simulation_surfsubsurface.F90 coverage: 77.78 %func 53.85 %block
1) module Simulation_Surf_Subsurf_class
2)
3) use Simulation_Surface_class
4) use Simulation_Subsurface_class
5) use Regression_module
6) use Option_module
7) use PMC_Base_class
8) use PMC_Subsurface_class
9) use PMC_Surface_class
10) use Realization_Subsurface_class
11) use Realization_Surface_class
12) use Waypoint_module
13)
14) use PFLOTRAN_Constants_module
15)
16) implicit none
17)
18) private
19)
20) #include "petsc/finclude/petscsys.h"
21)
22) type, public, extends(simulation_subsurface_type) :: &
23) simulation_surfsubsurface_type
24) class(pmc_surface_type), pointer :: surf_flow_process_model_coupler
25) class(realization_surface_type), pointer :: surf_realization
26) type(waypoint_list_type), pointer :: waypoint_list_surfsubsurface
27) contains
28) procedure, public :: Init => SurfSubsurfaceSimulationInit
29) procedure, public :: InitializeRun => SurfSubsurfaceInitializeRun
30) procedure, public :: InputRecord => SurfSubsurfaceInputRecord
31) procedure, public :: FinalizeRun => SurfSubsurfaceFinalizeRun
32) procedure, public :: Strip => SurfSubsurfaceSimulationStrip
33) procedure, public :: ExecuteRun => SurfSubsurfaceExecuteRun
34) procedure, public :: RunToTime => SurfSubsurfaceSimulationRunToTime
35) end type simulation_surfsubsurface_type
36)
37) public :: SurfSubsurfaceSimulationCreate, &
38) SurfSubsurfaceSimulationInit, &
39) SurfSubsurfaceFinalizeRun, &
40) SurfSubsurfaceSimulationStrip, &
41) SurfSubsurfaceSimulationDestroy
42)
43) contains
44)
45) ! ************************************************************************** !
46)
47) function SurfSubsurfaceSimulationCreate(option)
48) !
49) ! This routine
50) !
51) ! Author: Gautam Bisht, LBNL
52) ! Date: 06/28/13
53) !
54)
55) use Option_module
56)
57) implicit none
58)
59) type(option_type), pointer :: option
60)
61) class(simulation_surfsubsurface_type), pointer :: SurfSubsurfaceSimulationCreate
62)
63) print *, 'SurfSubsurfaceSimulationCreate'
64)
65) allocate(SurfSubsurfaceSimulationCreate)
66) call SurfSubsurfaceSimulationCreate%Init(option)
67)
68) end function SurfSubsurfaceSimulationCreate
69)
70) ! ************************************************************************** !
71)
72) subroutine SurfSubsurfaceSimulationInit(this,option)
73) !
74) ! This routine
75) !
76) ! Author: Gautam Bisht, LBNL
77) ! Date: 06/28/13
78) !
79) use Waypoint_module
80) use Option_module
81)
82) implicit none
83)
84) class(simulation_surfsubsurface_type) :: this
85) type(option_type), pointer :: option
86)
87) call SubsurfaceSimulationInit(this,option)
88) nullify(this%surf_realization)
89) this%waypoint_list_surfsubsurface => WaypointListCreate()
90)
91) end subroutine SurfSubsurfaceSimulationInit
92)
93) ! ************************************************************************** !
94)
95) subroutine SurfSubsurfaceInitializeRun(this)
96) !
97) ! This routine
98) !
99) ! Author: Gautam Bisht, LBNL
100) ! Date: 06/28/13
101) !
102)
103) use Logging_module
104) use Output_module
105) use PMC_Surface_class
106)
107) implicit none
108)
109) #include "petsc/finclude/petscviewer.h"
110)
111) class(simulation_surfsubsurface_type) :: this
112)
113) class(pmc_base_type), pointer :: cur_process_model_coupler
114) class(pmc_base_type), pointer :: cur_process_model_coupler_top
115) class(pmc_base_type), pointer :: cur_process_model_coupler_below
116) PetscInt :: depth
117) PetscErrorCode :: ierr
118) PetscViewer :: viewer
119)
120) call printMsg(this%option,'Simulation%InitializeRun()')
121)
122) call this%process_model_coupler_list%InitializeRun()
123)
124) if (this%option%restart_flag) then
125) call this%process_model_coupler_list%RestartBinary(viewer)
126) cur_process_model_coupler => this%process_model_coupler_list
127) select type(pmc => cur_process_model_coupler)
128) class is(pmc_surface_type)
129) select case(this%option%iflowmode)
130) case (RICHARDS_MODE)
131) call pmc%PMCSurfaceGetAuxDataAfterRestart()
132) case (TH_MODE)
133) call pmc%PMCSurfaceGetAuxDataAfterRestart()
134) case default
135) call printErrMsg(this%option,'SurfSubsurfaceInitializeRun ' // &
136) 'not supported in current flow mode.')
137) end select
138) end select
139)
140) endif
141)
142) end subroutine SurfSubsurfaceInitializeRun
143)
144) ! ************************************************************************** !
145)
146) subroutine SurfSubsurfaceInputRecord(this)
147) !
148) ! Writes ingested information to the input record file.
149) !
150) ! Author: Jenn Frederick, SNL
151) ! Date: 03/17/2016
152) !
153) use Output_module
154)
155) implicit none
156)
157) class(simulation_surfsubsurface_type) :: this
158)
159) character(len=MAXWORDLENGTH) :: word
160) PetscInt :: id = INPUT_RECORD_UNIT
161)
162) write(id,'(a29)',advance='no') 'simulation type: '
163) write(id,'(a)') 'surface-subsurface'
164)
165) ! print output file information
166) call OutputInputRecord(this%output_option,this%waypoint_list_surfsubsurface)
167)
168) end subroutine SurfSubsurfaceInputRecord
169)
170) ! ************************************************************************** !
171)
172) subroutine SurfSubsurfaceExecuteRun(this)
173) !
174) ! This routine
175) !
176) ! Author: Gautam Bisht, LBNL
177) ! Date: 06/28/13
178) !
179)
180) use Simulation_Base_class
181) use Timestepper_Base_class, only : TS_CONTINUE
182) use Checkpoint_module
183)
184) implicit none
185)
186) class(simulation_surfsubsurface_type) :: this
187)
188) PetscReal :: time
189) PetscReal :: final_time
190) PetscReal :: dt
191) character(len=MAXSTRINGLENGTH) :: append_name
192)
193) time = 0.d0
194) time = this%option%time
195)
196) final_time = SimulationGetFinalWaypointTime(this)
197) append_name = '-restart'
198)
199) call printMsg(this%option,'SurfSubsurfaceExecuteRun()')
200)
201) if (.not.associated(this%surf_realization)) then
202) call this%RunToTime(final_time)
203)
204) else
205)
206) ! If simulation is decoupled surface-subsurface simulation, set
207) ! dt_coupling to be dt_max
208) if (this%surf_realization%dt_coupling == 0.d0) &
209) this%surf_realization%dt_coupling = this%surf_realization%dt_max
210)
211) do
212) if (time + this%surf_realization%dt_coupling > final_time) then
213) dt = final_time-time
214) else
215) dt = this%surf_realization%dt_coupling
216) endif
217)
218) time = time + dt
219) call this%RunToTime(time)
220)
221) if (this%stop_flag /= TS_CONTINUE) exit ! end simulation
222)
223) if (time >= final_time) exit
224) enddo
225)
226) endif
227) if (associated(this%process_model_coupler_list%checkpoint_option)) then
228) append_name = CheckpointFilename(append_name,this%option)
229) call this%process_model_coupler_list%Checkpoint(append_name)
230) endif
231)
232) end subroutine SurfSubsurfaceExecuteRun
233)
234) ! ************************************************************************** !
235)
236) subroutine SurfSubsurfaceFinalizeRun(this)
237) !
238) ! This routine
239) !
240) ! Author: Gautam Bisht, LBNL
241) ! Date: 06/28/13
242) !
243)
244) use Simulation_Base_class
245) use Timestepper_Base_class
246)
247) implicit none
248)
249) class(simulation_surfsubsurface_type) :: this
250)
251) PetscErrorCode :: ierr
252)
253) call printMsg(this%option,'SurfSubsurfaceFinalizeRun()')
254)
255) call SubsurfaceFinalizeRun(this)
256) !call SurfaceFinalizeRun(this)
257)
258) end subroutine SurfSubsurfaceFinalizeRun
259)
260) ! ************************************************************************** !
261)
262) subroutine SurfSubsurfaceSimulationStrip(this)
263) !
264) ! This routine
265) !
266) ! Author: Gautam Bisht, LBNL
267) ! Date: 06/28/13
268) !
269) use Waypoint_module
270) use Simulation_Base_class
271)
272) implicit none
273)
274) class(simulation_surfsubsurface_type) :: this
275)
276) call printMsg(this%option,'SurfSubsurfaceSimulationStrip()')
277)
278) call SubsurfaceSimulationStrip(this)
279) call RealizSurfStrip(this%surf_realization)
280) deallocate(this%surf_realization)
281) nullify(this%surf_realization)
282) call WaypointListDestroy(this%waypoint_list_surfsubsurface)
283)
284) end subroutine SurfSubsurfaceSimulationStrip
285)
286) ! ************************************************************************** !
287)
288) subroutine SurfSubsurfaceSimulationRunToTime(this,target_time)
289) !
290) ! This routine executes surface-subsurface simualation
291) !
292) ! Author: Gautam Bisht, LBNL
293) ! Date: 06/27/13
294) !
295)
296) use Option_module
297) use Simulation_Aux_module
298)
299) implicit none
300)
301) #include "petsc/finclude/petscviewer.h"
302)
303) class(simulation_surfsubsurface_type) :: this
304) PetscReal :: target_time
305)
306) class(pmc_base_type), pointer :: cur_process_model_coupler
307) PetscViewer :: viewer
308)
309) #ifdef DEBUG
310) call printMsg(this%option,'RunToTime()')
311) #endif
312) call this%process_model_coupler_list%RunToTime(target_time,this%stop_flag)
313)
314) end subroutine SurfSubsurfaceSimulationRunToTime
315)
316) ! ************************************************************************** !
317)
318) subroutine SurfSubsurfaceSimulationDestroy(simulation)
319) !
320) ! This routine
321) !
322) ! Author: Gautam Bisht, LBNL
323) ! Date: 06/28/13
324) !
325)
326) implicit none
327)
328) class(simulation_surfsubsurface_type), pointer :: simulation
329)
330) call printMsg(simulation%option,'SimulationDestroy()')
331)
332) if (.not.associated(simulation)) return
333)
334) call simulation%Strip()
335) deallocate(simulation)
336) nullify(simulation)
337)
338) end subroutine SurfSubsurfaceSimulationDestroy
339)
340) end module Simulation_Surf_Subsurf_class