pm_surface.F90 coverage: 35.71 %func 25.25 %block
1) module PM_Surface_class
2)
3) use PM_Base_class
4) use Realization_Surface_class
5) use Communicator_Base_module
6) use Option_module
7) use PFLOTRAN_Constants_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14)
15) #include "petsc/finclude/petscvec.h"
16) #include "petsc/finclude/petscvec.h90"
17) #include "petsc/finclude/petscmat.h"
18) #include "petsc/finclude/petscmat.h90"
19) #include "petsc/finclude/petscsnes.h"
20) #include "petsc/finclude/petscts.h"
21)
22) type, public, extends(pm_base_type) :: pm_surface_type
23) class(realization_surface_type), pointer :: surf_realization
24) class(communicator_type), pointer :: comm1
25) PetscReal :: pressure_change_governor
26) PetscReal :: temperature_change_governor
27) PetscReal :: pressure_dampening_factor
28) PetscReal :: pressure_change_limit
29) PetscReal :: temperature_change_limit
30) contains
31) procedure, public :: Setup => PMSurfaceSetup
32) procedure, public :: PMSurfaceSetRealization
33) procedure, public :: InitializeRun => PMSurfaceInitializeRun
34) procedure, public :: PreSolve => PMSurfacePreSolve
35) procedure, public :: PostSolve => PMSurfacePostSolve
36) procedure, public :: CheckpointBinary => PMSurfaceCheckpointBinary
37) procedure, public :: RestartBinary => PMSurfaceRestartBinary
38) procedure, public :: UpdateAuxvars => PMSurfaceUpdateAuxvars
39) procedure, public :: InputRecord => PMSurfaceInputRecord
40) end type pm_surface_type
41)
42) public :: PMSurfaceCreate, &
43) PMSurfaceSetup, &
44) PMSurfaceUpdateSolution, &
45) PMSurfaceReadSelectCase, &
46) PMSurfaceDestroy
47)
48) contains
49)
50) ! ************************************************************************** !
51)
52) subroutine PMSurfaceCreate(this)
53) !
54) ! Intializes shared members of surface process models
55) !
56) ! Author: Gautam Bisht, LBNL
57) ! Date: 04/22/14
58)
59) implicit none
60)
61) class(pm_surface_type) :: this
62)
63) this%pressure_change_governor = 5.d5
64) this%temperature_change_governor = 5.d0
65) this%pressure_dampening_factor = UNINITIALIZED_DOUBLE
66) this%pressure_change_limit = UNINITIALIZED_DOUBLE
67) this%temperature_change_limit = UNINITIALIZED_DOUBLE
68)
69) nullify(this%surf_realization)
70) nullify(this%comm1)
71)
72) call PMBaseInit(this)
73)
74) end subroutine PMSurfaceCreate
75)
76) ! ************************************************************************** !
77)
78) subroutine PMSurfaceReadSelectCase(this,input,keyword,found,option)
79) !
80) ! Reads input file parameters associated with the subsurface flow process
81) ! model
82) !
83) ! Author: Glenn Hammond
84) ! Date: 01/05/16
85)
86) use Input_Aux_module
87) use String_module
88) use Option_module
89)
90) implicit none
91)
92) class(pm_surface_type) :: this
93) type(input_type) :: input
94)
95) character(len=MAXWORDLENGTH) :: keyword
96) PetscBool :: found
97) type(option_type) :: option
98)
99) found = PETSC_TRUE
100) select case(trim(keyword))
101)
102) case('MAX_PRESSURE_CHANGE')
103) call InputReadDouble(input,option,this%pressure_change_governor)
104) call InputDefaultMsg(input,option,'dpmxe')
105)
106) case('MAX_TEMPERATURE_CHANGE')
107) call InputReadDouble(input,option,this%temperature_change_governor)
108) call InputDefaultMsg(input,option,'dtmpmxe')
109)
110) case('PRESSURE_DAMPENING_FACTOR')
111) call InputReadDouble(input,option,this%pressure_dampening_factor)
112) call InputErrorMsg(input,option,'PRESSURE_DAMPENING_FACTOR', &
113) 'TIMESTEPPER')
114)
115) case('PRESSURE_CHANGE_LIMIT')
116) call InputReadDouble(input,option,this%pressure_change_limit)
117) call InputErrorMsg(input,option,'PRESSURE_CHANGE_LIMIT', &
118) 'TIMESTEPPER')
119)
120) case('TEMPERATURE_CHANGE_LIMIT')
121) call InputReadDouble(input,option,this%temperature_change_limit)
122) call InputErrorMsg(input,option,'TEMPERATURE_CHANGE_LIMIT', &
123) 'TIMESTEPPER')
124) case default
125) found = PETSC_FALSE
126) end select
127)
128) end subroutine PMSurfaceReadSelectCase
129)
130) ! ************************************************************************** !
131)
132) subroutine PMSurfaceSetup(this)
133) !
134) ! Initializes variables associated with subsurface process models
135) !
136) ! Author: Gautam Bisht, LBNL
137) ! Date: 04/22/14
138) !
139)
140) use Discretization_module
141) use Communicator_Unstructured_class
142) use Grid_module
143)
144) implicit none
145)
146) class(pm_surface_type) :: this
147)
148) ! set up communicator
149) select case(this%surf_realization%discretization%itype)
150) case(STRUCTURED_GRID)
151) this%option%io_buffer='Surface flow not supported on structured grids'
152) call printErrMsg(this%option)
153) case(UNSTRUCTURED_GRID)
154) this%comm1 => UnstructuredCommunicatorCreate()
155) end select
156)
157) ! set the communicator
158) call this%comm1%SetDM(this%surf_realization%discretization%dm_1dof)
159)
160) end subroutine PMSurfaceSetup
161)
162) ! ************************************************************************** !
163)
164) subroutine PMSurfaceSetRealization(this, surf_realization)
165) !
166) ! Initializes relization and PETSc vectors for solution and residual.
167) !
168) ! Author: Gautam Bisht, LBNL
169) ! Date: 04/22/14
170) !
171)
172) use Realization_Surface_class
173) use Grid_module
174)
175) implicit none
176)
177) class(pm_surface_type) :: this
178) class(realization_surface_type), pointer :: surf_realization
179)
180) this%surf_realization => surf_realization
181) this%realization_base => surf_realization
182)
183) this%solution_vec = surf_realization%surf_field%flow_xx
184) this%residual_vec = surf_realization%surf_field%flow_r
185)
186) end subroutine PMSurfaceSetRealization
187)
188) ! ************************************************************************** !
189)
190) recursive subroutine PMSurfaceInitializeRun(this)
191) !
192) ! This routine
193) !
194) ! Author: Gautam Bisht, LBNL
195) ! Date: 04/22/14
196) !
197)
198) implicit none
199)
200) class(pm_surface_type) :: this
201)
202) end subroutine PMSurfaceInitializeRun
203)
204) ! ************************************************************************** !
205) subroutine PMSurfacePreSolve(this)
206) !
207) ! Author: Gautam Bisht, LBNL
208) ! Date: 04/22/14
209)
210) use Global_module
211)
212) implicit none
213)
214) class(pm_surface_type) :: this
215)
216) this%option%io_buffer = 'PMSurfacePreSolve() must be extended.'
217) call printErrMsg(this%option)
218)
219) end subroutine PMSurfacePreSolve
220)
221) ! ************************************************************************** !
222)
223) subroutine PMSurfacePostSolve(this)
224) !
225) ! Author: Gautam Bisht, LBNL
226) ! Date: 04/22/14
227) !
228)
229) use Global_module
230)
231) implicit none
232)
233) class(pm_surface_type) :: this
234)
235) this%option%io_buffer = 'PMSurfacePostSolve() must be extended.'
236) call printErrMsg(this%option)
237)
238) end subroutine PMSurfacePostSolve
239)
240) ! ************************************************************************** !
241)
242) subroutine PMSurfaceUpdateSolution(this)
243) !
244) ! As a first step in updating the solution, update all flow-conditions.
245) ! The solution will be updated by each child class of pm_surface_type.
246) !
247) ! Author: Gautam Bisht, LBNL
248) ! Date: 04/22/14
249) !
250)
251) use Condition_module
252)
253) implicit none
254)
255) class(pm_surface_type) :: this
256)
257) PetscBool :: force_update_flag = PETSC_FALSE
258)
259)
260) ! begin from RealizationUpdate()
261) call FlowConditionUpdate(this%surf_realization%surf_flow_conditions, &
262) this%surf_realization%option, &
263) this%surf_realization%option%time)
264)
265) call RealizSurfAllCouplerAuxVars(this%surf_realization,force_update_flag)
266)
267) end subroutine PMSurfaceUpdateSolution
268)
269) ! ************************************************************************** !
270)
271) subroutine PMSurfaceUpdateAuxVars(this)
272) !
273) ! Author: Gautam Bisht, LBNL
274) ! Date: 04/22/14
275)
276) implicit none
277)
278) class(pm_surface_type) :: this
279)
280) this%option%io_buffer = 'PMSurfaceUpdateAuxVars() must be extended.'
281) call printErrMsg(this%option)
282)
283) end subroutine PMSurfaceUpdateAuxVars
284)
285) ! ************************************************************************** !
286)
287) subroutine PMSurfaceCheckpointBinary(this,viewer)
288) !
289) ! This routine checkpoints data associated with surface-flow PM
290) !
291) ! Author: Gautam Bisht, LBNL
292) ! Date: 04/22/14
293) !
294)
295) use Checkpoint_Surface_module
296)
297) implicit none
298) #include "petsc/finclude/petscviewer.h"
299)
300) class(pm_surface_type) :: this
301) PetscViewer :: viewer
302)
303) call SurfaceCheckpointProcessModelBinary(viewer,this%surf_realization)
304)
305) end subroutine PMSurfaceCheckpointBinary
306)
307) ! ************************************************************************** !
308)
309) subroutine PMSurfaceRestartBinary(this,viewer)
310) !
311) ! This routine reads checkpoint data associated with surface-flow PM
312) !
313) ! Author: Gautam Bisht, LBNL
314) ! Date: 04/22/14
315) !
316)
317) use Checkpoint_Surface_module
318)
319) implicit none
320) #include "petsc/finclude/petscviewer.h"
321)
322) class(pm_surface_type) :: this
323) PetscViewer :: viewer
324)
325) call SurfaceRestartProcessModelBinary(viewer,this%surf_realization)
326) call this%UpdateAuxVars()
327) call this%UpdateSolution()
328)
329) end subroutine PMSurfaceRestartBinary
330)
331) ! ************************************************************************** !
332)
333) recursive subroutine PMSurfaceFinalizeRun(this)
334) !
335) ! Finalizes the time stepping
336) !
337) ! Author: Gautam Bisht, LBNL
338) ! Date: 04/22/14
339) !
340)
341) implicit none
342)
343) class(pm_surface_type) :: this
344)
345) ! do something here
346)
347) if (associated(this%next)) then
348) call this%next%FinalizeRun()
349) endif
350)
351) end subroutine PMSurfaceFinalizeRun
352)
353) ! ************************************************************************** !
354)
355) subroutine PMSurfaceInputRecord(this)
356) !
357) ! Writes ingested information to the input record file.
358) !
359) ! Author: Jenn Frederick, SNL
360) ! Date: 03/21/2016
361) !
362)
363) implicit none
364)
365) class(pm_surface_type) :: this
366)
367) character(len=MAXWORDLENGTH) :: word
368) PetscInt :: id
369)
370) id = INPUT_RECORD_UNIT
371)
372) write(id,'(a29)',advance='no') 'pm: '
373) write(id,'(a)') this%name
374)
375) end subroutine PMSurfaceInputRecord
376)
377) ! ************************************************************************** !
378)
379) subroutine PMSurfaceDestroy(this)
380) !
381) ! Destroys Surface process model
382) !
383) ! Author: Gautam Bisht, LBNL
384) ! Date: 04/22/14
385) !
386)
387) implicit none
388)
389) class(pm_surface_type) :: this
390)
391) call this%comm1%Destroy()
392)
393) end subroutine PMSurfaceDestroy
394)
395) end module PM_Surface_class