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