pmc_third_party.F90 coverage: 100.00 %func 87.01 %block
1) module PMC_Third_Party_class
2)
3) use PMC_Base_class
4) use Realization_Subsurface_class
5) use Option_module
6)
7) use PFLOTRAN_Constants_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14) #include "petsc/finclude/petscvec.h"
15) #include "petsc/finclude/petscvec.h90"
16)
17) type, public, extends(pmc_base_type) :: pmc_third_party_type
18) class(realization_subsurface_type), pointer :: realization
19) contains
20) procedure, public :: Init => PMCThirdPartyInit
21) ! procedure, public :: InitializeRun => PMCThirdPartyInitializeRun
22) procedure, public :: RunToTime => PMCThirdPartyRunToTime
23) procedure, public :: FinalizeRun => PMCThirdPartyFinalizeRun
24) procedure, public :: Destroy => PMCThirdPartyDestroy
25) procedure, public :: GetAuxData => PMCThirdPartyGetAuxData
26) end type pmc_third_party_type
27)
28) public :: PMCThirdPartyCreate
29)
30) contains
31)
32) ! ************************************************************************** !
33)
34) function PMCThirdPartyCreate()
35) !
36) ! Allocates and initializes a new
37) ! process_model_coupler object.
38) !
39) ! Author: Glenn Hammond
40) ! Date: 07/02/13
41) !
42)
43) implicit none
44)
45) class(pmc_third_party_type), pointer :: PMCThirdPartyCreate
46)
47) class(pmc_third_party_type), pointer :: pmc
48)
49) allocate(pmc)
50) call pmc%Init()
51)
52) PMCThirdPartyCreate => pmc
53)
54) end function PMCThirdPartyCreate
55)
56) ! ************************************************************************** !
57)
58) subroutine PMCThirdPartyInit(this)
59) !
60) ! Initializes a new process model coupler object.
61) !
62) ! Author: Glenn Hammond
63) ! Date: 07/02/13
64) !
65)
66) implicit none
67)
68) class(pmc_third_party_type) :: this
69)
70) call PMCBaseInit(this)
71) this%name = 'PMCThirdParty'
72) nullify(this%realization)
73)
74) end subroutine PMCThirdPartyInit
75)
76) ! ************************************************************************** !
77)
78) recursive subroutine PMCThirdPartyRunToTime(this,sync_time,stop_flag)
79) !
80) ! Runs the actual simulation.
81) !
82) ! Author: Glenn Hammond
83) ! Date: 07/02/13
84) !
85)
86) use Timestepper_Base_class, only : TS_CONTINUE, TS_STOP_FAILURE
87)
88) implicit none
89)
90) class(pmc_third_party_type), target :: this
91) PetscReal :: sync_time
92) PetscInt :: stop_flag
93)
94) class(pmc_base_type), pointer :: pmc_base
95) PetscErrorCode :: ierr
96) PetscInt :: local_stop_flag
97)
98) this%option%io_buffer = trim(this%name)
99) call printVerboseMsg(this%option)
100)
101) call this%GetAuxData()
102)
103) local_stop_flag = TS_CONTINUE
104)
105) call this%pm_list%InitializeTimestep()
106) call this%pm_list%Solve(sync_time,ierr)
107) call this%pm_list%FinalizeTimestep()
108) if (ierr /= 0) local_stop_flag = TS_STOP_FAILURE
109)
110) ! Run neighboring process model couplers
111) if (associated(this%child)) then
112) call this%child%RunToTime(sync_time,local_stop_flag)
113) endif
114)
115) ! Run neighboring process model couplers
116) if (associated(this%peer)) then
117) call this%peer%RunToTime(sync_time,local_stop_flag)
118) endif
119)
120) stop_flag = max(stop_flag,local_stop_flag)
121)
122) end subroutine PMCThirdPartyRunToTime
123)
124) ! ************************************************************************** !
125)
126) subroutine PMCThirdPartyGetAuxData(this)
127) !
128) ! Runs the actual simulation.
129) !
130) ! Author: Glenn Hammond
131) ! Date: 07/02/13
132) !
133)
134) implicit none
135)
136) #include "petsc/finclude/petscvec.h"
137) #include "petsc/finclude/petscvec.h90"
138) #include "petsc/finclude/petscviewer.h"
139)
140) class(pmc_third_party_type) :: this
141)
142) PetscErrorCode :: ierr
143) PetscViewer :: viewer
144)
145) end subroutine PMCThirdPartyGetAuxData
146)
147) ! ************************************************************************** !
148)
149) recursive subroutine PMCThirdPartyFinalizeRun(this)
150) !
151) ! Finalizes the time stepping
152) !
153) ! Author: Glenn Hammond
154) ! Date: 07/02/13
155) !
156)
157) implicit none
158)
159) class(pmc_third_party_type) :: this
160)
161) ! call printMsg(this%option,'PMCThirdParty%FinalizeRun()')
162)
163) end subroutine PMCThirdPartyFinalizeRun
164)
165) ! ************************************************************************** !
166)
167) subroutine PMCThirdPartyStrip(this)
168) !
169) ! Deallocates members of PMC Subsurface.
170) !
171) ! Author: Glenn Hammond
172) ! Date: 01/13/14
173)
174) implicit none
175)
176) class(pmc_third_party_type) :: this
177)
178) PetscErrorCode :: ierr
179)
180) call PMCBaseStrip(this)
181) nullify(this%realization)
182)
183) end subroutine PMCThirdPartyStrip
184)
185) ! ************************************************************************** !
186)
187) recursive subroutine PMCThirdPartyDestroy(this)
188) !
189) ! Deallocates a process_model_coupler object
190) !
191) ! Author: Glenn Hammond
192) ! Date: 07/02/13
193) !
194)
195) use Utility_module, only: DeallocateArray
196)
197) implicit none
198)
199) class(pmc_third_party_type) :: this
200)
201) PetscErrorCode :: ierr
202)
203) ! call printMsg(this%option,'PMCThirdParty%Destroy()')
204)
205) call PMCThirdPartyStrip(this)
206)
207) if (associated(this%child)) then
208) call this%child%Destroy()
209) endif
210)
211) if (associated(this%peer)) then
212) call this%peer%Destroy()
213) endif
214)
215) end subroutine PMCThirdPartyDestroy
216)
217) end module PMC_Third_Party_class