surface_global.F90 coverage: 28.57 %func 42.75 %block
1) module Surface_Global_module
2)
3) use Surface_Global_Aux_module
4)
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12)
13) public SurfaceGlobalSetup, &
14) SurfaceGlobalSetAuxVarScalar, &
15) SurfaceGlobalSetAuxVarVecLoc, &
16) SurfaceGlobalUpdateAuxVars
17)
18) contains
19)
20) ! ************************************************************************** !
21)
22) subroutine SurfaceGlobalSetup(surf_realization)
23) !
24) ! This routine
25) !
26) ! Author: Gautam Bisht, LBNL
27) ! Date: 03/07/13
28) !
29)
30) use Realization_Surface_class
31) use Patch_module
32)
33) implicit none
34)
35) class(realization_surface_type) :: surf_realization
36)
37) type(patch_type), pointer :: cur_patch
38)
39) cur_patch => surf_realization%patch_list%first
40) do
41) if (.not.associated(cur_patch)) exit
42) surf_realization%patch => cur_patch
43) call SurfaceGlobalSetupPatch(surf_realization)
44) cur_patch => cur_patch%next
45) enddo
46)
47) end subroutine SurfaceGlobalSetup
48)
49) ! ************************************************************************** !
50)
51) subroutine SurfaceGlobalSetupPatch(surf_realization)
52) !
53) ! This routine
54) !
55) ! Author: Gautam Bisht, LBNL
56) ! Date: 03/07/13
57) !
58)
59) use Realization_Surface_class
60) use Patch_module
61) use Option_module
62) use Coupler_module
63) use Connection_module
64) use Grid_module
65)
66) implicit none
67)
68) class(realization_surface_type) :: surf_realization
69)
70) type(option_type), pointer :: option
71) type(patch_type),pointer :: patch
72) type(grid_type), pointer :: grid
73) type(coupler_type), pointer :: boundary_condition
74) type(coupler_type), pointer :: source_sink
75)
76) PetscInt :: ghosted_id, iconn, sum_connection
77) type(surface_global_auxvar_type), pointer :: auxvars(:)
78) type(surface_global_auxvar_type), pointer :: auxvars_bc(:)
79) type(surface_global_auxvar_type), pointer :: auxvars_ss(:)
80)
81) option => surf_realization%option
82) patch => surf_realization%patch
83) grid => patch%grid
84)
85) patch%surf_aux%SurfaceGlobal => SurfaceGlobalAuxCreate()
86)
87) ! allocate auxvar data structures for all grid cells
88) #ifdef COMPUTE_INTERNAL_MASS_FLUX
89) option%iflag = 1 ! allocate mass_balance array
90) #else
91) option%iflag = 0 ! be sure not to allocate mass_balance array
92) #endif
93) allocate(auxvars(grid%ngmax))
94) do ghosted_id = 1, grid%ngmax
95) call SurfaceGlobalAuxVarInit(auxvars(ghosted_id),option)
96) enddo
97) patch%surf_aux%SurfaceGlobal%auxvars => auxvars
98) patch%surf_aux%SurfaceGlobal%num_aux = grid%ngmax
99)
100) ! count the number of boundary connections and allocate
101) ! auxvar data structures for them
102) boundary_condition => patch%boundary_condition_list%first
103) sum_connection = 0
104) do
105) if (.not.associated(boundary_condition)) exit
106) sum_connection = sum_connection + &
107) boundary_condition%connection_set%num_connections
108) boundary_condition => boundary_condition%next
109) enddo
110)
111) if (sum_connection > 0) then
112) option%iflag = 1 ! enable allocation of mass_balance array
113) allocate(auxvars_bc(sum_connection))
114) do iconn = 1, sum_connection
115) call SurfaceGlobalAuxVarInit(auxvars_bc(iconn),option)
116) enddo
117) patch%surf_aux%SurfaceGlobal%auxvars_bc => auxvars_bc
118) endif
119) patch%surf_aux%SurfaceGlobal%num_aux_bc = sum_connection
120)
121) ! count the number of source/sink connections and allocate
122) ! auxvar data structures for them
123) source_sink => patch%source_sink_list%first
124) sum_connection = 0
125) do
126) if (.not.associated(source_sink)) exit
127) sum_connection = sum_connection + &
128) source_sink%connection_set%num_connections
129) source_sink => source_sink%next
130) enddo
131)
132) if (sum_connection > 0) then
133) option%iflag = 1 ! enable allocation of mass_balance array
134) allocate(auxvars_ss(sum_connection))
135) do iconn = 1, sum_connection
136) call SurfaceGlobalAuxVarInit(auxvars_ss(iconn),option)
137) enddo
138) patch%surf_aux%SurfaceGlobal%auxvars_ss => auxvars_ss
139) endif
140) patch%surf_aux%SurfaceGlobal%num_aux_ss = sum_connection
141)
142) option%iflag = 0
143)
144) end subroutine SurfaceGlobalSetupPatch
145)
146) ! ************************************************************************** !
147)
148) subroutine SurfaceGlobalSetAuxVarScalar(surf_realization,value,ivar)
149) !
150) ! This routine
151) !
152) ! Author: Gautam Bisht, LBNL
153) ! Date: 03/07/13
154) !
155)
156) use Realization_Surface_class
157) use Patch_module
158)
159) implicit none
160)
161) class(realization_surface_type) :: surf_realization
162) PetscReal :: value
163) PetscInt :: ivar
164)
165) type(patch_type), pointer :: cur_patch
166)
167) cur_patch => surf_realization%patch_list%first
168) do
169) if (.not.associated(cur_patch)) exit
170) surf_realization%patch => cur_patch
171) call SurfaceGlobalSetAuxVarScalarPatch(surf_realization,value,ivar)
172) cur_patch => cur_patch%next
173) enddo
174)
175) end subroutine SurfaceGlobalSetAuxVarScalar
176)
177) ! ************************************************************************** !
178)
179) subroutine SurfaceGlobalSetAuxVarScalarPatch(surf_realization,value,ivar)
180)
181) use Realization_Surface_class
182) use Option_module
183) use Patch_module
184) use Variables_module, only : SURFACE_LIQUID_HEAD, &
185) SURFACE_LIQUID_TEMPERATURE, &
186) SURFACE_LIQUID_DENSITY
187)
188) implicit none
189)
190) class(realization_surface_type) :: surf_realization
191) PetscReal :: value
192) PetscInt :: ivar
193)
194) type(option_type), pointer :: option
195) type(patch_type), pointer :: patch
196)
197) PetscInt :: i
198)
199) patch => surf_realization%patch
200) option => surf_realization%option
201)
202) select case(ivar)
203) case(SURFACE_LIQUID_HEAD)
204) do i=1, patch%surf_aux%SurfaceGlobal%num_aux
205) patch%surf_aux%SurfaceGlobal%auxvars(i)%head = value
206) enddo
207) do i=1, patch%surf_aux%SurfaceGlobal%num_aux_bc
208) patch%surf_aux%SurfaceGlobal%auxvars_bc(i)%head = value
209) enddo
210) case(SURFACE_LIQUID_TEMPERATURE)
211) do i=1, patch%surf_aux%SurfaceGlobal%num_aux
212) patch%surf_aux%SurfaceGlobal%auxvars(i)%temp = value
213) enddo
214) do i=1, patch%surf_aux%SurfaceGlobal%num_aux_bc
215) patch%surf_aux%SurfaceGlobal%auxvars_bc(i)%temp = value
216) enddo
217) case(SURFACE_LIQUID_DENSITY)
218) do i=1, patch%surf_aux%SurfaceGlobal%num_aux
219) patch%surf_aux%SurfaceGlobal%auxvars(i)%den_kg(option%liquid_phase) = value
220) enddo
221) do i=1, surf_realization%patch%surf_aux%SurfaceGlobal%num_aux_bc
222) patch%surf_aux%SurfaceGlobal%auxvars_bc(i)%den_kg(option%liquid_phase) = value
223) enddo
224) end select
225)
226) end subroutine SurfaceGlobalSetAuxVarScalarPatch
227)
228) ! ************************************************************************** !
229)
230) subroutine SurfaceGlobalSetAuxVarVecLoc(surf_realization,vec_loc,ivar,isubvar)
231) !
232) ! This routine
233) !
234) ! Author: Gautam Bisht, LBNL
235) ! Date: 03/07/13
236) !
237)
238) use Realization_Surface_class
239) use Patch_module
240)
241) implicit none
242)
243) #include "petsc/finclude/petscvec.h"
244) #include "petsc/finclude/petscvec.h90"
245)
246) class(realization_surface_type) :: surf_realization
247) Vec :: vec_loc
248) PetscInt :: ivar
249) PetscInt :: isubvar
250)
251) type(patch_type), pointer :: cur_patch
252)
253) cur_patch => surf_realization%patch_list%first
254) do
255) if (.not.associated(cur_patch)) exit
256) surf_realization%patch => cur_patch
257) call SurfaceGlobalSetAuxVarVecLocPatch(surf_realization,vec_loc,ivar,isubvar)
258) cur_patch => cur_patch%next
259) enddo
260)
261) end subroutine SurfaceGlobalSetAuxVarVecLoc
262)
263) ! ************************************************************************** !
264)
265) subroutine SurfaceGlobalSetAuxVarVecLocPatch(surf_realization,vec_loc,ivar,isubvar)
266) !
267) ! This routine
268) !
269) ! Author: Gautam Bisht, LBNL
270) ! Date: 03/07/13
271) !
272)
273) use Realization_Surface_class
274) use Patch_module
275) use Grid_module
276) use Option_module
277) use Variables_module, only : SURFACE_LIQUID_HEAD, &
278) SURFACE_LIQUID_TEMPERATURE, &
279) SURFACE_LIQUID_DENSITY
280)
281) implicit none
282)
283) #include "petsc/finclude/petscvec.h"
284) #include "petsc/finclude/petscvec.h90"
285)
286) class(realization_surface_type) :: surf_realization
287) Vec :: vec_loc
288) PetscInt :: ivar
289) PetscInt :: isubvar
290)
291) type(option_type), pointer :: option
292) type(patch_type), pointer :: patch
293) type(grid_type), pointer :: grid
294)
295) PetscInt :: ghosted_id
296) PetscReal, pointer :: vec_loc_p(:)
297) PetscErrorCode :: ierr
298)
299) patch => surf_realization%patch
300) grid => patch%grid
301) option => surf_realization%option
302)
303) call VecGetArrayF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
304)
305) select case(ivar)
306) case(SURFACE_LIQUID_HEAD)
307) select case(isubvar)
308) case default
309) do ghosted_id=1, grid%ngmax
310) patch%surf_aux%SurfaceGlobal%auxvars(ghosted_id)%head(option%liquid_phase) &
311) = vec_loc_p(ghosted_id)
312) enddo
313) end select
314) case(SURFACE_LIQUID_TEMPERATURE)
315) select case(isubvar)
316) case default
317) do ghosted_id=1, grid%ngmax
318) patch%surf_aux%SurfaceGlobal%auxvars(ghosted_id)%temp = vec_loc_p(ghosted_id)
319) enddo
320) end select
321) case(SURFACE_LIQUID_DENSITY)
322) select case(isubvar)
323) case default
324) do ghosted_id=1, grid%ngmax
325) patch%surf_aux%SurfaceGlobal%auxvars(ghosted_id)%den_kg(option%liquid_phase) &
326) = vec_loc_p(ghosted_id)
327) enddo
328) end select
329) end select
330)
331) call VecRestoreArrayF90(vec_loc,vec_loc_p,ierr);CHKERRQ(ierr)
332)
333) end subroutine SurfaceGlobalSetAuxVarVecLocPatch
334)
335) ! ************************************************************************** !
336)
337) subroutine SurfaceGlobalUpdateAuxVars(surf_realization,time_level)
338) !
339) ! This routine
340) !
341) ! Author: Gautam Bisht, LBNL
342) ! Date: 03/07/13
343) !
344)
345) use Realization_Surface_class
346) use Surface_Field_module
347) use Option_module
348) use Discretization_module
349) use Variables_module, only : SURFACE_LIQUID_HEAD, &
350) SURFACE_LIQUID_TEMPERATURE, &
351) LIQUID_DENSITY
352)
353) class(realization_surface_type) :: surf_realization
354) PetscInt :: time_level
355)
356) type(surface_field_type), pointer :: surf_field
357) type(option_type), pointer :: option
358)
359) option => surf_realization%option
360) surf_field => surf_realization%surf_field
361)
362) ! liquid density
363) call RealizSurfGetVariable(surf_realization,surf_field%work,LIQUID_DENSITY, &
364) ZERO_INTEGER)
365) call DiscretizationGlobalToLocal(surf_realization%discretization, &
366) surf_field%work,surf_field%work_loc,ONEDOF)
367) call SurfaceGlobalSetAuxVarVecLoc(surf_realization,surf_field%work_loc, &
368) LIQUID_DENSITY,time_level)
369)
370) select case(option%iflowmode)
371) case(TH_MODE)
372) ! head
373) call RealizSurfGetVariable(surf_realization,surf_field%work, &
374) SURFACE_LIQUID_HEAD,ZERO_INTEGER)
375) call DiscretizationGlobalToLocal(surf_realization%discretization, &
376) surf_field%work,surf_field%work_loc,ONEDOF)
377) call SurfaceGlobalSetAuxVarVecLoc(surf_realization,surf_field%work_loc, &
378) SURFACE_LIQUID_HEAD,time_level)
379)
380) ! temperature
381) call RealizSurfGetVariable(surf_realization,surf_field%work, &
382) SURFACE_LIQUID_TEMPERATURE, ZERO_INTEGER)
383) call DiscretizationGlobalToLocal(surf_realization%discretization, &
384) surf_field%work,surf_field%work_loc,ONEDOF)
385) call SurfaceGlobalSetAuxVarVecLoc(surf_realization,surf_field%work_loc, &
386) SURFACE_LIQUID_TEMPERATURE,time_level)
387)
388)
389) end select
390)
391) end subroutine SurfaceGlobalUpdateAuxVars
392)
393) end module Surface_Global_module