option.F90 coverage: 57.58 %func 48.43 %block
1) module Option_module
2)
3) ! IMPORTANT NOTE: This module can have no dependencies on other modules!!!
4)
5) use PFLOTRAN_Constants_module
6) use Option_Flow_module
7) use Option_Transport_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14)
15)
16) type, public :: option_type
17)
18) type(flow_option_type), pointer :: flow
19) type(transport_option_type), pointer :: transport
20)
21) PetscInt :: id ! id of realization
22) PetscInt :: successful_exit_code ! code passed out of PFLOTRAN
23) ! indicating successful completion
24) ! of simulation
25) PetscMPIInt :: global_comm ! MPI_COMM_WORLD
26) PetscMPIInt :: global_rank ! rank in MPI_COMM_WORLD
27) PetscMPIInt :: global_commsize ! size of MPI_COMM_WORLD
28) PetscMPIInt :: global_group ! id of group for MPI_COMM_WORLD
29)
30) PetscMPIInt :: mycomm ! PETSC_COMM_WORLD
31) PetscMPIInt :: myrank ! rank in PETSC_COMM_WORLD
32) PetscMPIInt :: mycommsize ! size of PETSC_COMM_WORLD
33) PetscMPIInt :: mygroup ! id of group for PETSC_COMM_WORLD
34) PetscMPIInt :: mygroup_id
35)
36) ! don't place a character string near here. It causes the Windows Intel compiler
37) ! to crash. Don't know why....
38)
39) PetscMPIInt :: io_rank
40) PetscMPIInt :: hdf5_read_group_size, hdf5_write_group_size
41) PetscBool :: broadcast_read
42)
43) #if defined(SCORPIO)
44) PetscMPIInt :: ioread_group_id, iowrite_group_id
45) #endif
46)
47) character(len=MAXSTRINGLENGTH) :: io_buffer
48)
49) PetscInt :: fid_out
50) PetscInt :: fid_inputrecord
51)
52) ! defines the mode (e.g. mph, richards, vadose, etc.
53) character(len=MAXWORDLENGTH) :: flowmode
54) PetscInt :: iflowmode
55) character(len=MAXWORDLENGTH) :: tranmode
56) PetscInt :: itranmode
57)
58) PetscInt :: nphase
59) PetscInt :: liquid_phase
60) PetscInt :: gas_phase
61) PetscInt :: oil_phase
62) PetscInt :: nflowdof
63) PetscInt :: nflowspec
64) PetscInt :: nmechdof
65) PetscInt :: nsec_cells
66) PetscBool :: use_th_freezing
67)
68) PetscBool :: surf_flow_on
69) PetscInt :: nsurfflowdof
70) PetscInt :: subsurf_surf_coupling
71) PetscInt :: surface_flow_formulation
72) PetscReal :: surf_flow_time, surf_flow_dt
73) PetscReal :: surf_subsurf_coupling_time
74) PetscReal :: surf_subsurf_coupling_flow_dt
75) PetscReal :: surf_restart_time
76) PetscBool :: surf_restart_flag
77) character(len=MAXSTRINGLENGTH) :: surf_initialize_flow_filename
78) character(len=MAXSTRINGLENGTH) :: surf_restart_filename
79)
80) PetscBool :: geomech_on
81) PetscBool :: geomech_initial
82) PetscInt :: ngeomechdof
83) PetscInt :: n_stress_strain_dof
84) PetscReal :: geomech_time
85) PetscInt :: geomech_subsurf_coupling
86) PetscReal :: geomech_gravity(3)
87) PetscBool :: sec_vars_update
88) PetscInt :: air_pressure_id
89) PetscInt :: capillary_pressure_id
90) PetscInt :: vapor_pressure_id
91) PetscInt :: saturation_pressure_id
92) PetscInt :: water_id ! index of water component dof
93) PetscInt :: air_id ! index of air component dof
94) PetscInt :: oil_id ! index of oil component dof
95) PetscInt :: energy_id ! index of energy dof
96)
97) PetscInt :: ntrandof
98)
99) PetscInt :: iflag
100) PetscInt :: status
101) PetscBool :: input_record
102) !geh: remove once legacy code is gone.
103) ! PetscBool :: init_stage
104) ! these flags are for printing outside of time step loop
105) PetscBool :: print_to_screen
106) PetscBool :: print_to_file
107) ! these flags are for printing within time step loop where printing may
108) ! need to be temporarily turned off to accommodate periodic screen outout.
109) PetscBool :: print_screen_flag
110) PetscBool :: print_file_flag
111) PetscInt :: verbosity ! Values >0 indicate additional console output.
112)
113) PetscReal :: uniform_velocity(3)
114)
115) ! Program options
116) PetscBool :: use_matrix_free ! If true, do not form the Jacobian.
117)
118) PetscBool :: use_isothermal
119) PetscBool :: use_mc ! If true, multiple continuum formulation is used.
120) PetscBool :: set_secondary_init_temp ! If true, then secondary init temp is different from prim. init temp
121) PetscBool :: set_secondary_init_conc
122)
123) PetscBool :: update_flow_perm ! If true, permeability changes due to pressure
124)
125) PetscInt :: ice_model ! specify water/ice/vapor phase partitioning model
126)
127) PetscReal :: flow_time, tran_time, time ! The time elapsed in the simulation.
128) PetscReal :: flow_dt ! The size of the time step.
129) PetscReal :: tran_dt
130) PetscReal :: dt
131) PetscBool :: match_waypoint
132) PetscReal :: refactor_dt
133)
134) PetscReal :: gravity(3)
135)
136) PetscReal :: scale
137)
138) PetscReal :: m_nacl
139)
140) PetscInt :: ideriv
141) PetscInt :: idt_switch
142) PetscReal :: reference_temperature
143) PetscReal :: reference_pressure
144) PetscReal :: reference_water_density
145) PetscReal :: reference_porosity
146) PetscReal :: reference_saturation
147)
148) PetscBool :: converged
149)
150) PetscReal :: infnorm_res_sec ! inf. norm of secondary continuum rt residual
151)
152) PetscReal :: minimum_hydrostatic_pressure
153)
154) ! table lookup
155) PetscInt :: itable
156) PetscInt :: co2eos
157) character(len=MAXSTRINGLENGTH) :: co2_database_filename
158)
159) PetscBool :: restart_flag
160) PetscReal :: restart_time
161) character(len=MAXSTRINGLENGTH) :: restart_filename
162) character(len=MAXSTRINGLENGTH) :: input_filename
163)
164) PetscLogDouble :: start_time
165) PetscBool :: wallclock_stop_flag
166) PetscLogDouble :: wallclock_stop_time
167)
168) PetscInt :: log_stage(10)
169)
170) PetscBool :: numerical_derivatives_multi_coupling
171) PetscBool :: compute_statistics
172) PetscBool :: compute_mass_balance_new
173) PetscBool :: mass_bal_detailed
174) PetscBool :: use_touch_options
175) PetscBool :: overwrite_restart_transport
176) PetscBool :: overwrite_restart_flow
177) PetscInt :: io_handshake_buffer_size
178)
179) character(len=MAXSTRINGLENGTH) :: initialize_flow_filename
180) character(len=MAXSTRINGLENGTH) :: initialize_transport_filename
181)
182) character(len=MAXSTRINGLENGTH) :: input_prefix
183) character(len=MAXSTRINGLENGTH) :: global_prefix
184) character(len=MAXWORDLENGTH) :: group_prefix
185)
186) PetscBool :: steady_state
187) PetscBool :: use_matrix_buffer
188) PetscBool :: force_newton_iteration
189) PetscBool :: use_upwinding
190) PetscBool :: out_of_table
191)
192) ! Specify secondary continuum solver
193) PetscBool :: print_explicit_primal_grid ! prints primal grid if true
194) PetscBool :: print_explicit_dual_grid ! prints voronoi (dual) grid if true
195) PetscInt :: secondary_continuum_solver ! Specify secondary continuum solver
196)
197) PetscInt :: subsurface_simulation_type
198)
199) ! Type of averaging scheme for relative permeability
200) PetscInt :: rel_perm_aveg
201) PetscBool :: first_step_after_restart
202)
203) ! value of a cutoff for Manning's/Infiltration velocity
204) PetscReal :: max_manning_velocity
205) PetscReal :: max_infiltration_velocity
206)
207) ! when the scaling factor is too small, stop in reactive transport
208) PetscReal :: min_allowable_scale
209)
210) PetscBool :: print_ekg
211)
212) end type option_type
213)
214) PetscInt, parameter, public :: SUBSURFACE_SIM_TYPE = 1
215) PetscInt, parameter, public :: MULTISIMULATION_SIM_TYPE = 2
216) PetscInt, parameter, public :: STOCHASTIC_SIM_TYPE = 3
217)
218) interface printMsg
219) module procedure printMsg1
220) module procedure printMsg2
221) end interface
222)
223) interface printMsgAnyRank
224) module procedure printMsgAnyRank1
225) module procedure printMsgAnyRank2
226) end interface
227)
228) interface printMsgByRank
229) module procedure printMsgByRank1
230) module procedure printMsgByRank2
231) end interface
232)
233) interface printErrMsgByRank
234) module procedure printErrMsgByRank1
235) module procedure printErrMsgByRank2
236) end interface
237)
238) interface printErrMsgNoStopByRank
239) module procedure printErrMsgNoStopByRank1
240) module procedure printErrMsgNoStopByRank2
241) end interface
242)
243) interface printErrMsg
244) module procedure printErrMsg1
245) module procedure printErrMsg2
246) end interface
247)
248) interface printWrnMsg
249) module procedure printWrnMsg1
250) module procedure printWrnMsg2
251) end interface
252)
253) interface OptionInitMPI
254) module procedure OptionInitMPI1
255) module procedure OptionInitMPI2
256) end interface
257)
258) public :: OptionCreate, &
259) OptionCheckCommandLine, &
260) printErrMsg, &
261) printErrMsgByRank, &
262) printWrnMsg, &
263) printMsg, &
264) printMsgAnyRank, &
265) printMsgByRank, &
266) printErrMsgNoStopByRank, &
267) printVerboseMsg, &
268) OptionCheckTouch, &
269) OptionPrintToScreen, &
270) OptionPrintToFile, &
271) OptionInitRealization, &
272) OptionMeanVariance, &
273) OptionMaxMinMeanVariance, &
274) OptionInitMPI, &
275) OptionInitPetsc, &
276) OptionDivvyUpSimulations, &
277) OptionCreateProcessorGroups, &
278) OptionBeginTiming, &
279) OptionEndTiming, &
280) OptionFinalize, &
281) OptionDestroy
282)
283) contains
284)
285) ! ************************************************************************** !
286)
287) function OptionCreate()
288) !
289) ! Allocates and initializes a new Option object
290) !
291) ! Author: Glenn Hammond
292) ! Date: 10/25/07
293) !
294)
295) implicit none
296)
297) type(option_type), pointer :: OptionCreate
298)
299) type(option_type), pointer :: option
300)
301) allocate(option)
302) option%flow => OptionFlowCreate()
303) option%transport => OptionTransportCreate()
304)
305) ! DO NOT initialize members of the option type here. One must decide
306) ! whether the member needs initialization once for all stochastic
307) ! simulations or initialization for every realization (e.g. within multiple
308) ! stochastic simulations). This is done in OptionInitAll() and
309) ! OptionInitRealization()
310) call OptionInitAll(option)
311) OptionCreate => option
312)
313) end function OptionCreate
314)
315) ! ************************************************************************** !
316)
317) subroutine OptionInitAll(option)
318) !
319) ! Initializes all option variables
320) !
321) ! Author: Glenn Hammond
322) ! Date: 10/25/07
323) !
324)
325) implicit none
326)
327) type(option_type) :: option
328)
329) ! These variables should only be initialized once at the beginning of a
330) ! PFLOTRAN run (regardless of whether stochastic)
331)
332) call OptionFlowInitAll(option%flow)
333) call OptionTransportInitAll(option%transport)
334)
335) option%id = 0
336) option%successful_exit_code = 0
337)
338) option%global_comm = 0
339) option%global_rank = 0
340) option%global_commsize = 0
341) option%global_group = 0
342)
343) option%mycomm = 0
344) option%myrank = 0
345) option%mycommsize = 0
346) option%mygroup = 0
347) option%mygroup_id = 0
348)
349) option%input_prefix = 'pflotran'
350) option%group_prefix = ''
351) option%global_prefix = ''
352)
353) option%broadcast_read = PETSC_FALSE
354) option%io_rank = 0
355) option%hdf5_read_group_size = 0
356) option%hdf5_write_group_size = 0
357)
358) option%input_record = PETSC_FALSE
359) option%print_screen_flag = PETSC_FALSE
360) option%print_file_flag = PETSC_FALSE
361) option%print_to_screen = PETSC_TRUE
362) option%print_to_file = PETSC_TRUE
363) option%verbosity = 0
364)
365) option%input_filename = ''
366)
367) option%use_upwinding = PETSC_TRUE
368)
369) option%out_of_table = PETSC_FALSE
370)
371) option%subsurface_simulation_type = SUBSURFACE_SIM_TYPE
372)
373) option%rel_perm_aveg = UPWIND
374) option%first_step_after_restart = PETSC_FALSE
375)
376) call OptionInitRealization(option)
377)
378) end subroutine OptionInitAll
379)
380) ! ************************************************************************** !
381)
382) subroutine OptionInitRealization(option)
383) !
384) ! Initializes option variables specific to a single
385) ! realization
386) !
387) ! Author: Glenn Hammond
388) ! Date: 10/25/07
389) !
390)
391) implicit none
392)
393) type(option_type) :: option
394)
395) ! These variables should be initialized once at the beginning of every
396) ! PFLOTRAN realization or simulation of a single realization
397) call OptionFlowInitRealization(option%flow)
398) call OptionTransportInitRealization(option%transport)
399)
400)
401) option%fid_out = OUT_UNIT
402) option%fid_inputrecord = INPUT_RECORD_UNIT
403)
404) option%iflag = 0
405) option%io_buffer = ''
406)
407) option%use_isothermal = PETSC_FALSE
408) option%use_matrix_free = PETSC_FALSE
409) option%use_mc = PETSC_FALSE
410) option%set_secondary_init_temp = PETSC_FALSE
411) option%ice_model = PAINTER_EXPLICIT
412) option%set_secondary_init_conc = PETSC_FALSE
413)
414) option%update_flow_perm = PETSC_FALSE
415)
416) option%flowmode = ""
417) option%iflowmode = NULL_MODE
418) option%nflowdof = 0
419) option%nmechdof = 0
420) option%nsec_cells = 0
421) option%use_th_freezing = PETSC_FALSE
422)
423) option%nsurfflowdof = 0
424) option%surf_flow_on = PETSC_FALSE
425) option%subsurf_surf_coupling = DECOUPLED
426) option%surface_flow_formulation = DIFFUSION_WAVE
427) option%surf_flow_dt = 0.d0
428) option%surf_flow_time =0.d0
429) option%surf_subsurf_coupling_time = 0.d0
430) option%surf_subsurf_coupling_flow_dt = 0.d0
431) option%surf_initialize_flow_filename = ""
432) option%surf_restart_filename = ""
433) option%surf_restart_flag = PETSC_FALSE
434) option%surf_restart_time = UNINITIALIZED_DOUBLE
435)
436) option%geomech_on = PETSC_FALSE
437) option%geomech_initial = PETSC_FALSE
438) option%ngeomechdof = 0
439) option%n_stress_strain_dof = 0
440) option%geomech_time = 0.d0
441) option%geomech_subsurf_coupling = 0
442) option%geomech_gravity(:) = 0.d0
443) option%geomech_gravity(3) = -9.8068d0 ! m/s^2
444)
445) option%tranmode = ""
446) option%itranmode = NULL_MODE
447) option%ntrandof = 0
448)
449) option%nphase = 0
450) option%liquid_phase = 0
451) option%gas_phase = 0
452)
453) option%air_pressure_id = 0
454) option%capillary_pressure_id = 0
455) option%vapor_pressure_id = 0
456) option%saturation_pressure_id = 0
457)
458) option%water_id = 0
459) option%air_id = 0
460) option%energy_id = 0
461)
462) option%uniform_velocity = 0.d0
463)
464) !-----------------------------------------------------------------------
465) ! Initialize some parameters to sensible values. These are parameters
466) ! which should be set via the command line or the input file, but it
467) ! seems good practice to set them to sensible values when a pflowGrid
468) ! is created.
469) !-----------------------------------------------------------------------
470) option%reference_pressure = 101325.d0
471) option%reference_temperature = 25.d0
472) option%reference_water_density = 0.d0
473) option%reference_porosity = 0.25d0
474) option%reference_saturation = 1.d0
475)
476) option%converged = PETSC_FALSE
477)
478) option%infnorm_res_sec = 0.d0
479)
480) option%minimum_hydrostatic_pressure = -1.d20
481)
482) !set scale factor for heat equation, i.e. use units of MJ for energy
483) option%scale = 1.d-6
484)
485) option%ideriv = 1
486)
487) option%gravity(:) = 0.d0
488) option%gravity(3) = -9.8068d0 ! m/s^2
489)
490) !physical constants and defult variables
491) ! option%difaq = 1.d-9 ! m^2/s read from input file
492) ! option%difaq = 0.d0
493) ! option%delhaq = 12.6d0 ! kJ/mol read from input file
494) ! option%eqkair = 1.d10 ! Henry's constant for air: Xl = eqkair * pa
495)
496) ! default brine concentrations
497) option%m_nacl = 0.d0
498)
499) ! option%disp = 0.d0
500)
501) option%restart_flag = PETSC_FALSE
502) option%restart_filename = ""
503) option%restart_time = UNINITIALIZED_DOUBLE
504)
505) option%start_time = 0.d0
506) option%wallclock_stop_flag = PETSC_FALSE
507) option%wallclock_stop_time = 0.d0
508)
509) option%log_stage = 0
510)
511) option%numerical_derivatives_multi_coupling = PETSC_FALSE
512) option%compute_statistics = PETSC_FALSE
513) option%compute_mass_balance_new = PETSC_FALSE
514) option%mass_bal_detailed = PETSC_FALSE
515)
516) option%use_touch_options = PETSC_FALSE
517) option%overwrite_restart_transport = PETSC_FALSE
518) option%overwrite_restart_flow = PETSC_FALSE
519)
520) option%time = 0.d0
521) option%flow_dt = 0.d0
522) option%tran_dt = 0.d0
523) option%dt = 0.d0
524) option%refactor_dt = 0.d0
525) option%match_waypoint = PETSC_FALSE
526)
527) option%io_handshake_buffer_size = 0
528)
529) option%initialize_flow_filename = ''
530) option%initialize_transport_filename = ''
531)
532) option%steady_state = PETSC_FALSE
533)
534) option%itable = 0
535) option%co2eos = EOS_SPAN_WAGNER
536) option%co2_database_filename = ''
537)
538) ! option%idt_switch = 1
539) option%idt_switch = -1
540)
541) option%use_matrix_buffer = PETSC_FALSE
542) option%status = PROCEED
543) option%force_newton_iteration = PETSC_FALSE
544) option%print_explicit_primal_grid = PETSC_FALSE
545) option%print_explicit_dual_grid = PETSC_FALSE
546) option%secondary_continuum_solver = 1
547)
548) ! initially set to a large value to effectively disable
549) option%max_manning_velocity = 1.d20
550) option%max_infiltration_velocity = 1.d20
551)
552) ! when the scaling factor is too small, stop in reactive transport
553) option%min_allowable_scale = 1.0d-10
554)
555) option%print_ekg = PETSC_FALSE
556)
557) end subroutine OptionInitRealization
558)
559) ! ************************************************************************** !
560)
561) subroutine OptionCheckCommandLine(option)
562) !
563) ! Checks all PETSc options on input
564) !
565) ! Author: Glenn Hammond
566) ! Date: 10/26/07
567) !
568)
569) implicit none
570)
571) type(option_type) :: option
572)
573) PetscBool :: option_found
574) PetscInt :: temp_int
575) PetscErrorCode :: ierr
576) character(len=MAXSTRINGLENGTH) :: string
577)
578) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
579) PETSC_NULL_CHARACTER, "-buffer_matrix", &
580) option%use_matrix_buffer, ierr);CHKERRQ(ierr)
581) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
582) PETSC_NULL_CHARACTER, "-snes_mf", &
583) option%use_matrix_free, ierr);CHKERRQ(ierr)
584) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
585) PETSC_NULL_CHARACTER, "-use_isothermal", &
586) option%use_isothermal, ierr);CHKERRQ(ierr)
587) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
588) PETSC_NULL_CHARACTER, "-use_mc", &
589) option%use_mc, ierr);CHKERRQ(ierr)
590)
591) call PetscOptionsGetString(PETSC_NULL_OBJECT,PETSC_NULL_CHARACTER, &
592) '-restart', option%restart_filename, &
593) option%restart_flag, ierr);CHKERRQ(ierr)
594) ! check on possible modes
595) option_found = PETSC_FALSE
596) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
597) PETSC_NULL_CHARACTER, "-use_richards", &
598) option_found, ierr);CHKERRQ(ierr)
599) if (option_found) option%flowmode = "richards"
600) option_found = PETSC_FALSE
601) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
602) PETSC_NULL_CHARACTER, "-use_thc", &
603) option_found, ierr);CHKERRQ(ierr)
604) if (option_found) option%flowmode = "thc"
605) option_found = PETSC_FALSE
606) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
607) PETSC_NULL_CHARACTER, "-use_mph", &
608) option_found, ierr);CHKERRQ(ierr)
609) if (option_found) option%flowmode = "mph"
610) option_found = PETSC_FALSE
611) call PetscOptionsHasName(PETSC_NULL_OBJECT, &
612) PETSC_NULL_CHARACTER, "-use_flash2", &
613) option_found, ierr);CHKERRQ(ierr)
614) if (option_found) option%flowmode = "flash2"
615)
616) end subroutine OptionCheckCommandLine
617)
618) ! ************************************************************************** !
619)
620) subroutine printErrMsg1(option)
621) !
622) ! Prints the error message from p0 and stops
623) !
624) ! Author: Glenn Hammond
625) ! Date: 10/26/07
626) !
627)
628) implicit none
629)
630) type(option_type) :: option
631)
632) call printErrMsg2(option,option%io_buffer)
633)
634) end subroutine printErrMsg1
635)
636) ! ************************************************************************** !
637)
638) subroutine printErrMsg2(option,string)
639) !
640) ! Prints the error message from p0 and stops
641) !
642) ! Author: Glenn Hammond
643) ! Date: 10/26/07
644) !
645)
646) implicit none
647)
648) type(option_type) :: option
649) character(len=*) :: string
650)
651) PetscBool :: petsc_initialized
652) PetscErrorCode :: ierr
653)
654) if (OptionPrintToScreen(option)) then
655) print *
656) print *, 'ERROR: ' // trim(string)
657) print *
658) print *, 'Stopping!'
659) endif
660) call MPI_Barrier(option%mycomm,ierr)
661) call PetscInitialized(petsc_initialized, ierr);CHKERRQ(ierr)
662) if (petsc_initialized) then
663) call PetscFinalize(ierr);CHKERRQ(ierr)
664) endif
665) stop
666)
667) end subroutine printErrMsg2
668)
669) ! ************************************************************************** !
670)
671) subroutine printErrMsgByRank1(option)
672) !
673) ! Prints the error message from processor with error along
674) ! with rank
675) !
676) ! Author: Glenn Hammond
677) ! Date: 11/04/11
678) !
679)
680) implicit none
681)
682) type(option_type) :: option
683)
684) call printErrMsgByRank2(option,option%io_buffer)
685)
686) end subroutine printErrMsgByRank1
687)
688) ! ************************************************************************** !
689)
690) subroutine printErrMsgByRank2(option,string)
691) !
692) ! Prints the error message from processor with error along
693) ! with rank
694) !
695) ! Author: Glenn Hammond
696) ! Date: 11/04/11
697) !
698)
699) implicit none
700)
701) type(option_type) :: option
702) character(len=*) :: string
703)
704) character(len=MAXWORDLENGTH) :: word
705)
706) write(word,*) option%myrank
707) print *
708) print *, 'ERROR(' // trim(adjustl(word)) // '): ' // trim(string)
709) print *
710) print *, 'Stopping!'
711) stop
712)
713) end subroutine printErrMsgByRank2
714)
715) ! ************************************************************************** !
716)
717) ! ************************************************************************** !
718)
719) subroutine printErrMsgNoStopByRank1(option)
720) !
721) ! Prints the error message from processor with error along
722) ! with rank
723) !
724) ! Author: Glenn Hammond
725) ! Date: 11/04/11
726) !
727)
728) implicit none
729)
730) type(option_type) :: option
731)
732) call printErrMsgNoStopByRank2(option,option%io_buffer)
733)
734) end subroutine printErrMsgNoStopByRank1
735)
736) ! ************************************************************************** !
737)
738) subroutine printErrMsgNoStopByRank2(option,string)
739) !
740) ! Prints the error message from processor with error along
741) ! with rank
742) !
743) ! Author: Glenn Hammond
744) ! Date: 11/04/11
745) !
746)
747) implicit none
748)
749) type(option_type) :: option
750) character(len=*) :: string
751)
752) character(len=MAXWORDLENGTH) :: word
753)
754) write(word,*) option%myrank
755) print *
756) print *, 'ERROR(' // trim(adjustl(word)) // '): ' // trim(string)
757) print *
758)
759) end subroutine printErrMsgNoStopByRank2
760)
761) ! ************************************************************************** !
762)
763) subroutine printWrnMsg1(option)
764) !
765) ! Prints the warning message from p0
766) !
767) ! Author: Glenn Hammond
768) ! Date: 10/26/07
769) !
770)
771) implicit none
772)
773) type(option_type) :: option
774)
775) call printWrnMsg2(option,option%io_buffer)
776)
777) end subroutine printWrnMsg1
778)
779) ! ************************************************************************** !
780)
781) subroutine printWrnMsg2(option,string)
782) !
783) ! Prints the warning message from p0
784) !
785) ! Author: Glenn Hammond
786) ! Date: 10/26/07
787) !
788)
789) implicit none
790)
791) type(option_type) :: option
792) character(len=*) :: string
793)
794) if (OptionPrintToScreen(option)) print *, 'WARNING: ' // trim(string)
795)
796) end subroutine printWrnMsg2
797)
798) ! ************************************************************************** !
799)
800) subroutine printMsg1(option)
801) !
802) ! Prints the message from p0
803) !
804) ! Author: Glenn Hammond
805) ! Date: 11/14/07
806) !
807)
808) implicit none
809)
810) type(option_type) :: option
811)
812) call printMsg2(option,option%io_buffer)
813)
814) end subroutine printMsg1
815)
816) ! ************************************************************************** !
817)
818) subroutine printMsg2(option,string)
819) !
820) ! Prints the message from p0
821) !
822) ! Author: Glenn Hammond
823) ! Date: 11/14/07
824) !
825)
826) implicit none
827)
828) type(option_type) :: option
829) character(len=*) :: string
830)
831) if (OptionPrintToScreen(option)) print *, trim(string)
832)
833) end subroutine printMsg2
834)
835) ! ************************************************************************** !
836)
837) subroutine printMsgAnyRank1(option)
838) !
839) ! Prints the message from any processor core
840) !
841) ! Author: Glenn Hammond
842) ! Date: 01/12/12
843) !
844)
845) implicit none
846)
847) type(option_type) :: option
848)
849) call printMsgAnyRank2(option%io_buffer)
850)
851) end subroutine printMsgAnyRank1
852)
853) ! ************************************************************************** !
854)
855) subroutine printMsgAnyRank2(string)
856) !
857) ! Prints the message from any processor core
858) !
859) ! Author: Glenn Hammond
860) ! Date: 01/12/12
861) !
862)
863) implicit none
864)
865) character(len=*) :: string
866)
867) print *, trim(string)
868)
869) end subroutine printMsgAnyRank2
870)
871) ! ************************************************************************** !
872)
873) subroutine printMsgByRank1(option)
874) !
875) ! Prints a message from processor along with rank
876) !
877) ! Author: Glenn Hammond
878) ! Date: 03/27/12
879) !
880)
881) implicit none
882)
883) type(option_type) :: option
884)
885) call printMsgByRank2(option,option%io_buffer)
886)
887) end subroutine printMsgByRank1
888)
889) ! ************************************************************************** !
890)
891) subroutine printMsgByRank2(option,string)
892) !
893) ! Prints a message from processor along with rank
894) !
895) ! Author: Glenn Hammond
896) ! Date: 03/27/12
897) !
898)
899) implicit none
900)
901) type(option_type) :: option
902) character(len=*) :: string
903)
904) character(len=MAXWORDLENGTH) :: word
905)
906) write(word,*) option%myrank
907) print *, '(' // trim(adjustl(word)) // '): ' // trim(string)
908)
909) end subroutine printMsgByRank2
910)
911) ! ************************************************************************** !
912)
913) subroutine printVerboseMsg(option)
914) !
915) ! Prints the message from p0
916) !
917) ! Author: Glenn Hammond
918) ! Date: 11/14/07
919) !
920)
921) implicit none
922)
923) type(option_type) :: option
924)
925) if (option%verbosity > 0) then
926) call printMsg(option,option%io_buffer)
927) endif
928)
929) end subroutine printVerboseMsg
930)
931) ! ************************************************************************** !
932)
933) function OptionCheckTouch(option,filename)
934) !
935) ! Users can steer the code by touching files.
936) !
937) ! Author: Glenn Hammond
938) ! Date: 03/04/08
939) !
940)
941) implicit none
942)
943) type(option_type) :: option
944) character(len=MAXSTRINGLENGTH) :: filename
945)
946) PetscInt :: ios
947) PetscInt :: fid = 86
948) PetscBool :: OptionCheckTouch
949) PetscErrorCode :: ierr
950)
951) OptionCheckTouch = PETSC_FALSE
952)
953) if (option%myrank == option%io_rank) &
954) open(unit=fid,file=trim(filename),status='old',iostat=ios)
955) call MPI_Bcast(ios,ONE_INTEGER_MPI,MPIU_INTEGER,option%io_rank, &
956) option%mycomm,ierr)
957)
958) if (ios == 0) then
959) if (option%myrank == option%io_rank) close(fid,status='delete')
960) OptionCheckTouch = PETSC_TRUE
961) endif
962)
963) end function OptionCheckTouch
964)
965) ! ************************************************************************** !
966)
967) function OptionPrintToScreen(option)
968) !
969) ! Determines whether printing should occur
970) !
971) ! Author: Glenn Hammond
972) ! Date: 12/09/08
973) !
974)
975) implicit none
976)
977) type(option_type) :: option
978)
979) PetscBool :: OptionPrintToScreen
980)
981) if (option%myrank == option%io_rank .and. option%print_to_screen) then
982) OptionPrintToScreen = PETSC_TRUE
983) else
984) OptionPrintToScreen = PETSC_FALSE
985) endif
986)
987) end function OptionPrintToScreen
988)
989) ! ************************************************************************** !
990)
991) function OptionPrintToFile(option)
992) !
993) ! Determines whether printing to file should occur
994) !
995) ! Author: Glenn Hammond
996) ! Date: 01/29/09
997) !
998)
999) implicit none
1000)
1001) type(option_type) :: option
1002)
1003) PetscBool :: OptionPrintToFile
1004)
1005) if (option%myrank == option%io_rank .and. option%print_to_file) then
1006) OptionPrintToFile = PETSC_TRUE
1007) else
1008) OptionPrintToFile = PETSC_FALSE
1009) endif
1010)
1011) end function OptionPrintToFile
1012)
1013) ! ************************************************************************** !
1014)
1015) subroutine OptionMaxMinMeanVariance(value,max,min,mean,variance, &
1016) calculate_variance,option)
1017) !
1018) ! Calculates the maximum, minumum, mean and
1019) ! optionally variance of a number across processor
1020) ! cores
1021) !
1022) ! Author: Glenn Hammond
1023) ! Date: 06/01/10
1024) !
1025)
1026) implicit none
1027)
1028) type(option_type) :: option
1029) PetscReal :: value
1030) PetscReal :: max
1031) PetscReal :: min
1032) PetscReal :: mean
1033) PetscReal :: variance
1034) PetscBool :: calculate_variance
1035)
1036) PetscReal :: temp_real_in(2), temp_real_out(2)
1037) PetscErrorCode :: ierr
1038)
1039) temp_real_in(1) = value
1040) temp_real_in(2) = -1.d0*value
1041) call MPI_Allreduce(temp_real_in,temp_real_out,TWO_INTEGER_MPI, &
1042) MPI_DOUBLE_PRECISION, &
1043) MPI_MAX,option%mycomm,ierr)
1044) max = temp_real_out(1)
1045) min = -1.d0*temp_real_out(2)
1046)
1047) call OptionMeanVariance(value,mean,variance,calculate_variance,option)
1048)
1049) end subroutine OptionMaxMinMeanVariance
1050)
1051) ! ************************************************************************** !
1052)
1053) subroutine OptionMeanVariance(value,mean,variance,calculate_variance,option)
1054) !
1055) ! Calculates the mean and optionally variance of a number
1056) ! across processor cores
1057) !
1058) ! Author: Glenn Hammond
1059) ! Date: 05/29/10
1060) !
1061)
1062) implicit none
1063)
1064) type(option_type) :: option
1065) PetscReal :: value
1066) PetscReal :: mean
1067) PetscReal :: variance
1068) PetscBool :: calculate_variance
1069)
1070) PetscReal :: temp_real
1071) PetscErrorCode :: ierr
1072)
1073) call MPI_Allreduce(value,temp_real,ONE_INTEGER_MPI,MPI_DOUBLE_PRECISION, &
1074) MPI_SUM,option%mycomm,ierr)
1075) mean = temp_real / dble(option%mycommsize)
1076)
1077) if (calculate_variance) then
1078) temp_real = value-mean
1079) temp_real = temp_real*temp_real
1080) call MPI_Allreduce(temp_real,variance,ONE_INTEGER_MPI, &
1081) MPI_DOUBLE_PRECISION, &
1082) MPI_SUM,option%mycomm,ierr)
1083) variance = variance / dble(option%mycommsize)
1084) endif
1085)
1086) end subroutine OptionMeanVariance
1087)
1088) ! ************************************************************************** !
1089)
1090) subroutine OptionInitMPI1(option)
1091) !
1092) ! Initializes base MPI communicator
1093) !
1094) ! Author: Glenn Hammond
1095) ! Date: 06/06/13
1096) !
1097)
1098) implicit none
1099)
1100) type(option_type) :: option
1101)
1102) PetscErrorCode :: ierr
1103)
1104) call MPI_Init(ierr)
1105) call OptionInitMPI2(option,MPI_COMM_WORLD)
1106)
1107) end subroutine OptionInitMPI1
1108)
1109) ! ************************************************************************** !
1110)
1111) subroutine OptionInitMPI2(option,communicator)
1112) !
1113) ! Initializes base MPI communicator
1114) !
1115) ! Author: Glenn Hammond
1116) ! Date: 06/06/13
1117) !
1118)
1119) implicit none
1120)
1121) type(option_type) :: option
1122)
1123) PetscMPIInt :: communicator
1124) PetscErrorCode :: ierr
1125)
1126) option%global_comm = communicator
1127) call MPI_Comm_rank(communicator,option%global_rank, ierr)
1128) call MPI_Comm_size(communicator,option%global_commsize,ierr)
1129) call MPI_Comm_group(communicator,option%global_group,ierr)
1130) option%mycomm = option%global_comm
1131) option%myrank = option%global_rank
1132) option%mycommsize = option%global_commsize
1133) option%mygroup = option%global_group
1134)
1135) end subroutine OptionInitMPI2
1136)
1137) ! ************************************************************************** !
1138)
1139) subroutine OptionInitPetsc(option)
1140) !
1141) ! Initialization of PETSc.
1142) !
1143) ! Author: Glenn Hammond
1144) ! Date: 06/07/13
1145) !
1146)
1147) use Logging_module
1148)
1149) implicit none
1150)
1151) type(option_type) :: option
1152)
1153) character(len=MAXSTRINGLENGTH) :: string
1154) PetscErrorCode :: ierr
1155)
1156) PETSC_COMM_WORLD = option%mycomm
1157) call PetscInitialize(PETSC_NULL_CHARACTER, ierr);CHKERRQ(ierr) !fmy: tiny memory leak here (don't know why)
1158)
1159) if (option%verbosity > 0) then
1160) call PetscLogDefaultBegin(ierr);CHKERRQ(ierr)
1161) string = '-log_view'
1162) call PetscOptionsInsertString(PETSC_NULL_OBJECT, &
1163) string, ierr);CHKERRQ(ierr)
1164) endif
1165)
1166) call LoggingCreate()
1167)
1168) end subroutine OptionInitPetsc
1169)
1170) ! ************************************************************************** !
1171)
1172) subroutine OptionBeginTiming(option)
1173) !
1174) ! Start outer timing.
1175) !
1176) ! Author: Glenn Hammond
1177) ! Date: 06/07/13
1178) !
1179)
1180) use Logging_module
1181)
1182) implicit none
1183)
1184) #include "petsc/finclude/petsclog.h"
1185)
1186) type(option_type) :: option
1187)
1188) PetscLogDouble :: timex_wall
1189) PetscErrorCode :: ierr
1190)
1191) call PetscTime(timex_wall, ierr);CHKERRQ(ierr)
1192) option%start_time = timex_wall
1193)
1194) end subroutine OptionBeginTiming
1195)
1196) ! ************************************************************************** !
1197)
1198) subroutine OptionEndTiming(option)
1199) !
1200) ! End timing.
1201) !
1202) ! Author: Glenn Hammond
1203) ! Date: 06/07/13
1204) !
1205)
1206) use Logging_module
1207)
1208) implicit none
1209)
1210) #include "petsc/finclude/petsclog.h"
1211)
1212) type(option_type) :: option
1213)
1214) PetscLogDouble :: timex_wall
1215) PetscErrorCode :: ierr
1216)
1217) ! Final Time
1218) call PetscTime(timex_wall, ierr);CHKERRQ(ierr)
1219)
1220) if (option%myrank == option%io_rank) then
1221)
1222) if (option%print_to_screen) then
1223) write(*,'(/," Wall Clock Time:", 1pe12.4, " [sec] ", &
1224) & 1pe12.4, " [min] ", 1pe12.4, " [hr]")') &
1225) timex_wall-option%start_time, &
1226) (timex_wall-option%start_time)/60.d0, &
1227) (timex_wall-option%start_time)/3600.d0
1228) endif
1229) if (option%print_to_file) then
1230) write(option%fid_out,'(/," Wall Clock Time:", 1pe12.4, " [sec] ", &
1231) & 1pe12.4, " [min] ", 1pe12.4, " [hr]")') &
1232) timex_wall-option%start_time, &
1233) (timex_wall-option%start_time)/60.d0, &
1234) (timex_wall-option%start_time)/3600.d0
1235) endif
1236) endif
1237)
1238) end subroutine OptionEndTiming
1239)
1240) ! ************************************************************************** !
1241)
1242) subroutine OptionDivvyUpSimulations(option,filenames)
1243) !
1244) ! Divides simulation in to multple simulations with
1245) ! multiple input decks
1246) !
1247) ! Author: Glenn Hammond
1248) ! Date: 06/06/13
1249) !
1250)
1251) implicit none
1252)
1253) type(option_type) :: option
1254)
1255) PetscInt :: i
1256) character(len=MAXSTRINGLENGTH) :: string
1257) character(len=MAXSTRINGLENGTH), pointer :: filenames(:)
1258)
1259) i = size(filenames)
1260) call OptionCreateProcessorGroups(option,i)
1261) option%input_filename = filenames(option%mygroup_id)
1262) i = index(option%input_filename,'.',PETSC_TRUE)
1263) if (i > 1) then
1264) i = i-1
1265) else
1266) ! for some reason len_trim doesn't work on MS Visual Studio in
1267) ! this location
1268) i = len(trim(option%input_filename))
1269) endif
1270) option%global_prefix = option%input_filename(1:i)
1271) write(string,*) option%mygroup_id
1272) option%group_prefix = 'G' // trim(adjustl(string))
1273)
1274) end subroutine OptionDivvyUpSimulations
1275)
1276) ! ************************************************************************** !
1277)
1278) subroutine OptionCreateProcessorGroups(option,num_groups)
1279) !
1280) ! Splits MPI_COMM_WORLD into N separate
1281) ! processor groups
1282) !
1283) ! Author: Glenn Hammond
1284) ! Date: 08/11/09
1285) !
1286)
1287) implicit none
1288)
1289) type(option_type) :: option
1290) PetscInt :: num_groups
1291)
1292) PetscInt :: local_commsize
1293) PetscInt :: offset, delta, remainder
1294) PetscInt :: igroup
1295) PetscMPIInt :: mycolor_mpi, mykey_mpi
1296) PetscErrorCode :: ierr
1297)
1298) local_commsize = option%global_commsize / num_groups
1299) remainder = option%global_commsize - num_groups * local_commsize
1300) offset = 0
1301) do igroup = 1, num_groups
1302) delta = local_commsize
1303) if (igroup < remainder) delta = delta + 1
1304) if (option%global_rank >= offset .and. &
1305) option%global_rank < offset + delta) exit
1306) offset = offset + delta
1307) enddo
1308) mycolor_mpi = igroup
1309) option%mygroup_id = igroup
1310) mykey_mpi = option%global_rank - offset
1311) call MPI_Comm_split(MPI_COMM_WORLD,mycolor_mpi,mykey_mpi,option%mycomm,ierr)
1312) call MPI_Comm_group(option%mycomm,option%mygroup,ierr)
1313)
1314) call MPI_Comm_rank(option%mycomm,option%myrank, ierr)
1315) call MPI_Comm_size(option%mycomm,option%mycommsize,ierr)
1316)
1317) end subroutine OptionCreateProcessorGroups
1318)
1319) ! ************************************************************************** !
1320)
1321) subroutine OptionFinalize(option)
1322) !
1323) ! End the simulation.
1324) !
1325) ! Author: Glenn Hammond
1326) ! Date: 06/07/13
1327) !
1328)
1329) use Logging_module
1330)
1331) implicit none
1332)
1333) type(option_type), pointer :: option
1334)
1335) PetscInt :: iflag
1336) PetscErrorCode :: ierr
1337)
1338) call LoggingDestroy()
1339) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
1340) '-options_left','no',ierr);CHKERRQ(ierr)
1341) ! list any PETSc objects that have not been freed - for debugging
1342) call PetscOptionsSetValue(PETSC_NULL_OBJECT, &
1343) '-objects_left','yes',ierr);CHKERRQ(ierr)
1344) call MPI_Barrier(option%global_comm,ierr)
1345) iflag = option%successful_exit_code
1346) call OptionDestroy(option)
1347) call PetscFinalize(ierr);CHKERRQ(ierr)
1348) call MPI_Finalize(ierr)
1349) call exit(iflag)
1350)
1351) end subroutine OptionFinalize
1352)
1353) ! ************************************************************************** !
1354)
1355) subroutine OptionDestroy(option)
1356) !
1357) ! Deallocates an option
1358) !
1359) ! Author: Glenn Hammond
1360) ! Date: 10/26/07
1361) !
1362)
1363) implicit none
1364)
1365) type(option_type), pointer :: option
1366)
1367) call OptionFlowDestroy(option%flow)
1368) call OptionTransportDestroy(option%transport)
1369) ! all kinds of stuff needs to be added here.
1370)
1371) ! all the below should be placed somewhere other than option.F90
1372)
1373) deallocate(option)
1374) nullify(option)
1375)
1376) end subroutine OptionDestroy
1377)
1378) end module Option_module