patch.F90 coverage: 70.73 %func 43.45 %block
1) module Patch_module
2)
3) use Option_module
4) use Grid_module
5) use Coupler_module
6) use Observation_module
7) use Integral_Flux_module
8) use Strata_module
9) use Region_module
10) use Reaction_Aux_module
11) use Dataset_Base_class
12) use Material_module
13) use Field_module
14) use Saturation_Function_module
15) use Characteristic_Curves_module
16) use Surface_Field_module
17) use Surface_Material_module
18) use Surface_Auxiliary_module
19)
20) use Auxiliary_module
21)
22) use PFLOTRAN_Constants_module
23)
24) implicit none
25)
26) private
27)
28) #include "petsc/finclude/petscsys.h"
29)
30) type, public :: patch_type
31)
32) PetscInt :: id
33)
34) ! These arrays will be used by all modes, mode-specific arrays should
35) ! go in the auxiliary data stucture for that mode
36) PetscInt, pointer :: imat(:)
37) PetscInt, pointer :: imat_internal_to_external(:)
38) PetscInt, pointer :: sat_func_id(:)
39)
40) PetscReal, pointer :: internal_velocities(:,:)
41) PetscReal, pointer :: boundary_velocities(:,:)
42) PetscReal, pointer :: internal_tran_coefs(:,:)
43) PetscReal, pointer :: boundary_tran_coefs(:,:)
44) PetscReal, pointer :: internal_flow_fluxes(:,:)
45) PetscReal, pointer :: boundary_flow_fluxes(:,:)
46) ! fluid fluxes in moles/sec
47) PetscReal, pointer :: ss_flow_fluxes(:,:)
48) ! volumetric flux (m^3/sec) for liquid phase needed for transport
49) PetscReal, pointer :: ss_flow_vol_fluxes(:,:)
50) PetscReal, pointer :: internal_tran_fluxes(:,:)
51) PetscReal, pointer :: boundary_tran_fluxes(:,:)
52) PetscReal, pointer :: ss_tran_fluxes(:,:)
53)
54) ! for TH surface/subsurface
55) PetscReal, pointer :: boundary_energy_flux(:,:)
56)
57) type(grid_type), pointer :: grid
58)
59) type(region_list_type), pointer :: region_list
60)
61) type(coupler_list_type), pointer :: boundary_condition_list
62) type(coupler_list_type), pointer :: initial_condition_list
63) type(coupler_list_type), pointer :: source_sink_list
64)
65) type(material_property_type), pointer :: material_properties
66) type(material_property_ptr_type), pointer :: material_property_array(:)
67) type(saturation_function_type), pointer :: saturation_functions
68) type(saturation_function_ptr_type), pointer :: saturation_function_array(:)
69) class(characteristic_curves_type), pointer :: characteristic_curves
70) type(characteristic_curves_ptr_type), pointer :: characteristic_curves_array(:)
71)
72) type(strata_list_type), pointer :: strata_list
73) type(observation_list_type), pointer :: observation_list
74) type(integral_flux_list_type), pointer :: integral_flux_list
75)
76) ! Pointers to objects in mother realization object
77) type(field_type), pointer :: field
78) type(reaction_type), pointer :: reaction
79) class(dataset_base_type), pointer :: datasets
80)
81) type(auxiliary_type) :: aux
82)
83) type(patch_type), pointer :: next
84)
85) PetscInt :: surf_or_subsurf_flag ! Flag to identify if the current patch
86) ! is a surface or subsurface (default)
87) type(surface_material_property_type), pointer :: surf_material_properties
88) type(surface_material_property_ptr_type), pointer :: surf_material_property_array(:)
89) type(surface_field_type), pointer :: surf_field
90) type(surface_auxiliary_type) :: surf_aux
91)
92) end type patch_type
93)
94) ! pointer data structure required for making an array of patch pointers in F90
95) type, public :: patch_ptr_type
96) type(patch_type), pointer :: ptr ! pointer to the patch_type
97) end type patch_ptr_type
98)
99) type, public :: patch_list_type
100) PetscInt :: num_patch_objects
101) type(patch_type), pointer :: first
102) type(patch_type), pointer :: last
103) type(patch_ptr_type), pointer :: array(:)
104) end type patch_list_type
105)
106) PetscInt, parameter, public :: INT_VAR = 0
107) PetscInt, parameter, public :: REAL_VAR = 1
108)
109) interface PatchGetVariable
110) module procedure PatchGetVariable1
111) module procedure PatchGetVariable2
112) end interface
113)
114) public :: PatchCreate, PatchDestroy, PatchCreateList, PatchDestroyList, &
115) PatchAddToList, PatchConvertListToArray, PatchProcessCouplers, &
116) PatchUpdateAllCouplerAuxVars, PatchInitAllCouplerAuxVars, &
117) PatchLocalizeRegions, PatchUpdateUniformVelocity, &
118) PatchGetVariable, PatchGetVariableValueAtCell, &
119) PatchSetVariable, PatchCouplerInputRecord, &
120) PatchInitConstraints, &
121) PatchCountCells, PatchGetIvarsFromKeyword, &
122) PatchGetVarNameFromKeyword, &
123) PatchCalculateCFL1Timestep, &
124) PatchGetCellCenteredVelocities, &
125) PatchGetCompMassInRegion, &
126) PatchGetCompMassInRegionAssign
127)
128) contains
129)
130) ! ************************************************************************** !
131)
132) function PatchCreate()
133) !
134) ! Allocates and initializes a new Patch object
135) !
136) ! Author: Glenn Hammond
137) ! Date: 02/22/08
138) !
139)
140) implicit none
141)
142) type(patch_type), pointer :: PatchCreate
143)
144) type(patch_type), pointer :: patch
145)
146) allocate(patch)
147)
148) patch%id = 0
149) patch%surf_or_subsurf_flag = SUBSURFACE
150) nullify(patch%imat)
151) nullify(patch%imat_internal_to_external)
152) nullify(patch%sat_func_id)
153) nullify(patch%internal_velocities)
154) nullify(patch%boundary_velocities)
155) nullify(patch%internal_tran_coefs)
156) nullify(patch%boundary_tran_coefs)
157) nullify(patch%internal_flow_fluxes)
158) nullify(patch%boundary_flow_fluxes)
159) nullify(patch%internal_tran_fluxes)
160) nullify(patch%boundary_tran_fluxes)
161) nullify(patch%ss_flow_fluxes)
162) nullify(patch%ss_tran_fluxes)
163) nullify(patch%ss_flow_vol_fluxes)
164) nullify(patch%boundary_energy_flux)
165)
166) nullify(patch%grid)
167)
168) allocate(patch%region_list)
169) call RegionInitList(patch%region_list)
170)
171) allocate(patch%boundary_condition_list)
172) call CouplerInitList(patch%boundary_condition_list)
173) allocate(patch%initial_condition_list)
174) call CouplerInitList(patch%initial_condition_list)
175) allocate(patch%source_sink_list)
176) call CouplerInitList(patch%source_sink_list)
177)
178) nullify(patch%material_properties)
179) nullify(patch%material_property_array)
180) nullify(patch%saturation_functions)
181) nullify(patch%saturation_function_array)
182) nullify(patch%characteristic_curves)
183) nullify(patch%characteristic_curves_array)
184)
185) allocate(patch%observation_list)
186) call ObservationInitList(patch%observation_list)
187) allocate(patch%integral_flux_list)
188) call IntegralFluxInitList(patch%integral_flux_list)
189) allocate(patch%strata_list)
190) call StrataInitList(patch%strata_list)
191)
192) call AuxInit(patch%aux)
193)
194) nullify(patch%field)
195) nullify(patch%reaction)
196) nullify(patch%datasets)
197)
198) nullify(patch%next)
199)
200) nullify(patch%surf_material_properties)
201) nullify(patch%surf_material_property_array)
202) nullify(patch%surf_field)
203) call SurfaceAuxInit(patch%surf_aux)
204)
205) PatchCreate => patch
206)
207) end function PatchCreate
208)
209) ! ************************************************************************** !
210)
211) function PatchCreateList()
212) !
213) ! PatchListCreate: Creates a patch list
214) !
215) ! Author: Glenn Hammond
216) ! Date: 02/22/08
217) !
218)
219) implicit none
220)
221) type(patch_list_type), pointer :: PatchCreateList
222)
223) type(patch_list_type), pointer :: patch_list
224)
225) allocate(patch_list)
226) nullify(patch_list%first)
227) nullify(patch_list%last)
228) nullify(patch_list%array)
229) patch_list%num_patch_objects = 0
230)
231) PatchCreateList => patch_list
232)
233) end function PatchCreateList
234)
235) ! ************************************************************************** !
236)
237) subroutine PatchAddToList(new_patch,patch_list)
238) !
239) ! Adds a new patch to list
240) !
241) ! Author: Glenn Hammond
242) ! Date: 02/22/08
243) !
244)
245) implicit none
246)
247) type(patch_type), pointer :: new_patch
248) type(patch_list_type) :: patch_list
249)
250) if (associated(new_patch)) then
251) patch_list%num_patch_objects = patch_list%num_patch_objects + 1
252) new_patch%id = patch_list%num_patch_objects
253) if (.not.associated(patch_list%first)) patch_list%first => new_patch
254) if (associated(patch_list%last)) patch_list%last%next => new_patch
255) patch_list%last => new_patch
256) end if
257) end subroutine PatchAddToList
258)
259) ! ************************************************************************** !
260)
261) subroutine PatchConvertListToArray(patch_list)
262) !
263) ! Creates an array of pointers to the
264) ! patchs in the patch list
265) !
266) ! Author: Glenn Hammond
267) ! Date: 02/22/08
268) !
269)
270) implicit none
271)
272) type(patch_list_type) :: patch_list
273)
274) PetscInt :: count
275) type(patch_type), pointer :: cur_patch
276)
277)
278) allocate(patch_list%array(patch_list%num_patch_objects))
279)
280) cur_patch => patch_list%first
281) do
282) if (.not.associated(cur_patch)) exit
283) patch_list%array(cur_patch%id)%ptr => cur_patch
284) cur_patch => cur_patch%next
285) enddo
286)
287) end subroutine PatchConvertListToArray
288)
289) ! ************************************************************************** !
290)
291) subroutine PatchLocalizeRegions(patch,regions,option)
292) !
293) ! Localizes regions within each patch
294) !
295) ! Author: Glenn Hammond
296) ! Date: 02/22/08
297) !
298)
299) use Option_module
300) use Output_Aux_module
301) use Region_module
302)
303) implicit none
304)
305) type(patch_type) :: patch
306) type(region_list_type) :: regions
307) type(option_type) :: option
308)
309) type(region_type), pointer :: cur_region
310) type(region_type), pointer :: patch_region
311)
312) cur_region => regions%first
313) do
314) if (.not.associated(cur_region)) exit
315) patch_region => RegionCreate(cur_region)
316) call RegionAddToList(patch_region,patch%region_list)
317) cur_region => cur_region%next
318) enddo
319)
320) !geh: All grids must be localized through GridLocalizeRegions. Patch
321) ! should not differentiate between structured/unstructured, etc.
322) call GridLocalizeRegions(patch%grid,patch%region_list,option)
323)
324) end subroutine PatchLocalizeRegions
325)
326) ! ************************************************************************** !
327)
328) subroutine PatchProcessCouplers(patch,flow_conditions,transport_conditions, &
329) option)
330) !
331) ! Assigns conditions and regions to couplers
332) !
333) ! Author: Glenn Hammond
334) ! Date: 02/22/08
335) !
336)
337) use Option_module
338) use Material_module
339) use Condition_module
340) use Transport_Constraint_module
341) use Connection_module
342)
343) implicit none
344)
345) type(patch_type) :: patch
346) type(condition_list_type) :: flow_conditions
347) type(tran_condition_list_type) :: transport_conditions
348) type(option_type) :: option
349)
350) type(coupler_type), pointer :: coupler
351) type(coupler_list_type), pointer :: coupler_list
352) type(strata_type), pointer :: strata
353) type(observation_type), pointer :: observation, next_observation
354) type(integral_flux_type), pointer :: integral_flux
355)
356) PetscInt :: temp_int, isub
357) PetscErrorCode :: ierr
358)
359) ! boundary conditions
360) coupler => patch%boundary_condition_list%first
361) do
362) if (.not.associated(coupler)) exit
363) ! pointer to region
364) coupler%region => RegionGetPtrFromList(coupler%region_name, &
365) patch%region_list)
366) if (.not.associated(coupler%region)) then
367) option%io_buffer = 'Region "' // trim(coupler%region_name) // &
368) '" in boundary condition "' // &
369) trim(coupler%name) // &
370) '" not found in region list'
371) call printErrMsg(option)
372) endif
373) if (associated(patch%grid%structured_grid)) then
374) if (coupler%region%num_cells > 0 .and. &
375) (coupler%region%iface == 0 .and. &
376) .not.associated(coupler%region%faces))) then
377) option%io_buffer = 'Region "' // trim(coupler%region_name) // &
378) '", which is tied to a boundary condition, has not ' // &
379) 'been assigned a face in the structured grid. '
380) call printErrMsg(option)
381) endif
382) endif
383) ! pointer to flow condition
384) if (option%nflowdof > 0) then
385) if (len_trim(coupler%flow_condition_name) > 0) then
386) coupler%flow_condition => &
387) FlowConditionGetPtrFromList(coupler%flow_condition_name,flow_conditions)
388) if (.not.associated(coupler%flow_condition)) then
389) option%io_buffer = 'Flow condition "' // &
390) trim(coupler%flow_condition_name) // &
391) '" in boundary condition "' // &
392) trim(coupler%name) // &
393) '" not found in flow condition list'
394) call printErrMsg(option)
395) endif
396) else
397) option%io_buffer = 'A FLOW_CONDITION must be specified in ' // &
398) 'BOUNDARY_CONDITION: ' // trim(coupler%name) // '.'
399) call printErrMsg(option)
400) endif
401) endif
402) ! pointer to transport condition
403) if (option%ntrandof > 0) then
404) if (len_trim(coupler%tran_condition_name) > 0) then
405) coupler%tran_condition => &
406) TranConditionGetPtrFromList(coupler%tran_condition_name,transport_conditions)
407) if (.not.associated(coupler%tran_condition)) then
408) option%io_buffer = 'Transport condition "' // &
409) trim(coupler%tran_condition_name) // &
410) '" in boundary condition "' // &
411) trim(coupler%name) // &
412) '" not found in transport condition list'
413) call printErrMsg(option)
414) endif
415) else
416) option%io_buffer = 'A TRANSPORT_CONDITION must be specified in ' // &
417) 'BOUNDARY_CONDITION: ' // trim(coupler%name) // '.'
418) call printErrMsg(option)
419) endif
420) endif
421) coupler => coupler%next
422) enddo
423)
424)
425) ! initial conditions
426) coupler => patch%initial_condition_list%first
427) do
428) if (.not.associated(coupler)) exit
429) ! pointer to region
430) coupler%region => RegionGetPtrFromList(coupler%region_name, &
431) patch%region_list)
432) if (.not.associated(coupler%region)) then
433) option%io_buffer = 'Region "' // trim(coupler%region_name) // &
434) '" in initial condition "' // &
435) trim(coupler%name) // &
436) '" not found in region list'
437) call printErrMsg(option)
438) endif
439) ! pointer to flow condition
440) if (option%nflowdof > 0) then
441) if (len_trim(coupler%flow_condition_name) > 0) then
442) coupler%flow_condition => &
443) FlowConditionGetPtrFromList(coupler%flow_condition_name,flow_conditions)
444) if (.not.associated(coupler%flow_condition)) then
445) option%io_buffer = 'Flow condition "' // &
446) trim(coupler%flow_condition_name) // &
447) '" in initial condition "' // &
448) trim(coupler%name) // &
449) '" not found in flow condition list'
450) call printErrMsg(option)
451) endif
452) else
453) option%io_buffer = 'A FLOW_CONDITION must be specified in ' // &
454) 'INITIAL_CONDITION: ' // trim(coupler%name) // '.'
455) call printErrMsg(option)
456) endif
457) endif
458) ! pointer to transport condition
459) if (option%ntrandof > 0) then
460) if (len_trim(coupler%tran_condition_name) > 0) then
461) coupler%tran_condition => &
462) TranConditionGetPtrFromList(coupler%tran_condition_name,transport_conditions)
463) if (.not.associated(coupler%tran_condition)) then
464) option%io_buffer = 'Transport condition "' // &
465) trim(coupler%tran_condition_name) // &
466) '" in initial condition "' // &
467) trim(coupler%name) // &
468) '" not found in transport condition list'
469) call printErrMsg(option)
470) endif
471) else
472) option%io_buffer = 'A TRANSPORT_CONDITION must be specified in ' // &
473) 'INITIAL_CONDITION: ' // trim(coupler%name) // '.'
474) call printErrMsg(option)
475) endif
476) endif
477) coupler => coupler%next
478) enddo
479)
480) ! source/sinks
481) coupler => patch%source_sink_list%first
482) do
483) if (.not.associated(coupler)) exit
484) ! pointer to region
485) coupler%region => RegionGetPtrFromList(coupler%region_name, &
486) patch%region_list)
487) if (.not.associated(coupler%region)) then
488) option%io_buffer = 'Region "' // trim(coupler%region_name) // &
489) '" in source/sink "' // &
490) trim(coupler%name) // &
491) '" not found in region list'
492) call printErrMsg(option)
493) endif
494) ! pointer to flow condition
495) if (option%nflowdof > 0) then
496) if (len_trim(coupler%flow_condition_name) > 0) then
497) coupler%flow_condition => &
498) FlowConditionGetPtrFromList(coupler%flow_condition_name,flow_conditions)
499) if (.not.associated(coupler%flow_condition)) then
500) option%io_buffer = 'Flow condition "' // &
501) trim(coupler%flow_condition_name) // &
502) '" in source/sink "' // &
503) trim(coupler%name) // &
504) '" not found in flow condition list'
505) call printErrMsg(option)
506) endif
507) ! check to ensure that a rate subcondition exists
508) if (.not.associated(coupler%flow_condition%rate) .and. &
509) .not.associated(coupler%flow_condition%well)) then
510) temp_int = 0
511) if (associated(coupler%flow_condition%general)) then
512) if (associated(coupler%flow_condition%general%rate)) then
513) temp_int = 1
514) endif
515) endif
516) if (associated(coupler%flow_condition%toil_ims)) then
517) if (associated(coupler%flow_condition%toil_ims%rate)) then
518) temp_int = 1
519) endif
520) end if
521) if (temp_int == 0) then
522) option%io_buffer = 'FLOW_CONDITIONs associated with ' // &
523) 'SOURCE_SINKs must have a RATE or WELL expression within them.'
524) call printErrMsg(option)
525) endif
526) endif
527) else
528) option%io_buffer = 'A FLOW_CONDITION must be specified in ' // &
529) 'SOURCE_SINK: ' // trim(coupler%name) // '.'
530) call printErrMsg(option)
531) endif
532) endif
533) ! pointer to transport condition
534) if (option%ntrandof > 0) then
535) if (len_trim(coupler%tran_condition_name) > 0) then
536) coupler%tran_condition => &
537) TranConditionGetPtrFromList(coupler%tran_condition_name, &
538) transport_conditions)
539) if (.not.associated(coupler%tran_condition)) then
540) option%io_buffer = 'Transport condition "' // &
541) trim(coupler%flow_condition_name) // &
542) '" in source/sink "' // &
543) trim(coupler%name) // &
544) '" not found in transport condition list'
545) call printErrMsg(option)
546) endif
547) else
548) option%io_buffer = 'A TRANSPORT_CONDITION must be specified in ' // &
549) 'SOURCE_SINK: ' // trim(coupler%name) // '.'
550) call printErrMsg(option)
551) endif
552) endif
553) coupler => coupler%next
554) enddo
555)
556) !----------------------------
557) ! AUX
558)
559) ! strata
560) ! connect pointers from strata to regions
561) strata => patch%strata_list%first
562) do
563) if (.not.associated(strata)) exit
564) ! pointer to region
565) if (len_trim(strata%region_name) > 0) then
566) strata%region => RegionGetPtrFromList(strata%region_name, &
567) patch%region_list)
568) if (.not.associated(strata%region)) then
569) option%io_buffer = 'Region "' // trim(strata%region_name) // &
570) '" in strata not found in region list'
571) call printErrMsg(option)
572) endif
573) if (strata%active) then
574) ! pointer to material
575) ! gb: Depending on a surface/subsurface patch, use corresponding
576) ! material properties
577) if (patch%surf_or_subsurf_flag == SUBSURFACE) then
578) strata%material_property => &
579) MaterialPropGetPtrFromArray(strata%material_property_name, &
580) patch%material_property_array)
581) if (.not.associated(strata%material_property)) then
582) option%io_buffer = 'Material "' // &
583) trim(strata%material_property_name) // &
584) '" not found in material list'
585) call printErrMsg(option)
586) endif
587) endif
588)
589) if (patch%surf_or_subsurf_flag == SURFACE) then
590) strata%surf_material_property => &
591) SurfaceMaterialPropGetPtrFromArray(strata%material_property_name, &
592) patch%surf_material_property_array)
593) if (.not.associated(strata%surf_material_property)) then
594) option%io_buffer = 'Material "' // &
595) trim(strata%material_property_name) // &
596) '" not found in material list'
597) call printErrMsg(option)
598) endif
599) endif
600)
601) endif
602) else
603) nullify(strata%region)
604) nullify(strata%material_property)
605) endif
606) strata => strata%next
607) enddo
608)
609) ! connectivity between initial conditions, boundary conditions, srcs/sinks, etc and grid
610) call CouplerListComputeConnections(patch%grid,option, &
611) patch%initial_condition_list)
612) call CouplerListComputeConnections(patch%grid,option, &
613) patch%boundary_condition_list)
614) call CouplerListComputeConnections(patch%grid,option, &
615) patch%source_sink_list)
616)
617) ! linkage of observation to regions and couplers must take place after
618) ! connection list have been created.
619) ! observation
620) observation => patch%observation_list%first
621) do
622) if (.not.associated(observation)) exit
623) next_observation => observation%next
624) select case(observation%itype)
625) case(OBSERVATION_SCALAR)
626) ! pointer to region
627) observation%region => RegionGetPtrFromList(observation%linkage_name, &
628) patch%region_list)
629) if (.not.associated(observation%region)) then
630) option%io_buffer = 'Region "' // &
631) trim(observation%linkage_name) // &
632) '" in observation point "' // &
633) trim(observation%name) // &
634) '" not found in region list'
635) call printErrMsg(option)
636) endif
637) call MPI_Allreduce(observation%region%num_cells,temp_int, &
638) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
639) option%mycomm,ierr)
640) if (temp_int == 0) then
641) option%io_buffer = 'Region "' // trim(observation%region%name) // &
642) '" is used in an observation point but lies outside the ' // &
643) 'model domain.'
644) call printErrMsg(option)
645) endif
646) if (observation%region%num_cells == 0) then
647) ! remove the observation object
648) call ObservationRemoveFromList(observation,patch%observation_list)
649) endif
650) case(OBSERVATION_FLUX)
651) coupler => CouplerGetPtrFromList(observation%linkage_name, &
652) patch%boundary_condition_list)
653) if (associated(coupler)) then
654) observation%connection_set => coupler%connection_set
655) else
656) option%io_buffer = 'Boundary Condition "' // &
657) trim(observation%linkage_name) // &
658) '" not found in Boundary Condition list'
659) call printErrMsg(option)
660) endif
661) if (observation%connection_set%num_connections == 0) then
662) ! cannot remove from list, since there must be a global reduction
663) ! across all procs
664) ! therefore, just nullify connection set
665) nullify(observation%connection_set)
666) endif
667) end select
668) observation => next_observation
669) enddo
670)
671) ! linkage of observation to regions and couplers must take place after
672) ! connection list have been created.
673) ! observation
674) integral_flux => patch%integral_flux_list%first
675) do
676) if (.not.associated(integral_flux)) exit
677) integral_flux%connections => &
678) PatchGetConnectionsFromCoords(patch,integral_flux%coordinates, &
679) integral_flux%name,option)
680) call IntegralFluxSizeStorage(integral_flux,option)
681) integral_flux => integral_flux%next
682) option%flow%store_fluxes = PETSC_TRUE
683) option%transport%store_fluxes = PETSC_TRUE
684) enddo
685)
686) temp_int = ConnectionGetNumberInList(patch%grid%internal_connection_set_list)
687) temp_int = max(temp_int,1)
688)
689) ! all simulations
690) allocate(patch%internal_velocities(option%nphase,temp_int))
691) patch%internal_velocities = 0.d0
692)
693) ! flow
694) if (option%nflowdof > 0) then
695) if (option%flow%store_fluxes .or. (patch%surf_or_subsurf_flag == SURFACE) ) then
696) allocate(patch%internal_flow_fluxes(option%nflowdof,temp_int))
697) patch%internal_flow_fluxes = 0.d0
698) endif
699) endif
700)
701) ! transport
702) if (option%ntrandof > 0) then
703) allocate(patch%internal_tran_coefs(option%nphase,temp_int))
704) patch%internal_tran_coefs = 0.d0
705) if (option%transport%store_fluxes) then
706) allocate(patch%internal_tran_fluxes(option%ntrandof,temp_int))
707) patch%internal_tran_fluxes = 0.d0
708) endif
709) endif
710)
711) temp_int = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
712)
713) if (temp_int > 0) then
714) ! all simulations
715) allocate(patch%boundary_velocities(option%nphase,temp_int))
716) patch%boundary_velocities = 0.d0
717) ! flow
718) if (option%nflowdof > 0) then
719) if (option%flow%store_fluxes .or. (patch%surf_or_subsurf_flag == SURFACE)) then
720) allocate(patch%boundary_flow_fluxes(option%nflowdof,temp_int))
721) patch%boundary_flow_fluxes = 0.d0
722) endif
723) ! surface/subsurface storage
724) if (option%iflowmode == TH_MODE) then
725) allocate(patch%boundary_energy_flux(2,temp_int))
726) patch%boundary_energy_flux = 0.d0
727) endif
728) endif
729) ! transport
730) if (option%ntrandof > 0) then
731) allocate(patch%boundary_tran_coefs(option%nphase,temp_int))
732) patch%boundary_tran_coefs = 0.d0
733) if (option%transport%store_fluxes) then
734) allocate(patch%boundary_tran_fluxes(option%ntrandof,temp_int))
735) patch%boundary_tran_fluxes = 0.d0
736) endif
737) endif
738) endif
739)
740) temp_int = CouplerGetNumConnectionsInList(patch%source_sink_list)
741) if (temp_int > 0) then
742) ! flow
743) if (option%nflowdof > 0) then
744) allocate(patch%ss_flow_fluxes(option%nflowdof,temp_int))
745) patch%ss_flow_fluxes = 0.d0
746) endif
747) ! transport
748) if (option%ntrandof > 0) then
749) allocate(patch%ss_tran_fluxes(option%ntrandof,temp_int))
750) patch%ss_tran_fluxes = 0.d0
751) ! only needed by transport
752) allocate(patch%ss_flow_vol_fluxes(option%nphase,temp_int))
753) patch%ss_flow_vol_fluxes = 0.d0
754) endif
755) endif
756)
757) end subroutine PatchProcessCouplers
758)
759) ! ************************************************************************** !
760)
761) subroutine PatchInitAllCouplerAuxVars(patch,option)
762) !
763) ! Initializes coupler auxillary variables
764) ! within list
765) !
766) ! Author: Glenn Hammond
767) ! Date: 02/22/08
768) !
769)
770) use Option_module
771) use Reaction_Aux_module
772)
773) implicit none
774)
775) type(patch_type), pointer :: patch
776) type(option_type) :: option
777)
778) PetscBool :: force_update_flag = PETSC_TRUE
779)
780) call PatchInitCouplerAuxVars(patch%initial_condition_list,patch, &
781) option)
782) call PatchInitCouplerAuxVars(patch%boundary_condition_list,patch, &
783) option)
784) call PatchInitCouplerAuxVars(patch%source_sink_list,patch, &
785) option)
786)
787) !geh: This should not be included in PatchUpdateAllCouplerAuxVars
788) ! as it will result in excessive updates to initial conditions
789) ! that are not necessary after the simulation has started time stepping.
790) call PatchUpdateCouplerAuxVars(patch,patch%initial_condition_list, &
791) force_update_flag,option)
792) call PatchUpdateAllCouplerAuxVars(patch,force_update_flag,option)
793)
794) end subroutine PatchInitAllCouplerAuxVars
795)
796) ! ************************************************************************** !
797)
798) subroutine PatchInitCouplerAuxVars(coupler_list,patch,option)
799) !
800) ! Initializes coupler auxillary variables
801) ! within list
802) !
803) ! Author: Glenn Hammond
804) ! Date: 02/22/08
805) !
806)
807) use Option_module
808) use Connection_module
809) use Reaction_Aux_module
810) use Reactive_Transport_Aux_module
811) use Global_Aux_module
812) use Condition_module
813) use Transport_Constraint_module
814) use General_Aux_module
815) use TOilIms_Aux_module
816)
817) implicit none
818)
819) type(coupler_list_type), pointer :: coupler_list
820) type(patch_type), pointer :: patch
821) type(option_type) :: option
822)
823) PetscInt :: num_connections
824) PetscBool :: force_update_flag
825)
826) type(coupler_type), pointer :: coupler
827) type(tran_constraint_coupler_type), pointer :: cur_constraint_coupler
828) PetscInt :: idof
829) character(len=MAXSTRINGLENGTH) :: string
830)
831) if (.not.associated(coupler_list)) return
832)
833) coupler => coupler_list%first
834) do
835) if (.not.associated(coupler)) exit
836)
837) if (associated(coupler%connection_set)) then
838) num_connections = coupler%connection_set%num_connections
839)
840) ! FLOW
841) if (associated(coupler%flow_condition)) then
842) ! determine whether flow_condition is transient
843) coupler%flow_condition%is_transient = &
844) FlowConditionIsTransient(coupler%flow_condition)
845) if (coupler%itype == INITIAL_COUPLER_TYPE .or. &
846) coupler%itype == BOUNDARY_COUPLER_TYPE) then
847)
848) if (associated(coupler%flow_condition%pressure) .or. &
849) associated(coupler%flow_condition%concentration) .or. &
850) associated(coupler%flow_condition%saturation) .or. &
851) associated(coupler%flow_condition%rate) .or. &
852) associated(coupler%flow_condition%temperature) .or. &
853) associated(coupler%flow_condition%toil_ims) .or. &
854) associated(coupler%flow_condition%general)) then
855)
856) ! allocate arrays that match the number of connections
857) select case(option%iflowmode)
858)
859) case(RICHARDS_MODE)
860) allocate(coupler%flow_aux_real_var(2,num_connections))
861) allocate(coupler%flow_aux_int_var(1,num_connections))
862) coupler%flow_aux_real_var = 0.d0
863) coupler%flow_aux_int_var = 0
864)
865) case(TH_MODE)
866) allocate(coupler%flow_aux_real_var(option%nflowdof* &
867) option%nphase,num_connections))
868) allocate(coupler%flow_aux_int_var(1,num_connections))
869) coupler%flow_aux_real_var = 0.d0
870) coupler%flow_aux_int_var = 0
871)
872) case(MPH_MODE, IMS_MODE, FLASH2_MODE, MIS_MODE)
873) allocate(coupler%flow_aux_real_var(option%nflowdof, &
874) num_connections))
875) allocate(coupler%flow_aux_int_var(1,num_connections))
876) coupler%flow_aux_real_var = 0.d0
877) coupler%flow_aux_int_var = 0
878)
879) case(G_MODE)
880) allocate(coupler%flow_aux_mapping(GENERAL_MAX_INDEX))
881) allocate(coupler%flow_bc_type(THREE_INTEGER))
882) allocate(coupler%flow_aux_real_var(FIVE_INTEGER, &
883) num_connections))
884) allocate(coupler%flow_aux_int_var(ONE_INTEGER,num_connections))
885) coupler%flow_aux_mapping = 0
886) coupler%flow_bc_type = 0
887) coupler%flow_aux_real_var = 0.d0
888) coupler%flow_aux_int_var = 0
889)
890) case(TOIL_IMS_MODE)
891) allocate(coupler%flow_aux_mapping(TOIL_IMS_MAX_INDEX))
892) allocate(coupler%flow_bc_type(THREE_INTEGER))
893) allocate(coupler%flow_aux_real_var(option%nflowdof, &
894) num_connections))
895) coupler%flow_aux_mapping = 0
896) coupler%flow_bc_type = 0
897) coupler%flow_aux_real_var = 0.d0
898)
899) case default
900) end select
901)
902) endif ! associated(coupler%flow_condition%pressure)
903)
904) else if (coupler%itype == SRC_SINK_COUPLER_TYPE) then
905)
906) if (associated(coupler%flow_condition%rate)) then
907)
908) select case(coupler%flow_condition%rate%itype)
909) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS, &
910) VOLUMETRIC_RATE_SS,MASS_RATE_SS, &
911) HET_VOL_RATE_SS,HET_MASS_RATE_SS)
912) select case(option%iflowmode)
913) case(RICHARDS_MODE)
914) allocate(coupler%flow_aux_real_var(1,num_connections))
915) coupler%flow_aux_real_var = 0.d0
916) case(TH_MODE)
917) allocate(coupler%flow_aux_real_var(option%nflowdof,num_connections))
918) coupler%flow_aux_real_var = 0.d0
919) case(MPH_MODE,FLASH2_MODE,MIS_MODE,IMS_MODE)
920) ! do nothing
921) case default
922) string = GetSubConditionName(coupler%flow_condition%rate%itype)
923) option%io_buffer='Source/Sink of rate%itype = "' // &
924) trim(adjustl(string)) // '", not implemented in this mode.'
925) call printErrMsg(option)
926) end select
927) case default
928) string = GetSubConditionName(coupler%flow_condition%rate%itype)
929) option%io_buffer = &
930) FlowConditionUnknownItype(coupler%flow_condition,'rate', &
931) string)
932) call printErrMsg(option)
933) end select
934) ! handles source/sinks in general mode
935) else if (associated(coupler%flow_condition%general)) then
936) if (associated(coupler%flow_condition%general%rate)) then
937) select case(coupler%flow_condition%general%rate%itype)
938) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
939) allocate(coupler%flow_aux_real_var(1,num_connections))
940) coupler%flow_aux_real_var = 0.d0
941) end select
942) endif
943) ! source/sinks for toil_ims
944) else if (associated(coupler%flow_condition%toil_ims)) then
945) if (associated(coupler%flow_condition%toil_ims%rate)) then
946) select case(coupler%flow_condition%toil_ims%rate%itype)
947) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
948) allocate(coupler%flow_aux_real_var(1,num_connections))
949) coupler%flow_aux_real_var = 0.d0
950) end select
951) endif
952) endif ! associated(coupler%flow_condition%rate)
953) endif ! coupler%itype == SRC_SINK_COUPLER_TYPE
954) endif ! associated(coupler%flow_condition)
955) endif ! associated(coupler%connection_set)
956)
957) ! TRANSPORT
958) if (associated(coupler%tran_condition)) then
959) cur_constraint_coupler => &
960) coupler%tran_condition%constraint_coupler_list
961) do
962) if (.not.associated(cur_constraint_coupler)) exit
963) ! Setting option%iflag = 0 ensures that the "mass_balance" array
964) ! is not allocated.
965) option%iflag = 0
966) ! Only allocate the XXX_auxvar objects if they have not been allocated.
967) ! Since coupler%tran_condition is a pointer to a separate list of
968) ! tran conditions, the XXX_auxvar object may already be allocated.
969) if (.not.associated(cur_constraint_coupler%global_auxvar)) then
970) allocate(cur_constraint_coupler%global_auxvar)
971) call GlobalAuxVarInit(cur_constraint_coupler%global_auxvar,option)
972) endif
973) if (.not.associated(cur_constraint_coupler%rt_auxvar)) then
974) allocate(cur_constraint_coupler%rt_auxvar)
975) call RTAuxVarInit(cur_constraint_coupler%rt_auxvar,patch%reaction, &
976) option)
977) endif
978) cur_constraint_coupler => cur_constraint_coupler%next
979) enddo
980) endif
981)
982) coupler => coupler%next
983) enddo
984)
985) end subroutine PatchInitCouplerAuxVars
986)
987) ! ************************************************************************** !
988)
989) subroutine PatchUpdateAllCouplerAuxVars(patch,force_update_flag,option)
990) !
991) ! Updates auxiliary variables associated
992) ! with couplers in list
993) !
994) ! Author: Glenn Hammond
995) ! Date: 02/22/08
996) !
997)
998) use Option_module
999)
1000) implicit none
1001)
1002) type(patch_type) :: patch
1003) PetscBool :: force_update_flag
1004) type(option_type) :: option
1005)
1006) PetscInt :: iconn
1007)
1008) !geh: no need to update initial conditions as they only need updating
1009) ! once as performed in PatchInitCouplerAuxVars()
1010) call PatchUpdateCouplerAuxVars(patch,patch%boundary_condition_list, &
1011) force_update_flag,option)
1012) call PatchUpdateCouplerAuxVars(patch,patch%source_sink_list, &
1013) force_update_flag,option)
1014)
1015) ! stop
1016) end subroutine PatchUpdateAllCouplerAuxVars
1017)
1018) ! ************************************************************************** !
1019)
1020) subroutine PatchUpdateCouplerAuxVars(patch,coupler_list,force_update_flag, &
1021) option)
1022) !
1023) ! Updates auxiliary variables associated
1024) ! with couplers in list
1025) !
1026) ! Author: Glenn Hammond
1027) ! Date: 11/26/07
1028) !
1029) use Option_module
1030) use Condition_module
1031) use Hydrostatic_module
1032) use Saturation_module
1033)
1034)
1035) use General_Aux_module
1036) use Grid_module
1037) use Dataset_Common_HDF5_class
1038) use Dataset_Gridded_HDF5_class
1039)
1040) implicit none
1041)
1042) type(patch_type) :: patch
1043) type(coupler_list_type), pointer :: coupler_list
1044) PetscBool :: force_update_flag
1045) type(option_type) :: option
1046)
1047) type(coupler_type), pointer :: coupler
1048) type(flow_condition_type), pointer :: flow_condition
1049)
1050) if (.not.associated(coupler_list)) return
1051)
1052) coupler => coupler_list%first
1053)
1054) do
1055) if (.not.associated(coupler)) exit
1056)
1057) ! FLOW
1058) if (associated(coupler%flow_aux_real_var)) then
1059)
1060) flow_condition => coupler%flow_condition
1061) if (force_update_flag .or. flow_condition%is_transient) then
1062) select case(option%iflowmode)
1063) case(G_MODE)
1064) call PatchUpdateCouplerAuxVarsG(patch,coupler,option)
1065) case(MPH_MODE)
1066) call PatchUpdateCouplerAuxVarsMPH(patch,coupler,option)
1067) case(IMS_MODE)
1068) call PatchUpdateCouplerAuxVarsIMS(patch,coupler,option)
1069) case(FLASH2_MODE)
1070) call PatchUpdateCouplerAuxVarsFLASH2(patch,coupler,option)
1071) case(TH_MODE)
1072) call PatchUpdateCouplerAuxVarsTH(patch,coupler,option)
1073) case(MIS_MODE)
1074) call PatchUpdateCouplerAuxVarsMIS(patch,coupler,option)
1075) case(RICHARDS_MODE)
1076) call PatchUpdateCouplerAuxVarsRich(patch,coupler,option)
1077) case(TOIL_IMS_MODE)
1078) call PatchUpdateCouplerAuxVarsTOI(patch,coupler,option)
1079) end select
1080) endif
1081) endif
1082)
1083) ! TRANSPORT
1084) ! nothing for transport at this point in time
1085) coupler => coupler%next
1086) enddo
1087)
1088) end subroutine PatchUpdateCouplerAuxVars
1089)
1090) ! ************************************************************************** !
1091)
1092) subroutine PatchUpdateCouplerAuxVarsG(patch,coupler,option)
1093) !
1094) ! Updates flow auxiliary variables associated
1095) ! with a coupler for G_MODE
1096) !
1097) ! Author: Glenn Hammond
1098) ! Date: 11/26/13
1099) !
1100)
1101) use Option_module
1102) use Condition_module
1103) use Hydrostatic_module
1104) use Saturation_module
1105) use EOS_Water_module
1106)
1107) use General_Aux_module
1108) use Grid_module
1109) use Dataset_Common_HDF5_class
1110) use Dataset_Gridded_HDF5_class
1111) use Dataset_Ascii_class
1112) use Dataset_module
1113)
1114) implicit none
1115)
1116) type(patch_type) :: patch
1117) type(coupler_type), pointer :: coupler
1118) type(option_type) :: option
1119)
1120) type(flow_condition_type), pointer :: flow_condition
1121) type(tran_condition_type), pointer :: tran_condition
1122) type(flow_general_condition_type), pointer :: general
1123) PetscBool :: update
1124) PetscBool :: dof1, dof2, dof3
1125) PetscReal :: temperature, p_sat, p_air, p_gas, p_cap, s_liq
1126) PetscReal :: relative_humidity
1127) PetscReal :: dummy_real
1128) PetscReal :: x(option%nflowdof)
1129) character(len=MAXSTRINGLENGTH) :: string, string2
1130) PetscErrorCode :: ierr
1131)
1132) PetscInt :: idof, num_connections,sum_connection
1133) PetscInt :: iconn, local_id, ghosted_id
1134) ! use to map flow_aux_map to the flow_aux_real_var array
1135) PetscInt :: real_count
1136)
1137) num_connections = coupler%connection_set%num_connections
1138)
1139) flow_condition => coupler%flow_condition
1140)
1141) general => flow_condition%general
1142) dof1 = PETSC_FALSE
1143) dof2 = PETSC_FALSE
1144) dof3 = PETSC_FALSE
1145) real_count = 0
1146) select case(flow_condition%iphase)
1147) case(TWO_PHASE_STATE)
1148) coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = TWO_PHASE_STATE
1149) real_count = real_count + 1
1150) select case(general%gas_pressure%itype)
1151) case(DIRICHLET_BC)
1152) coupler%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX) = real_count
1153) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1154) general%gas_pressure%dataset%rarray(1)
1155) dof1 = PETSC_TRUE
1156) coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
1157) case default
1158) string = &
1159) GetSubConditionName(general%gas_pressure%itype)
1160) option%io_buffer = &
1161) FlowConditionUnknownItype(coupler%flow_condition, &
1162) 'general two phase state gas pressure',string)
1163) call printErrMsg(option)
1164) end select
1165) ! in two-phase flow, air pressure is second dof
1166) real_count = real_count + 1
1167) select case(general%temperature%itype)
1168) case(DIRICHLET_BC)
1169) coupler%flow_aux_mapping(general_2ph_energy_dof) = real_count
1170) temperature = general%temperature%dataset%rarray(1)
1171) if (general_2ph_energy_dof == GENERAL_TEMPERATURE_INDEX) then
1172) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1173) temperature
1174) else
1175) call EOSWaterSaturationPressure(temperature,p_sat,ierr)
1176) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1177) general%gas_pressure%dataset%rarray(1) - p_sat
1178) endif
1179) dof3 = PETSC_TRUE
1180) coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
1181) case default
1182) string = &
1183) GetSubConditionName(general%temperature%itype)
1184) option%io_buffer = &
1185) FlowConditionUnknownItype(coupler%flow_condition, &
1186) 'general two phase state temperature',string)
1187) call printErrMsg(option)
1188) end select
1189) ! in two-phase flow, gas saturation is third dof
1190) real_count = real_count + 1
1191) select case(general%gas_saturation%itype)
1192) case(DIRICHLET_BC)
1193) coupler%flow_aux_mapping(GENERAL_GAS_SATURATION_INDEX) = real_count
1194) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1195) general%gas_saturation%dataset%rarray(1)
1196) dof2 = PETSC_TRUE
1197) coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = DIRICHLET_BC
1198) case default
1199) string = &
1200) GetSubConditionName(general%gas_saturation%itype)
1201) option%io_buffer = &
1202) FlowConditionUnknownItype(coupler%flow_condition, &
1203) 'general two phase state gas saturation',string)
1204) call printErrMsg(option)
1205) end select
1206) case(LIQUID_STATE)
1207) coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = LIQUID_STATE
1208) if (general%liquid_pressure%itype == HYDROSTATIC_BC) then
1209) ! option%io_buffer = 'Hydrostatic BC for general phase cannot possibly ' // &
1210) ! 'be set up correctly. - GEH'
1211) ! call printErrMsg(option)
1212) if (general%mole_fraction%itype /= DIRICHLET_BC) then
1213) option%io_buffer = &
1214) 'Hydrostatic liquid state pressure bc for flow condition "' // &
1215) trim(flow_condition%name) // &
1216) '" requires a mole fraction bc of type dirichlet'
1217) call printErrMsg(option)
1218) endif
1219) if (general%temperature%itype /= DIRICHLET_BC) then
1220) option%io_buffer = &
1221) 'Hydrostatic liquid state pressure bc for flow condition "' // &
1222) trim(flow_condition%name) // &
1223) '" requires a temperature bc of type dirichlet'
1224) call printErrMsg(option)
1225) endif
1226) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
1227) do iconn=1,coupler%connection_set%num_connections
1228) if (coupler%flow_aux_int_var(ONE_INTEGER,iconn) == TWO_PHASE_STATE) then
1229) !geh: This cannot possibly be working. real_count needs to be incremented
1230) ! but what variable is mapped? Need to figure out how real_count
1231) ! factors into the hydrostatic condition
1232) option%io_buffer = 'Need to fix PatchUpdateCouplerAuxVarsG() ' // &
1233) 'for a variable saturated hydrostatic condition.'
1234) call printErrMsg(option)
1235)
1236) ! we have to remap the capillary pressure to saturation and
1237) ! temperature to air pressure
1238) local_id = coupler%connection_set%id_dn(iconn)
1239) ghosted_id = patch%grid%nL2G(local_id)
1240) ! we have to convert capillary pressure (stored in air
1241) ! pressure index) to a saturation
1242) ! index variable
1243) ! 1 coupler%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX) = 1
1244) ! air pressure in this case hijacked for capillary pressure
1245) ! 2 coupler%flow_aux_mapping(GENERAL_AIR_PRESSURE_INDEX) = 2
1246) ! 3 coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = 3
1247) p_gas = coupler%flow_aux_real_var( &
1248) coupler%flow_aux_mapping( &
1249) GENERAL_GAS_PRESSURE_INDEX),iconn)
1250) p_cap = coupler%flow_aux_real_var( &
1251) coupler%flow_aux_mapping( &
1252) GENERAL_AIR_PRESSURE_INDEX),iconn)
1253) temperature = coupler%flow_aux_real_var( &
1254) coupler%flow_aux_mapping( &
1255) GENERAL_TEMPERATURE_INDEX),iconn)
1256) coupler%flow_aux_mapping(general_2ph_energy_dof) = real_count
1257) if (general_2ph_energy_dof == GENERAL_TEMPERATURE_INDEX) then
1258) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1259) temperature
1260) else
1261) call EOSWaterSaturationPressure(temperature,p_sat,ierr)
1262) coupler%flow_aux_real_var( &
1263) coupler%flow_aux_mapping( &
1264) GENERAL_AIR_PRESSURE_INDEX),iconn) = &
1265) p_gas - p_sat ! air pressure
1266) endif
1267) call patch%characteristic_curves_array(patch%sat_func_id(ghosted_id))% &
1268) ptr%saturation_function%Saturation(p_cap,s_liq,dummy_real,option)
1269) ! %flow_aux_mapping(GENERAL_GAS_SATURATION_INDEX) set to 3 in hydrostatic
1270) coupler%flow_aux_real_var( &
1271) coupler%flow_aux_mapping( &
1272) GENERAL_GAS_SATURATION_INDEX),iconn) = &
1273) 1.d0 - s_liq
1274) endif
1275) enddo
1276) coupler%flow_bc_type(1) = HYDROSTATIC_BC
1277) coupler%flow_bc_type(2:3) = DIRICHLET_BC
1278) else
1279) real_count = real_count + 1
1280) select case(general%liquid_pressure%itype)
1281) case(DIRICHLET_BC)
1282) coupler%flow_aux_mapping(GENERAL_LIQUID_PRESSURE_INDEX) = real_count
1283) select type(selector => general%liquid_pressure%dataset)
1284) class is(dataset_ascii_type)
1285) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1286) selector%rarray(1)
1287) dof1 = PETSC_TRUE
1288) class is(dataset_gridded_hdf5_type)
1289) call PatchUpdateCouplerFromDataset(coupler,option, &
1290) patch%grid,selector, &
1291) real_count)
1292) dof1 = PETSC_TRUE
1293) class default
1294) option%io_buffer = 'Unknown dataset class (general%liquid_' // &
1295) 'pressure%itype,LIQUID_STATE,DIRICHLET_BC)'
1296) call printErrMsg(option)
1297) end select
1298) coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
1299) case default
1300) string = &
1301) GetSubConditionName(general%liquid_pressure%itype)
1302) option%io_buffer = &
1303) FlowConditionUnknownItype(coupler%flow_condition, &
1304) 'general liquid state liquid pressure',string)
1305) call printErrMsg(option)
1306) end select
1307) real_count = real_count + 1
1308) select case(general%mole_fraction%itype)
1309) case(DIRICHLET_BC)
1310) coupler%flow_aux_mapping(GENERAL_MOLE_FRACTION_INDEX) = real_count
1311) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1312) general%mole_fraction%dataset%rarray(1)
1313) dof2 = PETSC_TRUE
1314) coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = DIRICHLET_BC
1315) case default
1316) string = &
1317) GetSubConditionName(general%mole_fraction%itype)
1318) option%io_buffer = &
1319) FlowConditionUnknownItype(coupler%flow_condition, &
1320) 'general liquid state mole fraction',string)
1321) call printErrMsg(option)
1322) end select
1323) real_count = real_count + 1
1324) select case(general%temperature%itype)
1325) case(DIRICHLET_BC)
1326) coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = real_count
1327) select type(selector =>general%temperature%dataset)
1328) class is(dataset_ascii_type)
1329) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1330) selector%rarray(1)
1331) dof3 = PETSC_TRUE
1332) class is(dataset_gridded_hdf5_type)
1333) call PatchUpdateCouplerFromDataset(coupler,option, &
1334) patch%grid,selector, &
1335) real_count)
1336) dof3 = PETSC_TRUE
1337) class default
1338) option%io_buffer = 'Unknown dataset class (general%' // &
1339) 'temperature%itype,LIQUID_STATE,DIRICHLET_BC)'
1340) call printErrMsg(option)
1341) end select
1342) coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
1343) case default
1344) string = &
1345) GetSubConditionName(general%temperature%itype)
1346) option%io_buffer = &
1347) FlowConditionUnknownItype(coupler%flow_condition, &
1348) 'general liquid state temperature',string)
1349) call printErrMsg(option)
1350) end select
1351) endif
1352) case(GAS_STATE)
1353) p_gas = UNINITIALIZED_DOUBLE ! set to uninitialized
1354) temperature = UNINITIALIZED_DOUBLE
1355) real_count = real_count + 1
1356) coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = GAS_STATE
1357) select case(general%gas_pressure%itype)
1358) case(DIRICHLET_BC)
1359) coupler%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX) = real_count
1360) p_gas = general%gas_pressure%dataset%rarray(1)
1361) coupler%flow_aux_real_var(real_count,1:num_connections) = p_gas
1362) dof1 = PETSC_TRUE
1363) coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = DIRICHLET_BC
1364) case default
1365) string = &
1366) GetSubConditionName(general%gas_pressure%itype)
1367) option%io_buffer = &
1368) FlowConditionUnknownItype(coupler%flow_condition, &
1369) 'general gas state gas pressure',string)
1370) call printErrMsg(option)
1371) end select
1372) real_count = real_count + 1
1373) select case(general%temperature%itype)
1374) case(DIRICHLET_BC)
1375) temperature = general%temperature%dataset%rarray(1)
1376) coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = real_count
1377) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1378) temperature
1379) dof3 = PETSC_TRUE
1380) coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
1381) case default
1382) string = &
1383) GetSubConditionName(general%temperature%itype)
1384) option%io_buffer = &
1385) FlowConditionUnknownItype(coupler%flow_condition, &
1386) 'general gas state temperature',string)
1387) call printErrMsg(option)
1388) end select
1389) real_count = real_count + 1
1390) if (associated(general%mole_fraction)) then
1391) select case(general%mole_fraction%itype)
1392) case(DIRICHLET_BC)
1393) if (Uninitialized(p_gas) .or. Uninitialized(temperature)) then
1394) option%io_buffer = 'Gas pressure or temperature not set ' // &
1395) 'correctly in flow condition "' // &
1396) trim(flow_condition%name) // '".'
1397) call printErrMsg(option)
1398) endif
1399) coupler%flow_aux_mapping(GENERAL_AIR_PRESSURE_INDEX) = real_count
1400) p_air = general%mole_fraction%dataset%rarray(1) * p_gas
1401) call EOSWaterSaturationPressure(temperature,p_sat,ierr)
1402) if (p_gas - p_air >= p_sat) then
1403) option%io_buffer = 'MOLE_FRACTION set in flow condition "' // &
1404) trim(flow_condition%name) // &
1405) '" results in a vapor pressure exceeding the water ' // &
1406) 'saturation pressure, which indicates that a two-phase ' // &
1407) 'state with GAS_PRESSURE and GAS_SATURATION should be used.'
1408) call printErrMsg(option)
1409) endif
1410) coupler%flow_aux_real_var(real_count,1:num_connections) = p_air
1411) dof2 = PETSC_TRUE
1412) coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
1413) case default
1414) string = &
1415) GetSubConditionName(general%mole_fraction%itype)
1416) option%io_buffer = &
1417) FlowConditionUnknownItype(coupler%flow_condition, &
1418) 'general gas state mole fraction',string)
1419) call printErrMsg(option)
1420) end select
1421) else
1422) select case(general%relative_humidity%itype)
1423) case(DIRICHLET_BC)
1424) if (Uninitialized(p_gas) .or. Uninitialized(temperature)) then
1425) option%io_buffer = 'Gas pressure or temperature not set ' // &
1426) 'correctly in flow condition "' // &
1427) trim(flow_condition%name) // '".'
1428) call printErrMsg(option)
1429) endif
1430) coupler%flow_aux_mapping(GENERAL_AIR_PRESSURE_INDEX) = real_count
1431) ! relative humidity in %
1432) relative_humidity = general%relative_humidity%dataset%rarray(1)
1433) if (relative_humidity < 0.d0 .or. relative_humidity > 100.d0) then
1434) option%io_buffer = 'Relative humidity in flow condition "' // &
1435) trim(flow_condition%name) // '" outside bounds of 0-100%.'
1436) call printErrMsg(option)
1437) endif
1438) call EOSWaterSaturationPressure(temperature,p_sat,ierr)
1439) ! convert from % to fraction
1440) p_air = p_gas - relative_humidity*1.d-2*p_sat
1441) coupler%flow_aux_real_var(real_count,1:num_connections) = p_air
1442) dof2 = PETSC_TRUE
1443) coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
1444) case default
1445) string = &
1446) GetSubConditionName(general%mole_fraction%itype)
1447) option%io_buffer = &
1448) FlowConditionUnknownItype(coupler%flow_condition, &
1449) 'general gas state relative humidity',string)
1450) call printErrMsg(option)
1451) end select
1452) endif
1453) case(ANY_STATE)
1454) if (associated(coupler%flow_aux_int_var)) then ! not used with rate
1455) coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = &
1456) ANY_STATE
1457) endif
1458) if (associated(general%temperature)) then
1459) real_count = real_count + 1
1460) select case(general%temperature%itype)
1461) case(DIRICHLET_BC)
1462) coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = real_count
1463) select type(selector =>general%temperature%dataset)
1464) class is(dataset_ascii_type)
1465) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1466) selector%rarray(1)
1467) dof3 = PETSC_TRUE
1468) class is(dataset_gridded_hdf5_type)
1469) call PatchUpdateCouplerFromDataset(coupler,option, &
1470) patch%grid,selector, &
1471) real_count)
1472) dof3 = PETSC_TRUE
1473) class default
1474) option%io_buffer = 'Unknown dataset class (general%' // &
1475) 'temperature%itype,LIQUID_STATE,DIRICHLET_BC)'
1476) call printErrMsg(option)
1477) end select
1478) coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
1479) case default
1480) string = &
1481) GetSubConditionName(general%temperature%itype)
1482) option%io_buffer = &
1483) FlowConditionUnknownItype(coupler%flow_condition, &
1484) 'general gas state temperature',string)
1485) call printErrMsg(option)
1486) end select
1487) endif
1488) end select
1489)
1490) if (associated(general%liquid_flux)) then
1491) coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = NEUMANN_BC
1492) real_count = real_count + 1
1493) coupler%flow_aux_mapping(GENERAL_LIQUID_FLUX_INDEX) = real_count
1494) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1495) general%liquid_flux%dataset%rarray(1)
1496) dof1 = PETSC_TRUE
1497) endif
1498) if (associated(general%gas_flux)) then
1499) coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = NEUMANN_BC
1500) real_count = real_count + 1
1501) coupler%flow_aux_mapping(GENERAL_GAS_FLUX_INDEX) = real_count
1502) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1503) general%gas_flux%dataset%rarray(1)
1504) dof2 = PETSC_TRUE
1505) endif
1506) if (associated(general%energy_flux)) then
1507) coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = NEUMANN_BC
1508) real_count = real_count + 1
1509) coupler%flow_aux_mapping(GENERAL_ENERGY_FLUX_INDEX) = real_count
1510) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1511) general%energy_flux%dataset%rarray(1)
1512) dof3 = PETSC_TRUE
1513) endif
1514)
1515) if (associated(general%rate)) then
1516) select case(general%rate%itype)
1517) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
1518) call PatchScaleSourceSink(patch,coupler,general%rate%isubtype,option)
1519) end select
1520) endif
1521)
1522) !geh: is this really correct, or should it be .or.
1523) if (.not.dof1 .or. .not.dof2 .or. .not.dof3) then
1524) option%io_buffer = 'Error with general phase boundary condition'
1525) endif
1526)
1527) end subroutine PatchUpdateCouplerAuxVarsG
1528)
1529) ! ************************************************************************** !
1530)
1531) subroutine PatchUpdateCouplerAuxVarsTOI(patch,coupler,option)
1532) !
1533) ! Updates flow auxiliary variables associated
1534) ! with a coupler for TOIL_IMS_MODE
1535) ! only ascii database option currenlty available
1536) !
1537) ! Author: Paolo Orsini
1538) ! Date: 09/09/15
1539) !
1540)
1541) use Option_module
1542) use Condition_module
1543) use Hydrostatic_module
1544) use HydrostaticMultiPhase_module
1545) use Saturation_module
1546)
1547) use TOilIms_Aux_module
1548) use Grid_module
1549) use Dataset_Common_HDF5_class
1550) use Dataset_Gridded_HDF5_class
1551) use Dataset_Ascii_class
1552) use Dataset_module
1553)
1554) implicit none
1555)
1556) type(patch_type) :: patch
1557) type(coupler_type), pointer :: coupler
1558) type(option_type) :: option
1559)
1560) type(flow_condition_type), pointer :: flow_condition
1561) character(len=MAXSTRINGLENGTH) :: string
1562) !type(tran_condition_type), pointer :: tran_condition
1563)
1564) type(flow_toil_ims_condition_type), pointer :: toil_ims
1565)
1566) PetscBool :: dof1, dof2, dof3
1567)
1568) PetscErrorCode :: ierr
1569)
1570) PetscInt :: idof, num_connections
1571) PetscInt :: iconn, local_id, ghosted_id
1572) ! use to map flow_aux_map to the flow_aux_real_var array
1573) PetscInt :: real_count
1574)
1575) num_connections = coupler%connection_set%num_connections
1576)
1577) flow_condition => coupler%flow_condition
1578)
1579) toil_ims => flow_condition%toil_ims
1580) dof1 = PETSC_FALSE
1581) dof2 = PETSC_FALSE
1582) dof3 = PETSC_FALSE
1583)
1584) real_count = 0
1585)
1586) if ( associated(toil_ims%pressure) ) then
1587) ! pressure is either hydrostatic or dirichlet
1588) if (toil_ims%pressure%itype == HYDROSTATIC_BC) then
1589) if (toil_ims%saturation%itype /= DIRICHLET_BC) then
1590) option%io_buffer = &
1591) 'Hydrostatic pressure bc for flow condition "' // &
1592) trim(flow_condition%name) // &
1593) '" requires a saturation bc of type dirichlet'
1594) call printErrMsg(option)
1595) endif
1596) if (toil_ims%temperature%itype /= DIRICHLET_BC) then
1597) option%io_buffer = &
1598) 'Hydrostatic pressure bc for flow condition "' // &
1599) trim(flow_condition%name) // &
1600) '" requires a temperature bc of type dirichlet'
1601) call printErrMsg(option)
1602) endif
1603) ! at the moment hydrostatic pressure is valid only for regions
1604) ! fully saturated in water Sw=Sw_max, where Pw=Po (i.e. Pc=0)
1605) !coupler%flow_aux_mapping(TOIL_IMS_OIL_SATURATION_INDEX) = 2
1606) !coupler%flow_aux_real_var(2,1:num_connections) = 0.d0
1607) !allow for exception when zero capillary pressure (pw=po)
1608) !coupler%flow_aux_real_var(2,1:num_connections) = &
1609) ! toil_ims%saturation%dataset%rarray(1)
1610) dof2 = PETSC_TRUE
1611) call TOIHydrostaticUpdateCoupler(coupler,option,patch%grid, &
1612) patch%characteristic_curves_array,patch%sat_func_id, &
1613) patch%imat)
1614) coupler%flow_bc_type(TOIL_IMS_OIL_EQUATION_INDEX) = HYDROSTATIC_BC
1615) coupler%flow_bc_type(TOIL_IMS_LIQUID_EQUATION_INDEX) = HYDROSTATIC_BC
1616) coupler%flow_bc_type(TOIL_IMS_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
1617) dof1 = PETSC_TRUE
1618) dof3 = PETSC_TRUE
1619) else
1620) real_count = real_count + 1
1621) select case(toil_ims%pressure%itype)
1622) case(DIRICHLET_BC)
1623) coupler%flow_aux_mapping(TOIL_IMS_PRESSURE_INDEX) = real_count
1624) coupler%flow_bc_type(TOIL_IMS_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
1625) select type(selector => toil_ims%pressure%dataset)
1626) class is(dataset_ascii_type)
1627) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1628) selector%rarray(1)
1629) dof1 = PETSC_TRUE
1630) class is(dataset_gridded_hdf5_type)
1631) call PatchUpdateCouplerFromDataset(coupler,option, &
1632) patch%grid,selector, &
1633) real_count)
1634) dof1 = PETSC_TRUE
1635) class default
1636) option%io_buffer = 'Unknown dataset class (toil_ims%' // &
1637) 'pressure%itype,DIRICHLET_BC)'
1638) call printErrMsg(option)
1639) end select
1640) !case(CONDUCTANCE_BC) !not implemented yet
1641) !case(SEEPAGE_BC) !not implemented yet
1642) case default
1643) string = &
1644) GetSubConditionName(toil_ims%pressure%itype)
1645) option%io_buffer = &
1646) FlowConditionUnknownItype(coupler%flow_condition, &
1647) 'toi_ims pressure',string)
1648) call printErrMsg(option)
1649) end select
1650)
1651) real_count = real_count + 1
1652) select case(toil_ims%saturation%itype)
1653) case(DIRICHLET_BC)
1654) coupler%flow_aux_mapping(TOIL_IMS_OIL_SATURATION_INDEX) = real_count
1655) !coupler%flow_aux_real_var(real_count,1:num_connections) = &
1656) ! toil_ims%saturation%dataset%rarray(1)
1657) !dof2 = PETSC_TRUE
1658) coupler%flow_bc_type(TOIL_IMS_OIL_EQUATION_INDEX) = DIRICHLET_BC
1659) select type(selector => toil_ims%saturation%dataset)
1660) class is(dataset_ascii_type)
1661) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1662) selector%rarray(1)
1663) dof2 = PETSC_TRUE
1664) class is(dataset_gridded_hdf5_type)
1665) call PatchUpdateCouplerFromDataset(coupler,option, &
1666) patch%grid,selector, &
1667) real_count)
1668) dof2 = PETSC_TRUE
1669) class default
1670) option%io_buffer = 'Unknown dataset class (toil_ims%' // &
1671) 'saturation%itype,DIRICHLET_BC)'
1672) call printErrMsg(option)
1673) end select
1674) case default
1675) string = &
1676) GetSubConditionName(toil_ims%saturation%itype)
1677) option%io_buffer = &
1678) FlowConditionUnknownItype(coupler%flow_condition, &
1679) 'toi_ims saturation',string)
1680) call printErrMsg(option)
1681) end select
1682)
1683) real_count = real_count + 1
1684) select case(toil_ims%temperature%itype)
1685) case(DIRICHLET_BC)
1686) coupler%flow_aux_mapping(TOIL_IMS_TEMPERATURE_INDEX) = real_count
1687) !temperature = toil_ims%temperature%dataset%rarray(1)
1688) !coupler%flow_aux_real_var(real_count,1:num_connections) = &
1689) ! temperature
1690) !dof3 = PETSC_TRUE
1691) coupler%flow_bc_type(TOIL_IMS_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
1692) select type(selector => toil_ims%temperature%dataset)
1693) class is(dataset_ascii_type)
1694) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1695) selector%rarray(1)
1696) dof3 = PETSC_TRUE
1697) class is(dataset_gridded_hdf5_type)
1698) call PatchUpdateCouplerFromDataset(coupler,option, &
1699) patch%grid,selector, &
1700) real_count)
1701) dof3 = PETSC_TRUE
1702) class default
1703) option%io_buffer = 'Unknown dataset class (toil_ims%' // &
1704) 'temperature%itype,DIRICHLET_BC)'
1705) call printErrMsg(option)
1706) end select
1707) ! to add here therma gradient option
1708) case default
1709) string = &
1710) GetSubConditionName(toil_ims%temperature%itype)
1711) option%io_buffer = &
1712) FlowConditionUnknownItype(coupler%flow_condition, &
1713) 'toi_ims temperature',string)
1714) call printErrMsg(option)
1715) end select
1716)
1717) end if ! end else branch for pressure /= HYDROSTATIC_BC
1718) end if !if associated pressure
1719)
1720) if (associated(toil_ims%liquid_flux)) then
1721) coupler%flow_bc_type(TOIL_IMS_LIQUID_EQUATION_INDEX) = NEUMANN_BC
1722) real_count = real_count + 1
1723) coupler%flow_aux_mapping(TOIL_IMS_LIQUID_FLUX_INDEX) = real_count
1724) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1725) toil_ims%liquid_flux%dataset%rarray(1)
1726) dof1 = PETSC_TRUE
1727) endif
1728) if (associated(toil_ims%oil_flux)) then
1729) coupler%flow_bc_type(TOIL_IMS_OIL_EQUATION_INDEX) = NEUMANN_BC
1730) real_count = real_count + 1
1731) coupler%flow_aux_mapping(TOIL_IMS_OIL_FLUX_INDEX) = real_count
1732) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1733) toil_ims%oil_flux%dataset%rarray(1)
1734) dof2 = PETSC_TRUE
1735) endif
1736) if (associated(toil_ims%energy_flux)) then
1737) coupler%flow_bc_type(TOIL_IMS_ENERGY_EQUATION_INDEX) = NEUMANN_BC
1738) real_count = real_count + 1
1739) coupler%flow_aux_mapping(TOIL_IMS_ENERGY_FLUX_INDEX) = real_count
1740) coupler%flow_aux_real_var(real_count,1:num_connections) = &
1741) toil_ims%energy_flux%dataset%rarray(1)
1742) dof3 = PETSC_TRUE
1743) endif
1744)
1745) if (associated(toil_ims%rate)) then
1746) select case(toil_ims%rate%itype)
1747) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
1748) call PatchScaleSourceSink(patch,coupler,toil_ims%rate%isubtype,option)
1749) end select
1750) endif
1751)
1752) ! if not all primary variables updated for toil_ims, it returns an error
1753) !if (.not.dof1 .or. .not.dof2 .or. .not.dof3) then
1754) ! option%io_buffer = 'Error with themal oil phase boundary condition'
1755) !endif
1756)
1757) end subroutine PatchUpdateCouplerAuxVarsTOI
1758)
1759) ! ************************************************************************** !
1760)
1761) subroutine PatchUpdateCouplerAuxVarsMPH(patch,coupler,option)
1762) !
1763) ! Updates flow auxiliary variables associated
1764) ! with a coupler for MPH_MODE
1765) !
1766) ! Author: Glenn Hammond
1767) ! Date: 11/26/07
1768) !
1769)
1770) use Option_module
1771) use Condition_module
1772) use Hydrostatic_module
1773) use Saturation_module
1774)
1775)
1776) use General_Aux_module
1777) use Grid_module
1778) use Dataset_Common_HDF5_class
1779) use Dataset_Gridded_HDF5_class
1780)
1781) implicit none
1782)
1783) type(patch_type) :: patch
1784) type(coupler_type), pointer :: coupler
1785) type(option_type) :: option
1786)
1787) type(flow_condition_type), pointer :: flow_condition
1788) type(tran_condition_type), pointer :: tran_condition
1789) type(flow_general_condition_type), pointer :: general
1790) class(dataset_common_hdf5_type), pointer :: dataset
1791) PetscBool :: update
1792) PetscBool :: dof1, dof2, dof3
1793) PetscReal :: temperature, p_sat
1794) PetscReal :: x(option%nflowdof)
1795) character(len=MAXSTRINGLENGTH) :: string, string2
1796) PetscErrorCode :: ierr
1797)
1798) PetscInt :: idof, num_connections,sum_connection
1799) PetscInt :: iconn, local_id, ghosted_id
1800)
1801) num_connections = coupler%connection_set%num_connections
1802)
1803) flow_condition => coupler%flow_condition
1804)
1805) if (associated(flow_condition%pressure)) then
1806) coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
1807) flow_condition%iphase
1808) select case(flow_condition%pressure%itype)
1809) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
1810) coupler%flow_aux_real_var(MPH_PRESSURE_DOF,1:num_connections) = &
1811) flow_condition%pressure%dataset%rarray(1)
1812) case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
1813) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
1814) ! case(SATURATION_BC)
1815) end select
1816) select case(flow_condition%temperature%itype)
1817) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
1818) if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
1819) (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
1820) flow_condition%temperature%itype /= DIRICHLET_BC)) then
1821) coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
1822) flow_condition%temperature%dataset%rarray(1)
1823) endif
1824) end select
1825) select case(flow_condition%concentration%itype)
1826) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
1827) if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
1828) (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
1829) flow_condition%concentration%itype /= DIRICHLET_BC)) then
1830) coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
1831) flow_condition%concentration%dataset%rarray(1)
1832) endif
1833) end select
1834) else
1835) select case(flow_condition%temperature%itype)
1836) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
1837) coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
1838) flow_condition%temperature%dataset%rarray(1)
1839) end select
1840) select case(flow_condition%concentration%itype)
1841) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
1842) coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
1843) flow_condition%concentration%dataset%rarray(1)
1844) end select
1845) endif
1846) if (associated(flow_condition%rate)) then
1847) select case(flow_condition%rate%itype)
1848) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
1849) call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
1850) option)
1851) end select
1852) endif
1853) if (associated(flow_condition%saturation)) then
1854) call SaturationUpdateCoupler(coupler,option,patch%grid, &
1855) patch%saturation_function_array, &
1856) patch%sat_func_id)
1857) endif
1858)
1859) end subroutine PatchUpdateCouplerAuxVarsMPH
1860)
1861) ! ************************************************************************** !
1862)
1863) subroutine PatchUpdateCouplerAuxVarsIMS(patch,coupler,option)
1864) !
1865) ! Updates flow auxiliary variables associated
1866) ! with a coupler for IMS_MODE
1867) !
1868) ! Author: Glenn Hammond
1869) ! Date: 11/26/07
1870) !
1871)
1872) use Option_module
1873) use Condition_module
1874) use Hydrostatic_module
1875) use Saturation_module
1876)
1877)
1878) use General_Aux_module
1879) use Grid_module
1880) use Dataset_Common_HDF5_class
1881) use Dataset_Gridded_HDF5_class
1882)
1883) implicit none
1884)
1885) type(patch_type) :: patch
1886) type(coupler_type), pointer :: coupler
1887) type(option_type) :: option
1888)
1889) type(flow_condition_type), pointer :: flow_condition
1890) type(tran_condition_type), pointer :: tran_condition
1891) type(flow_general_condition_type), pointer :: general
1892) class(dataset_common_hdf5_type), pointer :: dataset
1893) PetscBool :: update
1894) PetscBool :: dof1, dof2, dof3
1895) PetscReal :: temperature, p_sat
1896) PetscReal :: x(option%nflowdof)
1897) character(len=MAXSTRINGLENGTH) :: string, string2
1898) PetscErrorCode :: ierr
1899)
1900) PetscInt :: idof, num_connections,sum_connection
1901) PetscInt :: iconn, local_id, ghosted_id
1902)
1903) num_connections = coupler%connection_set%num_connections
1904)
1905) flow_condition => coupler%flow_condition
1906)
1907) if (associated(flow_condition%pressure)) then
1908) coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
1909) flow_condition%iphase
1910) select case(flow_condition%pressure%itype)
1911) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
1912) coupler%flow_aux_real_var(MPH_PRESSURE_DOF,1:num_connections) = &
1913) flow_condition%pressure%dataset%rarray(1)
1914) case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
1915) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
1916) ! case(SATURATION_BC)
1917) end select
1918) select case(flow_condition%temperature%itype)
1919) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
1920) if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
1921) (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
1922) flow_condition%temperature%itype /= DIRICHLET_BC)) then
1923) coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
1924) flow_condition%temperature%dataset%rarray(1)
1925) endif
1926) end select
1927) select case(flow_condition%concentration%itype)
1928) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
1929) if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
1930) (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
1931) flow_condition%concentration%itype /= DIRICHLET_BC)) then
1932) coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
1933) flow_condition%concentration%dataset%rarray(1)
1934) endif
1935) end select
1936) else
1937) select case(flow_condition%temperature%itype)
1938) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
1939) coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
1940) flow_condition%temperature%dataset%rarray(1)
1941) end select
1942) select case(flow_condition%concentration%itype)
1943) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
1944) coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
1945) flow_condition%concentration%dataset%rarray(1)
1946) end select
1947) endif
1948) if (associated(flow_condition%rate)) then
1949) select case(flow_condition%rate%itype)
1950) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
1951) call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
1952) option)
1953) end select
1954) endif
1955) if (associated(flow_condition%saturation)) then
1956) call SaturationUpdateCoupler(coupler,option,patch%grid, &
1957) patch%saturation_function_array, &
1958) patch%sat_func_id)
1959) endif
1960)
1961) end subroutine PatchUpdateCouplerAuxVarsIMS
1962)
1963) ! ************************************************************************** !
1964)
1965) subroutine PatchUpdateCouplerAuxVarsFLASH2(patch,coupler,option)
1966) !
1967) ! Updates flow auxiliary variables associated
1968) ! with a coupler for FLASH2_MODE
1969) !
1970) ! Author: Glenn Hammond
1971) ! Date: 11/26/07
1972) !
1973)
1974) use Option_module
1975) use Condition_module
1976) use Hydrostatic_module
1977) use Saturation_module
1978)
1979)
1980) use General_Aux_module
1981) use Grid_module
1982) use Dataset_Common_HDF5_class
1983) use Dataset_Gridded_HDF5_class
1984)
1985) implicit none
1986)
1987) type(patch_type) :: patch
1988) type(coupler_type), pointer :: coupler
1989) type(option_type) :: option
1990)
1991) type(flow_condition_type), pointer :: flow_condition
1992) type(tran_condition_type), pointer :: tran_condition
1993) type(flow_general_condition_type), pointer :: general
1994) class(dataset_common_hdf5_type), pointer :: dataset
1995) PetscBool :: update
1996) PetscBool :: dof1, dof2, dof3
1997) PetscReal :: temperature, p_sat
1998) PetscReal :: x(option%nflowdof)
1999) character(len=MAXSTRINGLENGTH) :: string, string2
2000) PetscErrorCode :: ierr
2001)
2002) PetscInt :: idof, num_connections,sum_connection
2003) PetscInt :: iconn, local_id, ghosted_id
2004)
2005) num_connections = coupler%connection_set%num_connections
2006)
2007) flow_condition => coupler%flow_condition
2008)
2009) if (associated(flow_condition%pressure)) then
2010) coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
2011) flow_condition%iphase
2012) select case(flow_condition%pressure%itype)
2013) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
2014) coupler%flow_aux_real_var(MPH_PRESSURE_DOF,1:num_connections) = &
2015) flow_condition%pressure%dataset%rarray(1)
2016) case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
2017) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
2018) ! case(SATURATION_BC)
2019) end select
2020) select case(flow_condition%temperature%itype)
2021) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
2022) if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
2023) (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
2024) flow_condition%temperature%itype /= DIRICHLET_BC)) then
2025) coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
2026) flow_condition%temperature%dataset%rarray(1)
2027) endif
2028) end select
2029) select case(flow_condition%concentration%itype)
2030) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
2031) if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
2032) (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
2033) flow_condition%concentration%itype /= DIRICHLET_BC)) then
2034) coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
2035) flow_condition%concentration%dataset%rarray(1)
2036) endif
2037) end select
2038) else
2039) select case(flow_condition%temperature%itype)
2040) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
2041) coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
2042) flow_condition%temperature%dataset%rarray(1)
2043) end select
2044) select case(flow_condition%concentration%itype)
2045) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
2046) coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
2047) flow_condition%concentration%dataset%rarray(1)
2048) end select
2049) endif
2050) if (associated(flow_condition%rate)) then
2051) select case(flow_condition%rate%itype)
2052) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
2053) call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
2054) option)
2055) end select
2056) endif
2057) if (associated(flow_condition%saturation)) then
2058) call SaturationUpdateCoupler(coupler,option,patch%grid, &
2059) patch%saturation_function_array, &
2060) patch%sat_func_id)
2061) endif
2062)
2063) end subroutine PatchUpdateCouplerAuxVarsFLASH2
2064)
2065) ! ************************************************************************** !
2066)
2067) subroutine PatchUpdateCouplerAuxVarsTH(patch,coupler,option)
2068) !
2069) ! Updates flow auxiliary variables associated
2070) ! with a coupler for TH_MODE
2071) !
2072) ! Author: Glenn Hammond
2073) ! Date: 11/26/07
2074) !
2075)
2076) use Option_module
2077) use Condition_module
2078) use Hydrostatic_module
2079) use Saturation_module
2080)
2081)
2082) use General_Aux_module
2083) use Grid_module
2084) use Dataset_Common_HDF5_class
2085) use Dataset_Gridded_HDF5_class
2086) use Dataset_Ascii_class
2087)
2088) implicit none
2089)
2090) type(patch_type) :: patch
2091) type(coupler_type), pointer :: coupler
2092) type(option_type) :: option
2093)
2094) type(flow_condition_type), pointer :: flow_condition
2095) type(tran_condition_type), pointer :: tran_condition
2096) type(flow_general_condition_type), pointer :: general
2097) class(dataset_common_hdf5_type), pointer :: dataset
2098) PetscBool :: update
2099) PetscBool :: dof1, dof2, dof3
2100) PetscReal :: temperature, p_sat
2101) PetscReal :: x(option%nflowdof)
2102) character(len=MAXSTRINGLENGTH) :: string, string2
2103) PetscErrorCode :: ierr
2104) PetscBool :: apply_temp_cond
2105) PetscInt :: rate_scale_type
2106)
2107) PetscInt :: idof, num_connections,sum_connection
2108) PetscInt :: iconn, local_id, ghosted_id
2109) PetscInt :: iphase
2110)
2111) num_connections = coupler%connection_set%num_connections
2112)
2113) flow_condition => coupler%flow_condition
2114)
2115) if (associated(flow_condition%pressure)) then
2116) !geh: this is a fix for an Intel compiler bug. Not sure why Intel cannot
2117) ! access flow_condition%iphase directly....
2118) iphase = flow_condition%iphase
2119) coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = iphase
2120) ! coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
2121) ! flow_condition%iphase
2122) select case(flow_condition%pressure%itype)
2123) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC,SPILLOVER_BC)
2124) select type(selector =>flow_condition%pressure%dataset)
2125) class is(dataset_ascii_type)
2126) coupler%flow_aux_real_var(TH_PRESSURE_DOF,1:num_connections) = &
2127) selector%rarray(1)
2128) class is(dataset_gridded_hdf5_type)
2129) call PatchUpdateCouplerFromDataset(coupler,option, &
2130) patch%grid,selector, &
2131) TH_PRESSURE_DOF)
2132) class default
2133) option%io_buffer = 'Unknown dataset class (TH%' // &
2134) 'pressure%itype,DIRICHLET_BC)'
2135) call printErrMsg(option)
2136) end select
2137) case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
2138) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
2139) case(HET_DIRICHLET)
2140) call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
2141) flow_condition%pressure%dataset, &
2142) num_connections,TH_PRESSURE_DOF,option)
2143) case(HET_SURF_SEEPAGE_BC)
2144) ! Do nothing, since this BC type is only used for coupling of
2145) ! surface-subsurface model
2146) case default
2147) string = &
2148) GetSubConditionName(flow_condition%pressure%itype)
2149) option%io_buffer = &
2150) FlowConditionUnknownItype(flow_condition,'TH pressure',string)
2151) call printErrMsg(option)
2152) end select
2153) if (associated(flow_condition%temperature)) then
2154) select case(flow_condition%temperature%itype)
2155) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
2156) select type(selector =>flow_condition%temperature%dataset)
2157) class is(dataset_ascii_type)
2158) if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
2159) (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
2160) flow_condition%temperature%itype /= DIRICHLET_BC)) then
2161) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF, &
2162) 1:num_connections) = &
2163) selector%rarray(1)
2164) endif
2165) class is(dataset_gridded_hdf5_type)
2166) call PatchUpdateCouplerFromDataset(coupler,option, &
2167) patch%grid,selector, &
2168) TH_TEMPERATURE_DOF)
2169) class default
2170) option%io_buffer = 'Unknown dataset class (TH%' // &
2171) 'temperature%itype,DIRICHLET_BC)'
2172) call printErrMsg(option)
2173) end select
2174) case (HET_DIRICHLET)
2175) call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
2176) flow_condition%temperature%dataset, &
2177) num_connections,TH_TEMPERATURE_DOF,option)
2178) case default
2179) string = &
2180) GetSubConditionName(flow_condition%temperature%itype)
2181) option%io_buffer = &
2182) FlowConditionUnknownItype(flow_condition,'TH temperature',string)
2183) call printErrMsg(option)
2184) end select
2185) endif
2186) if (associated(flow_condition%energy_flux)) then
2187) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF,1:num_connections) = &
2188) flow_condition%energy_flux%dataset%rarray(1)
2189) endif
2190) endif
2191)
2192) apply_temp_cond = PETSC_FALSE
2193) if (associated(flow_condition%temperature) .and. associated(flow_condition%pressure)) then
2194) if (flow_condition%pressure%itype /= HYDROSTATIC_BC) then
2195) apply_temp_cond = PETSC_TRUE
2196) else
2197) if (flow_condition%temperature%itype /= DIRICHLET_BC) then
2198) apply_temp_cond = PETSC_TRUE
2199) endif
2200) endif
2201) else
2202) apply_temp_cond = PETSC_TRUE
2203) endif
2204)
2205) if (associated(flow_condition%temperature) .and. apply_temp_cond) then
2206) select case(flow_condition%temperature%itype)
2207) case(DIRICHLET_BC,ZERO_GRADIENT_BC)
2208) select type(selector =>flow_condition%temperature%dataset)
2209) class is(dataset_ascii_type)
2210) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF, &
2211) 1:num_connections) = &
2212) selector%rarray(1)
2213) class is(dataset_gridded_hdf5_type)
2214) call PatchUpdateCouplerFromDataset(coupler,option, &
2215) patch%grid,selector, &
2216) TH_TEMPERATURE_DOF)
2217) class default
2218) option%io_buffer = 'Unknown dataset class (TH%' // &
2219) 'pressure%itype,DIRICHLET_BC)'
2220) call printErrMsg(option)
2221) end select
2222) case (HET_DIRICHLET)
2223) call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
2224) flow_condition%temperature%dataset, &
2225) num_connections,TH_TEMPERATURE_DOF,option)
2226) case default
2227) string = &
2228) GetSubConditionName(flow_condition%temperature%itype)
2229) option%io_buffer = &
2230) FlowConditionUnknownItype(flow_condition,'TH temperature',string)
2231) call printErrMsg(option)
2232) end select
2233) endif
2234)
2235) if (associated(flow_condition%energy_flux)) then
2236) select case(flow_condition%energy_flux%itype)
2237) case(NEUMANN_BC)
2238) select type(selector =>flow_condition%energy_flux%dataset)
2239) class is(dataset_ascii_type)
2240) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF, &
2241) 1:num_connections) = &
2242) selector%rarray(1)
2243) class is(dataset_gridded_hdf5_type)
2244) call PatchUpdateCouplerFromDataset(coupler,option, &
2245) patch%grid,selector, &
2246) TH_TEMPERATURE_DOF)
2247) class default
2248) option%io_buffer = 'Unknown dataset class (TH%' // &
2249) 'pressure%itype,NEUMANN_BC)'
2250) call printErrMsg(option)
2251) end select
2252) case default
2253) string = &
2254) GetSubConditionName(flow_condition%energy_flux%itype)
2255) option%io_buffer = &
2256) FlowConditionUnknownItype(flow_condition,'TH energy flux',string)
2257) call printErrMsg(option)
2258) end select
2259) endif
2260)
2261) !geh: we set this flag to ensure that we are not scaling mass and energy
2262) ! differently
2263) rate_scale_type = 0
2264) if (associated(flow_condition%rate)) then
2265) select case(flow_condition%rate%itype)
2266) case (HET_MASS_RATE_SS,HET_VOL_RATE_SS)
2267) call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
2268) flow_condition%rate%dataset, &
2269) num_connections,TH_PRESSURE_DOF,option)
2270) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
2271) call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
2272) option)
2273) rate_scale_type = flow_condition%rate%isubtype
2274) case(MASS_RATE_SS,VOLUMETRIC_RATE_SS)
2275) ! do nothing here
2276) case default
2277) string = &
2278) GetSubConditionName(flow_condition%rate%itype)
2279) option%io_buffer = &
2280) FlowConditionUnknownItype(flow_condition,'TH rate',string)
2281) call printErrMsg(option)
2282) end select
2283) endif
2284) if (associated(flow_condition%energy_rate)) then
2285) select case (flow_condition%energy_rate%itype)
2286) case (ENERGY_RATE_SS)
2287) !geh: this is pointless as %dataset%rarray(1) is reference in TH,
2288) ! not the flow_aux_real_var!
2289) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF,1:num_connections) = &
2290) flow_condition%energy_rate%dataset%rarray(1)
2291) case (SCALED_ENERGY_RATE_SS)
2292) if (rate_scale_type == 0) then
2293) call PatchScaleSourceSink(patch,coupler, &
2294) flow_condition%energy_rate%isubtype,option)
2295) else if (rate_scale_type == flow_condition%energy_rate%isubtype) then
2296) !geh: do nothing as it is taken care of later.
2297) else
2298) option%io_buffer = 'MASS and ENERGY scaling mismatch in ' // &
2299) 'FLOW_CONDITION "' // trim(flow_condition%name) // '".'
2300) call printErrMsg(option)
2301) endif
2302) !geh: do nothing as the
2303) case (HET_ENERGY_RATE_SS)
2304) call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
2305) flow_condition%energy_rate%dataset, &
2306) num_connections,TH_TEMPERATURE_DOF,option)
2307) case default
2308) string = &
2309) GetSubConditionName(flow_condition%energy_rate%itype)
2310) option%io_buffer = &
2311) FlowConditionUnknownItype(flow_condition,'TH energy rate',string)
2312) call printErrMsg(option)
2313) end select
2314) endif
2315) if (associated(flow_condition%saturation)) then
2316) call SaturationUpdateCoupler(coupler,option,patch%grid, &
2317) patch%saturation_function_array, &
2318) patch%sat_func_id)
2319) endif
2320)
2321) end subroutine PatchUpdateCouplerAuxVarsTH
2322)
2323) ! ************************************************************************** !
2324)
2325) subroutine PatchUpdateCouplerAuxVarsMIS(patch,coupler,option)
2326) !
2327) ! Updates flow auxiliary variables associated
2328) ! with a coupler for MIS_MODE
2329) !
2330) ! Author: Glenn Hammond
2331) ! Date: 11/26/07
2332) !
2333)
2334) use Option_module
2335) use Condition_module
2336) use Hydrostatic_module
2337) use Saturation_module
2338)
2339)
2340) use General_Aux_module
2341) use Grid_module
2342) use Dataset_Common_HDF5_class
2343) use Dataset_Gridded_HDF5_class
2344)
2345) implicit none
2346)
2347) type(patch_type) :: patch
2348) type(coupler_type), pointer :: coupler
2349) type(option_type) :: option
2350)
2351) type(flow_condition_type), pointer :: flow_condition
2352) type(tran_condition_type), pointer :: tran_condition
2353) type(flow_general_condition_type), pointer :: general
2354) class(dataset_common_hdf5_type), pointer :: dataset
2355) PetscBool :: update
2356) PetscBool :: dof1, dof2, dof3
2357) PetscReal :: temperature, p_sat
2358) PetscReal :: x(option%nflowdof)
2359) character(len=MAXSTRINGLENGTH) :: string, string2
2360) PetscErrorCode :: ierr
2361)
2362) PetscInt :: idof, num_connections,sum_connection
2363) PetscInt :: iconn, local_id, ghosted_id
2364)
2365) num_connections = coupler%connection_set%num_connections
2366)
2367) flow_condition => coupler%flow_condition
2368) if (associated(flow_condition%pressure)) then
2369) select case(flow_condition%pressure%itype)
2370) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
2371) coupler%flow_aux_real_var(MIS_PRESSURE_DOF, &
2372) 1:num_connections) = &
2373) flow_condition%pressure%dataset%rarray(1)
2374) case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
2375) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
2376) ! case(SATURATION_BC)
2377) end select
2378) endif
2379) if (associated(flow_condition%concentration)) then
2380) select case(flow_condition%concentration%itype)
2381) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
2382) if (associated(flow_condition%concentration%dataset)) then
2383) coupler%flow_aux_real_var(MIS_CONCENTRATION_DOF, &
2384) 1:num_connections) = &
2385) flow_condition%concentration%dataset%rarray(1)
2386) endif
2387) case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
2388) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
2389) ! case(SATURATION_BC)
2390) end select
2391) endif
2392) if (associated(flow_condition%rate)) then
2393) select case(flow_condition%rate%itype)
2394) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
2395) call PatchScaleSourceSink(patch,coupler, &
2396) flow_condition%rate%isubtype,option)
2397) end select
2398) endif
2399)
2400) end subroutine PatchUpdateCouplerAuxVarsMIS
2401)
2402) ! ************************************************************************** !
2403)
2404) subroutine PatchUpdateCouplerAuxVarsRich(patch,coupler,option)
2405) !
2406) ! Updates flow auxiliary variables associated
2407) ! with a coupler for RICHARDS_MODE
2408) !
2409) ! Author: Glenn Hammond
2410) ! Date: 11/26/07
2411) !
2412)
2413) use Option_module
2414) use Condition_module
2415) use Hydrostatic_module
2416) use Saturation_module
2417)
2418)
2419) use General_Aux_module
2420) use Grid_module
2421) use Dataset_Common_HDF5_class
2422) use Dataset_Gridded_HDF5_class
2423) use Dataset_Ascii_class
2424)
2425) implicit none
2426)
2427) type(patch_type) :: patch
2428) type(coupler_type), pointer :: coupler
2429) type(option_type) :: option
2430)
2431) type(flow_condition_type), pointer :: flow_condition
2432) type(tran_condition_type), pointer :: tran_condition
2433) type(flow_general_condition_type), pointer :: general
2434) class(dataset_common_hdf5_type), pointer :: dataset
2435) PetscBool :: update
2436) PetscBool :: dof1, dof2, dof3
2437) PetscReal :: temperature, p_sat
2438) PetscReal :: x(option%nflowdof)
2439) character(len=MAXSTRINGLENGTH) :: string, string2
2440) PetscErrorCode :: ierr
2441)
2442) PetscInt :: idof, num_connections,sum_connection
2443) PetscInt :: iconn, local_id, ghosted_id
2444)
2445) num_connections = coupler%connection_set%num_connections
2446)
2447) flow_condition => coupler%flow_condition
2448) if (associated(flow_condition%pressure)) then
2449) select case(flow_condition%pressure%itype)
2450) case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
2451) select type(dataset => &
2452) flow_condition%pressure%dataset)
2453) class is(dataset_ascii_type)
2454) coupler%flow_aux_real_var(RICHARDS_PRESSURE_DOF, &
2455) 1:num_connections) = dataset%rarray(1)
2456) class is(dataset_gridded_hdf5_type)
2457) call PatchUpdateCouplerFromDataset(coupler,option, &
2458) patch%grid,dataset, &
2459) RICHARDS_PRESSURE_DOF)
2460) class default
2461) end select
2462) case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
2463) call HydrostaticUpdateCoupler(coupler,option,patch%grid)
2464) ! case(SATURATION_BC)
2465) case(HET_DIRICHLET)
2466) call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
2467) flow_condition%pressure%dataset, &
2468) num_connections,RICHARDS_PRESSURE_DOF,option)
2469) end select
2470) endif
2471) if (associated(flow_condition%saturation)) then
2472) call SaturationUpdateCoupler(coupler,option,patch%grid, &
2473) patch%saturation_function_array, &
2474) patch%sat_func_id)
2475) endif
2476) if (associated(flow_condition%rate)) then
2477) select case(flow_condition%rate%itype)
2478) case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
2479) call PatchScaleSourceSink(patch,coupler, &
2480) flow_condition%rate%isubtype,option)
2481) case (HET_VOL_RATE_SS,HET_MASS_RATE_SS)
2482) call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
2483) flow_condition%rate%dataset, &
2484) num_connections,RICHARDS_PRESSURE_DOF,option)
2485) end select
2486) endif
2487)
2488) end subroutine PatchUpdateCouplerAuxVarsRich
2489)
2490) ! ************************************************************************** !
2491)
2492) subroutine PatchUpdateCouplerFromDataset(coupler,option,grid,dataset,dof)
2493) !
2494) ! Updates auxiliary variables from dataset.
2495) !
2496) ! Author: Glenn Hammond
2497) ! Date: 11/26/07
2498) !
2499)
2500) use Option_module
2501) use Grid_module
2502) use Coupler_module
2503) use Dataset_Gridded_HDF5_class
2504)
2505) implicit none
2506)
2507) type(coupler_type) :: coupler
2508) type(option_type) :: option
2509) type(grid_type) :: grid
2510) class(dataset_gridded_hdf5_type) :: dataset
2511) PetscInt :: dof
2512)
2513) PetscReal :: temp_real
2514) PetscInt :: iconn
2515) PetscInt :: local_id
2516) PetscInt :: ghosted_id
2517) PetscReal :: x
2518) PetscReal :: y
2519) PetscReal :: z
2520) PetscReal :: dist(-1:3)
2521)
2522) do iconn = 1, coupler%connection_set%num_connections
2523) local_id = coupler%connection_set%id_dn(iconn)
2524) ghosted_id = grid%nL2G(local_id)
2525) x = grid%x(ghosted_id)
2526) y = grid%y(ghosted_id)
2527) z = grid%z(ghosted_id)
2528) if (associated(coupler%connection_set%dist)) then
2529) dist = coupler%connection_set%dist(:,iconn)
2530) x = x-dist(0)*dist(1)
2531) y = y-dist(0)*dist(2)
2532) z = z-dist(0)*dist(3)
2533) endif
2534) call DatasetGriddedHDF5InterpolateReal(dataset,x,y,z,temp_real,option)
2535) coupler%flow_aux_real_var(dof,iconn) = temp_real
2536) enddo
2537)
2538) end subroutine PatchUpdateCouplerFromDataset
2539)
2540) ! ************************************************************************** !
2541)
2542) subroutine PatchScaleSourceSink(patch,source_sink,iscale_type,option)
2543) !
2544) ! Scales select source/sinks based on perms*volume
2545) !
2546) ! Author: Glenn Hammond
2547) ! Date: 01/12/11
2548) !
2549)
2550) use Option_module
2551) use Field_module
2552) use Coupler_module
2553) use Connection_module
2554) use Condition_module
2555) use Grid_module
2556) use Material_Aux_class
2557) use Variables_module, only : PERMEABILITY_X
2558)
2559) implicit none
2560)
2561) #include "petsc/finclude/petscvec.h"
2562) #include "petsc/finclude/petscvec.h90"
2563) #include "petsc/finclude/petscdmda.h"
2564)
2565) type(patch_type) :: patch
2566) type(coupler_type) :: source_sink
2567) PetscInt :: iscale_type
2568) type(option_type) :: option
2569)
2570) PetscErrorCode :: ierr
2571)
2572) type(grid_type), pointer :: grid
2573) type(connection_set_type), pointer :: cur_connection_set
2574) type(field_type), pointer :: field
2575)
2576) PetscReal, pointer :: vec_ptr(:)
2577) PetscInt :: local_id
2578) PetscInt :: ghosted_id, neighbor_ghosted_id
2579) PetscInt :: iconn
2580) PetscReal :: scale, sum
2581) PetscInt :: icount, x_count, y_count, z_count
2582) PetscInt, parameter :: x_width = 1, y_width = 1, z_width = 0
2583) PetscInt :: ghosted_neighbors(27)
2584) class(material_auxvar_type), pointer :: material_auxvars(:)
2585)
2586) field => patch%field
2587) grid => patch%grid
2588) material_auxvars => patch%aux%Material%auxvars
2589)
2590) grid => patch%grid
2591)
2592) call VecZeroEntries(field%work,ierr);CHKERRQ(ierr)
2593) call VecGetArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
2594)
2595) cur_connection_set => source_sink%connection_set
2596)
2597) select case(iscale_type)
2598) case(SCALE_BY_VOLUME)
2599) do iconn = 1, cur_connection_set%num_connections
2600) local_id = cur_connection_set%id_dn(iconn)
2601) ghosted_id = grid%nL2G(local_id)
2602) vec_ptr(local_id) = vec_ptr(local_id) + &
2603) material_auxvars(ghosted_id)%volume
2604) enddo
2605) case(SCALE_BY_PERM)
2606) do iconn = 1, cur_connection_set%num_connections
2607) local_id = cur_connection_set%id_dn(iconn)
2608) ghosted_id = grid%nL2G(local_id)
2609) vec_ptr(local_id) = vec_ptr(local_id) + &
2610) ! this function protects from error in gfortran compiler when indexing
2611) ! the permeability array
2612) MaterialAuxVarGetValue(material_auxvars(ghosted_id), &
2613) PERMEABILITY_X) * &
2614) material_auxvars(ghosted_id)%volume
2615) enddo
2616) case(SCALE_BY_NEIGHBOR_PERM)
2617) do iconn = 1, cur_connection_set%num_connections
2618) local_id = cur_connection_set%id_dn(iconn)
2619) ghosted_id = grid%nL2G(local_id)
2620) !geh: kludge for 64-bit integers.
2621) call GridGetGhostedNeighbors(grid,ghosted_id,DMDA_STENCIL_STAR, &
2622) x_width,y_width,z_width, &
2623) x_count,y_count,z_count, &
2624) ghosted_neighbors,option)
2625) ! ghosted neighbors is ordered first in x, then, y, then z
2626) icount = 0
2627) sum = 0.d0
2628) ! x-direction
2629) do while (icount < x_count)
2630) icount = icount + 1
2631) neighbor_ghosted_id = ghosted_neighbors(icount)
2632) sum = sum + &
2633) MaterialAuxVarGetValue(material_auxvars(neighbor_ghosted_id), &
2634) PERMEABILITY_X) * &
2635) grid%structured_grid%dy(neighbor_ghosted_id)* &
2636) grid%structured_grid%dz(neighbor_ghosted_id)
2637) enddo
2638) ! y-direction
2639) do while (icount < x_count + y_count)
2640) icount = icount + 1
2641) neighbor_ghosted_id = ghosted_neighbors(icount)
2642) sum = sum + &
2643) MaterialAuxVarGetValue(material_auxvars(neighbor_ghosted_id), &
2644) PERMEABILITY_X) * &
2645) grid%structured_grid%dx(neighbor_ghosted_id)* &
2646) grid%structured_grid%dz(neighbor_ghosted_id)
2647) enddo
2648) ! z-direction
2649) do while (icount < x_count + y_count + z_count)
2650) icount = icount + 1
2651) neighbor_ghosted_id = ghosted_neighbors(icount)
2652) sum = sum + &
2653) MaterialAuxVarGetValue(material_auxvars(neighbor_ghosted_id), &
2654) PERMEABILITY_X) * &
2655) grid%structured_grid%dx(neighbor_ghosted_id)* &
2656) grid%structured_grid%dy(neighbor_ghosted_id)
2657) enddo
2658) vec_ptr(local_id) = vec_ptr(local_id) + sum
2659) enddo
2660) case(0)
2661) option%io_buffer = 'Unknown scaling type in PatchScaleSourceSink ' // &
2662) 'for FLOW_CONDITION "' // trim(source_sink%flow_condition%name) // '".'
2663) call printErrMsg(option)
2664) end select
2665)
2666) call VecRestoreArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
2667) call VecNorm(field%work,NORM_1,scale,ierr);CHKERRQ(ierr)
2668) if (scale < 1.d-40) then
2669) option%io_buffer = 'Zero infinity norm in PatchScaleSourceSink for ' // &
2670) 'FLOW_CONDITION "' // trim(source_sink%flow_condition%name) // '".'
2671) call printErrMsg(option)
2672) endif
2673) scale = 1.d0/scale
2674) call VecScale(field%work,scale,ierr);CHKERRQ(ierr)
2675)
2676) call VecGetArrayF90(field%work,vec_ptr, ierr);CHKERRQ(ierr)
2677) do iconn = 1, cur_connection_set%num_connections
2678) local_id = cur_connection_set%id_dn(iconn)
2679) select case(option%iflowmode)
2680) case(RICHARDS_MODE,G_MODE,TH_MODE,TOIL_IMS_MODE)
2681) source_sink%flow_aux_real_var(ONE_INTEGER,iconn) = &
2682) vec_ptr(local_id)
2683) case(MPH_MODE,IMS_MODE,MIS_MODE,FLASH2_MODE)
2684) option%io_buffer = 'PatchScaleSourceSink not set up for flow mode'
2685) call printErrMsg(option)
2686) end select
2687) enddo
2688) call VecRestoreArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
2689)
2690) end subroutine PatchScaleSourceSink
2691)
2692) ! ************************************************************************** !
2693)
2694) subroutine PatchUpdateHetroCouplerAuxVars(patch,coupler,dataset_base, &
2695) sum_connection,isub_condition,option)
2696) !
2697) ! This subroutine updates aux vars for distributed copuler_type
2698) !
2699) ! Author: Gautam Bisht, LBL
2700) ! Date: 10/03/2012
2701) !
2702)
2703) use Option_module
2704) use Field_module
2705) use Coupler_module
2706) use Connection_module
2707) use Condition_module
2708) use Grid_module
2709) use Dataset_module
2710) use Dataset_Map_HDF5_class
2711) use Dataset_Base_class
2712) use Dataset_Ascii_class
2713)
2714) implicit none
2715)
2716) #include "petsc/finclude/petscvec.h"
2717) #include "petsc/finclude/petscvec.h90"
2718) #include "petsc/finclude/petscdmda.h"
2719)
2720) type(patch_type) :: patch
2721) type(coupler_type) :: coupler
2722) class(dataset_base_type), pointer :: dataset_base
2723) PetscInt :: isub_condition
2724) type(option_type) :: option
2725)
2726) type(connection_set_type), pointer :: cur_connection_set
2727) type(grid_type),pointer :: grid
2728) PetscErrorCode :: ierr
2729) PetscInt :: iconn,sum_connection
2730) PetscInt :: ghosted_id,local_id
2731) PetscInt,pointer ::cell_ids_nat(:)
2732) type(flow_sub_condition_type) :: flow_sub_condition
2733)
2734) class(dataset_map_hdf5_type), pointer :: dataset_map_hdf5
2735) class(dataset_ascii_type), pointer :: dataset_ascii
2736)
2737) grid => patch%grid
2738)
2739) if (isub_condition>option%nflowdof*option%nphase) then
2740) option%io_buffer='ERROR: PatchUpdateHetroCouplerAuxVars '// &
2741) 'isub_condition > option%nflowdof*option%nphase.'
2742) call printErrMsg(option)
2743) endif
2744)
2745) if (option%iflowmode/=RICHARDS_MODE.and.option%iflowmode/=TH_MODE) then
2746) option%io_buffer='PatchUpdateHetroCouplerAuxVars only implemented '// &
2747) ' for RICHARDS or TH mode.'
2748) call printErrMsg(option)
2749) endif
2750)
2751) cur_connection_set => coupler%connection_set
2752)
2753) select type(selector=>dataset_base)
2754) class is(dataset_map_hdf5_type)
2755) dataset_map_hdf5 => selector
2756)
2757) ! If called for the first time, create the map
2758) if (dataset_map_hdf5%first_time) then
2759) allocate(cell_ids_nat(cur_connection_set%num_connections))
2760) do iconn=1,cur_connection_set%num_connections
2761) sum_connection = sum_connection + 1
2762) local_id = cur_connection_set%id_dn(iconn)
2763) ghosted_id = grid%nL2G(local_id)
2764) cell_ids_nat(iconn)=grid%nG2A(ghosted_id)
2765) enddo
2766)
2767) call PatchCreateFlowConditionDatasetMap(patch%grid,dataset_map_hdf5,&
2768) cell_ids_nat,cur_connection_set%num_connections,option)
2769)
2770) dataset_map_hdf5%first_time = PETSC_FALSE
2771) deallocate(cell_ids_nat)
2772)
2773) endif
2774)
2775) ! Save the data in the array
2776) do iconn=1,cur_connection_set%num_connections
2777) coupler%flow_aux_real_var(isub_condition,iconn) = &
2778) dataset_map_hdf5%rarray(dataset_map_hdf5%datatocell_ids(iconn))
2779) enddo
2780)
2781) class is(dataset_ascii_type)
2782) dataset_ascii => selector
2783)
2784) do iconn=1,cur_connection_set%num_connections
2785) coupler%flow_aux_real_var(isub_condition,iconn) = &
2786) dataset_ascii%rarray(1)
2787) enddo
2788)
2789) class default
2790) option%io_buffer = 'Incorrect dataset class (' // &
2791) trim(DatasetGetClass(dataset_base)) // &
2792) ') for coupler "' // trim(coupler%name) // &
2793) '" in PatchUpdateHetroCouplerAuxVars.'
2794) call printErrMsg(option)
2795) end select
2796)
2797) end subroutine PatchUpdateHetroCouplerAuxVars
2798)
2799) ! ************************************************************************** !
2800)
2801) subroutine PatchCreateFlowConditionDatasetMap(grid,dataset_map_hdf5,cell_ids,ncells,option)
2802) !
2803) ! This routine creates dataset-map for flow condition
2804) !
2805) ! Author: Gautam Bisht, LBL
2806) ! Date: 10/26/12
2807) !
2808)
2809) use Grid_module
2810) use Dataset_Map_HDF5_class
2811) use Option_module
2812)
2813) implicit none
2814) #include "petsc/finclude/petscvec.h"
2815) #include "petsc/finclude/petscvec.h90"
2816) #include "petsc/finclude/petscis.h"
2817) #include "petsc/finclude/petscis.h90"
2818) #include "petsc/finclude/petscviewer.h"
2819)
2820) type(grid_type) :: grid
2821) class(dataset_map_hdf5_type) :: dataset_map_hdf5
2822) type(option_type) :: option
2823) PetscInt,pointer :: cell_ids(:)
2824) PetscInt :: ncells
2825)
2826) PetscInt, allocatable :: int_array(:)
2827) PetscInt :: ghosted_id,local_id
2828) PetscInt :: ii,count
2829) PetscReal, pointer :: vec_ptr(:)
2830) PetscErrorCode :: ierr
2831) PetscInt :: nloc,nglo
2832) PetscInt :: istart
2833)
2834) IS :: is_from, is_to
2835) Vec :: map_ids_1, map_ids_2,map_ids_3
2836) VecScatter ::vec_scatter
2837) PetscViewer :: viewer
2838)
2839) ! Step-1: Rearrange map dataset
2840) nloc = maxval(dataset_map_hdf5%mapping(2,:))
2841) call MPI_Allreduce(nloc,nglo,ONE_INTEGER,MPIU_INTEGER,MPI_Max,option%mycomm,ierr)
2842) call VecCreateMPI(option%mycomm,dataset_map_hdf5%map_dims_local(2),&
2843) PETSC_DETERMINE,map_ids_1,ierr);CHKERRQ(ierr)
2844) call VecCreateMPI(option%mycomm,PETSC_DECIDE,nglo,map_ids_2, &
2845) ierr);CHKERRQ(ierr)
2846) call VecSet(map_ids_2,0,ierr);CHKERRQ(ierr)
2847)
2848) istart = 0
2849) call MPI_Exscan(dataset_map_hdf5%map_dims_local(2), istart, ONE_INTEGER_MPI, &
2850) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
2851)
2852) allocate(int_array(dataset_map_hdf5%map_dims_local(2)))
2853) do ii=1,dataset_map_hdf5%map_dims_local(2)
2854) int_array(ii)=ii+istart
2855) enddo
2856) int_array=int_array-1
2857)
2858) call ISCreateBlock(option%mycomm,1,dataset_map_hdf5%map_dims_local(2), &
2859) int_array,PETSC_COPY_VALUES,is_from,ierr);CHKERRQ(ierr)
2860) deallocate(int_array)
2861)
2862) allocate(int_array(dataset_map_hdf5%map_dims_local(2)))
2863) do ii=1,dataset_map_hdf5%map_dims_local(2)
2864) int_array(ii)=dataset_map_hdf5%mapping(2,ii)
2865) enddo
2866) int_array=int_array-1
2867)
2868) call ISCreateBlock(option%mycomm,1,dataset_map_hdf5%map_dims_local(2), &
2869) int_array,PETSC_COPY_VALUES,is_to,ierr);CHKERRQ(ierr)
2870) deallocate(int_array)
2871)
2872) !call VecCreateSeq(PETSC_COMM_SELF,dataset_map%map_dims_global(2),map_ids_1,ierr)
2873) !call VecCreateSeq(PETSC_COMM_SELF,maxval(dataset_map%map(2,:)),map_ids_2,ierr)
2874) !call VecSet(map_ids_2,0,ierr)
2875)
2876) call VecScatterCreate(map_ids_1,is_from,map_ids_2,is_to,vec_scatter, &
2877) ierr);CHKERRQ(ierr)
2878) call ISDestroy(is_from,ierr);CHKERRQ(ierr)
2879) call ISDestroy(is_to,ierr);CHKERRQ(ierr)
2880)
2881) call VecGetArrayF90(map_ids_1,vec_ptr,ierr);CHKERRQ(ierr)
2882) do ii=1,dataset_map_hdf5%map_dims_local(2)
2883) vec_ptr(ii)=dataset_map_hdf5%mapping(1,ii)
2884) enddo
2885) call VecRestoreArrayF90(map_ids_1,vec_ptr,ierr);CHKERRQ(ierr)
2886)
2887) call VecScatterBegin(vec_scatter,map_ids_1,map_ids_2, &
2888) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
2889) call VecScatterEnd(vec_scatter,map_ids_1,map_ids_2, &
2890) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
2891) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
2892)
2893) ! Step-2: Get ids in map dataset for cells
2894) allocate(int_array(ncells))
2895) allocate(dataset_map_hdf5%cell_ids_local(ncells))
2896) int_array=cell_ids-1
2897)
2898) call ISCreateBlock(option%mycomm,1,ncells,int_array,PETSC_COPY_VALUES,is_from, &
2899) ierr);CHKERRQ(ierr)
2900)
2901) istart = 0
2902) call MPI_Exscan(ncells, istart, ONE_INTEGER_MPI, &
2903) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
2904)
2905) do local_id=1,ncells
2906) int_array(local_id)=local_id+istart
2907) enddo
2908) int_array=int_array-1
2909)
2910) call ISCreateBlock(option%mycomm,1,ncells,int_array,PETSC_COPY_VALUES,is_to, &
2911) ierr);CHKERRQ(ierr)
2912) deallocate(int_array)
2913)
2914) !call VecCreateSeq(PETSC_COMM_SELF,ncells,map_ids_3,ierr)
2915) call VecCreateMPI(option%mycomm,ncells,PETSC_DETERMINE,map_ids_3, &
2916) ierr);CHKERRQ(ierr)
2917)
2918) call VecScatterCreate(map_ids_2,is_from,map_ids_3,is_to,vec_scatter, &
2919) ierr);CHKERRQ(ierr)
2920) call ISDestroy(is_from,ierr);CHKERRQ(ierr)
2921) call ISDestroy(is_to,ierr);CHKERRQ(ierr)
2922)
2923) call VecScatterBegin(vec_scatter,map_ids_2,map_ids_3, &
2924) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
2925) call VecScatterEnd(vec_scatter,map_ids_2,map_ids_3, &
2926) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
2927) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
2928)
2929) ! Step-3: Save the datatocell_ids
2930) allocate(dataset_map_hdf5%datatocell_ids(ncells))
2931) call VecGetArrayF90(map_ids_3,vec_ptr,ierr);CHKERRQ(ierr)
2932) do local_id=1,ncells
2933) dataset_map_hdf5%datatocell_ids(local_id) = int(vec_ptr(local_id))
2934) enddo
2935) call VecRestoreArrayF90(map_ids_3,vec_ptr,ierr);CHKERRQ(ierr)
2936)
2937) call VecDestroy(map_ids_1,ierr);CHKERRQ(ierr)
2938) call VecDestroy(map_ids_2,ierr);CHKERRQ(ierr)
2939) call VecDestroy(map_ids_3,ierr);CHKERRQ(ierr)
2940)
2941) end subroutine PatchCreateFlowConditionDatasetMap
2942)
2943) ! ************************************************************************** !
2944)
2945) subroutine PatchInitConstraints(patch,reaction,option)
2946) !
2947) ! Initializes constraint concentrations
2948) !
2949) ! Author: Glenn Hammond
2950) ! Date: 12/04/08
2951) !
2952)
2953) use Reaction_Aux_module
2954)
2955) implicit none
2956)
2957) type(patch_type) :: patch
2958) type(option_type) :: option
2959) type(reaction_type), pointer :: reaction
2960)
2961) call PatchInitCouplerConstraints(patch%initial_condition_list, &
2962) reaction,option)
2963)
2964) call PatchInitCouplerConstraints(patch%boundary_condition_list, &
2965) reaction,option)
2966)
2967) call PatchInitCouplerConstraints(patch%source_sink_list, &
2968) reaction,option)
2969)
2970) end subroutine PatchInitConstraints
2971)
2972) ! ************************************************************************** !
2973)
2974) subroutine PatchInitCouplerConstraints(coupler_list,reaction,option)
2975) !
2976) ! Initializes constraint concentrations
2977) ! for a given coupler
2978) !
2979) ! Author: Glenn Hammond
2980) ! Date: 12/04/08
2981) !
2982)
2983) use Reaction_module
2984) use Reactive_Transport_Aux_module
2985) use Reaction_Aux_module
2986) use Global_Aux_module
2987) use Material_Aux_class
2988) use Transport_Constraint_module
2989)
2990) use EOS_Water_module
2991)
2992) implicit none
2993)
2994) type(coupler_list_type), pointer :: coupler_list
2995) type(option_type) :: option
2996) type(reaction_type), pointer :: reaction
2997)
2998) type(reactive_transport_auxvar_type), pointer :: rt_auxvar
2999) type(global_auxvar_type), pointer :: global_auxvar
3000) class(material_auxvar_type), allocatable :: material_auxvar
3001) type(coupler_type), pointer :: cur_coupler
3002) type(tran_constraint_coupler_type), pointer :: cur_constraint_coupler
3003) PetscReal :: dum1
3004) PetscErrorCode :: ierr
3005)
3006) allocate(material_auxvar)
3007) call MaterialAuxVarInit(material_auxvar,option)
3008) material_auxvar%porosity = option%reference_porosity
3009)
3010) cur_coupler => coupler_list%first
3011) do
3012) if (.not.associated(cur_coupler)) exit
3013)
3014) if (.not.associated(cur_coupler%tran_condition)) then
3015) option%io_buffer = 'Null transport condition found in coupler'
3016) if (len_trim(cur_coupler%name) > 1) then
3017) option%io_buffer = trim(option%io_buffer) // &
3018) ' "' // trim(cur_coupler%name) // '"'
3019) endif
3020) call printErrMsg(option)
3021) endif
3022)
3023) cur_constraint_coupler => &
3024) cur_coupler%tran_condition%constraint_coupler_list
3025) do
3026) if (.not.associated(cur_constraint_coupler)) exit
3027) global_auxvar => cur_constraint_coupler%global_auxvar
3028) rt_auxvar => cur_constraint_coupler%rt_auxvar
3029) if (associated(cur_coupler%flow_condition)) then
3030) if (associated(cur_coupler%flow_condition%pressure)) then
3031) if (associated(cur_coupler%flow_condition%pressure%dataset)) then
3032) global_auxvar%pres = &
3033) cur_coupler%flow_condition%pressure%dataset%rarray(1)
3034) else
3035) global_auxvar%pres = option%reference_pressure
3036) endif
3037) else
3038) global_auxvar%pres = option%reference_pressure
3039) endif
3040) if (associated(cur_coupler%flow_condition%temperature)) then
3041) if (associated(cur_coupler%flow_condition%temperature%dataset)) then
3042) global_auxvar%temp = &
3043) cur_coupler%flow_condition%temperature%dataset%rarray(1)
3044) else
3045) global_auxvar%temp = option%reference_temperature
3046) endif
3047) else
3048) global_auxvar%temp = option%reference_temperature
3049) endif
3050)
3051) call EOSWaterDensity(global_auxvar%temp, &
3052) global_auxvar%pres(1), &
3053) global_auxvar%den_kg(1), &
3054) dum1,ierr)
3055) else
3056) global_auxvar%pres = option%reference_pressure
3057) global_auxvar%temp = option%reference_temperature
3058) global_auxvar%den_kg = option%reference_water_density
3059) endif
3060) global_auxvar%sat = option%reference_saturation
3061)
3062) call ReactionEquilibrateConstraint(rt_auxvar,global_auxvar, &
3063) material_auxvar, &
3064) reaction,cur_constraint_coupler%constraint_name, &
3065) cur_constraint_coupler%aqueous_species, &
3066) cur_constraint_coupler%free_ion_guess, &
3067) cur_constraint_coupler%minerals, &
3068) cur_constraint_coupler%surface_complexes, &
3069) cur_constraint_coupler%colloids, &
3070) cur_constraint_coupler%immobile_species, &
3071) cur_constraint_coupler%num_iterations, &
3072) PETSC_FALSE,option)
3073) ! update CO2 mole fraction for CO2 modes
3074) select case(option%iflowmode)
3075) case(MPH_MODE,FLASH2_MODE)
3076) if (cur_coupler%flow_condition%iphase == 1) then
3077) dum1 = RCO2MoleFraction(rt_auxvar,global_auxvar,reaction,option)
3078) cur_coupler%flow_condition%concentration%dataset%rarray(1) = dum1
3079) if (associated(cur_coupler%flow_aux_real_var)) then
3080) cur_coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,:) = dum1
3081) endif
3082) endif
3083) end select
3084) cur_constraint_coupler => cur_constraint_coupler%next
3085) enddo
3086) cur_coupler => cur_coupler%next
3087) enddo
3088)
3089) call MaterialAuxVarStrip(material_auxvar)
3090) deallocate(material_auxvar)
3091)
3092) end subroutine PatchInitCouplerConstraints
3093)
3094) ! ************************************************************************** !
3095)
3096) subroutine PatchUpdateUniformVelocity(patch,velocity,option)
3097) !
3098) ! Assigns uniform velocity in connection list
3099) ! darcy velocities
3100) !
3101) ! Author: Glenn Hammond
3102) ! Date: 02/20/08
3103) !
3104)
3105) use Option_module
3106) use Coupler_module
3107) use Condition_module
3108) use Connection_module
3109)
3110) implicit none
3111)
3112) type(patch_type), pointer :: patch
3113) PetscReal :: velocity(3)
3114) type(option_type), pointer :: option
3115)
3116) type(grid_type), pointer :: grid
3117) type(coupler_type), pointer :: boundary_condition
3118) type(connection_set_type), pointer :: cur_connection_set
3119) PetscInt :: iconn, sum_connection
3120) PetscReal :: vdarcy
3121)
3122) grid => patch%grid
3123)
3124) ! Internal Flux Terms -----------------------------------
3125) cur_connection_set => grid%internal_connection_set_list%first
3126) sum_connection = 0
3127) do
3128) if (.not.associated(cur_connection_set)) exit
3129) do iconn = 1, cur_connection_set%num_connections
3130) sum_connection = sum_connection + 1
3131) vdarcy = dot_product(velocity, &
3132) cur_connection_set%dist(1:3,iconn))
3133) patch%internal_velocities(1,sum_connection) = vdarcy
3134) enddo
3135) cur_connection_set => cur_connection_set%next
3136) enddo
3137)
3138) ! Boundary Flux Terms -----------------------------------
3139) boundary_condition => patch%boundary_condition_list%first
3140) sum_connection = 0
3141) do
3142) if (.not.associated(boundary_condition)) exit
3143) cur_connection_set => boundary_condition%connection_set
3144) do iconn = 1, cur_connection_set%num_connections
3145) sum_connection = sum_connection + 1
3146) vdarcy = dot_product(velocity, &
3147) cur_connection_set%dist(1:3,iconn))
3148) patch%boundary_velocities(1,sum_connection) = vdarcy
3149) enddo
3150) boundary_condition => boundary_condition%next
3151) enddo
3152)
3153) end subroutine PatchUpdateUniformVelocity
3154)
3155) ! ************************************************************************** !
3156)
3157) function PatchAuxVarsUpToDate(patch)
3158) !
3159) ! Checks to see if aux vars are up to date
3160) !
3161) ! Author: Glenn Hammond
3162) ! Date: 09/12/08
3163) !
3164)
3165) use Grid_module
3166) use Option_module
3167) use Field_module
3168)
3169) use Mphase_Aux_module
3170) use TH_Aux_module
3171) use Richards_Aux_module
3172) use Reactive_Transport_Aux_module
3173)
3174) type(patch_type) :: patch
3175)
3176) PetscBool :: PatchAuxVarsUpToDate
3177) PetscBool :: flow_up_to_date
3178) PetscBool :: transport_up_to_date
3179) PetscInt :: dummy
3180) dummy = 1
3181)
3182) if (associated(patch%aux%TH)) then
3183) flow_up_to_date = patch%aux%TH%auxvars_up_to_date
3184) else if (associated(patch%aux%Richards)) then
3185) flow_up_to_date = patch%aux%Richards%auxvars_up_to_date
3186) else if (associated(patch%aux%Mphase)) then
3187) flow_up_to_date = patch%aux%Mphase%auxvars_up_to_date
3188) else if (associated(patch%aux%Flash2)) then
3189) flow_up_to_date = patch%aux%Flash2%auxvars_up_to_date
3190) else if (associated(patch%aux%Immis)) then
3191) flow_up_to_date = patch%aux%Immis%auxvars_up_to_date
3192) endif
3193)
3194) if (associated(patch%aux%RT)) then
3195) transport_up_to_date = patch%aux%RT%auxvars_up_to_date
3196) endif
3197)
3198) PatchAuxVarsUpToDate = flow_up_to_date .and. transport_up_to_date
3199)
3200) end function PatchAuxVarsUpToDate
3201)
3202) ! ************************************************************************** !
3203)
3204) subroutine PatchGetVariable1(patch,field,reaction,option,output_option,vec, &
3205) ivar,isubvar,isubvar1)
3206) !
3207) ! PatchGetVariable: Extracts variables indexed by ivar and isubvar from a patch
3208) !
3209) ! Author: Glenn Hammond
3210) ! Date: 09/12/08
3211) !
3212)
3213) use Grid_module
3214) use Option_module
3215) use Field_module
3216)
3217) use Immis_Aux_module
3218) use Miscible_Aux_module
3219) use Mphase_Aux_module
3220) use TH_Aux_module
3221) use Richards_Aux_module
3222) use Reaction_Mineral_module
3223) use Reaction_module
3224) use Reactive_Transport_Aux_module
3225) use Reaction_Surface_Complexation_Aux_module
3226) use General_Aux_module
3227) use Output_Aux_module
3228) use Variables_module
3229) use Material_Aux_class
3230)
3231) implicit none
3232)
3233) #include "petsc/finclude/petscvec.h"
3234) #include "petsc/finclude/petscvec.h90"
3235)
3236) type(option_type), pointer :: option
3237) type(reaction_type), pointer :: reaction
3238) type(output_option_type), pointer :: output_option
3239) type(field_type), pointer :: field
3240) type(patch_type), pointer :: patch
3241) Vec :: vec
3242) PetscInt :: ivar
3243) PetscInt :: isubvar
3244) PetscInt, optional :: isubvar1
3245) PetscInt :: iphase
3246)
3247) PetscInt :: local_id, ghosted_id
3248) type(grid_type), pointer :: grid
3249) class(material_auxvar_type), pointer :: material_auxvars(:)
3250) PetscReal, pointer :: vec_ptr(:), vec_ptr2(:)
3251) PetscReal :: xmass, lnQKgas, ehfac, eh0, pe0, ph0, tk
3252) PetscReal :: tempreal
3253) PetscInt :: tempint, tempint2
3254) PetscInt :: irate, istate, irxn, ifo2, jcomp, comp_id
3255) PetscInt :: ivar_temp
3256) PetscErrorCode :: ierr
3257)
3258) grid => patch%grid
3259) material_auxvars => patch%aux%Material%auxvars
3260)
3261) call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
3262)
3263) iphase = 1
3264) select case(ivar)
3265) case(TEMPERATURE,LIQUID_PRESSURE,GAS_PRESSURE,AIR_PRESSURE, &
3266) LIQUID_SATURATION,GAS_SATURATION,ICE_SATURATION, &
3267) LIQUID_MOLE_FRACTION,GAS_MOLE_FRACTION,LIQUID_ENERGY,GAS_ENERGY, &
3268) LIQUID_DENSITY,GAS_DENSITY,GAS_DENSITY_MOL,LIQUID_VISCOSITY, &
3269) GAS_VISCOSITY,CAPILLARY_PRESSURE,LIQUID_DENSITY_MOL, &
3270) LIQUID_MOBILITY,GAS_MOBILITY,SC_FUGA_COEFF,STATE,ICE_DENSITY, &
3271) EFFECTIVE_POROSITY,LIQUID_HEAD,VAPOR_PRESSURE,SATURATION_PRESSURE, &
3272) MAXIMUM_PRESSURE,LIQUID_MASS_FRACTION,GAS_MASS_FRACTION, &
3273) OIL_PRESSURE,OIL_SATURATION,OIL_DENSITY,OIL_DENSITY_MOL,OIL_ENERGY, &
3274) OIL_MOBILITY)
3275)
3276) if (associated(patch%aux%TH)) then
3277) select case(ivar)
3278) case(TEMPERATURE)
3279) do local_id=1,grid%nlmax
3280) vec_ptr(local_id) = &
3281) patch%aux%Global%auxvars(grid%nL2G(local_id))%temp
3282) enddo
3283) case(LIQUID_PRESSURE)
3284) do local_id=1,grid%nlmax
3285) vec_ptr(local_id) = &
3286) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)
3287) enddo
3288) case(LIQUID_SATURATION)
3289) do local_id=1,grid%nlmax
3290) vec_ptr(local_id) = &
3291) patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1)
3292) enddo
3293) case(LIQUID_DENSITY)
3294) do local_id=1,grid%nlmax
3295) vec_ptr(local_id) = &
3296) patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
3297) enddo
3298) case(GAS_MOLE_FRACTION,GAS_ENERGY,GAS_DENSITY,GAS_VISCOSITY) ! still needs implementation
3299) call printErrMsg(option,'GAS_MOLE_FRACTION not supported by TH')
3300) case(GAS_SATURATION)
3301) do local_id=1,grid%nlmax
3302) if (option%use_th_freezing) then
3303) vec_ptr(local_id) = &
3304) patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_gas
3305) else
3306) vec_ptr(local_id) = 0.d0
3307) endif
3308) enddo
3309) case(ICE_SATURATION)
3310) if (option%use_th_freezing) then
3311) do local_id=1,grid%nlmax
3312) vec_ptr(local_id) = &
3313) patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_ice
3314) enddo
3315) endif
3316) case(ICE_DENSITY)
3317) if (option%use_th_freezing) then
3318) do local_id=1,grid%nlmax
3319) vec_ptr(local_id) = &
3320) patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%den_ice*FMWH2O
3321) enddo
3322) endif
3323) case(LIQUID_VISCOSITY)
3324) do local_id=1,grid%nlmax
3325) vec_ptr(local_id) = &
3326) patch%aux%TH%auxvars(grid%nL2G(local_id))%vis
3327) enddo
3328) case(LIQUID_MOBILITY)
3329) do local_id=1,grid%nlmax
3330) vec_ptr(local_id) = &
3331) patch%aux%TH%auxvars(grid%nL2G(local_id))%kvr
3332) enddo
3333) case(LIQUID_MOLE_FRACTION)
3334) call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by TH')
3335) case(LIQUID_ENERGY)
3336) do local_id=1,grid%nlmax
3337) vec_ptr(local_id) = &
3338) patch%aux%TH%auxvars(grid%nL2G(local_id))%u
3339) enddo
3340) case(EFFECTIVE_POROSITY)
3341) do local_id=1,grid%nlmax
3342) vec_ptr(local_id) = &
3343) patch%aux%TH%auxvars(grid%nL2G(local_id))%transient_por
3344) enddo
3345) end select
3346)
3347) else if (associated(patch%aux%Richards)) then
3348)
3349) select case(ivar)
3350) case(TEMPERATURE)
3351) call printErrMsg(option,'TEMPERATURE not supported by Richards')
3352) case(GAS_SATURATION)
3353) call printErrMsg(option,'GAS_SATURATION not supported by Richards')
3354) case(ICE_SATURATION)
3355) call printErrMsg(option,'ICE_SATURATION not supported by Richards')
3356) case(ICE_DENSITY)
3357) call printErrMsg(option,'ICE_DENSITY not supported by Richards')
3358) case(GAS_DENSITY)
3359) call printErrMsg(option,'GAS_DENSITY not supported by Richards')
3360) case(LIQUID_MOLE_FRACTION)
3361) call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by Richards')
3362) case(GAS_MOLE_FRACTION)
3363) call printErrMsg(option,'GAS_MOLE_FRACTION not supported by Richards')
3364) case(LIQUID_ENERGY)
3365) call printErrMsg(option,'LIQUID_ENERGY not supported by Richards')
3366) case(GAS_ENERGY)
3367) call printErrMsg(option,'GAS_ENERGY not supported by Richards')
3368) case(LIQUID_VISCOSITY)
3369) call printErrMsg(option,'LIQUID_VISCOSITY not supported by Richards')
3370) case(GAS_VISCOSITY)
3371) call printErrMsg(option,'GAS_VISCOSITY not supported by Richards')
3372) case(GAS_MOBILITY)
3373) call printErrMsg(option,'GAS_MOBILITY not supported by Richards')
3374) case(EFFECTIVE_POROSITY)
3375) call printErrMsg(option,'EFFECTIVE_POROSITY not supported by Richards')
3376) case(LIQUID_PRESSURE)
3377) do local_id=1,grid%nlmax
3378) vec_ptr(local_id) = &
3379) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)
3380) enddo
3381) case(LIQUID_HEAD)
3382) do local_id=1,grid%nlmax
3383) vec_ptr(local_id) = &
3384) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)/9.81/ &
3385) patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
3386) enddo
3387) case(LIQUID_SATURATION)
3388) do local_id=1,grid%nlmax
3389) vec_ptr(local_id) = &
3390) patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1)
3391) enddo
3392) case(LIQUID_DENSITY)
3393) do local_id=1,grid%nlmax
3394) vec_ptr(local_id) = &
3395) patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
3396) enddo
3397) case(LIQUID_MOBILITY)
3398) do local_id=1,grid%nlmax
3399) vec_ptr(local_id) = &
3400) patch%aux%Richards%auxvars(grid%nL2G(local_id))%kvr
3401) enddo
3402) end select
3403) else if (associated(patch%aux%Flash2)) then
3404)
3405) select case(ivar)
3406) case(TEMPERATURE)
3407) do local_id=1,grid%nlmax
3408) vec_ptr(local_id) = &
3409) patch%aux%Global%auxvars(grid%nL2G(local_id))%temp
3410) enddo
3411) case(LIQUID_PRESSURE)
3412) do local_id=1,grid%nlmax
3413) vec_ptr(local_id) = &
3414) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(2)
3415) enddo
3416) case(LIQUID_SATURATION)
3417) do local_id=1,grid%nlmax
3418) vec_ptr(local_id) = &
3419) patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1)
3420) enddo
3421) case(LIQUID_DENSITY)
3422) do local_id=1,grid%nlmax
3423) vec_ptr(local_id) = &
3424) patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
3425) enddo
3426) case(GAS_SATURATION)
3427) do local_id=1,grid%nlmax
3428) vec_ptr(local_id) = &
3429) patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(2)
3430) enddo
3431) case(GAS_MOLE_FRACTION)
3432) do local_id=1,grid%nlmax
3433) vec_ptr(local_id) = &
3434) patch%aux%Flash2%auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(2+isubvar)
3435) enddo
3436) case(GAS_ENERGY)
3437) do local_id=1,grid%nlmax
3438) vec_ptr(local_id) = patch%aux%Flash2% &
3439) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(2)
3440) enddo
3441) case(GAS_VISCOSITY)
3442) do local_id=1,grid%nlmax
3443) vec_ptr(local_id) = patch%aux%Flash2% &
3444) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(2)
3445) enddo
3446) case(GAS_MOBILITY)
3447) do local_id=1,grid%nlmax
3448) vec_ptr(local_id) = patch%aux%Flash2% &
3449) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(2)
3450) enddo
3451) case(GAS_DENSITY)
3452) do local_id=1,grid%nlmax
3453) vec_ptr(local_id) = patch%aux%Global% &
3454) auxvars(grid%nL2G(local_id))%den_kg(2)
3455) enddo
3456) case(GAS_DENSITY_MOL)
3457) do local_id=1,grid%nlmax
3458) vec_ptr(local_id) = patch%aux%Global% &
3459) auxvars(grid%nL2G(local_id))%den(2)
3460) enddo
3461) case(SC_FUGA_COEFF)
3462) if (.not.associated(patch%aux%Global% &
3463) auxvars(1)%fugacoeff) .and. &
3464) OptionPrintToScreen(option))then
3465) print *,'ERRor, fugacoeff not allocated for ', option%iflowmode, 1
3466) endif
3467) do local_id=1,grid%nlmax
3468) vec_ptr(local_id) = patch%aux%Global% &
3469) auxvars(grid%nL2G(local_id))%fugacoeff(1)
3470) enddo
3471) case(LIQUID_MOLE_FRACTION)
3472) do local_id=1,grid%nlmax
3473) vec_ptr(local_id) = patch%aux%Flash2% &
3474) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(isubvar)
3475) enddo
3476) case(LIQUID_VISCOSITY)
3477) do local_id=1,grid%nlmax
3478) vec_ptr(local_id) = patch%aux%Flash2% &
3479) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
3480) enddo
3481) case(LIQUID_MOBILITY)
3482) do local_id=1,grid%nlmax
3483) vec_ptr(local_id) = patch%aux%Flash2% &
3484) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(1)
3485) enddo
3486) case(LIQUID_ENERGY)
3487) do local_id=1,grid%nlmax
3488) vec_ptr(local_id) = patch%aux%Flash2% &
3489) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(1)
3490) enddo
3491) end select
3492)
3493) else if (associated(patch%aux%Mphase)) then
3494)
3495) select case(ivar)
3496)
3497) case(TEMPERATURE)
3498) do local_id=1,grid%nlmax
3499) vec_ptr(local_id) = patch%aux%Global% &
3500) auxvars(grid%nL2G(local_id))%temp
3501) enddo
3502) case(LIQUID_PRESSURE)
3503) do local_id=1,grid%nlmax
3504) vec_ptr(local_id) = patch%aux%Global% &
3505) auxvars(grid%nL2G(local_id))%pres(1)
3506) enddo
3507) case(GAS_PRESSURE)
3508) do local_id=1,grid%nlmax
3509) vec_ptr(local_id) = patch%aux%Global% &
3510) auxvars(grid%nL2G(local_id))%pres(2)
3511) enddo
3512) case(LIQUID_SATURATION)
3513) do local_id=1,grid%nlmax
3514) vec_ptr(local_id) = patch%aux%Global% &
3515) auxvars(grid%nL2G(local_id))%sat(1)
3516) enddo
3517) case(LIQUID_DENSITY)
3518) !geh: CO2 Mass Balance Fix (change to #if 0 to scale the mixture density by the water mole fraction)
3519) #if 1
3520) do local_id=1,grid%nlmax
3521) vec_ptr(local_id) = patch%aux%Global% &
3522) auxvars(grid%nL2G(local_id))%den_kg(1)
3523) enddo
3524) #else
3525) do local_id=1,grid%nlmax
3526) vec_ptr(local_id) = &
3527) patch%aux%Global%auxvars(grid%nL2G(local_id))%den(1) * &
3528) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
3529) auxvar_elem(0)%xmol(1) * FMWH2O
3530) enddo
3531) #endif
3532) case(LIQUID_VISCOSITY)
3533) do local_id=1,grid%nlmax
3534) vec_ptr(local_id) = patch%aux%Mphase% &
3535) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
3536) enddo
3537) case(LIQUID_MOBILITY)
3538) do local_id=1,grid%nlmax
3539) vec_ptr(local_id) = patch%aux%Mphase% &
3540) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(1)
3541) enddo
3542) case(GAS_SATURATION)
3543) do local_id=1,grid%nlmax
3544) vec_ptr(local_id) = patch%aux%Global% &
3545) auxvars(grid%nL2G(local_id))%sat(2)
3546) enddo
3547) case(GAS_MOLE_FRACTION)
3548) do local_id=1,grid%nlmax
3549) vec_ptr(local_id) = patch%aux%Mphase% &
3550) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(2+isubvar)
3551) enddo
3552) case(GAS_ENERGY)
3553) do local_id=1,grid%nlmax
3554) vec_ptr(local_id) = patch%aux%Mphase% &
3555) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(2)
3556) enddo
3557) case(GAS_VISCOSITY)
3558) do local_id=1,grid%nlmax
3559) vec_ptr(local_id) = patch%aux%Mphase% &
3560) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(2)
3561) enddo
3562) case(GAS_MOBILITY)
3563) do local_id=1,grid%nlmax
3564) vec_ptr(local_id) = patch%aux%Mphase% &
3565) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(2)
3566) enddo
3567) case(GAS_DENSITY)
3568) do local_id=1,grid%nlmax
3569) vec_ptr(local_id) = patch%aux%Global% &
3570) auxvars(grid%nL2G(local_id))%den_kg(2)
3571) enddo
3572) case(GAS_DENSITY_MOL)
3573) do local_id=1,grid%nlmax
3574) vec_ptr(local_id) = &
3575) patch%aux%Global%auxvars(grid%nL2G(local_id))%den(2)
3576) enddo
3577) case(SC_FUGA_COEFF)
3578) if (.not.associated(patch%aux%Global%auxvars(1)%fugacoeff) .and. &
3579) OptionPrintToScreen(option))then
3580) print *,'ERRor, fugacoeff not allocated for ', option%iflowmode, 1
3581) endif
3582) do local_id=1,grid%nlmax
3583) vec_ptr(local_id) = patch%aux%Global%&
3584) auxvars(grid%nL2G(local_id))%fugacoeff(1)
3585) enddo
3586) case(LIQUID_MOLE_FRACTION)
3587) do local_id=1,grid%nlmax
3588) vec_ptr(local_id) = patch%aux%Mphase%&
3589) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(isubvar)
3590) enddo
3591) case(LIQUID_ENERGY)
3592) do local_id=1,grid%nlmax
3593) vec_ptr(local_id) = patch%aux%Mphase%&
3594) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(1)
3595) enddo
3596) end select
3597)
3598) else if (associated(patch%aux%Miscible)) then
3599)
3600) select case(ivar)
3601)
3602) ! case(TEMPERATURE)
3603) ! do local_id=1,grid%nlmax
3604) ! vec_ptr(local_id) = patch%aux%Global%auxvars(grid%nL2G(local_id))%temp
3605) ! enddo
3606) case(LIQUID_PRESSURE)
3607) do local_id=1,grid%nlmax
3608) vec_ptr(local_id) = &
3609) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)
3610) enddo
3611) case(LIQUID_DENSITY)
3612) do local_id=1,grid%nlmax
3613) vec_ptr(local_id) = &
3614) patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
3615) enddo
3616) case(LIQUID_VISCOSITY)
3617) do local_id=1,grid%nlmax
3618) vec_ptr(local_id) = patch%aux%Miscible% &
3619) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
3620) enddo
3621) case(LIQUID_MOLE_FRACTION)
3622) do local_id=1,grid%nlmax
3623) vec_ptr(local_id) = patch%aux%Miscible% &
3624) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(isubvar)
3625) enddo
3626) end select
3627)
3628) else if (associated(patch%aux%immis)) then
3629)
3630) select case(ivar)
3631) case(TEMPERATURE)
3632) do local_id=1,grid%nlmax
3633) vec_ptr(local_id) = patch%aux%Global% &
3634) auxvars(grid%nL2G(local_id))%temp
3635) enddo
3636) case(LIQUID_PRESSURE)
3637) do local_id=1,grid%nlmax
3638) vec_ptr(local_id) = patch%aux%Global% &
3639) auxvars(grid%nL2G(local_id))%pres(2)
3640) enddo
3641) case(LIQUID_SATURATION)
3642) do local_id=1,grid%nlmax
3643) vec_ptr(local_id) = patch%aux%Global% &
3644) auxvars(grid%nL2G(local_id))%sat(1)
3645) enddo
3646) case(LIQUID_DENSITY)
3647) do local_id=1,grid%nlmax
3648) vec_ptr(local_id) = patch%aux%Global% &
3649) auxvars(grid%nL2G(local_id))%den_kg(1)
3650) enddo
3651) case(LIQUID_ENERGY)
3652) do local_id=1,grid%nlmax
3653) vec_ptr(local_id) = patch%aux%Immis% &
3654) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(1)
3655) enddo
3656) case(LIQUID_VISCOSITY)
3657) do local_id=1,grid%nlmax
3658) vec_ptr(local_id) = patch%aux%Immis% &
3659) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
3660) enddo
3661) case(LIQUID_MOBILITY)
3662) do local_id=1,grid%nlmax
3663) vec_ptr(local_id) = patch%aux%Immis% &
3664) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(1)
3665) enddo
3666) case(GAS_SATURATION)
3667) do local_id=1,grid%nlmax
3668) vec_ptr(local_id) = patch%aux%Global% &
3669) auxvars(grid%nL2G(local_id))%sat(2)
3670) enddo
3671) case(GAS_ENERGY)
3672) do local_id=1,grid%nlmax
3673) vec_ptr(local_id) = patch%aux%Immis% &
3674) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(2)
3675) enddo
3676) case(GAS_DENSITY)
3677) do local_id=1,grid%nlmax
3678) vec_ptr(local_id) = patch%aux%Global% &
3679) auxvars(grid%nL2G(local_id))%den_kg(2)
3680) enddo
3681) case(GAS_VISCOSITY)
3682) do local_id=1,grid%nlmax
3683) vec_ptr(local_id) = patch%aux%Immis% &
3684) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(2)
3685) enddo
3686) case(GAS_MOBILITY)
3687) do local_id=1,grid%nlmax
3688) vec_ptr(local_id) = patch%aux%Immis% &
3689) auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(2)
3690) enddo
3691) end select
3692) else if (associated(patch%aux%General)) then
3693) select case(ivar)
3694) case(TEMPERATURE)
3695) do local_id=1,grid%nlmax
3696) vec_ptr(local_id) = &
3697) patch%aux%General%auxvars(ZERO_INTEGER, &
3698) grid%nL2G(local_id))%temp
3699) enddo
3700) case(MAXIMUM_PRESSURE)
3701) do local_id=1,grid%nlmax
3702) ghosted_id = grid%nL2G(local_id)
3703) vec_ptr(local_id) = &
3704) maxval(patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3705) pres(option%liquid_phase:option%gas_phase))
3706) enddo
3707) case(LIQUID_PRESSURE)
3708) if (output_option%filter_non_state_variables) then
3709) do local_id=1,grid%nlmax
3710) ghosted_id = grid%nL2G(local_id)
3711) if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
3712) GAS_STATE) then
3713) vec_ptr(local_id) = &
3714) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3715) pres(option%liquid_phase)
3716) else
3717) vec_ptr(local_id) = 0.d0
3718) endif
3719) enddo
3720) else
3721) do local_id=1,grid%nlmax
3722) ghosted_id = grid%nL2G(local_id)
3723) vec_ptr(local_id) = &
3724) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3725) pres(option%liquid_phase)
3726) enddo
3727) endif
3728) case(GAS_PRESSURE)
3729) if (output_option%filter_non_state_variables) then
3730) do local_id=1,grid%nlmax
3731) ghosted_id = grid%nL2G(local_id)
3732) if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
3733) LIQUID_STATE) then
3734) vec_ptr(local_id) = &
3735) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3736) pres(option%gas_phase)
3737) else
3738) vec_ptr(local_id) = 0.d0
3739) endif
3740) enddo
3741) else
3742) do local_id=1,grid%nlmax
3743) ghosted_id = grid%nL2G(local_id)
3744) vec_ptr(local_id) = &
3745) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3746) pres(option%gas_phase)
3747) enddo
3748) endif
3749) case(AIR_PRESSURE)
3750) if (output_option%filter_non_state_variables) then
3751) do local_id=1,grid%nlmax
3752) ghosted_id = grid%nL2G(local_id)
3753) if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
3754) LIQUID_STATE) then
3755) vec_ptr(local_id) = &
3756) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3757) pres(option%air_pressure_id)
3758) else
3759) vec_ptr(local_id) = 0.d0
3760) endif
3761) enddo
3762) else
3763) do local_id=1,grid%nlmax
3764) ghosted_id = grid%nL2G(local_id)
3765) vec_ptr(local_id) = &
3766) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3767) pres(option%air_pressure_id)
3768) enddo
3769) endif
3770) case(CAPILLARY_PRESSURE)
3771) do local_id=1,grid%nlmax
3772) ghosted_id = grid%nL2G(local_id)
3773) vec_ptr(local_id) = &
3774) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3775) pres(option%capillary_pressure_id)
3776) enddo
3777) case(VAPOR_PRESSURE)
3778) do local_id=1,grid%nlmax
3779) ghosted_id = grid%nL2G(local_id)
3780) vec_ptr(local_id) = &
3781) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3782) pres(option%vapor_pressure_id)
3783) enddo
3784) case(SATURATION_PRESSURE)
3785) do local_id=1,grid%nlmax
3786) ghosted_id = grid%nL2G(local_id)
3787) vec_ptr(local_id) = &
3788) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
3789) pres(option%saturation_pressure_id)
3790) enddo
3791) case(STATE)
3792) do local_id=1,grid%nlmax
3793) vec_ptr(local_id) = &
3794) patch%aux%Global%auxvars(grid%nL2G(local_id))%istate
3795) enddo
3796) case(LIQUID_SATURATION)
3797) do local_id=1,grid%nlmax
3798) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3799) grid%nL2G(local_id))%sat(option%liquid_phase)
3800) enddo
3801) case(LIQUID_DENSITY)
3802) do local_id=1,grid%nlmax
3803) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3804) grid%nL2G(local_id))%den_kg(option%liquid_phase)
3805) enddo
3806) case(LIQUID_DENSITY_MOL)
3807) do local_id=1,grid%nlmax
3808) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3809) grid%nL2G(local_id))%den(option%liquid_phase)
3810) enddo
3811) case(LIQUID_ENERGY)
3812) if (isubvar == ZERO_INTEGER) then
3813) do local_id=1,grid%nlmax
3814) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3815) grid%nL2G(local_id))%U(option%liquid_phase)
3816) enddo
3817) else
3818) do local_id=1,grid%nlmax
3819) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3820) grid%nL2G(local_id))%U(option%liquid_phase) * &
3821) patch%aux%General%auxvars(ZERO_INTEGER, &
3822) grid%nL2G(local_id))%den(option%liquid_phase)
3823) enddo
3824) endif
3825) case(LIQUID_MOLE_FRACTION,LIQUID_MASS_FRACTION)
3826) do local_id=1,grid%nlmax
3827) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3828) grid%nL2G(local_id))%xmol(isubvar,option%liquid_phase)
3829) enddo
3830) if (ivar == LIQUID_MASS_FRACTION) then
3831) tempint = isubvar
3832) tempint2 = tempint+1
3833) if (tempint2 > 2) tempint2 = 1
3834) vec_ptr(:) = vec_ptr(:)*fmw_comp(tempint) / &
3835) (vec_ptr(:)*fmw_comp(tempint) + &
3836) (1.d0-vec_ptr(:))*fmw_comp(tempint2))
3837) endif
3838) case(LIQUID_MOBILITY)
3839) do local_id=1,grid%nlmax
3840) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3841) grid%nL2G(local_id))%mobility(option%liquid_phase)
3842) enddo
3843) case(GAS_SATURATION)
3844) do local_id=1,grid%nlmax
3845) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3846) grid%nL2G(local_id))%sat(option%gas_phase)
3847) enddo
3848) case(GAS_ENERGY)
3849) if (isubvar == ZERO_INTEGER) then
3850) do local_id=1,grid%nlmax
3851) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3852) grid%nL2G(local_id))%U(option%gas_phase)
3853) enddo
3854) else
3855) do local_id=1,grid%nlmax
3856) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3857) grid%nL2G(local_id))%U(option%gas_phase) * &
3858) patch%aux%General%auxvars(ZERO_INTEGER, &
3859) grid%nL2G(local_id))%den(option%gas_phase)
3860) enddo
3861) endif
3862) case(GAS_DENSITY)
3863) do local_id=1,grid%nlmax
3864) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3865) grid%nL2G(local_id))%den_kg(option%gas_phase)
3866) enddo
3867) case(GAS_DENSITY_MOL)
3868) do local_id=1,grid%nlmax
3869) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3870) grid%nL2G(local_id))%den(option%gas_phase)
3871) enddo
3872) case(GAS_MOLE_FRACTION,GAS_MASS_FRACTION)
3873) do local_id=1,grid%nlmax
3874) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3875) grid%nL2G(local_id))%xmol(isubvar,option%gas_phase)
3876) enddo
3877) if (ivar == GAS_MASS_FRACTION) then
3878) tempint = isubvar
3879) tempint2 = tempint+1
3880) if (tempint2 > 2) tempint2 = 1
3881) vec_ptr(:) = vec_ptr(:)*fmw_comp(tempint) / &
3882) (vec_ptr(:)*fmw_comp(tempint) + &
3883) (1.d0-vec_ptr(:))*fmw_comp(tempint2))
3884) endif
3885) case(GAS_MOBILITY)
3886) do local_id=1,grid%nlmax
3887) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3888) grid%nL2G(local_id))%mobility(option%gas_phase)
3889) enddo
3890) case(EFFECTIVE_POROSITY)
3891) do local_id=1,grid%nlmax
3892) vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
3893) grid%nL2G(local_id))%effective_porosity
3894) enddo
3895) end select
3896)
3897) else if (associated(patch%aux%TOil_ims)) then
3898)
3899) select case(ivar)
3900) case(TEMPERATURE)
3901) do local_id=1,grid%nlmax
3902) vec_ptr(local_id) = patch%aux%TOil_ims% &
3903) auxvars(ZERO_INTEGER,grid%nL2G(local_id))%temp
3904) enddo
3905) case(MAXIMUM_PRESSURE)
3906) do local_id=1,grid%nlmax
3907) ghosted_id = grid%nL2G(local_id)
3908) vec_ptr(local_id) = &
3909) maxval(patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
3910) pres(option%liquid_phase:option%oil_phase))
3911) enddo
3912) case(LIQUID_PRESSURE)
3913) do local_id=1,grid%nlmax
3914) ghosted_id = grid%nL2G(local_id)
3915) vec_ptr(local_id) = &
3916) patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
3917) pres(option%liquid_phase)
3918) enddo
3919) case(OIL_PRESSURE)
3920) do local_id=1,grid%nlmax
3921) ghosted_id = grid%nL2G(local_id)
3922) vec_ptr(local_id) = &
3923) patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
3924) pres(option%oil_phase)
3925) enddo
3926) case(CAPILLARY_PRESSURE)
3927) do local_id=1,grid%nlmax
3928) ghosted_id = grid%nL2G(local_id)
3929) vec_ptr(local_id) = &
3930) patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
3931) pres(option%capillary_pressure_id)
3932) enddo
3933) case(LIQUID_SATURATION)
3934) do local_id=1,grid%nlmax
3935) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3936) grid%nL2G(local_id))%sat(option%liquid_phase)
3937) enddo
3938) case(LIQUID_DENSITY)
3939) do local_id=1,grid%nlmax
3940) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3941) grid%nL2G(local_id))%den_kg(option%liquid_phase)
3942) enddo
3943) case(LIQUID_DENSITY_MOL)
3944) do local_id=1,grid%nlmax
3945) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3946) grid%nL2G(local_id))%den(option%liquid_phase)
3947) enddo
3948) case(LIQUID_ENERGY)
3949) if (isubvar == ZERO_INTEGER) then
3950) do local_id=1,grid%nlmax
3951) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3952) grid%nL2G(local_id))%U(option%liquid_phase)
3953) enddo
3954) else
3955) do local_id=1,grid%nlmax
3956) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3957) grid%nL2G(local_id))%U(option%liquid_phase) * &
3958) patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3959) grid%nL2G(local_id))%den(option%liquid_phase)
3960) enddo
3961) endif
3962) case(LIQUID_MOBILITY)
3963) do local_id=1,grid%nlmax
3964) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3965) grid%nL2G(local_id))%mobility(option%liquid_phase)
3966) enddo
3967) case(OIL_SATURATION)
3968) do local_id=1,grid%nlmax
3969) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3970) grid%nL2G(local_id))%sat(option%oil_phase)
3971) enddo
3972) case(OIL_ENERGY)
3973) if (isubvar == ZERO_INTEGER) then
3974) do local_id=1,grid%nlmax
3975) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3976) grid%nL2G(local_id))%U(option%oil_phase)
3977) enddo
3978) else
3979) do local_id=1,grid%nlmax
3980) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3981) grid%nL2G(local_id))%U(option%oil_phase) * &
3982) patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3983) grid%nL2G(local_id))%den(option%oil_phase)
3984) enddo
3985) endif
3986) case(OIL_DENSITY)
3987) do local_id=1,grid%nlmax
3988) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3989) grid%nL2G(local_id))%den_kg(option%oil_phase)
3990) enddo
3991) case(OIL_DENSITY_MOL)
3992) do local_id=1,grid%nlmax
3993) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3994) grid%nL2G(local_id))%den(option%oil_phase)
3995) enddo
3996) case(OIL_MOBILITY)
3997) do local_id=1,grid%nlmax
3998) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
3999) grid%nL2G(local_id))%mobility(option%oil_phase)
4000) enddo
4001) case(EFFECTIVE_POROSITY)
4002) do local_id=1,grid%nlmax
4003) vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
4004) grid%nL2G(local_id))%effective_porosity
4005) enddo
4006) end select
4007)
4008) endif
4009)
4010) case(PH,PE,EH,O2,PRIMARY_MOLALITY,PRIMARY_MOLARITY,SECONDARY_MOLALITY, &
4011) SECONDARY_MOLARITY,TOTAL_MOLALITY,TOTAL_MOLARITY, &
4012) MINERAL_RATE,MINERAL_VOLUME_FRACTION,MINERAL_SATURATION_INDEX, &
4013) SURFACE_CMPLX,SURFACE_CMPLX_FREE,SURFACE_SITE_DENSITY, &
4014) KIN_SURFACE_CMPLX,KIN_SURFACE_CMPLX_FREE, PRIMARY_ACTIVITY_COEF, &
4015) SECONDARY_ACTIVITY_COEF,PRIMARY_KD,TOTAL_SORBED,TOTAL_SORBED_MOBILE, &
4016) COLLOID_MOBILE,COLLOID_IMMOBILE,AGE,TOTAL_BULK,IMMOBILE_SPECIES)
4017)
4018) select case(ivar)
4019) case(PH)
4020) if (isubvar > 0) then
4021) do local_id=1,grid%nlmax
4022) ghosted_id = grid%nL2G(local_id)
4023) vec_ptr(local_id) = &
4024) -log10(patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)* &
4025) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
4026) enddo
4027) else
4028) do local_id=1,grid%nlmax
4029) ghosted_id = grid%nL2G(local_id)
4030) vec_ptr(local_id) = &
4031) -log10(patch%aux%RT%auxvars(ghosted_id)%sec_act_coef(-isubvar)* &
4032) patch%aux%RT%auxvars(ghosted_id)%sec_molal(-isubvar))
4033) enddo
4034) endif
4035) case(EH)
4036) do local_id=1,grid%nlmax
4037) ghosted_id = grid%nL2G(local_id)
4038) if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
4039) 0.d0) then
4040) !geh: all the below should be calculated somewhere else, not in
4041) ! patch.F90. most likely reactive_transport.F90
4042) ph0 = &
4043) -log10(patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)* &
4044) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
4045) ifo2 = reaction%species_idx%o2_gas_id
4046) ! compute gas partial pressure
4047) lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
4048) ! activity of water
4049) if (reaction%eqgash2oid(ifo2) > 0) then
4050) lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
4051) patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
4052) endif
4053) do jcomp = 1, reaction%eqgasspecid(0,ifo2)
4054) comp_id = reaction%eqgasspecid(jcomp,ifo2)
4055) lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
4056) log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
4057) patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
4058) enddo
4059) tk = patch%aux%Global%auxvars(ghosted_id)%temp + &
4060) 273.15d0
4061) ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
4062) eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
4063) pe0 = eh0/ehfac
4064) vec_ptr(local_id) = eh0
4065) else
4066) vec_ptr(local_id) = 0.d0
4067) endif
4068) enddo
4069) case(PE)
4070) do local_id=1,grid%nlmax
4071) ghosted_id = grid%nL2G(local_id)
4072) if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
4073) 0.d0) then
4074) !geh: all the below should be calculated somewhere else, not in
4075) ! patch.F90. most likely reactive_transport.F90
4076) ph0 = &
4077) -log10(patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)* &
4078) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
4079) ifo2 = reaction%species_idx%o2_gas_id
4080) ! compute gas partial pressure
4081) lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
4082) ! activity of water
4083) if (reaction%eqgash2oid(ifo2) > 0) then
4084) lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
4085) patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
4086) endif
4087) do jcomp = 1, reaction%eqgasspecid(0,ifo2)
4088) comp_id = reaction%eqgasspecid(jcomp,ifo2)
4089) lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
4090) log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
4091) patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
4092) enddo
4093) tk = patch%aux%Global%auxvars(ghosted_id)%temp + &
4094) 273.15d0
4095) ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
4096) eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
4097) pe0 = eh0/ehfac
4098) vec_ptr(local_id) = pe0
4099) else
4100) vec_ptr(local_id) = 0.d0
4101) endif
4102) enddo
4103)
4104) case(O2)
4105) do local_id=1,grid%nlmax
4106) ghosted_id = grid%nL2G(local_id)
4107) if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
4108) 0.d0) then
4109) !geh: all the below should be calculated somewhere else, not in
4110) ! patch.F90. most likely reactive_transport.F90
4111) ifo2 = reaction%species_idx%o2_gas_id
4112) ! compute gas partial pressure
4113) lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
4114) ! activity of water
4115) if (reaction%eqgash2oid(ifo2) > 0) then
4116) lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
4117) patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
4118) endif
4119) do jcomp = 1, reaction%eqgasspecid(0,ifo2)
4120) comp_id = reaction%eqgasspecid(jcomp,ifo2)
4121) lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
4122) log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
4123) patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
4124) enddo
4125) vec_ptr(local_id) = lnQKgas * LN_TO_LOG
4126) else
4127) vec_ptr(local_id) = 0.d0
4128) endif
4129) enddo
4130) case(PRIMARY_MOLALITY)
4131) do local_id=1,grid%nlmax
4132) vec_ptr(local_id) = &
4133) patch%aux%RT%auxvars(grid%nL2G(local_id))%pri_molal(isubvar)
4134) enddo
4135) case(PRIMARY_MOLARITY)
4136) do local_id=1,grid%nlmax
4137) ghosted_id = grid%nL2G(local_id)
4138) if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) then
4139) xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
4140) else
4141) xmass = 1.d0
4142) endif
4143) vec_ptr(local_id) = &
4144) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) * xmass * &
4145) (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
4146) enddo
4147) case(SECONDARY_MOLALITY)
4148) do local_id=1,grid%nlmax
4149) ghosted_id = grid%nL2G(local_id)
4150) vec_ptr(local_id) = &
4151) patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar)
4152) enddo
4153) case(SECONDARY_MOLARITY)
4154) do local_id=1,grid%nlmax
4155) ghosted_id = grid%nL2G(local_id)
4156) if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) then
4157) xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
4158) else
4159) xmass = 1.d0
4160) endif
4161) vec_ptr(local_id) = &
4162) patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar) * xmass * &
4163) (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
4164) enddo
4165) case(TOTAL_MOLALITY)
4166) do local_id=1,grid%nlmax
4167) ghosted_id =grid%nL2G(local_id)
4168) if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) then
4169) xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
4170) else
4171) xmass = 1.d0
4172) endif
4173) if (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) > 0.d0) then
4174) vec_ptr(local_id) = &
4175) patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) / &
4176) xmass / &
4177) (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
4178) else
4179) vec_ptr(local_id) = 0.d0
4180) endif
4181) enddo
4182) case(TOTAL_MOLARITY)
4183) do local_id=1,grid%nlmax
4184) vec_ptr(local_id) = &
4185) patch%aux%RT%auxvars(grid%nL2G(local_id))%total(isubvar,iphase)
4186) enddo
4187) case(TOTAL_BULK) ! mol/m^3 bulk
4188) ! add in total molarity and convert to mol/m^3 bulk
4189) do local_id=1,grid%nlmax
4190) ghosted_id = grid%nL2G(local_id)
4191) vec_ptr(local_id) = &
4192) patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) * &
4193) patch%aux%Material%auxvars(ghosted_id)%porosity * &
4194) ! mol/L -> mol/m^3
4195) patch%aux%Global%auxvars(ghosted_id)%sat(iphase) * 1.d-3
4196) enddo
4197) ! add in total sorbed. already in mol/m^3 bulk
4198) if (patch%reaction%nsorb > 0) then
4199) do local_id=1,grid%nlmax
4200) ghosted_id = grid%nL2G(local_id)
4201) if (patch%reaction%surface_complexation%neqsrfcplxrxn > 0) then
4202) vec_ptr(local_id) = vec_ptr(local_id) + &
4203) patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
4204) endif
4205) if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
4206) do irxn = 1, &
4207) patch%reaction%surface_complexation%nkinmrsrfcplxrxn
4208) do irate = 1, &
4209) patch%reaction%surface_complexation%kinmr_nrate(irxn)
4210) vec_ptr(local_id) = vec_ptr(local_id) + &
4211) patch%aux%RT%auxvars(ghosted_id)% &
4212) kinmr_total_sorb(isubvar,irate,irxn)
4213) enddo
4214) enddo
4215) endif
4216) enddo
4217) endif
4218) case(MINERAL_VOLUME_FRACTION)
4219) do local_id=1,grid%nlmax
4220) vec_ptr(local_id) = &
4221) patch%aux%RT%auxvars(grid%nL2G(local_id))%mnrl_volfrac(isubvar)
4222) enddo
4223) case(MINERAL_RATE)
4224) do local_id=1,grid%nlmax
4225) vec_ptr(local_id) = &
4226) patch%aux%RT%auxvars(grid%nL2G(local_id))%mnrl_rate(isubvar)
4227) enddo
4228) case(MINERAL_SATURATION_INDEX)
4229) do local_id = 1, grid%nlmax
4230) ghosted_id = grid%nL2G(local_id)
4231) vec_ptr(local_id) = &
4232) RMineralSaturationIndex(isubvar, &
4233) patch%aux%RT%auxvars(ghosted_id), &
4234) patch%aux%Global%auxvars(ghosted_id), &
4235) reaction,option)
4236) enddo
4237) case(IMMOBILE_SPECIES)
4238) do local_id=1,grid%nlmax
4239) vec_ptr(local_id) = &
4240) patch%aux%RT%auxvars(grid%nL2G(local_id))%immobile(isubvar)
4241) enddo
4242) case(SURFACE_CMPLX)
4243) if (associated(patch%aux%RT%auxvars(1)%eqsrfcplx_conc)) then
4244) do local_id=1,grid%nlmax
4245) vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
4246) eqsrfcplx_conc(isubvar)
4247) enddo
4248) else
4249) vec_ptr = UNINITIALIZED_DOUBLE
4250) endif
4251) case(SURFACE_SITE_DENSITY)
4252) tempreal = &
4253) reaction%surface_complexation%srfcplxrxn_site_density(isubvar)
4254) select case(reaction%surface_complexation% &
4255) srfcplxrxn_surf_type(isubvar))
4256) case(ROCK_SURFACE)
4257) do local_id=1,grid%nlmax
4258) ghosted_id = grid%nL2G(local_id)
4259) vec_ptr(local_id) = tempreal* &
4260) material_auxvars(ghosted_id)%soil_particle_density * &
4261) (1.d0-material_auxvars(ghosted_id)%porosity)
4262) enddo
4263) case(MINERAL_SURFACE)
4264) tempint = &
4265) reaction%surface_complexation%srfcplxrxn_to_surf(isubvar)
4266) do local_id=1,grid%nlmax
4267) vec_ptr(local_id) = tempreal* &
4268) patch%aux%RT%auxvars(grid%nL2G(local_id))% &
4269) mnrl_volfrac(tempint)
4270) enddo
4271) case(COLLOID_SURFACE)
4272) option%io_buffer = 'Printing of surface site density for ' // &
4273) 'colloidal surfaces not implemented.'
4274) call printErrMsg(option)
4275) case(NULL_SURFACE)
4276) do local_id=1,grid%nlmax
4277) vec_ptr(local_id) = tempreal
4278) enddo
4279) end select
4280) case(SURFACE_CMPLX_FREE)
4281) do local_id=1,grid%nlmax
4282) vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
4283) srfcplxrxn_free_site_conc(isubvar)
4284) enddo
4285) case(KIN_SURFACE_CMPLX)
4286) do local_id=1,grid%nlmax
4287) vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
4288) kinsrfcplx_conc(isubvar,1)
4289) enddo
4290) case(KIN_SURFACE_CMPLX_FREE)
4291) do local_id=1,grid%nlmax
4292) vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
4293) kinsrfcplx_free_site_conc(isubvar)
4294) enddo
4295) case(PRIMARY_ACTIVITY_COEF)
4296) do local_id=1,grid%nlmax
4297) ghosted_id = grid%nL2G(local_id)
4298) vec_ptr(local_id) = &
4299) patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)
4300) enddo
4301) case(SECONDARY_ACTIVITY_COEF)
4302) do local_id=1,grid%nlmax
4303) ghosted_id = grid%nL2G(local_id)
4304) vec_ptr(local_id) = &
4305) patch%aux%RT%auxvars(ghosted_id)%sec_act_coef(isubvar)
4306) enddo
4307) case(PRIMARY_KD)
4308) do local_id=1,grid%nlmax
4309) ghosted_id = grid%nL2G(local_id)
4310) call ReactionComputeKd(isubvar,vec_ptr(local_id), &
4311) patch%aux%RT%auxvars(ghosted_id), &
4312) patch%aux%Global%auxvars(ghosted_id), &
4313) patch%aux%Material%auxvars(ghosted_id), &
4314) patch%reaction,option)
4315) enddo
4316) case(TOTAL_SORBED)
4317) if (patch%reaction%nsorb > 0) then
4318) if (patch%reaction%neqsorb > 0) then
4319) do local_id=1,grid%nlmax
4320) ghosted_id = grid%nL2G(local_id)
4321) vec_ptr(local_id) = &
4322) patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
4323) enddo
4324) endif
4325) if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
4326) do local_id=1,grid%nlmax
4327) ghosted_id = grid%nL2G(local_id)
4328) vec_ptr(local_id) = 0.d0
4329) do irxn = 1, &
4330) patch%reaction%surface_complexation%nkinmrsrfcplxrxn
4331) do irate = 1, &
4332) patch%reaction%surface_complexation%kinmr_nrate(irxn)
4333) vec_ptr(local_id) = vec_ptr(local_id) + &
4334) patch%aux%RT%auxvars(ghosted_id)% &
4335) kinmr_total_sorb(isubvar,irate,irxn)
4336) enddo
4337) enddo
4338) enddo
4339) endif
4340) endif
4341) case(TOTAL_SORBED_MOBILE)
4342) if (patch%reaction%nsorb > 0 .and. patch%reaction%ncollcomp > 0) then
4343) do local_id=1,grid%nlmax
4344) ghosted_id = grid%nL2G(local_id)
4345) vec_ptr(local_id) = patch%aux%RT%auxvars(ghosted_id)%colloid% &
4346) total_eq_mob(isubvar)
4347) enddo
4348) endif
4349) case(COLLOID_MOBILE)
4350) if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
4351) do local_id=1,grid%nlmax
4352) ghosted_id =grid%nL2G(local_id)
4353) if (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) > &
4354) 0.d0) then
4355) vec_ptr(local_id) = &
4356) patch%aux%RT%auxvars(ghosted_id)% &
4357) colloid%conc_mob(isubvar) / &
4358) (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
4359) else
4360) vec_ptr(local_id) = 0.d0
4361) endif
4362) enddo
4363) else
4364) do local_id=1,grid%nlmax
4365) vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
4366) colloid%conc_mob(isubvar)
4367) enddo
4368) endif
4369) case(COLLOID_IMMOBILE)
4370) if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
4371) do local_id=1,grid%nlmax
4372) ghosted_id =grid%nL2G(local_id)
4373) if (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) > &
4374) 0.d0) then
4375) vec_ptr(local_id) = &
4376) patch%aux%RT%auxvars(ghosted_id)% &
4377) colloid%conc_imb(isubvar) / &
4378) (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
4379) else
4380) vec_ptr(local_id) = 0.d0
4381) endif
4382) enddo
4383) else
4384) do local_id=1,grid%nlmax
4385) vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
4386) colloid%conc_imb(isubvar)
4387) enddo
4388) endif
4389) case(AGE)
4390) do local_id=1,grid%nlmax
4391) ghosted_id = grid%nL2G(local_id)
4392) if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
4393) 0.d0) then
4394) vec_ptr(local_id) = &
4395) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) / &
4396) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar1) / &
4397) output_option%tconv
4398) endif
4399) enddo
4400) end select
4401) case(POROSITY,MINERAL_POROSITY,PERMEABILITY,PERMEABILITY_X, &
4402) PERMEABILITY_Y, PERMEABILITY_Z,PERMEABILITY_XY,PERMEABILITY_XZ, &
4403) PERMEABILITY_YZ,VOLUME,TORTUOSITY,SOIL_COMPRESSIBILITY, &
4404) SOIL_REFERENCE_PRESSURE)
4405) ivar_temp = ivar
4406) if (ivar_temp == PERMEABILITY) ivar_temp = PERMEABILITY_X
4407) do local_id=1,grid%nlmax
4408) vec_ptr(local_id) = &
4409) MaterialAuxVarGetValue(material_auxvars(grid%nL2G(local_id)), &
4410) ivar_temp)
4411) enddo
4412) case(PHASE)
4413) call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
4414) do local_id=1,grid%nlmax
4415) vec_ptr(local_id) = vec_ptr2(grid%nL2G(local_id))
4416) enddo
4417) call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
4418) case(MATERIAL_ID)
4419) do local_id=1,grid%nlmax
4420) vec_ptr(local_id) = &
4421) patch%imat_internal_to_external(iabs(patch%imat(grid%nL2G(local_id))))
4422) enddo
4423) case(PROCESS_ID)
4424) do local_id=1,grid%nlmax
4425) vec_ptr(local_id) = option%myrank
4426) enddo
4427) case(RESIDUAL)
4428) call VecRestoreArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
4429) call VecStrideGather(field%flow_r,isubvar-1,vec,INSERT_VALUES,ierr)
4430) call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
4431) case default
4432) write(option%io_buffer, &
4433) '(''IVAR ('',i3,'') not found in PatchGetVariable'')') ivar
4434) call printErrMsg(option)
4435) end select
4436)
4437) call VecRestoreArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
4438)
4439) end subroutine PatchGetVariable1
4440)
4441) ! ************************************************************************** !
4442)
4443) function PatchGetVariableValueAtCell(patch,field,reaction,option, &
4444) output_option, &
4445) ivar,isubvar,ghosted_id,isubvar1)
4446) !
4447) ! Returns variables indexed by ivar,
4448) ! isubvar, local id from Reactive Transport type
4449) !
4450) ! Author: Glenn Hammond
4451) ! Date: 02/11/08
4452) !
4453)
4454) use Grid_module
4455) use Option_module
4456) use Field_module
4457)
4458) use Mphase_Aux_module
4459) use TH_Aux_module
4460) use Richards_Aux_module
4461) use Miscible_Aux_module
4462) use Reactive_Transport_Aux_module
4463) use Reaction_Mineral_module
4464) use Reaction_module
4465) use Reaction_Mineral_Aux_module
4466) use Reaction_Surface_Complexation_Aux_module
4467) use Output_Aux_module
4468) use Variables_module
4469) use General_Aux_module
4470) use Material_Aux_class
4471)
4472) implicit none
4473)
4474) #include "petsc/finclude/petscvec.h"
4475) #include "petsc/finclude/petscvec.h90"
4476)
4477) PetscReal :: PatchGetVariableValueAtCell
4478) type(option_type), pointer :: option
4479) type(reaction_type), pointer :: reaction
4480) type(output_option_type), pointer :: output_option
4481) type(field_type), pointer :: field
4482) type(patch_type), pointer :: patch
4483) class(material_auxvar_type), pointer :: material_auxvars(:)
4484) PetscInt :: ivar
4485) PetscInt :: isubvar
4486) PetscInt :: tempint, tempint2
4487) PetscInt, optional :: isubvar1
4488) PetscInt :: iphase
4489) PetscInt :: ghosted_id, local_id
4490) PetscInt :: ivar_temp
4491)
4492) PetscReal :: value, xmass, lnQKgas, tk, ehfac, eh0, pe0, ph0
4493) PetscInt :: irate, istate, irxn, ifo2, jcomp, comp_id
4494) type(grid_type), pointer :: grid
4495) PetscReal, pointer :: vec_ptr2(:)
4496) PetscErrorCode :: ierr
4497)
4498) grid => patch%grid
4499) material_auxvars => patch%aux%Material%auxvars
4500)
4501) value = UNINITIALIZED_DOUBLE
4502)
4503) ! inactive grid cell
4504) if (patch%imat(ghosted_id) <= 0) then
4505) PatchGetVariableValueAtCell = 0.d0
4506) return
4507) endif
4508)
4509) iphase = 1
4510) xmass = 1.d0
4511) if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) &
4512) xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
4513)
4514) select case(ivar)
4515) case(TEMPERATURE,LIQUID_PRESSURE,GAS_PRESSURE, &
4516) LIQUID_SATURATION,GAS_SATURATION,ICE_SATURATION, &
4517) LIQUID_MOLE_FRACTION,GAS_MOLE_FRACTION,LIQUID_ENERGY,GAS_ENERGY, &
4518) LIQUID_DENSITY,GAS_DENSITY,GAS_DENSITY_MOL,LIQUID_VISCOSITY, &
4519) GAS_VISCOSITY,AIR_PRESSURE,CAPILLARY_PRESSURE, &
4520) LIQUID_MOBILITY,GAS_MOBILITY,SC_FUGA_COEFF,STATE,ICE_DENSITY, &
4521) SECONDARY_TEMPERATURE,LIQUID_DENSITY_MOL,EFFECTIVE_POROSITY, &
4522) LIQUID_HEAD,VAPOR_PRESSURE,SATURATION_PRESSURE,MAXIMUM_PRESSURE, &
4523) LIQUID_MASS_FRACTION,GAS_MASS_FRACTION, &
4524) OIL_PRESSURE,OIL_SATURATION,OIL_DENSITY,OIL_DENSITY_MOL,OIL_ENERGY, &
4525) OIL_MOBILITY)
4526)
4527) if (associated(patch%aux%TH)) then
4528) select case(ivar)
4529) case(TEMPERATURE)
4530) value = patch%aux%Global%auxvars(ghosted_id)%temp
4531) case(LIQUID_PRESSURE)
4532) value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
4533) case(LIQUID_SATURATION)
4534) value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
4535) case(LIQUID_DENSITY)
4536) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
4537) case(LIQUID_VISCOSITY)
4538) value = patch%aux%TH%auxvars(ghosted_id)%vis
4539) case(LIQUID_MOBILITY)
4540) value = patch%aux%TH%auxvars(ghosted_id)%kvr
4541) case(GAS_MOLE_FRACTION,GAS_ENERGY,GAS_DENSITY) ! still need implementation
4542) call printErrMsg(option,'GAS_MOLE_FRACTION not supported by TH')
4543) case(GAS_SATURATION)
4544) if (option%use_th_freezing) then
4545) value = patch%aux%TH%auxvars(ghosted_id)%ice%sat_gas
4546) else
4547) value = 0.d0
4548) endif
4549) case(ICE_SATURATION)
4550) if (option%use_th_freezing) then
4551) value = patch%aux%TH%auxvars(ghosted_id)%ice%sat_ice
4552) endif
4553) case(ICE_DENSITY)
4554) if (option%use_th_freezing) then
4555) value = patch%aux%TH%auxvars(ghosted_id)%ice%den_ice*FMWH2O
4556) endif
4557) case(LIQUID_MOLE_FRACTION)
4558) call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by TH')
4559) case(LIQUID_ENERGY)
4560) value = patch%aux%TH%auxvars(ghosted_id)%u
4561) case(SECONDARY_TEMPERATURE)
4562) local_id = grid%nG2L(ghosted_id)
4563) value = patch%aux%SC_heat%sec_heat_vars(local_id)%sec_temp(isubvar)
4564) case(EFFECTIVE_POROSITY)
4565) value = patch%aux%TH%auxvars(ghosted_id)%transient_por
4566) end select
4567) else if (associated(patch%aux%Richards)) then
4568) select case(ivar)
4569) case(TEMPERATURE)
4570) call printErrMsg(option,'TEMPERATURE not supported by Richards')
4571) case(GAS_SATURATION)
4572) call printErrMsg(option,'GAS_SATURATION not supported by Richards')
4573) case(GAS_DENSITY)
4574) call printErrMsg(option,'GAS_DENSITY not supported by Richards')
4575) case(LIQUID_MOLE_FRACTION)
4576) call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by Richards')
4577) case(GAS_MOLE_FRACTION)
4578) call printErrMsg(option,'GAS_MOLE_FRACTION not supported by Richards')
4579) case(LIQUID_ENERGY)
4580) call printErrMsg(option,'LIQUID_ENERGY not supported by Richards')
4581) case(GAS_ENERGY)
4582) call printErrMsg(option,'GAS_ENERGY not supported by Richards')
4583) case(EFFECTIVE_POROSITY)
4584) call printErrMsg(option,'EFFECTIVE_POROSITY not supported by Richards')
4585) case(LIQUID_PRESSURE)
4586) value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
4587) case(LIQUID_HEAD)
4588) value = patch%aux%Global%auxvars(ghosted_id)%pres(1)/9.81/ &
4589) patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
4590) case(LIQUID_SATURATION)
4591) value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
4592) case(LIQUID_DENSITY)
4593) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
4594) case(LIQUID_MOBILITY)
4595) value = patch%aux%Richards%auxvars(ghosted_id)%kvr
4596) end select
4597) else if (associated(patch%aux%Flash2)) then
4598) select case(ivar)
4599) case(TEMPERATURE)
4600) value = patch%aux%Global%auxvars(ghosted_id)%temp
4601) case(LIQUID_PRESSURE)
4602) value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
4603) case(LIQUID_SATURATION)
4604) value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
4605) case(LIQUID_DENSITY)
4606) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
4607) case(LIQUID_VISCOSITY)
4608) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
4609) case(LIQUID_MOBILITY)
4610) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
4611) case(GAS_PRESSURE)
4612) value = patch%aux%Global%auxvars(ghosted_id)%pres(2)
4613) case(GAS_SATURATION)
4614) value = patch%aux%Global%auxvars(ghosted_id)%sat(2)
4615) case(GAS_MOLE_FRACTION)
4616) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%xmol(2+isubvar)
4617) case(GAS_ENERGY)
4618) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%u(2)
4619) case(GAS_DENSITY)
4620) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(2)
4621) case(GAS_DENSITY_MOL)
4622) value = patch%aux%Global%auxvars(ghosted_id)%den(2)
4623) case(GAS_VISCOSITY)
4624) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%vis(2)
4625) case(GAS_MOBILITY)
4626) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%kvr(2)
4627) case(SC_FUGA_COEFF)
4628) value = patch%aux%Global%auxvars(ghosted_id)%fugacoeff(1)
4629) case(LIQUID_MOLE_FRACTION)
4630) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%xmol(isubvar)
4631) case(LIQUID_ENERGY)
4632) value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
4633) end select
4634) else if (associated(patch%aux%Mphase)) then
4635) select case(ivar)
4636) case(TEMPERATURE)
4637) value = patch%aux%Global%auxvars(ghosted_id)%temp
4638) case(LIQUID_PRESSURE)
4639) value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
4640) case(GAS_PRESSURE)
4641) value = patch%aux%Global%auxvars(ghosted_id)%pres(2)
4642) case(LIQUID_SATURATION)
4643) value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
4644) case(LIQUID_MOLE_FRACTION)
4645) if (patch%aux%Global%auxvars(ghosted_id)%sat(1) > 0.d0) then
4646) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%xmol(isubvar)
4647) else
4648) value = 0.d0
4649) endif
4650) case(LIQUID_ENERGY)
4651) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
4652) case(LIQUID_DENSITY)
4653) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
4654) case(LIQUID_VISCOSITY)
4655) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
4656) case(LIQUID_MOBILITY)
4657) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
4658) case(GAS_SATURATION)
4659) value = patch%aux%Global%auxvars(ghosted_id)%sat(2)
4660) case(GAS_MOLE_FRACTION)
4661) if (patch%aux%Global%auxvars(ghosted_id)%sat(2) > 0.d0) then
4662) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%xmol(2+isubvar)
4663) else
4664) value = 0.d0
4665) endif
4666) case(GAS_ENERGY)
4667) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%u(2)
4668) case(GAS_DENSITY)
4669) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(2)
4670) case(GAS_VISCOSITY)
4671) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%vis(2)
4672) case(GAS_MOBILITY)
4673) value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%kvr(2)
4674) case(GAS_DENSITY_MOL)
4675) value = patch%aux%Global%auxvars(ghosted_id)%den(2)
4676) case(SC_FUGA_COEFF)
4677) value = patch%aux%Global%auxvars(ghosted_id)%fugacoeff(1)
4678) case(SECONDARY_TEMPERATURE)
4679) local_id = grid%nG2L(ghosted_id)
4680) value = patch%aux%SC_heat%sec_heat_vars(local_id)%sec_temp(isubvar)
4681) end select
4682) else if (associated(patch%aux%Immis)) then
4683) select case(ivar)
4684) case(TEMPERATURE)
4685) value = patch%aux%Global%auxvars(ghosted_id)%temp
4686) case(LIQUID_PRESSURE)
4687) value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
4688) case(GAS_PRESSURE)
4689) value = patch%aux%Global%auxvars(ghosted_id)%pres(2)
4690) case(LIQUID_SATURATION)
4691) value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
4692) case(LIQUID_DENSITY)
4693) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
4694) case(LIQUID_ENERGY)
4695) value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
4696) case(LIQUID_VISCOSITY)
4697) value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
4698) case(LIQUID_MOBILITY)
4699) value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
4700) case(GAS_SATURATION)
4701) value = patch%aux%Global%auxvars(ghosted_id)%sat(2)
4702) case(GAS_ENERGY)
4703) value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%u(2)
4704) case(GAS_DENSITY)
4705) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(2)
4706) case(GAS_DENSITY_MOL)
4707) value = patch%aux%Global%auxvars(ghosted_id)%den(2)
4708) case(GAS_VISCOSITY)
4709) value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%vis(2)
4710) case(GAS_MOBILITY)
4711) value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%kvr(2)
4712) end select
4713) else if (associated(patch%aux%Miscible)) then
4714) select case(ivar)
4715) ! case(TEMPERATURE)
4716) ! value = patch%aux%Global%auxvars(ghosted_id)%temp
4717) case(LIQUID_PRESSURE)
4718) value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
4719) ! case(LIQUID_SATURATION)
4720) ! value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
4721) case(LIQUID_DENSITY)
4722) value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
4723) ! case(LIQUID_ENERGY)
4724) ! value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
4725) case(LIQUID_VISCOSITY)
4726) value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
4727) ! case(LIQUID_MOBILITY)
4728) ! value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
4729) case(LIQUID_MOLE_FRACTION)
4730) value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%xmol(isubvar)
4731) end select
4732) else if (associated(patch%aux%General)) then
4733) select case(ivar)
4734) case(TEMPERATURE)
4735) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)%temp
4736) case(MAXIMUM_PRESSURE)
4737) value = maxval(patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4738) pres(option%liquid_phase:option%gas_phase))
4739) case(LIQUID_PRESSURE)
4740) if (output_option%filter_non_state_variables) then
4741) if (patch%aux%Global%auxvars(ghosted_id)%istate /= GAS_STATE) then
4742) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4743) pres(option%liquid_phase)
4744) else
4745) value = 0.d0
4746) endif
4747) else
4748) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4749) pres(option%liquid_phase)
4750) endif
4751) case(GAS_PRESSURE)
4752) if (output_option%filter_non_state_variables) then
4753) if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
4754) LIQUID_STATE) then
4755) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4756) pres(option%gas_phase)
4757) else
4758) value = 0.d0
4759) endif
4760) else
4761) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4762) pres(option%gas_phase)
4763) endif
4764) case(AIR_PRESSURE)
4765) if (output_option%filter_non_state_variables) then
4766) if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
4767) LIQUID_STATE) then
4768) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4769) pres(option%air_pressure_id)
4770) else
4771) value = 0.d0
4772) endif
4773) else
4774) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4775) pres(option%air_pressure_id)
4776) endif
4777) case(CAPILLARY_PRESSURE)
4778) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4779) pres(option%capillary_pressure_id)
4780) case(VAPOR_PRESSURE)
4781) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4782) pres(option%vapor_pressure_id)
4783) case(SATURATION_PRESSURE)
4784) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4785) pres(option%saturation_pressure_id)
4786) case(STATE)
4787) value = patch%aux%Global%auxvars(ghosted_id)%istate
4788) case(LIQUID_SATURATION)
4789) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4790) sat(option%liquid_phase)
4791) case(LIQUID_DENSITY)
4792) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4793) den_kg(option%liquid_phase)
4794) case(LIQUID_DENSITY_MOL)
4795) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4796) den(option%liquid_phase)
4797) case(LIQUID_ENERGY)
4798) if (isubvar == ZERO_INTEGER) then
4799) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4800) U(option%liquid_phase)
4801) else
4802) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4803) U(option%liquid_phase) * &
4804) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4805) den(option%liquid_phase)
4806) endif
4807) case(LIQUID_MOLE_FRACTION,LIQUID_MASS_FRACTION)
4808) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4809) xmol(isubvar,option%liquid_phase)
4810) if (ivar == LIQUID_MASS_FRACTION) then
4811) tempint = isubvar
4812) tempint2 = tempint+1
4813) if (tempint2 > 2) tempint2 = 1
4814) value = value*fmw_comp(tempint) / &
4815) (value*fmw_comp(tempint) + &
4816) (1.d0-value)*fmw_comp(tempint2))
4817) endif
4818) case(LIQUID_MOBILITY)
4819) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4820) mobility(option%liquid_phase)
4821) case(GAS_SATURATION)
4822) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4823) sat(option%gas_phase)
4824) case(GAS_DENSITY)
4825) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4826) den_kg(option%gas_phase)
4827) case(GAS_DENSITY_MOL)
4828) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4829) den(option%gas_phase)
4830) case(GAS_ENERGY)
4831) if (isubvar == ZERO_INTEGER) then
4832) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4833) U(option%gas_phase)
4834) else
4835) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4836) U(option%gas_phase) * &
4837) patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4838) den(option%gas_phase)
4839) endif
4840) case(GAS_MOLE_FRACTION,GAS_MASS_FRACTION)
4841) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4842) xmol(isubvar,option%gas_phase)
4843) if (ivar == GAS_MASS_FRACTION) then
4844) tempint = isubvar
4845) tempint2 = tempint+1
4846) if (tempint2 > 2) tempint2 = 1
4847) value = value*fmw_comp(tempint) / &
4848) (value*fmw_comp(tempint) + &
4849) (1.d0-value)*fmw_comp(tempint2))
4850) endif
4851) case(GAS_MOBILITY)
4852) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4853) mobility(option%gas_phase)
4854) case(EFFECTIVE_POROSITY)
4855) value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
4856) effective_porosity
4857) end select
4858)
4859) else if (associated(patch%aux%TOil_ims)) then
4860)
4861) select case(ivar)
4862) case(TEMPERATURE)
4863) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)%temp
4864) case(MAXIMUM_PRESSURE)
4865) value = maxval(patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
4866) ghosted_id)%pres(option%liquid_phase:option%oil_phase))
4867) case(LIQUID_PRESSURE)
4868) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4869) pres(option%liquid_phase)
4870) case(OIL_PRESSURE)
4871) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4872) pres(option%oil_phase)
4873) case(CAPILLARY_PRESSURE)
4874) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4875) pres(option%capillary_pressure_id)
4876) case(LIQUID_SATURATION)
4877) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4878) sat(option%liquid_phase)
4879) case(LIQUID_DENSITY)
4880) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4881) den_kg(option%liquid_phase)
4882) case(LIQUID_DENSITY_MOL)
4883) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4884) den(option%liquid_phase)
4885) case(LIQUID_ENERGY)
4886) if (isubvar == ZERO_INTEGER) then
4887) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4888) U(option%liquid_phase)
4889) else
4890) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4891) U(option%liquid_phase) * &
4892) patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4893) den(option%liquid_phase)
4894) end if
4895) case(LIQUID_MOBILITY)
4896) value = &
4897) patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4898) mobility(option%liquid_phase)
4899) case(OIL_SATURATION)
4900) value = &
4901) patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4902) sat(option%oil_phase)
4903) case(OIL_ENERGY)
4904) if (isubvar == ZERO_INTEGER) then
4905) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4906) U(option%oil_phase)
4907) else
4908) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4909) U(option%oil_phase) * &
4910) patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4911) den(option%oil_phase)
4912) endif
4913) case(OIL_DENSITY)
4914) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4915) den_kg(option%oil_phase)
4916) case(OIL_DENSITY_MOL)
4917) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4918) den(option%oil_phase)
4919) case(OIL_MOBILITY)
4920) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4921) mobility(option%gas_phase)
4922) case(EFFECTIVE_POROSITY)
4923) value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
4924) effective_porosity
4925) end select
4926)
4927) endif
4928)
4929) case(PH,PE,EH,O2,PRIMARY_MOLALITY,PRIMARY_MOLARITY,SECONDARY_MOLALITY, &
4930) SECONDARY_MOLARITY, TOTAL_MOLALITY,TOTAL_MOLARITY, &
4931) MINERAL_VOLUME_FRACTION,MINERAL_RATE,MINERAL_SATURATION_INDEX, &
4932) SURFACE_CMPLX,SURFACE_CMPLX_FREE,SURFACE_SITE_DENSITY, &
4933) KIN_SURFACE_CMPLX,KIN_SURFACE_CMPLX_FREE, PRIMARY_ACTIVITY_COEF, &
4934) SECONDARY_ACTIVITY_COEF,PRIMARY_KD, TOTAL_SORBED, &
4935) TOTAL_SORBED_MOBILE,COLLOID_MOBILE,COLLOID_IMMOBILE,AGE,TOTAL_BULK, &
4936) IMMOBILE_SPECIES)
4937)
4938) select case(ivar)
4939) case(PH)
4940) if (isubvar > 0) then
4941) value = -log10(patch%aux%RT%auxvars(ghosted_id)% &
4942) pri_act_coef(isubvar)* &
4943) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
4944) else
4945) value = -log10(patch%aux%RT%auxvars(ghosted_id)% &
4946) sec_act_coef(-isubvar)* &
4947) patch%aux%RT%auxvars(ghosted_id)%sec_molal(-isubvar))
4948) endif
4949) case(EH)
4950) ph0 = -log10(patch%aux%RT%auxvars(ghosted_id)% &
4951) pri_act_coef(isubvar)* &
4952) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
4953)
4954) ifo2 = reaction%species_idx%o2_gas_id
4955)
4956) ! compute gas partial pressure
4957) lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
4958)
4959) ! activity of water
4960) if (reaction%eqgash2oid(ifo2) > 0) then
4961) lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
4962) patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
4963) endif
4964) do jcomp = 1, reaction%eqgasspecid(0,ifo2)
4965) comp_id = reaction%eqgasspecid(jcomp,ifo2)
4966) lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
4967) log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
4968) patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
4969) enddo
4970)
4971) tk = patch%aux%Global%auxvars(ghosted_id)%temp+273.15d0
4972) ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
4973) eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
4974)
4975) value = eh0
4976)
4977) case(PE)
4978) ph0 = -log10(patch%aux%RT%auxvars(ghosted_id)% &
4979) pri_act_coef(isubvar)* &
4980) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
4981)
4982) ifo2 = reaction%species_idx%o2_gas_id
4983)
4984) ! compute gas partial pressure
4985) lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
4986)
4987) ! activity of water
4988) if (reaction%eqgash2oid(ifo2) > 0) then
4989) lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
4990) patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
4991) endif
4992) do jcomp = 1, reaction%eqgasspecid(0,ifo2)
4993) comp_id = reaction%eqgasspecid(jcomp,ifo2)
4994) lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
4995) log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
4996) patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
4997) enddo
4998)
4999) tk = patch%aux%Global%auxvars(ghosted_id)%temp+273.15d0
5000) ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
5001) eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
5002) pe0 = eh0/ehfac
5003) value = pe0
5004)
5005) case(O2)
5006)
5007) ! compute gas partial pressure
5008) ifo2 = reaction%species_idx%o2_gas_id
5009) lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
5010)
5011) ! activity of water
5012) if (reaction%eqgash2oid(ifo2) > 0) then
5013) lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
5014) patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
5015) endif
5016) do jcomp = 1, reaction%eqgasspecid(0,ifo2)
5017) comp_id = reaction%eqgasspecid(jcomp,ifo2)
5018) lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
5019) log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
5020) patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
5021) enddo
5022) value = lnQKgas * LN_TO_LOG
5023) case(PRIMARY_MOLALITY)
5024) value = patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar)
5025) case(PRIMARY_MOLARITY)
5026) value = patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar)*xmass * &
5027) patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) / 1000.d0
5028) case(SECONDARY_MOLALITY)
5029) value = patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar)
5030) case(SECONDARY_MOLARITY)
5031) value = patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar)*xmass * &
5032) patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) / 1000.d0
5033) case(TOTAL_MOLALITY)
5034) value = patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) / &
5035) xmass / &
5036) patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)*1000.d0
5037) case(TOTAL_MOLARITY)
5038) value = patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase)
5039) case(TOTAL_BULK) ! mol/m^3 bulk
5040) ! add in total molarity and convert to mol/m^3 bulk
5041) value = &
5042) patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) * &
5043) patch%aux%Material%auxvars(ghosted_id)%porosity * &
5044) ! mol/L -> mol/m^3
5045) patch%aux%Global%auxvars(ghosted_id)%sat(iphase) * 1.d-3
5046) ! add in total sorbed. already in mol/m^3 bulk
5047) if (patch%reaction%nsorb > 0) then
5048) if (patch%reaction%surface_complexation%neqsrfcplxrxn > 0) then
5049) value = value + &
5050) patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
5051) endif
5052) if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
5053) do irxn = 1, patch%reaction%surface_complexation%nkinmrsrfcplxrxn
5054) do irate = 1, &
5055) patch%reaction%surface_complexation%kinmr_nrate(irxn)
5056) value = value + &
5057) patch%aux%RT%auxvars(ghosted_id)% &
5058) kinmr_total_sorb(isubvar,irate,irxn)
5059) enddo
5060) enddo
5061) endif
5062) endif
5063) case(MINERAL_VOLUME_FRACTION)
5064) value = patch%aux%RT%auxvars(ghosted_id)%mnrl_volfrac(isubvar)
5065) case(MINERAL_RATE)
5066) value = patch%aux%RT%auxvars(ghosted_id)%mnrl_rate(isubvar)
5067) case(MINERAL_SATURATION_INDEX)
5068) value = RMineralSaturationIndex(isubvar, &
5069) patch%aux%RT%auxvars(ghosted_id), &
5070) patch%aux%Global%auxvars(ghosted_id), &
5071) reaction,option)
5072) case(IMMOBILE_SPECIES)
5073) value = patch%aux%RT%auxvars(ghosted_id)%immobile(isubvar)
5074) case(SURFACE_CMPLX)
5075) if (associated(patch%aux%RT%auxvars(ghosted_id)%eqsrfcplx_conc)) then
5076) value = patch%aux%RT%auxvars(ghosted_id)%eqsrfcplx_conc(isubvar)
5077) else
5078) value = UNINITIALIZED_DOUBLE
5079) endif
5080) case(SURFACE_CMPLX_FREE)
5081) value = &
5082) patch%aux%RT%auxvars(ghosted_id)%srfcplxrxn_free_site_conc(isubvar)
5083) case(SURFACE_SITE_DENSITY)
5084) select case(reaction%surface_complexation% &
5085) srfcplxrxn_surf_type(isubvar))
5086) case(ROCK_SURFACE)
5087) value = reaction%surface_complexation% &
5088) srfcplxrxn_site_density(isubvar)* &
5089) material_auxvars(ghosted_id)%soil_particle_density * &
5090) (1.d0-material_auxvars(ghosted_id)%porosity)
5091) case(MINERAL_SURFACE)
5092) value = reaction%surface_complexation% &
5093) srfcplxrxn_site_density(isubvar)* &
5094) patch%aux%RT%auxvars(ghosted_id)% &
5095) mnrl_volfrac(reaction%surface_complexation% &
5096) srfcplxrxn_to_surf(isubvar))
5097) case(COLLOID_SURFACE)
5098) option%io_buffer = 'Printing of surface site density for ' // &
5099) 'colloidal surfaces not implemented.'
5100) call printErrMsg(option)
5101) case(NULL_SURFACE)
5102) value = reaction%surface_complexation% &
5103) srfcplxrxn_site_density(isubvar)
5104) end select
5105) case(KIN_SURFACE_CMPLX)
5106) value = patch%aux%RT%auxvars(ghosted_id)%kinsrfcplx_conc(isubvar,1)
5107) case(KIN_SURFACE_CMPLX_FREE)
5108) value = &
5109) patch%aux%RT%auxvars(ghosted_id)%kinsrfcplx_free_site_conc(isubvar)
5110) case(PRIMARY_ACTIVITY_COEF)
5111) value = patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)
5112) case(SECONDARY_ACTIVITY_COEF)
5113) value = patch%aux%RT%auxvars(ghosted_id)%sec_act_coef(isubvar)
5114) case(PRIMARY_KD)
5115) call ReactionComputeKd(isubvar,value, &
5116) patch%aux%RT%auxvars(ghosted_id), &
5117) patch%aux%Global%auxvars(ghosted_id), &
5118) material_auxvars(ghosted_id), &
5119) patch%reaction,option)
5120) case(TOTAL_SORBED)
5121) if (patch%reaction%nsorb > 0) then
5122) if (patch%reaction%neqsorb > 0) then
5123) value = patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
5124) endif
5125) if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
5126) value = 0.d0
5127) do irxn = 1, patch%reaction%surface_complexation%nkinmrsrfcplxrxn
5128) do irate = 1, &
5129) patch%reaction%surface_complexation%kinmr_nrate(irxn)
5130) value = value + &
5131) patch%aux%RT%auxvars(ghosted_id)% &
5132) kinmr_total_sorb(isubvar,irate,irxn)
5133) enddo
5134) enddo
5135) endif
5136) endif
5137) case(TOTAL_SORBED_MOBILE)
5138) if (patch%reaction%nsorb > 0 .and. patch%reaction%ncollcomp > 0) then
5139) value = &
5140) patch%aux%RT%auxvars(ghosted_id)%colloid%total_eq_mob(isubvar)
5141) endif
5142) case(COLLOID_MOBILE)
5143) if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
5144) value = patch%aux%RT%auxvars(ghosted_id)% &
5145) colloid%conc_mob(isubvar) / &
5146) patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)*1000.d0
5147) else
5148) value = patch%aux%RT%auxvars(ghosted_id)%colloid%conc_mob(isubvar)
5149) endif
5150) case(COLLOID_IMMOBILE)
5151) if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
5152) value = patch%aux%RT%auxvars(ghosted_id)% &
5153) colloid%conc_imb(isubvar) / &
5154) patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)*1000.d0
5155) else
5156) value = patch%aux%RT%auxvars(ghosted_id)%colloid%conc_imb(isubvar)
5157) endif
5158) case(AGE)
5159) if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
5160) 0.d0) then
5161) value = patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) / &
5162) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar1) / &
5163) output_option%tconv
5164) endif
5165) end select
5166) case(POROSITY,MINERAL_POROSITY,PERMEABILITY,PERMEABILITY_X, &
5167) PERMEABILITY_Y, PERMEABILITY_Z,PERMEABILITY_XY,PERMEABILITY_XZ, &
5168) PERMEABILITY_YZ,VOLUME,TORTUOSITY,SOIL_COMPRESSIBILITY, &
5169) SOIL_REFERENCE_PRESSURE)
5170) ivar_temp = ivar
5171) if (ivar_temp == PERMEABILITY) ivar_temp = PERMEABILITY_X
5172) value = MaterialAuxVarGetValue(material_auxvars(ghosted_id),ivar_temp)
5173) case(PHASE)
5174) call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
5175) value = vec_ptr2(ghosted_id)
5176) call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
5177) case(MATERIAL_ID)
5178) value = patch%imat_internal_to_external(iabs(patch%imat(ghosted_id)))
5179) case(PROCESS_ID)
5180) value = option%myrank
5181) ! Need to fix the below two cases (they assume only one component) -- SK 02/06/13
5182) case(SECONDARY_CONCENTRATION)
5183) ! Note that the units are in mol/kg
5184) local_id = grid%nG2L(ghosted_id)
5185) value = patch%aux%SC_RT%sec_transport_vars(local_id)% &
5186) sec_rt_auxvar(isubvar)%pri_molal(isubvar1)
5187) case(SEC_MIN_VOLFRAC)
5188) local_id = grid%nG2L(ghosted_id)
5189) value = patch%aux%SC_RT%sec_transport_vars(local_id)% &
5190) sec_rt_auxvar(isubvar)%mnrl_volfrac(isubvar1)
5191) case(SEC_MIN_RATE)
5192) local_id = grid%nG2L(ghosted_id)
5193) value = patch%aux%SC_RT%sec_transport_vars(local_id)% &
5194) sec_rt_auxvar(isubvar)%mnrl_rate(isubvar1)
5195) case(SEC_MIN_SI)
5196) local_id = grid%nG2L(ghosted_id)
5197) value = RMineralSaturationIndex(isubvar1,&
5198) patch%aux%SC_RT% &
5199) sec_transport_vars(local_id)% &
5200) sec_rt_auxvar(isubvar), &
5201) patch%aux%Global%auxvars(ghosted_id),&
5202) reaction,option)
5203) case(RESIDUAL)
5204) local_id = grid%nG2L(ghosted_id)
5205) call VecGetArrayF90(field%flow_r,vec_ptr2,ierr);CHKERRQ(ierr)
5206) value = vec_ptr2((local_id-1)*option%nflowdof+isubvar)
5207) call VecRestoreArrayF90(field%flow_r,vec_ptr2,ierr);CHKERRQ(ierr)
5208) case default
5209) write(option%io_buffer, &
5210) '(''IVAR ('',i3,'') not found in PatchGetVariableValueAtCell'')') &
5211) ivar
5212) call printErrMsg(option)
5213) end select
5214)
5215) PatchGetVariableValueAtCell = value
5216)
5217) end function PatchGetVariableValueAtCell
5218)
5219) ! ************************************************************************** !
5220)
5221) subroutine PatchSetVariable(patch,field,option,vec,vec_format,ivar,isubvar)
5222) !
5223) ! Sets variables indexed by ivar and isubvar within a patch
5224) !
5225) ! Author: Glenn Hammond
5226) ! Date: 09/12/08
5227) !
5228)
5229) use Grid_module
5230) use Option_module
5231) use Field_module
5232) use Variables_module
5233) use General_Aux_module
5234) use Material_Aux_class
5235)
5236) implicit none
5237)
5238) #include "petsc/finclude/petscvec.h"
5239) #include "petsc/finclude/petscvec.h90"
5240)
5241) type(option_type), pointer :: option
5242) type(field_type), pointer :: field
5243) type(patch_type), pointer :: patch
5244) Vec :: vec
5245) PetscInt :: vec_format
5246) PetscInt :: ivar
5247) PetscInt :: isubvar
5248) PetscInt :: iphase, istate
5249)
5250) PetscInt :: local_id, ghosted_id
5251) type(grid_type), pointer :: grid
5252) class(material_auxvar_type), pointer :: material_auxvars(:)
5253) PetscReal, pointer :: vec_ptr(:), vec_ptr2(:)
5254) PetscErrorCode :: ierr
5255)
5256) grid => patch%grid
5257) material_auxvars => patch%aux%Material%auxvars
5258)
5259) call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
5260)
5261) if (vec_format == NATURAL) then
5262) call printErrMsg(option,&
5263) 'NATURAL vector format not supported by PatchSetVariable')
5264) endif
5265)
5266) iphase = 1
5267) select case(ivar)
5268) case(TEMPERATURE,LIQUID_PRESSURE,GAS_PRESSURE,LIQUID_SATURATION, &
5269) GAS_SATURATION,AIR_PRESSURE,CAPILLARY_PRESSURE, &
5270) LIQUID_MOLE_FRACTION,GAS_MOLE_FRACTION,LIQUID_ENERGY,GAS_ENERGY, &
5271) LIQUID_DENSITY,GAS_DENSITY,GAS_DENSITY_MOL,LIQUID_VISCOSITY, &
5272) GAS_VISCOSITY, &
5273) LIQUID_MOBILITY,GAS_MOBILITY,STATE)
5274)
5275) if (associated(patch%aux%TH)) then
5276) select case(ivar)
5277) case(TEMPERATURE)
5278) if (vec_format == GLOBAL) then
5279) do local_id=1,grid%nlmax
5280) patch%aux%Global%auxvars(grid%nL2G(local_id))%temp = &
5281) vec_ptr(local_id)
5282) enddo
5283) else if (vec_format == LOCAL) then
5284) do ghosted_id=1,grid%ngmax
5285) patch%aux%Global%auxvars(ghosted_id)%temp = vec_ptr(ghosted_id)
5286) enddo
5287) endif
5288) case(LIQUID_PRESSURE)
5289) if (vec_format == GLOBAL) then
5290) do local_id=1,grid%nlmax
5291) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres = &
5292) vec_ptr(local_id)
5293) enddo
5294) else if (vec_format == LOCAL) then
5295) do ghosted_id=1,grid%ngmax
5296) patch%aux%Global%auxvars(ghosted_id)%pres = vec_ptr(ghosted_id)
5297) enddo
5298) endif
5299) case(LIQUID_SATURATION)
5300) if (vec_format == GLOBAL) then
5301) do local_id=1,grid%nlmax
5302) patch%aux%Global%auxvars(grid%nL2G(local_id))%sat = &
5303) vec_ptr(local_id)
5304) enddo
5305) else if (vec_format == LOCAL) then
5306) do ghosted_id=1,grid%ngmax
5307) patch%aux%Global%auxvars(ghosted_id)%sat = vec_ptr(ghosted_id)
5308) enddo
5309) endif
5310) case(LIQUID_DENSITY)
5311) if (vec_format == GLOBAL) then
5312) do local_id=1,grid%nlmax
5313) patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg = &
5314) vec_ptr(local_id)
5315) enddo
5316) else if (vec_format == LOCAL) then
5317) do ghosted_id=1,grid%ngmax
5318) patch%aux%Global%auxvars(ghosted_id)%den_kg = &
5319) vec_ptr(ghosted_id)
5320) enddo
5321) endif
5322) case(GAS_MOLE_FRACTION,GAS_ENERGY,GAS_DENSITY)
5323) call printErrMsg(option,'GAS_MOLE_FRACTION not supported by TH')
5324) case(GAS_SATURATION)
5325) if (option%use_th_freezing) then
5326) if (vec_format == GLOBAL) then
5327) do local_id=1,grid%nlmax
5328) patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_gas = &
5329) vec_ptr(local_id)
5330) enddo
5331) else if (vec_format == LOCAL) then
5332) do ghosted_id=1,grid%ngmax
5333) patch%aux%TH%auxvars(ghosted_id)%ice%sat_gas = vec_ptr(ghosted_id)
5334) enddo
5335) endif
5336) endif
5337) case(ICE_SATURATION)
5338) if (option%use_th_freezing) then
5339) if (vec_format == GLOBAL) then
5340) do local_id=1,grid%nlmax
5341) patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_ice = &
5342) vec_ptr(local_id)
5343) enddo
5344) else if (vec_format == LOCAL) then
5345) do ghosted_id=1,grid%ngmax
5346) patch%aux%TH%auxvars(ghosted_id)%ice%sat_ice = vec_ptr(ghosted_id)
5347) enddo
5348) endif
5349) endif
5350) case(ICE_DENSITY)
5351) if (option%use_th_freezing) then
5352) if (vec_format == GLOBAL) then
5353) do local_id=1,grid%nlmax
5354) patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%den_ice = &
5355) vec_ptr(local_id)
5356) enddo
5357) else if (vec_format == LOCAL) then
5358) do ghosted_id=1,grid%ngmax
5359) patch%aux%TH%auxvars(ghosted_id)%ice%den_ice = vec_ptr(ghosted_id)
5360) enddo
5361) endif
5362) endif
5363) case(LIQUID_VISCOSITY)
5364) case(GAS_VISCOSITY)
5365) case(LIQUID_MOLE_FRACTION)
5366) call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by TH')
5367) case(LIQUID_ENERGY)
5368) if (vec_format == GLOBAL) then
5369) do local_id=1,grid%nlmax
5370) patch%aux%TH%auxvars(grid%nL2G(local_id))%u = vec_ptr(local_id)
5371) enddo
5372) else if (vec_format == LOCAL) then
5373) do ghosted_id=1,grid%ngmax
5374) patch%aux%TH%auxvars(ghosted_id)%u = vec_ptr(ghosted_id)
5375) enddo
5376) endif
5377) end select
5378) else if (associated(patch%aux%Richards)) then
5379) select case(ivar)
5380) case(TEMPERATURE)
5381) call printErrMsg(option,'TEMPERATURE not supported by Richards')
5382) case(GAS_SATURATION)
5383) call printErrMsg(option,'GAS_SATURATION not supported by Richards')
5384) case(GAS_DENSITY)
5385) call printErrMsg(option,'GAS_DENSITY not supported by Richards')
5386) case(LIQUID_MOLE_FRACTION)
5387) call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by Richards')
5388) case(GAS_MOLE_FRACTION)
5389) call printErrMsg(option,'GAS_MOLE_FRACTION not supported by Richards')
5390) case(LIQUID_VISCOSITY)
5391) call printErrMsg(option,'LIQUID_VISCOSITY not supported by Richards')
5392) case(GAS_VISCOSITY)
5393) call printErrMsg(option,'GAS_VISCOSITY not supported by Richards')
5394) case(GAS_MOBILITY)
5395) call printErrMsg(option,'GAS_MOBILITY not supported by Richards')
5396) case(LIQUID_ENERGY)
5397) call printErrMsg(option,'LIQUID_ENERGY not supported by Richards')
5398) case(GAS_ENERGY)
5399) call printErrMsg(option,'GAS_ENERGY not supported by Richards')
5400) case(LIQUID_PRESSURE)
5401) if (vec_format == GLOBAL) then
5402) do local_id=1,grid%nlmax
5403) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1) = &
5404) vec_ptr(local_id)
5405) enddo
5406) else if (vec_format == LOCAL) then
5407) do ghosted_id=1,grid%ngmax
5408) patch%aux%Global%auxvars(ghosted_id)%pres(1) = &
5409) vec_ptr(ghosted_id)
5410) enddo
5411) endif
5412) case(LIQUID_SATURATION)
5413) if (vec_format == GLOBAL) then
5414) do local_id=1,grid%nlmax
5415) patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1) = &
5416) vec_ptr(local_id)
5417) enddo
5418) else if (vec_format == LOCAL) then
5419) do ghosted_id=1,grid%ngmax
5420) patch%aux%Global%auxvars(ghosted_id)%sat(1) = &
5421) vec_ptr(ghosted_id)
5422) enddo
5423) endif
5424) case(LIQUID_DENSITY)
5425) if (vec_format == GLOBAL) then
5426) do local_id=1,grid%nlmax
5427) patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1) = &
5428) vec_ptr(local_id)
5429) enddo
5430) else if (vec_format == LOCAL) then
5431) do ghosted_id=1,grid%ngmax
5432) patch%aux%Global%auxvars(ghosted_id)%den_kg(1) = &
5433) vec_ptr(ghosted_id)
5434) enddo
5435) endif
5436) case(LIQUID_MOBILITY)
5437) if (vec_format == GLOBAL) then
5438) do local_id=1,grid%nlmax
5439) patch%aux%Richards%auxvars(grid%nL2G(local_id))%kvr = &
5440) vec_ptr(local_id)
5441) enddo
5442) else if (vec_format == LOCAL) then
5443) do ghosted_id=1,grid%ngmax
5444) patch%aux%Richards%auxvars(ghosted_id)%kvr = vec_ptr(ghosted_id)
5445) enddo
5446) endif
5447) end select
5448) else if (associated(patch%aux%Flash2)) then
5449) select case(ivar)
5450) case(TEMPERATURE)
5451) if (vec_format == GLOBAL) then
5452) do local_id=1,grid%nlmax
5453) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5454) auxvar_elem(0)%temp = vec_ptr(local_id)
5455) enddo
5456) else if (vec_format == LOCAL) then
5457) do ghosted_id=1,grid%ngmax
5458) patch%aux%Flash2%auxvars(ghosted_id)% &
5459) auxvar_elem(0)%temp = vec_ptr(ghosted_id)
5460) enddo
5461) endif
5462) case(LIQUID_PRESSURE)
5463) if (vec_format == GLOBAL) then
5464) do local_id=1,grid%nlmax
5465) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5466) auxvar_elem(0)%pres = vec_ptr(local_id)
5467) enddo
5468) else if (vec_format == LOCAL) then
5469) do ghosted_id=1,grid%ngmax
5470) patch%aux%Flash2%auxvars(ghosted_id)% &
5471) auxvar_elem(0)%pres = vec_ptr(ghosted_id)
5472) enddo
5473) endif
5474) case(LIQUID_SATURATION)
5475) if (vec_format == GLOBAL) then
5476) do local_id=1,grid%nlmax
5477) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5478) auxvar_elem(0)%sat(1) = vec_ptr(local_id)
5479) enddo
5480) else if (vec_format == LOCAL) then
5481) do ghosted_id=1,grid%ngmax
5482) patch%aux%Flash2%auxvars(ghosted_id)% &
5483) auxvar_elem(0)%sat(1) = vec_ptr(ghosted_id)
5484) enddo
5485) endif
5486) case(LIQUID_DENSITY)
5487) if (vec_format == GLOBAL) then
5488) do local_id=1,grid%nlmax
5489) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5490) auxvar_elem(0)%den(1) = vec_ptr(local_id)
5491) enddo
5492) else if (vec_format == LOCAL) then
5493) do ghosted_id=1,grid%ngmax
5494) patch%aux%Flash2%auxvars(ghosted_id)% &
5495) auxvar_elem(0)%den(1) = vec_ptr(ghosted_id)
5496) enddo
5497) endif
5498) case(LIQUID_VISCOSITY)
5499) if (vec_format == GLOBAL) then
5500) do local_id=1,grid%nlmax
5501) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5502) auxvar_elem(0)%vis(1) = vec_ptr(local_id)
5503) enddo
5504) else if (vec_format == LOCAL) then
5505) do ghosted_id=1,grid%ngmax
5506) patch%aux%Flash2%auxvars(ghosted_id)% &
5507) auxvar_elem(0)%vis(1) = vec_ptr(ghosted_id)
5508) enddo
5509) endif
5510) case(LIQUID_MOBILITY)
5511) if (vec_format == GLOBAL) then
5512) do local_id=1,grid%nlmax
5513) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5514) auxvar_elem(0)%kvr(1) = vec_ptr(local_id)
5515) enddo
5516) else if (vec_format == LOCAL) then
5517) do ghosted_id=1,grid%ngmax
5518) patch%aux%Flash2%auxvars(ghosted_id)% &
5519) auxvar_elem(0)%kvr(1) = vec_ptr(ghosted_id)
5520) enddo
5521) endif
5522) case(GAS_SATURATION)
5523) if (vec_format == GLOBAL) then
5524) do local_id=1,grid%nlmax
5525) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5526) auxvar_elem(0)%sat(2) = vec_ptr(local_id)
5527) enddo
5528) else if (vec_format == LOCAL) then
5529) do ghosted_id=1,grid%ngmax
5530) patch%aux%Flash2%auxvars(ghosted_id)% &
5531) auxvar_elem(0)%sat(2) = vec_ptr(ghosted_id)
5532) enddo
5533) endif
5534) case(GAS_MOLE_FRACTION)
5535) if (vec_format == GLOBAL) then
5536) do local_id=1,grid%nlmax
5537) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5538) auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(local_id)
5539) enddo
5540) else if (vec_format == LOCAL) then
5541) do ghosted_id=1,grid%ngmax
5542) patch%aux%Flash2%auxvars(ghosted_id)% &
5543) auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(ghosted_id)
5544) enddo
5545) endif
5546) case(GAS_ENERGY)
5547) if (vec_format == GLOBAL) then
5548) do local_id=1,grid%nlmax
5549) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5550) auxvar_elem(0)%u(2) = vec_ptr(local_id)
5551) enddo
5552) else if (vec_format == LOCAL) then
5553) do ghosted_id=1,grid%ngmax
5554) patch%aux%Flash2%auxvars(ghosted_id)% &
5555) auxvar_elem(0)%u(2) = vec_ptr(ghosted_id)
5556) enddo
5557) endif
5558) case(GAS_DENSITY, GAS_DENSITY_MOL)
5559) if (vec_format == GLOBAL) then
5560) do local_id=1,grid%nlmax
5561) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5562) auxvar_elem(0)%den(2) = vec_ptr(local_id)
5563) enddo
5564) else if (vec_format == LOCAL) then
5565) do ghosted_id=1,grid%ngmax
5566) patch%aux%Flash2%auxvars(ghosted_id)% &
5567) auxvar_elem(0)%den(2) = vec_ptr(ghosted_id)
5568) enddo
5569) endif
5570) case(GAS_VISCOSITY)
5571) if (vec_format == GLOBAL) then
5572) do local_id=1,grid%nlmax
5573) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5574) auxvar_elem(0)%vis(2) = vec_ptr(local_id)
5575) enddo
5576) else if (vec_format == LOCAL) then
5577) do ghosted_id=1,grid%ngmax
5578) patch%aux%Flash2%auxvars(ghosted_id)% &
5579) auxvar_elem(0)%vis(2) = vec_ptr(ghosted_id)
5580) enddo
5581) endif
5582) case(GAS_MOBILITY)
5583) if (vec_format == GLOBAL) then
5584) do local_id=1,grid%nlmax
5585) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5586) auxvar_elem(0)%kvr(2) = vec_ptr(local_id)
5587) enddo
5588) else if (vec_format == LOCAL) then
5589) do ghosted_id=1,grid%ngmax
5590) patch%aux%Flash2%auxvars(ghosted_id)% &
5591) auxvar_elem(0)%kvr(2) = vec_ptr(ghosted_id)
5592) enddo
5593) endif
5594) case(LIQUID_MOLE_FRACTION)
5595) if (vec_format == GLOBAL) then
5596) do local_id=1,grid%nlmax
5597) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5598) auxvar_elem(0)%xmol(isubvar) = vec_ptr(local_id)
5599) enddo
5600) else if (vec_format == LOCAL) then
5601) do ghosted_id=1,grid%ngmax
5602) patch%aux%Flash2%auxvars(ghosted_id)% &
5603) auxvar_elem(0)%xmol(isubvar) = vec_ptr(ghosted_id)
5604) enddo
5605) endif
5606) case(LIQUID_ENERGY)
5607) if (vec_format == GLOBAL) then
5608) do local_id=1,grid%nlmax
5609) patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
5610) auxvar_elem(0)%u(1) = vec_ptr(local_id)
5611) enddo
5612) else if (vec_format == LOCAL) then
5613) do ghosted_id=1,grid%ngmax
5614) patch%aux%Flash2%auxvars(ghosted_id)% &
5615) auxvar_elem(0)%u(1) = vec_ptr(ghosted_id)
5616) enddo
5617) endif
5618) end select
5619) else if (associated(patch%aux%Mphase)) then
5620) select case(ivar)
5621) case(TEMPERATURE)
5622) if (vec_format == GLOBAL) then
5623) do local_id=1,grid%nlmax
5624) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5625) auxvar_elem(0)%temp = vec_ptr(local_id)
5626) enddo
5627) else if (vec_format == LOCAL) then
5628) do ghosted_id=1,grid%ngmax
5629) patch%aux%Mphase%auxvars(ghosted_id)% &
5630) auxvar_elem(0)%temp = vec_ptr(ghosted_id)
5631) enddo
5632) endif
5633) case(LIQUID_PRESSURE)
5634) if (vec_format == GLOBAL) then
5635) do local_id=1,grid%nlmax
5636) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1) = &
5637) vec_ptr(local_id)
5638) enddo
5639) else if (vec_format == LOCAL) then
5640) do ghosted_id=1,grid%ngmax
5641) patch%aux%Global%auxvars(ghosted_id)%pres(1) = &
5642) vec_ptr(ghosted_id)
5643) enddo
5644) endif
5645) case(GAS_PRESSURE)
5646) if (vec_format == GLOBAL) then
5647) do local_id=1,grid%nlmax
5648) patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(2) = &
5649) vec_ptr(local_id)
5650) enddo
5651) else if (vec_format == LOCAL) then
5652) do ghosted_id=1,grid%ngmax
5653) patch%aux%Global%auxvars(ghosted_id)%pres(2) = &
5654) vec_ptr(ghosted_id)
5655) enddo
5656) endif
5657) case(LIQUID_SATURATION)
5658) if (vec_format == GLOBAL) then
5659) do local_id=1,grid%nlmax
5660) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5661) auxvar_elem(0)%sat(1) = vec_ptr(local_id)
5662) enddo
5663) else if (vec_format == LOCAL) then
5664) do ghosted_id=1,grid%ngmax
5665) patch%aux%Mphase%auxvars(ghosted_id)% &
5666) auxvar_elem(0)%sat(1) = vec_ptr(ghosted_id)
5667) enddo
5668) endif
5669) case(LIQUID_DENSITY)
5670) if (vec_format == GLOBAL) then
5671) do local_id=1,grid%nlmax
5672) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5673) auxvar_elem(0)%den(1) = vec_ptr(local_id)
5674) enddo
5675) else if (vec_format == LOCAL) then
5676) do ghosted_id=1,grid%ngmax
5677) patch%aux%Mphase%auxvars(ghosted_id)% &
5678) auxvar_elem(0)%den(1) = vec_ptr(ghosted_id)
5679) enddo
5680) endif
5681) case(LIQUID_VISCOSITY)
5682) if (vec_format == GLOBAL) then
5683) do local_id=1,grid%nlmax
5684) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5685) auxvar_elem(0)%vis(1) = vec_ptr(local_id)
5686) enddo
5687) else if (vec_format == LOCAL) then
5688) do ghosted_id=1,grid%ngmax
5689) patch%aux%Mphase%auxvars(ghosted_id)% &
5690) auxvar_elem(0)%vis(1) = vec_ptr(ghosted_id)
5691) enddo
5692) endif
5693) case(LIQUID_MOBILITY)
5694) if (vec_format == GLOBAL) then
5695) do local_id=1,grid%nlmax
5696) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5697) auxvar_elem(0)%kvr(1) = vec_ptr(local_id)
5698) enddo
5699) else if (vec_format == LOCAL) then
5700) do ghosted_id=1,grid%ngmax
5701) patch%aux%Mphase%auxvars(ghosted_id)% &
5702) auxvar_elem(0)%kvr(1) = vec_ptr(ghosted_id)
5703) enddo
5704) endif
5705) case(GAS_SATURATION)
5706) if (vec_format == GLOBAL) then
5707) do local_id=1,grid%nlmax
5708) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5709) auxvar_elem(0)%sat(2) = vec_ptr(local_id)
5710) enddo
5711) else if (vec_format == LOCAL) then
5712) do ghosted_id=1,grid%ngmax
5713) patch%aux%Mphase%auxvars(ghosted_id)% &
5714) auxvar_elem(0)%sat(2) = vec_ptr(ghosted_id)
5715) enddo
5716) endif
5717) case(GAS_MOLE_FRACTION)
5718) if (vec_format == GLOBAL) then
5719) do local_id=1,grid%nlmax
5720) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5721) auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(local_id)
5722) enddo
5723) else if (vec_format == LOCAL) then
5724) do ghosted_id=1,grid%ngmax
5725) patch%aux%Mphase%auxvars(ghosted_id)% &
5726) auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(ghosted_id)
5727) enddo
5728) endif
5729) case(GAS_ENERGY)
5730) if (vec_format == GLOBAL) then
5731) do local_id=1,grid%nlmax
5732) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5733) auxvar_elem(0)%u(2) = vec_ptr(local_id)
5734) enddo
5735) else if (vec_format == LOCAL) then
5736) do ghosted_id=1,grid%ngmax
5737) patch%aux%Mphase%auxvars(ghosted_id)% &
5738) auxvar_elem(0)%u(2) = vec_ptr(ghosted_id)
5739) enddo
5740) endif
5741) case(GAS_DENSITY, GAS_DENSITY_MOL)
5742) if (vec_format == GLOBAL) then
5743) do local_id=1,grid%nlmax
5744) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5745) auxvar_elem(0)%den(2) = vec_ptr(local_id)
5746) enddo
5747) else if (vec_format == LOCAL) then
5748) do ghosted_id=1,grid%ngmax
5749) patch%aux%Mphase%auxvars(ghosted_id)% &
5750) auxvar_elem(0)%den(2) = vec_ptr(ghosted_id)
5751) enddo
5752) endif
5753) case(LIQUID_MOLE_FRACTION)
5754) if (vec_format == GLOBAL) then
5755) do local_id=1,grid%nlmax
5756) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5757) auxvar_elem(0)%xmol(isubvar) = vec_ptr(local_id)
5758) enddo
5759) else if (vec_format == LOCAL) then
5760) do ghosted_id=1,grid%ngmax
5761) patch%aux%Mphase%auxvars(ghosted_id)% &
5762) auxvar_elem(0)%xmol(isubvar) = vec_ptr(ghosted_id)
5763) enddo
5764) endif
5765) case(LIQUID_ENERGY)
5766) if (vec_format == GLOBAL) then
5767) do local_id=1,grid%nlmax
5768) patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
5769) auxvar_elem(0)%u(1) = vec_ptr(local_id)
5770) enddo
5771) else if (vec_format == LOCAL) then
5772) do ghosted_id=1,grid%ngmax
5773) patch%aux%Mphase%auxvars(ghosted_id)% &
5774) auxvar_elem(0)%u(1) = vec_ptr(ghosted_id)
5775) enddo
5776) endif
5777) end select
5778) else if (associated(patch%aux%Immis)) then
5779) select case(ivar)
5780) case(TEMPERATURE)
5781) if (vec_format == GLOBAL) then
5782) do local_id=1,grid%nlmax
5783) patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
5784) auxvar_elem(0)%temp = vec_ptr(local_id)
5785) enddo
5786) else if (vec_format == LOCAL) then
5787) do ghosted_id=1,grid%ngmax
5788) patch%aux%Immis%auxvars(ghosted_id)% &
5789) auxvar_elem(0)%temp = vec_ptr(ghosted_id)
5790) enddo
5791) endif
5792) case(LIQUID_PRESSURE)
5793) if (vec_format == GLOBAL) then
5794) do local_id=1,grid%nlmax
5795) patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
5796) auxvar_elem(0)%pres = vec_ptr(local_id)
5797) enddo
5798) else if (vec_format == LOCAL) then
5799) do ghosted_id=1,grid%ngmax
5800) patch%aux%Immis%auxvars(ghosted_id)% &
5801) auxvar_elem(0)%pres = vec_ptr(ghosted_id)
5802) enddo
5803) endif
5804) case(LIQUID_SATURATION)
5805) if (vec_format == GLOBAL) then
5806) do local_id=1,grid%nlmax
5807) patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
5808) auxvar_elem(0)%sat(1) = vec_ptr(local_id)
5809) enddo
5810) else if (vec_format == LOCAL) then
5811) do ghosted_id=1,grid%ngmax
5812) patch%aux%Immis%auxvars(ghosted_id)% &
5813) auxvar_elem(0)%sat(1) = vec_ptr(ghosted_id)
5814) enddo
5815) endif
5816) case(LIQUID_DENSITY)
5817) if (vec_format == GLOBAL) then
5818) do local_id=1,grid%nlmax
5819) patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
5820) auxvar_elem(0)%den(1) = vec_ptr(local_id)
5821) enddo
5822) else if (vec_format == LOCAL) then
5823) do ghosted_id=1,grid%ngmax
5824) patch%aux%Immis%auxvars(ghosted_id)% &
5825) auxvar_elem(0)%den(1) = vec_ptr(ghosted_id)
5826) enddo
5827) endif
5828) case(GAS_SATURATION)
5829) if (vec_format == GLOBAL) then
5830) do local_id=1,grid%nlmax
5831) patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
5832) auxvar_elem(0)%sat(2) = vec_ptr(local_id)
5833) enddo
5834) else if (vec_format == LOCAL) then
5835) do ghosted_id=1,grid%ngmax
5836) patch%aux%Immis%auxvars(ghosted_id)% &
5837) auxvar_elem(0)%sat(2) = vec_ptr(ghosted_id)
5838) enddo
5839) endif
5840) case(GAS_ENERGY)
5841) if (vec_format == GLOBAL) then
5842) do local_id=1,grid%nlmax
5843) patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
5844) auxvar_elem(0)%u(2) = vec_ptr(local_id)
5845) enddo
5846) else if (vec_format == LOCAL) then
5847) do ghosted_id=1,grid%ngmax
5848) patch%aux%Immis%auxvars(ghosted_id)% &
5849) auxvar_elem(0)%u(2) = vec_ptr(ghosted_id)
5850) enddo
5851) endif
5852) case(LIQUID_ENERGY)
5853) if (vec_format == GLOBAL) then
5854) do local_id=1,grid%nlmax
5855) patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
5856) auxvar_elem(0)%u(1) = vec_ptr(local_id)
5857) enddo
5858) else if (vec_format == LOCAL) then
5859) do ghosted_id=1,grid%ngmax
5860) patch%aux%Immis%auxvars(ghosted_id)% &
5861) auxvar_elem(0)%u(1) = vec_ptr(ghosted_id)
5862) enddo
5863) endif
5864) end select
5865) else if (associated(patch%aux%General)) then
5866) select case(ivar)
5867) case(TEMPERATURE)
5868) do local_id=1,grid%nlmax
5869) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5870) temp = vec_ptr(local_id)
5871) enddo
5872) case(LIQUID_PRESSURE)
5873) do local_id=1,grid%nlmax
5874) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5875) pres(option%liquid_phase) = vec_ptr(local_id)
5876) enddo
5877) case(GAS_PRESSURE)
5878) do local_id=1,grid%nlmax
5879) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5880) pres(option%gas_phase) = vec_ptr(local_id)
5881) enddo
5882) case(AIR_PRESSURE)
5883) do local_id=1,grid%nlmax
5884) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5885) pres(option%air_pressure_id) = vec_ptr(local_id)
5886) enddo
5887) case(CAPILLARY_PRESSURE)
5888) do local_id=1,grid%nlmax
5889) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5890) pres(option%capillary_pressure_id) = vec_ptr(local_id)
5891) enddo
5892) case(STATE)
5893) do local_id=1,grid%nlmax
5894) patch%aux%Global%auxvars(grid%nL2G(local_id))%istate = &
5895) int(vec_ptr(local_id)+1.d-10)
5896) enddo
5897) case(LIQUID_SATURATION)
5898) do local_id=1,grid%nlmax
5899) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5900) sat(option%liquid_phase) = vec_ptr(local_id)
5901) enddo
5902) case(LIQUID_DENSITY)
5903) do local_id=1,grid%nlmax
5904) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5905) den_kg(option%liquid_phase) = vec_ptr(local_id)
5906) enddo
5907) case(LIQUID_ENERGY)
5908) do local_id=1,grid%nlmax
5909) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5910) U(option%liquid_phase) = vec_ptr(local_id)
5911) enddo
5912) case(LIQUID_MOLE_FRACTION)
5913) do local_id=1,grid%nlmax
5914) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5915) xmol(isubvar,option%liquid_phase) = vec_ptr(local_id)
5916) enddo
5917) case(GAS_SATURATION)
5918) do local_id=1,grid%nlmax
5919) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5920) sat(option%gas_phase) = vec_ptr(local_id)
5921) enddo
5922) case(GAS_DENSITY)
5923) do local_id=1,grid%nlmax
5924) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5925) den_kg(option%gas_phase) = vec_ptr(local_id)
5926) enddo
5927) case(GAS_ENERGY)
5928) do local_id=1,grid%nlmax
5929) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5930) U(option%gas_phase) = vec_ptr(local_id)
5931) enddo
5932) case(GAS_MOLE_FRACTION)
5933) do local_id=1,grid%nlmax
5934) patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
5935) xmol(isubvar,option%gas_phase) = vec_ptr(local_id)
5936) enddo
5937) end select
5938) endif
5939) case(PRIMARY_MOLALITY,TOTAL_MOLARITY,MINERAL_VOLUME_FRACTION, &
5940) PRIMARY_ACTIVITY_COEF,SECONDARY_ACTIVITY_COEF,IMMOBILE_SPECIES)
5941) select case(ivar)
5942) case(PRIMARY_MOLALITY)
5943) if (vec_format == GLOBAL) then
5944) do local_id=1,grid%nlmax
5945) patch%aux%RT%auxvars(grid%nL2G(local_id))%pri_molal(isubvar) = &
5946) vec_ptr(local_id)
5947) enddo
5948) else if (vec_format == LOCAL) then
5949) do ghosted_id=1,grid%ngmax
5950) patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) = &
5951) vec_ptr(ghosted_id)
5952) enddo
5953) endif
5954) case(TOTAL_MOLARITY)
5955) if (vec_format == GLOBAL) then
5956) do local_id=1,grid%nlmax
5957) patch%aux%RT%auxvars(grid%nL2G(local_id))% &
5958) total(isubvar,iphase) = vec_ptr(local_id)
5959) enddo
5960) else if (vec_format == LOCAL) then
5961) do ghosted_id=1,grid%ngmax
5962) patch%aux%RT%auxvars(ghosted_id)% &
5963) total(isubvar,iphase) = vec_ptr(ghosted_id)
5964) enddo
5965) endif
5966) case(MINERAL_VOLUME_FRACTION)
5967) if (vec_format == GLOBAL) then
5968) do local_id=1,grid%nlmax
5969) patch%aux%RT%auxvars(grid%nL2G(local_id))% &
5970) mnrl_volfrac(isubvar) = vec_ptr(local_id)
5971) enddo
5972) else if (vec_format == LOCAL) then
5973) do ghosted_id=1,grid%ngmax
5974) patch%aux%RT%auxvars(ghosted_id)% &
5975) mnrl_volfrac(isubvar) = vec_ptr(ghosted_id)
5976) enddo
5977) endif
5978) case(IMMOBILE_SPECIES)
5979) if (vec_format == GLOBAL) then
5980) do local_id=1,grid%nlmax
5981) patch%aux%RT%auxvars(grid%nL2G(local_id))% &
5982) immobile(isubvar) = vec_ptr(local_id)
5983) enddo
5984) else if (vec_format == LOCAL) then
5985) do ghosted_id=1,grid%ngmax
5986) patch%aux%RT%auxvars(ghosted_id)% &
5987) immobile(isubvar) = vec_ptr(ghosted_id)
5988) enddo
5989) endif
5990) case(PRIMARY_ACTIVITY_COEF)
5991) if (vec_format == GLOBAL) then
5992) do local_id=1,grid%nlmax
5993) patch%aux%RT%auxvars(grid%nL2G(local_id))% &
5994) pri_act_coef(isubvar) = vec_ptr(local_id)
5995) enddo
5996) else if (vec_format == LOCAL) then
5997) do ghosted_id=1,grid%ngmax
5998) patch%aux%RT%auxvars(ghosted_id)% &
5999) pri_act_coef(isubvar) = vec_ptr(ghosted_id)
6000) enddo
6001) endif
6002) case(SECONDARY_ACTIVITY_COEF)
6003) if (vec_format == GLOBAL) then
6004) do local_id=1,grid%nlmax
6005) patch%aux%RT%auxvars(grid%nL2G(local_id))% &
6006) sec_act_coef(isubvar) = vec_ptr(local_id)
6007) enddo
6008) else if (vec_format == LOCAL) then
6009) do ghosted_id=1,grid%ngmax
6010) patch%aux%RT%auxvars(ghosted_id)% &
6011) sec_act_coef(isubvar) = vec_ptr(ghosted_id)
6012) enddo
6013) endif
6014) end select
6015) case(PRIMARY_MOLARITY,SECONDARY_MOLALITY,SECONDARY_MOLARITY,TOTAL_MOLALITY, &
6016) COLLOID_MOBILE,COLLOID_IMMOBILE)
6017) select case(ivar)
6018) case(PRIMARY_MOLARITY)
6019) call printErrMsg(option,'Setting of primary molarity at grid cell not supported.')
6020) case(SECONDARY_MOLALITY)
6021) call printErrMsg(option,'Setting of secondary molality at grid cell not supported.')
6022) case(SECONDARY_MOLARITY)
6023) call printErrMsg(option,'Setting of secondary molarity at grid cell not supported.')
6024) case(TOTAL_MOLALITY)
6025) call printErrMsg(option,'Setting of total molality at grid cell not supported.')
6026) case(COLLOID_MOBILE)
6027) call printErrMsg(option,'Setting of mobile colloid concentration at grid cell not supported.')
6028) case(COLLOID_IMMOBILE)
6029) call printErrMsg(option,'Setting of immobile colloid concentration at grid cell not supported.')
6030) end select
6031) case(POROSITY,MINERAL_POROSITY)
6032) if (vec_format == GLOBAL) then
6033) do local_id=1,grid%nlmax
6034) call MaterialAuxVarSetValue(material_auxvars(grid%nL2G(local_id)), &
6035) ivar,vec_ptr(local_id))
6036) enddo
6037) else if (vec_format == LOCAL) then
6038) do ghosted_id=1,grid%ngmax
6039) call MaterialAuxVarSetValue(material_auxvars(ghosted_id), &
6040) ivar,vec_ptr(ghosted_id))
6041) enddo
6042) endif
6043) case(VOLUME,TORTUOSITY,SOIL_COMPRESSIBILITY,SOIL_REFERENCE_PRESSURE)
6044) option%io_buffer = 'Setting of volume, tortuosity, ' // &
6045) 'soil compressibility or soil reference pressure in ' // &
6046) '"PatchSetVariable" not supported.'
6047) call printErrMsg(option)
6048) case(PERMEABILITY,PERMEABILITY_X,PERMEABILITY_Y,PERMEABILITY_Z)
6049) option%io_buffer = 'Setting of permeability in "PatchSetVariable"' // &
6050) ' not supported.'
6051) call printErrMsg(option)
6052) case(PHASE)
6053) if (vec_format == GLOBAL) then
6054) call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
6055) do local_id=1,grid%nlmax
6056) vec_ptr2(grid%nL2G(local_id)) = vec_ptr(local_id)
6057) enddo
6058) call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
6059) else if (vec_format == LOCAL) then
6060) call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
6061) vec_ptr2(1:grid%ngmax) = vec_ptr(1:grid%ngmax)
6062) call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
6063) endif
6064) case(MATERIAL_ID)
6065) !geh: this would require the creation of a permanent mapping between
6066) ! external and internal material ids, which we want to avoid.
6067) call printErrMsg(option, &
6068) 'Cannot set MATERIAL_ID through PatchSetVariable()')
6069) if (vec_format == GLOBAL) then
6070) do local_id=1,grid%nlmax
6071) patch%imat(grid%nL2G(local_id)) = int(vec_ptr(local_id))
6072) enddo
6073) else if (vec_format == LOCAL) then
6074) patch%imat(1:grid%ngmax) = int(vec_ptr(1:grid%ngmax))
6075) endif
6076) case(PROCESS_ID)
6077) call printErrMsg(option, &
6078) 'Cannot set PROCESS_ID through PatchSetVariable()')
6079) case default
6080) write(option%io_buffer, &
6081) '(''IVAR ('',i3,'') not found in PatchSetVariable'')') ivar
6082) call printErrMsg(option)
6083) end select
6084)
6085) call VecRestoreArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
6086)
6087) end subroutine PatchSetVariable
6088)
6089) ! ************************************************************************** !
6090)
6091) subroutine PatchCountCells(patch,total_count,active_count)
6092) !
6093) ! Counts # of active and inactive grid cells
6094) !
6095) ! Author: Glenn Hammond
6096) ! Date: 06/01/10
6097) !
6098)
6099) use Option_module
6100)
6101) implicit none
6102)
6103) type(patch_type) :: patch
6104) PetscInt :: total_count
6105) PetscInt :: active_count
6106)
6107) type(grid_type), pointer :: grid
6108) PetscInt :: local_id
6109)
6110) grid => patch%grid
6111)
6112) total_count = grid%nlmax
6113)
6114) active_count = 0
6115) do local_id = 1, grid%nlmax
6116) if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
6117) active_count = active_count + 1
6118) enddo
6119)
6120) end subroutine PatchCountCells
6121)
6122) ! ************************************************************************** !
6123)
6124) subroutine PatchCalculateCFL1Timestep(patch,option,max_dt_cfl_1)
6125) !
6126) ! Calculates largest time step to preserves a
6127) ! CFL # of 1 in a patch
6128) !
6129) ! Author: Glenn Hammond
6130) ! Date: 10/06/11
6131) !
6132)
6133) use Option_module
6134) use Connection_module
6135) use Coupler_module
6136) use Field_module
6137) use Global_Aux_module
6138) use Material_Aux_class
6139)
6140) implicit none
6141)
6142) #include "petsc/finclude/petscvec.h"
6143) #include "petsc/finclude/petscvec.h90"
6144)
6145) type(patch_type) :: patch
6146) type(option_type) :: option
6147) PetscReal :: max_dt_cfl_1
6148)
6149) type(grid_type), pointer :: grid
6150) type(field_type), pointer :: field
6151) type(coupler_type), pointer :: boundary_condition
6152) type(global_auxvar_type), pointer :: global_auxvars(:)
6153) class(material_auxvar_type), pointer :: material_auxvars(:)
6154) type(connection_set_list_type), pointer :: connection_set_list
6155) type(connection_set_type), pointer :: cur_connection_set
6156) PetscInt :: iconn
6157) PetscInt :: sum_connection
6158) PetscReal :: distance, fraction_upwind
6159) PetscReal :: por_sat_ave, por_sat_min, v_darcy, v_pore_ave, v_pore_max
6160) PetscInt :: local_id_up, local_id_dn
6161) PetscInt :: ghosted_id_up, ghosted_id_dn
6162) PetscInt :: iphase
6163)
6164) PetscReal :: dt_cfl_1
6165) PetscErrorCode :: ierr
6166)
6167) field => patch%field
6168) global_auxvars => patch%aux%Global%auxvars
6169) material_auxvars => patch%aux%Material%auxvars
6170) grid => patch%grid
6171)
6172) max_dt_cfl_1 = 1.d20
6173)
6174) connection_set_list => grid%internal_connection_set_list
6175) cur_connection_set => connection_set_list%first
6176) sum_connection = 0
6177) do
6178) if (.not.associated(cur_connection_set)) exit
6179) do iconn = 1, cur_connection_set%num_connections
6180) sum_connection = sum_connection + 1
6181) ghosted_id_up = cur_connection_set%id_up(iconn)
6182) ghosted_id_dn = cur_connection_set%id_dn(iconn)
6183) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
6184) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
6185) if (patch%imat(ghosted_id_up) <= 0 .or. &
6186) patch%imat(ghosted_id_dn) <= 0) cycle
6187) distance = cur_connection_set%dist(0,iconn)
6188) fraction_upwind = cur_connection_set%dist(-1,iconn)
6189) do iphase = 1, option%nphase
6190) ! if the phase is not present in either cell, skip the connection
6191) if (.not.(global_auxvars(ghosted_id_up)%sat(iphase) > 0.d0 .and. &
6192) global_auxvars(ghosted_id_dn)%sat(iphase) > 0.d0)) cycle
6193) por_sat_min = min(material_auxvars(ghosted_id_up)%porosity* &
6194) global_auxvars(ghosted_id_up)%sat(iphase), &
6195) material_auxvars(ghosted_id_dn)%porosity* &
6196) global_auxvars(ghosted_id_dn)%sat(iphase))
6197) por_sat_ave = (fraction_upwind* &
6198) material_auxvars(ghosted_id_up)%porosity* &
6199) global_auxvars(ghosted_id_up)%sat(iphase) + &
6200) (1.d0-fraction_upwind)* &
6201) material_auxvars(ghosted_id_dn)%porosity* &
6202) global_auxvars(ghosted_id_dn)%sat(iphase))
6203) v_darcy = patch%internal_velocities(iphase,sum_connection)
6204) v_pore_max = v_darcy / por_sat_min
6205) v_pore_ave = v_darcy / por_sat_ave
6206) !geh: I use v_por_max to ensure that we limit the cfl based on the
6207) ! highest velocity through the face. If porosity*saturation
6208) ! varies, the pore water velocity will be highest on the side
6209) ! of the face with the smalled value of porosity*saturation.
6210) dt_cfl_1 = distance / dabs(v_pore_max)
6211) max_dt_cfl_1 = min(dt_cfl_1,max_dt_cfl_1)
6212) enddo
6213) enddo
6214) cur_connection_set => cur_connection_set%next
6215) enddo
6216)
6217) boundary_condition => patch%boundary_condition_list%first
6218) sum_connection = 0
6219) do
6220) if (.not.associated(boundary_condition)) exit
6221) cur_connection_set => boundary_condition%connection_set
6222) do iconn = 1, cur_connection_set%num_connections
6223) sum_connection = sum_connection + 1
6224) local_id_dn = cur_connection_set%id_dn(iconn)
6225) ghosted_id_dn = grid%nL2G(local_id_dn)
6226) if (patch%imat(ghosted_id_dn) <= 0) cycle
6227) !geh: since on boundary, dist must be scaled by 2.d0
6228) distance = 2.d0*cur_connection_set%dist(0,iconn)
6229) do iphase = 1, option%nphase
6230) por_sat_ave = material_auxvars(ghosted_id_dn)%porosity* &
6231) global_auxvars(ghosted_id_dn)%sat(iphase)
6232) v_darcy = patch%boundary_velocities(iphase,sum_connection)
6233) v_pore_ave = v_darcy / por_sat_ave
6234) dt_cfl_1 = distance / dabs(v_pore_ave)
6235) max_dt_cfl_1 = min(dt_cfl_1,max_dt_cfl_1)
6236) enddo
6237) enddo
6238) boundary_condition => boundary_condition%next
6239) enddo
6240)
6241) end subroutine PatchCalculateCFL1Timestep
6242)
6243) ! ************************************************************************** !
6244)
6245) function PatchGetVarNameFromKeyword(keyword,option)
6246) !
6247) ! Returns the name of variable defined by keyword
6248) !
6249) ! Author: Glenn Hammond
6250) ! Date: 07/28/11
6251) !
6252)
6253) use Option_module
6254)
6255) implicit none
6256)
6257) character(len=MAXWORDLENGTH) :: keyword
6258) type(option_type) :: option
6259)
6260) character(len=MAXSTRINGLENGTH) :: PatchGetVarNameFromKeyword
6261) character(len=MAXSTRINGLENGTH) :: var_name
6262)
6263) select case(keyword)
6264) case('PROCESS_ID')
6265) var_name = 'Processor ID'
6266) case default
6267) option%io_buffer = 'Keyword "' // trim(keyword) // '" not ' // &
6268) 'recognized in PatchGetIvarsFromKeyword()'
6269) call printErrMsg(option)
6270) end select
6271)
6272) PatchGetVarNameFromKeyword = var_name
6273)
6274) end function PatchGetVarNameFromKeyword
6275)
6276) ! ************************************************************************** !
6277)
6278) subroutine PatchGetIvarsFromKeyword(keyword,ivar,isubvar,var_type,option)
6279) !
6280) ! Returns the ivar and isubvars for extracting
6281) ! datasets using PatchGet/PatchSet routines
6282) !
6283) ! Author: Glenn Hammond
6284) ! Date: 07/28/11
6285) !
6286)
6287) use Option_module
6288) use Variables_module
6289)
6290) implicit none
6291)
6292) character(len=MAXWORDLENGTH) :: keyword
6293) PetscInt :: ivar
6294) PetscInt :: isubvar
6295) PetscInt :: var_type
6296) type(option_type) :: option
6297)
6298) select case(keyword)
6299) case('PROCESS_ID')
6300) ivar = PROCESS_ID
6301) isubvar = ZERO_INTEGER
6302) var_type = INT_VAR
6303) case default
6304) option%io_buffer = 'Keyword "' // trim(keyword) // '" not ' // &
6305) 'recognized in PatchGetIvarsFromKeyword()'
6306) call printErrMsg(option)
6307) end select
6308)
6309) end subroutine
6310)
6311) ! ************************************************************************** !
6312)
6313) subroutine PatchGetVariable2(patch,surf_field,option,output_option,vec,ivar, &
6314) isubvar,isubvar1)
6315) !
6316) ! PatchGetVariable: Extracts variables indexed by ivar and isubvar from a patch
6317) !
6318) ! Author: Glenn Hammond
6319) ! Date: 09/12/08
6320) !
6321)
6322) use Grid_module
6323) use Option_module
6324) use Output_Aux_module
6325) use Surface_Field_module
6326) use Variables_module
6327)
6328) implicit none
6329)
6330) #include "petsc/finclude/petscvec.h"
6331) #include "petsc/finclude/petscvec.h90"
6332)
6333) type(option_type), pointer :: option
6334) !type(reaction_type), pointer :: reaction
6335) type(output_option_type), pointer :: output_option
6336) type(surface_field_type), pointer :: surf_field
6337) type(patch_type), pointer :: patch
6338) Vec :: vec
6339) PetscInt :: ivar
6340) PetscInt :: isubvar
6341) PetscInt, optional :: isubvar1
6342) PetscInt :: iphase
6343)
6344) PetscInt :: local_id, ghosted_id
6345) type(grid_type), pointer :: grid
6346) PetscReal, pointer :: vec_ptr(:), vec_ptr2(:)
6347) PetscReal :: xmass
6348) PetscReal :: tempreal
6349) PetscInt :: tempint
6350) PetscInt :: irate, istate, irxn
6351) PetscErrorCode :: ierr
6352)
6353) grid => patch%grid
6354)
6355) call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
6356)
6357) iphase = 1
6358)
6359) select case(ivar)
6360) case(SURFACE_LIQUID_HEAD)
6361) do local_id=1,grid%nlmax
6362) vec_ptr(local_id) = patch%surf_aux%SurfaceGlobal%auxvars(grid%nL2G(local_id))%head(1)
6363) enddo
6364) case(SURFACE_LIQUID_TEMPERATURE)
6365) do local_id=1,grid%nlmax
6366) vec_ptr(local_id) = patch%surf_aux%SurfaceGlobal%auxvars(grid%nL2G(local_id))%temp
6367) enddo
6368) case(MATERIAL_ID)
6369) do local_id=1,grid%nlmax
6370) vec_ptr(local_id) = &
6371) patch%imat_internal_to_external(iabs(patch%imat(grid%nL2G(local_id))))
6372) enddo
6373) case(PROCESS_ID)
6374) do local_id=1,grid%nlmax
6375) vec_ptr(local_id) = option%myrank
6376) enddo
6377) case default
6378) write(option%io_buffer, &
6379) '(''IVAR ('',i3,'') not found in PatchGetVariable'')') ivar
6380) call printErrMsg(option)
6381) end select
6382)
6383) end subroutine PatchGetVariable2
6384)
6385) ! ************************************************************************** !
6386)
6387) subroutine PatchGetCellCenteredVelocities(patch,iphase,velocities)
6388) !
6389) ! Calculates the Darcy velocity at the center of all cells in a patch
6390) !
6391) ! Author: Glenn Hammond
6392) ! Date: 01/31/14
6393) !
6394) use Connection_module
6395) use Coupler_module
6396)
6397) implicit none
6398)
6399) type(patch_type), pointer :: patch
6400) PetscInt :: iphase
6401) PetscReal, intent(out) :: velocities(:,:)
6402)
6403) type(grid_type), pointer :: grid
6404) type(option_type), pointer :: option
6405) type(coupler_type), pointer :: boundary_condition
6406) type(connection_set_list_type), pointer :: connection_set_list
6407) type(connection_set_type), pointer :: cur_connection_set
6408) PetscInt :: sum_connection, iconn, num_connections
6409) PetscReal, allocatable :: sum_area(:,:), sum_velocity(:,:)
6410) PetscReal :: area(3), velocity(3)
6411) PetscInt :: ghosted_id_up, ghosted_id_dn
6412) PetscInt :: local_id_up, local_id_dn
6413) PetscInt :: local_id
6414) PetscInt :: i
6415)
6416) grid => patch%grid
6417)
6418) allocate(sum_velocity(3,grid%nlmax))
6419) allocate(sum_area(3,grid%nlmax))
6420) sum_velocity(:,:) = 0.d0
6421) sum_area(:,:) = 0.d0
6422)
6423) ! interior velocities
6424) connection_set_list => grid%internal_connection_set_list
6425) cur_connection_set => connection_set_list%first
6426) sum_connection = 0
6427) do
6428) if (.not.associated(cur_connection_set)) exit
6429) do iconn = 1, cur_connection_set%num_connections
6430) sum_connection = sum_connection + 1
6431) ghosted_id_up = cur_connection_set%id_up(iconn)
6432) ghosted_id_dn = cur_connection_set%id_dn(iconn)
6433) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
6434) local_id_dn = grid%nG2L(ghosted_id_dn) ! = zero for ghost nodes
6435) ! velocities are stored as the downwind face of the upwind cell
6436) area = cur_connection_set%area(iconn)* &
6437) cur_connection_set%dist(1:3,iconn)
6438) velocity = patch%internal_velocities(iphase,sum_connection)*area
6439) if (local_id_up > 0) then
6440) sum_velocity(:,local_id_up) = sum_velocity(:,local_id_up) + velocity
6441) sum_area(:,local_id_up) = sum_area(:,local_id_up) + dabs(area)
6442) endif
6443) if (local_id_dn > 0) then
6444) sum_velocity(:,local_id_dn) = sum_velocity(:,local_id_dn) + velocity
6445) sum_area(:,local_id_dn) = sum_area(:,local_id_dn) + dabs(area)
6446) endif
6447) enddo
6448) cur_connection_set => cur_connection_set%next
6449) enddo
6450)
6451) ! boundary velocities
6452) boundary_condition => patch%boundary_condition_list%first
6453) sum_connection = 0
6454) do
6455) if (.not.associated(boundary_condition)) exit
6456) cur_connection_set => boundary_condition%connection_set
6457) do iconn = 1, cur_connection_set%num_connections
6458) sum_connection = sum_connection + 1
6459) local_id = cur_connection_set%id_dn(iconn)
6460) area = cur_connection_set%area(iconn)* &
6461) cur_connection_set%dist(1:3,iconn)
6462) velocity = patch%boundary_velocities(iphase,sum_connection)*area
6463) sum_velocity(:,local_id) = sum_velocity(:,local_id) + velocity
6464) sum_area(:,local_id) = sum_area(:,local_id) + dabs(area)
6465) enddo
6466) boundary_condition => boundary_condition%next
6467) enddo
6468)
6469) ! divide by total area
6470) do local_id=1,grid%nlmax
6471) do i=1,3
6472) if (sum_area(i,local_id) > 0.d0) then
6473) velocities(i,local_id) = sum_velocity(i,local_id) / &
6474) sum_area(i,local_id)
6475) else
6476) velocities(i,local_id) = 0.d0
6477) endif
6478) enddo
6479) enddo
6480)
6481) deallocate(sum_velocity)
6482) deallocate(sum_area)
6483)
6484) end subroutine PatchGetCellCenteredVelocities
6485)
6486) ! ************************************************************************** !
6487)
6488) function PatchGetConnectionsFromCoords(patch,coordinates,integral_flux_name, &
6489) option)
6490) !
6491) !
6492) ! Returns a list of internal and boundary connection ids for cell
6493) ! interfaces within a polygon.
6494) !
6495) ! Author: Glenn Hammond
6496) ! Date: 10/20/14
6497) !
6498) use Option_module
6499) use Geometry_module
6500) use Utility_module
6501) use Connection_module
6502) use Coupler_module
6503)
6504) implicit none
6505)
6506) type(patch_type) :: patch
6507) type(point3d_type) :: coordinates(:)
6508) character(len=MAXWORDLENGTH) :: integral_flux_name
6509) type(option_type) :: option
6510)
6511) PetscInt, pointer :: PatchGetConnectionsFromCoords(:)
6512)
6513) PetscInt, pointer :: connections(:)
6514) type(grid_type), pointer :: grid
6515) type(connection_set_list_type), pointer :: connection_set_list
6516) type(connection_set_type), pointer :: cur_connection_set
6517) type(coupler_type), pointer :: boundary_condition
6518)
6519) PetscInt :: idir
6520) PetscInt :: icount
6521) PetscInt :: array_size
6522) PetscInt :: sum_connection
6523) PetscInt :: iconn
6524) PetscInt :: i
6525) PetscInt :: local_id
6526) PetscInt :: local_id_up
6527) PetscInt :: ghosted_id
6528) PetscInt :: ghosted_id_up
6529) PetscInt :: ghosted_id_dn
6530) PetscReal :: fraction_upwind
6531) PetscReal :: magnitude
6532) PetscReal :: v1(3), v2(3)
6533) PetscReal :: x, y, z
6534) PetscReal :: value1, value2
6535) PetscReal, parameter :: relative_tolerance = 1.d-6
6536) PetscBool :: within_tolerance
6537) PetscErrorCode :: ierr
6538)
6539) grid => patch%grid
6540)
6541) ! determine orientation of polygon
6542) if (size(coordinates) > 2) then
6543) v1(1) = coordinates(2)%x - coordinates(1)%x
6544) v1(2) = coordinates(2)%y - coordinates(1)%y
6545) v1(3) = coordinates(2)%z - coordinates(1)%z
6546) v2(1) = coordinates(2)%x - coordinates(3)%x
6547) v2(2) = coordinates(2)%y - coordinates(3)%y
6548) v2(3) = coordinates(2)%z - coordinates(3)%z
6549) v1 = CrossProduct(v1,v2)
6550) icount = 0
6551) idir = 0
6552) do i = X_DIRECTION, Z_DIRECTION
6553) if (v1(i) > 1.d-10) then
6554) icount = icount + 1
6555) idir = i
6556) endif
6557) enddo
6558) else
6559) v1(1) = coordinates(1)%x
6560) v1(2) = coordinates(1)%y
6561) v1(3) = coordinates(1)%z
6562) v2(1) = coordinates(2)%x
6563) v2(2) = coordinates(2)%y
6564) v2(3) = coordinates(2)%z
6565) icount = 0
6566) do i = X_DIRECTION, Z_DIRECTION
6567) if (Equal(v2(i),v1(i))) then
6568) idir = i
6569) icount = icount + 1
6570) endif
6571) enddo
6572) if (icount == 0) icount = 3
6573) endif
6574)
6575) if (icount > 1) then
6576) option%io_buffer = 'Rectangle defined in integral flux "' // &
6577) trim(adjustl(integral_flux_name)) // &
6578) '" must be aligned with structured grid coordinates axes.'
6579) call printErrMsg(option)
6580) endif
6581)
6582) array_size = 100
6583) allocate(connections(array_size))
6584) icount = 0
6585) ! Interior Flux Terms -----------------------------------
6586) connection_set_list => grid%internal_connection_set_list
6587) cur_connection_set => connection_set_list%first
6588) sum_connection = 0
6589) do
6590) if (.not.associated(cur_connection_set)) exit
6591) do iconn = 1, cur_connection_set%num_connections
6592) sum_connection = sum_connection + 1
6593)
6594) ghosted_id_up = cur_connection_set%id_up(iconn)
6595) ghosted_id_dn = cur_connection_set%id_dn(iconn)
6596)
6597) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
6598) ! if one of the cells is ghosted, the process stores the flux only
6599) ! when the upwind cell is non-ghosted.
6600) if (local_id_up <= 0) cycle
6601)
6602) fraction_upwind = cur_connection_set%dist(-1,iconn)
6603) magnitude = cur_connection_set%dist(0,iconn)
6604) x = grid%x(ghosted_id_up) + fraction_upwind * magnitude * &
6605) cur_connection_set%dist(X_DIRECTION,iconn)
6606) y = grid%y(ghosted_id_up) + fraction_upwind * magnitude * &
6607) cur_connection_set%dist(Y_DIRECTION,iconn)
6608) z = grid%z(ghosted_id_up) + fraction_upwind * magnitude * &
6609) cur_connection_set%dist(Z_DIRECTION,iconn)
6610) select case(idir)
6611) case(X_DIRECTION)
6612) value1 = x
6613) value2 = coordinates(1)%x
6614) case(Y_DIRECTION)
6615) value1 = y
6616) value2 = coordinates(1)%y
6617) case(Z_DIRECTION)
6618) value1 = z
6619) value2 = coordinates(1)%z
6620) end select
6621) within_tolerance = PETSC_FALSE
6622) if (Equal(value1,0.d0)) then
6623) within_tolerance = Equal(value1,value2)
6624) else
6625) within_tolerance = dabs((value1-value2)/value1) < relative_tolerance
6626) endif
6627) if (within_tolerance .and. &
6628) GeometryPointInPolygon(x,y,z,idir,coordinates)) then
6629) icount = icount + 1
6630) if (icount > size(connections)) then
6631) call reallocateIntArray(connections,array_size)
6632) endif
6633) connections(icount) = sum_connection
6634) endif
6635) enddo
6636) cur_connection_set => cur_connection_set%next
6637) enddo
6638)
6639) ! Boundary Flux Terms -----------------------------------
6640) boundary_condition => patch%boundary_condition_list%first
6641) sum_connection = 0
6642) do
6643) if (.not.associated(boundary_condition)) exit
6644) cur_connection_set => boundary_condition%connection_set
6645) do iconn = 1, cur_connection_set%num_connections
6646) sum_connection = sum_connection + 1
6647) local_id = cur_connection_set%id_dn(iconn)
6648) ghosted_id = grid%nL2G(local_id)
6649) fraction_upwind = 1.d0
6650) magnitude = cur_connection_set%dist(0,iconn)
6651) x = grid%x(ghosted_id) - fraction_upwind * magnitude * &
6652) cur_connection_set%dist(X_DIRECTION,iconn)
6653) y = grid%y(ghosted_id) - fraction_upwind * magnitude * &
6654) cur_connection_set%dist(Y_DIRECTION,iconn)
6655) z = grid%z(ghosted_id) - fraction_upwind * magnitude * &
6656) cur_connection_set%dist(Z_DIRECTION,iconn)
6657) select case(idir)
6658) case(X_DIRECTION)
6659) value1 = x
6660) value2 = coordinates(1)%x
6661) case(Y_DIRECTION)
6662) value1 = y
6663) value2 = coordinates(1)%y
6664) case(Z_DIRECTION)
6665) value1 = z
6666) value2 = coordinates(1)%z
6667) end select
6668) within_tolerance = PETSC_FALSE
6669) if (Equal(value1,0.d0)) then
6670) within_tolerance = Equal(value1,value2)
6671) else
6672) within_tolerance = dabs((value1-value2)/value1) < relative_tolerance
6673) endif
6674) if (within_tolerance .and. &
6675) GeometryPointInPolygon(x,y,z,idir,coordinates)) then
6676) icount = icount + 1
6677) if (icount > size(connections)) then
6678) call reallocateIntArray(connections,array_size)
6679) endif
6680) connections(icount) = -1 * sum_connection
6681) endif
6682) enddo
6683) boundary_condition => boundary_condition%next
6684) enddo
6685)
6686) nullify(PatchGetConnectionsFromCoords)
6687) if (icount > 0) then
6688) allocate(PatchGetConnectionsFromCoords(icount))
6689) PatchGetConnectionsFromCoords = connections(1:icount)
6690) endif
6691) deallocate(connections)
6692) nullify(connections)
6693)
6694) call MPI_Allreduce(icount,i,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
6695) option%mycomm,ierr)
6696) if (i == 0) then
6697) option%io_buffer = 'Zero connections found for INTEGRAL_FLUX "' // &
6698) trim(adjustl(integral_flux_name)) // &
6699) '". Please ensure that the coordinates coincide with a cell boundary.'
6700) call printErrMsg(option)
6701) endif
6702)
6703) end function PatchGetConnectionsFromCoords
6704)
6705) ! **************************************************************************** !
6706)
6707) subroutine PatchCouplerInputRecord(patch)
6708) !
6709) ! Prints ingested coupler information to the input record file.
6710) !
6711) ! Author: Jenn Frederick
6712) ! Date: 04/18/2016
6713) !
6714) use Coupler_module
6715)
6716) implicit none
6717)
6718) type(patch_type), pointer :: patch
6719)
6720) type(coupler_type), pointer :: cur_coupler
6721) character(len=MAXWORDLENGTH) :: word1, word2
6722) character(len=MAXSTRINGLENGTH) :: string
6723) PetscInt :: k
6724) PetscInt :: id = INPUT_RECORD_UNIT
6725)
6726) k = 0
6727)
6728) write(id,'(a)') ' '
6729) write(id,'(a)') '---------------------------------------------------------&
6730) &-----------------------'
6731) write(id,'(a29)',advance='no') '---------------------------: '
6732) write(id,'(a)') 'INITIAL CONDITIONS'
6733)
6734) ! Initial conditions
6735) cur_coupler => patch%initial_condition_list%first
6736) do
6737) if (.not.associated(cur_coupler)) exit
6738) k = k + 1
6739) write(id,'(a29)',advance='no') 'initial condition listed: '
6740) write(word1,*) k
6741) write(id,'(a)') '#' // adjustl(trim(word1))
6742) write(id,'(a29)',advance='no') 'applies to region: '
6743) write(id,'(a)') adjustl(trim(cur_coupler%region_name))
6744) if (len_trim(cur_coupler%flow_condition_name) > 0) then
6745) write(id,'(a29)',advance='no') 'flow condition name: '
6746) write(id,'(a)') adjustl(trim(cur_coupler%flow_condition_name))
6747) endif
6748) if (len_trim(cur_coupler%tran_condition_name) > 0) then
6749) write(id,'(a29)',advance='no') 'transport condition name: '
6750) write(id,'(a)') adjustl(trim(cur_coupler%tran_condition_name))
6751) endif
6752) write(id,'(a29)') '---------------------------: '
6753) cur_coupler => cur_coupler%next
6754) enddo
6755)
6756) write(id,'(a)') ' '
6757) write(id,'(a)') '---------------------------------------------------------&
6758) &-----------------------'
6759) write(id,'(a29)',advance='no') '---------------------------: '
6760) write(id,'(a)') 'BOUNDARY CONDITIONS'
6761)
6762) ! Boundary conditions
6763) cur_coupler => patch%boundary_condition_list%first
6764) do
6765) if (.not.associated(cur_coupler)) exit
6766) write(id,'(a29)',advance='no') 'boundary condition name: '
6767) write(id,'(a)') adjustl(trim(cur_coupler%name))
6768) write(id,'(a29)',advance='no') 'applies to region: '
6769) write(id,'(a)') adjustl(trim(cur_coupler%region_name))
6770) if (len_trim(cur_coupler%flow_condition_name) > 0) then
6771) write(id,'(a29)',advance='no') 'flow condition name: '
6772) write(id,'(a)') adjustl(trim(cur_coupler%flow_condition_name))
6773) endif
6774) if (len_trim(cur_coupler%tran_condition_name) > 0) then
6775) write(id,'(a29)',advance='no') 'transport condition name: '
6776) write(id,'(a)') adjustl(trim(cur_coupler%tran_condition_name))
6777) endif
6778) write(id,'(a29)') '---------------------------: '
6779) cur_coupler => cur_coupler%next
6780) enddo
6781)
6782) write(id,'(a)') ' '
6783) write(id,'(a)') '---------------------------------------------------------&
6784) &-----------------------'
6785) write(id,'(a29)',advance='no') '---------------------------: '
6786) write(id,'(a)') 'SOURCE-SINKS'
6787)
6788) ! Source-Sink conditions
6789) cur_coupler => patch%source_sink_list%first
6790) do
6791) if (.not.associated(cur_coupler)) exit
6792) write(id,'(a29)',advance='no') 'source-sink name: '
6793) write(id,'(a)') adjustl(trim(cur_coupler%name))
6794) write(id,'(a29)',advance='no') 'applies to region: '
6795) write(id,'(a)') adjustl(trim(cur_coupler%region_name))
6796) if (len_trim(cur_coupler%flow_condition_name) > 0) then
6797) write(id,'(a29)',advance='no') 'flow condition name: '
6798) write(id,'(a)') adjustl(trim(cur_coupler%flow_condition_name))
6799) endif
6800) if (len_trim(cur_coupler%tran_condition_name) > 0) then
6801) write(id,'(a29)',advance='no') 'transport condition name: '
6802) write(id,'(a)') adjustl(trim(cur_coupler%tran_condition_name))
6803) endif
6804) write(id,'(a29)') '---------------------------: '
6805) cur_coupler => cur_coupler%next
6806) enddo
6807)
6808) end subroutine PatchCouplerInputRecord
6809)
6810) ! **************************************************************************** !
6811)
6812) subroutine PatchGetCompMassInRegion(cell_ids,num_cells,patch,option, &
6813) global_total_mass)
6814) !
6815) ! Calculates the total mass (aqueous, sorbed, and precipitated) in a region
6816) ! in units of mol.
6817) !
6818) ! Author: Jenn Frederick
6819) ! Date: 04/25/2016
6820) !
6821) use Global_Aux_module
6822) use Material_Aux_class
6823) use Reaction_Aux_module
6824) use Grid_module
6825) use Option_module
6826) use Reactive_Transport_Aux_module
6827)
6828) implicit none
6829)
6830) PetscInt, pointer :: cell_ids(:)
6831) PetscInt :: num_cells
6832) type(patch_type), pointer :: patch
6833) type(option_type), pointer :: option
6834) PetscReal :: global_total_mass ! [mol]
6835)
6836) type(global_auxvar_type), pointer :: global_auxvars(:)
6837) class(material_auxvar_type), pointer :: material_auxvars(:)
6838) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
6839) type(reaction_type), pointer :: reaction
6840) PetscReal :: aq_species_mass ! [mol]
6841) PetscReal :: sorb_species_mass ! [mol]
6842) PetscReal :: ppt_species_mass ! [mol]
6843) PetscReal :: m3_water ! [m^3-water]
6844) PetscReal :: m3_bulk ! [m^3-bulk]
6845) PetscInt :: k, j, m
6846) PetscInt :: local_id, ghosted_id
6847) PetscErrorCode :: ierr
6848) PetscReal :: local_total_mass
6849)
6850) global_auxvars => patch%aux%Global%auxvars
6851) material_auxvars => patch%aux%Material%auxvars
6852) rt_auxvars => patch%aux%RT%auxvars
6853) reaction => patch%reaction
6854) local_total_mass = 0.d0
6855) global_total_mass = 0.d0
6856)
6857) ! Loop through all cells in the region:
6858) do k = 1,num_cells
6859) local_id = cell_ids(k)
6860) ghosted_id = patch%grid%nL2G(local_id)
6861) if (patch%imat(ghosted_id) <= 0) cycle
6862) m3_water = material_auxvars(ghosted_id)%porosity * & ! [-]
6863) global_auxvars(ghosted_id)%sat(LIQUID_PHASE) * & ! [water]
6864) material_auxvars(ghosted_id)%volume ! [m^3-bulk]
6865) m3_bulk = material_auxvars(ghosted_id)%volume ! [m^3-bulk]
6866) ! Loop through aqueous and sorbed species:
6867) do j = 1,reaction%ncomp
6868) aq_species_mass = 0.d0
6869) sorb_species_mass = 0.d0
6870) ! aqueous species; units [mol/L-water]*[m^3-water]*[1000L/m^3-water]=[mol]
6871) aq_species_mass = rt_auxvars(ghosted_id)%total(j,LIQUID_PHASE) * &
6872) m3_water * 1.0d3
6873) if (associated(rt_auxvars(ghosted_id)%total_sorb_eq)) then
6874) ! sorbed species; units [mol/m^3-bulk]*[m^3-bulk]=[mol]
6875) sorb_species_mass = rt_auxvars(ghosted_id)%total_sorb_eq(j) * m3_bulk
6876) else
6877) sorb_species_mass = 0.d0
6878) endif
6879) local_total_mass = local_total_mass + aq_species_mass + &
6880) sorb_species_mass
6881) enddo
6882) ! Loop through precipitated species:
6883) do m = 1,reaction%mineral%nkinmnrl
6884) ppt_species_mass = 0.d0
6885) ! precip. species; units [m^3-mnrl/m^3-bulk]*[m^3-bulk]/[m^3-mnrl/mol-mnrl]=[mol]
6886) ppt_species_mass = rt_auxvars(ghosted_id)%mnrl_volfrac(m) * m3_bulk / &
6887) reaction%mineral%kinmnrl_molar_vol(m)
6888) local_total_mass = local_total_mass + ppt_species_mass
6889) enddo
6890) enddo ! Cell loop
6891)
6892) ! Sum the local_total_mass across all processes that own the region:
6893) call MPI_Allreduce(local_total_mass,global_total_mass,ONE_INTEGER_MPI, &
6894) MPI_DOUBLE_PRECISION,MPI_SUM,option%mycomm,ierr)
6895)
6896) end subroutine PatchGetCompMassInRegion
6897)
6898) ! **************************************************************************** !
6899)
6900) subroutine PatchGetCompMassInRegionAssign(region_list, &
6901) mass_balance_region_list,option)
6902) !
6903) ! Assigns patch%region information to the mass balance region object
6904) !
6905) ! Author: Jenn Frederick
6906) ! Date: 04/26/2016
6907) !
6908) use Output_Aux_module
6909) use Region_module
6910) use String_module
6911)
6912) implicit none
6913)
6914) type(region_list_type), pointer :: region_list
6915) type(mass_balance_region_type), pointer :: mass_balance_region_list
6916) type(option_type), pointer :: option
6917)
6918) type(region_type), pointer :: cur_region
6919) type(mass_balance_region_type), pointer :: cur_mbr
6920) PetscBool :: success
6921)
6922) cur_mbr => mass_balance_region_list
6923) do
6924) if (.not.associated(cur_mbr)) exit
6925) ! Loop through patch%region_list to find wanted region:
6926) cur_region => region_list%first
6927) do
6928) if (.not.associated(cur_region)) exit
6929) success = PETSC_TRUE
6930) if (StringCompareIgnoreCase(cur_region%name,cur_mbr%region_name)) exit
6931) success = PETSC_FALSE
6932) cur_region => cur_region%next
6933) enddo
6934) ! If the wanted region was not found, throw an error msg:
6935) if (.not.success) then
6936) option%io_buffer = 'Region ' // trim(cur_mbr%region_name) // ' not &
6937) &found among listed regions.'
6938) call printErrMsg(option)
6939) endif
6940) ! Assign the mass balance region the wanted region's info:
6941) cur_mbr%num_cells = cur_region%num_cells
6942) cur_mbr%region_cell_ids => cur_region%cell_ids
6943) ! Go to next mass balance region
6944) cur_mbr => cur_mbr%next
6945) enddo
6946)
6947) end subroutine PatchGetCompMassInRegionAssign
6948)
6949) ! ************************************************************************** !
6950)
6951) subroutine PatchDestroyList(patch_list)
6952) !
6953) ! Deallocates a patch list and array of patches
6954) !
6955) ! Author: Glenn Hammond
6956) ! Date: 10/15/07
6957) !
6958)
6959) implicit none
6960)
6961) type(patch_list_type), pointer :: patch_list
6962)
6963) type(patch_type), pointer :: cur_patch, prev_patch
6964)
6965) if (.not.associated(patch_list)) return
6966)
6967) if (associated(patch_list%array)) deallocate(patch_list%array)
6968) nullify(patch_list%array)
6969)
6970) cur_patch => patch_list%first
6971) do
6972) if (.not.associated(cur_patch)) exit
6973) prev_patch => cur_patch
6974) cur_patch => cur_patch%next
6975) call PatchDestroy(prev_patch)
6976) enddo
6977)
6978) nullify(patch_list%first)
6979) nullify(patch_list%last)
6980) patch_list%num_patch_objects = 0
6981)
6982) deallocate(patch_list)
6983) nullify(patch_list)
6984)
6985) end subroutine PatchDestroyList
6986)
6987) ! ************************************************************************** !
6988)
6989) subroutine PatchDestroy(patch)
6990) !
6991) ! Deallocates a patch object
6992) !
6993) ! Author: Glenn Hammond
6994) ! Date: 02/22/08
6995) !
6996)
6997) use Utility_module, only : DeallocateArray
6998)
6999) implicit none
7000)
7001) type(patch_type), pointer :: patch
7002)
7003) call DeallocateArray(patch%imat)
7004) call DeallocateArray(patch%imat_internal_to_external)
7005) call DeallocateArray(patch%sat_func_id)
7006) call DeallocateArray(patch%internal_velocities)
7007) call DeallocateArray(patch%boundary_velocities)
7008) call DeallocateArray(patch%internal_tran_coefs)
7009) call DeallocateArray(patch%boundary_tran_coefs)
7010) call DeallocateArray(patch%internal_flow_fluxes)
7011) call DeallocateArray(patch%boundary_flow_fluxes)
7012) call DeallocateArray(patch%ss_flow_fluxes)
7013) call DeallocateArray(patch%internal_tran_fluxes)
7014) call DeallocateArray(patch%boundary_tran_fluxes)
7015) call DeallocateArray(patch%ss_tran_fluxes)
7016) call DeallocateArray(patch%ss_flow_vol_fluxes)
7017)
7018) call DeallocateArray(patch%boundary_energy_flux)
7019)
7020)
7021) if (associated(patch%material_property_array)) &
7022) deallocate(patch%material_property_array)
7023) nullify(patch%material_property_array)
7024) ! Since this linked list will be destroyed by realization, just nullify here
7025) nullify(patch%material_properties)
7026) if (associated(patch%saturation_function_array)) &
7027) deallocate(patch%saturation_function_array)
7028) nullify(patch%saturation_function_array)
7029) ! Since this linked list will be destroyed by realization, just nullify here
7030) nullify(patch%saturation_functions)
7031) if (associated(patch%characteristic_curves_array)) &
7032) deallocate(patch%characteristic_curves_array)
7033) nullify(patch%characteristic_curves_array)
7034) ! Since this linked list will be destroyed by realization, just nullify here
7035) nullify(patch%characteristic_curves)
7036)
7037) nullify(patch%surf_field)
7038) if (associated(patch%surf_material_property_array)) &
7039) deallocate(patch%surf_material_property_array)
7040) nullify(patch%surf_material_property_array)
7041) nullify(patch%surf_material_properties)
7042)
7043) ! solely nullify grid since destroyed in discretization
7044) nullify(patch%grid)
7045) call RegionDestroyList(patch%region_list)
7046) call CouplerDestroyList(patch%boundary_condition_list)
7047) call CouplerDestroyList(patch%initial_condition_list)
7048) call CouplerDestroyList(patch%source_sink_list)
7049)
7050) call ObservationDestroyList(patch%observation_list)
7051) call IntegralFluxDestroyList(patch%integral_flux_list)
7052) call StrataDestroyList(patch%strata_list)
7053)
7054) call AuxDestroy(patch%aux)
7055) call SurfaceAuxDestroy(patch%surf_aux)
7056)
7057) ! these are solely pointers, must not destroy.
7058) nullify(patch%reaction)
7059) nullify(patch%datasets)
7060) nullify(patch%field)
7061)
7062) deallocate(patch)
7063) nullify(patch)
7064)
7065) end subroutine PatchDestroy
7066)
7067) end module Patch_module