pm_surface.F90       coverage:  35.71 %func     25.25 %block


     1) module PM_Surface_class
     2) 
     3)   use PM_Base_class
     4)   use Realization_Surface_class
     5)   use Communicator_Base_module
     6)   use Option_module
     7)   use PFLOTRAN_Constants_module
     8) 
     9)   implicit none
    10) 
    11)   private
    12) 
    13) #include "petsc/finclude/petscsys.h"
    14) 
    15) #include "petsc/finclude/petscvec.h"
    16) #include "petsc/finclude/petscvec.h90"
    17) #include "petsc/finclude/petscmat.h"
    18) #include "petsc/finclude/petscmat.h90"
    19) #include "petsc/finclude/petscsnes.h"
    20) #include "petsc/finclude/petscts.h"
    21) 
    22)   type, public, extends(pm_base_type) :: pm_surface_type
    23)     class(realization_surface_type), pointer :: surf_realization
    24)     class(communicator_type), pointer :: comm1
    25)     PetscReal :: pressure_change_governor
    26)     PetscReal :: temperature_change_governor
    27)     PetscReal :: pressure_dampening_factor
    28)     PetscReal :: pressure_change_limit
    29)     PetscReal :: temperature_change_limit
    30)   contains
    31)     procedure, public :: Setup => PMSurfaceSetup
    32)     procedure, public :: PMSurfaceSetRealization
    33)     procedure, public :: InitializeRun => PMSurfaceInitializeRun
    34)     procedure, public :: PreSolve => PMSurfacePreSolve
    35)     procedure, public :: PostSolve => PMSurfacePostSolve
    36)     procedure, public :: CheckpointBinary => PMSurfaceCheckpointBinary
    37)     procedure, public :: RestartBinary => PMSurfaceRestartBinary
    38)     procedure, public :: UpdateAuxvars => PMSurfaceUpdateAuxvars
    39)     procedure, public :: InputRecord => PMSurfaceInputRecord
    40)   end type pm_surface_type
    41) 
    42)   public :: PMSurfaceCreate, &
    43)             PMSurfaceSetup, &
    44)             PMSurfaceUpdateSolution, &
    45)             PMSurfaceReadSelectCase, &
    46)             PMSurfaceDestroy
    47)   
    48) contains
    49) 
    50) ! ************************************************************************** !
    51) 
    52) subroutine PMSurfaceCreate(this)
    53)   ! 
    54)   ! Intializes shared members of surface process models
    55)   ! 
    56)   ! Author: Gautam Bisht, LBNL
    57)   ! Date: 04/22/14
    58) 
    59)   implicit none
    60)   
    61)   class(pm_surface_type) :: this
    62)   
    63)   this%pressure_change_governor = 5.d5
    64)   this%temperature_change_governor = 5.d0
    65)   this%pressure_dampening_factor = UNINITIALIZED_DOUBLE
    66)   this%pressure_change_limit = UNINITIALIZED_DOUBLE
    67)   this%temperature_change_limit = UNINITIALIZED_DOUBLE
    68) 
    69)   nullify(this%surf_realization)
    70)   nullify(this%comm1)
    71)   
    72)   call PMBaseInit(this)
    73) 
    74) end subroutine PMSurfaceCreate
    75) 
    76) ! ************************************************************************** !
    77) 
    78) subroutine PMSurfaceReadSelectCase(this,input,keyword,found,option)
    79)   ! 
    80)   ! Reads input file parameters associated with the subsurface flow process 
    81)   !       model
    82)   ! 
    83)   ! Author: Glenn Hammond
    84)   ! Date: 01/05/16
    85) 
    86)   use Input_Aux_module
    87)   use String_module
    88)   use Option_module
    89) 
    90)   implicit none
    91) 
    92)   class(pm_surface_type) :: this
    93)   type(input_type) :: input
    94) 
    95)   character(len=MAXWORDLENGTH) :: keyword
    96)   PetscBool :: found
    97)   type(option_type) :: option
    98) 
    99)   found = PETSC_TRUE
   100)   select case(trim(keyword))
   101) 
   102)     case('MAX_PRESSURE_CHANGE')
   103)       call InputReadDouble(input,option,this%pressure_change_governor)
   104)       call InputDefaultMsg(input,option,'dpmxe')
   105) 
   106)     case('MAX_TEMPERATURE_CHANGE')
   107)       call InputReadDouble(input,option,this%temperature_change_governor)
   108)       call InputDefaultMsg(input,option,'dtmpmxe')
   109) 
   110)     case('PRESSURE_DAMPENING_FACTOR')
   111)       call InputReadDouble(input,option,this%pressure_dampening_factor)
   112)       call InputErrorMsg(input,option,'PRESSURE_DAMPENING_FACTOR', &
   113)                           'TIMESTEPPER')
   114) 
   115)     case('PRESSURE_CHANGE_LIMIT')
   116)       call InputReadDouble(input,option,this%pressure_change_limit)
   117)       call InputErrorMsg(input,option,'PRESSURE_CHANGE_LIMIT', &
   118)                           'TIMESTEPPER')
   119) 
   120)     case('TEMPERATURE_CHANGE_LIMIT')
   121)       call InputReadDouble(input,option,this%temperature_change_limit)
   122)       call InputErrorMsg(input,option,'TEMPERATURE_CHANGE_LIMIT', &
   123)                           'TIMESTEPPER')
   124)     case default
   125)       found = PETSC_FALSE
   126)   end select
   127) 
   128) end subroutine PMSurfaceReadSelectCase
   129) 
   130) ! ************************************************************************** !
   131) 
   132) subroutine PMSurfaceSetup(this)
   133)   ! 
   134)   ! Initializes variables associated with subsurface process models
   135)   ! 
   136)   ! Author: Gautam Bisht, LBNL
   137)   ! Date: 04/22/14
   138)   ! 
   139) 
   140)   use Discretization_module
   141)   use Communicator_Unstructured_class
   142)   use Grid_module
   143) 
   144)   implicit none
   145) 
   146)   class(pm_surface_type) :: this
   147) 
   148)   ! set up communicator
   149)   select case(this%surf_realization%discretization%itype)
   150)     case(STRUCTURED_GRID)
   151)       this%option%io_buffer='Surface flow not supported on structured grids'
   152)       call printErrMsg(this%option)
   153)     case(UNSTRUCTURED_GRID)
   154)       this%comm1 => UnstructuredCommunicatorCreate()
   155)   end select
   156) 
   157)   ! set the communicator
   158)   call this%comm1%SetDM(this%surf_realization%discretization%dm_1dof)
   159) 
   160) end subroutine PMSurfaceSetup
   161) 
   162) ! ************************************************************************** !
   163) 
   164) subroutine PMSurfaceSetRealization(this, surf_realization)
   165)   ! 
   166)   ! Initializes relization and PETSc vectors for solution and residual.
   167)   ! 
   168)   ! Author: Gautam Bisht, LBNL
   169)   ! Date: 04/22/14
   170)   ! 
   171) 
   172)   use Realization_Surface_class
   173)   use Grid_module
   174) 
   175)   implicit none
   176) 
   177)   class(pm_surface_type) :: this
   178)   class(realization_surface_type), pointer :: surf_realization
   179) 
   180)   this%surf_realization => surf_realization
   181)   this%realization_base => surf_realization
   182) 
   183)   this%solution_vec = surf_realization%surf_field%flow_xx
   184)   this%residual_vec = surf_realization%surf_field%flow_r
   185) 
   186) end subroutine PMSurfaceSetRealization
   187) 
   188) ! ************************************************************************** !
   189) 
   190) recursive subroutine PMSurfaceInitializeRun(this)
   191)   ! 
   192)   ! This routine
   193)   ! 
   194)   ! Author: Gautam Bisht, LBNL
   195)   ! Date: 04/22/14
   196)   !
   197) 
   198)   implicit none
   199) 
   200)   class(pm_surface_type) :: this
   201) 
   202) end subroutine PMSurfaceInitializeRun
   203) 
   204) ! ************************************************************************** !
   205) subroutine PMSurfacePreSolve(this)
   206)   ! 
   207)   ! Author: Gautam Bisht, LBNL
   208)   ! Date: 04/22/14
   209) 
   210)   use Global_module
   211) 
   212)   implicit none
   213)   
   214)   class(pm_surface_type) :: this
   215)   
   216)   this%option%io_buffer = 'PMSurfacePreSolve() must be extended.'
   217)   call printErrMsg(this%option)  
   218) 
   219) end subroutine PMSurfacePreSolve
   220) 
   221) ! ************************************************************************** !
   222) 
   223) subroutine PMSurfacePostSolve(this)
   224)   !
   225)   ! Author: Gautam Bisht, LBNL
   226)   ! Date: 04/22/14
   227)   ! 
   228) 
   229)   use Global_module
   230) 
   231)   implicit none
   232)   
   233)   class(pm_surface_type) :: this
   234)   
   235)   this%option%io_buffer = 'PMSurfacePostSolve() must be extended.'
   236)   call printErrMsg(this%option)  
   237)   
   238) end subroutine PMSurfacePostSolve
   239) 
   240) ! ************************************************************************** !
   241) 
   242) subroutine PMSurfaceUpdateSolution(this)
   243)   !
   244)   ! As a first step in updating the solution, update all flow-conditions.
   245)   ! The solution will be updated by each child class of pm_surface_type.
   246)   ! 
   247)   ! Author: Gautam Bisht, LBNL
   248)   ! Date: 04/22/14
   249)   ! 
   250) 
   251)   use Condition_module
   252) 
   253)   implicit none
   254) 
   255)   class(pm_surface_type) :: this
   256) 
   257)   PetscBool :: force_update_flag = PETSC_FALSE
   258) 
   259) 
   260)   ! begin from RealizationUpdate()
   261)   call FlowConditionUpdate(this%surf_realization%surf_flow_conditions, &
   262)                            this%surf_realization%option, &
   263)                            this%surf_realization%option%time)
   264) 
   265)   call RealizSurfAllCouplerAuxVars(this%surf_realization,force_update_flag)
   266) 
   267) end subroutine PMSurfaceUpdateSolution
   268) 
   269) ! ************************************************************************** !
   270) 
   271) subroutine PMSurfaceUpdateAuxVars(this)
   272)   ! 
   273)   ! Author: Gautam Bisht, LBNL
   274)   ! Date: 04/22/14
   275) 
   276)   implicit none
   277)   
   278)   class(pm_surface_type) :: this
   279) 
   280)   this%option%io_buffer = 'PMSurfaceUpdateAuxVars() must be extended.'
   281)   call printErrMsg(this%option)
   282) 
   283) end subroutine PMSurfaceUpdateAuxVars
   284) 
   285) ! ************************************************************************** !
   286) 
   287) subroutine PMSurfaceCheckpointBinary(this,viewer)
   288)   ! 
   289)   ! This routine checkpoints data associated with surface-flow PM
   290)   ! 
   291)   ! Author: Gautam Bisht, LBNL
   292)   ! Date: 04/22/14
   293)   ! 
   294) 
   295)   use Checkpoint_Surface_module
   296) 
   297)   implicit none
   298) #include "petsc/finclude/petscviewer.h"
   299) 
   300)   class(pm_surface_type) :: this
   301)   PetscViewer :: viewer
   302) 
   303)   call SurfaceCheckpointProcessModelBinary(viewer,this%surf_realization)
   304) 
   305) end subroutine PMSurfaceCheckpointBinary
   306) 
   307) ! ************************************************************************** !
   308) 
   309) subroutine PMSurfaceRestartBinary(this,viewer)
   310)   ! 
   311)   ! This routine reads checkpoint data associated with surface-flow PM
   312)   ! 
   313)   ! Author: Gautam Bisht, LBNL
   314)   ! Date: 04/22/14
   315)   ! 
   316) 
   317)   use Checkpoint_Surface_module
   318) 
   319)   implicit none
   320) #include "petsc/finclude/petscviewer.h"
   321) 
   322)   class(pm_surface_type) :: this
   323)   PetscViewer :: viewer
   324) 
   325)   call SurfaceRestartProcessModelBinary(viewer,this%surf_realization)
   326)   call this%UpdateAuxVars()
   327)   call this%UpdateSolution()
   328) 
   329) end subroutine PMSurfaceRestartBinary
   330) 
   331) ! ************************************************************************** !
   332) 
   333) recursive subroutine PMSurfaceFinalizeRun(this)
   334)   ! 
   335)   ! Finalizes the time stepping
   336)   ! 
   337)   ! Author: Gautam Bisht, LBNL
   338)   ! Date: 04/22/14
   339)   ! 
   340) 
   341)   implicit none
   342) 
   343)   class(pm_surface_type) :: this
   344) 
   345)   ! do something here
   346) 
   347)   if (associated(this%next)) then
   348)     call this%next%FinalizeRun()
   349)   endif
   350) 
   351) end subroutine PMSurfaceFinalizeRun
   352) 
   353) ! ************************************************************************** !
   354) 
   355) subroutine PMSurfaceInputRecord(this)
   356)   ! 
   357)   ! Writes ingested information to the input record file.
   358)   ! 
   359)   ! Author: Jenn Frederick, SNL
   360)   ! Date: 03/21/2016
   361)   ! 
   362)   
   363)   implicit none
   364)   
   365)   class(pm_surface_type) :: this
   366) 
   367)   character(len=MAXWORDLENGTH) :: word
   368)   PetscInt :: id
   369) 
   370)   id = INPUT_RECORD_UNIT
   371) 
   372)   write(id,'(a29)',advance='no') 'pm: '
   373)   write(id,'(a)') this%name
   374) 
   375) end subroutine PMSurfaceInputRecord
   376) 
   377) ! ************************************************************************** !
   378) 
   379) subroutine PMSurfaceDestroy(this)
   380)   ! 
   381)   ! Destroys Surface process model
   382)   ! 
   383)   ! Author: Gautam Bisht, LBNL
   384)   ! Date: 04/22/14
   385)   ! 
   386) 
   387)   implicit none
   388) 
   389)   class(pm_surface_type) :: this
   390) 
   391)   call this%comm1%Destroy()
   392) 
   393) end subroutine PMSurfaceDestroy
   394) 
   395) end module PM_Surface_class

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