factory_pflotran.F90 coverage: 71.43 %func 74.07 %block
1) module Factory_PFLOTRAN_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10)
11) public :: PFLOTRANInitializePrePetsc, &
12) PFLOTRANInitializePostPetsc, &
13) PFLOTRANFinalize
14)
15) contains
16)
17) ! ************************************************************************** !
18)
19) subroutine PFLOTRANInitializePrePetsc(multisimulation,option)
20) !
21) ! Sets up PFLOTRAN subsurface simulation framework prior to PETSc
22) ! initialization
23) ! Author: Glenn Hammond
24) ! Date: 06/07/13
25) !
26) use Option_module
27) use Input_Aux_module
28) use Multi_Simulation_module
29)
30) implicit none
31)
32) type(multi_simulation_type), pointer :: multisimulation
33) type(option_type) :: option
34)
35) character(len=MAXSTRINGLENGTH) :: string
36) PetscBool :: bool_flag
37) PetscBool :: option_found
38)
39) ! NOTE: Cannot add anything that requires PETSc in this routine as PETSc
40) ! has not yet been initialized.
41)
42) call PFLOTRANInitCommandLineSettings(option)
43) ! initialize stochastic realizations here
44) string = '-stochastic'
45) call InputGetCommandLineTruth(string,bool_flag,option_found,option)
46) if (option_found) then
47) multisimulation => MultiSimulationCreate()
48) call MultiSimulationInitialize(multisimulation,option)
49) endif
50)
51) end subroutine PFLOTRANInitializePrePetsc
52)
53) ! ************************************************************************** !
54)
55) subroutine PFLOTRANInitializePostPetsc(simulation,multisimulation,option)
56) !
57) ! Sets up PFLOTRAN subsurface simulation framework after PETSc initialization
58) ! Author: Glenn Hammond
59) ! Date: 06/17/13
60) !
61) use Option_module
62) use Multi_Simulation_module
63) use Simulation_Base_class
64) use Logging_module
65) use EOS_module
66) use PM_Surface_class
67) use PM_Geomechanics_Force_class
68) use PM_Subsurface_Flow_class
69) use PM_RT_class
70)
71) implicit none
72)
73) class(simulation_base_type), pointer :: simulation
74) type(multi_simulation_type), pointer :: multisimulation
75) type(option_type), pointer :: option
76)
77) character(len=MAXSTRINGLENGTH) :: filename
78) PetscErrorCode :: ierr
79)
80) ! must come after logging is created
81) call LoggingSetupComplete()
82) call MultiSimulationIncrement(multisimulation,option)
83) call OptionBeginTiming(option)
84)
85) ! popped in SimulationBaseInitializeRun()
86) call PetscLogStagePush(logging%stage(INIT_STAGE),ierr);CHKERRQ(ierr)
87) call PetscLogEventBegin(logging%event_init,ierr);CHKERRQ(ierr)
88)
89) call EOSInit()
90) filename = trim(option%global_prefix) // trim(option%group_prefix) // &
91) '.out'
92) if (option%myrank == option%io_rank .and. option%print_to_file) then
93) open(option%fid_out, file=filename, action="write", status="unknown")
94) endif
95)
96) call PFLOTRANReadSimulation(simulation,option)
97)
98) end subroutine PFLOTRANInitializePostPetsc
99)
100) ! ************************************************************************** !
101)
102) subroutine PFLOTRANReadSimulation(simulation,option)
103) !
104) ! Sets up PFLOTRAN subsurface simulation framework after PETSc initialization
105) ! Author: Glenn Hammond
106) ! Date: 06/17/13
107) !
108) use Option_module
109) use Input_Aux_module
110) use String_module
111)
112) use Simulation_Base_class
113) use Simulation_Subsurface_class
114) use Simulation_Surf_Subsurf_class
115) use Simulation_Geomechanics_class
116) use Simulation_Hydrogeophysics_class
117) use PM_Base_class
118) use PM_Surface_Flow_class
119) use PM_Surface_TH_class
120) use PM_Geomechanics_Force_class
121) use PM_Auxiliary_class
122) use PMC_Base_class
123) use Checkpoint_module
124) use Output_Aux_module
125) use Waypoint_module
126) use Units_module
127)
128) use Factory_Subsurface_module
129) use Factory_Hydrogeophysics_module
130) use Factory_Surf_Subsurf_module
131) use Factory_Geomechanics_module
132)
133) implicit none
134)
135) class(simulation_base_type), pointer :: simulation
136) type(option_type), pointer :: option
137)
138) type(input_type), pointer :: input
139) character(len=MAXSTRINGLENGTH) :: filename
140) character(len=MAXSTRINGLENGTH) :: string
141) character(len=MAXWORDLENGTH) :: word
142) character(len=MAXWORDLENGTH) :: name
143) character(len=MAXWORDLENGTH) :: simulation_type
144) character(len=MAXWORDLENGTH) :: internal_units
145)
146) class(pm_base_type), pointer :: pm_master
147) class(pm_base_type), pointer :: cur_pm
148) class(pm_base_type), pointer :: new_pm
149) type(checkpoint_option_type), pointer :: checkpoint_option
150) type(waypoint_list_type), pointer :: checkpoint_waypoint_list
151)
152) class(pmc_base_type), pointer :: pmc_master
153)
154) PetscBool :: print_ekg
155)
156) nullify(pm_master)
157) nullify(cur_pm)
158) nullify(new_pm)
159)
160) nullify(pmc_master)
161) nullify(checkpoint_option)
162) nullify(checkpoint_waypoint_list)
163) print_ekg = PETSC_FALSE
164)
165) input => InputCreate(IN_UNIT,option%input_filename,option)
166)
167) simulation_type = ''
168) string = 'SIMULATION'
169) call InputFindStringInFile(input,option,string)
170) call InputFindStringErrorMsg(input,option,string)
171) word = ''
172) do
173) call InputReadPflotranString(input,option)
174) if (InputCheckExit(input,option)) exit
175) call InputReadWord(input,option,word,PETSC_TRUE)
176) call InputErrorMsg(input,option,'PROCESS_MODEL','SIMULATION')
177)
178) call StringToUpper(word)
179) select case(trim(word))
180) case('SIMULATION_TYPE')
181) call InputReadWord(input,option,simulation_type,PETSC_TRUE)
182) call InputErrorMsg(input,option,'simulation_type', &
183) 'SIMULATION')
184) case('PROCESS_MODELS')
185) do
186) call InputReadPflotranString(input,option)
187) if (InputCheckExit(input,option)) exit
188) call InputReadWord(input,option,word,PETSC_TRUE)
189) call InputErrorMsg(input,option,'process_model', &
190) 'SIMULATION,PROCESS_MODELS')
191) call InputReadWord(input,option,name,PETSC_TRUE)
192) call InputErrorMsg(input,option,'name','SIMULATION,PROCESS_MODEL')
193) call StringToUpper(word)
194) select case(trim(word))
195) case('SUBSURFACE_FLOW')
196) call SubsurfaceReadFlowPM(input, option, new_pm)
197) case('SUBSURFACE_TRANSPORT')
198) call SubsurfaceReadRTPM(input, option, new_pm)
199) case('WASTE_FORM')
200) call SubsurfaceReadWasteFormPM(input, option,new_pm)
201) case('UFD_DECAY')
202) call SubsurfaceReadUFDDecayPM(input, option,new_pm)
203) case('HYDROGEOPHYSICS')
204) case('SURFACE_SUBSURFACE')
205) call SurfSubsurfaceReadFlowPM(input, option, new_pm)
206) case('GEOMECHANICS_SUBSURFACE')
207) option%geomech_on = PETSC_TRUE
208) new_pm => PMGeomechForceCreate()
209) case('AUXILIARY')
210) new_pm => PMAuxiliaryCreate()
211) input%buf = name
212) call PMAuxiliaryRead(input,option,PMAuxiliaryCast(new_pm))
213) case default
214) call InputKeywordUnrecognized(word, &
215) 'SIMULATION,PROCESS_MODELS',option)
216) end select
217) if (.not.associated(new_pm%option)) new_pm%option => option
218) new_pm%name = name
219) if (associated(cur_pm)) then
220) cur_pm%next => new_pm
221) else
222) cur_pm => new_pm
223) endif
224) if (.not.associated(pm_master)) then
225) pm_master => new_pm
226) endif
227) cur_pm => new_pm
228) nullify(new_pm)
229) enddo
230) case('MASTER')
231) call PFLOTRANSetupPMCHierarchy(input,option,pmc_master)
232) case('PRINT_EKG')
233) option%print_ekg = PETSC_TRUE
234) case('CHECKPOINT')
235) checkpoint_option => CheckpointOptionCreate()
236) checkpoint_waypoint_list => WaypointListCreate()
237) call CheckpointRead(input,option,checkpoint_option, &
238) checkpoint_waypoint_list)
239) case ('RESTART')
240) option%io_buffer = 'The RESTART card within SUBSURFACE block has &
241) &been deprecated.'
242) option%restart_flag = PETSC_TRUE
243) call InputReadNChars(input,option,option%restart_filename, &
244) MAXSTRINGLENGTH,PETSC_TRUE)
245) call InputErrorMsg(input,option,'RESTART','Restart file name')
246) call InputReadDouble(input,option,option%restart_time)
247) if (input%ierr == 0) then
248) call InputReadAndConvertUnits(input,option%restart_time, &
249) 'sec','RESTART,time units',option)
250) endif
251) case('INPUT_RECORD_FILE')
252) option%input_record = PETSC_TRUE
253) call OpenAndWriteInputRecord(option)
254) case default
255) call InputKeywordUnrecognized(word,'SIMULATION',option)
256) end select
257) enddo
258) call InputDestroy(input)
259)
260) if (.not.associated(pm_master)) then
261) option%io_buffer = 'No process models defined in SIMULATION block.'
262) call printErrMsg(option)
263) endif
264)
265) if (option%print_ekg) then
266) cur_pm => pm_master
267) do
268) if (.not.associated(cur_pm)) exit
269) cur_pm%print_ekg = PETSC_TRUE
270) cur_pm => cur_pm%next
271) enddo
272) endif
273)
274) ! create the simulation objects
275) select case(simulation_type)
276) case('SUBSURFACE')
277) simulation => SubsurfaceSimulationCreate(option)
278) case('HYDROGEOPHYSICS')
279) simulation => HydrogeophysicsCreate(option)
280) case('SURFACE_SUBSURFACE')
281) simulation => SurfSubsurfaceSimulationCreate(option)
282) case('GEOMECHANICS_SUBSURFACE')
283) simulation => GeomechanicsSimulationCreate(option)
284) case default
285) if (len_trim(simulation_type) == 0) then
286) option%io_buffer = 'A SIMULATION_TYPE (e.g. "SIMULATION_TYPE &
287) &SUBSURFACE") must be specified within the SIMULATION block.'
288) call printErrMsg(option)
289) endif
290) call InputKeywordUnrecognized(simulation_type, &
291) 'SIMULATION,SIMULATION_TYPE',option)
292) end select
293) simulation%process_model_list => pm_master
294) simulation%checkpoint_option => checkpoint_option
295) call WaypointListMerge(simulation%waypoint_list_outer, &
296) checkpoint_waypoint_list,option)
297) select type(simulation)
298) class is(simulation_subsurface_type)
299) call SubsurfaceInitialize(simulation)
300) class is(simulation_hydrogeophysics_type)
301) call HydrogeophysicsInitialize(simulation)
302) class is(simulation_surfsubsurface_type)
303) call SurfSubsurfaceInitialize(simulation)
304) class is(simulation_geomechanics_type)
305) call GeomechanicsInitialize(simulation)
306) end select
307)
308) end subroutine PFLOTRANReadSimulation
309)
310) ! ************************************************************************** !
311)
312) recursive subroutine PFLOTRANSetupPMCHierarchy(input,option,pmc)
313) !
314) ! Forms a linked list of named dummy pmcs as placeholders
315) ! Author: Glenn Hammond
316) ! Date: 12/10/14
317) !
318) use Option_module
319) use Input_Aux_module
320) use PMC_Base_class
321) use String_module
322)
323) implicit none
324)
325) type(input_type), pointer :: input
326) type(option_type) :: option
327) class(pmc_base_type), pointer :: pmc
328)
329) character(len=MAXWORDLENGTH) :: word
330)
331) call InputReadWord(input,option,word,PETSC_TRUE)
332) call InputErrorMsg(input,option,'PMC name','SIMULATION')
333) ! at this point, we are creating a
334) pmc => PMCBaseCreate()
335) pmc%name = word
336)
337) do
338) call InputReadPflotranString(input,option)
339) if (InputCheckExit(input,option)) exit
340) call InputReadWord(input,option,word,PETSC_TRUE)
341) call InputErrorMsg(input,option,'CHILD or PEER','SIMULATION')
342) call StringToUpper(word)
343) select case(trim(word))
344) case('PEER')
345) call PFLOTRANSetupPMCHierarchy(input,option,pmc%peer)
346) case('CHILD')
347) call PFLOTRANSetupPMCHierarchy(input,option,pmc%child)
348) case default
349) call InputKeywordUnrecognized(word,'PFLOTRANSetupPMCHierarchy',option)
350) end select
351) enddo
352)
353) end subroutine PFLOTRANSetupPMCHierarchy
354)
355) ! ************************************************************************** !
356)
357) recursive subroutine PFLOTRANLinkPMToPMC(input,option,pmc,pm)
358) !
359) ! Forms a linked list of named dummy pmcs as placeholders
360) ! Author: Glenn Hammond
361) ! Date: 12/10/14
362) !
363) use Option_module
364) use Input_Aux_module
365) use String_module
366) use PM_Base_class
367) use PMC_Base_class
368)
369) implicit none
370)
371) type(input_type), pointer :: input
372) type(option_type) :: option
373) class(pmc_base_type), pointer :: pmc
374) class(pm_base_type), pointer :: pm
375)
376) if (.not.associated(pmc)) return
377)
378) print *, pmc%name, pm%name
379) if (StringCompareIgnoreCase(pmc%name,pm%name)) then
380) pmc%pm_list => pm
381) return
382) endif
383)
384) call PFLOTRANLinkPMToPMC(input,option,pmc%peer,pm)
385) call PFLOTRANLinkPMToPMC(input,option,pmc%child,pm)
386)
387) end subroutine PFLOTRANLinkPMToPMC
388)
389) ! ************************************************************************** !
390)
391) subroutine PFLOTRANFinalize(option)
392) !
393) ! Destroys PFLOTRAN subsurface simulation framework
394) ! Author: Glenn Hammond
395) ! Date: 06/07/13
396) !
397) use Option_module
398) use Logging_module
399) use Output_EKG_module
400)
401) implicit none
402)
403) type(option_type) :: option
404) PetscErrorCode :: ierr
405)
406) ! pushed in FinalizeRun()
407) call PetscLogStagePop(ierr);CHKERRQ(ierr)
408) call OptionEndTiming(option)
409) if (OptionPrintToFile(option)) then
410) close(option%fid_out)
411) call OutputEKGFinalize()
412) endif
413)
414) end subroutine PFLOTRANFinalize
415)
416) ! ************************************************************************** !
417)
418) subroutine PFLOTRANInitCommandLineSettings(option)
419) !
420) ! Initializes PFLOTRAN output filenames, etc.
421) !
422) ! Author: Glenn Hammond
423) ! Date: 06/06/13
424) !
425)
426) use Option_module
427) use Input_Aux_module
428) use String_module
429)
430) implicit none
431)
432) type(option_type) :: option
433)
434) character(len=MAXSTRINGLENGTH) :: string, string2
435) PetscBool :: option_found
436) PetscBool :: bool_flag
437) PetscBool :: pflotranin_option_found
438) PetscBool :: input_prefix_option_found
439) character(len=MAXSTRINGLENGTH), pointer :: strings(:)
440) PetscInt :: i
441) PetscErrorCode :: ierr
442)
443) ! check for non-default input filename
444) option%input_filename = 'pflotran.in'
445) string = '-pflotranin'
446) call InputGetCommandLineString(string,option%input_filename, &
447) pflotranin_option_found,option)
448) string = '-input_prefix'
449) call InputGetCommandLineString(string,option%input_prefix, &
450) input_prefix_option_found,option)
451)
452) if (pflotranin_option_found .and. input_prefix_option_found) then
453) option%io_buffer = 'Cannot specify both "-pflotranin" and ' // &
454) '"-input_prefix" on the command lines.'
455) call printErrMsg(option)
456) else if (pflotranin_option_found) then
457) strings => StringSplit(option%input_filename,'.')
458) option%input_prefix = strings(1)
459) deallocate(strings)
460) nullify(strings)
461) else if (input_prefix_option_found) then
462) option%input_filename = trim(option%input_prefix) // '.in'
463) endif
464)
465) string = '-output_prefix'
466) call InputGetCommandLineString(string,option%global_prefix,option_found,option)
467) if (.not.option_found) option%global_prefix = option%input_prefix
468)
469) string = '-screen_output'
470) call InputGetCommandLineTruth(string,option%print_to_screen,option_found,option)
471)
472) string = '-file_output'
473) call InputGetCommandLineTruth(string,option%print_to_file,option_found,option)
474)
475) string = '-v'
476) call InputGetCommandLineInt(string,i,option_found,option)
477) if (option_found) option%verbosity = i
478)
479) string = '-successful_exit_code'
480) call InputGetCommandLineInt(string,i,option_found,option)
481) if (option_found) option%successful_exit_code = i
482)
483) ! this will get overwritten later if stochastic
484) string = '-realization_id'
485) call InputGetCommandLineInt(string,i,option_found,option)
486) if (option_found) then
487) if (i < 1) then
488) option%io_buffer = 'realization_id must be greater than zero.'
489) call printErrMsg(option)
490) endif
491) option%id = i
492) endif
493)
494) end subroutine PFLOTRANInitCommandLineSettings
495)
496) end module Factory_PFLOTRAN_module