simulation_surface.F90 coverage: 0.00 %func 0.00 %block
1) module Simulation_Surface_class
2)
3) use Simulation_Base_class
4) use Regression_module
5) use Option_module
6) use PMC_Surface_class
7) use PMC_Base_class
8) use Realization_Surface_class
9) use Waypoint_module
10) use PFLOTRAN_Constants_module
11)
12) implicit none
13)
14) #include "petsc/finclude/petscsys.h"
15)
16) private
17)
18) type, public, extends(simulation_base_type) :: simulation_surface_type
19) class(pmc_surface_type), pointer :: surf_flow_process_model_coupler
20) class(realization_surface_type), pointer :: surf_realization
21) type(regression_type), pointer :: regression
22) type(waypoint_list_type), pointer :: waypoint_list_surface
23) contains
24) procedure, public :: Init => SurfaceSimulationInit
25) procedure, public :: InputRecord => SurfaceSimInputRecord
26) procedure, public :: InitializeRun => SurfaceInitializeRun
27) procedure, public :: FinalizeRun => SurfaceFinalizeRun
28) procedure, public :: Strip => SurfaceSimulationStrip
29) end type simulation_surface_type
30)
31) public :: SurfaceSimulationCreate, &
32) SurfaceSimulationInit, &
33) SurfaceFinalizeRun, &
34) SurfaceSimulationStrip, &
35) SurfaceSimulationDestroy
36)
37) contains
38)
39) ! ************************************************************************** !
40)
41) function SurfaceSimulationCreate(option)
42) !
43) ! This routine
44) !
45) ! Author: Gautam Bisht, LBNL
46) ! Date: 06/27/13
47) !
48)
49) use Option_module
50)
51) implicit none
52)
53) type(option_type), pointer :: option
54)
55) class(simulation_surface_type), pointer :: SurfaceSimulationCreate
56)
57) print *, 'SurfaceSimulationCreate'
58)
59) allocate(SurfaceSimulationCreate)
60) call SurfaceSimulationCreate%Init(option)
61)
62) end function SurfaceSimulationCreate
63)
64) ! ************************************************************************** !
65)
66) subroutine SurfaceSimulationInit(this,option)
67) !
68) ! This routine
69) !
70) ! Author: Gautam Bisht, LBNL
71) ! Date: 06/27/13
72) !
73) use Waypoint_module
74) use Option_module
75)
76) implicit none
77)
78) class(simulation_surface_type) :: this
79) type(option_type), pointer :: option
80)
81) call SimulationBaseInit(this,option)
82) nullify(this%regression)
83) this%waypoint_list_surface => WaypointListCreate()
84)
85) end subroutine SurfaceSimulationInit
86)
87) ! ************************************************************************** !
88)
89) subroutine SurfaceSimInputRecord(this)
90) !
91) ! Writes ingested information to the input record file.
92) !
93) ! Author: Jenn Frederick, SNL
94) ! Date: 03/17/2016
95) !
96) use Output_module
97)
98) implicit none
99)
100) class(simulation_surface_type) :: this
101)
102) character(len=MAXWORDLENGTH) :: word
103) PetscInt :: id = INPUT_RECORD_UNIT
104)
105) write(id,'(a29)',advance='no') 'simulation type: '
106) write(id,'(a)') 'surface'
107)
108) ! print output file information
109) call OutputInputRecord(this%output_option,this%waypoint_list_surface)
110)
111) end subroutine SurfaceSimInputRecord
112)
113) ! ************************************************************************** !
114)
115) subroutine SurfaceInitializeRun(this)
116) !
117) ! This routine
118) !
119) ! Author: Gautam Bisht, LBNL
120) ! Date: 06/27/13
121) !
122)
123) use Logging_module
124) use Output_module
125)
126) implicit none
127)
128) class(simulation_surface_type) :: this
129)
130) class(pmc_base_type), pointer :: cur_process_model_coupler
131) class(pmc_base_type), pointer :: cur_process_model_coupler_top
132) class(pmc_base_type), pointer :: cur_process_model_coupler_below
133) PetscInt :: depth
134) PetscErrorCode :: ierr
135)
136) call printMsg(this%option,'SurfaceInitializeRun: Simulation%InitializeRun()')
137)
138) cur_process_model_coupler => this%process_model_coupler_list
139) do
140) if (.not.associated(cur_process_model_coupler)) exit
141) depth = 0
142) call cur_process_model_coupler%InitializeRun()
143) cur_process_model_coupler => cur_process_model_coupler%peer
144) enddo
145)
146) ! set depth in tree
147) cur_process_model_coupler_top => this%process_model_coupler_list
148) do
149) if (.not.associated(cur_process_model_coupler_top)) exit
150) depth = 0
151) cur_process_model_coupler_below => cur_process_model_coupler_top%child
152) do
153) if (.not.associated(cur_process_model_coupler_below)) exit
154) depth = depth + 1
155) cur_process_model_coupler_below => cur_process_model_coupler_below%child
156) enddo
157) cur_process_model_coupler_top => cur_process_model_coupler_top%peer
158) enddo
159)
160) end subroutine SurfaceInitializeRun
161)
162) ! ************************************************************************** !
163)
164) subroutine SurfaceFinalizeRun(this)
165) !
166) ! This routine
167) !
168) ! Author: Gautam Bisht, LBNL
169) ! Date: 06/27/13
170) !
171)
172) use Timestepper_Base_class
173)
174) implicit none
175)
176) class(simulation_surface_type) :: this
177)
178) PetscErrorCode :: ierr
179)
180) class(timestepper_base_type), pointer :: surf_flow_timestepper
181)
182) call printMsg(this%option,'SurfaceFinalizeRun()')
183)
184) call SimulationBaseFinalizeRun(this)
185)
186) nullify(surf_flow_timestepper)
187) surf_flow_timestepper => this%surf_flow_process_model_coupler%timestepper
188)
189) end subroutine SurfaceFinalizeRun
190)
191) ! ************************************************************************** !
192)
193) subroutine SurfaceSimulationStrip(this)
194) !
195) ! This routine
196) !
197) ! Author: Gautam Bisht, LBNL
198) ! Date: 06/27/13
199) !
200)
201) implicit none
202)
203) class(simulation_surface_type) :: this
204)
205) call printMsg(this%option,'SurfaceSimulationStrip()')
206)
207) call SimulationBaseStrip(this)
208) call RealizSurfStrip(this%surf_realization)
209) deallocate(this%surf_realization)
210) nullify(this%surf_realization)
211) call RegressionDestroy(this%regression)
212) call WaypointListDestroy(this%waypoint_list_surface)
213)
214) end subroutine SurfaceSimulationStrip
215)
216) ! ************************************************************************** !
217)
218) subroutine SurfaceSimulationDestroy(simulation)
219) !
220) ! This routine
221) !
222) ! Author: Gautam Bisht, LBNL
223) ! Date: 06/27/13
224) !
225)
226) implicit none
227)
228) class(simulation_surface_type), pointer :: simulation
229)
230) call printMsg(simulation%option,'SurfaceSimulationDestroy()')
231)
232) if (.not.associated(simulation)) return
233)
234) call simulation%Strip()
235) deallocate(simulation)
236) nullify(simulation)
237)
238) end subroutine SurfaceSimulationDestroy
239)
240) end module Simulation_Surface_class