pm_base_pointer.F90 coverage: 50.00 %func 44.44 %block
1) module PM_Base_Pointer_module
2)
3) use PM_Base_class
4)
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12)
13) ! Since the context (ctx) for procedures passed to PETSc must be declared
14) ! as a "type" instead of a "class", object is a workaround for passing the
15) ! process model as context of a procedure where one can pass the
16) ! pm_base_pointer_type to a procedure, declaring it as e.g.
17) !
18) ! type(pm_base_pointer_type) :: pm_ptr
19) !
20) ! and use the ptr:
21) !
22) ! pm_ptr%this%Residual
23) !
24) type, public :: pm_base_pointer_type
25) class(pm_base_type), pointer :: pm
26) end type pm_base_pointer_type
27)
28) public :: PMResidual, &
29) PMJacobian, &
30) PMCheckUpdatePre, &
31) PMCheckUpdatePost, &
32) PMRHSFunction, &
33) PMResidualPtr, &
34) PMJacobianPtr, &
35) PMCheckUpdatePrePtr, &
36) PMCheckUpdatePostPtr, &
37) PMRHSFunctionPtr
38)
39) contains
40)
41) ! ************************************************************************** !
42)
43) subroutine PMResidual(snes,xx,r,this,ierr)
44) !
45) ! Author: Glenn Hammond
46) ! Date: 03/14/13
47) !
48)
49) use Option_module
50) use Realization_Subsurface_class
51)
52) implicit none
53)
54) #include "petsc/finclude/petscvec.h"
55) #include "petsc/finclude/petscvec.h90"
56) #include "petsc/finclude/petscsnes.h"
57)
58) SNES :: snes
59) Vec :: xx
60) Vec :: r
61) class(pm_base_type) :: this
62) PetscErrorCode :: ierr
63)
64) #ifdef DEBUG
65) print *, 'PMResidual()'
66) #endif
67)
68) call this%Residual(snes,xx,r,ierr)
69)
70) end subroutine PMResidual
71)
72) ! ************************************************************************** !
73)
74) subroutine PMResidualPtr(snes,xx,r,this,ierr)
75) !
76) ! Author: Glenn Hammond
77) ! Date: 03/14/13
78) !
79)
80) use Option_module
81) use Realization_Subsurface_class
82)
83) implicit none
84)
85) #include "petsc/finclude/petscvec.h"
86) #include "petsc/finclude/petscvec.h90"
87) #include "petsc/finclude/petscsnes.h"
88)
89) SNES :: snes
90) Vec :: xx
91) Vec :: r
92) type(pm_base_pointer_type) :: this
93) PetscErrorCode :: ierr
94)
95) #ifdef DEBUG
96) print *, 'PMResidualPtr()'
97) #endif
98)
99) call this%pm%Residual(snes,xx,r,ierr)
100)
101) end subroutine PMResidualPtr
102)
103) ! ************************************************************************** !
104)
105) subroutine PMJacobian(snes,xx,A,B,this,ierr)
106) !
107) ! Author: Glenn Hammond
108) ! Date: 03/14/13
109) !
110)
111) use Option_module
112)
113) implicit none
114)
115) #include "petsc/finclude/petscvec.h"
116) #include "petsc/finclude/petscvec.h90"
117) #include "petsc/finclude/petscmat.h"
118) #include "petsc/finclude/petscsnes.h"
119)
120) SNES :: snes
121) Vec :: xx
122) Mat :: A, B
123) class(pm_base_type) :: this
124) PetscErrorCode :: ierr
125)
126) #ifdef DEBUG
127) print *, 'PMJacobian()'
128) #endif
129)
130) call this%Jacobian(snes,xx,A,B,ierr)
131)
132) end subroutine PMJacobian
133)
134) ! ************************************************************************** !
135)
136) subroutine PMJacobianPtr(snes,xx,A,B,this,ierr)
137) !
138) ! Author: Glenn Hammond
139) ! Date: 03/14/13
140) !
141)
142) use Option_module
143)
144) implicit none
145)
146) #include "petsc/finclude/petscvec.h"
147) #include "petsc/finclude/petscvec.h90"
148) #include "petsc/finclude/petscmat.h"
149) #include "petsc/finclude/petscsnes.h"
150)
151) SNES :: snes
152) Vec :: xx
153) Mat :: A, B
154) type(pm_base_pointer_type) :: this
155) PetscErrorCode :: ierr
156)
157) #ifdef DEBUG
158) print *, 'PMJacobianPtr()'
159) #endif
160)
161) call this%pm%Jacobian(snes,xx,A,B,ierr)
162)
163) end subroutine PMJacobianPtr
164)
165) ! ************************************************************************** !
166)
167) subroutine PMRHSFunction(ts,time,xx,ff,this,ierr)
168) !
169) ! Author: Gautam Bisht
170) ! Date: 04/12/13
171) !
172)
173) implicit none
174)
175) #include "petsc/finclude/petscvec.h"
176) #include "petsc/finclude/petscvec.h90"
177) #include "petsc/finclude/petscts.h"
178)
179) TS :: ts
180) PetscReal :: time
181) Vec :: xx
182) Vec :: ff
183) class(pm_base_type) :: this
184) PetscErrorCode :: ierr
185)
186) #ifdef DEBUG
187) print *, 'PMRHSFunction()'
188) #endif
189)
190) call this%RHSFunction(ts,time,xx,ff,ierr)
191)
192) end subroutine PMRHSFunction
193)
194) ! ************************************************************************** !
195)
196) subroutine PMRHSFunctionPtr(ts,time,xx,ff,this,ierr)
197) !
198) ! Author: Gautam Bisht
199) ! Date: 04/12/13
200) !
201)
202) implicit none
203)
204) #include "petsc/finclude/petscvec.h"
205) #include "petsc/finclude/petscvec.h90"
206) #include "petsc/finclude/petscts.h"
207)
208) TS :: ts
209) PetscReal :: time
210) Vec :: xx
211) Vec :: ff
212) type(pm_base_pointer_type) :: this
213) PetscErrorCode :: ierr
214)
215) #ifdef DEBUG
216) print *, 'PMRHSFunctionPtr()'
217) #endif
218)
219) call this%pm%RHSFunction(ts,time,xx,ff,ierr)
220)
221) end subroutine PMRHSFunctionPtr
222)
223) ! ************************************************************************** !
224)
225) subroutine PMCheckUpdatePre(line_search,X,dX,changed,this,ierr)
226) !
227) ! Wrapper for native call to XXXCheckUpdatePre
228) !
229) ! Author: Glenn Hammond
230) ! Date: 12/02/14
231) !
232)
233) implicit none
234)
235) #include "petsc/finclude/petscvec.h"
236) #include "petsc/finclude/petscvec.h90"
237) #include "petsc/finclude/petscsnes.h"
238)
239) SNESLineSearch :: line_search
240) Vec :: X
241) Vec :: dX
242) PetscBool :: changed
243) class(pm_base_type) :: this
244) PetscErrorCode :: ierr
245)
246) #ifdef DEBUG
247) print *, 'PMCheckUpdatePre()'
248) #endif
249)
250) call this%CheckUpdatePre(line_search,X,dX,changed,ierr)
251)
252) end subroutine PMCheckUpdatePre
253)
254) ! ************************************************************************** !
255)
256) subroutine PMCheckUpdatePrePtr(line_search,X,dX,changed,this,ierr)
257) !
258) ! Wrapper for native call to XXXCheckUpdatePre
259) !
260) ! Author: Glenn Hammond
261) ! Date: 12/02/14
262) !
263)
264) implicit none
265)
266) #include "petsc/finclude/petscvec.h"
267) #include "petsc/finclude/petscvec.h90"
268) #include "petsc/finclude/petscsnes.h"
269)
270) SNESLineSearch :: line_search
271) Vec :: X
272) Vec :: dX
273) PetscBool :: changed
274) type(pm_base_pointer_type) :: this
275) PetscErrorCode :: ierr
276)
277) #ifdef DEBUG
278) print *, 'PMCheckUpdatePrePtr()'
279) #endif
280)
281) call this%pm%CheckUpdatePre(line_search,X,dX,changed,ierr)
282)
283) end subroutine PMCheckUpdatePrePtr
284)
285) ! ************************************************************************** !
286)
287) subroutine PMCheckUpdatePost(line_search,X0,dX,X1,dX_changed,X1_changed,this, &
288) ierr)
289) !
290) ! Wrapper for native call to XXXCheckUpdatePost
291) !
292) ! Author: Glenn Hammond
293) ! Date: 12/02/14
294) !
295)
296) implicit none
297)
298) #include "petsc/finclude/petscvec.h"
299) #include "petsc/finclude/petscvec.h90"
300) #include "petsc/finclude/petscsnes.h"
301)
302) SNESLineSearch :: line_search
303) Vec :: X0
304) Vec :: dX
305) Vec :: X1
306) PetscBool :: dX_changed
307) PetscBool :: X1_changed
308) class(pm_base_type) :: this
309) PetscErrorCode :: ierr
310)
311) #ifdef DEBUG
312) print *, 'PMCheckUpdatePost()'
313) #endif
314)
315) call this%CheckUpdatePost(line_search,X0,dX,X1,dX_changed,X1_changed,ierr)
316)
317) end subroutine PMCheckUpdatePost
318)
319) ! ************************************************************************** !
320)
321) subroutine PMCheckUpdatePostPtr(line_search,X0,dX,X1,dX_changed,X1_changed, &
322) this,ierr)
323) !
324) ! Wrapper for native call to XXXCheckUpdatePost
325) !
326) ! Author: Glenn Hammond
327) ! Date: 12/02/14
328) !
329)
330) implicit none
331)
332) #include "petsc/finclude/petscvec.h"
333) #include "petsc/finclude/petscvec.h90"
334) #include "petsc/finclude/petscsnes.h"
335)
336) SNESLineSearch :: line_search
337) Vec :: X0
338) Vec :: dX
339) Vec :: X1
340) PetscBool :: dX_changed
341) PetscBool :: X1_changed
342) type(pm_base_pointer_type) :: this
343) PetscErrorCode :: ierr
344)
345) #ifdef DEBUG
346) print *, 'PMCheckUpdatePostPtr()'
347) #endif
348)
349) call this%pm%CheckUpdatePost(line_search,X0,dX,X1,dX_changed,X1_changed,ierr)
350)
351) end subroutine PMCheckUpdatePostPtr
352)
353) end module PM_Base_Pointer_module