surface_th.F90 coverage: 86.67 %func 64.48 %block
1) module Surface_TH_module
2)
3) use Surface_Global_Aux_module
4) use Surface_TH_Aux_module
5)
6) use PFLOTRAN_Constants_module
7)
8) implicit none
9)
10) private
11)
12) #include "petsc/finclude/petscsys.h"
13)
14) #include "petsc/finclude/petscvec.h"
15) #include "petsc/finclude/petscvec.h90"
16) #include "petsc/finclude/petscmat.h"
17) #include "petsc/finclude/petscmat.h90"
18) #include "petsc/finclude/petscsnes.h"
19) #include "petsc/finclude/petscviewer.h"
20) #include "petsc/finclude/petsclog.h"
21) #include "petsc/finclude/petscts.h"
22)
23) ! Cutoff parameters
24) PetscReal, parameter :: eps = 1.D-12
25) PetscReal, parameter :: perturbation_tolerance = 1.d-6
26)
27) public SurfaceTHSetup, &
28) SurfaceTHRHSFunction, &
29) SurfaceTHIFunction, &
30) SurfaceTHComputeMaxDt, &
31) SurfaceTHUpdateAuxVars, &
32) SurfaceTHUpdateSolution, &
33) SurfaceTHUpdateTemperature, &
34) SurfaceTHUpdateSurfState, &
35) SurfaceTHImplicitAtmForcing, &
36) SurfaceTHDestroy
37)
38) contains
39)
40) ! ************************************************************************** !
41)
42) subroutine SurfaceTHSetup(surf_realization)
43) !
44) ! This routine sets up surface_TH_type
45) !
46) ! Author: Gautam Bisht, LBNL
47) ! Date: 02/28/13
48) !
49)
50) use Realization_Surface_class
51) use Patch_module
52) use Option_module
53) use Grid_module
54) use Region_module
55) use Coupler_module
56) use Connection_module
57) use Fluid_module
58) use Output_Aux_module
59)
60) implicit none
61)
62) class(realization_surface_type) :: surf_realization
63)
64) type(option_type), pointer :: option
65) type(patch_type), pointer :: patch
66) type(grid_type), pointer :: grid
67) type(coupler_type), pointer :: boundary_condition
68) type(Surface_TH_auxvar_type), pointer :: Surf_TH_auxvars(:)
69) type(Surface_TH_auxvar_type), pointer :: Surf_TH_auxvars_bc(:)
70) type(Surface_TH_auxvar_type), pointer :: Surf_TH_auxvars_ss(:)
71) type(fluid_property_type), pointer :: cur_fluid_property
72) type(coupler_type), pointer :: initial_condition
73) type(output_variable_list_type), pointer :: list
74) PetscReal :: area_per_vol
75)
76) PetscInt :: ghosted_id, iconn, sum_connection
77) PetscInt :: i, iphase
78)
79) option => surf_realization%option
80) patch => surf_realization%patch
81) grid => patch%grid
82)
83) patch%surf_aux%SurfaceTH => SurfaceTHAuxCreate(option)
84)
85) ! allocate auxvar data structures for all grid cells
86) allocate(Surf_TH_auxvars(grid%ngmax))
87) do ghosted_id = 1, grid%ngmax
88) call SurfaceTHAuxVarInit(Surf_TH_auxvars(ghosted_id),option)
89) enddo
90)
91) patch%surf_aux%SurfaceTH%auxvars => Surf_TH_auxvars
92) patch%surf_aux%SurfaceTH%num_aux = grid%ngmax
93)
94) ! count the number of boundary connections and allocate
95) ! auxvar data structures for them
96) boundary_condition => patch%boundary_condition_list%first
97)
98) sum_connection = 0
99) do
100) if (.not.associated(boundary_condition)) exit
101) sum_connection = sum_connection + &
102) boundary_condition%connection_set%num_connections
103) boundary_condition => boundary_condition%next
104) enddo
105)
106) if (sum_connection > 0) then
107) allocate(Surf_TH_auxvars_bc(sum_connection))
108) do iconn = 1, sum_connection
109) call SurfaceTHAuxVarInit(Surf_TH_auxvars_bc(iconn),option)
110) enddo
111) patch%surf_aux%SurfaceTH%auxvars_bc => Surf_TH_auxvars_bc
112) endif
113) patch%surf_aux%SurfaceTH%num_aux_bc = sum_connection
114)
115) ! Create aux vars for source/sink
116) sum_connection = CouplerGetNumConnectionsInList(patch%source_sink_list)
117) if (sum_connection > 0) then
118) allocate(Surf_TH_auxvars_ss(sum_connection))
119) do iconn = 1, sum_connection
120) call SurfaceTHAuxVarInit(Surf_TH_auxvars_ss(iconn),option)
121) enddo
122) patch%surf_aux%SurfaceTH%auxvars_ss => Surf_TH_auxvars_ss
123) endif
124) patch%surf_aux%SurfaceTH%num_aux_ss = sum_connection
125)
126) list => surf_realization%output_option%output_snap_variable_list
127) call SurfaceTHSetPlotVariables(list)
128) list => surf_realization%output_option%output_obs_variable_list
129) call SurfaceTHSetPlotVariables(list)
130)
131) end subroutine SurfaceTHSetup
132)
133) ! ************************************************************************** !
134)
135) subroutine SurfaceTHSetPlotVariables(list)
136) !
137) ! This routine adds default variables to be printed to list
138) !
139) ! Author: Gautam Bisht, LBNL
140) ! Date: 02/28/13
141) !
142)
143) use Realization_Surface_class
144) use Output_Aux_module
145) use Variables_module
146)
147) implicit none
148)
149) type(output_variable_list_type), pointer :: list
150)
151) character(len=MAXWORDLENGTH) :: name, units
152)
153) if (associated(list%first)) then
154) return
155) endif
156)
157) name = 'H'
158) units = 'm'
159) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
160) SURFACE_LIQUID_HEAD)
161)
162) name = 'Temperature'
163) units = 'C'
164) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
165) SURFACE_LIQUID_TEMPERATURE)
166)
167) name = 'Material ID'
168) units = ''
169) call OutputVariableAddToList(list,name,OUTPUT_DISCRETE,units, &
170) MATERIAL_ID)
171)
172) end subroutine SurfaceTHSetPlotVariables
173)
174) ! ************************************************************************** !
175)
176) subroutine SurfaceTHRHSFunction(ts,t,xx,ff,surf_realization,ierr)
177) !
178) ! This routine provides the function evaluation for PETSc TSSolve()
179) ! Author: Gautam Bisht, LBNL
180) !
181)
182) use EOS_Water_module
183) use Connection_module
184) use Realization_Surface_class
185) use Discretization_module
186) use Patch_module
187) use Grid_module
188) use Option_module
189) use Coupler_module
190) use Surface_Field_module
191) use Debug_module
192) use Surface_TH_Aux_module
193) use Surface_Global_Aux_module
194)
195) implicit none
196)
197) TS :: ts
198) PetscReal :: t
199) Vec :: xx
200) Vec :: ff
201) class(realization_surface_type) :: surf_realization
202) PetscErrorCode :: ierr
203)
204) type(grid_type), pointer :: grid
205) type(patch_type), pointer :: patch
206) type(option_type), pointer :: option
207) type(surface_field_type), pointer :: surf_field
208) type(coupler_type), pointer :: boundary_condition
209) type(coupler_type), pointer :: source_sink
210) type(connection_set_list_type), pointer :: connection_set_list
211) type(connection_set_type), pointer :: cur_connection_set
212)
213) type(Surface_TH_auxvar_type), pointer :: surf_auxvars(:)
214) type(Surface_TH_auxvar_type), pointer :: surf_auxvars_bc(:)
215) type(surface_global_auxvar_type), pointer :: surf_global_auxvars(:)
216) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_bc(:)
217) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_ss(:)
218)
219) PetscInt :: local_id_up, local_id_dn, local_id
220) PetscInt :: ghosted_id_up, ghosted_id_dn, ghosted_id
221) PetscInt :: iconn
222) PetscInt :: sum_connection
223) PetscInt :: istart, iend
224)
225) PetscReal :: dx, dy, dz
226) PetscReal :: dist
227) PetscReal :: vel
228) PetscReal :: slope, slope_dn
229) PetscReal :: rho ! density [kg/m^3]
230) PetscReal :: hw_up, hw_dn ! water height [m]
231) PetscReal :: Res(surf_realization%option%nflowdof), v_darcy
232) PetscReal :: qsrc, qsrc_flow
233) PetscReal :: esrc
234) PetscReal :: den
235) PetscReal :: dum1
236)
237) PetscViewer :: viewer
238) character(len=MAXSTRINGLENGTH) :: string,string2
239)
240) PetscReal, pointer :: ff_p(:), mannings_loc_p(:),area_p(:)
241) PetscReal, pointer :: xc(:),yc(:),zc(:)
242)
243) patch => surf_realization%patch
244) grid => patch%grid
245) option => surf_realization%option
246) surf_field => surf_realization%surf_field
247)
248) surf_auxvars => patch%surf_aux%SurfaceTH%auxvars
249) surf_auxvars_bc => patch%surf_aux%SurfaceTH%auxvars_bc
250) surf_global_auxvars => patch%surf_aux%SurfaceGlobal%auxvars
251) surf_global_auxvars_bc => patch%surf_aux%SurfaceGlobal%auxvars_bc
252) surf_global_auxvars_ss => patch%surf_aux%SurfaceGlobal%auxvars_ss
253)
254) surf_realization%iter_count = surf_realization%iter_count+1
255) if (surf_realization%iter_count < 10) then
256) write(string2,'("00",i1)') surf_realization%iter_count
257) else if (surf_realization%iter_count < 100) then
258) write(string2,'("0",i2)') surf_realization%iter_count
259) else if (surf_realization%iter_count < 1000) then
260) write(string2,'(i3)') surf_realization%iter_count
261) else if (surf_realization%iter_count < 10000) then
262) write(string2,'(i4)') surf_realization%iter_count
263) endif
264)
265) ! First, update the solution vector
266) call DiscretizationGlobalToLocal(surf_realization%discretization, &
267) xx,surf_field%flow_xx_loc,NFLOWDOF)
268)
269) ! Then, update the aux vars
270) ! RTM: This includes calculation of the accumulation terms, correct?
271) call SurfaceTHUpdateTemperature(surf_realization)
272) call SurfaceTHUpdateAuxVars(surf_realization)
273) ! override flags since they will soon be out of date
274) patch%surf_aux%SurfaceTH%auxvars_up_to_date = PETSC_FALSE
275)
276) call VecGetArrayF90(ff,ff_p, ierr);CHKERRQ(ierr)
277) call VecGetArrayF90(surf_field%mannings_loc,mannings_loc_p, &
278) ierr);CHKERRQ(ierr)
279) call VecGetArrayF90(surf_field%area,area_p,ierr);CHKERRQ(ierr)
280)
281) ff_p = 0.d0
282) Res = 0.d0
283)
284) xc => surf_realization%discretization%grid%x
285) yc => surf_realization%discretization%grid%y
286) zc => surf_realization%discretization%grid%z
287)
288) ! Interior Flux Terms -----------------------------------
289) connection_set_list => grid%internal_connection_set_list
290) cur_connection_set => connection_set_list%first
291) sum_connection = 0
292) do
293) if (.not.associated(cur_connection_set)) exit
294) do iconn = 1, cur_connection_set%num_connections
295) sum_connection = sum_connection + 1
296)
297) ghosted_id_up = cur_connection_set%id_up(iconn)
298) ghosted_id_dn = cur_connection_set%id_dn(iconn)
299)
300) local_id_up = grid%nG2L(ghosted_id_up)
301) local_id_dn = grid%nG2L(ghosted_id_dn)
302)
303) dx = xc(ghosted_id_dn) - xc(ghosted_id_up)
304) dy = yc(ghosted_id_dn) - yc(ghosted_id_up)
305) dz = zc(ghosted_id_dn) - zc(ghosted_id_up)
306) dist = sqrt(dx*dx + dy*dy + dz*dz)
307) slope = dz/dist
308)
309) call SurfaceTHFlux(surf_auxvars(ghosted_id_up), &
310) surf_global_auxvars(ghosted_id_up), &
311) zc(ghosted_id_up), &
312) mannings_loc_p(ghosted_id_up), &
313) surf_auxvars(ghosted_id_dn), &
314) surf_global_auxvars(ghosted_id_dn), &
315) zc(ghosted_id_dn), &
316) mannings_loc_p(ghosted_id_dn), &
317) dist, cur_connection_set%area(iconn), &
318) option,vel,dum1,Res)
319)
320) patch%internal_velocities(1,sum_connection) = vel
321) patch%internal_flow_fluxes(:,sum_connection) = Res(:)
322)
323) if (local_id_up>0) then
324) iend = local_id_up*option%nflowdof
325) istart = iend-option%nflowdof+1
326) ff_p(istart:iend) = ff_p(istart:iend) - Res(:)/area_p(local_id_up)
327) endif
328)
329) if (local_id_dn>0) then
330) iend = local_id_dn*option%nflowdof
331) istart = iend-option%nflowdof+1
332) ff_p(istart:iend) = ff_p(istart:iend) + Res(:)/area_p(local_id_dn)
333) endif
334)
335) enddo
336) cur_connection_set => cur_connection_set%next
337) enddo
338)
339) ! Boundary Flux Terms -----------------------------------
340) boundary_condition => patch%boundary_condition_list%first
341) sum_connection = 0
342) do
343) if (.not.associated(boundary_condition)) exit
344)
345) cur_connection_set => boundary_condition%connection_set
346)
347) do iconn = 1, cur_connection_set%num_connections
348) sum_connection = sum_connection + 1
349)
350) local_id_dn = cur_connection_set%id_dn(iconn)
351) ghosted_id_dn = grid%nL2G(local_id_dn)
352)
353) dx = xc(ghosted_id_dn) - cur_connection_set%intercp(1,iconn)
354) dy = yc(ghosted_id_dn) - cur_connection_set%intercp(2,iconn)
355) dz = zc(ghosted_id_dn) - cur_connection_set%intercp(3,iconn)
356) dist = sqrt(dx*dx + dy*dy + dz*dz)
357) slope_dn = dz/sqrt(dx*dx + dy*dy + dz*dz)
358)
359) call SurfaceTHBCFlux(boundary_condition%flow_condition%itype, &
360) boundary_condition%flow_aux_real_var(:,iconn), &
361) surf_auxvars_bc(sum_connection), &
362) surf_global_auxvars_bc(sum_connection), &
363) surf_auxvars(ghosted_id_dn), &
364) surf_global_auxvars(ghosted_id_dn), &
365) slope_dn, &
366) mannings_loc_p(ghosted_id_dn), &
367) dist, &
368) cur_connection_set%area(iconn), &
369) option,vel,dum1,Res)
370)
371) patch%boundary_velocities(1,sum_connection) = vel
372) patch%boundary_flow_fluxes(:,sum_connection) = Res(:)
373)
374) iend = local_id_dn*option%nflowdof
375) istart = iend-option%nflowdof+1
376) ff_p(istart:iend) = ff_p(istart:iend) + Res(:)/area_p(local_id_dn)
377) enddo
378) boundary_condition => boundary_condition%next
379) enddo
380)
381) ! Source/sink terms -------------------------------------
382) source_sink => patch%source_sink_list%first
383) sum_connection = 0
384) do
385) if (.not.associated(source_sink)) exit
386)
387) if (source_sink%flow_condition%rate%itype/=HET_VOL_RATE_SS.and. &
388) source_sink%flow_condition%rate%itype/=HET_MASS_RATE_SS) &
389) qsrc_flow = source_sink%flow_condition%rate%dataset%rarray(1)
390)
391) if (source_sink%flow_condition%rate%itype == ENERGY_RATE_SS) &
392) esrc = source_sink%flow_condition%energy_rate%dataset%rarray(1)
393)
394) cur_connection_set => source_sink%connection_set
395)
396) do iconn = 1, cur_connection_set%num_connections
397) sum_connection = sum_connection + 1
398) local_id = cur_connection_set%id_dn(iconn)
399) ghosted_id = grid%nL2G(local_id)
400) if (patch%imat(ghosted_id) <= 0) cycle
401)
402) select case(source_sink%flow_condition%rate%itype)
403) case(VOLUMETRIC_RATE_SS) ! assume local density for now
404) ! qsrc = m^3/sec
405) qsrc = qsrc_flow*area_p(local_id)
406) case(HET_VOL_RATE_SS)
407) ! qsrc = m^3/sec
408) qsrc = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)*area_p(local_id)
409) case default
410) option%io_buffer = 'Source/Sink flow condition type not recognized'
411) call printErrMsg(option)
412) end select
413)
414) esrc = 0.d0
415) select case(source_sink%flow_condition%itype(TH_TEMPERATURE_DOF))
416) case (ENERGY_RATE_SS)
417) esrc = source_sink%flow_condition%energy_rate%dataset%rarray(1)
418) case (HET_ENERGY_RATE_SS)
419) esrc = source_sink%flow_aux_real_var(TWO_INTEGER,iconn)
420) end select
421)
422) iend = local_id*option%nflowdof
423) istart = iend-option%nflowdof+1
424)
425) ff_p(istart) = ff_p(istart) + qsrc/area_p(local_id)
426) ! RTM: TODO: What should the density term and specific heat capactiy be
427) ! in the freezing case?
428) ! I think using the weighted average of liquid and ice densities and Cwi
429) ! is correct here, but I should check.
430) ff_p(iend) = ff_p(iend) + esrc + &
431) surf_global_auxvars_ss(sum_connection)%den_kg(1)* &
432) (surf_global_auxvars_ss(sum_connection)%temp + 273.15d0)* &
433) surf_auxvars(local_id)%Cwi* &
434) qsrc/area_p(local_id)
435) enddo
436) source_sink => source_sink%next
437) enddo
438)
439) call VecRestoreArrayF90(ff,ff_p, ierr);CHKERRQ(ierr)
440) call VecRestoreArrayF90(surf_field%mannings_loc,mannings_loc_p, &
441) ierr);CHKERRQ(ierr)
442) call VecRestoreArrayF90(surf_field%area,area_p,ierr);CHKERRQ(ierr)
443)
444) if (surf_realization%debug%vecview_solution) then
445) string = 'Surf_xx_' // trim(adjustl(string2)) // '.bin'
446) call PetscViewerBinaryOpen(surf_realization%option%mycomm,string, &
447) FILE_MODE_WRITE,viewer,ierr);CHKERRQ(ierr)
448) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
449) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
450)
451) string = 'Surf_ff_' // trim(adjustl(string2)) // '.bin'
452) call PetscViewerBinaryOpen(surf_realization%option%mycomm,string, &
453) FILE_MODE_WRITE,viewer,ierr);CHKERRQ(ierr)
454) call VecView(ff,viewer,ierr);CHKERRQ(ierr)
455) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
456) endif
457)
458) end subroutine SurfaceTHRHSFunction
459)
460) ! ************************************************************************** !
461)
462) subroutine SurfaceTHIFunction(ts,t,xx,xxdot,ff,surf_realization,ierr)
463) !
464) ! This routine provides the implicit function evaluation for PETSc TSSolve()
465) ! Author: Nathan Collier, ORNL
466) !
467)
468) use EOS_Water_module
469) use Connection_module
470) use Realization_Surface_class
471) use Discretization_module
472) use Patch_module
473) use Grid_module
474) use Option_module
475) use Coupler_module
476) use Surface_Field_module
477) use Debug_module
478) use Surface_TH_Aux_module
479) use Surface_Global_Aux_module
480)
481) implicit none
482)
483) TS :: ts
484) PetscReal :: t
485) Vec :: xx,xxdot
486) Vec :: ff
487) class(realization_surface_type) :: surf_realization
488) PetscErrorCode :: ierr
489)
490) ! Our equations are in the form:
491) ! xxdot = RHS(xx)
492) ! or in residual form:
493) ! ff = xxdot - RHS(xx)
494)
495) ! First we call RHS function: ff = RHS(xx)
496) call SurfaceTHRHSFunction(ts,t,xx,ff,surf_realization,ierr);CHKERRQ(ierr)
497) ! negate: RHS(xx) = -RHS(xx)
498) call VecScale(ff,-1.d0,ierr);CHKERRQ(ierr)
499) ! and finally: ff += xxdot
500) call VecAYPX(ff,1.d0,xxdot,ierr);CHKERRQ(ierr)
501)
502) end subroutine SurfaceTHIFunction
503)
504) ! ************************************************************************** !
505)
506) subroutine SurfaceTHComputeMaxDt(surf_realization,max_allowable_dt)
507) !
508) ! This routine maximum allowable 'dt' for explicit time scheme.
509) ! Author: Gautam Bisht, LBNL
510) !
511)
512) use EOS_Water_module
513) use Connection_module
514) use Realization_Surface_class
515) use Patch_module
516) use Grid_module
517) use Option_module
518) use Coupler_module
519) use Surface_Field_module
520) use Debug_module
521) use Surface_TH_Aux_module
522) use Surface_Global_Aux_module
523)
524) implicit none
525)
526) class(realization_surface_type) :: surf_realization
527) PetscErrorCode :: ierr
528)
529) type(grid_type), pointer :: grid
530) type(patch_type), pointer :: patch
531) type(option_type), pointer :: option
532) type(surface_field_type), pointer :: surf_field
533) type(coupler_type), pointer :: boundary_condition
534) type(connection_set_list_type), pointer :: connection_set_list
535) type(connection_set_type), pointer :: cur_connection_set
536)
537) type(Surface_TH_auxvar_type), pointer :: surf_auxvars(:)
538) type(Surface_TH_auxvar_type), pointer :: surf_auxvars_bc(:)
539) type(surface_global_auxvar_type), pointer :: surf_global_auxvars(:)
540) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_bc(:)
541)
542) PetscInt :: local_id_up, local_id_dn
543) PetscInt :: ghosted_id_up, ghosted_id_dn
544) PetscInt :: iconn
545) PetscInt :: sum_connection
546) #ifdef SURFACE_TH_DEBUG
547) PetscInt :: max_connection,max_iconn
548) #endif
549)
550) PetscReal :: dx, dy, dz
551) PetscReal :: dist
552) PetscReal :: vel
553) PetscReal :: slope, slope_dn
554) PetscReal :: hw_up, hw_dn ! water height [m]
555) PetscReal :: Res(surf_realization%option%nflowdof), v_darcy
556) PetscReal :: max_allowable_dt
557) PetscReal :: dt
558)
559) PetscReal, pointer :: mannings_loc_p(:),area_p(:)
560) PetscReal, pointer :: xc(:),yc(:),zc(:)
561)
562) patch => surf_realization%patch
563) grid => patch%grid
564) option => surf_realization%option
565) surf_field => surf_realization%surf_field
566)
567) surf_auxvars => patch%surf_aux%SurfaceTH%auxvars
568) surf_auxvars_bc => patch%surf_aux%SurfaceTH%auxvars_bc
569) surf_global_auxvars => patch%surf_aux%SurfaceGlobal%auxvars
570) surf_global_auxvars_bc => patch%surf_aux%SurfaceGlobal%auxvars_bc
571)
572) call VecGetArrayF90(surf_field%mannings_loc,mannings_loc_p, &
573) ierr);CHKERRQ(ierr)
574) call VecGetArrayF90(surf_field%area,area_p,ierr);CHKERRQ(ierr)
575)
576) Res = 0.d0
577) max_allowable_dt = 1.d10
578) vel = 0.d0
579)
580) xc => surf_realization%discretization%grid%x
581) yc => surf_realization%discretization%grid%y
582) zc => surf_realization%discretization%grid%z
583)
584) ! Interior Flux Terms -----------------------------------
585) connection_set_list => grid%internal_connection_set_list
586) cur_connection_set => connection_set_list%first
587) sum_connection = 0
588) #ifdef SURFACE_TH_DEBUG
589) max_connection = -1
590) max_iconn = -1
591) #endif
592) do
593) if (.not.associated(cur_connection_set)) exit
594) do iconn = 1, cur_connection_set%num_connections
595) sum_connection = sum_connection + 1
596)
597) ghosted_id_up = cur_connection_set%id_up(iconn)
598) ghosted_id_dn = cur_connection_set%id_dn(iconn)
599)
600) local_id_up = grid%nG2L(ghosted_id_up)
601) local_id_dn = grid%nG2L(ghosted_id_dn)
602)
603) dx = xc(ghosted_id_dn) - xc(ghosted_id_up)
604) dy = yc(ghosted_id_dn) - yc(ghosted_id_up)
605) dz = zc(ghosted_id_dn) - zc(ghosted_id_up)
606) dist = sqrt(dx*dx + dy*dy + dz*dz)
607) slope = dz/dist
608)
609) call SurfaceTHFlux(surf_auxvars(ghosted_id_up), &
610) surf_global_auxvars(ghosted_id_up), &
611) zc(ghosted_id_up), &
612) mannings_loc_p(ghosted_id_up), &
613) surf_auxvars(ghosted_id_dn), &
614) surf_global_auxvars(ghosted_id_dn), &
615) zc(ghosted_id_dn), &
616) mannings_loc_p(ghosted_id_dn), &
617) dist, cur_connection_set%area(iconn), &
618) option,vel,dt,Res)
619)
620) patch%internal_velocities(1,sum_connection) = vel
621) patch%internal_flow_fluxes(:,sum_connection) = Res(:)
622)
623) #ifdef SURFACE_TH_DEBUG
624) if (dt < max_allowable_dt) then
625) max_connection = sum_connection
626) max_iconn = iconn
627) endif
628) #endif
629) max_allowable_dt = min(max_allowable_dt, dt)
630)
631) enddo
632) cur_connection_set => cur_connection_set%next
633) enddo
634)
635) #ifdef SURFACE_TH_DEBUG
636) if (max_allowable_dt < 1.d-1) then
637) cur_connection_set => connection_set_list%first
638) ghosted_id_up = cur_connection_set%id_up(max_iconn)
639) ghosted_id_dn = cur_connection_set%id_dn(max_iconn)
640) local_id_up = grid%nG2L(ghosted_id_up)
641) local_id_dn = grid%nG2L(ghosted_id_dn)
642) dx = xc(ghosted_id_dn) - xc(ghosted_id_up)
643) dy = yc(ghosted_id_dn) - yc(ghosted_id_up)
644) dz = zc(ghosted_id_dn) - zc(ghosted_id_up)
645) dist = sqrt(dx*dx + dy*dy + dz*dz)
646) slope = dz/dist
647) print *,"--------------------------"
648) print *,"max_allowable_dt:",max_allowable_dt
649) print *,"connection:",max_iconn
650) print *,"(dx,dy,dz):",dx,dy,dz
651) print *,"dist: ",dist
652) print *,"slope: ",slope
653) print *,"flux: ",patch%internal_velocities(1,max_connection)
654) print *,"dt: ",dist/abs(patch%internal_velocities(1,max_connection))/3.0d0
655) print *,"up info:",ghosted_id_up
656) print *," istate:",surf_global_auxvars(ghosted_id_up)%istate
657) print *," head: ",surf_global_auxvars(ghosted_id_up)%head(1)
658) print *," zc: ",zc(ghosted_id_up)
659) print *," temp: ",surf_global_auxvars(ghosted_id_up)%temp
660) print *," is_dry:",surf_global_auxvars(ghosted_id_up)%is_dry
661) print *,"dn info:",ghosted_id_dn
662) print *," istate:",surf_global_auxvars(ghosted_id_dn)%istate
663) print *," head: ",surf_global_auxvars(ghosted_id_dn)%head(1)
664) print *," zc: ",zc(ghosted_id_dn)
665) print *," temp: ",surf_global_auxvars(ghosted_id_dn)%temp
666) print *," is_dry:",surf_global_auxvars(ghosted_id_dn)%is_dry
667) endif
668) #endif
669)
670) ! Boundary Flux Terms -----------------------------------
671) boundary_condition => patch%boundary_condition_list%first
672) sum_connection = 0
673) do
674) if (.not.associated(boundary_condition)) exit
675)
676) cur_connection_set => boundary_condition%connection_set
677)
678) do iconn = 1, cur_connection_set%num_connections
679) sum_connection = sum_connection + 1
680)
681) local_id_dn = cur_connection_set%id_dn(iconn)
682) ghosted_id_dn = grid%nL2G(local_id_dn)
683)
684) dx = xc(ghosted_id_dn) - cur_connection_set%intercp(1,iconn)
685) dy = yc(ghosted_id_dn) - cur_connection_set%intercp(2,iconn)
686) dz = zc(ghosted_id_dn) - cur_connection_set%intercp(3,iconn)
687) dist = sqrt(dx*dx + dy*dy + dz*dz)
688) slope_dn = dz/sqrt(dx*dx + dy*dy + dz*dz)
689)
690) call SurfaceTHBCFlux(boundary_condition%flow_condition%itype, &
691) boundary_condition%flow_aux_real_var(:,iconn), &
692) surf_auxvars_bc(sum_connection), &
693) surf_global_auxvars_bc(sum_connection), &
694) surf_auxvars(ghosted_id_dn), &
695) surf_global_auxvars(ghosted_id_dn), &
696) slope_dn, &
697) mannings_loc_p(ghosted_id_dn), &
698) dist, &
699) cur_connection_set%area(iconn), &
700) option,vel,dt,Res)
701)
702) patch%boundary_velocities(1,sum_connection) = vel
703) patch%boundary_flow_fluxes(:,sum_connection) = Res(:)
704)
705) max_allowable_dt = min(max_allowable_dt, dt)
706) enddo
707) boundary_condition => boundary_condition%next
708) enddo
709)
710) call VecRestoreArrayF90(surf_field%mannings_loc,mannings_loc_p, &
711) ierr);CHKERRQ(ierr)
712) call VecRestoreArrayF90(surf_field%area,area_p,ierr);CHKERRQ(ierr)
713)
714) if (max_allowable_dt < 0.d0) then
715) write(option%io_buffer, &
716) '("surface_th.F90: SurfaceTHComputeMaxDt --> negative max_allowable_dt!",es15.7)') &
717) max_allowable_dt
718) call printErrMsg(option)
719) endif
720)
721) end subroutine SurfaceTHComputeMaxDt
722)
723) ! ************************************************************************** !
724)
725) subroutine SurfaceTHFlux(surf_auxvar_up, &
726) surf_global_auxvar_up, &
727) zc_up, &
728) mannings_up, &
729) surf_auxvar_dn, &
730) surf_global_auxvar_dn, &
731) zc_dn, &
732) mannings_dn, &
733) dist, &
734) length, &
735) option, &
736) vel, &
737) dt_max, &
738) Res)
739) !
740) ! This routine computes the internal flux term for under
741) ! diffusion-wave assumption.
742) !
743) ! Author: Gautam Bisht, LBL
744) ! Date: 08/03/12
745) !
746)
747) use Surface_TH_Aux_module
748) use Surface_Global_Aux_module
749) use Option_module
750) use PFLOTRAN_Constants_module, only : MIN_SURFACE_WATER_HEIGHT
751)
752) implicit none
753)
754) type(option_type) :: option
755) type(Surface_TH_auxvar_type) :: surf_auxvar_up
756) type(Surface_TH_auxvar_type) :: surf_auxvar_dn
757) type(surface_global_auxvar_type) :: surf_global_auxvar_up
758) type(surface_global_auxvar_type) :: surf_global_auxvar_dn
759) PetscReal :: zc_up, zc_dn
760) PetscReal :: mannings_up, mannings_dn
761)
762) PetscReal :: head_up, head_dn
763) PetscReal :: dist, length
764) PetscReal :: vel ! [m/s]
765) PetscReal :: dt_max
766) PetscReal :: Res(1:option%nflowdof) ! [m^3/s]
767)
768) PetscReal :: hw_half
769) PetscReal :: hw_liq_half
770) PetscReal :: mannings_half
771) PetscReal :: unfrozen_fraction_half
772) PetscReal :: dhead
773) PetscReal :: den_aveg
774) PetscReal :: temp_half
775) PetscReal :: dtemp
776) PetscReal :: Cw
777) PetscReal :: k_therm
778) PetscReal :: dt
779)
780) ! Initialize
781) dt_max = PETSC_MAX_REAL
782)
783) ! We upwind Manning's coefficient, temperature, and the unfrozen head
784) head_up = surf_global_auxvar_up%head(1) + zc_up
785) head_dn = surf_global_auxvar_dn%head(1) + zc_dn
786) if (head_up > head_dn) then
787) mannings_half = mannings_up
788) temp_half = surf_global_auxvar_up%temp + 273.15d0 ! [K]
789) unfrozen_fraction_half = surf_auxvar_up%unfrozen_fraction
790) hw_half = surf_global_auxvar_up%head(1)
791) else
792) mannings_half = mannings_dn
793) temp_half = surf_global_auxvar_dn%temp + 273.15d0 ! [K]
794) unfrozen_fraction_half = surf_auxvar_dn%unfrozen_fraction
795) hw_half = surf_global_auxvar_dn%head(1)
796) endif
797)
798) ! We clip to avoid problems later evaluating at negative water height
799) hw_half = max(hw_half,MIN_SURFACE_WATER_HEIGHT)
800) if (hw_half == MIN_SURFACE_WATER_HEIGHT) then
801) temp_half = 0.d0
802) hw_half = 0.d0
803) endif
804)
805) ! Frozen water doesn't contribute to the velocity
806) hw_liq_half = unfrozen_fraction_half*hw_half
807)
808) ! Compute Manning's velocity
809) dhead = head_up - head_dn
810) vel = sign(hw_liq_half**(2.d0/3.d0)/mannings_half*abs(dhead/dist)**0.5d0,dhead) ! [m/s]
811)
812) ! KLUDGE: To address high velocity oscillations of the surface water
813) ! height, reduce this value to keep dt from shrinking too much. Add
814) ! to options if we decide to keep it.
815) vel = sign(min(option%max_manning_velocity,abs(vel)),vel)
816)
817) ! Load into residual
818) Res(TH_PRESSURE_DOF) = vel*hw_liq_half*length ! [m^3/s]
819)
820) ! Temperature equation
821) ! RTM: k_therm is the weighted average of the liquid and ice thermal
822) ! conductivities. For the density and specific heat capacity in the
823) ! advection term, we want these for liquid water ONLY, as the ice portion
824) ! is immobile and thus should not make up part of the advection term. We
825) ! also multiply the ponded water depth (hw_half) by the unfrozen fraction
826) ! in the advection term but NOT the conduction term.
827) ! We do the same in SurfaceTHBCFlux().
828)
829) ! Average density
830) ! Here we only consider the LIQUID fraction.
831) den_aveg = (surf_global_auxvar_up%den_kg(1) + &
832) surf_global_auxvar_dn%den_kg(1))/2.d0
833) ! Temperature difference
834) if (surf_global_auxvar_up%is_dry .or. surf_global_auxvar_dn%is_dry) then
835) dtemp = 0.d0
836) else
837) dtemp = surf_global_auxvar_up%temp - surf_global_auxvar_dn%temp
838) endif
839)
840) ! We are not being careful with dry/wet conditions, so if the
841) ! temperature change is greater than 100 [C] we will assuming that
842) ! it was a wet/dry interface change that was missed.
843) if (abs(dtemp) > 100.d0) then
844) den_aveg = 0.d0
845) dtemp = 0.d0
846) endif
847)
848) ! Note, Cw and k_therm are same for up and downwind
849) Cw = surf_auxvar_up%Cw
850) k_therm = surf_auxvar_up%k_therm
851)
852) ! Unfrozen fraction multiplies hw_half in advection term, but does NOT affect the
853) ! conduction therm.
854) ! RTM: Brookfield et al. 2009 also has dispersion term, which we are not using.
855) Res(TH_TEMPERATURE_DOF) = (den_aveg*vel*temp_half*Cw*hw_liq_half + &
856) k_therm*dtemp/dist*hw_half)*length
857)
858) if (abs(vel)>eps) then
859) ! 1) Restriction due to flow equation
860) dt = dist/abs(vel)/3.d0
861) dt_max = min(dt_max, dt)
862) endif
863)
864) if (abs(dtemp) > 1.0d-12) then
865) ! 2) Restriction due to energy equation
866) dt_max = min(dt_max,(dist**2.d0)*Cw*den_aveg/(2.d0*k_therm))
867) endif
868)
869) end subroutine SurfaceTHFlux
870)
871) ! ************************************************************************** !
872)
873) subroutine SurfaceTHBCFlux(ibndtype, &
874) auxvars, &
875) surf_auxvar_up, &
876) surf_global_auxvar_up, &
877) surf_auxvar_dn, &
878) surf_global_auxvar_dn, &
879) slope, &
880) mannings, &
881) dist, &
882) length, &
883) option, &
884) vel, &
885) dt_max, &
886) Res)
887) !
888) ! This routine computes flux for boundary cells.
889) !
890) ! Author: Gautam Bisht, LBNL
891) ! Date: 03/07/13
892) !
893)
894) use Option_module
895) use PFLOTRAN_Constants_module, only : MIN_SURFACE_WATER_HEIGHT
896)
897) implicit none
898)
899) type(option_type) :: option
900) type(Surface_TH_auxvar_type) :: surf_auxvar_up
901) type(surface_global_auxvar_type) :: surf_global_auxvar_up
902) type(Surface_TH_auxvar_type) :: surf_auxvar_dn
903) type(surface_global_auxvar_type) :: surf_global_auxvar_dn
904) PetscReal :: auxvars(:) ! from aux_real_var array
905) PetscReal :: slope
906) PetscReal :: mannings
907) PetscReal :: length
908) PetscReal :: flux
909) PetscInt :: ibndtype(:)
910) PetscReal :: vel
911) PetscReal :: dt_max
912) PetscReal :: Res(1:option%nflowdof)
913) PetscReal :: dist
914)
915) PetscInt :: pressure_bc_type
916) PetscReal :: head,dhead
917) PetscReal :: head_liq
918) PetscReal :: den
919) PetscReal :: temp_half
920) PetscReal :: Cw
921) PetscReal :: dtemp
922) PetscReal :: hw_half
923) PetscReal :: k_therm
924) PetscReal :: dt
925)
926) flux = 0.d0
927) vel = 0.d0
928) hw_half = 0.d0
929) dtemp = 0.d0
930) Cw = 0.d0
931) dt_max = PETSC_MAX_REAL
932)
933) ! Flow
934) pressure_bc_type = ibndtype(TH_PRESSURE_DOF)
935) head = surf_global_auxvar_dn%head(1)
936) k_therm = surf_auxvar_dn%k_therm
937)
938) select case(pressure_bc_type)
939) case (ZERO_GRADIENT_BC)
940) if (slope<0.d0) then
941) vel = 0.d0
942) head_liq = 0.d0
943) else
944) head_liq = surf_auxvar_dn%unfrozen_fraction * head
945) vel = -sqrt(dabs(slope))/mannings*(head_liq**(2.d0/3.d0))
946) hw_half = head
947) endif
948) den = surf_global_auxvar_dn%den_kg(1)
949) Cw = surf_auxvar_dn%Cw
950) case (NEUMANN_BC)
951) vel = auxvars(TH_PRESSURE_DOF)
952) den = (surf_global_auxvar_up%den_kg(1) + &
953) surf_global_auxvar_dn%den_kg(1))/2.d0
954) case (SPILLOVER_BC)
955) ! if liquid water height is above a user-defined value, then outflow can occur
956) head_liq = surf_auxvar_dn%unfrozen_fraction * head
957) dhead = max(head_liq-auxvars(1),0.0d0)
958) vel = -dhead**(2.d0/3.d0)/mannings*abs(dhead/dist)**0.5d0
959) hw_half = head
960) Cw = surf_auxvar_dn%Cw
961) den = surf_global_auxvar_dn%den_kg(1)
962) case default
963) option%io_buffer = 'Unknown pressure_bc_type for surface flow '
964) call printErrMsg(option)
965) end select
966)
967) if (vel>0.d0) then
968) temp_half = surf_global_auxvar_up%temp + 273.15d0
969) else
970) temp_half = surf_global_auxvar_dn%temp + 273.15d0
971) endif
972)
973) if (pressure_bc_type /= ZERO_GRADIENT_BC) then
974) select case (ibndtype(TH_TEMPERATURE_DOF))
975) case (DIRICHLET_BC)
976) dtemp = surf_global_auxvar_up%temp - surf_global_auxvar_dn%temp
977) case default
978) option%io_buffer = 'Unknown temperature_bc_type for surface flow '
979) call printErrMsg(option)
980) end select
981) endif
982)
983) flux = head_liq*vel
984) Res(TH_PRESSURE_DOF) = flux*length
985) Res(TH_TEMPERATURE_DOF) = den*temp_half*Cw*vel*head_liq*length + &
986) k_therm*dtemp/dist*hw_half*length
987)
988) ! Timestep restriction due to mass equation
989) if (abs(vel)>eps) then
990) dt = dist/abs(vel)/3.d0
991) dt_max = min(dt_max, dt)
992) endif
993) ! Timestep restriction due to energy equation
994) if (head_liq > MIN_SURFACE_WATER_HEIGHT) then
995) dt_max = min(dt_max,(dist**2.d0)*Cw*den/(2.d0*k_therm))
996) endif
997)
998) end subroutine SurfaceTHBCFlux
999)
1000) ! ************************************************************************** !
1001)
1002) subroutine SurfaceTHUpdateAuxVars(surf_realization)
1003) !
1004) ! This routine updates auxiliary variables
1005) !
1006) ! Author: Gautam Bisht, LBNL
1007) ! Date: 03/07/13
1008) !
1009)
1010) use Realization_Surface_class
1011) use Patch_module
1012) use Option_module
1013) use Surface_Field_module
1014) use Grid_module
1015) use Coupler_module
1016) use Connection_module
1017) use Surface_Material_module
1018) use PFLOTRAN_Constants_module, only : MIN_SURFACE_WATER_HEIGHT
1019)
1020) implicit none
1021)
1022) class(realization_surface_type) :: surf_realization
1023)
1024) type(option_type), pointer :: option
1025) type(patch_type), pointer :: patch
1026) type(grid_type), pointer :: grid
1027) type(surface_field_type), pointer :: surf_field
1028) type(coupler_type), pointer :: boundary_condition
1029) type(coupler_type), pointer :: source_sink
1030) type(connection_set_type), pointer :: cur_connection_set
1031) type(Surface_TH_auxvar_type), pointer :: surf_th_auxvars(:)
1032) type(Surface_TH_auxvar_type), pointer :: surf_th_auxvars_bc(:)
1033) type(Surface_TH_auxvar_type), pointer :: surf_th_auxvars_ss(:)
1034) type(surface_global_auxvar_type), pointer :: surf_global_auxvars(:)
1035) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_bc(:)
1036) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_ss(:)
1037)
1038) PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
1039) PetscInt :: iphasebc, iphase
1040) PetscReal, pointer :: xx_loc_p(:), icap_loc_p(:), iphase_loc_p(:)
1041) PetscReal, pointer :: perm_xx_loc_p(:), porosity_loc_p(:)
1042) PetscReal :: xxbc(surf_realization%option%nflowdof)
1043) PetscReal :: xxss(surf_realization%option%nflowdof)
1044) PetscReal :: tsrc1
1045) PetscErrorCode :: ierr
1046) PetscReal :: den,head
1047)
1048) option => surf_realization%option
1049) patch => surf_realization%patch
1050) grid => patch%grid
1051) surf_field => surf_realization%surf_field
1052)
1053) surf_th_auxvars => patch%surf_aux%SurfaceTH%auxvars
1054) surf_th_auxvars_bc => patch%surf_aux%SurfaceTH%auxvars_bc
1055) surf_th_auxvars_ss => patch%surf_aux%SurfaceTH%auxvars_ss
1056) surf_global_auxvars => patch%surf_aux%SurfaceGlobal%auxvars
1057) surf_global_auxvars_bc => patch%surf_aux%SurfaceGlobal%auxvars_bc
1058) surf_global_auxvars_ss => patch%surf_aux%SurfaceGlobal%auxvars_ss
1059)
1060) call VecGetArrayF90(surf_field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
1061)
1062) ! Internal aux vars
1063) do ghosted_id = 1, grid%ngmax
1064) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
1065)
1066) !geh - Ignore inactive cells with inactive materials
1067) if (associated(patch%imat)) then
1068) if (patch%imat(ghosted_id) <= 0) cycle
1069) endif
1070) iend = ghosted_id*option%nflowdof
1071) istart = iend-option%nflowdof+1
1072)
1073) call SurfaceTHAuxVarCompute(xx_loc_p(istart:iend), &
1074) surf_th_auxvars(ghosted_id), &
1075) surf_global_auxvars(ghosted_id), &
1076) option)
1077) ! [rho*h*T*Cwi]
1078) if (xx_loc_p(istart) >= MIN_SURFACE_WATER_HEIGHT) then
1079) xx_loc_p(istart+1) = surf_global_auxvars(ghosted_id)%den_kg(1)* &
1080) xx_loc_p(istart)* &
1081) (surf_global_auxvars(ghosted_id)%temp + 273.15d0)* &
1082) surf_th_auxvars(ghosted_id)%Cwi
1083) else
1084) xx_loc_p(istart+1) = 0.d0
1085) endif
1086) enddo
1087)
1088) ! Boundary aux vars
1089) boundary_condition => patch%boundary_condition_list%first
1090) sum_connection = 0
1091) do
1092) if (.not.associated(boundary_condition)) exit
1093) cur_connection_set => boundary_condition%connection_set
1094) do iconn = 1, cur_connection_set%num_connections
1095) sum_connection = sum_connection + 1
1096) local_id = cur_connection_set%id_dn(iconn)
1097) ghosted_id = grid%nL2G(local_id)
1098) if (associated(patch%imat)) then
1099) if (patch%imat(ghosted_id) <= 0) cycle
1100) endif
1101)
1102) do idof=1,option%nflowdof
1103) select case(boundary_condition%flow_condition%itype(idof))
1104) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC,HET_DIRICHLET,NEUMANN_BC)
1105) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
1106) case(ZERO_GRADIENT_BC)
1107) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
1108) end select
1109) enddo
1110)
1111) surf_global_auxvars_bc(sum_connection)%temp = xxbc(2)
1112) call SurfaceTHAuxVarCompute(xxbc, &
1113) surf_th_auxvars_bc(sum_connection), &
1114) surf_global_auxvars_bc(sum_connection), &
1115) option)
1116)
1117) enddo
1118) boundary_condition => boundary_condition%next
1119) enddo
1120)
1121) ! Source/Sink aux vars
1122) ! source/sinks
1123) source_sink => patch%source_sink_list%first
1124) sum_connection = 0
1125) do
1126) if (.not.associated(source_sink)) exit
1127) cur_connection_set => source_sink%connection_set
1128) do iconn = 1, cur_connection_set%num_connections
1129) sum_connection = sum_connection + 1
1130) local_id = cur_connection_set%id_dn(iconn)
1131) ghosted_id = grid%nL2G(local_id)
1132) if (patch%imat(ghosted_id) <= 0) cycle
1133)
1134) iend = ghosted_id*option%nflowdof
1135) istart = iend-option%nflowdof+1
1136)
1137) if (associated(source_sink%flow_condition%temperature)) then
1138) if (source_sink%flow_condition%temperature%itype/=HET_DIRICHLET) then
1139) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
1140) else
1141) tsrc1 = source_sink%flow_aux_real_var(TWO_INTEGER,iconn)
1142) endif
1143) else
1144) tsrc1 = xx_loc_p((ghosted_id-1)*option%nflowdof+1)
1145) tsrc1 = surf_global_auxvars(ghosted_id)%temp
1146) endif
1147)
1148) xxss = xx_loc_p(istart:iend)
1149) head = xxss(1)
1150) xxss(1) = 1.d0 ! set arbitrary amount of surface water so auxvar will evaluate
1151) xxss(2) = tsrc1
1152)
1153) surf_global_auxvars_ss(sum_connection)%temp = tsrc1
1154) call SurfaceTHAuxVarCompute(xxss, &
1155) surf_th_auxvars_ss(sum_connection), &
1156) surf_global_auxvars_ss(sum_connection), &
1157) option)
1158) surf_global_auxvars_ss(sum_connection)%head = head ! set head back just in case
1159)
1160) enddo
1161) source_sink => source_sink%next
1162) enddo
1163)
1164) patch%surf_aux%SurfaceTH%auxvars_up_to_date = PETSC_TRUE
1165)
1166) call VecRestoreArrayF90(surf_field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
1167)
1168) end subroutine SurfaceTHUpdateAuxVars
1169)
1170) ! ************************************************************************** !
1171)
1172) subroutine EnergyToTemperatureBisection(T,TL,TR,h,energy,Cwi,Pr,option)
1173) !
1174) ! Solves the following nonlinear equation using the bisection method
1175) !
1176) ! R(T) = rho(T) Cwi hw T - energy = 0
1177) !
1178) ! Author: Nathan Collier, ORNL
1179) ! Date: 11/2014
1180) !
1181) use EOS_Water_module
1182) use Option_module
1183)
1184) implicit none
1185)
1186) PetscReal :: T,TL,TR,h,energy,Cwi,Pr
1187) type(option_type), pointer :: option
1188)
1189) PetscReal :: Tp,rho,rho_t,f,fR,fL,rtol
1190) PetscInt :: iter,niter
1191) PetscBool :: found
1192) PetscErrorCode :: ierr
1193)
1194) call EOSWaterdensity(TR,Pr,rho,rho_T,ierr)
1195) fR = rho*Cwi*h*(TR+273.15d0) - energy
1196) call EOSWaterdensity(TL,Pr,rho,rho_T,ierr)
1197) fL = rho*Cwi*h*(TL+273.15d0) - energy
1198)
1199) if (fL*fR > 0.d0) then
1200) print *,"[TL,TR] = ",TL,TR
1201) print *,"[fL,fR] = ",fL,fR
1202) write(option%io_buffer,'("surface_th.F90: EnergyToTemperatureBisection --> root is not bracketed")')
1203) call printErrMsg(option)
1204) endif
1205)
1206) T = 0.5d0*(TL+TR)
1207) call EOSWaterdensity(T,Pr,rho,rho_T,ierr)
1208) f = rho*Cwi*h*(T+273.15d0) - energy
1209)
1210) found = PETSC_FALSE
1211) niter = 200
1212) rtol = 1.d-6
1213) do iter = 1,niter
1214) Tp = T
1215) if (fL*f < 0.d0) then
1216) TR = T
1217) else
1218) TL = T
1219) endif
1220)
1221) T = 0.5d0*(TL+TR)
1222)
1223) call EOSWaterdensity(T,Pr,rho,rho_T,ierr)
1224) f = rho*Cwi*h*(T+273.15d0) - energy
1225)
1226) if (abs((T-Tp)/(T+273.15d0)) < rtol) then
1227) found = PETSC_TRUE
1228) exit
1229) endif
1230) enddo
1231)
1232) if (found .eqv. PETSC_FALSE) then
1233) print *,"[TL,T,TR] = ",TL,T,TR
1234) write(option%io_buffer,'("surface_th.F90: EnergyToTemperatureBisection --> root not found!")')
1235) call printErrMsg(option)
1236) endif
1237)
1238) end subroutine EnergyToTemperatureBisection
1239)
1240) ! ************************************************************************** !
1241)
1242) subroutine SurfaceTHUpdateTemperature(surf_realization)
1243) !
1244) ! This routine updates the temperature after TSSolve.
1245) !
1246) ! Author: Gautam Bisht, LBNL
1247) ! Date: 06/25/13
1248) !
1249)
1250) use Realization_Surface_class
1251) use Patch_module
1252) use Option_module
1253) use Surface_Field_module
1254) use Grid_module
1255) use Coupler_module
1256) use Connection_module
1257) use Surface_Material_module
1258) use EOS_Water_module
1259) use PFLOTRAN_Constants_module, only : DUMMY_VALUE,MIN_SURFACE_WATER_HEIGHT
1260)
1261) implicit none
1262)
1263) class(realization_surface_type) :: surf_realization
1264) type(option_type), pointer :: option
1265) type(patch_type), pointer :: patch
1266) type(grid_type), pointer :: grid
1267) type(surface_field_type), pointer :: surf_field
1268) type(coupler_type), pointer :: boundary_condition
1269) type(coupler_type), pointer :: source_sink
1270) type(connection_set_type), pointer :: cur_connection_set
1271) type(Surface_TH_auxvar_type), pointer :: surf_auxvars(:)
1272) type(Surface_TH_auxvar_type), pointer :: surf_auxvars_bc(:)
1273) type(Surface_TH_auxvar_type), pointer :: surf_auxvars_ss(:)
1274) type(surface_global_auxvar_type), pointer :: surf_global_auxvars(:)
1275) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_bc(:)
1276) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_ss(:)
1277)
1278) PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
1279) PetscInt :: iphasebc, iphase
1280) PetscReal, pointer :: xx_loc_p(:), icap_loc_p(:), iphase_loc_p(:)
1281) PetscReal, pointer :: perm_xx_loc_p(:), porosity_loc_p(:)
1282) PetscReal :: xxbc(surf_realization%option%nflowdof)
1283) PetscReal :: xxss(surf_realization%option%nflowdof)
1284) PetscReal :: temp,TL,TR
1285) PetscReal :: den
1286) PetscReal :: dum1
1287) PetscErrorCode :: ierr
1288)
1289) option => surf_realization%option
1290) patch => surf_realization%patch
1291) grid => patch%grid
1292) surf_field => surf_realization%surf_field
1293)
1294) surf_global_auxvars => patch%surf_aux%SurfaceGlobal%auxvars
1295) surf_global_auxvars_bc => patch%surf_aux%SurfaceGlobal%auxvars_bc
1296) surf_global_auxvars_ss => patch%surf_aux%SurfaceGlobal%auxvars_ss
1297) surf_auxvars => patch%surf_aux%SurfaceTH%auxvars
1298) surf_auxvars_bc => patch%surf_aux%SurfaceTH%auxvars_bc
1299)
1300) !
1301) ! The unknown for the energy balance in the surface domain is
1302) ! energy. Thus we need to compute a temperature, which results in
1303) ! finding the root of the following nonlinear equation,
1304) !
1305) ! Residual(T) = rho(T) Cwi hw T - energy = 0
1306) !
1307)
1308) call VecGetArrayF90(surf_field%flow_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
1309)
1310) do ghosted_id = 1,grid%ngmax
1311) istart = (ghosted_id-1)*option%nflowdof+1 ! surface water height dof
1312) iend = istart+1 ! surface energy dof
1313) if (xx_loc_p(istart) < MIN_SURFACE_WATER_HEIGHT) then
1314) ! If the cell is dry then we set temperature to a dummy value
1315) ! and then zero out the water height and energy.
1316) surf_global_auxvars(ghosted_id)%is_dry = PETSC_TRUE
1317) temp = DUMMY_VALUE
1318) xx_loc_p(istart) = 0.d0 ! no water
1319) xx_loc_p(iend) = 0.d0 ! no energy
1320) else
1321) TL = -100.d0
1322) TR = 100.d0
1323) call EnergyToTemperatureBisection(temp,TL,TR, &
1324) xx_loc_p(istart), &
1325) xx_loc_p(iend), &
1326) surf_auxvars(ghosted_id)%Cwi, &
1327) option%reference_pressure,option)
1328) endif
1329) surf_global_auxvars(ghosted_id)%temp = temp
1330) call EOSWaterdensity(temp,option%reference_pressure,den,dum1,ierr)
1331) surf_global_auxvars(ghosted_id)%den_kg(1) = den
1332) enddo
1333)
1334) call VecRestoreArrayF90(surf_field%flow_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
1335)
1336) end subroutine SurfaceTHUpdateTemperature
1337)
1338) ! ************************************************************************** !
1339)
1340) subroutine SurfaceTHUpdateSurfState(surf_realization)
1341) !
1342) ! This routine updates the states for surface-model at the end of
1343) ! subsurface-model timestep.
1344) !
1345) ! Author: Gautam Bisht, LBNL
1346) ! Date: 06/25/13
1347) !
1348)
1349) use Connection_module
1350) use Coupler_module
1351) use Discretization_module
1352) use DM_Kludge_module
1353) use Grid_module
1354) use Option_module
1355) use Patch_module
1356) use Realization_Subsurface_class
1357) use Realization_Base_class
1358) use String_module
1359) use Surface_Field_module
1360) use Realization_Surface_class
1361) use EOS_Water_module
1362)
1363) implicit none
1364)
1365) #include "petsc/finclude/petscvec.h"
1366) #include "petsc/finclude/petscvec.h90"
1367) #include "petsc/finclude/petscmat.h"
1368) #include "petsc/finclude/petscmat.h90"
1369)
1370) class(realization_surface_type) :: surf_realization
1371)
1372) type(coupler_list_type), pointer :: coupler_list
1373) type(coupler_type), pointer :: coupler
1374) type(connection_set_type), pointer :: cur_connection_set
1375) type(dm_ptr_type), pointer :: dm_ptr
1376) type(grid_type),pointer :: grid,surf_grid
1377) type(option_type), pointer :: option
1378) type(patch_type),pointer :: patch,surf_patch
1379) type(surface_field_type),pointer :: surf_field
1380) type(Surface_TH_auxvar_type), pointer :: surf_auxvars(:)
1381)
1382) PetscInt :: count
1383) PetscInt :: ghosted_id
1384) PetscInt :: local_id
1385) PetscInt :: ibeg
1386) PetscInt :: iend
1387) PetscInt :: iconn
1388) PetscInt :: sum_connection
1389)
1390) PetscReal :: den
1391) PetscReal :: dum1
1392) PetscReal, pointer :: avg_vdarcy_p(:) ! avg darcy velocity [m/s]
1393) PetscReal, pointer :: xx_p(:) ! head [m]
1394) PetscReal, pointer :: surfpress_p(:)
1395) PetscReal, pointer :: surftemp_p(:)
1396) PetscReal :: Cwi
1397) PetscReal :: temp_K
1398) PetscErrorCode :: ierr
1399)
1400) PetscBool :: coupler_found = PETSC_FALSE
1401)
1402) patch => surf_realization%patch
1403) option => surf_realization%option
1404) surf_field => surf_realization%surf_field
1405) surf_grid => surf_realization%discretization%grid
1406) surf_auxvars => patch%surf_aux%SurfaceTH%auxvars
1407)
1408) call VecGetArrayF90(surf_field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
1409) call VecGetArrayF90(surf_field%press_subsurf, surfpress_p, &
1410) ierr);CHKERRQ(ierr)
1411) call VecGetArrayF90(surf_field%temp_subsurf, surftemp_p, ierr);CHKERRQ(ierr)
1412)
1413) count = 0
1414) do ghosted_id = 1,surf_grid%ngmax
1415)
1416) local_id = surf_grid%nG2L(ghosted_id)
1417) if (local_id <= 0) cycle
1418)
1419) iend = ghosted_id*option%nflowdof
1420) ibeg = iend - 1
1421)
1422) ! Compute density
1423) count = count + 1
1424) call EOSWaterdensity(surftemp_p(count),option%reference_pressure,den,dum1,ierr)
1425) xx_p(ibeg) = (surfpress_p(count)-option%reference_pressure)/ &
1426) (abs(option%gravity(3)))/den
1427) if (surfpress_p(count)-option%reference_pressure < 1.0d-8) then
1428) xx_p(ibeg) = 0.d0
1429) xx_p(iend) = 0.d0
1430) else
1431) Cwi = surf_auxvars(ghosted_id)%Cwi
1432) temp_K = surftemp_p(count) + 273.15d0
1433) xx_p(iend) = den*Cwi*temp_K*xx_p(ibeg)
1434) endif
1435)
1436) enddo
1437) call VecRestoreArrayF90(surf_field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
1438) call VecRestoreArrayF90(surf_field%press_subsurf, surfpress_p, &
1439) ierr);CHKERRQ(ierr)
1440) call VecRestoreArrayF90(surf_field%temp_subsurf, surftemp_p, &
1441) ierr);CHKERRQ(ierr)
1442)
1443) call DiscretizationGlobalToLocal(surf_realization%discretization, &
1444) surf_field%flow_xx, &
1445) surf_field%flow_xx_loc, &
1446) NFLOWDOF)
1447) call SurfaceTHUpdateAuxVars(surf_realization)
1448)
1449) end subroutine SurfaceTHUpdateSurfState
1450)
1451) ! ************************************************************************** !
1452)
1453) subroutine AtmEnergyToTemperatureBisection(T,TL,TR,shift,RHS,Pr,option)
1454) !
1455) ! Solves the following nonlinear equation using the bisection method
1456) !
1457) ! R(T) = (rho(T)+shift)*T - RHS = 0
1458) !
1459) ! Author: Nathan Collier, ORNL
1460) ! Date: 11/2014
1461) !
1462) use EOS_Water_module
1463) use Option_module
1464)
1465) implicit none
1466)
1467) PetscReal :: T,TL,TR,shift,RHS,Pr
1468) type(option_type), pointer :: option
1469)
1470) PetscReal :: Tp,rho,rho_t,f,fR,fL,rtol
1471) PetscInt :: iter,niter
1472) PetscBool :: found
1473) PetscErrorCode :: ierr
1474)
1475) call EOSWaterdensity(TR,Pr,rho,rho_T,ierr)
1476) fR = (rho+shift)*(TR+273.15d0) - RHS
1477) call EOSWaterdensity(TL,Pr,rho,rho_T,ierr)
1478) fL = (rho+shift)*(TL+273.15d0) - RHS
1479)
1480) if (fL*fR > 0.d0) then
1481) print *,"[TL,TR] = ",TL,TR
1482) print *,"[fL,fR] = ",fL,fR
1483) write(option%io_buffer,'("surface_th.F90: AtmEnergyToTemperatureBisection --> root is not bracketed")')
1484) call printErrMsg(option)
1485) endif
1486)
1487) T = 0.5d0*(TL+TR)
1488) call EOSWaterdensity(T,Pr,rho,rho_T,ierr)
1489) f = (rho+shift)*(T+273.15d0) - RHS
1490)
1491) found = PETSC_FALSE
1492) niter = 200
1493) rtol = 1.d-6
1494) do iter = 1,niter
1495) Tp = T
1496) if (fL*f < 0.d0) then
1497) TR = T
1498) else
1499) TL = T
1500) endif
1501)
1502) T = 0.5d0*(TL+TR)
1503)
1504) call EOSWaterdensity(T,Pr,rho,rho_T,ierr)
1505) f = (rho+shift)*(T+273.15d0) - RHS
1506)
1507) if (abs((T-Tp)/(T+273.15d0)) < rtol) then
1508) found = PETSC_TRUE
1509) exit
1510) endif
1511) enddo
1512)
1513) if (found .eqv. PETSC_FALSE) then
1514) print *,"[TL,T,TR] = ",TL,T,TR
1515) write(option%io_buffer,'("surface_th.F90: AtmEnergyToTemperatureBisection --> root not found!")')
1516) call printErrMsg(option)
1517) endif
1518)
1519) end subroutine AtmEnergyToTemperatureBisection
1520)
1521) ! ************************************************************************** !
1522)
1523) subroutine SurfaceTHImplicitAtmForcing(surf_realization)
1524) !
1525) ! Updates the temperature of surface-water implicitly due to conduction.
1526) !
1527) ! Author: Gautam Bisht, LBNL
1528) ! Date: 04/24/2014
1529) !
1530)
1531) use Realization_Surface_class
1532) use Patch_module
1533) use Option_module
1534) use Surface_Field_module
1535) use Grid_module
1536) use Coupler_module
1537) use Connection_module
1538) use Surface_Material_module
1539) use EOS_Water_module
1540) use String_module
1541) use PFLOTRAN_Constants_module, only : MIN_SURFACE_WATER_HEIGHT
1542) implicit none
1543)
1544) class(realization_surface_type) :: surf_realization
1545) type(option_type), pointer :: option
1546) type(patch_type), pointer :: patch
1547) type(grid_type), pointer :: grid
1548) type(surface_field_type), pointer :: surf_field
1549) type(coupler_type), pointer :: boundary_condition
1550) type(coupler_type), pointer :: source_sink
1551) type(connection_set_type), pointer :: cur_connection_set
1552) type(Surface_TH_auxvar_type), pointer :: surf_auxvars(:)
1553) type(Surface_TH_auxvar_type), pointer :: surf_auxvars_bc(:)
1554) type(Surface_TH_auxvar_type), pointer :: surf_auxvars_ss(:)
1555) type(surface_global_auxvar_type), pointer :: surf_global_auxvars(:)
1556) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_bc(:)
1557) type(surface_global_auxvar_type), pointer :: surf_global_auxvars_ss(:)
1558)
1559) PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
1560) PetscInt :: iphasebc, iphase
1561) PetscReal, pointer :: xx_loc_p(:), xx_p(:)
1562) PetscReal, pointer :: perm_xx_loc_p(:), porosity_loc_p(:)
1563) PetscReal :: xxbc(surf_realization%option%nflowdof)
1564) PetscReal :: xxss(surf_realization%option%nflowdof)
1565) PetscReal :: temp,ptemp,rtol
1566) PetscInt :: iter
1567) PetscInt :: niter
1568) PetscReal :: den
1569) PetscReal :: dum1
1570) PetscReal :: den_iter
1571) PetscReal :: den_old
1572) PetscReal :: k_therm
1573) PetscReal :: Cw
1574) PetscReal :: temp_old
1575) PetscReal :: head
1576) PetscReal :: beta,RHS,TL,TR
1577) PetscBool :: found
1578) PetscErrorCode :: ierr
1579)
1580) option => surf_realization%option
1581) patch => surf_realization%patch
1582) grid => patch%grid
1583) surf_field => surf_realization%surf_field
1584)
1585) surf_global_auxvars => patch%surf_aux%SurfaceGlobal%auxvars
1586) surf_global_auxvars_ss => patch%surf_aux%SurfaceGlobal%auxvars_ss
1587) surf_auxvars => patch%surf_aux%SurfaceTH%auxvars
1588) surf_auxvars_bc => patch%surf_aux%SurfaceTH%auxvars_bc
1589)
1590) ! niter = max(m)
1591) niter = 20
1592) rtol = 1.d-12
1593) call VecGetArrayF90(surf_field%flow_xx,xx_p,ierr);CHKERRQ(ierr)
1594)
1595) ! Update source/sink aux vars
1596) source_sink => patch%source_sink_list%first
1597) sum_connection = 0
1598) do
1599) if (.not.associated(source_sink)) exit
1600)
1601) cur_connection_set => source_sink%connection_set
1602)
1603) if (StringCompare(source_sink%name,'atm_energy_ss')) then
1604)
1605) if (source_sink%flow_condition%itype(TH_TEMPERATURE_DOF) == HET_DIRICHLET) then
1606)
1607) do iconn = 1, cur_connection_set%num_connections
1608)
1609) sum_connection = sum_connection + 1
1610)
1611) local_id = cur_connection_set%id_dn(iconn)
1612) ghosted_id = grid%nL2G(local_id)
1613)
1614) head = surf_global_auxvars(ghosted_id)%head(1)
1615) temp_old = surf_global_auxvars(ghosted_id)%temp
1616) k_therm = surf_auxvars(ghosted_id)%k_therm
1617) Cw = surf_auxvars(ghosted_id)%Cw
1618)
1619) if (head > MIN_SURFACE_WATER_HEIGHT) then
1620)
1621) call EOSWaterdensity(temp_old,option%reference_pressure,den_old,dum1,ierr)
1622) call EOSWaterdensity(temp_old,option%reference_pressure,den_iter,dum1,ierr)
1623)
1624) TL = -100.d0
1625) TR = 100.d0
1626) beta = (2.d0*k_therm*option%surf_flow_dt)/(Cw*head**2.d0)
1627) RHS = den_old*(temp_old+273.15d0)+beta*(surf_global_auxvars_ss(sum_connection)%temp+273.15d0)
1628) call AtmEnergyToTemperatureBisection(temp,TL,TR,beta,RHS,option%reference_pressure,option)
1629)
1630) call EOSWaterdensity(temp,option%reference_pressure,den_iter,dum1,ierr)
1631) surf_global_auxvars(ghosted_id)%temp = temp
1632)
1633) iend = local_id*option%nflowdof
1634) istart = iend - option%nflowdof + 1
1635) xx_p(iend) = den_iter*Cw*(temp + 273.15d0)*xx_p(istart)
1636) endif
1637)
1638) enddo
1639)
1640) else
1641) sum_connection = sum_connection + cur_connection_set%num_connections
1642) endif
1643)
1644) else
1645) sum_connection = sum_connection + cur_connection_set%num_connections
1646) endif
1647)
1648) source_sink => source_sink%next
1649) enddo
1650)
1651) call VecRestoreArrayF90(surf_field%flow_xx,xx_p,ierr);CHKERRQ(ierr)
1652)
1653) end subroutine SurfaceTHImplicitAtmForcing
1654)
1655) ! ************************************************************************** !
1656)
1657) subroutine SurfaceTHUpdateSolution(surf_realization)
1658) !
1659) ! This routine updates solution after a successful time step
1660) !
1661) ! Author: Gautam Bisht, LBNL
1662) ! Date: 03/07/13
1663) !
1664)
1665) use Realization_Surface_class
1666) use Surface_Field_module
1667)
1668) implicit none
1669)
1670) class(realization_surface_type) :: surf_realization
1671)
1672) type(surface_field_type),pointer :: surf_field
1673) PetscErrorCode :: ierr
1674)
1675) surf_field => surf_realization%surf_field
1676) call VecCopy(surf_field%flow_xx,surf_field%flow_yy,ierr);CHKERRQ(ierr)
1677)
1678) end subroutine SurfaceTHUpdateSolution
1679)
1680)
1681) ! ************************************************************************** !
1682)
1683) subroutine SurfaceTHDestroy(surf_realization)
1684) !
1685) ! Deallocates variables associated with Richard
1686) !
1687) ! Author: ???
1688) ! Date: 02/14/08
1689) !
1690)
1691) use Realization_Surface_class
1692)
1693) implicit none
1694)
1695) class(realization_surface_type) :: surf_realization
1696)
1697) ! aux vars should be destroyed when surf_realization is destroyed.
1698)
1699) end subroutine SurfaceTHDestroy
1700)
1701) end module Surface_TH_module