pm_base.F90       coverage:  5.56 %func     2.75 %block


     1) module PM_Base_class
     2) 
     3)   use Option_module
     4)   use Output_Aux_module
     5)   use Realization_Base_class
     6) 
     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 :: pm_base_type
    23)     character(len=MAXWORDLENGTH) :: name
    24)     type(option_type), pointer :: option
    25)     type(output_option_type), pointer :: output_option
    26)     Vec :: solution_vec
    27)     Vec :: residual_vec
    28)     PetscBool :: print_ekg
    29)     class(realization_base_type), pointer :: realization_base
    30)     class(pm_base_type), pointer :: next
    31)   contains
    32)     procedure, public :: Setup => PMBaseSetup
    33)     procedure, public :: Read => PMBaseRead
    34)     procedure, public :: SetupSolvers => PMBaseSetupSolvers
    35)     procedure, public :: InitializeRun => PMBaseThisOnly
    36)     procedure, public :: InputRecord => PMBaseInputRecord
    37)     procedure, public :: FinalizeRun => PMBaseThisOnly
    38)     procedure, public :: Residual => PMBaseResidual
    39)     procedure, public :: Jacobian => PMBaseJacobian
    40)     procedure, public :: UpdateTimestep => PMBaseUpdateTimestep
    41)     procedure, public :: InitializeTimestep => PMBaseThisOnly
    42)     procedure, public :: PreSolve => PMBaseThisOnly
    43)     procedure, public :: Solve => PMBaseThisTimeError
    44)     procedure, public :: PostSolve => PMBaseThisOnly
    45)     procedure, public :: FinalizeTimestep => PMBaseThisOnly
    46)     procedure, public :: AcceptSolution => PMBaseFunctionThisOnly
    47)     procedure, public :: CheckUpdatePre => PMBaseCheckUpdatePre
    48)     procedure, public :: CheckUpdatePost => PMBaseCheckUpdatePost
    49)     procedure, public :: TimeCut => PMBaseThisOnly
    50)     procedure, public :: UpdateSolution => PMBaseThisOnly
    51)     procedure, public :: UpdateAuxVars => PMBaseThisOnly
    52)     procedure, public :: MaxChange => PMBaseThisOnly
    53)     procedure, public :: ComputeMassBalance => PMBaseComputeMassBalance
    54)     procedure, public :: Destroy => PMBaseThisOnly
    55)     procedure, public :: RHSFunction => PMBaseRHSFunction
    56)     procedure, public :: CheckpointBinary => PMBaseCheckpointBinary
    57)     procedure, public :: RestartBinary => PMBaseCheckpointBinary
    58)     procedure, public :: CheckpointHDF5 => PMBaseCheckpointHDF5
    59)     procedure, public :: RestartHDF5 => PMBaseCheckpointHDF5
    60)   end type pm_base_type
    61)   
    62)   type, public :: pm_base_header_type
    63)     PetscInt :: ndof
    64)   end type pm_base_header_type
    65)     
    66)   public :: PMBaseInit, &
    67)             PMBaseInputRecord, &
    68)             PMBaseResidual, &
    69)             PMBaseJacobian, &
    70)             PMBaseRHSFunction
    71)   
    72) contains
    73) 
    74) ! ************************************************************************** !
    75) 
    76) subroutine PMBaseInit(this)
    77) 
    78)   implicit none
    79)   
    80)   class(pm_base_type) :: this  
    81) 
    82)   ! Cannot allocate here.  Allocation takes place in daughter class
    83)   this%name = ''
    84)   nullify(this%option)
    85)   nullify(this%output_option)
    86)   nullify(this%realization_base)
    87)   this%solution_vec = 0
    88)   this%residual_vec = 0
    89)   this%print_ekg = PETSC_FALSE
    90)   nullify(this%next)
    91)   
    92) end subroutine PMBaseInit
    93) 
    94) ! ************************************************************************** !
    95) 
    96) subroutine PMBaseRead(this,input)
    97)   use Input_Aux_module
    98)   implicit none
    99)   class(pm_base_type) :: this
   100)   type(input_type), pointer :: input
   101)   print *, 'Must extend PMBaseRead for: ' // trim(this%name)
   102)   stop
   103) end subroutine PMBaseRead
   104) 
   105) ! ************************************************************************** !
   106) 
   107) subroutine PMBaseSetup(this)
   108)   implicit none
   109)   class(pm_base_type) :: this
   110)   print *, 'Must extend PMBaseSetup for: ' // trim(this%name)
   111)   stop
   112) end subroutine PMBaseSetup
   113) 
   114) ! ************************************************************************** !
   115) 
   116) subroutine PMBaseInputRecord(this)
   117)   implicit none
   118)   class(pm_base_type) :: this
   119)   print *, 'Must extend PMBaseInputRecord for: ' // trim(this%name)
   120)   stop
   121) end subroutine PMBaseInputRecord
   122) 
   123) ! ************************************************************************** !
   124) 
   125) subroutine PMBaseSetupSolvers(this,solver)
   126)   use Solver_module
   127)   implicit none
   128)   class(pm_base_type) :: this
   129)   type(solver_type) :: solver
   130)   print *, 'Must extend PMBaseSetupSolvers for: ' // trim(this%name)
   131)   stop
   132) end subroutine PMBaseSetupSolvers
   133) 
   134) ! ************************************************************************** !
   135) 
   136) subroutine PMBaseResidual(this,snes,xx,r,ierr)
   137)   implicit none
   138)   class(pm_base_type) :: this
   139)   SNES :: snes
   140)   Vec :: xx
   141)   Vec :: r
   142)   PetscErrorCode :: ierr
   143)   print *, 'Must extend PMBaseResidual for: ' // trim(this%name)
   144)   stop
   145) end subroutine PMBaseResidual
   146) 
   147) ! ************************************************************************** !
   148) 
   149) subroutine PMBaseJacobian(this,snes,xx,A,B,ierr)
   150)   implicit none
   151)   class(pm_base_type) :: this
   152)   SNES :: snes
   153)   Vec :: xx
   154)   Mat :: A, B
   155)   PetscErrorCode :: ierr
   156)   print *, 'Must extend PMBaseJacobian for: ' // trim(this%name)
   157)   stop
   158) end subroutine PMBaseJacobian
   159) 
   160) ! ************************************************************************** !
   161) 
   162) subroutine PMBaseUpdateTimestep(this,dt,dt_min,dt_max,iacceleration, &
   163)                                 num_newton_iterations,tfac)
   164)   implicit none
   165)   class(pm_base_type) :: this
   166)   PetscReal :: dt
   167)   PetscReal :: dt_min,dt_max
   168)   PetscInt :: iacceleration
   169)   PetscInt :: num_newton_iterations
   170)   PetscReal :: tfac(:)
   171)   print *, 'Must extend PMBaseUpdateTimestep for: ' // trim(this%name)
   172)   stop
   173) end subroutine PMBaseUpdateTimestep
   174) 
   175) ! ************************************************************************** !
   176) 
   177) subroutine PMBaseCheckUpdatePre(this,line_search,X,dX,changed,ierr)
   178)   implicit none
   179)   class(pm_base_type) :: this
   180)   SNESLineSearch :: line_search
   181)   Vec :: X
   182)   Vec :: dX
   183)   PetscBool :: changed
   184)   PetscErrorCode :: ierr
   185)   print *, 'Must extend PMBaseCheckUpdatePre for: ' // trim(this%name)
   186)   stop
   187) end subroutine PMBaseCheckUpdatePre
   188) 
   189) ! ************************************************************************** !
   190) 
   191) subroutine PMBaseCheckUpdatePost(this,line_search,X0,dX,X1,dX_changed, &
   192)                                  X1_changed,ierr)
   193)   implicit none
   194)   class(pm_base_type) :: this
   195)   SNESLineSearch :: line_search
   196)   Vec :: X0
   197)   Vec :: dX
   198)   Vec :: X1
   199)   PetscBool :: dX_changed
   200)   PetscBool :: X1_changed
   201)   PetscErrorCode :: ierr
   202)   print *, 'Must extend PMBaseCheckUpdatePost for: ' // trim(this%name)
   203)   stop
   204) end subroutine PMBaseCheckUpdatePost
   205) 
   206) ! ************************************************************************** !
   207) 
   208) subroutine PMBaseThisOnly(this)
   209)   implicit none
   210)   class(pm_base_type) :: this
   211)   print *, 'Must extend PMBaseThisOnly for: ' // trim(this%name)
   212)   stop
   213) end subroutine PMBaseThisOnly
   214) 
   215) ! ************************************************************************** !
   216) 
   217) subroutine PMBaseThisTime(this,time)
   218)   implicit none
   219)   class(pm_base_type) :: this
   220)   PetscReal :: time
   221)   print *, 'Must extend PMBaseThisTime for: ' // trim(this%name)
   222)   stop
   223) end subroutine PMBaseThisTime
   224) 
   225) ! ************************************************************************** !
   226) 
   227) subroutine PMBaseThisTimeError(this,time,ierr)
   228)   implicit none
   229)   class(pm_base_type) :: this
   230)   PetscReal :: time
   231)   PetscErrorCode :: ierr
   232)   print *, 'Must extend PMBaseThisTimeError for: ' // trim(this%name)
   233)   stop
   234) end subroutine PMBaseThisTimeError
   235) 
   236) ! ************************************************************************** !
   237) 
   238) function PMBaseFunctionThisOnly(this)
   239)   implicit none
   240)   class(pm_base_type) :: this
   241)   PetscBool ::  PMBaseFunctionThisOnly
   242)   PMBaseFunctionThisOnly = PETSC_TRUE
   243)   print *, 'Must extend PMBaseFunctionThisOnly for: ' // trim(this%name)
   244)   stop
   245) end function PMBaseFunctionThisOnly
   246) 
   247) ! ************************************************************************** !
   248) 
   249) subroutine PMBaseComputeMassBalance(this,mass_balance_array)
   250)   implicit none
   251)   class(pm_base_type) :: this
   252)   PetscReal :: mass_balance_array(:)
   253)   print *, 'Must extend PMBaseComputeMassBalance for: ' // trim(this%name)
   254)   stop
   255) end subroutine PMBaseComputeMassBalance
   256) 
   257) ! ************************************************************************** !
   258) 
   259) subroutine PMBaseRHSFunction(this,ts,time,xx,ff,ierr)
   260)   implicit none
   261)   class(pm_base_type) :: this
   262)   TS :: ts
   263)   PetscReal :: time
   264)   Vec :: xx
   265)   Vec :: ff
   266)   PetscErrorCode :: ierr
   267)   print *, 'Must extend PMBaseRHSFunction for: ' // trim(this%name)
   268)   stop
   269) end subroutine PMBaseRHSFunction
   270) 
   271) ! ************************************************************************** !
   272) 
   273) subroutine PMBaseCheckpointBinary(this,viewer)
   274)   implicit none
   275) #include "petsc/finclude/petscviewer.h"      
   276)   class(pm_base_type) :: this
   277)   PetscViewer :: viewer
   278) !  print *, 'Must extend PMBaseCheckpointBinary/RestartBinary.'
   279) !  stop
   280) end subroutine PMBaseCheckpointBinary
   281) 
   282) ! ************************************************************************** !
   283) 
   284) subroutine PMBaseCheckpointHDF5(this, pm_grp_id)
   285) 
   286) #if  !defined(PETSC_HAVE_HDF5)
   287)   implicit none
   288)   class(pm_base_type) :: this
   289)   integer :: pm_grp_id
   290)   print *, 'PFLOTRAN must be compiled with HDF5 to ' // &
   291)         'write HDF5 formatted checkpoint file. Darn.'
   292)   stop
   293) #else
   294) 
   295)   use hdf5
   296)   implicit none
   297) 
   298)   class(pm_base_type) :: this
   299) #if defined(SCORPIO_WRITE)
   300)   integer :: pm_grp_id
   301) #else
   302)   integer(HID_T) :: pm_grp_id
   303) #endif
   304) !  print *, 'Must extend PMBaseCheckpointHDF5/RestartHDF5.'
   305) !  stop
   306) #endif
   307) 
   308) end subroutine PMBaseCheckpointHDF5
   309) 
   310) end module PM_Base_class

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