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

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody