mphase.F90 coverage: 76.47 %func 61.39 %block
1) module Mphase_module
2)
3) use Mphase_Aux_module
4) use Global_Aux_module
5)
6) use PFLOTRAN_Constants_module
7)
8) implicit none
9)
10) private
11)
12) #include "petsc/finclude/petscsys.h"
13)
14) !#include "include/petscf90.h"
15) #include "petsc/finclude/petscvec.h"
16) #include "petsc/finclude/petscvec.h90"
17) ! It is VERY IMPORTANT to make sure that the above .h90 file gets included.
18) ! Otherwise some very strange things will happen and PETSc will give no
19) ! indication of what the problem is.
20) #include "petsc/finclude/petscmat.h"
21) #include "petsc/finclude/petscmat.h90"
22) #include "petsc/finclude/petscdm.h"
23) #include "petsc/finclude/petscdm.h90"
24) !#ifdef USE_PETSC216
25) !#include "petsc/finclude/petscsles.h"
26) !#endiff
27) #include "petsc/finclude/petscsnes.h"
28) #include "petsc/finclude/petscviewer.h"
29) #include "petsc/finclude/petscsysdef.h"
30) #include "petsc/finclude/petscis.h"
31) #include "petsc/finclude/petscis.h90"
32) #include "petsc/finclude/petsclog.h"
33) #include "petsc/finclude/petscerror.h"
34)
35) ! Cutoff parameters
36) PetscReal, parameter :: formeps = 1.D-4
37) PetscReal, parameter :: eps = 1.D-8
38) PetscReal, parameter :: dfac = 1D-8
39) PetscReal, parameter :: floweps = 1.D-24
40) ! PetscReal, parameter :: satcuteps = 1.D-5
41) PetscReal, parameter :: zerocut =0.D0 !1D-8
42)
43)
44) PetscInt, parameter :: jh2o=1, jco2=2
45)
46) public MphaseResidual,MphaseJacobian, &
47) MphaseUpdateFixedAccumulation,MphaseTimeCut, &
48) MphaseSetup,MphaseUpdateReason, &
49) MphaseMaxChange,MphaseUpdateSolution, &
50) MphaseGetTecplotHeader,MphaseInitializeTimestep, &
51) MphaseUpdateAuxVars, &
52) MphaseSecondaryHeat,MphaseSecondaryHeatJacobian, &
53) MphaseComputeMassBalance,MphaseDestroy
54)
55) contains
56)
57) ! ************************************************************************** !
58)
59) subroutine MphaseTimeCut(realization)
60) !
61) ! Resets arrays for time step cut
62) !
63) ! Author: Chuan Lu
64) ! Date: 5/13/08
65) !
66)
67) use Realization_Subsurface_class
68) use Option_module
69) use Field_module
70)
71) implicit none
72)
73) type(realization_subsurface_type) :: realization
74) type(option_type), pointer :: option
75) type(field_type), pointer :: field
76)
77) PetscReal, pointer :: xx_p(:),yy_p(:)
78) PetscErrorCode :: ierr
79) PetscInt :: local_id
80)
81) option => realization%option
82) field => realization%field
83)
84) call VecCopy(field%iphas_old_loc,field%iphas_loc,ierr);CHKERRQ(ierr)
85)
86) end subroutine MphaseTimeCut
87)
88) ! ************************************************************************** !
89)
90) subroutine MphaseSetup(realization)
91) !
92) ! Author: Chuan Lu
93) ! Date: 5/13/08
94) !
95)
96) use Realization_Subsurface_class
97) use Patch_module
98) use Output_Aux_module
99)
100) type(realization_subsurface_type) :: realization
101)
102) type(patch_type), pointer :: cur_patch
103) type(output_variable_list_type), pointer :: list
104)
105) cur_patch => realization%patch_list%first
106) do
107) if (.not.associated(cur_patch)) exit
108) realization%patch => cur_patch
109) call MphaseSetupPatch(realization)
110) cur_patch => cur_patch%next
111) enddo
112)
113) list => realization%output_option%output_snap_variable_list
114) call MPhaseSetPlotVariables(list)
115) list => realization%output_option%output_obs_variable_list
116) call MPhaseSetPlotVariables(list)
117)
118) end subroutine MphaseSetup
119)
120) ! ************************************************************************** !
121)
122) subroutine MphaseSetupPatch(realization)
123) !
124) ! Creates arrays for auxiliary variables
125) !
126) ! Author: Chuan Lu
127) ! Date: 5/13/08
128) !
129)
130) use Realization_Subsurface_class
131) use Patch_module
132) use Option_module
133) use Coupler_module
134) use Connection_module
135) use Grid_module
136) use Secondary_Continuum_Aux_module
137) use Secondary_Continuum_module
138)
139) implicit none
140)
141) type(realization_subsurface_type) :: realization
142)
143) type(option_type), pointer :: option
144) type(patch_type),pointer :: patch
145) type(mphase_type),pointer :: mphase
146) type(grid_type), pointer :: grid
147) type(coupler_type), pointer :: boundary_condition
148) type(coupler_type), pointer :: source_sink
149)
150) PetscInt :: ghosted_id, iconn, sum_connection, ipara
151) type(Mphase_auxvar_type), pointer :: auxvars(:)
152) type(Mphase_auxvar_type), pointer :: auxvars_bc(:)
153) type(Mphase_auxvar_type), pointer :: auxvars_ss(:)
154) type(sec_heat_type), pointer :: mphase_sec_heat_vars(:)
155) type(coupler_type), pointer :: initial_condition
156) PetscReal :: area_per_vol
157) PetscInt :: local_id
158)
159) option => realization%option
160) patch => realization%patch
161) grid => patch%grid
162)
163) patch%aux%Mphase => MphaseAuxCreate()
164) patch%aux%SC_heat => SecondaryAuxHeatCreate(option)
165) mphase => patch%aux%Mphase
166)
167)
168) ! option%io_buffer = 'Before Mphase can be run, the thc_parameter object ' // &
169) ! 'must be initialized with the proper variables ' // &
170) ! 'MphaseAuxCreate() is called anywhere.'
171) ! call printErrMsg(option)
172)
173) ! mphase_parameters create *********************************************
174) ! Sir
175) allocate(mphase%Mphase_parameter%sir(option%nphase, &
176) size(patch%saturation_function_array)))
177) do ipara = 1, size(patch%saturation_function_array)
178) mphase%mphase_parameter%sir(:,patch% &
179) saturation_function_array(ipara)%ptr%id) = &
180) patch%saturation_function_array(ipara)%ptr%Sr(:)
181) enddo
182)
183) ! dencpr
184) allocate(mphase%Mphase_parameter%dencpr(size(patch%material_property_array)))
185) do ipara = 1, size(patch%material_property_array)
186) mphase%mphase_parameter%dencpr(iabs(patch%material_property_array(ipara)% &
187) ptr%internal_id)) = &
188) patch%material_property_array(ipara)%ptr%rock_density*option%scale*&
189) patch%material_property_array(ipara)%ptr%specific_heat
190) enddo
191) ! ckwet
192) allocate(mphase%Mphase_parameter%ckwet(size(patch%material_property_array)))
193) do ipara = 1, size(patch%material_property_array)
194) mphase%mphase_parameter%ckwet(iabs(patch%material_property_array(ipara)% &
195) ptr%internal_id)) = &
196) patch%material_property_array(ipara)%ptr%thermal_conductivity_wet*option%scale
197) enddo
198)
199)
200) ! mphase_parameters create_end *****************************************
201)
202) ! Create secondary continuum variables - Added by SK 06/28/12
203)
204) if (option%use_mc) then
205)
206) initial_condition => patch%initial_condition_list%first
207) allocate(mphase_sec_heat_vars(grid%nlmax))
208)
209) do local_id = 1, grid%nlmax
210)
211) ! Assuming the same secondary continuum for all regions (need to make it an array)
212) ! S. Karra 07/18/12
213) call SecondaryContinuumSetProperties( &
214) mphase_sec_heat_vars(local_id)%sec_continuum, &
215) patch%material_property_array(1)%ptr%secondary_continuum_name, &
216) patch%material_property_array(1)%ptr%secondary_continuum_length, &
217) patch%material_property_array(1)%ptr%secondary_continuum_matrix_block_size, &
218) patch%material_property_array(1)%ptr%secondary_continuum_fracture_spacing, &
219) patch%material_property_array(1)%ptr%secondary_continuum_radius, &
220) patch%material_property_array(1)%ptr%secondary_continuum_area, &
221) option)
222)
223) mphase_sec_heat_vars(local_id)%ncells = &
224) patch%material_property_array(1)%ptr%secondary_continuum_ncells
225) mphase_sec_heat_vars(local_id)%aperture = &
226) patch%material_property_array(1)%ptr%secondary_continuum_aperture
227) mphase_sec_heat_vars(local_id)%epsilon = &
228) patch%material_property_array(1)%ptr%secondary_continuum_epsilon
229) mphase_sec_heat_vars(local_id)%log_spacing = &
230) patch%material_property_array(1)%ptr%secondary_continuum_log_spacing
231) mphase_sec_heat_vars(local_id)%outer_spacing = &
232) patch%material_property_array(1)%ptr%secondary_continuum_outer_spacing
233)
234)
235) allocate(mphase_sec_heat_vars(local_id)%area(mphase_sec_heat_vars(local_id)%ncells))
236) allocate(mphase_sec_heat_vars(local_id)%vol(mphase_sec_heat_vars(local_id)%ncells))
237) allocate(mphase_sec_heat_vars(local_id)%dm_minus(mphase_sec_heat_vars(local_id)%ncells))
238) allocate(mphase_sec_heat_vars(local_id)%dm_plus(mphase_sec_heat_vars(local_id)%ncells))
239) allocate(mphase_sec_heat_vars(local_id)%sec_continuum% &
240) distance(mphase_sec_heat_vars(local_id)%ncells))
241)
242) call SecondaryContinuumType(&
243) mphase_sec_heat_vars(local_id)%sec_continuum, &
244) mphase_sec_heat_vars(local_id)%ncells, &
245) mphase_sec_heat_vars(local_id)%area, &
246) mphase_sec_heat_vars(local_id)%vol, &
247) mphase_sec_heat_vars(local_id)%dm_minus, &
248) mphase_sec_heat_vars(local_id)%dm_plus, &
249) mphase_sec_heat_vars(local_id)%aperture, &
250) mphase_sec_heat_vars(local_id)%epsilon, &
251) mphase_sec_heat_vars(local_id)%log_spacing, &
252) mphase_sec_heat_vars(local_id)%outer_spacing, &
253) area_per_vol,option)
254)
255) mphase_sec_heat_vars(local_id)%interfacial_area = area_per_vol* &
256) (1.d0 - mphase_sec_heat_vars(local_id)%epsilon)* &
257) patch%material_property_array(1)%ptr% &
258) secondary_continuum_area_scaling
259)
260)
261) ! Setting the initial values of all secondary node temperatures same as primary node
262) ! temperatures (with initial dirichlet BC only) -- sk 06/26/12
263) allocate(mphase_sec_heat_vars(local_id)%sec_temp(mphase_sec_heat_vars(local_id)%ncells))
264)
265) if (option%set_secondary_init_temp) then
266) mphase_sec_heat_vars(local_id)%sec_temp = &
267) patch%material_property_array(1)%ptr%secondary_continuum_init_temp
268) else
269) mphase_sec_heat_vars(local_id)%sec_temp = &
270) initial_condition%flow_condition%temperature%dataset%rarray(1)
271) endif
272)
273) enddo
274)
275) patch%aux%SC_heat%sec_heat_vars => mphase_sec_heat_vars
276)
277) endif
278)
279)
280) ! allocate auxvar data structures for all grid cells
281) allocate(auxvars(grid%ngmax))
282)
283) do ghosted_id = 1, grid%ngmax
284) call MphaseAuxVarInit(auxvars(ghosted_id),option)
285) enddo
286) mphase%auxvars => auxvars
287) mphase%num_aux = grid%ngmax
288)
289) allocate(mphase%delx(option%nflowdof,grid%ngmax))
290) allocate(mphase%res_old_AR(grid%nlmax,option%nflowdof))
291) allocate(mphase%res_old_FL(ConnectionGetNumberInList(patch%grid%&
292) internal_connection_set_list),option%nflowdof))
293)
294) ! count the number of boundary connections and allocate
295) ! auxvar data structures for them
296) boundary_condition => patch%boundary_condition_list%first
297) sum_connection = 0
298) do
299) if (.not.associated(boundary_condition)) exit
300) sum_connection = sum_connection + &
301) boundary_condition%connection_set%num_connections
302) boundary_condition => boundary_condition%next
303) enddo
304)
305) allocate(auxvars_bc(sum_connection))
306)
307) do iconn = 1, sum_connection
308) call MphaseAuxVarInit(auxvars_bc(iconn),option)
309) enddo
310)
311) mphase%auxvars_bc => auxvars_bc
312) mphase%num_aux_bc = sum_connection
313)
314) ! Allocate source /sink
315) source_sink => patch%source_sink_list%first
316) sum_connection = 0
317) do
318) if (.not.associated(source_sink)) exit
319) sum_connection = sum_connection + &
320) source_sink%connection_set%num_connections
321) source_sink => source_sink%next
322) enddo
323) allocate(auxvars_ss(sum_connection))
324) do iconn = 1, sum_connection
325) call MphaseAuxVarInit(auxvars_ss(iconn),option)
326) enddo
327) mphase%auxvars_ss => auxvars_ss
328) mphase%num_aux_ss = sum_connection
329)
330) option%flow%numerical_derivatives = PETSC_TRUE
331)
332) end subroutine MphaseSetupPatch
333)
334) ! ************************************************************************** !
335)
336) subroutine MphaseComputeMassBalance(realization,mass_balance,mass_trapped)
337) !
338) ! Author: Glenn Hammond
339) ! Date: 02/22/08
340) !
341)
342) use Realization_Subsurface_class
343) use Patch_module
344)
345) type(realization_subsurface_type) :: realization
346) PetscReal :: mass_balance(realization%option%nflowspec,realization%option%nphase)
347) PetscReal :: mass_trapped(realization%option%nphase)
348)
349) type(patch_type), pointer :: cur_patch
350)
351) mass_balance = 0.d0
352) mass_trapped = 0.d0
353)
354) cur_patch => realization%patch_list%first
355) do
356) if (.not.associated(cur_patch)) exit
357) realization%patch => cur_patch
358) call MphaseComputeMassBalancePatch(realization,mass_balance,mass_trapped)
359) cur_patch => cur_patch%next
360) enddo
361)
362) end subroutine MphaseComputeMassBalance
363)
364) ! ************************************************************************** !
365)
366) subroutine MphaseComputeMassBalancePatch(realization,mass_balance,mass_trapped)
367) !
368) ! Initializes mass balance
369) !
370) ! Author: Glenn Hammond
371) ! Date: 12/19/08
372) !
373)
374) use Realization_Subsurface_class
375) use Option_module
376) use Patch_module
377) use Field_module
378) use Grid_module
379) use Material_Aux_class
380) ! use Saturation_Function_module
381) ! use Mphase_pckr_module
382)
383) implicit none
384)
385) type(realization_subsurface_type) :: realization
386) ! type(saturation_function_type) :: saturation_function_type
387)
388) PetscReal :: mass_balance(realization%option%nflowspec,realization%option%nphase)
389) PetscReal :: mass_trapped(realization%option%nphase)
390)
391) type(option_type), pointer :: option
392) type(patch_type), pointer :: patch
393) type(field_type), pointer :: field
394) type(grid_type), pointer :: grid
395) type(mphase_auxvar_type), pointer :: mphase_auxvars(:)
396) class(material_auxvar_type), pointer :: material_auxvars(:)
397) PetscReal, pointer :: icap_loc_p(:)
398)
399) PetscErrorCode :: ierr
400) PetscInt :: local_id
401) PetscInt :: ghosted_id
402) PetscInt :: iphase
403) PetscInt :: ispec_start, ispec_end, ispec
404) PetscReal :: pckr_sir(realization%option%nphase)
405)
406) option => realization%option
407) patch => realization%patch
408) grid => patch%grid
409) field => realization%field
410)
411) mphase_auxvars => patch%aux%MPhase%auxvars
412) material_auxvars => patch%aux%Material%auxvars
413)
414) call VecGetArrayF90(field%icap_loc,icap_loc_p, ierr);CHKERRQ(ierr)
415)
416) do local_id = 1, grid%nlmax
417) ghosted_id = grid%nL2G(local_id)
418)
419) !geh - Ignore inactive cells with inactive materials
420) if (associated(patch%imat)) then
421) if (patch%imat(ghosted_id) <= 0) cycle
422) endif
423)
424) ! mass = volume * saturation * density * mole fraction
425) do iphase = 1, option%nphase
426) do ispec = 1, option%nflowspec
427) mass_balance(ispec,iphase) = mass_balance(ispec,iphase) + &
428) mphase_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
429) mphase_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
430) mphase_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
431) material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
432) enddo
433)
434) pckr_sir(iphase) = &
435) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr%sr(iphase)
436)
437) if (iphase == 1 .and. &
438) mphase_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase) <= pckr_sir(iphase)) then
439) ispec = 1
440) mass_trapped(iphase) = mass_trapped(iphase) + &
441) mphase_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
442) mphase_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
443) mphase_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
444) material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
445) endif
446)
447) if (iphase == 2 .and. &
448) mphase_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase) <= pckr_sir(iphase)) then
449) ispec = 2
450) mass_trapped(iphase) = mass_trapped(iphase) + &
451) mphase_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
452) mphase_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
453) mphase_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
454) material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
455) endif
456) enddo
457) enddo
458)
459) call VecRestoreArrayF90(field%icap_loc,icap_loc_p, ierr);CHKERRQ(ierr)
460)
461) end subroutine MphaseComputeMassBalancePatch
462)
463) ! ************************************************************************** !
464)
465) subroutine MphaseZeroMassBalDeltaPatch(realization)
466) !
467) ! Zeros mass balance delta array
468) !
469) ! Author: Glenn Hammond
470) ! Date: 12/19/08
471) !
472)
473) use Realization_Subsurface_class
474) use Option_module
475) use Patch_module
476) use Grid_module
477)
478) implicit none
479)
480) type(realization_subsurface_type) :: realization
481)
482) type(option_type), pointer :: option
483) type(patch_type), pointer :: patch
484) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
485) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
486)
487) PetscInt :: iconn
488)
489) option => realization%option
490) patch => realization%patch
491)
492) global_auxvars_bc => patch%aux%Global%auxvars_bc
493) global_auxvars_ss => patch%aux%Global%auxvars_ss
494)
495) #ifdef COMPUTE_INTERNAL_MASS_FLUX
496) do iconn = 1, patch%aux%Mphase%num_aux
497) patch%aux%Global%auxvars(iconn)%mass_balance_delta = 0.d0
498) enddo
499) #endif
500)
501) ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
502) ! placed around the internal do loop - geh
503) if (patch%aux%Mphase%num_aux_bc > 0) then
504) do iconn = 1, patch%aux%Mphase%num_aux_bc
505) global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
506) enddo
507) endif
508)
509) if (patch%aux%Mphase%num_aux_ss > 0) then
510) do iconn = 1, patch%aux%Mphase%num_aux_ss
511) global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
512) enddo
513) endif
514)
515) end subroutine MphaseZeroMassBalDeltaPatch
516)
517) ! ************************************************************************** !
518)
519) subroutine MphaseUpdateMassBalancePatch(realization)
520) !
521) ! Updates mass balance
522) !
523) ! Author: Glenn Hammond
524) ! Date: 12/19/08
525) !
526)
527) use Realization_Subsurface_class
528) use Option_module
529) use Patch_module
530) use Grid_module
531)
532) implicit none
533)
534) type(realization_subsurface_type) :: realization
535)
536) type(option_type), pointer :: option
537) type(patch_type), pointer :: patch
538) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
539) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
540)
541) PetscInt :: iconn
542)
543) option => realization%option
544) patch => realization%patch
545)
546) global_auxvars_bc => patch%aux%Global%auxvars_bc
547) global_auxvars_ss => patch%aux%Global%auxvars_ss
548)
549) #ifdef COMPUTE_INTERNAL_MASS_FLUX
550) do iconn = 1, patch%aux%Mphase%num_aux
551) patch%aux%Global%auxvars(iconn)%mass_balance = &
552) patch%aux%Global%auxvars(iconn)%mass_balance + &
553) patch%aux%Global%auxvars(iconn)%mass_balance_delta* &
554) option%flow_dt
555) enddo
556) #endif
557)
558) ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
559) ! placed around the internal do loop - geh
560) if (patch%aux%Mphase%num_aux_bc > 0) then
561) do iconn = 1, patch%aux%Mphase%num_aux_bc
562) global_auxvars_bc(iconn)%mass_balance = &
563) global_auxvars_bc(iconn)%mass_balance + &
564) global_auxvars_bc(iconn)%mass_balance_delta*option%flow_dt
565) enddo
566) endif
567)
568) if (patch%aux%Mphase%num_aux_ss > 0) then
569) do iconn = 1, patch%aux%Mphase%num_aux_ss
570) global_auxvars_ss(iconn)%mass_balance = &
571) global_auxvars_ss(iconn)%mass_balance + &
572) global_auxvars_ss(iconn)%mass_balance_delta*option%flow_dt
573) enddo
574) endif
575)
576) end subroutine MphaseUpdateMassBalancePatch
577)
578) ! ************************************************************************** !
579)
580) function MphaseInitGuessCheck(realization)
581) !
582) ! Mphaseinitguesscheckpatch:
583) !
584) ! Author: Chuan Lu
585) ! Date: 12/10/07
586) !
587)
588) use Realization_Subsurface_class
589) use Patch_module
590) use Option_module
591)
592) PetscInt :: MphaseInitGuessCheck
593) type(realization_subsurface_type) :: realization
594) type(option_type), pointer :: option
595) type(patch_type), pointer :: cur_patch
596) PetscInt :: ipass, ipass0
597) PetscErrorCode :: ierr
598)
599) option => realization%option
600) ipass = 1
601) cur_patch => realization%patch_list%first
602) do while(ipass > 0)
603) if (.not.associated(cur_patch)) exit
604) realization%patch => cur_patch
605) ipass = MphaseInitGuessCheckPatch(realization)
606) cur_patch => cur_patch%next
607) enddo
608)
609) call MPI_Barrier(option%mycomm,ierr)
610) if (option%mycommsize > 1) then
611) call MPI_Allreduce(ipass,ipass0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
612) option%mycomm,ierr)
613) if (ipass0 < option%mycommsize) ipass=-1
614) endif
615) MphaseInitGuessCheck =ipass
616) end function MphaseInitGuessCheck
617)
618) ! ************************************************************************** !
619)
620) subroutine MPhaseUpdateReasonPatch(reason,realization)
621) !
622) ! Mphaseinitguesscheckpatch:
623) !
624) ! Author: Chuan Lu
625) ! Date: 12/10/07
626) !
627) use Realization_Subsurface_class
628) use Patch_module
629) use Field_module
630) use Option_module
631) use Grid_module
632)
633) implicit none
634)
635) PetscInt, intent(out) :: reason
636) type(realization_subsurface_type) :: realization
637) type(patch_type),pointer :: patch
638) type(grid_type), pointer :: grid
639) type(field_type), pointer :: field
640) type(option_type), pointer :: option
641) PetscReal, pointer :: xx_p(:),iphase_loc_p(:), yy_p(:)
642) PetscInt :: n,n0,re
643) PetscInt :: re0, iipha
644) PetscErrorCode :: ierr
645)
646) option => realization%option
647) field => realization%field
648) patch => realization%patch
649) grid => patch%grid
650)
651) re = 1
652)
653) ! if (re > 0) then
654) call VecGetArrayReadF90(field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
655) call VecGetArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
656) call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr);CHKERRQ(ierr)
657)
658) do n = 1,grid%nlmax
659) !**** clu-Ignore inactive cells with inactive materials **************
660) if (associated(patch%imat)) then
661) if (patch%imat(grid%nL2G(n)) <= 0) cycle
662) endif
663) n0 = (n-1)*option%nflowdof
664) iipha = int(iphase_loc_p(grid%nL2G(n)))
665)
666) ! ******** Too huge change in pressure ****************
667) !geh: I don't believe that this code is being used. Therefore, I will add an
668) ! error message and let someone sort the use of option%dpmxe later
669) option%io_buffer = 'option%dpmxe and option%dtmpmxe needs to be ' // &
670) 'refactored in MPhaseUpdateReasonPatch'
671) call printErrMsg(option)
672) !geh if (dabs(xx_p(n0 + 1) - yy_p(n0 + 1)) > (1000.0D0 * option%dpmxe)) then
673) re = 0; print *,'large change in p', xx_p(n0 + 1), yy_p(n0 + 1)
674) exit
675) !geh endif
676)
677) ! ******** Too huge change in temperature ****************
678) !geh if (dabs(xx_p(n0 + 2) - yy_p(n0 + 2)) > (10.0D0 * option%dtmpmxe)) then
679) re = 0; print *,'large change in T', xx_p(n0 + 2), yy_p(n0 + 2)
680) exit
681) !geh endif
682)
683) ! ******* Check 0 <= sat/con <= 1 **************************
684) select case(iipha)
685) case (1) ! liquid
686) if (xx_p(n0 + 3) > 1.0D0) then
687) re = 0; exit
688) endif
689) if (xx_p(n0 + 3) < 0.D0) then
690) ! if (xx_p(n0 + 3) > -1D-14) then
691) ! xx_p(n0 + 3) = 0.D0
692) ! else
693) !! print *,'MPhaseUpdate: ',iipha,n,n0,option%nflowdof,xx_p(n0+3)
694) re = 0; exit
695) ! endif ! clu removed 05/02/2011
696) endif
697) case (2) ! gas
698) if (xx_p(n0 + 3) > 1.0D0) then
699) re=0; exit
700) endif
701) if (xx_p(n0 + 3) < 0.D-0) then
702) ! if (xx_p(n0 + 3) > -1D-14) then
703) ! xx_p(n0 + 3) = 0.D0
704) ! else
705) re = 0; exit
706) ! endif
707) endif
708) case (3) ! two-phase
709) if (xx_p(n0 + 3) > 1.D0) then
710) re=0; exit
711) endif
712) if (xx_p(n0 + 3) < 0.) then
713) ! if (xx_p(n0 + 3) > -1D-14) then
714) ! xx_p(n0 + 3) = 0.D0
715) ! else
716) re = 0; exit
717) ! endif
718) endif
719) end select
720) end do
721)
722) ! if (re <= 0) print *,'Sat or Con out of Region at: ',n,iipha,xx_p(n0+1:n0+3)
723) call VecRestoreArrayReadF90(field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
724) call VecRestoreArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
725) call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr);CHKERRQ(ierr)
726)
727) ! endif
728) ! print *,' update reason', grid%myrank, re,n,grid%nlmax
729) reason=re
730)
731) end subroutine MPhaseUpdateReasonPatch
732)
733) ! ************************************************************************** !
734)
735) subroutine MPhaseUpdateReason(reason, realization)
736) !
737) ! MphaseUpdateAuxVars: Updates the auxiliary variables associated with
738) ! the Mphase problem
739) !
740) ! Author: Glenn Hammond
741) ! Date: 12/10/07
742) !
743)
744) use Realization_Subsurface_class
745) use Patch_module
746) implicit none
747)
748) type(realization_subsurface_type) :: realization
749)
750) type(patch_type), pointer :: cur_patch
751) PetscInt :: reason
752)
753) PetscInt :: re, re0
754) PetscErrorCode :: ierr
755)
756) re = 1
757) cur_patch => realization%patch_list%first
758) do
759) if (.not.associated(cur_patch)) exit
760) realization%patch => cur_patch
761) call MPhaseUpdateReasonPatch(re, realization)
762) if (re<=0)then
763) exit
764) endif
765) cur_patch => cur_patch%next
766) enddo
767)
768)
769) call MPI_Barrier(realization%option%mycomm,ierr)
770)
771) if (realization%option%mycommsize > 1) then
772) call MPI_Allreduce(re,re0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
773) realization%option%mycomm,ierr)
774) if (re0<realization%option%mycommsize) re=0
775) endif
776) reason=re
777)
778) if (reason <= 0 .and. realization%option%myrank == 0) print *,'Sat or Con out of Region', re
779) end subroutine MPhaseUpdateReason
780)
781) ! ************************************************************************** !
782)
783) function MphaseInitGuessCheckPatch(realization)
784) !
785) ! Author: Chuan Lu
786) ! Date: 12/10/07
787) !
788)
789) use co2_span_wagner_module
790)
791) use Realization_Subsurface_class
792) use Patch_module
793) use Field_module
794) use Grid_module
795) use Option_module
796) implicit none
797)
798) PetscInt :: MphaseInitGuessCheckPatch
799) type(realization_subsurface_type) :: realization
800) type(grid_type), pointer :: grid
801) type(patch_type), pointer :: patch
802) type(option_type), pointer :: option
803) type(field_type), pointer :: field
804)
805) PetscInt :: local_id, ghosted_id, ipass
806) PetscReal, pointer :: xx_p(:)
807) PetscErrorCode :: ierr
808)
809)
810) patch => realization%patch
811) grid => patch%grid
812) option => realization%option
813) field => realization%field
814)
815) call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
816)
817) ipass=1
818) do local_id = 1, grid%nlmax
819) ghosted_id = grid%nL2G(local_id)
820) !geh - Ignore inactive cells with inactive materials
821) if (associated(patch%imat)) then
822) if (patch%imat(ghosted_id) <= 0) cycle
823) endif
824)
825) ! insure zero liquid sat not passed to ptran (no effect on pflow)
826) if (xx_p((local_id-1)*option%nflowdof+3) < 0.D0)xx_p((local_id-1)*option%nflowdof+3) = zerocut
827) if (xx_p((local_id-1)*option%nflowdof+3) > 1.D0)xx_p((local_id-1)*option%nflowdof+3) = 1.D0 - zerocut
828)
829) ! check if p,T within range of table
830) if (xx_p((local_id-1)*option%nflowdof+1)< p0_tab*1D6 &
831) .or. xx_p((local_id-1)*option%nflowdof+1)>(ntab_p*dp_tab + p0_tab)*1D6)then
832) ipass=-1; exit
833) endif
834) if (xx_p((local_id-1)*option%nflowdof+2)< t0_tab -273.15D0 &
835) .or. xx_p((local_id-1)*option%nflowdof+2)>ntab_t*dt_tab + t0_tab-273.15D0)then
836) ipass=-1; exit
837) endif
838) enddo
839)
840) call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
841)
842) MphaseInitGuessCheckPatch = ipass
843)
844) end function MphaseInitGuessCheckPatch
845)
846) ! ************************************************************************** !
847)
848) subroutine MphaseUpdateAuxVars(realization)
849) !
850) ! Updates the auxiliary variables associated with
851) ! the Mphase problem
852) !
853) ! Author: Glenn Hammond
854) ! Date: 12/10/07
855) !
856)
857) use Realization_Subsurface_class
858) use Patch_module
859)
860) type(realization_subsurface_type) :: realization
861)
862) type(patch_type), pointer :: cur_patch
863)
864) cur_patch => realization%patch_list%first
865) do
866) if (.not.associated(cur_patch)) exit
867) realization%patch => cur_patch
868) call MphaseUpdateAuxVarsPatch(realization)
869) cur_patch => cur_patch%next
870) enddo
871)
872) end subroutine MphaseUpdateAuxVars
873)
874) ! ************************************************************************** !
875)
876) subroutine MphaseUpdateAuxVarsPatch(realization)
877) !
878) ! Updates the auxiliary variables associated with
879) ! the Mphase problem
880) !
881) ! Author: Chuan Lu
882) ! Date: 12/10/07
883) !
884)
885) use Realization_Subsurface_class
886) use Patch_module
887) use Field_module
888) use Option_module
889) use Grid_module
890) use Coupler_module
891) use Connection_module
892) use Material_module
893)
894) implicit none
895)
896) type(realization_subsurface_type) :: realization
897)
898) type(option_type), pointer :: option
899) type(patch_type), pointer :: patch
900) type(grid_type), pointer :: grid
901) type(field_type), pointer :: field
902) type(coupler_type), pointer :: boundary_condition
903) type(coupler_type), pointer :: source_sink
904) type(connection_set_type), pointer :: cur_connection_set
905) type(Mphase_auxvar_type), pointer :: auxvars(:)
906) type(Mphase_auxvar_type), pointer :: auxvars_bc(:)
907) type(Mphase_auxvar_type), pointer :: auxvars_ss(:)
908) type(global_auxvar_type), pointer :: global_auxvars(:)
909) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
910) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
911)
912) PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
913) PetscInt :: iphase
914) PetscReal, pointer :: xx_loc_p(:), icap_loc_p(:), iphase_loc_p(:)
915) PetscReal :: xxbc(realization%option%nflowdof)
916) PetscErrorCode :: ierr
917) PetscReal :: xphi, ynacl, mnacl
918)
919) option => realization%option
920) patch => realization%patch
921) grid => patch%grid
922) field => realization%field
923)
924) auxvars => patch%aux%Mphase%auxvars
925) auxvars_bc => patch%aux%Mphase%auxvars_bc
926) auxvars_ss => patch%aux%Mphase%auxvars_ss
927)
928) global_auxvars => patch%aux%Global%auxvars
929) global_auxvars_bc => patch%aux%Global%auxvars_bc
930) global_auxvars_ss => patch%aux%Global%auxvars_ss
931)
932) call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
933) call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
934) call VecGetArrayF90(field%iphas_loc,iphase_loc_p,ierr);CHKERRQ(ierr)
935)
936) do ghosted_id = 1, grid%ngmax
937) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
938) !geh - Ignore inactive cells with inactive materials
939) if (associated(patch%imat)) then
940) if (patch%imat(ghosted_id) <= 0) cycle
941) endif
942) iend = ghosted_id*option%nflowdof
943) istart = iend-option%nflowdof+1
944) iphase = int(iphase_loc_p(ghosted_id))
945) if (.not. associated(patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr))then
946) print *, 'error!!! saturation function not allocated', ghosted_id,icap_loc_p(ghosted_id)
947) endif
948)
949) call MphaseAuxVarCompute_NINC(xx_loc_p(istart:iend), &
950) auxvars(ghosted_id)%auxvar_elem(0),&
951) global_auxvars(ghosted_id), &
952) iphase, &
953) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
954) realization%fluid_properties,option,xphi)
955) ! update global variables
956) if (associated(global_auxvars)) then
957) global_auxvars(ghosted_id)%pres(:) = auxvars(ghosted_id)%auxvar_elem(0)%pres
958) if (iphase == 3) then ! 2-phase
959) global_auxvars(ghosted_id)%pres(1) = auxvars(ghosted_id)%auxvar_elem(0)%pres - &
960) auxvars(ghosted_id)%auxvar_elem(0)%pc(1)
961) endif
962)
963) ! print *,'UPdate mphase and global vars ', ghosted_id, &
964) ! auxvars(ghosted_id)%auxvar_elem(0)%pc(:),auxvars(ghosted_id)%auxvar_elem(0)%pres, &
965) ! global_auxvars(ghosted_id)%pres(:)
966)
967) global_auxvars(ghosted_id)%temp = auxvars(ghosted_id)%auxvar_elem(0)%temp
968) global_auxvars(ghosted_id)%sat(:) = auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
969) global_auxvars(ghosted_id)%fugacoeff(1) = xphi
970) global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
971) global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
972) * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
973)
974) mnacl = global_auxvars(ghosted_id)%m_nacl(1)
975) if (global_auxvars(ghosted_id)%m_nacl(2) > mnacl) mnacl = global_auxvars(ghosted_id)%m_nacl(2)
976) ynacl = mnacl/(1.d3/FMWH2O + mnacl)
977) global_auxvars(ghosted_id)%xmass(1) = (1.d0-ynacl) &
978) *auxvars(ghosted_id)%auxvar_elem(0)%xmol(1) * FMWH2O &
979) /((1.d0-ynacl)*auxvars(ghosted_id)%auxvar_elem(0)%xmol(1) * FMWH2O &
980) +auxvars(ghosted_id)%auxvar_elem(0)%xmol(2) * FMWCO2 &
981) +ynacl*auxvars(ghosted_id)%auxvar_elem(0)%xmol(1)*FMWNACL)
982) global_auxvars(ghosted_id)%xmass(2) = auxvars(ghosted_id)%auxvar_elem(0)%xmol(3) * FMWH2O &
983) /(auxvars(ghosted_id)%auxvar_elem(0)%xmol(3) * FMWH2O &
984) +auxvars(ghosted_id)%auxvar_elem(0)%xmol(4) * FMWCO2)
985) global_auxvars(ghosted_id)%reaction_rate_store(:) = global_auxvars(ghosted_id)%reaction_rate(:)
986) global_auxvars(ghosted_id)%reaction_rate(:) = 0.D0
987) else
988) print *,'Not associated global for mph'
989) endif
990) iphase_loc_p(ghosted_id) = iphase
991) enddo
992)
993) boundary_condition => patch%boundary_condition_list%first
994) sum_connection = 0
995) do
996) if (.not.associated(boundary_condition)) exit
997) cur_connection_set => boundary_condition%connection_set
998) do iconn = 1, cur_connection_set%num_connections
999) sum_connection = sum_connection + 1
1000) local_id = cur_connection_set%id_dn(iconn)
1001) ghosted_id = grid%nL2G(local_id)
1002) if (associated(patch%imat)) then
1003) if (patch%imat(ghosted_id) <= 0) cycle
1004) endif
1005)
1006) ! Added the following by Satish Karra 10/05/11
1007) do idof = 1, option%nflowdof
1008) select case(boundary_condition%flow_condition%itype(idof))
1009) case(DIRICHLET_BC)
1010) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
1011) case(HYDROSTATIC_BC,SEEPAGE_BC)
1012) xxbc(MPH_PRESSURE_DOF) = boundary_condition%flow_aux_real_var(MPH_PRESSURE_DOF,iconn)
1013) if (idof >= MPH_TEMPERATURE_DOF) then
1014) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
1015) endif
1016) case(NEUMANN_BC, ZERO_GRADIENT_BC)
1017) ! solve for pb from Darcy's law given qb /= 0
1018) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
1019) iphase = int(iphase_loc_p(ghosted_id))
1020) end select
1021) enddo
1022)
1023) select case(boundary_condition%flow_condition%itype(MPH_CONCENTRATION_DOF))
1024) case(DIRICHLET_BC,SEEPAGE_BC,HYDROSTATIC_BC)
1025) iphase = boundary_condition%flow_aux_int_var(1,iconn)
1026) case(NEUMANN_BC,ZERO_GRADIENT_BC)
1027) iphase = int(iphase_loc_p(ghosted_id))
1028) end select
1029)
1030) call MphaseAuxVarCompute_NINC(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0), &
1031) global_auxvars_bc(sum_connection),iphase, &
1032) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
1033) realization%fluid_properties, option, xphi)
1034)
1035) if (associated(global_auxvars_bc)) then
1036) global_auxvars_bc(sum_connection)%pres(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
1037) auxvars_bc(sum_connection)%auxvar_elem(0)%pc(:)
1038) global_auxvars_bc(sum_connection)%temp = auxvars_bc(sum_connection)%auxvar_elem(0)%temp
1039) global_auxvars_bc(sum_connection)%sat(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
1040) ! global_auxvars(ghosted_id)%sat_store =
1041) global_auxvars_bc(sum_connection)%fugacoeff(1) = xphi
1042) global_auxvars_bc(sum_connection)%den(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
1043) global_auxvars_bc(sum_connection)%den_kg(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
1044) * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
1045) ! print *,'xxbc ', xxbc, iphasebc, global_auxvars_bc(sum_connection)%den_kg(:)
1046) mnacl= global_auxvars_bc(sum_connection)%m_nacl(1)
1047) if (global_auxvars_bc(sum_connection)%m_nacl(2)>mnacl) mnacl = global_auxvars_bc(sum_connection)%m_nacl(2)
1048) ynacl = mnacl/(1.d3/FMWH2O + mnacl)
1049) global_auxvars_bc(sum_connection)%xmass(1) = (1.d0-ynacl)&
1050) *auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1) * FMWH2O&
1051) /((1.d0-ynacl)*auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1) * FMWH2O &
1052) +auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(2) * FMWCO2 &
1053) +ynacl*auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1)*FMWNACL)
1054) global_auxvars_bc(sum_connection)%xmass(2) = auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(3) * FMWH2O&
1055) /(auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(3) * FMWH2O&
1056) +auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(4) * FMWCO2)
1057)
1058) endif
1059)
1060) enddo
1061) boundary_condition => boundary_condition%next
1062) enddo
1063)
1064)
1065) ! source/sinks
1066) source_sink => patch%source_sink_list%first
1067) sum_connection = 0
1068) do
1069) if (.not.associated(source_sink)) exit
1070) cur_connection_set => source_sink%connection_set
1071) do iconn = 1, cur_connection_set%num_connections
1072) sum_connection = sum_connection + 1
1073) local_id = cur_connection_set%id_dn(iconn)
1074) ghosted_id = grid%nL2G(local_id)
1075) if (patch%imat(ghosted_id) <= 0) cycle
1076)
1077) call MphaseAuxVarCopy(auxvars(ghosted_id)%auxvar_elem(0), &
1078) auxvars_ss(sum_connection)%auxvar_elem(0),option)
1079) call GlobalAuxVarCopy(global_auxvars(ghosted_id), &
1080) global_auxvars_ss(sum_connection),option)
1081)
1082) enddo
1083) source_sink => source_sink%next
1084) enddo
1085)
1086)
1087) call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
1088) call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
1089) call VecRestoreArrayF90(field%iphas_loc,iphase_loc_p,ierr);CHKERRQ(ierr)
1090)
1091) patch%aux%Mphase%auxvars_up_to_date = PETSC_TRUE
1092)
1093) end subroutine MphaseUpdateAuxVarsPatch
1094)
1095) ! ************************************************************************** !
1096)
1097) subroutine MphaseInitializeTimestep(realization)
1098) !
1099) ! Update data in module prior to time step
1100) !
1101) ! Author: Glenn Hammond
1102) ! Date: 02/20/08
1103) !
1104)
1105) use Realization_Subsurface_class
1106)
1107) implicit none
1108)
1109) type(realization_subsurface_type) :: realization
1110)
1111) call MphaseUpdateFixedAccumulation(realization)
1112)
1113) end subroutine MphaseInitializeTimestep
1114)
1115) ! ************************************************************************** !
1116)
1117) subroutine MphaseUpdateSolution(realization)
1118) !
1119) ! Updates data in module after a successful time step
1120) !
1121) ! Author: Glenn Hammond
1122) ! Date: 02/13/08
1123) !
1124)
1125) use Realization_Subsurface_class
1126) use Field_module
1127) use Patch_module
1128)
1129) implicit none
1130)
1131) type(realization_subsurface_type) :: realization
1132)
1133) type(field_type), pointer :: field
1134) type(patch_type), pointer :: cur_patch
1135)
1136) PetscErrorCode :: ierr
1137) PetscViewer :: viewer
1138)
1139) field => realization%field
1140)
1141) call VecCopy(field%iphas_loc,field%iphas_old_loc,ierr);CHKERRQ(ierr)
1142)
1143) ! call VecCopy(realization%field%flow_xx,realization%field%flow_yy,ierr)
1144) ! call VecCopy(realization%field%iphas_loc,realization%field%iphas_old_loc,ierr)
1145)
1146) cur_patch => realization%patch_list%first
1147) do
1148) if (.not.associated(cur_patch)) exit
1149) realization%patch => cur_patch
1150) call MphaseUpdateSolutionPatch(realization)
1151) cur_patch => cur_patch%next
1152) enddo
1153)
1154) ! make room for hysteric s-Pc-kr
1155)
1156) end subroutine MphaseUpdateSolution
1157)
1158) ! ************************************************************************** !
1159)
1160) subroutine MphaseUpdateSolutionPatch(realization)
1161) !
1162) ! Updates data in module after a successful time
1163) ! step
1164) ! written based on RichardsUpdateSolutionPatch
1165) !
1166) ! Author: Satish Karra, LANL
1167) ! Date: 08/23/11, 02/27/14
1168) !
1169)
1170) use Realization_Subsurface_class
1171) use Patch_module
1172) use Grid_module
1173) use Option_module
1174) use Field_module
1175) use Secondary_Continuum_Aux_module
1176) use Secondary_Continuum_module
1177)
1178) implicit none
1179)
1180) type(realization_subsurface_type) :: realization
1181) type(grid_type), pointer :: grid
1182) type(patch_type), pointer :: patch
1183) type(option_type), pointer :: option
1184) type(field_type), pointer :: field
1185) type(mphase_type), pointer :: mphase
1186) type(mphase_parameter_type), pointer :: mphase_parameter
1187) type(mphase_auxvar_type), pointer :: auxvars(:)
1188) type(global_auxvar_type), pointer :: global_auxvars(:)
1189) type(sec_heat_type), pointer :: mphase_sec_heat_vars(:)
1190)
1191) PetscInt :: istart, iend
1192) PetscInt :: local_id, ghosted_id
1193) ! secondary continuum variables
1194) PetscReal :: sec_dencpr
1195) PetscErrorCode :: ierr
1196) PetscReal, pointer :: ithrm_loc_p(:)
1197)
1198) patch => realization%patch
1199) grid => patch%grid
1200) option => realization%option
1201) field => realization%field
1202)
1203) mphase => patch%aux%Mphase
1204) mphase_parameter => mphase%mphase_parameter
1205) auxvars => mphase%auxvars
1206) global_auxvars => patch%aux%Global%auxvars
1207)
1208) if (option%use_mc) then
1209) mphase_sec_heat_vars => patch%aux%SC_heat%sec_heat_vars
1210) endif
1211)
1212) if (realization%option%compute_mass_balance_new) then
1213) call MphaseUpdateMassBalancePatch(realization)
1214) endif
1215)
1216) if (option%use_mc) then
1217)
1218) call VecGetArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
1219)
1220) ! Secondary continuum contribution (Added by SK 06/26/2012)
1221) ! only one secondary continuum for now for each primary continuum node
1222) do local_id = 1, grid%nlmax ! For each local node do...
1223) ghosted_id = grid%nL2G(local_id)
1224) if (associated(patch%imat)) then
1225) if (patch%imat(ghosted_id) <= 0) cycle
1226) endif
1227) iend = local_id*option%nflowdof
1228) istart = iend-option%nflowdof+1
1229)
1230) sec_dencpr = mphase_parameter%dencpr(int(ithrm_loc_p(ghosted_id))) ! secondary rho*c_p same as primary for now
1231)
1232) call MphaseSecHeatAuxVarCompute(mphase_sec_heat_vars(local_id), &
1233) auxvars(ghosted_id)%auxvar_elem(0), &
1234) global_auxvars(ghosted_id), &
1235) mphase_parameter%ckwet(int(ithrm_loc_p(ghosted_id))), &
1236) sec_dencpr, &
1237) option)
1238) enddo
1239)
1240) call VecRestoreArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
1241)
1242) endif
1243)
1244) end subroutine MphaseUpdateSolutionPatch
1245)
1246) ! ************************************************************************** !
1247)
1248) subroutine MphaseUpdateFixedAccumulation(realization)
1249) !
1250) ! Updates the fixed portion of the
1251) ! accumulation term
1252) !
1253) ! Author: Chuan Lu
1254) ! Date: 05/12/08
1255) !
1256)
1257) use Realization_Subsurface_class
1258) use Patch_module
1259)
1260) type(realization_subsurface_type) :: realization
1261)
1262) type(patch_type), pointer :: cur_patch
1263)
1264) cur_patch => realization%patch_list%first
1265) do
1266) if (.not.associated(cur_patch)) exit
1267) realization%patch => cur_patch
1268) call MphaseUpdateFixedAccumPatch(realization)
1269) cur_patch => cur_patch%next
1270) enddo
1271)
1272) end subroutine MphaseUpdateFixedAccumulation
1273)
1274) ! ************************************************************************** !
1275)
1276) subroutine MphaseUpdateFixedAccumPatch(realization)
1277) !
1278) ! Updates the fixed portion of the
1279) ! accumulation term
1280) !
1281) ! Author: Chuan Lu
1282) ! Date: 05/12/08
1283) !
1284)
1285) use Realization_Subsurface_class
1286) use Patch_module
1287) use Option_module
1288) use Field_module
1289) use Grid_module
1290) use Secondary_Continuum_Aux_module
1291) use Material_Aux_class
1292)
1293) implicit none
1294)
1295) type(realization_subsurface_type) :: realization
1296)
1297) type(option_type), pointer :: option
1298) type(patch_type), pointer :: patch
1299) type(grid_type), pointer :: grid
1300) type(field_type), pointer :: field
1301) type(mphase_parameter_type), pointer :: mphase_parameter
1302) type(mphase_auxvar_type), pointer :: auxvars(:)
1303) type(global_auxvar_type), pointer :: global_auxvars(:)
1304) type(sec_heat_type), pointer :: mphase_sec_heat_vars(:)
1305) class(material_auxvar_type), pointer :: material_auxvars(:)
1306)
1307) PetscInt :: ghosted_id, local_id, istart, iend !, iphase
1308) PetscReal, pointer :: xx_p(:), icap_loc_p(:), iphase_loc_p(:)
1309) PetscReal, pointer :: ithrm_loc_p(:), accum_p(:)
1310)
1311) PetscErrorCode :: ierr
1312) PetscReal :: vol_frac_prim
1313)
1314) call MphaseUpdateAuxVarsPatch(realization)
1315)
1316) option => realization%option
1317) field => realization%field
1318) patch => realization%patch
1319) grid => patch%grid
1320)
1321)
1322) mphase_parameter => patch%aux%Mphase%mphase_parameter
1323) auxvars => patch%aux%Mphase%auxvars
1324) global_auxvars => patch%aux%Global%auxvars
1325) mphase_sec_heat_vars => patch%aux%SC_heat%sec_heat_vars
1326) material_auxvars => patch%aux%Material%auxvars
1327)
1328) call VecGetArrayF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
1329) call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
1330) call VecGetArrayF90(field%iphas_loc,iphase_loc_p,ierr);CHKERRQ(ierr)
1331) call VecGetArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
1332)
1333) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
1334)
1335) vol_frac_prim = 1.d0
1336)
1337) do local_id = 1, grid%nlmax
1338) ghosted_id = grid%nL2G(local_id)
1339) !geh - Ignore inactive cells with inactive materials
1340) if (associated(patch%imat)) then
1341) if (patch%imat(ghosted_id) <= 0) cycle
1342) endif
1343) iend = local_id*option%nflowdof
1344) istart = iend-option%nflowdof+1
1345)
1346) if (option%use_mc) then
1347) vol_frac_prim = mphase_sec_heat_vars(local_id)%epsilon
1348) endif
1349)
1350) ! iphase = int(iphase_loc_p(ghosted_id))
1351) ! call MphaseAuxVarCompute_Ninc(xx_p(istart:iend), &
1352) ! auxvars(ghosted_id)%auxvar_elem(0), &
1353) ! iphase, &
1354) ! patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
1355) ! realization%fluid_properties,option)
1356) ! iphase_loc_p(ghosted_id) = iphase
1357) ! print *, 'MphaseUpdateFixedAccumPatch1'
1358) !if (.not.associated(auxvars(ghosted_id))) print *,'no var'
1359) if (.not.associated(mphase_parameter%dencpr)) print *,'no para'
1360)
1361) call MphaseAccumulation(auxvars(ghosted_id)%auxvar_elem(0), &
1362) global_auxvars(ghosted_id), &
1363) material_auxvars(ghosted_id)%porosity, &
1364) material_auxvars(ghosted_id)%volume, &
1365) mphase_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
1366) option,ZERO_INTEGER,vol_frac_prim, &
1367) accum_p(istart:iend))
1368) enddo
1369)
1370) call VecRestoreArrayF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
1371) call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
1372) call VecRestoreArrayF90(field%iphas_loc,iphase_loc_p,ierr);CHKERRQ(ierr)
1373) call VecRestoreArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
1374)
1375) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
1376)
1377) #if 0
1378) ! call MphaseNumericalJacobianTest(field%flow_xx,realization)
1379) #endif
1380)
1381) end subroutine MphaseUpdateFixedAccumPatch
1382)
1383) ! ************************************************************************** !
1384)
1385) subroutine MphaseAccumulation(auxvar,global_auxvar,por,vol,rock_dencpr, &
1386) option,iireac,vol_frac_prim,Res)
1387) !
1388) ! Computes the non-fixed portion of the accumulation
1389) ! term for the residual
1390) !
1391) ! Author: Chuan Lu
1392) ! Date: 05/12/08
1393) !
1394)
1395) use Option_module
1396)
1397) implicit none
1398)
1399) type(mphase_auxvar_elem_type) :: auxvar
1400) type(option_type) :: option
1401) PetscReal Res(1:option%nflowdof)
1402) PetscReal vol,por,rock_dencpr
1403) type(global_auxvar_type) :: global_auxvar
1404)
1405) PetscInt :: ispec, np, iireac
1406) PetscReal :: porXvol, mol(option%nflowspec), eng
1407) PetscReal :: vol_frac_prim
1408)
1409) ! if (present(ireac)) iireac=ireac
1410)
1411) porXvol = por*vol
1412)
1413) mol=0.d0; eng=0.D0
1414) do np = 1, option%nphase
1415) do ispec = 1, option%nflowspec
1416) mol(ispec) = mol(ispec) + auxvar%sat(np) * auxvar%den(np) * &
1417) auxvar%xmol(ispec + (np-1)*option%nflowspec)
1418) enddo
1419) eng = eng + auxvar%sat(np) * auxvar%den(np) * auxvar%u(np)
1420) enddo
1421) mol = mol * porXvol
1422) ! if (option%use_isothermal == PETSC_FALSE) &
1423) eng = eng * porXvol + (1.d0 - por) * vol * rock_dencpr * auxvar%temp
1424)
1425) ! Reaction terms here
1426) ! Note if iireac > 0, then it is the node global index
1427)
1428) !#if 0
1429) if (option%ntrandof > 0) then
1430) if (iireac > 0) then
1431) !H2O
1432) mol(1) = mol(1) + vol * global_auxvar%reaction_rate_store(1) &
1433) *option%flow_dt*1.D-3
1434)
1435) !CO2
1436) mol(2) = mol(2) + vol * global_auxvar%reaction_rate_store(2) &
1437) *option%flow_dt*1.D-3
1438) endif
1439) endif
1440) !#endif
1441) ! if (option%use_isothermal)then
1442) ! Res(1:option%nflowdof) = mol(:)
1443) ! else
1444) Res(1:option%nflowdof-1) = vol_frac_prim * mol(:)
1445) Res(option%nflowdof) = vol_frac_prim * eng
1446)
1447) ! endif
1448) end subroutine MphaseAccumulation
1449)
1450) ! ************************************************************************** !
1451)
1452) subroutine MphaseSourceSink(mmsrc,nsrcpara,psrc,tsrc,hsrc,csrc,auxvar,isrctype,Res, &
1453) qsrc_vol,energy_flag,option)
1454) !
1455) ! Computes the source/sink portion for the residual
1456) !
1457) ! Author: Chuan Lu
1458) ! Date: 05/12/08
1459) !
1460)
1461) use Option_module
1462)
1463) use EOS_Water_module
1464) ! use Gas_EOS_module
1465) use co2eos_module
1466) use co2_span_wagner_spline_module, only: sw_prop
1467) use co2_sw_module, only: co2_sw_interp
1468) use co2_span_wagner_module
1469)
1470) implicit none
1471)
1472) type(mphase_auxvar_elem_type) :: auxvar
1473) type(option_type) :: option
1474) PetscReal :: Res(1:option%nflowdof)
1475) PetscReal, pointer :: mmsrc(:)
1476) PetscReal :: psrc(option%nphase),tsrc,hsrc,csrc
1477) PetscInt :: isrctype
1478) PetscInt :: nsrcpara
1479) PetscBool :: energy_flag
1480) PetscReal :: qsrc_vol(option%nphase) ! volumetric rate of injection/extraction for each phase
1481)
1482) PetscReal, allocatable :: msrc(:)
1483) PetscReal :: dw_kg, dw_mol,dddt,dddp
1484) PetscReal :: enth_src_h2o, enth_src_co2
1485) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
1486) PetscReal :: ukvr, v_darcy, dq, dphi
1487) PetscReal :: well_status, well_diameter
1488) PetscReal :: pressure_bh, well_factor, pressure_max, pressure_min
1489) PetscReal :: well_inj_water, well_inj_co2
1490) PetscInt :: np
1491) PetscInt :: iflag
1492) PetscErrorCode :: ierr
1493)
1494) Res = 0.D0
1495) allocate(msrc(nsrcpara))
1496) msrc = mmsrc(1:nsrcpara)
1497)
1498) ! if (present(ireac)) iireac=ireac
1499) ! if (energy_flag) then
1500) ! Res(option%nflowdof) = Res(option%nflowdof) + hsrc * option%flow_dt
1501) ! endif
1502)
1503) qsrc_vol(:) = 0.d0
1504)
1505) select case(isrctype)
1506) case(MASS_RATE_SS)
1507) msrc(1) = msrc(1) / FMWH2O
1508) msrc(2) = msrc(2) / FMWCO2
1509) if (msrc(1) > 0.d0) then ! H2O injection
1510) call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr)
1511) call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr)
1512) ! J/kmol -> whatever units
1513) enth_src_h2o = enth_src_h2o * option%scale
1514)
1515) ! units: dw_mol [mol/dm^3]; dw_kg [kg/m^3]
1516) ! qqsrc = qsrc1/dw_mol ! [kmol/s (mol/dm^3 = kmol/m^3)]
1517) Res(jh2o) = Res(jh2o) + msrc(1)*(1.d0-csrc)*option%flow_dt
1518) Res(jco2) = Res(jco2) + msrc(1)*csrc*option%flow_dt
1519) if (energy_flag) Res(option%nflowdof) = Res(option%nflowdof) + &
1520) msrc(1)*enth_src_h2o*option%flow_dt
1521)
1522) ! print *,'soure/sink: ',msrc,csrc,enth_src_h2o,option%flow_dt,option%nflowdof
1523)
1524) ! store volumetric rate for ss_fluid_fluxes()
1525) qsrc_vol(1) = msrc(1)/dw_mol
1526) elseif (msrc(1) < 0.d0) then ! H2O extraction
1527) call EOSWaterDensity(auxvar%temp,auxvar%pres,dw_kg,dw_mol,ierr)
1528) call EOSWaterEnthalpy(auxvar%temp,auxvar%pres,enth_src_h2o,ierr)
1529) ! J/kmol -> whatever
1530) enth_src_h2o = enth_src_h2o * option%scale
1531) ! units: dw_mol [mol/dm^3]; dw_kg [kg/m^3]
1532) ! qqsrc = qsrc1/dw_mol ! [kmol/s (mol/dm^3 = kmol/m^3)]
1533) Res(jh2o) = Res(jh2o) + msrc(1)*(1.d0-csrc)*option%flow_dt
1534) Res(jco2) = Res(jco2) + msrc(1)*csrc*option%flow_dt
1535) if (energy_flag) Res(option%nflowdof) = Res(option%nflowdof) + &
1536) msrc(1)*enth_src_h2o*option%flow_dt
1537)
1538) ! print *,'soure/sink: ',msrc,csrc,enth_src_h2o,option%flow_dt,option%nflowdof
1539)
1540) ! store volumetric rate for ss_fluid_fluxes()
1541) qsrc_vol(1) = msrc(1)/dw_mol
1542) endif
1543)
1544) if (msrc(2) > 0.d0) then ! CO2 injection
1545) ! call printErrMsg(option,"concentration source not yet implemented in Mphase")
1546) if (option%co2eos == EOS_SPAN_WAGNER) then
1547) ! span-wagner
1548) rho = auxvar%den(jco2)*FMWCO2
1549) select case(option%itable)
1550) case(0,1,2,4,5)
1551) if (option%itable >=4) then
1552) call co2_sw_interp(auxvar%pres*1.D-6, &
1553) tsrc,rho,dddt,dddp,fg,dfgdp,dfgdt, &
1554) eng,enth_src_co2,dhdt,dhdp,visc,dvdt,dvdp,option%itable)
1555) else
1556) iflag = 1
1557) call co2_span_wagner(auxvar%pres*1.D-6, &
1558) tsrc+273.15D0,rho,dddt,dddp,fg,dfgdp,dfgdt, &
1559) eng,enth_src_co2,dhdt,dhdp,visc,dvdt,dvdp,iflag,option%itable)
1560) endif
1561) case(3)
1562) call sw_prop(tsrc,auxvar%pres*1.D-6,rho, &
1563) enth_src_co2, eng, fg)
1564) end select
1565)
1566) ! units: rho [kg/m^3]; csrc1 [kmol/s]
1567) enth_src_co2 = enth_src_co2 * FMWCO2
1568)
1569) ! store volumetric rate for ss_fluid_fluxes()
1570) ! qsrc_phase [m^3/sec] = msrc [kmol/sec] / [kmol/m^3]
1571) qsrc_vol(2) = msrc(2)/auxvar%den(jco2)
1572)
1573) else if (option%co2eos == EOS_MRK) then
1574) ! MRK eos [modified version from Kerrick and Jacobs (1981) and Weir et al. (1996).]
1575) call CO2(tsrc,auxvar%pres, rho,fg, xphi,enth_src_co2)
1576) !geh: this is never used as the conversion is performed inside
1577) ! reactive transport
1578) !qsrc_phase(2) = msrc(2)*rho/FMWCO2
1579) enth_src_co2 = enth_src_co2*FMWCO2*option%scale
1580) else
1581) call printErrMsg(option,'pflow mphase ERROR: Need specify CO2 EOS')
1582) endif
1583)
1584) Res(jco2) = Res(jco2) + msrc(2)*option%flow_dt
1585) if (energy_flag) Res(option%nflowdof) = Res(option%nflowdof) + msrc(2) * &
1586) enth_src_co2 *option%flow_dt
1587) endif
1588)
1589) case(WELL_SS) ! production well
1590) !if node pessure is lower than the given extraction pressure, shut it down
1591) ! Flow term
1592) ! well parameter explaination
1593) ! 1. well status. 1 injection; -1 production; 0 shut in
1594) ! 2 rate controled injection (same as rate_ss, with max pressure control, not completed yet)
1595) ! -2 rate controled production(not implemented for now)
1596) !
1597) ! 2. well factor [m^3], the effective permeability [m^2/s]
1598) ! 3. bottomhole pressure: [Pa]
1599) ! 4. max pressure: [Pa]
1600) ! 5. min pressure: [Pa]
1601) ! 6. conc. of water
1602) ! 7. conc. of Co2 (1 - conc. of water)
1603) ! 8. well diameter, not used now
1604) ! 9. skin factor, not used now
1605)
1606) well_status = msrc(1)
1607) well_factor = msrc(2)
1608) pressure_bh = msrc(3)
1609) pressure_max = msrc(4)
1610) pressure_min = msrc(5)
1611) well_inj_water = msrc(6)
1612) well_inj_co2 = msrc(7)
1613)
1614) ! if (pressure_min < 0D0) pressure_min = 0D0 !not limited by pressure lower bound
1615)
1616) ! production well (well status = -1)
1617) if ( dabs(well_status + 1.D0) < 1.D-1) then
1618) if (auxvar%pres > pressure_min) then
1619) Dq = well_factor
1620) do np = 1, option%nphase
1621) dphi = auxvar%pres - auxvar%pc(np) - pressure_bh
1622) if (dphi >= 0.D0) then ! outflow only
1623) ukvr = auxvar%kvr(np)
1624) if (ukvr < 1.e-20) ukvr = 0.D0
1625) v_darcy = 0.D0
1626) if (ukvr*Dq > floweps) then
1627) v_darcy = Dq * ukvr * dphi
1628) ! store volumetric rate for ss_fluid_fluxes()
1629) qsrc_vol(1) = -1.d0*v_darcy
1630) Res(1) = Res(1) - v_darcy* auxvar%den(np)* &
1631) auxvar%xmol((np-1)*option%nflowspec+1)*option%flow_dt
1632) Res(2) = Res(2) - v_darcy* auxvar%den(np)* &
1633) auxvar%xmol((np-1)*option%nflowspec+2)*option%flow_dt
1634) if (energy_flag) Res(3) = Res(3) - v_darcy * auxvar%den(np)* &
1635) auxvar%h(np)*option%flow_dt
1636) ! print *,'produce: ',np,v_darcy
1637) endif
1638) endif
1639) enddo
1640) endif
1641) endif
1642) !print *,'well-prod: ', auxvar%pres,psrc(1), res
1643) ! injection well (well status = 2)
1644) if ( dabs(well_status - 2.D0) < 1.D-1) then
1645)
1646) call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr)
1647) call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr)
1648) ! J/kmol -> whatever units
1649) enth_src_h2o = enth_src_h2o * option%scale
1650)
1651) Dq = msrc(2) ! well parameter, read in input file
1652) ! Take the place of 2nd parameter
1653) ! Flow term
1654) if ( auxvar%pres < pressure_max)then
1655) do np = 1, option%nphase
1656) dphi = pressure_bh - auxvar%pres + auxvar%pc(np)
1657) if (dphi >= 0.D0) then ! outflow only
1658) ukvr = auxvar%kvr(np)
1659) v_darcy = 0.D0
1660) if (ukvr*Dq>floweps) then
1661) v_darcy = Dq * ukvr * dphi
1662) ! store volumetric rate for ss_fluid_fluxes()
1663) qsrc_vol(1) = v_darcy
1664) Res(1) = Res(1) + v_darcy* auxvar%den(np)* &
1665) ! auxvar%xmol((np-1)*option%nflowspec+1) * option%flow_dt
1666) well_inj_water * option%flow_dt
1667) Res(2) = Res(2) + v_darcy* auxvar%den(np)* &
1668) ! auxvar%xmol((np-1)*option%nflowspec+2) * option%flow_dt
1669) well_inj_co2 * option%flow_dt
1670) ! if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)*auxvar%h(np)*option%flow_dt
1671) if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np) * &
1672) enth_src_h2o*option%flow_dt
1673)
1674) ! print *,'inject: ',np,v_darcy
1675) endif
1676) endif
1677) enddo
1678) endif
1679) endif
1680) case default
1681) print *,'Unrecognized Source/Sink condition: ', isrctype
1682) end select
1683) deallocate(msrc)
1684)
1685) end subroutine MphaseSourceSink
1686)
1687) ! ************************************************************************** !
1688)
1689) subroutine MphaseFlux(auxvar_up,por_up,tor_up,sir_up,dd_up,perm_up,Dk_up, &
1690) auxvar_dn,por_dn,tor_dn,sir_dn,dd_dn,perm_dn,Dk_dn, &
1691) area,dist_gravity,upweight, &
1692) option,vv_darcy,vol_frac_prim,Res)
1693) !
1694) ! Computes the internal flux terms for the residual
1695) !
1696) ! Author: Chuan Lu
1697) ! Date: 05/12/08
1698) !
1699) use Option_module
1700)
1701) implicit none
1702)
1703) type(mphase_auxvar_elem_type) :: auxvar_up, auxvar_dn
1704) type(option_type) :: option
1705) PetscReal :: sir_up(:), sir_dn(:)
1706) PetscReal :: por_up, por_dn
1707) PetscReal :: tor_up, tor_dn
1708) PetscReal :: dd_up, dd_dn
1709) PetscReal :: perm_up, perm_dn
1710) PetscReal :: Dk_up, Dk_dn
1711) PetscReal :: vv_darcy(:),area,vol_frac_prim
1712) PetscReal :: Res(1:option%nflowdof)
1713) PetscReal :: dist_gravity ! distance along gravity vector
1714)
1715) PetscInt :: ispec, np, ind
1716) PetscReal :: fluxm(option%nflowspec),fluxe,q, v_darcy
1717) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,difff,diffdp, DK,Dq
1718) PetscReal :: upweight,density_ave,cond,gravity,dphi
1719)
1720) Dq = (perm_up * perm_dn)/(dd_up*perm_dn + dd_dn*perm_up)
1721) #if 0
1722) ! This factor 2/3 is multiplied to get bulk perm k=delta^3/12/l, karra 05/14/2013
1723) if (option%use_mc) Dq = Dq*2.d0/3.d0*vol_frac_prim
1724) #endif
1725) diffdp = (por_up*tor_up * por_dn*tor_dn) / &
1726) (dd_dn*por_up*tor_up + dd_up*por_dn*tor_dn)*area*vol_frac_prim
1727)
1728) fluxm = 0.D0
1729) fluxe = 0.D0
1730) vv_darcy =0.D0
1731)
1732) ! Flow term
1733) do np = 1, option%nphase
1734)
1735) ! if (auxvar_up%sat(np) > sir_up(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
1736) if ((auxvar_up%kvr(np) + auxvar_dn%kvr(np)) > eps) then
1737) upweight = dd_dn/(dd_up+dd_dn)
1738) if (auxvar_up%sat(np) < eps) then
1739) upweight = 0.d0
1740) else if (auxvar_dn%sat(np) < eps) then
1741) upweight = 1.d0
1742) endif
1743) density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
1744)
1745) gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
1746) (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
1747) * dist_gravity
1748)
1749) dphi = auxvar_up%pres - auxvar_dn%pres &
1750) - auxvar_up%pc(np) + auxvar_dn%pc(np) &
1751) + gravity
1752)
1753) v_darcy = 0.D0
1754) ukvr = 0.D0
1755) uh = 0.D0
1756) uxmol = 0.D0
1757)
1758) ! note uxmol only contains one phase xmol
1759) ! upstream weighting
1760) if (dphi >= 0.D0) then
1761) ukvr = auxvar_up%kvr(np)
1762) ! if (option%use_isothermal == PETSC_FALSE) &
1763) uh = auxvar_up%h(np)
1764) uxmol(1:option%nflowspec) = &
1765) auxvar_up%xmol((np-1)*option%nflowspec + 1 : np*option%nflowspec)
1766) else
1767) ukvr = auxvar_dn%kvr(np)
1768) ! if (option%use_isothermal == PETSC_FALSE) &
1769) uh = auxvar_dn%h(np)
1770) uxmol(1:option%nflowspec) = &
1771) auxvar_dn%xmol((np-1)*option%nflowspec + 1 : np*option%nflowspec)
1772) endif
1773)
1774) if (ukvr > floweps) then
1775) v_darcy = Dq * ukvr * dphi
1776) vv_darcy(np) = v_darcy
1777) q = v_darcy * area
1778)
1779) do ispec=1, option%nflowspec
1780) fluxm(ispec)=fluxm(ispec) + q * density_ave * uxmol(ispec)
1781) enddo
1782) ! if (option%use_isothermal == PETSC_FALSE) &
1783) fluxe = fluxe + q*density_ave*uh
1784) endif
1785) endif
1786)
1787) ! Diffusion term
1788) ! Note : average rule may not be correct
1789)
1790) #ifdef PCL
1791)
1792) if ((auxvar_up%sat(np) >= 1.d0) .and. (auxvar_dn%sat(np) >= 1.d0) .or. &
1793) (auxvar_up%sat(np) <= 0.d0) .and. (auxvar_dn%sat(np) <= 0.d0) &
1794) ) then
1795) ! single phase
1796) difff = diffdp * 0.25D0*(auxvar_up%sat(np) + auxvar_dn%sat(np))* &
1797) (auxvar_up%den(np) + auxvar_dn%den(np))
1798) do ispec=1, option%nflowspec
1799) ind = ispec + (np-1)*option%nflowspec
1800) fluxm(ispec) = fluxm(ispec) + difff * .5D0 * &
1801) (auxvar_up%diff(ind) + auxvar_dn%diff(ind))* &
1802) (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
1803) ! print *,'mphaseflux1: ',ind,auxvar_up%diff(ind),auxvar_dn%diff(ind)
1804) enddo
1805)
1806) else
1807)
1808) ! two-phase
1809) difff = diffdp * 0.5D0*(auxvar_up%den(np) + auxvar_dn%den(np))
1810) do ispec=1, option%nflowspec
1811) ind = ispec + (np-1)*option%nflowspec
1812)
1813) if (auxvar_up%xmol(ind) > auxvar_dn%xmol(ind)) then
1814) upweight = 1.d0
1815) else
1816) upweight = 0.d0
1817) endif
1818)
1819) fluxm(ispec) = fluxm(ispec) + difff * &
1820) 0.5D0 * (auxvar_up%diff(ind) + auxvar_dn%diff(ind))* &
1821) (upweight*auxvar_up%sat(np)+(1.d0-upweight)*auxvar_dn%sat(np))* &
1822) (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
1823) ! print *,'mphaseflux1: ',ind,auxvar_up%diff(ind),auxvar_dn%diff(ind)
1824) enddo
1825) endif
1826)
1827) #else
1828)
1829) ! print *,'mphaseflux: ',np,auxvar_up%sat(np),auxvar_dn%sat(np),eps, &
1830) ! auxvar_up%den(np),auxvar_dn%den(np),diffdp
1831)
1832) if ((auxvar_up%sat(np) > eps) .and. (auxvar_dn%sat(np) > eps)) then
1833) difff = diffdp * 0.25D0*(auxvar_up%sat(np) + auxvar_dn%sat(np))* &
1834) (auxvar_up%den(np) + auxvar_dn%den(np))
1835) do ispec=1, option%nflowspec
1836) ind = ispec + (np-1)*option%nflowspec
1837) fluxm(ispec) = fluxm(ispec) + difff * .5D0 * &
1838) (auxvar_up%diff(ind) + auxvar_dn%diff(ind))* &
1839) (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
1840) ! print *,'mphaseflux1: ',ind,auxvar_up%diff(ind),auxvar_dn%diff(ind)
1841) enddo
1842) endif
1843)
1844) #endif
1845)
1846) enddo
1847)
1848) ! conduction term
1849) !if (option%use_isothermal == PETSC_FALSE) then
1850) Dk = (Dk_up * Dk_dn) / (dd_dn*Dk_up + dd_up*Dk_dn)
1851) cond = vol_frac_prim * Dk*area * (auxvar_up%temp-auxvar_dn%temp)
1852) fluxe = fluxe + cond
1853) ! end if
1854)
1855) !if (option%use_isothermal)then
1856) ! Res(1:option%nflowdof) = fluxm(:) * option%flow_dt
1857) ! else
1858) Res(1:option%nflowdof-1) = fluxm(:) * option%flow_dt
1859) Res(option%nflowdof) = fluxe * option%flow_dt
1860) ! end if
1861) ! note: Res is the flux contribution, for node 1 R = R + Res_FL
1862) ! 2 R = R - Res_FL
1863)
1864) end subroutine MphaseFlux
1865)
1866) ! ************************************************************************** !
1867)
1868) subroutine MphaseBCFlux(ibndtype,auxvars,auxvar_up,auxvar_dn, &
1869) por_dn,tor_dn,sir_dn,dd_up,perm_dn,Dk_dn, &
1870) area,dist_gravity,option,vv_darcy,vol_frac_prim,Res)
1871) !
1872) ! Computes boundary flux terms for the residual function
1873) !
1874) ! Author: Chuan Lu
1875) ! Date: 05/12/08
1876) !
1877) use Option_module
1878)
1879) implicit none
1880)
1881) PetscInt :: ibndtype(:)
1882) type(mphase_auxvar_elem_type) :: auxvar_up, auxvar_dn
1883) type(option_type) :: option
1884) PetscReal :: dd_up, sir_dn(:)
1885) PetscReal :: auxvars(:) ! from aux_real_var array
1886) PetscReal :: por_dn,perm_dn,Dk_dn,tor_dn
1887) PetscReal :: vv_darcy(:), area, vol_frac_prim
1888) PetscReal :: Res(1:option%nflowdof)
1889)
1890) PetscReal :: dist_gravity ! distance along gravity vector
1891)
1892) PetscInt :: ispec, np
1893) PetscReal :: fluxm(option%nflowspec),fluxe,q,density_ave, v_darcy
1894) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,diff,diffdp,DK,Dq
1895) PetscReal :: upweight,cond,gravity,dphi
1896) PetscReal :: Neuman_total_mass_flux, Neuman_mass_flux_spec(option%nflowspec)
1897) PetscReal :: mol_total_flux(option%nphase)
1898) PetscInt :: pressure_bc_type
1899)
1900) fluxm = 0.d0
1901) fluxe = 0.d0
1902) v_darcy = 0.d0
1903) vv_darcy = 0.d0
1904) density_ave = 0.d0
1905) q = 0.d0
1906) ukvr = 0.d0
1907) uh = 0.d0
1908)
1909) mol_total_flux = 0.d0
1910) uxmol = 0.d0
1911)
1912) diffdp = por_dn*tor_dn/dd_up*area*vol_frac_prim
1913)
1914) ! Flow
1915) do np = 1, option%nphase
1916) pressure_bc_type = ibndtype(MPH_PRESSURE_DOF)
1917)
1918) select case(ibndtype(MPH_PRESSURE_DOF))
1919) ! figure out the direction of flow
1920) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
1921) Dq = perm_dn / dd_up
1922) #if 0
1923) ! This factor 2/3 is multiplied to get bulk perm k=delta^3/12/l, karra 05/14/2013
1924) if (option%use_mc) Dq = Dq*2.d0/3.d0*vol_frac_prim
1925) #endif
1926) ! Flow term
1927) ukvr = 0.D0
1928) v_darcy = 0.D0
1929)
1930) ! print *,'Seepage BC: pc/sat ',np, &
1931) ! auxvar_up%pc(np),auxvar_dn%pc(np),auxvar_up%sat(np),auxvar_dn%sat(np)
1932)
1933) ! if (auxvar_up%sat(np) > sir_dn(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
1934) if ((auxvar_up%kvr(np) + auxvar_dn%kvr(np)) > eps) then
1935) upweight = 1.D0
1936) if (auxvar_up%sat(np) < eps) then
1937) upweight = 0.d0
1938) else if (auxvar_dn%sat(np) < eps) then
1939) upweight = 1.d0
1940) endif
1941) density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
1942)
1943) gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
1944) (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
1945) * dist_gravity
1946)
1947) dphi = auxvar_up%pres - auxvar_dn%pres &
1948) - auxvar_up%pc(np) + auxvar_dn%pc(np) + gravity
1949)
1950) ! print *,'Seepage BC: press ',np,auxvar_up%pres,auxvar_dn%pres,dphi,gravity
1951)
1952) if ((pressure_bc_type == SEEPAGE_BC .or. &
1953) pressure_bc_type == CONDUCTANCE_BC ) .and. np == 2) then
1954) ! flow in ! boundary cell is <= pref
1955) if (dphi > 0.d0) then
1956) dphi = 0.d0
1957) endif
1958) endif
1959)
1960) if (dphi >= 0.D0) then
1961) ukvr = auxvar_up%kvr(np)
1962) else
1963) ukvr = auxvar_dn%kvr(np)
1964) endif
1965)
1966) if (ukvr*Dq > floweps) then
1967) v_darcy = Dq * ukvr * dphi
1968) endif
1969)
1970) ! print *,'Seepage: vD/kvr/dphi ',np,V_darcy,ukvr,Dq,dphi
1971) endif
1972)
1973) q = v_darcy * area
1974) vv_darcy(np) = v_darcy
1975)
1976) uh = 0.D0
1977) uxmol = 0.D0
1978) mol_total_flux(np) = q*density_ave
1979) if (v_darcy >= 0.D0) then
1980) ! if (option%use_isothermal == PETSC_FALSE) &
1981) uh = auxvar_up%h(np)
1982) uxmol(:) = auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1983) else
1984) ! if (option%use_isothermal == PETSC_FALSE) &
1985) uh = auxvar_dn%h(np)
1986) uxmol(:) = auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1987) endif
1988)
1989)
1990) case(NEUMANN_BC)
1991) v_darcy = 0.D0
1992) if (dabs(auxvars(1)) > floweps) then
1993) Neuman_total_mass_flux = auxvars(MPH_PRESSURE_DOF)
1994) if (v_darcy > 0.d0) then
1995) density_ave = auxvar_up%den(np)
1996) else
1997) density_ave = auxvar_dn%den(np)
1998) endif
1999) if (np == 1) then
2000) Neuman_mass_flux_spec(np) = &
2001) Neuman_total_mass_flux * (1.D0-auxvars(MPH_CONCENTRATION_DOF))
2002) uxmol(1) = 1.D0; uxmol(2)=0.D0
2003) mol_total_flux(np) = Neuman_mass_flux_spec(np)/FMWH2O
2004) uh = auxvar_dn%h(np)
2005) else
2006) Neuman_mass_flux_spec(np) = &
2007) Neuman_total_mass_flux * auxvars(MPH_CONCENTRATION_DOF)
2008) uxmol(1) = 0.D0; uxmol(2) = 1.D0
2009) mol_total_flux(np) = Neuman_mass_flux_spec(np)/FMWCO2
2010) uh = auxvar_dn%h(np)
2011) endif
2012) vv_darcy(np) = mol_total_flux(np)/density_ave
2013) endif
2014)
2015) case(ZERO_GRADIENT_BC)
2016)
2017) end select
2018)
2019) do ispec=1, option%nflowspec
2020) fluxm(ispec) = fluxm(ispec) + mol_total_flux(np)*uxmol(ispec)
2021) enddo
2022) !if (option%use_isothermal == PETSC_FALSE) &
2023) fluxe = fluxe + mol_total_flux(np)*uh
2024) ! print *,'FLBC', ibndtype(1),np, ukvr, v_darcy, uh, uxmol, mol_total_flux
2025) enddo
2026)
2027) ! Diffusion term
2028) select case(ibndtype(MPH_CONCENTRATION_DOF))
2029) case(DIRICHLET_BC)
2030) ! if (auxvar_up%sat > eps .and. auxvar_dn%sat > eps) then
2031) !diff = diffdp * 0.25D0*(auxvar_up%sat+auxvar_dn%sat)*(auxvar_up%den+auxvar_dn%den)
2032) do np = 1, option%nphase
2033) if (auxvar_up%sat(np)>eps .and. auxvar_dn%sat(np) > eps) then
2034) diff = diffdp * 0.25D0*(auxvar_up%sat(np)+auxvar_dn%sat(np))* &
2035) (auxvar_up%den(np)+auxvar_up%den(np))
2036) do ispec = 1, option%nflowspec
2037) fluxm(ispec) = fluxm(ispec) + &
2038) diff * auxvar_dn%diff((np-1)* option%nflowspec+ispec)* &
2039) (auxvar_up%xmol((np-1)* option%nflowspec+ispec) &
2040) -auxvar_dn%xmol((np-1)* option%nflowspec+ispec))
2041) enddo
2042) endif
2043) enddo
2044)
2045) end select
2046)
2047) ! Conduction term
2048) ! if (option%use_isothermal == PETSC_FALSE) then
2049) select case(ibndtype(MPH_TEMPERATURE_DOF))
2050) case(DIRICHLET_BC)
2051) Dk = Dk_dn / dd_up
2052) cond = vol_frac_prim * Dk*area*(auxvar_up%temp - auxvar_dn%temp)
2053) fluxe = fluxe + cond
2054) case(NEUMANN_BC)
2055) fluxe = fluxe + auxvars(MPH_TEMPERATURE_DOF)*area*option%scale
2056) ! auxvars(MPH_TEMPERATURE_DOF) stores heat flux, 1.d-6 is to convert
2057) ! from W to MW, Added by Satish Karra, LANL 10/05/11
2058) case(ZERO_GRADIENT_BC)
2059) ! No change in fluxe
2060) end select
2061) ! print *, fluxe, auxvars
2062) ! end if
2063)
2064) Res(1:option%nflowspec) = fluxm(:) * option%flow_dt
2065) Res(option%nflowdof) = fluxe * option%flow_dt
2066)
2067) end subroutine MphaseBCFlux
2068)
2069) ! ************************************************************************** !
2070)
2071) subroutine MphaseResidual(snes,xx,r,realization,ierr)
2072) !
2073) ! Computes the residual equation
2074) !
2075) ! Author: Glenn Hammond
2076) ! Date: 12/10/07
2077) !
2078)
2079) use Realization_Subsurface_class
2080) use Patch_module
2081) use Discretization_module
2082) use Field_module
2083) use Option_module
2084) use Grid_module
2085) use Material_module
2086) use Variables_module, only : PERMEABILITY_X, PERMEABILITY_Y, PERMEABILITY_Z
2087)
2088) implicit none
2089)
2090) SNES :: snes
2091) Vec :: xx
2092) Vec :: r
2093) type(realization_subsurface_type) :: realization
2094) PetscErrorCode :: ierr
2095)
2096) type(discretization_type), pointer :: discretization
2097) type(option_type), pointer :: option
2098) type(grid_type), pointer :: grid
2099) type(field_type), pointer :: field
2100) type(patch_type), pointer :: patch
2101) PetscInt :: ichange, i
2102)
2103) field => realization%field
2104) grid => realization%patch%grid
2105) option => realization%option
2106) discretization => realization%discretization
2107) patch => realization%patch
2108)
2109) ! call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
2110) call DiscretizationLocalToLocal(discretization,field%iphas_loc,field%iphas_loc,ONEDOF)
2111) ! check initial guess -----------------------------------------------
2112) ierr = MphaseInitGuessCheck(realization)
2113) if (ierr<0)then
2114) !ierr = PETSC_ERR_ARG_OUTOFRANGE
2115) if (option%myrank==0) print *,'table out of range: ',ierr
2116) call SNESSetFunctionDomainError(snes,ierr);CHKERRQ(ierr)
2117) return
2118) endif
2119) ! end check ---------------------------------------------------------
2120)
2121)
2122) ! Variable switching-------------------------------------------------
2123) call MphaseVarSwitchPatch(xx, realization, ZERO_INTEGER, ichange)
2124) call MPI_Allreduce(ichange,i,ONE_INTEGER_MPI,MPIU_INTEGER, &
2125) MPI_MIN,option%mycomm,ierr)
2126) ichange = i
2127) if (ichange < 0) then
2128) call SNESSetFunctionDomainError(snes,ierr);CHKERRQ(ierr)
2129) return
2130) endif
2131) ! end switching ------------------------------------------------------
2132)
2133) ! Communication -----------------------------------------
2134) ! These 3 must be called before MphaseUpdateAuxVars()
2135) call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
2136) call DiscretizationLocalToLocal(discretization,field%iphas_loc,field%iphas_loc,ONEDOF)
2137) call DiscretizationLocalToLocal(discretization,field%icap_loc,field%icap_loc,ONEDOF)
2138)
2139) call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2140) PERMEABILITY_X,ZERO_INTEGER)
2141) call DiscretizationLocalToLocal(discretization,field%work_loc, &
2142) field%work_loc,ONEDOF)
2143) call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2144) PERMEABILITY_X,ZERO_INTEGER)
2145) call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2146) PERMEABILITY_Y,ZERO_INTEGER)
2147) call DiscretizationLocalToLocal(discretization,field%work_loc, &
2148) field%work_loc,ONEDOF)
2149) call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2150) PERMEABILITY_Y,ZERO_INTEGER)
2151) call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2152) PERMEABILITY_Z,ZERO_INTEGER)
2153) call DiscretizationLocalToLocal(discretization,field%work_loc, &
2154) field%work_loc,ONEDOF)
2155) call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2156) PERMEABILITY_Z,ZERO_INTEGER)
2157)
2158) call DiscretizationLocalToLocal(discretization,field%ithrm_loc,field%ithrm_loc,ONEDOF)
2159)
2160) call MphaseResidualPatch(snes,xx,r,realization,ierr)
2161)
2162) end subroutine MphaseResidual
2163)
2164) ! ************************************************************************** !
2165)
2166) subroutine MphaseVarSwitchPatch(xx, realization, icri, ichange)
2167) !
2168) ! Computes the residual equation at patch level
2169) !
2170) ! Author: Chuan Lu
2171) ! Date: 3/10/08
2172) !
2173)
2174) use Realization_Subsurface_class
2175) use Option_module
2176) use Field_module
2177) use Grid_module
2178) use Patch_module
2179)
2180) use EOS_Water_module
2181) use Gas_EOS_module
2182) use co2eos_module
2183) use co2_span_wagner_spline_module, only: sw_prop
2184) use co2_sw_module, only: co2_sw_interp
2185) use co2_span_wagner_module
2186)
2187) implicit none
2188)
2189) type(realization_subsurface_type) :: realization
2190)
2191) Vec, intent(in) :: xx
2192) PetscInt :: icri,ichange
2193)
2194) PetscReal, pointer :: xx_p(:), yy_p(:),iphase_loc_p(:)
2195) PetscReal :: den(realization%option%nphase)
2196) PetscInt :: ipr
2197) PetscInt :: iipha
2198) PetscErrorCode :: ierr
2199) ! PetscInt :: index,i
2200) PetscReal :: p2,p,tmp,t
2201) PetscReal :: dg,dddt,dddp,fg,dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp
2202) PetscReal :: ug,xphi,henry,sat_pressure
2203) PetscReal :: k1, k2, z1, z2, xg, vmco2, vmh2o, sg, sgg
2204) PetscReal :: xmol(realization%option%nphase*realization%option%nflowspec),&
2205) satu(realization%option%nphase)
2206) PetscReal :: yh2o_in_co2 = 1.d-2
2207) ! PetscReal :: yh2o_in_co2 = 0.d0
2208) PetscReal :: wat_sat_x, co2_sat_x
2209) PetscReal :: lngamco2, m_na, m_cl, m_nacl, Qkco2, mco2, xco2eq, temp
2210) ! PetscReal :: xla,co2_poyn
2211) PetscInt :: local_id, ghosted_id, dof_offset
2212) PetscInt :: iflag
2213) PetscInt :: idum
2214) PetscReal :: min_value
2215)
2216) type(grid_type), pointer :: grid
2217) type(option_type), pointer :: option
2218) type(field_type), pointer :: field
2219) type(patch_type), pointer :: patch
2220) type(global_auxvar_type), pointer :: global_auxvars(:)
2221)
2222) ! xmol(1) = X_H2O^l
2223) ! xmol(2) = X_CO2^l
2224) ! xmol(3) = X_H2O^g = Psat(T)/P_g
2225) ! xmol(4) = X_CO2^g = (1-Psat(T))/P_g
2226)
2227) patch => realization%patch
2228) grid => patch%grid
2229) option => realization%option
2230) field => realization%field
2231) global_auxvars => patch%aux%Global%auxvars
2232)
2233) #if 0
2234) option%force_newton_iteration = PETSC_FALSE
2235) ! checking for negative saturation/mole fraction
2236) call VecStrideMin(xx,TWO_INTEGER,idum,min_value,ierr);CHKERRQ(ierr)
2237) if (min_value < 0.d0) then
2238) write(option%io_buffer,*) 'Warning: saturation or mole fraction negative at cell ', &
2239) idum, min_value
2240) call printMsg(option)
2241) option%force_newton_iteration = PETSC_TRUE
2242) endif
2243) #endif
2244)
2245) ! mphase code need assemble
2246) call VecLockPop(xx,ierr); CHKERRQ(ierr)
2247) call VecGetArrayF90(xx, xx_p, ierr);CHKERRQ(ierr)
2248) call VecLockPush(xx,ierr); CHKERRQ(ierr)
2249) call VecGetArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
2250) call VecGetArrayF90(field%iphas_loc, iphase_loc_p,ierr);CHKERRQ(ierr)
2251)
2252) ichange = 0
2253) do local_id = 1,grid%nlmax
2254) ghosted_id = grid%nL2G(local_id)
2255) if (associated(patch%imat)) then
2256) if (patch%imat(ghosted_id) <= 0) cycle
2257) endif
2258) ipr=0
2259) dof_offset=(local_id-1)* option%nflowdof
2260) iipha=int(iphase_loc_p(ghosted_id))
2261) p = xx_p(dof_offset+1)
2262) t = xx_p(dof_offset+2)
2263) den(1:option%nphase) = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%den(1:option%nphase)
2264) select case(iipha)
2265) case(1) ! liquid
2266) xmol(2) = xx_p(dof_offset+3)
2267) xmol(1) = 1.D0 - xmol(2)
2268) satu(1) = 1.D0; satu(2) = 0.D0
2269) case(2) ! gas
2270) xmol(4) = xx_p(dof_offset+3)
2271) xmol(3) = 1.D0 - xmol(4)
2272) satu(1) = 0.d0; satu(2) = 1.D0
2273) case(3) ! two-phase
2274) satu(2) = xx_p(dof_offset+3)
2275) satu(1) = 1.D0 - satu(2)
2276) xmol(3) = yh2o_in_co2; xmol(4) = 1.D0-xmol(3)
2277) end select
2278)
2279) ! Pure CO2 phase properties ------------------------------------------
2280) p2 = p
2281) ! p2 = p*xmol(4)
2282) if (p2 >= 5.d4) then
2283) if (option%co2eos == EOS_SPAN_WAGNER) then
2284) select case(option%itable)
2285) case(0,1,2,4,5)
2286) if (option%itable >=4) then
2287) call co2_sw_interp(p2*1.D-6,t,dg,dddt,dddp,fg, &
2288) dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,option%itable)
2289) else
2290) iflag = 1
2291) call co2_span_wagner(p2*1.D-6,t+273.15D0,dg,dddt,dddp,fg, &
2292) dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,iflag,option%itable)
2293) if (iflag < 1) then
2294) ichange = -1
2295) return
2296) endif
2297) endif
2298) dg = dg / FMWCO2
2299) fg = fg * 1.D6
2300) hg = hg * FMWCO2
2301) ! Span-Wagner EOS with Bi-Cubic Spline interpolation
2302) case(3)
2303) call sw_prop(t,p2*1D-6,dg,hg, eng, fg)
2304) dg = dg / FMWCO2
2305) fg = fg * 1.D6
2306) hg = hg * FMWCO2
2307) end select
2308) elseif (option%co2eos == EOS_MRK) then
2309) ! MRK eos [modified version from Kerrick and Jacobs (1981) and Weir et al. (1996).]
2310) call CO2( t,p2, dg,fg, xphi, hg)
2311) dg = dg / FMWCO2
2312) hg = hg * FMWCO2 *option%scale
2313) endif
2314) else
2315) call ideal_gaseos_noderiv(p2,t,dg,hg,ug)
2316) ! J/kmol -> whatever
2317) hg = hg * option%scale
2318) ug = ug * option%scale
2319) fg = p2
2320) endif
2321)
2322) xphi = fg/p2
2323) call EOSWaterSaturationPressure(t, sat_pressure, ierr)
2324) sat_pressure = sat_pressure/1.D5
2325)
2326) m_na=option%m_nacl; m_cl=m_na; m_nacl = m_na
2327) if (associated(realization%reaction)) then
2328) if (associated(realization%reaction%species_idx)) then
2329) if (realization%reaction%species_idx%na_ion_id /= 0 .and. &
2330) realization%reaction%species_idx%cl_ion_id /= 0) then
2331) m_na = global_auxvars(ghosted_id)%m_nacl(1)
2332) m_cl = global_auxvars(ghosted_id)%m_nacl(2)
2333) m_nacl = m_na
2334) if (m_cl > m_na) m_nacl = m_cl
2335) endif
2336) endif
2337) endif
2338)
2339) call Henry_duan_sun(t,p2*1.D-5,henry,lngamco2,m_na,m_cl)
2340)
2341) Qkco2 = henry*xphi ! QkCO2 = xphi * exp(-mu0) / gamma
2342)
2343) sat_pressure = sat_pressure * 1.D5
2344) mco2 = (p - sat_pressure)*1.D-5 * Qkco2 ! molality CO2, y * P = P - Psat(T)
2345)
2346) xco2eq = mco2/(1.D3/fmwh2o + mco2 + m_nacl) ! mole fraction CO2
2347)
2348) henry = 1.D8 / FMWH2O / henry / xphi !note: henry = H/phi
2349) wat_sat_x = sat_pressure/p ! X_w^sc
2350) co2_sat_x = (1.D0-wat_sat_x)/(henry/p-wat_sat_x)*henry/p ! xmol(4) = xmol(2)*henry/p
2351)
2352) ! tmp = 1.D0-tmp ! approximate form
2353)
2354) select case(icri) ! icri = 0 in call statement
2355) case(0)
2356) select case(iipha)
2357) case(1) ! liquid
2358) xmol(4) = xmol(2)*henry/p
2359)
2360) ! print *,'phase chg: ',xmol(2),xco2eq,mco2,m_nacl,p,t
2361)
2362) ! if (xmol(4)+ wat_sat_x > 1.05d0) then
2363) ! if (xmol(2) > xco2eq) then
2364) if (xmol(2) >= xco2eq) then
2365)
2366) ! Rachford-Rice initial guess: 1=H2O, 2=CO2
2367) k1 = wat_sat_x !sat_pressure*1.D5/p
2368) k2 = henry/p
2369) z1 = xmol(1); z2 = xmol(2)
2370) xg = ((1.d0-k2)*z2+(1.d0-k1)*z1)/((1.d0-k2)*(1.d0-k1)*(z1+z2))
2371) vmco2 = 1.d0/dg
2372) vmh2o = 1.D0 /den(1) ! FMWH2O/0.9d3
2373)
2374) ! calculate initial guess for sg
2375) sg = vmco2*xg/(vmco2*xg+vmh2o*(1.d0-xg))
2376) if (sg > 1.D-4) then
2377) write(*,'('' Liq -> 2ph '',''rank='',i6,'' n='',i8,'' p='',1pe10.4, &
2378) & '' T='',1pe10.4,'' Xl='',1pe11.4, &
2379) & '' Xco2eq='',1pe11.4,'' sg='',1pe11.4)') &
2380) option%myrank,local_id,xx_p(dof_offset+1:dof_offset+3),xco2eq,sg
2381)
2382) iphase_loc_p(ghosted_id) = 3 ! Liq -> 2ph
2383)
2384) ! write(*,'(''Rachford-Rice: '','' z1, z2='', &
2385) ! & 1p2e12.4,'' xeq='',1pe12.4,'' xg='',1pe12.4, &
2386) ! & '' sg='',1pe12.4)') z1,z2,xco2eq,xg,sg
2387)
2388) ! write(*,'(''Rachford-Rice: '',''K1,2='',1p2e12.4,'' z1,2='', &
2389) ! & 1p2e12.4,'' xeq='',1pe12.4,'' xg='',1pe12.4, &
2390) ! & '' sg='',1pe12.4,'' dg='',1p2e12.4)') &
2391) ! k1,k2,z1,z2,xco2eq,xg,sg,den(1),dg
2392)
2393) ! sgg = den(1)*(z2-xco2eq)/(den(1)*(z2-xco2eq) - &
2394) ! dg*(z2-(1.d0-wat_sat_x)))
2395) ! write(*,'(''Rachford-Rice: sg = '',1p2e12.4)') sgg,sg
2396)
2397) xx_p(dof_offset+3) = sg
2398) ichange = 1
2399) endif
2400) endif
2401)
2402) case(2) ! gas
2403)
2404) ! if (xmol(3) > wat_sat_x * 1.05d0) then
2405) if (xmol(3) > wat_sat_x * 1.001d0) then
2406)
2407) ! print *,'gas -> 2ph: ',xmol(3),wat_sat_x,xco2eq,sat_pressure
2408)
2409) ! if (xmol(3) > (1.d0+1.d-6)*tmp .and. iipha==2) then
2410) write(*,'('' Gas -> 2ph '',''rank='',i6,'' n='',i8, &
2411) & '' p= '',1pe10.4,'' T= '',1pe10.4,'' Xg= '',1pe11.4,'' Ps/P='', 1pe11.4)') &
2412) option%myrank,local_id,xx_p(dof_offset+1:dof_offset+3),wat_sat_x
2413)
2414) iphase_loc_p(ghosted_id) = 3 ! Gas -> 2ph
2415) xx_p(dof_offset+3) = 1.D0-formeps
2416) ! xx_p(dof_offset+3) = 1.D0
2417) ichange = 1
2418) endif
2419)
2420) case(3) ! two-phase
2421) tmp = wat_sat_x
2422)
2423) ! xmol(2)= (1.D0-tmp)/(Henry/p-tmp) ! solve: x1+x2=1, y1+y2=1, y1=k1*x1, y2=k2*x2
2424) ! xmol(2)= p*(1.D0-tmp)/Henry ! approximate form
2425) ! xmol(1)= 1.D0-xmol(2)
2426) ! xmol(3)= xmol(1)*tmp
2427) ! xmol(4)= 1.D0-xmol(3)
2428)
2429) xmol(1) = 1.D0 - xco2eq ! x_h2o^h2o
2430) xmol(2) = xco2eq ! x_co2^h2o
2431) xmol(3) = tmp ! x_h2o^co2
2432) xmol(4) = 1.D0 - tmp ! x_co2^co2
2433)
2434) ! if (satu(2) >= 1.D0) then
2435) ! if (satu(2) >= 1.01D0) then
2436) if (satu(2) >= 1.001D0) then
2437)
2438) write(*,'('' 2ph -> Gas '',''rank='',i6,'' n='',i8, &
2439) & '' p='',1pe10.4,'' T='',1pe10.4,'' sg='',1pe11.4)') &
2440) option%myrank,local_id,xx_p(dof_offset+1:dof_offset+3)
2441)
2442) iphase_loc_p(ghosted_id) = 2 ! 2ph -> Gas
2443) ! xx_p(dof_offset+3) = 1.D0 - 1.D-8
2444) xx_p(dof_offset+3) = 1.D0
2445) ichange = 1
2446)
2447) else if (satu(2) <= 0.D0) then
2448)
2449) write(*,'('' 2ph -> Liq '',''rank= '',i6,'' n='',i8,'' p='',1pe10.4, &
2450) & '' T='',1pe10.4,'' sg ='',1pe11.4,'' Xco2eq='',1pe11.4)') &
2451) option%myrank,local_id, xx_p(dof_offset+1:dof_offset+3),xmol(2)
2452)
2453) iphase_loc_p(ghosted_id) = 1 ! 2ph -> Liq
2454) ichange = 1
2455) tmp = xmol(2) * 0.99
2456) xx_p(dof_offset+3) = tmp
2457) endif
2458)
2459) end select
2460)
2461) case(1)
2462)
2463) select case(iipha)
2464) case(2)
2465) if (xmol(3) > wat_sat_x) then
2466) ! write(*,'(''** Gas -> 2ph '',i8,1p10e12.4)') local_id, &
2467) ! xx_p(dof_offset+1:dof_offset+3)
2468) endif
2469) case(1)
2470) xmol(4) = xmol(2)*henry/p
2471) if (xmol(4) >co2_sat_x ) then
2472) ! write(*,'(''** Liq -> 2ph '',i8,1p10e12.4)') local_id, &
2473) ! xx_p(dof_offset+1:dof_offset+3),xmol(4), co2_sat_x
2474) endif
2475) case(3)
2476) if (satu(2) > 1.D0 .and. iipha == 3) then
2477) ! write(*,'(''** 2ph -> Gas '',i8,1p10e12.4)') local_id, &
2478) ! xx_p(dof_offset+1:dof_offset+3)
2479) endif
2480) if (satu(2) <= 0.D0 .and. iipha == 3) then
2481) ! write(*,'(''** 2ph -> Liq '',i8,1p10e12.4)') local_id, &
2482) ! xx_p(dof_offset+1:dof_offset+3),satu(1),satu(2)
2483) endif
2484) end select
2485) end select
2486) enddo
2487)
2488) call VecRestoreArrayReadF90(xx, xx_p, ierr);CHKERRQ(ierr)
2489) call VecRestoreArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
2490) call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p,ierr);CHKERRQ(ierr)
2491)
2492) end subroutine MphaseVarSwitchPatch
2493)
2494) ! ************************************************************************** !
2495)
2496) subroutine MphaseResidualPatch(snes,xx,r,realization,ierr)
2497) !
2498) ! Computes the residual equation at patch level
2499) !
2500) ! Author: Glenn Hammond
2501) ! Date: 12/10/07
2502) !
2503)
2504) use Connection_module
2505) use Realization_Subsurface_class
2506) use Patch_module
2507) use Grid_module
2508) use Option_module
2509) use Coupler_module
2510) use Field_module
2511) use Debug_module
2512) use Secondary_Continuum_Aux_module
2513) use Secondary_Continuum_module
2514) use Material_Aux_class
2515)
2516) implicit none
2517)
2518) SNES, intent(in) :: snes
2519) Vec, intent(inout) :: xx
2520) Vec, intent(out) :: r
2521) type(realization_subsurface_type) :: realization
2522)
2523) PetscErrorCode :: ierr
2524) PetscInt :: i, jn
2525) PetscInt :: ip1, ip2
2526) PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
2527)
2528) PetscReal, pointer :: accum_p(:)
2529)
2530) PetscReal, pointer :: r_p(:), xx_loc_p(:), xx_p(:), yy_p(:)
2531)
2532) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
2533)
2534) PetscInt :: iphase
2535) PetscInt :: icap_up, icap_dn, ithrm_up, ithrm_dn
2536) PetscReal :: dd_up, dd_dn
2537) PetscReal :: dd, f_up, f_dn, ff
2538) PetscReal :: perm_up, perm_dn
2539) PetscReal :: D_up, D_dn ! "Diffusion" constants at upstream, downstream faces.
2540) PetscReal :: dw_kg, dw_mol,dddt,dddp
2541) PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
2542) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
2543) PetscReal :: upweight
2544) PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
2545) PetscReal :: xxbc(realization%option%nflowdof)
2546) PetscReal :: psrc(1:realization%option%nphase)
2547) PetscViewer :: viewer
2548)
2549)
2550) type(grid_type), pointer :: grid
2551) type(patch_type), pointer :: patch
2552) type(option_type), pointer :: option
2553) type(field_type), pointer :: field
2554) type(mphase_type), pointer :: mphase
2555) type(mphase_parameter_type), pointer :: mphase_parameter
2556) type(mphase_auxvar_type), pointer :: auxvars(:)
2557) type(mphase_auxvar_type), pointer :: auxvars_bc(:)
2558) type(mphase_auxvar_type), pointer :: auxvars_ss(:)
2559) type(global_auxvar_type), pointer :: global_auxvars(:)
2560) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
2561) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
2562) class(material_auxvar_type), pointer :: material_auxvars(:)
2563) type(coupler_type), pointer :: boundary_condition
2564) type(coupler_type), pointer :: source_sink
2565) type(connection_set_list_type), pointer :: connection_set_list
2566) type(connection_set_type), pointer :: cur_connection_set
2567) PetscReal, pointer :: msrc(:)
2568) PetscReal :: ss_flow_vol_flux(realization%option%nphase)
2569)
2570) type(sec_heat_type), pointer :: mphase_sec_heat_vars(:)
2571)
2572) PetscBool :: enthalpy_flag
2573) PetscInt :: ng
2574) PetscInt :: iconn, idof, istart, iend
2575) PetscInt :: nsrcpara
2576) PetscInt :: sum_connection
2577) PetscReal :: distance, fraction_upwind
2578) PetscReal :: distance_gravity
2579) PetscReal :: vol_frac_prim
2580)
2581) ! secondary continuum variables
2582) PetscReal :: sec_dencpr
2583) PetscReal :: area_prim_sec
2584) PetscReal :: res_sec_heat
2585)
2586) character(len=MAXSTRINGLENGTH) :: string
2587)
2588) patch => realization%patch
2589) grid => patch%grid
2590) option => realization%option
2591) field => realization%field
2592)
2593) mphase => patch%aux%Mphase
2594) mphase_parameter => mphase%mphase_parameter
2595) auxvars => mphase%auxvars
2596) auxvars_bc => mphase%auxvars_bc
2597) auxvars_ss => mphase%auxvars_ss
2598) global_auxvars => patch%aux%Global%auxvars
2599) global_auxvars_bc => patch%aux%Global%auxvars_bc
2600) global_auxvars_ss => patch%aux%Global%auxvars_ss
2601) material_auxvars => patch%aux%Material%auxvars
2602) mphase_sec_heat_vars => patch%aux%SC_heat%sec_heat_vars
2603)
2604) ! call MphaseUpdateAuxVarsPatchNinc(realization)
2605) ! override flags since they will soon be out of date
2606) ! patch%MphaseAux%auxvars_up_to_date = PETSC_FALSE
2607)
2608) if (option%compute_mass_balance_new) then
2609) call MphaseZeroMassBalDeltaPatch(realization)
2610) endif
2611)
2612) ! now assign access pointer to local variables
2613) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2614) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2615) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2616)
2617) ! call VecGetArrayF90(field%flow_yy,yy_p,ierr)
2618) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2619) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2620) call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr);CHKERRQ(ierr)
2621)
2622)
2623) vol_frac_prim = 1.d0
2624)
2625) #if 1
2626) ! Pertubations for aux terms --------------------------------
2627) do ng = 1, grid%ngmax
2628) if (grid%nG2L(ng) < 0) cycle
2629) if (associated(patch%imat)) then
2630) if (patch%imat(ng) <= 0) cycle
2631) endif
2632)
2633) istart = (ng-1) * option%nflowdof + 1; iend = istart - 1 + option%nflowdof
2634) iphase = int(iphase_loc_p(ng))
2635) ghosted_id = ng
2636) call MphaseAuxVarCompute_Ninc(xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0), &
2637) global_auxvars(ng), iphase, &
2638) patch%saturation_function_array(int(icap_loc_p(ng)))%ptr, &
2639) realization%fluid_properties,option,xphi)
2640)
2641) #if 1
2642) if (associated(global_auxvars)) then
2643) global_auxvars(ghosted_id)%pres(:) = auxvars(ghosted_id)%auxvar_elem(0)%pres - &
2644) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
2645) global_auxvars(ghosted_id)%temp = auxvars(ghosted_id)%auxvar_elem(0)%temp
2646) global_auxvars(ghosted_id)%sat(:) = auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
2647) global_auxvars(ghosted_id)%fugacoeff(1) = xphi
2648) global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
2649) global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
2650) * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
2651) ! global_auxvars(ghosted_id)%reaction_rate(:)=0D0
2652) ! print *,'UPdate mphase and gloable vars', ghosted_id, global_auxvars(ghosted_id) %m_nacl(:), &
2653) ! global_auxvars(ghosted_id)%pres(:)
2654) ! global_auxvars(ghosted_id)%mass_balance
2655) ! global_auxvars(ghosted_id)%mass_balance_delta
2656) else
2657) print *,'Not associated global for mph'
2658) endif
2659) #endif
2660)
2661) if (option%flow%numerical_derivatives) then
2662) mphase%delx(1,ng) = xx_loc_p((ng-1)*option%nflowdof+1)*dfac !* 1.D-3
2663) mphase%delx(2,ng) = xx_loc_p((ng-1)*option%nflowdof+2)*dfac
2664)
2665) ! print *,'mphase_delx: ',dfac,mphase%delx(1,ng),mphase%delx(2,ng),mphase%delx(3,ng), &
2666) ! xx_loc_p((ng-1)*option%nflowdof+1),xx_loc_p((ng-1)*option%nflowdof+2),xx_loc_p((ng-1)*option%nflowdof+3)
2667)
2668) select case (iphase)
2669) case (1)
2670) if (xx_loc_p((ng-1)*option%nflowdof+3) < 5D-5) then
2671) mphase%delx(3,ng) = dfac*xx_loc_p((ng-1)*option%nflowdof+3)
2672) else
2673) mphase%delx(3,ng) = -dfac*xx_loc_p((ng-1)*option%nflowdof+3)
2674) endif
2675) if (mphase%delx(3,ng) < 1D-8 .and. mphase%delx(3,ng) >= 0.D0) mphase%delx(3,ng) = 1D-8
2676) if (mphase%delx(3,ng) > -1D-8 .and. mphase%delx(3,ng) < 0.D0) mphase%delx(3,ng) = -1D-8
2677) case(2)
2678) if (xx_loc_p((ng-1)*option%nflowdof+3) < 0.9995) then
2679) mphase%delx(3,ng) = dfac*xx_loc_p((ng-1)*option%nflowdof+3)
2680) else
2681) mphase%delx(3,ng) = -dfac*xx_loc_p((ng-1)*option%nflowdof+3)
2682) endif
2683) if (mphase%delx(3,ng) < 1D-8 .and. mphase%delx(3,ng) >= 0.D0) mphase%delx(3,ng) = 1D-8
2684) if (mphase%delx(3,ng) > -1D-8 .and. mphase%delx(3,ng) < 0.D0) mphase%delx(3,ng) = -1D-8
2685) case(3)
2686) if (xx_loc_p((ng-1)*option%nflowdof+3) <= 0.9) then
2687) mphase%delx(3,ng) = dfac*xx_loc_p((ng-1)*option%nflowdof+3)
2688) else
2689) mphase%delx(3,ng) = -dfac*xx_loc_p((ng-1)*option%nflowdof+3)
2690) endif
2691)
2692) if (mphase%delx(3,ng) < 1D-12 .and. mphase%delx(3,ng) >= 0.D0) mphase%delx(3,ng) = 1D-12
2693) if (mphase%delx(3,ng) > -1D-12 .and. mphase%delx(3,ng) < 0.D0) mphase%delx(3,ng) = -1D-12
2694)
2695) if ((mphase%delx(3,ng)+xx_loc_p((ng-1)*option%nflowdof+3)) > 1.D0) then
2696) mphase%delx(3,ng) = (1.D0-xx_loc_p((ng-1)*option%nflowdof+3))*1D-6
2697) endif
2698) if ((mphase%delx(3,ng)+xx_loc_p((ng-1)*option%nflowdof+3)) < 0.D0) then
2699) mphase%delx(3,ng) = xx_loc_p((ng-1)*option%nflowdof+3)*1D-6
2700) endif
2701) end select
2702) call MphaseAuxVarCompute_Winc(xx_loc_p(istart:iend),mphase%delx(:,ng),&
2703) auxvars(ng)%auxvar_elem(1:option%nflowdof),global_auxvars(ng),iphase,&
2704) patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
2705) realization%fluid_properties,option)
2706) endif
2707) enddo
2708) ! print *,'mphase resi patch: end numerical increments'
2709) #endif
2710)
2711) mphase%res_old_AR=0.D0; mphase%res_old_FL=0.D0; r_p = 0.d0
2712)
2713) #if 1
2714) ! Accumulation terms ------------------------------------
2715) r_p = - accum_p
2716)
2717) do local_id = 1, grid%nlmax ! For each local node do...
2718) ghosted_id = grid%nL2G(local_id)
2719) !geh - Ignore inactive cells with inactive materials
2720) if (associated(patch%imat)) then
2721) if (patch%imat(ghosted_id) <= 0) cycle
2722) endif
2723) iend = local_id*option%nflowdof
2724) istart = iend-option%nflowdof+1
2725)
2726) if (option%use_mc) then
2727) vol_frac_prim = mphase_sec_heat_vars(local_id)%epsilon
2728) endif
2729)
2730) call MphaseAccumulation(auxvars(ghosted_id)%auxvar_elem(0), &
2731) global_auxvars(ghosted_id), &
2732) material_auxvars(ghosted_id)%porosity, &
2733) material_auxvars(ghosted_id)%volume, &
2734) mphase_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
2735) option,ONE_INTEGER,vol_frac_prim,Res)
2736) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
2737)
2738) mphase%res_old_AR(local_id, :)= Res(1:option%nflowdof)
2739) enddo
2740) #endif
2741)
2742)
2743) ! ================== Secondary continuum heat source terms =====================
2744) #if 1
2745) if (option%use_mc) then
2746) ! Secondary continuum contribution (Added by SK 06/26/2012)
2747) ! only one secondary continuum for now for each primary continuum node
2748) do local_id = 1, grid%nlmax ! For each local node do...
2749) ghosted_id = grid%nL2G(local_id)
2750) if (associated(patch%imat)) then
2751) if (patch%imat(ghosted_id) <= 0) cycle
2752) endif
2753) iend = local_id*option%nflowdof
2754) istart = iend-option%nflowdof+1
2755)
2756) sec_dencpr = mphase_parameter%dencpr(int(ithrm_loc_p(ghosted_id))) ! secondary rho*c_p same as primary for now
2757)
2758) call MphaseSecondaryHeat(mphase_sec_heat_vars(local_id), &
2759) auxvars(ghosted_id)%auxvar_elem(0), &
2760) global_auxvars(ghosted_id), &
2761) mphase_parameter%ckwet(int(ithrm_loc_p(ghosted_id))), &
2762) sec_dencpr, &
2763) option,res_sec_heat)
2764) r_p(iend) = r_p(iend) - res_sec_heat*option%flow_dt* &
2765) material_auxvars(ghosted_id)%volume
2766)
2767) enddo
2768) endif
2769) #endif
2770)
2771) ! ============== end secondary continuum heat source ===========================
2772)
2773) #if 1
2774) ! Source/sink terms -------------------------------------
2775) ! print *, 'Mphase residual patch 2'
2776) source_sink => patch%source_sink_list%first
2777) sum_connection = 0
2778) do
2779) if (.not.associated(source_sink)) exit
2780) !print *, 'RES s/s begin'
2781) ! check whether enthalpy dof is included
2782) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
2783) enthalpy_flag = PETSC_TRUE
2784) ! else
2785) ! enthalpy_flag = PETSC_FALSE
2786) ! endif
2787)
2788) if (associated(source_sink%flow_condition%pressure)) then
2789) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
2790) endif
2791) ! qsrc1 = source_sink%flow_condition%pressure%dataset%rarray(1)
2792) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
2793) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
2794) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
2795)
2796) ! print *,'src/sink: ',tsrc1,csrc1,hsrc1,psrc
2797)
2798) ! hsrc1=0D0
2799) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
2800) ! csrc1 = csrc1 / FMWCO2
2801) ! msrc(1)=qsrc1; msrc(2) =csrc1
2802) !geh begin change
2803) !geh remove
2804) !geh msrc(:)= psrc(:)
2805) !clu add
2806) select case(source_sink%flow_condition%itype(1))
2807) case(MASS_RATE_SS)
2808) msrc => source_sink%flow_condition%rate%dataset%rarray
2809) nsrcpara= 2
2810) case(WELL_SS)
2811) msrc => source_sink%flow_condition%well%dataset%rarray
2812) nsrcpara = 7 + option%nflowspec
2813)
2814) ! print *,'src/sink: ',nsrcpara,msrc
2815) case default
2816) print *, 'mphase mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
2817) stop
2818) end select
2819)
2820) !clu end change
2821)
2822) cur_connection_set => source_sink%connection_set
2823) do iconn = 1, cur_connection_set%num_connections
2824) sum_connection = sum_connection + 1
2825) local_id = cur_connection_set%id_dn(iconn)
2826) ghosted_id = grid%nL2G(local_id)
2827)
2828) if (associated(patch%imat)) then
2829) if (patch%imat(ghosted_id) <= 0) cycle
2830) endif
2831)
2832) call MphaseSourceSink(msrc,nsrcpara, psrc,tsrc1,hsrc1,csrc1, &
2833) auxvars(ghosted_id)%auxvar_elem(0),&
2834) source_sink%flow_condition%itype(1),Res, &
2835) ! fluid flux [m^3/sec] = Res [kmol/mol] / den [kmol/m^3]
2836) ss_flow_vol_flux, &
2837) enthalpy_flag,option)
2838)
2839) ! included by SK, 08/23/11 to print mass fluxes at source/sink
2840) if (option%compute_mass_balance_new) then
2841) global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) = &
2842) global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) - &
2843) Res(1:2)/option%flow_dt
2844) endif
2845) if (associated(patch%ss_flow_fluxes)) then
2846) patch%ss_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
2847) endif
2848) if (associated(patch%ss_flow_vol_fluxes)) then
2849) patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux/option%flow_dt
2850) endif
2851) r_p((local_id-1)*option%nflowdof + jh2o) = r_p((local_id-1)*option%nflowdof + jh2o)-Res(jh2o)
2852) r_p((local_id-1)*option%nflowdof + jco2) = r_p((local_id-1)*option%nflowdof + jco2)-Res(jco2)
2853) mphase%res_old_AR(local_id,jh2o) = mphase%res_old_AR(local_id,jh2o) - Res(jh2o)
2854) mphase%res_old_AR(local_id,jco2) = mphase%res_old_AR(local_id,jco2) - Res(jco2)
2855) if (enthalpy_flag) then
2856) r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - &
2857) Res(option%nflowdof)
2858) mphase%res_old_AR(local_id,option%nflowdof) = &
2859) mphase%res_old_AR(local_id,option%nflowdof) - Res(option%nflowdof)
2860) endif
2861) ! else if (qsrc1 < 0.d0) then ! withdrawal
2862) ! endif
2863) enddo
2864) source_sink => source_sink%next
2865) enddo
2866) #endif
2867)
2868) #if 1
2869) ! print *, 'Mphase residual patch 3'
2870) ! Boundary Flux Terms -----------------------------------
2871) boundary_condition => patch%boundary_condition_list%first
2872) sum_connection = 0
2873) do
2874) if (.not.associated(boundary_condition)) exit
2875)
2876) cur_connection_set => boundary_condition%connection_set
2877)
2878) do iconn = 1, cur_connection_set%num_connections
2879) sum_connection = sum_connection + 1
2880)
2881) local_id = cur_connection_set%id_dn(iconn)
2882) ghosted_id = grid%nL2G(local_id)
2883)
2884) if (associated(patch%imat)) then
2885) if (patch%imat(ghosted_id) <= 0) cycle
2886) endif
2887)
2888) if (ghosted_id<=0) then
2889) print *, "Wrong boundary node index... STOP!!!"
2890) stop
2891) endif
2892)
2893) ithrm_dn = int(ithrm_loc_p(ghosted_id))
2894) D_dn = mphase_parameter%ckwet(ithrm_dn)
2895)
2896) ! for now, just assume diagonal tensor
2897) call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
2898) cur_connection_set%dist(:,iconn),perm_dn)
2899) ! dist(0,iconn) = scalar - magnitude of distance
2900) ! gravity = vector(3)
2901) ! dist(1:3,iconn) = vector(3) - unit vector
2902) distance_gravity = cur_connection_set%dist(0,iconn) * &
2903) dot_product(option%gravity, &
2904) cur_connection_set%dist(1:3,iconn))
2905)
2906) icap_dn = int(icap_loc_p(ghosted_id))
2907) ! Then need fill up increments for BCs
2908) do idof =1, option%nflowdof
2909) select case(boundary_condition%flow_condition%itype(idof))
2910) case(DIRICHLET_BC)
2911) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
2912) case(HYDROSTATIC_BC,SEEPAGE_BC)
2913) xxbc(MPH_PRESSURE_DOF) = boundary_condition%flow_aux_real_var(MPH_PRESSURE_DOF,iconn)
2914) if (idof>=MPH_TEMPERATURE_DOF)then
2915) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2916) endif
2917) case(ZERO_GRADIENT_BC)
2918) ! solve for pb from Darcy's law given qb /= 0
2919) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2920) iphase = int(iphase_loc_p(ghosted_id))
2921) case(NEUMANN_BC)
2922) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2923) iphase = int(iphase_loc_p(ghosted_id))
2924) end select
2925) enddo
2926)
2927) select case(boundary_condition%flow_condition%itype(MPH_CONCENTRATION_DOF))
2928) case(DIRICHLET_BC,SEEPAGE_BC,HYDROSTATIC_BC)
2929) iphase = boundary_condition%flow_aux_int_var(1,iconn)
2930) case(NEUMANN_BC,ZERO_GRADIENT_BC)
2931) iphase=int(iphase_loc_p(ghosted_id))
2932) end select
2933)
2934) call MphaseAuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
2935) global_auxvars_bc(sum_connection), iphase,&
2936) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
2937) realization%fluid_properties, option, xphi)
2938)
2939) #if 1
2940) if ( associated(global_auxvars_bc))then
2941) global_auxvars_bc(sum_connection)%pres(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
2942) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
2943) global_auxvars_bc(sum_connection)%temp = auxvars_bc(sum_connection)%auxvar_elem(0)%temp
2944) global_auxvars_bc(sum_connection)%sat(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
2945) ! global_auxvars(ghosted_id)%sat_store =
2946) global_auxvars_bc(sum_connection)%fugacoeff(1) = xphi
2947) global_auxvars_bc(sum_connection)%den(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
2948) global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
2949) * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
2950) ! global_auxvars(ghosted_id)%den_kg_store
2951) ! global_auxvars(ghosted_id)%mass_balance
2952) ! global_auxvars(ghosted_id)%mass_balance_delta
2953) endif
2954) #endif
2955)
2956)
2957) call MphaseBCFlux(boundary_condition%flow_condition%itype, &
2958) boundary_condition%flow_aux_real_var(:,iconn), &
2959) auxvars_bc(sum_connection)%auxvar_elem(0), &
2960) auxvars(ghosted_id)%auxvar_elem(0), &
2961) material_auxvars(ghosted_id)%porosity, &
2962) material_auxvars(ghosted_id)%tortuosity, &
2963) mphase_parameter%sir(:,icap_dn), &
2964) cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
2965) cur_connection_set%area(iconn), &
2966) distance_gravity,option, &
2967) v_darcy,vol_frac_prim,Res)
2968)
2969) patch%boundary_velocities(:,sum_connection) = v_darcy(:)
2970)
2971) iend = local_id*option%nflowdof
2972) istart = iend-option%nflowdof+1
2973) r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
2974)
2975) mphase%res_old_AR(local_id,1:option%nflowdof) = &
2976) mphase%res_old_AR(local_id,1:option%nflowdof) - Res(1:option%nflowdof)
2977)
2978) if (associated(patch%boundary_flow_fluxes)) then
2979) patch%boundary_flow_fluxes(1:option%nflowdof,sum_connection) = &
2980) Res(1:option%nflowdof)/option%flow_dt
2981) endif
2982) if (option%compute_mass_balance_new) then
2983) ! contribution to boundary
2984) global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) = &
2985) global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) &
2986) - Res(1:2)/option%flow_dt
2987) endif
2988)
2989) enddo
2990) boundary_condition => boundary_condition%next
2991) enddo
2992) #endif
2993) #if 1
2994) ! Interior Flux Terms -----------------------------------
2995) connection_set_list => grid%internal_connection_set_list
2996) cur_connection_set => connection_set_list%first
2997) sum_connection = 0
2998) do
2999) if (.not.associated(cur_connection_set)) exit
3000) do iconn = 1, cur_connection_set%num_connections
3001) sum_connection = sum_connection + 1
3002)
3003) ghosted_id_up = cur_connection_set%id_up(iconn)
3004) ghosted_id_dn = cur_connection_set%id_dn(iconn)
3005)
3006) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
3007) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
3008)
3009) if (associated(patch%imat)) then
3010) if (patch%imat(ghosted_id_up) <= 0 .or. &
3011) patch%imat(ghosted_id_dn) <= 0) cycle
3012) endif
3013)
3014) fraction_upwind = cur_connection_set%dist(-1,iconn)
3015) distance = cur_connection_set%dist(0,iconn)
3016) ! distance = scalar - magnitude of distance
3017) ! gravity = vector(3)
3018) ! dist(1:3,iconn) = vector(3) - unit vector
3019) distance_gravity = distance * &
3020) dot_product(option%gravity, &
3021) cur_connection_set%dist(1:3,iconn))
3022) dd_up = distance*fraction_upwind
3023) dd_dn = distance-dd_up ! should avoid truncation error
3024) ! upweight could be calculated as 1.d0-fraction_upwind
3025) ! however, this introduces ever so slight error causing pflow-overhaul not
3026) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
3027) upweight = dd_dn/(dd_up+dd_dn)
3028)
3029) ! for now, just assume diagonal tensor
3030) call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
3031) cur_connection_set%dist(:,iconn),perm_up)
3032) call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
3033) cur_connection_set%dist(:,iconn),perm_dn)
3034)
3035) ithrm_up = int(ithrm_loc_p(ghosted_id_up))
3036) ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
3037) icap_up = int(icap_loc_p(ghosted_id_up))
3038) icap_dn = int(icap_loc_p(ghosted_id_dn))
3039)
3040) D_up = mphase_parameter%ckwet(ithrm_up)
3041) D_dn = mphase_parameter%ckwet(ithrm_dn)
3042)
3043)
3044) call MphaseFlux(auxvars(ghosted_id_up)%auxvar_elem(0), &
3045) material_auxvars(ghosted_id_up)%porosity, &
3046) material_auxvars(ghosted_id_up)%tortuosity, &
3047) mphase_parameter%sir(:,icap_up), &
3048) dd_up,perm_up,D_up, &
3049) auxvars(ghosted_id_dn)%auxvar_elem(0), &
3050) material_auxvars(ghosted_id_dn)%porosity, &
3051) material_auxvars(ghosted_id_dn)%tortuosity, &
3052) mphase_parameter%sir(:,icap_dn), &
3053) dd_dn,perm_dn,D_dn, &
3054) cur_connection_set%area(iconn),distance_gravity, &
3055) upweight,option,v_darcy,vol_frac_prim,Res)
3056)
3057) patch%internal_velocities(:,sum_connection) = v_darcy(:)
3058) mphase%res_old_FL(sum_connection,1:option%nflowdof)= Res(1:option%nflowdof)
3059)
3060) if (local_id_up > 0) then
3061) iend = local_id_up*option%nflowdof
3062) istart = iend-option%nflowdof+1
3063) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
3064) endif
3065)
3066) if (local_id_dn > 0) then
3067) iend = local_id_dn*option%nflowdof
3068) istart = iend-option%nflowdof+1
3069) r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
3070) endif
3071)
3072) if (associated(patch%internal_flow_fluxes)) then
3073) patch%internal_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
3074) endif
3075)
3076) enddo
3077) cur_connection_set => cur_connection_set%next
3078) enddo
3079) #endif
3080)
3081) ! adjust residual to R/dt
3082) select case (option%idt_switch)
3083) case(1)
3084) r_p(:) = r_p(:)/option%flow_dt
3085) case(-1)
3086) if (option%flow_dt > 1.D0) r_p(:) = r_p(:)/option%flow_dt
3087) end select
3088)
3089) do local_id = 1, grid%nlmax
3090) if (associated(patch%imat)) then
3091) if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
3092) endif
3093)
3094) istart = 1 + (local_id-1)*option%nflowdof
3095) ! if (volume_p(local_id) > 1.D0) & ! karra added 05/06/2013
3096)
3097) ! scale residual with volume
3098) r_p (istart:istart+option%nflowdof-1) = &
3099) r_p(istart:istart+option%nflowdof-1) / &
3100) material_auxvars(grid%nL2G(local_id))%volume
3101)
3102) if (r_p(istart) > 1E20 .or. r_p(istart) < -1E20) print *,'mphase residual: ', r_p (istart:istart+2)
3103)
3104) enddo
3105)
3106) ! print *,'finished rp vol scale'
3107) if (option%use_isothermal) then
3108) do local_id = 1, grid%nlmax ! For each local node do...
3109) ghosted_id = grid%nL2G(local_id) ! corresponding ghost index
3110) if (associated(patch%imat)) then
3111) if (patch%imat(ghosted_id) <= 0) cycle
3112) endif
3113) istart = 3 + (local_id-1)*option%nflowdof
3114) r_p(istart) = 0.D0 ! xx_loc_p(2 + (ng-1)*option%nflowdof) - yy_p(p1-1)
3115) enddo
3116) endif
3117) !call VecRestoreArrayF90(r, r_p, ierr)
3118)
3119)
3120) if (mphase%inactive_cells_exist) then
3121) do i=1,mphase%n_zero_rows
3122) r_p(mphase%zero_rows_local(i)) = 0.d0
3123) enddo
3124) endif
3125)
3126) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3127) ! call VecRestoreArrayF90(field%flow_yy, yy_p, ierr)
3128) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
3129) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
3130) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
3131) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
3132) call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr);CHKERRQ(ierr)
3133)
3134) if (realization%debug%vecview_residual) then
3135) string = 'MPHresidual'
3136) call DebugCreateViewer(realization%debug,string,option,viewer)
3137) call VecView(r,viewer,ierr);CHKERRQ(ierr)
3138) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3139) endif
3140) if (realization%debug%vecview_solution) then
3141) string = 'MPHxx'
3142) call DebugCreateViewer(realization%debug,string,option,viewer)
3143) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
3144) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3145) endif
3146) end subroutine MphaseResidualPatch
3147)
3148) ! ************************************************************************** !
3149)
3150) subroutine MphaseJacobian(snes,xx,A,B,realization,ierr)
3151) !
3152) ! Computes the Jacobian
3153) !
3154) ! Author: Chuan Lu
3155) ! Date: 12/10/07
3156) !
3157)
3158) use Realization_Subsurface_class
3159) use Patch_module
3160) use Grid_module
3161) use Option_module
3162) use Debug_module
3163)
3164) implicit none
3165)
3166) SNES :: snes
3167) Vec :: xx
3168) Mat :: A, B
3169) type(realization_subsurface_type) :: realization
3170) PetscErrorCode :: ierr
3171)
3172) Mat :: J
3173) MatType :: mat_type
3174) PetscViewer :: viewer
3175) type(patch_type), pointer :: cur_patch
3176) type(grid_type), pointer :: grid
3177) type(option_type), pointer :: option
3178) PetscReal :: norm
3179) character(len=MAXSTRINGLENGTH) :: string
3180)
3181) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
3182) if (mat_type == MATMFFD) then
3183) J = B
3184) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3185) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3186) else
3187) J = A
3188) endif
3189)
3190) call MatZeroEntries(J,ierr);CHKERRQ(ierr)
3191)
3192) cur_patch => realization%patch_list%first
3193) do
3194) if (.not.associated(cur_patch)) exit
3195) realization%patch => cur_patch
3196) call MphaseJacobianPatch(snes,xx,J,J,realization,ierr)
3197) cur_patch => cur_patch%next
3198) enddo
3199)
3200) if (realization%debug%matview_Jacobian) then
3201) string = 'MPHjacobian'
3202) call DebugCreateViewer(realization%debug,string,realization%option,viewer)
3203) call MatView(J,viewer,ierr);CHKERRQ(ierr)
3204) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3205) endif
3206) if (realization%debug%norm_Jacobian) then
3207) option => realization%option
3208) call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
3209) write(option%io_buffer,'("1 norm: ",es11.4)') norm
3210) call printMsg(option)
3211) call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
3212) write(option%io_buffer,'("2 norm: ",es11.4)') norm
3213) call printMsg(option)
3214) call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
3215) write(option%io_buffer,'("inf norm: ",es11.4)') norm
3216) call printMsg(option)
3217) endif
3218)
3219) end subroutine MphaseJacobian
3220)
3221) ! ************************************************************************** !
3222)
3223) subroutine MphaseJacobianPatch(snes,xx,A,B,realization,ierr)
3224) !
3225) ! Computes the Jacobian
3226) !
3227) ! Author: Chuan Lu
3228) ! Date: 12/13/07
3229) !
3230)
3231) use Connection_module
3232) use Option_module
3233) use Grid_module
3234) use Realization_Subsurface_class
3235) use Patch_module
3236) use Coupler_module
3237) use Field_module
3238) use Debug_module
3239) use Secondary_Continuum_Aux_module
3240) use Material_Aux_class
3241)
3242) implicit none
3243)
3244) SNES :: snes
3245) Vec :: xx
3246) Mat :: A, B
3247) type(realization_subsurface_type) :: realization
3248)
3249) PetscErrorCode :: ierr
3250) PetscInt :: nvar,neq,nr
3251) PetscInt :: ithrm_up, ithrm_dn, i, j
3252) PetscInt :: ip1, ip2
3253)
3254) PetscReal, pointer :: xx_loc_p(:)
3255) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
3256) PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
3257) PetscInt :: ii, jj
3258) PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
3259) PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
3260) PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
3261) PetscReal :: perm_up, perm_dn
3262) PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
3263) PetscReal :: D_up, D_dn ! "Diffusion" constants upstream and downstream of a face.
3264) PetscReal :: zero, norm
3265) PetscReal :: upweight
3266) ! PetscReal :: max_dev
3267) PetscInt :: local_id, ghosted_id
3268) PetscInt :: local_id_up, local_id_dn
3269) PetscInt :: ghosted_id_up, ghosted_id_dn
3270) PetscInt :: natural_id_up,natural_id_dn
3271)
3272) PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
3273) Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
3274)
3275) PetscInt :: istart, iend
3276)
3277) type(coupler_type), pointer :: boundary_condition, source_sink
3278) type(connection_set_list_type), pointer :: connection_set_list
3279) type(connection_set_type), pointer :: cur_connection_set
3280) PetscBool :: enthalpy_flag
3281) PetscInt :: iconn, idof
3282) PetscInt :: sum_connection
3283) PetscReal :: distance, fraction_upwind
3284) PetscReal :: distance_gravity
3285) PetscReal :: Res(realization%option%nflowdof)
3286) PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
3287) PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
3288) realization%option%nflowdof)
3289) PetscReal :: dummy_real(realization%option%nphase)
3290) type(grid_type), pointer :: grid
3291) type(patch_type), pointer :: patch
3292) type(option_type), pointer :: option
3293) type(field_type), pointer :: field
3294) type(mphase_type), pointer :: mphase
3295) type(mphase_parameter_type), pointer :: mphase_parameter
3296) type(mphase_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
3297) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
3298) class(material_auxvar_type), pointer :: material_auxvars(:)
3299)
3300) type(sec_heat_type), pointer :: sec_heat_vars(:)
3301)
3302) PetscReal :: vv_darcy(realization%option%nphase), voltemp
3303) PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2)
3304) PetscReal, pointer :: msrc(:)
3305) PetscReal :: psrc(1:realization%option%nphase)
3306) PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
3307) dvdp, xphi
3308) PetscInt :: iphasebc
3309) PetscInt :: nsrcpara
3310)
3311) PetscViewer :: viewer
3312) Vec :: debug_vec
3313) PetscReal :: vol_frac_prim
3314)
3315) ! secondary continuum variables
3316) PetscReal :: area_prim_sec
3317) PetscReal :: jac_sec_heat
3318)
3319) character(len=MAXSTRINGLENGTH) :: string
3320)
3321) !-----------------------------------------------------------------------
3322) ! R stand for residual
3323) ! ra 1 2 3 4 5 6 7 8
3324) ! 1: p dR/dpi dR/dTi dR/dci dR/dsi dR/dpim dR/dTim
3325) ! 2: T
3326) ! 3: c
3327) ! 4 s
3328) !-----------------------------------------------------------------------
3329)
3330) patch => realization%patch
3331) grid => patch%grid
3332) option => realization%option
3333) field => realization%field
3334)
3335) mphase => patch%aux%mphase
3336) mphase_parameter => mphase%mphase_parameter
3337) auxvars => mphase%auxvars
3338) auxvars_bc => mphase%auxvars_bc
3339) global_auxvars => patch%aux%Global%auxvars
3340) global_auxvars_bc => patch%aux%Global%auxvars_bc
3341) material_auxvars => patch%aux%Material%auxvars
3342)
3343) sec_heat_vars => patch%aux%SC_heat%sec_heat_vars
3344)
3345) ! dropped derivatives:
3346) ! 1.D0 gas phase viscocity to all p,t,c,s
3347) ! 2. Average molecular weights to p,t,s
3348) #if 0
3349) ! call MphaseNumericalJacobianTest(xx,realization)
3350) #endif
3351)
3352) ! print *,'*********** In Jacobian ********************** '
3353) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
3354)
3355) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
3356) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
3357) call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr);CHKERRQ(ierr)
3358)
3359) ResInc = 0.D0
3360) vol_frac_prim = 1.d0
3361)
3362) #if 1
3363) ! Accumulation terms ------------------------------------
3364) do local_id = 1, grid%nlmax ! For each local node do...
3365) ghosted_id = grid%nL2G(local_id)
3366) !geh - Ignore inactive cells with inactive materials
3367) if (associated(patch%imat)) then
3368) if (patch%imat(ghosted_id) <= 0) cycle
3369) endif
3370) iend = local_id*option%nflowdof
3371) istart = iend-option%nflowdof+1
3372) icap = int(icap_loc_p(ghosted_id))
3373)
3374) if (option%use_mc) then
3375) vol_frac_prim = sec_heat_vars(local_id)%epsilon
3376) endif
3377)
3378) do nvar =1, option%nflowdof
3379) call MphaseAccumulation(auxvars(ghosted_id)%auxvar_elem(nvar), &
3380) global_auxvars(ghosted_id), &
3381) material_auxvars(ghosted_id)%porosity, &
3382) material_auxvars(ghosted_id)%volume, &
3383) mphase_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
3384) option,ONE_INTEGER,vol_frac_prim,res)
3385) ResInc(local_id,:,nvar) = ResInc(local_id,:,nvar) + Res(:)
3386) enddo
3387)
3388) enddo
3389) #endif
3390)
3391) #if 1
3392) ! Source/sink terms -------------------------------------
3393) source_sink => patch%source_sink_list%first
3394) do
3395) if (.not.associated(source_sink)) exit
3396)
3397) ! check whether enthalpy dof is included
3398) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
3399) enthalpy_flag = PETSC_TRUE
3400) ! else
3401) ! enthalpy_flag = PETSC_FALSE
3402) ! endif
3403)
3404) if (associated(source_sink%flow_condition%pressure)) then
3405) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
3406) endif
3407) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
3408) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
3409) ! hsrc1=0.D0
3410) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
3411)
3412) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
3413) ! csrc1 = csrc1 / FMWCO2
3414) !geh begin change
3415) !geh remove
3416) !geh msrc(:)= psrc(:)
3417) !clu add
3418) select case(source_sink%flow_condition%itype(1))
3419) case(MASS_RATE_SS)
3420) msrc => source_sink%flow_condition%rate%dataset%rarray
3421) nsrcpara= 2
3422) case(WELL_SS)
3423) msrc => source_sink%flow_condition%well%dataset%rarray
3424) nsrcpara = 7 + option%nflowspec
3425) case default
3426) print *, 'mphase mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
3427) stop
3428) end select
3429)
3430) cur_connection_set => source_sink%connection_set
3431)
3432) do iconn = 1, cur_connection_set%num_connections
3433) local_id = cur_connection_set%id_dn(iconn)
3434) ghosted_id = grid%nL2G(local_id)
3435)
3436) if (associated(patch%imat)) then
3437) if (patch%imat(ghosted_id) <= 0) cycle
3438) endif
3439) ! if (enthalpy_flag) then
3440) ! r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - hsrc1 * option%flow_dt
3441) ! endif
3442)
3443) do nvar = 1, option%nflowdof
3444) call MphaseSourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, &
3445) auxvars(ghosted_id)%auxvar_elem(nvar), &
3446) source_sink%flow_condition%itype(1),Res, &
3447) dummy_real,enthalpy_flag,option)
3448)
3449) ResInc(local_id,jh2o,nvar) = ResInc(local_id,jh2o,nvar) - Res(jh2o)
3450) ResInc(local_id,jco2,nvar) = ResInc(local_id,jco2,nvar) - Res(jco2)
3451) if (enthalpy_flag) &
3452) ResInc(local_id,option%nflowdof,nvar) = &
3453) ResInc(local_id,option%nflowdof,nvar) - Res(option%nflowdof)
3454)
3455) enddo
3456) enddo
3457) source_sink => source_sink%next
3458) enddo
3459) #endif
3460)
3461) ! Boundary conditions
3462) #if 1
3463) ! Boundary Flux Terms -----------------------------------
3464) boundary_condition => patch%boundary_condition_list%first
3465) sum_connection = 0
3466) do
3467) if (.not.associated(boundary_condition)) exit
3468)
3469) cur_connection_set => boundary_condition%connection_set
3470)
3471) do iconn = 1, cur_connection_set%num_connections
3472) sum_connection = sum_connection + 1
3473)
3474) local_id = cur_connection_set%id_dn(iconn)
3475) ghosted_id = grid%nL2G(local_id)
3476)
3477) if (associated(patch%imat)) then
3478) if (patch%imat(ghosted_id) <= 0) cycle
3479) endif
3480)
3481) if (ghosted_id<=0) then
3482) print *, "Wrong boundary node index... STOP!!!"
3483) stop
3484) endif
3485)
3486) ithrm_dn = int(ithrm_loc_p(ghosted_id))
3487) D_dn = mphase_parameter%ckwet(ithrm_dn)
3488)
3489)
3490) ! for now, just assume diagonal tensor
3491) call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
3492) cur_connection_set%dist(:,iconn),perm_dn)
3493) ! dist(0,iconn) = scalar - magnitude of distance
3494) ! gravity = vector(3)
3495) ! dist(1:3,iconn) = vector(3) - unit vector
3496) distance_gravity = cur_connection_set%dist(0,iconn) * &
3497) dot_product(option%gravity, &
3498) cur_connection_set%dist(1:3,iconn))
3499) icap_dn = int(icap_loc_p(ghosted_id))
3500)
3501) ! Then need fill up increments for BCs
3502) delxbc = 0.D0;
3503) do idof = 1, option%nflowdof
3504) select case(boundary_condition%flow_condition%itype(idof))
3505) case(DIRICHLET_BC)
3506) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
3507) delxbc(idof) = 0.D0
3508) case(HYDROSTATIC_BC,SEEPAGE_BC)
3509) xxbc(MPH_PRESSURE_DOF) = boundary_condition%flow_aux_real_var(MPH_PRESSURE_DOF,iconn)
3510) if (idof >= MPH_TEMPERATURE_DOF) then
3511) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
3512) delxbc(idof) = mphase%delx(idof,ghosted_id)
3513) endif
3514) case(ZERO_GRADIENT_BC,NEUMANN_BC)
3515) ! solve for pb from Darcy's law given qb /= 0
3516) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
3517) !iphasebc = int(iphase_loc_p(ghosted_id))
3518) delxbc(idof) = mphase%delx(idof,ghosted_id)
3519) end select
3520) enddo
3521) !print *,'BC:',boundary_condition%flow_condition%itype, xxbc, delxbc
3522)
3523)
3524) select case(boundary_condition%flow_condition%itype(MPH_CONCENTRATION_DOF))
3525) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
3526) iphasebc = boundary_condition%flow_aux_int_var(1,iconn)
3527) case(ZERO_GRADIENT_BC)
3528) iphasebc=int(iphase_loc_p(ghosted_id))
3529) end select
3530) if (boundary_condition%flow_condition%itype(MPH_PRESSURE_DOF) /= NEUMANN_BC) then
3531) call MphaseAuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0), &
3532) global_auxvars_bc(sum_connection),iphasebc,&
3533) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
3534) realization%fluid_properties,option)
3535) call MphaseAuxVarCompute_Winc(xxbc,delxbc,&
3536) auxvars_bc(sum_connection)%auxvar_elem(1:option%nflowdof),&
3537) global_auxvars_bc(sum_connection),iphasebc, &
3538) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
3539) realization%fluid_properties,option)
3540)
3541) do nvar=1,option%nflowdof
3542) call MphaseBCFlux(boundary_condition%flow_condition%itype, &
3543) boundary_condition%flow_aux_real_var(:,iconn), &
3544) auxvars_bc(sum_connection)%auxvar_elem(nvar), &
3545) auxvars(ghosted_id)%auxvar_elem(nvar), &
3546) material_auxvars(ghosted_id)%porosity, &
3547) material_auxvars(ghosted_id)%tortuosity, &
3548) mphase_parameter%sir(:,icap_dn), &
3549) cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
3550) cur_connection_set%area(iconn), &
3551) distance_gravity,option, &
3552) vv_darcy,vol_frac_prim,Res)
3553) ResInc(local_id,1:option%nflowdof,nvar) = &
3554) ResInc(local_id,1:option%nflowdof,nvar) - Res(1:option%nflowdof)
3555) enddo
3556) endif
3557) enddo
3558) boundary_condition => boundary_condition%next
3559) enddo
3560) #endif
3561)
3562) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
3563) do local_id = 1, grid%nlmax ! For each local node do...
3564) ghosted_id = grid%nL2G(local_id)
3565) !geh - Ignore inactive cells with inactive materials
3566) if (associated(patch%imat)) then
3567) if (patch%imat(ghosted_id) <= 0) cycle
3568) endif
3569)
3570) ra = 0.D0
3571) ! max_dev = 0.D0
3572) do neq = 1, option%nflowdof
3573) do nvar = 1, option%nflowdof
3574) ra(neq,nvar) = (ResInc(local_id,neq,nvar) - mphase%res_old_AR(local_id,neq)) &
3575) /mphase%delx(nvar,ghosted_id)
3576)
3577) ! print *,'finite dif: ',neq,nvar,ra(neq,nvar),ResInc(local_id,neq,nvar),mphase%res_old_AR(local_id,neq), &
3578) ! mphase%delx(nvar,ghosted_id)
3579)
3580) ! if (max_dev < dabs(ra(3,nvar))) max_dev = dabs(ra(3,nvar))
3581) enddo
3582) enddo
3583)
3584) select case(option%idt_switch)
3585) case(1)
3586) ra(1:option%nflowdof,1:option%nflowdof) = ra(1:option%nflowdof,1:option%nflowdof)/option%flow_dt
3587) case(-1)
3588) if (option%flow_dt > 1) ra(1:option%nflowdof,1:option%nflowdof) = ra(1:option%nflowdof,1:option%nflowdof)/option%flow_dt
3589) end select
3590)
3591) Jup = ra(1:option%nflowdof,1:option%nflowdof)
3592)
3593) if (option%use_mc) then
3594)
3595) call MphaseSecondaryHeatJacobian(sec_heat_vars(local_id), &
3596) mphase_parameter%ckwet(int(ithrm_loc_p(ghosted_id))), &
3597) mphase_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
3598) option,jac_sec_heat)
3599) ! sk - option%flow_dt cancels out with option%flow_dt in the denominator for the term below
3600) Jup(option%nflowdof,2) = Jup(option%nflowdof,2) - &
3601) jac_sec_heat* &
3602) material_auxvars(ghosted_id)%volume
3603) endif
3604)
3605) ! if (volume_p(local_id) > 1.D0) & ! karra added 05/06/2013
3606) Jup = Jup / material_auxvars(ghosted_id)%volume
3607)
3608) ! if (n==1) print *, blkmat11, volume_p(n), ra
3609) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
3610) ierr);CHKERRQ(ierr)
3611) end do
3612)
3613) if (realization%debug%matview_Jacobian_detailed) then
3614) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3615) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3616) string = 'jacobian_srcsink'
3617) call DebugCreateViewer(realization%debug,string,option,viewer)
3618) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
3619) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3620) endif
3621) #if 1
3622) ! Interior Flux Terms -----------------------------------
3623) connection_set_list => grid%internal_connection_set_list
3624) cur_connection_set => connection_set_list%first
3625) sum_connection = 0
3626) ResInc = 0.D0
3627) do
3628) if (.not.associated(cur_connection_set)) exit
3629) do iconn = 1, cur_connection_set%num_connections
3630) sum_connection = sum_connection + 1
3631)
3632) ghosted_id_up = cur_connection_set%id_up(iconn)
3633) ghosted_id_dn = cur_connection_set%id_dn(iconn)
3634)
3635) if (associated(patch%imat)) then
3636) if (patch%imat(ghosted_id_up) <= 0 .or. &
3637) patch%imat(ghosted_id_dn) <= 0) cycle
3638) endif
3639)
3640) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
3641) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
3642) ! natural_id_up = grid%nG2N(ghosted_id_up)
3643) ! natural_id_dn = grid%nG2N(ghosted_id_dn)
3644)
3645) fraction_upwind = cur_connection_set%dist(-1,iconn)
3646) distance = cur_connection_set%dist(0,iconn)
3647) ! distance = scalar - magnitude of distance
3648) ! gravity = vector(3)
3649) ! dist(1:3,iconn) = vector(3) - unit vector
3650) distance_gravity = distance * &
3651) dot_product(option%gravity, &
3652) cur_connection_set%dist(1:3,iconn))
3653) dd_up = distance*fraction_upwind
3654) dd_dn = distance-dd_up ! should avoid truncation error
3655) ! upweight could be calculated as 1.d0-fraction_upwind
3656) ! however, this introduces ever so slight error causing pflow-overhaul not
3657) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
3658) upweight = dd_dn/(dd_up+dd_dn)
3659)
3660) ! for now, just assume diagonal tensor
3661) call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
3662) cur_connection_set%dist(:,iconn),perm_up)
3663) call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
3664) cur_connection_set%dist(:,iconn),perm_dn)
3665)
3666) iphas_up = int(iphase_loc_p(ghosted_id_up))
3667) iphas_dn = int(iphase_loc_p(ghosted_id_dn))
3668)
3669) ithrm_up = int(ithrm_loc_p(ghosted_id_up))
3670) ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
3671) D_up = mphase_parameter%ckwet(ithrm_up)
3672) D_dn = mphase_parameter%ckwet(ithrm_dn)
3673)
3674) icap_up = int(icap_loc_p(ghosted_id_up))
3675) icap_dn = int(icap_loc_p(ghosted_id_dn))
3676)
3677)
3678) do nvar = 1, option%nflowdof
3679) call MphaseFlux(auxvars(ghosted_id_up)%auxvar_elem(nvar), &
3680) material_auxvars(ghosted_id_up)%porosity, &
3681) material_auxvars(ghosted_id_up)%tortuosity, &
3682) mphase_parameter%sir(:,icap_up), &
3683) dd_up,perm_up,D_up, &
3684) auxvars(ghosted_id_dn)%auxvar_elem(0), &
3685) material_auxvars(ghosted_id_dn)%porosity, &
3686) material_auxvars(ghosted_id_dn)%tortuosity, &
3687) mphase_parameter%sir(:,icap_dn), &
3688) dd_dn,perm_dn,D_dn, &
3689) cur_connection_set%area(iconn), &
3690) distance_gravity, &
3691) upweight, option, vv_darcy, vol_frac_prim, Res)
3692)
3693) ra(:,nvar) = (Res(:)-mphase%res_old_FL(iconn,:))/ &
3694) mphase%delx(nvar,ghosted_id_up)
3695)
3696) call MphaseFlux(auxvars(ghosted_id_up)%auxvar_elem(0), &
3697) material_auxvars(ghosted_id_up)%porosity, &
3698) material_auxvars(ghosted_id_up)%tortuosity, &
3699) mphase_parameter%sir(:,icap_up), &
3700) dd_up,perm_up,D_up, &
3701) auxvars(ghosted_id_dn)%auxvar_elem(nvar), &
3702) material_auxvars(ghosted_id_dn)%porosity,&
3703) material_auxvars(ghosted_id_dn)%tortuosity, &
3704) mphase_parameter%sir(:,icap_dn), &
3705) dd_dn,perm_dn,D_dn, &
3706) cur_connection_set%area(iconn),distance_gravity, &
3707) upweight, option, vv_darcy, vol_frac_prim, Res)
3708)
3709) ra(:,nvar+option%nflowdof) = (Res(:)-mphase%res_old_FL(iconn,:)) &
3710) /mphase%delx(nvar,ghosted_id_dn)
3711) enddo
3712)
3713) select case(option%idt_switch)
3714) case(1)
3715) ra = ra / option%flow_dt
3716) case(-1)
3717) if (option%flow_dt>1) ra = ra / option%flow_dt
3718) end select
3719)
3720) if (local_id_up > 0) then
3721) voltemp=1.D0
3722) ! if (volume_p(local_id_up) > 1.D0)then ! karra added 05/06/2013
3723) voltemp = 1.D0 / material_auxvars(ghosted_id_up)%volume
3724) ! endif
3725) Jup(:,1:option%nflowdof)= ra(:,1:option%nflowdof)*voltemp !11
3726) Jdn(:,1:option%nflowdof)= &
3727) ra(:,1 + option%nflowdof:2 * option%nflowdof)*voltemp !12
3728)
3729) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
3730) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3731) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
3732) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3733) endif
3734) if (local_id_dn > 0) then
3735) voltemp = 1.D0
3736) ! if (volume_p(local_id_dn) > 1.D0) then ! karra added 05/06/2013
3737) voltemp = 1.D0 / material_auxvars(ghosted_id_dn)%volume
3738) ! endif
3739) Jup(:,1:option%nflowdof) = -ra(:,1:option%nflowdof)*voltemp !21
3740) Jdn(:,1:option%nflowdof) = -ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !22
3741)
3742) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
3743) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3744) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
3745) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3746) endif
3747) enddo
3748) cur_connection_set => cur_connection_set%next
3749) enddo
3750) #endif
3751) if (realization%debug%matview_Jacobian_detailed) then
3752) ! print *,'end inter flux'
3753) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3754) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3755) string = 'jacobian_flux'
3756) call DebugCreateViewer(realization%debug,string,option,viewer)
3757) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
3758) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3759) endif
3760) #if 0
3761) if (realization%debug%matview_Jacobian_detailed) then
3762) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3763) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3764) call PetscViewerASCIIOpen(option%mycomm,'jacobian_bcflux.out',viewer, &
3765) ierr);CHKERRQ(ierr)
3766) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3767) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3768) endif
3769) #endif
3770)
3771) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
3772)
3773) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
3774) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
3775) call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr);CHKERRQ(ierr)
3776) !print *,'end jac'
3777) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3778) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3779) ! call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr)
3780) #if 0
3781) ! zero out isothermal and inactive cells
3782) #ifdef ISOTHERMAL
3783) zero = 0.d0
3784) call MatZeroRowsLocal(A,n_zero_rows,zero_rows_local_ghosted,zero, &
3785) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3786) ierr);CHKERRQ(ierr)
3787) do i=1, n_zero_rows
3788) ii = mod(zero_rows_local(i),option%nflowdof)
3789) ip1 = zero_rows_local_ghosted(i)
3790) if (ii == 0) then
3791) ip2 = ip1-1
3792) elseif (ii == option%nflowdof-1) then
3793) ip2 = ip1+1
3794) else
3795) ip2 = ip1
3796) endif
3797) call MatSetValuesLocal(A,1,ip1,1,ip2,1.d0,INSERT_VALUES, &
3798) ierr);CHKERRQ(ierr)
3799) enddo
3800)
3801) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3802) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3803) #else
3804) #endif
3805) #endif
3806)
3807) if (mphase%inactive_cells_exist) then
3808) f_up = 1.d0
3809) call MatZeroRowsLocal(A,mphase%n_zero_rows, &
3810) mphase%zero_rows_local_ghosted,f_up, &
3811) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3812) ierr);CHKERRQ(ierr)
3813) endif
3814)
3815) end subroutine MphaseJacobianPatch
3816)
3817) ! ************************************************************************** !
3818)
3819) subroutine MphaseMaxChange(realization,dpmax,dtmpmax,dsmax,dcmax)
3820) !
3821) ! Computes the maximum change in the solution vector
3822) !
3823) ! Author: Glenn Hammond
3824) ! Date: 01/15/08
3825) !
3826)
3827) use Realization_Subsurface_class
3828) use Field_module
3829) use Option_module
3830) use Field_module
3831)
3832) implicit none
3833)
3834) type(realization_subsurface_type) :: realization
3835)
3836) type(option_type), pointer :: option
3837) type(field_type), pointer :: field
3838) PetscReal :: dpmax, dtmpmax, dsmax, dcmax
3839) PetscErrorCode :: ierr
3840)
3841) option => realization%option
3842) field => realization%field
3843)
3844) dpmax = 0.d0
3845) dtmpmax = 0.d0
3846) dcmax = 0.d0
3847) dsmax = 0.d0
3848)
3849) call VecWAXPY(field%flow_dxx,-1.d0,field%flow_xx,field%flow_yy, &
3850) ierr);CHKERRQ(ierr)
3851) call VecStrideNorm(field%flow_dxx,ZERO_INTEGER,NORM_INFINITY,dpmax, &
3852) ierr);CHKERRQ(ierr)
3853) call VecStrideNorm(field%flow_dxx,ONE_INTEGER,NORM_INFINITY,dtmpmax, &
3854) ierr);CHKERRQ(ierr)
3855)
3856) call MphaseMaxChangePatch(realization, dcmax, dsmax)
3857)
3858) call MPI_Allreduce(MPI_IN_PLACE,dcmax,ONE_INTEGER_MPI,MPI_DOUBLE_PRECISION, &
3859) MPI_MAX,option%mycomm,ierr)
3860) call MPI_Allreduce(MPI_IN_PLACE,dsmax,ONE_INTEGER_MPI,MPI_DOUBLE_PRECISION, &
3861) MPI_MAX,option%mycomm,ierr)
3862)
3863) end subroutine MphaseMaxChange
3864)
3865) ! ************************************************************************** !
3866)
3867) subroutine MphaseMaxChangePatch(realization, max_c, max_s)
3868)
3869) use Realization_Subsurface_class
3870) use Grid_module
3871) use Patch_module
3872) use Field_module
3873) use Option_module
3874) implicit none
3875)
3876) type(realization_subsurface_type) :: realization
3877) PetscReal :: max_s, max_c
3878)
3879)
3880) type(grid_type), pointer :: grid
3881) type(patch_type), pointer :: patch
3882) type(field_type), pointer :: field
3883) type(option_type), pointer :: option
3884) PetscErrorCode :: ierr
3885) PetscReal, pointer :: xx_p(:), yy_p(:), iphase_loc_p(:), iphase_old_loc_p(:)
3886) PetscInt :: local_id, ghosted_id, n0
3887) PetscReal :: cmp
3888)
3889) patch => realization%patch
3890) grid => patch%grid
3891) field => realization%field
3892) option => realization%option
3893)
3894) max_c=0.D0
3895) max_s=0.D0
3896)
3897)
3898)
3899) call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
3900) call VecGetArrayF90(field%flow_yy,yy_p, ierr);CHKERRQ(ierr)
3901) call VecGetArrayF90(field%iphas_loc,iphase_loc_p, ierr);CHKERRQ(ierr)
3902) call VecGetArrayF90(field%iphas_old_loc,iphase_old_loc_p, &
3903) ierr);CHKERRQ(ierr)
3904)
3905) do local_id =1, grid%nlmax
3906) ghosted_id = grid%nL2G(local_id)
3907) if (associated(patch%imat)) then
3908) if (patch%imat(ghosted_id) <= 0) cycle
3909) endif
3910) n0 = (local_id-1)*option%nflowdof
3911) if (int(iphase_loc_p(ghosted_id)) == int(iphase_old_loc_p(ghosted_id)))then
3912) cmp=dabs(xx_p(n0+3)-yy_p(n0+3))
3913) if (int(iphase_loc_p(ghosted_id))==1 .or.int(iphase_loc_p(ghosted_id))==2)then
3914) if (max_c<cmp) max_c = cmp
3915) endif
3916) if (int(iphase_loc_p(ghosted_id))==3)then
3917) if (max_s<cmp) max_s=cmp
3918) endif
3919) end if
3920) end do
3921)
3922) call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
3923) call VecRestoreArrayF90(field%flow_yy,yy_p, ierr);CHKERRQ(ierr)
3924) call VecRestoreArrayF90(field%iphas_loc,iphase_loc_p, ierr);CHKERRQ(ierr)
3925) call VecRestoreArrayF90(field%iphas_old_loc,iphase_old_loc_p, &
3926) ierr);CHKERRQ(ierr)
3927)
3928)
3929)
3930) end subroutine MphaseMaxChangePatch
3931)
3932) ! ************************************************************************** !
3933)
3934) function MphaseGetTecplotHeader(realization,icolumn)
3935) !
3936) ! Returns Mphase contribution to
3937) ! Tecplot file header
3938) !
3939) ! Author: Glenn Hammond
3940) ! Date: 02/13/08
3941) !
3942)
3943) use Realization_Subsurface_class
3944) use Option_module
3945) use Field_module
3946)
3947) implicit none
3948)
3949) character(len=MAXSTRINGLENGTH) :: MphaseGetTecplotHeader
3950) type(realization_subsurface_type) :: realization
3951) PetscInt :: icolumn
3952)
3953) character(len=MAXSTRINGLENGTH) :: string, string2
3954) type(option_type), pointer :: option
3955) type(field_type), pointer :: field
3956) PetscInt :: i
3957)
3958) option => realization%option
3959) field => realization%field
3960)
3961) string = ''
3962)
3963) if (icolumn > -1) then
3964) icolumn = icolumn + 1
3965) write(string2,'('',"'',i2,''-T [C]"'')') icolumn
3966) else
3967) write(string2,'('',"T [C]"'')')
3968) endif
3969) string = trim(string) // trim(string2)
3970)
3971) if (icolumn > -1) then
3972) icolumn = icolumn + 1
3973) write(string2,'('',"'',i2,''-P(l) [Pa]"'')') icolumn
3974) else
3975) write(string2,'('',"P(l) [Pa]"'')')
3976) endif
3977) string = trim(string) // trim(string2)
3978)
3979) if (icolumn > -1) then
3980) icolumn = icolumn + 1
3981) write(string2,'('',"'',i2,''-P(g) [Pa]"'')') icolumn
3982) else
3983) write(string2,'('',"P(g) [Pa]"'')')
3984) endif
3985) string = trim(string) // trim(string2)
3986)
3987) if (icolumn > -1) then
3988) icolumn = icolumn + 1
3989) write(string2,'('',"'',i2,''-S(l)"'')') icolumn
3990) else
3991) write(string2,'('',"S(l)"'')')
3992) endif
3993) string = trim(string) // trim(string2)
3994)
3995) if (icolumn > -1) then
3996) icolumn = icolumn + 1
3997) write(string2,'('',"'',i2,''-S(g)"'')') icolumn
3998) else
3999) write(string2,'('',"S(g)"'')')
4000) endif
4001) string = trim(string) // trim(string2)
4002)
4003) if (icolumn > -1) then
4004) icolumn = icolumn + 1
4005) write(string2,'('',"'',i2,''-d(l)"'')') icolumn
4006) else
4007) write(string2,'('',"d(l)"'')')
4008) endif
4009) string = trim(string) // trim(string2)
4010)
4011) if (icolumn > -1) then
4012) icolumn = icolumn + 1
4013) write(string2,'('',"'',i2,''-d(g)"'')') icolumn
4014) else
4015) write(string2,'('',"d(g)"'')')
4016) endif
4017) string = trim(string) // trim(string2)
4018)
4019) if (icolumn > -1) then
4020) icolumn = icolumn + 1
4021) write(string2,'('',"'',i2,''-u(l)"'')') icolumn
4022) else
4023) write(string2,'('',"u(l)"'')')
4024) endif
4025) string = trim(string) // trim(string2)
4026)
4027) if (icolumn > -1) then
4028) icolumn = icolumn + 1
4029) write(string2,'('',"'',i2,''-u(g)"'')') icolumn
4030) else
4031) write(string2,'('',"u(g)"'')')
4032) endif
4033) string = trim(string) // trim(string2)
4034)
4035) if (icolumn > -1) then
4036) icolumn = icolumn + 1
4037) write(string2,'('',"'',i2,''-vis(l)"'')') icolumn
4038) else
4039) write(string2,'('',"vis(l)"'')')
4040) endif
4041) string = trim(string) // trim(string2)
4042)
4043) if (icolumn > -1) then
4044) icolumn = icolumn + 1
4045) write(string2,'('',"'',i2,''-vis(g)"'')') icolumn
4046) else
4047) write(string2,'('',"vis(g)"'')')
4048) endif
4049) string = trim(string) // trim(string2)
4050)
4051) if (icolumn > -1) then
4052) icolumn = icolumn + 1
4053) write(string2,'('',"'',i2,''-kvr(l)"'')') icolumn
4054) else
4055) write(string2,'('',"kvr(l)"'')')
4056) endif
4057) string = trim(string) // trim(string2)
4058)
4059) if (icolumn > -1) then
4060) icolumn = icolumn + 1
4061) write(string2,'('',"'',i2,''-kvr(g)"'')') icolumn
4062) else
4063) write(string2,'('',"kvr(g)"'')')
4064) endif
4065) string = trim(string) // trim(string2)
4066)
4067) do i=1,option%nflowspec
4068) if (icolumn > -1) then
4069) icolumn = icolumn + 1
4070) write(string2,'('',"'',i2,''-Xl('',i1,'')"'')') icolumn, i
4071) else
4072) write(string2,'('',"Xl('',i1,'')"'')') i
4073) endif
4074) string = trim(string) // trim(string2)
4075) enddo
4076)
4077) do i=1,option%nflowspec
4078) if (icolumn > -1) then
4079) icolumn = icolumn + 1
4080) write(string2,'('',"'',i2,''-Xg('',i1,'')"'')') icolumn, i
4081) else
4082) write(string2,'('',"Xg('',i1,'')"'')') i
4083) endif
4084) string = trim(string) // trim(string2)
4085) enddo
4086)
4087) if (icolumn > -1) then
4088) icolumn = icolumn + 1
4089) write(string2,'('',"'',i2,''-PHASE"'')') icolumn
4090) else
4091) write(string2,'('',"PHASE"'')')
4092) endif
4093) string = trim(string) // trim(string2)
4094)
4095) MphaseGetTecplotHeader = string
4096)
4097) end function MphaseGetTecplotHeader
4098)
4099) ! ************************************************************************** !
4100)
4101) subroutine MphaseSetPlotVariables(list)
4102) !
4103) ! Adds variables to be printed to list
4104) !
4105) ! Author: Glenn Hammond
4106) ! Date: 10/15/12
4107) !
4108)
4109) use Output_Aux_module
4110) use Variables_module
4111)
4112) implicit none
4113)
4114) type(output_variable_list_type), pointer :: list
4115)
4116) character(len=MAXWORDLENGTH) :: name, units
4117) type(output_variable_type) :: output_variable
4118)
4119) if (associated(list%first)) then
4120) return
4121) endif
4122)
4123) name = 'Temperature'
4124) units = 'C'
4125) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4126) TEMPERATURE)
4127)
4128) name = 'Liquid Pressure'
4129) units = 'Pa'
4130) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
4131) LIQUID_PRESSURE)
4132)
4133) name = 'Gas Pressure'
4134) units = 'Pa'
4135) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
4136) GAS_PRESSURE)
4137)
4138) name = 'Liquid Saturation'
4139) units = ''
4140) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
4141) LIQUID_SATURATION)
4142)
4143) name = 'Gas Saturation'
4144) units = ''
4145) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
4146) GAS_SATURATION)
4147)
4148) name = 'Liquid Density'
4149) units = 'kg/m^3'
4150) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4151) LIQUID_DENSITY)
4152)
4153) name = 'Gas Density'
4154) units = 'kg/m^3'
4155) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4156) GAS_DENSITY)
4157)
4158) name = 'Liquid Energy'
4159) units = 'kJ/mol'
4160) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4161) LIQUID_ENERGY)
4162)
4163) name = 'Gas Energy'
4164) units = 'kJ/mol'
4165) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4166) GAS_ENERGY)
4167)
4168) name = 'Liquid Viscosity'
4169) units = 'Pa.s'
4170) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4171) LIQUID_VISCOSITY)
4172)
4173) name = 'Gas Viscosity'
4174) units = 'Pa.s'
4175) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4176) GAS_VISCOSITY)
4177)
4178) name = 'Liquid Mobility'
4179) units = '1/Pa.s'
4180) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4181) LIQUID_MOBILITY)
4182)
4183) name = 'Gas Mobility'
4184) units = '1/Pa.s'
4185) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4186) GAS_MOBILITY)
4187)
4188) name = 'Liquid Mole Fraction H2O'
4189) units = ''
4190) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4191) LIQUID_MOLE_FRACTION,ONE_INTEGER)
4192)
4193) name = 'Liquid Mole Fraction CO2'
4194) units = ''
4195) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4196) LIQUID_MOLE_FRACTION,TWO_INTEGER)
4197)
4198) name = 'Gas Mole Fraction H2O'
4199) units = ''
4200) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4201) GAS_MOLE_FRACTION,ONE_INTEGER)
4202)
4203) name = 'Gas Mole Fraction CO2'
4204) units = ''
4205) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4206) GAS_MOLE_FRACTION,TWO_INTEGER)
4207)
4208) name = 'Phase'
4209) units = ''
4210) output_variable%iformat = 1 ! integer
4211) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4212) PHASE)
4213)
4214) end subroutine MphaseSetPlotVariables
4215)
4216) ! ************************************************************************** !
4217)
4218) subroutine MphaseSecondaryHeat(sec_heat_vars,auxvar,global_auxvar, &
4219) therm_conductivity,dencpr, &
4220) option,res_heat)
4221) !
4222) ! Calculates the source term contribution due to secondary
4223) ! continuum in the primary continuum residual
4224) !
4225) ! Author: Satish Karra, LANL
4226) ! Date: 06/26/12
4227) !
4228)
4229) use Option_module
4230) use Global_Aux_module
4231) use Secondary_Continuum_Aux_module
4232)
4233) implicit none
4234)
4235) type(sec_heat_type) :: sec_heat_vars
4236) type(mphase_auxvar_elem_type) :: auxvar
4237) type(global_auxvar_type) :: global_auxvar
4238) type(option_type) :: option
4239) PetscReal :: coeff_left(sec_heat_vars%ncells)
4240) PetscReal :: coeff_diag(sec_heat_vars%ncells)
4241) PetscReal :: coeff_right(sec_heat_vars%ncells)
4242) PetscReal :: rhs(sec_heat_vars%ncells)
4243) PetscReal :: sec_temp(sec_heat_vars%ncells)
4244) PetscReal :: area(sec_heat_vars%ncells)
4245) PetscReal :: vol(sec_heat_vars%ncells)
4246) PetscReal :: dm_plus(sec_heat_vars%ncells)
4247) PetscReal :: dm_minus(sec_heat_vars%ncells)
4248) PetscInt :: i, ngcells
4249) PetscReal :: area_fm
4250) PetscReal :: alpha, therm_conductivity, dencpr
4251) PetscReal :: temp_primary_node
4252) PetscReal :: m
4253) PetscReal :: temp_current_N
4254) PetscReal :: res_heat
4255)
4256) ngcells = sec_heat_vars%ncells
4257) area = sec_heat_vars%area
4258) vol = sec_heat_vars%vol
4259) dm_plus = sec_heat_vars%dm_plus
4260) dm_minus = sec_heat_vars%dm_minus
4261) area_fm = sec_heat_vars%interfacial_area
4262) ! temp_primary_node = global_auxvar%temp
4263) temp_primary_node = auxvar%temp
4264)
4265) coeff_left = 0.d0
4266) coeff_diag = 0.d0
4267) coeff_right = 0.d0
4268) rhs = 0.d0
4269)
4270) alpha = option%flow_dt*therm_conductivity/dencpr
4271)
4272)
4273) ! Setting the coefficients
4274) do i = 2, ngcells-1
4275) coeff_left(i) = -alpha*area(i-1)/((dm_minus(i) + dm_plus(i-1))*vol(i))
4276) coeff_diag(i) = alpha*area(i-1)/((dm_minus(i) + dm_plus(i-1))*vol(i)) + &
4277) alpha*area(i)/((dm_minus(i+1) + dm_plus(i))*vol(i)) + 1.d0
4278) coeff_right(i) = -alpha*area(i)/((dm_minus(i+1) + dm_plus(i))*vol(i))
4279) enddo
4280)
4281) coeff_diag(1) = alpha*area(1)/((dm_minus(2) + dm_plus(1))*vol(1)) + 1.d0
4282) coeff_right(1) = -alpha*area(1)/((dm_minus(2) + dm_plus(1))*vol(1))
4283)
4284) coeff_left(ngcells) = -alpha*area(ngcells-1)/ &
4285) ((dm_minus(ngcells) + dm_plus(ngcells-1))*vol(ngcells))
4286) coeff_diag(ngcells) = alpha*area(ngcells-1)/ &
4287) ((dm_minus(ngcells) + dm_plus(ngcells-1))*vol(ngcells)) &
4288) + alpha*area(ngcells)/(dm_plus(ngcells)*vol(ngcells)) &
4289) + 1.d0
4290)
4291) rhs = sec_heat_vars%sec_temp ! secondary continuum values from previous time step
4292) rhs(ngcells) = rhs(ngcells) + &
4293) alpha*area(ngcells)/(dm_plus(ngcells)*vol(ngcells))* &
4294) temp_primary_node
4295)
4296) ! Thomas algorithm for tridiagonal system
4297) ! Forward elimination
4298) do i = 2, ngcells
4299) m = coeff_left(i)/coeff_diag(i-1)
4300) coeff_diag(i) = coeff_diag(i) - m*coeff_right(i-1)
4301) rhs(i) = rhs(i) - m*rhs(i-1)
4302) enddo
4303)
4304) ! Back substitution
4305) ! We only need the temperature at the outer-most node (closest to primary node)
4306) temp_current_N = rhs(ngcells)/coeff_diag(ngcells)
4307)
4308) ! Calculate the coupling term
4309) res_heat = area_fm*therm_conductivity*(temp_current_N - temp_primary_node)/ &
4310) dm_plus(ngcells)
4311)
4312) end subroutine MphaseSecondaryHeat
4313)
4314) ! ************************************************************************** !
4315)
4316) subroutine MphaseSecondaryHeatJacobian(sec_heat_vars, &
4317) therm_conductivity, &
4318) dencpr, &
4319) option,jac_heat)
4320) !
4321) ! Calculates the source term jacobian contribution
4322) ! due to secondary continuum in the primary continuum residual
4323) !
4324) ! Author: Satish Karra, LANL
4325) ! Date: 06/6/12
4326) !
4327)
4328) use Option_module
4329) use Global_Aux_module
4330) use Secondary_Continuum_Aux_module
4331)
4332) implicit none
4333)
4334) type(sec_heat_type) :: sec_heat_vars
4335) type(option_type) :: option
4336) PetscReal :: coeff_left(sec_heat_vars%ncells)
4337) PetscReal :: coeff_diag(sec_heat_vars%ncells)
4338) PetscReal :: coeff_right(sec_heat_vars%ncells)
4339) PetscReal :: rhs(sec_heat_vars%ncells)
4340) PetscReal :: area(sec_heat_vars%ncells)
4341) PetscReal :: vol(sec_heat_vars%ncells)
4342) PetscReal :: dm_plus(sec_heat_vars%ncells)
4343) PetscReal :: dm_minus(sec_heat_vars%ncells)
4344) PetscInt :: i, ngcells
4345) PetscReal :: area_fm
4346) PetscReal :: alpha, therm_conductivity, dencpr
4347) PetscReal :: m
4348) PetscReal :: Dtemp_N_Dtemp_prim
4349) PetscReal :: jac_heat
4350)
4351) ngcells = sec_heat_vars%ncells
4352) area = sec_heat_vars%area
4353) vol = sec_heat_vars%vol
4354) dm_plus = sec_heat_vars%dm_plus
4355) area_fm = sec_heat_vars%interfacial_area
4356) dm_minus = sec_heat_vars%dm_minus
4357)
4358) coeff_left = 0.d0
4359) coeff_diag = 0.d0
4360) coeff_right = 0.d0
4361) rhs = 0.d0
4362)
4363) alpha = option%flow_dt*therm_conductivity/dencpr
4364)
4365)
4366) ! Setting the coefficients
4367) do i = 2, ngcells-1
4368) coeff_left(i) = -alpha*area(i-1)/((dm_minus(i) + dm_plus(i-1))*vol(i))
4369) coeff_diag(i) = alpha*area(i-1)/((dm_minus(i) + dm_plus(i-1))*vol(i)) + &
4370) alpha*area(i)/((dm_minus(i+1) + dm_plus(i))*vol(i)) + 1.d0
4371) coeff_right(i) = -alpha*area(i)/((dm_minus(i+1) + dm_plus(i))*vol(i))
4372) enddo
4373)
4374) coeff_diag(1) = alpha*area(1)/((dm_minus(2) + dm_plus(1))*vol(1)) + 1.d0
4375) coeff_right(1) = -alpha*area(1)/((dm_minus(2) + dm_plus(1))*vol(1))
4376)
4377) coeff_left(ngcells) = -alpha*area(ngcells-1)/ &
4378) ((dm_minus(ngcells) + dm_plus(ngcells-1))*vol(ngcells))
4379) coeff_diag(ngcells) = alpha*area(ngcells-1)/ &
4380) ((dm_minus(ngcells) + dm_plus(ngcells-1))*vol(ngcells)) &
4381) + alpha*area(ngcells)/(dm_plus(ngcells)*vol(ngcells)) &
4382) + 1.d0
4383)
4384) ! Thomas algorithm for tridiagonal system
4385) ! Forward elimination
4386) do i = 2, ngcells
4387) m = coeff_left(i)/coeff_diag(i-1)
4388) coeff_diag(i) = coeff_diag(i) - m*coeff_right(i-1)
4389) ! We do not have to calculate rhs terms
4390) enddo
4391)
4392) ! We need the temperature derivative at the outer-most node (closest to primary node)
4393) Dtemp_N_Dtemp_prim = 1.d0/coeff_diag(ngcells)*alpha*area(ngcells)/ &
4394) (dm_plus(ngcells)*vol(ngcells))
4395)
4396) ! Calculate the jacobian term
4397) jac_heat = area_fm*therm_conductivity*(Dtemp_N_Dtemp_prim - 1.d0)/ &
4398) dm_plus(ngcells)
4399)
4400)
4401) end subroutine MphaseSecondaryHeatJacobian
4402)
4403) ! ************************************************************************** !
4404)
4405) subroutine MphaseDestroy(realization)
4406) !
4407) ! Deallocates variables associated with Richard
4408) !
4409) ! Author: Glenn Hammond
4410) ! Date: 02/14/08
4411) !
4412)
4413) use Realization_Subsurface_class
4414)
4415) implicit none
4416)
4417) type(realization_subsurface_type) :: realization
4418)
4419) ! need to free array in aux vars
4420) !call MphaseAuxDestroy(patch%aux%mphase)
4421)
4422) end subroutine MphaseDestroy
4423)
4424) #if 0
4425)
4426) ! ************************************************************************** !
4427)
4428) subroutine MphaseCheckpointWrite(discretization, viewer)
4429) !
4430) ! Writes vecs to checkpoint file
4431) !
4432) use Discretization_module
4433)
4434) implicit none
4435)
4436) type(discretization_type) :: discretization
4437) PetscViewer :: viewer
4438)
4439) Vec :: global_var
4440) PetscErrorCode :: ierr
4441)
4442) call VecView(global_var,viewer,ierr);CHKERRQ(ierr)
4443) call VecDestroy(global_var,ierr);CHKERRQ(ierr)
4444)
4445) ! solid volume fraction
4446) if (mphase_option%rk > 0.d0) then
4447) call VecView(mphase_field%phis, viewer, ierr);CHKERRQ(ierr)
4448) endif
4449)
4450) end subroutine MphaseCheckpointWrite
4451)
4452) ! ************************************************************************** !
4453)
4454) subroutine MphaseCheckpointRead(discretization,viewer)
4455) !
4456) ! Reads vecs from checkpoint file
4457) !
4458) use Discretization_module
4459)
4460) implicit none
4461)
4462) type(discretization_type) :: discretization
4463) PetscViewer :: viewer
4464)
4465) Vec :: global_var
4466) PetscErrorCode :: ierr
4467)
4468) call VecLoad(global_var, viewer, ierr);CHKERRQ(ierr)
4469) call VecDestroy(global_var,ierr);CHKERRQ(ierr)
4470) ! solid volume fraction
4471) if (mphase_option%rk > 0.d0) then
4472) call VecLoad(mphase_field%phis, viewer, ierr);CHKERRQ(ierr)
4473) endif
4474)
4475) end subroutine MphaseCheckpointRead
4476)
4477) #endif
4478)
4479) end module Mphase_module