pmc_subsurface.F90 coverage: 91.67 %func 69.05 %block
1) module PMC_Subsurface_class
2)
3) use PMC_Base_class
4) use Realization_Subsurface_class
5)
6) use PFLOTRAN_Constants_module
7)
8) implicit none
9)
10) #include "petsc/finclude/petscsys.h"
11)
12) private
13)
14) type, public, extends(pmc_base_type) :: pmc_subsurface_type
15) class(realization_subsurface_type), pointer :: realization
16) contains
17) procedure, public :: Init => PMCSubsurfaceInit
18) procedure, public :: SetupSolvers => PMCSubsurfaceSetupSolvers
19) procedure, public :: GetAuxData => PMCSubsurfaceGetAuxData
20) procedure, public :: SetAuxData => PMCSubsurfaceSetAuxData
21) procedure, public :: Destroy => PMCSubsurfaceDestroy
22) end type pmc_subsurface_type
23)
24) public :: PMCSubsurfaceCreate
25)
26) contains
27)
28) ! ************************************************************************** !
29)
30) function PMCSubsurfaceCreate()
31) !
32) ! Allocates and initializes a new process_model_coupler
33) ! object.
34) !
35) ! Author: Glenn Hammond
36) ! Date: 03/14/13
37) !
38)
39) implicit none
40)
41) class(pmc_subsurface_type), pointer :: PMCSubsurfaceCreate
42)
43) class(pmc_subsurface_type), pointer :: pmc
44)
45) #ifdef DEBUG
46) print *, 'PMCSubsurface%Create()'
47) #endif
48)
49) allocate(pmc)
50) call pmc%Init()
51)
52) PMCSubsurfaceCreate => pmc
53)
54) end function PMCSubsurfaceCreate
55)
56) ! ************************************************************************** !
57)
58) subroutine PMCSubsurfaceInit(this)
59) !
60) ! Initializes a new process model coupler object.
61) !
62) ! Author: Glenn Hammond
63) ! Date: 06/10/13
64) !
65)
66) implicit none
67)
68) class(pmc_subsurface_type) :: this
69)
70) #ifdef DEBUG
71) print *, 'PMCSubsurface%Init()'
72) #endif
73)
74) call PMCBaseInit(this)
75) this%name = 'PMCSubsurface'
76) nullify(this%realization)
77)
78) end subroutine PMCSubsurfaceInit
79)
80) ! ************************************************************************** !
81)
82) subroutine PMCSubsurfaceSetupSolvers(this)
83) !
84) ! Author: Glenn Hammond
85) ! Date: 03/18/13
86) !
87) use PM_Base_class
88) use Timestepper_Base_class
89) use Timestepper_BE_class
90) use PM_Base_Pointer_module
91) use Option_module
92)
93) implicit none
94)
95) class(pmc_subsurface_type) :: this
96)
97) PetscErrorCode :: ierr
98)
99) #ifdef DEBUG
100) call printMsg(this%option,'PMCSubsurface%SetupSolvers()')
101) #endif
102)
103) select type(ts => this%timestepper)
104) class is(timestepper_BE_type)
105) call SNESSetFunction(ts%solver%snes, &
106) this%pm_ptr%pm%residual_vec, &
107) PMResidual, &
108) this%pm_ptr, &
109) ierr);CHKERRQ(ierr)
110) call SNESSetJacobian(ts%solver%snes, &
111) ts%solver%J, &
112) ts%solver%Jpre, &
113) PMJacobian, &
114) this%pm_ptr, &
115) ierr);CHKERRQ(ierr)
116) end select
117)
118) end subroutine PMCSubsurfaceSetupSolvers
119)
120) ! ************************************************************************** !
121)
122) subroutine PMCSubsurfaceGetAuxData(this)
123) !
124) ! Author: Gautam Bisht
125) ! Date: 10/24/13
126) !
127)
128) implicit none
129)
130) class(pmc_subsurface_type) :: this
131)
132) if (this%option%surf_flow_on) call PMCSubsurfaceGetAuxDataFromSurf(this)
133) if (this%option%ngeomechdof > 0) call PMCSubsurfaceGetAuxDataFromGeomech(this)
134)
135) end subroutine PMCSubsurfaceGetAuxData
136)
137) ! ************************************************************************** !
138)
139) subroutine PMCSubsurfaceSetAuxData(this)
140) !
141) ! Author: Gautam Bisht
142) ! Date: 10/24/13
143) !
144)
145) implicit none
146)
147) class(pmc_subsurface_type) :: this
148)
149) if (this%option%surf_flow_on) call PMCSubsurfaceSetAuxDataForSurf(this)
150) if (this%option%ngeomechdof > 0) call PMCSubsurfaceSetAuxDataForGeomech(this)
151)
152) end subroutine PMCSubsurfaceSetAuxData
153)
154) ! ************************************************************************** !
155)
156) subroutine PMCSubsurfaceGetAuxDataFromSurf(this)
157) !
158) ! This routine
159) !
160) ! Author: Gautam Bisht, LBNL
161) ! Date: 08/22/13
162) !
163)
164) use Connection_module
165) use Coupler_module
166) use Field_module
167) use Grid_module
168) use Option_module
169) use Patch_module
170) ! use Realization_Base_class
171) use Realization_Subsurface_class
172) use String_module
173) use EOS_Water_module
174)
175) implicit none
176)
177) #include "petsc/finclude/petscvec.h"
178) #include "petsc/finclude/petscvec.h90"
179)
180) class(pmc_subsurface_type) :: this
181)
182) class(realization_subsurface_type), pointer :: realization
183) type (patch_type),pointer :: patch
184) type (grid_type),pointer :: grid
185) type (coupler_list_type), pointer :: coupler_list
186) type (coupler_type), pointer :: coupler
187) type (option_type), pointer :: option
188) type (field_type),pointer :: field
189) type (connection_set_type), pointer :: cur_connection_set
190) PetscBool :: coupler_found
191) PetscInt :: iconn
192) PetscReal :: den
193) PetscReal :: dt
194) PetscReal :: surfpress
195) PetscReal :: dum1
196) PetscReal, pointer :: mflux_p(:)
197) PetscReal, pointer :: hflux_p(:)
198) PetscReal, pointer :: head_p(:)
199) PetscReal, pointer :: temp_p(:)
200) PetscErrorCode :: ierr
201)
202) #ifdef DEBUG
203) print *, 'PMCSubsurfaceGetAuxData()'
204) #endif
205)
206) dt = this%option%surf_subsurf_coupling_flow_dt
207)
208) if (associated(this%sim_aux)) then
209)
210) select type (pmc => this)
211) class is (pmc_subsurface_type)
212)
213) if (this%sim_aux%subsurf_mflux_exchange_with_surf /= 0) then
214) ! PETSc Vector to store relevant mass-flux data between
215) ! surface-subsurface model exists
216)
217) patch => pmc%realization%patch
218) grid => pmc%realization%discretization%grid
219) field => pmc%realization%field
220) option => pmc%realization%option
221)
222) select case(this%option%iflowmode)
223) case (RICHARDS_MODE)
224) call VecScatterBegin(pmc%sim_aux%surf_to_subsurf, &
225) pmc%sim_aux%surf_mflux_exchange_with_subsurf, &
226) pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
227) INSERT_VALUES,SCATTER_FORWARD, &
228) ierr);CHKERRQ(ierr)
229) call VecScatterEnd(pmc%sim_aux%surf_to_subsurf, &
230) pmc%sim_aux%surf_mflux_exchange_with_subsurf, &
231) pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
232) INSERT_VALUES,SCATTER_FORWARD, &
233) ierr);CHKERRQ(ierr)
234)
235) call VecScatterBegin(pmc%sim_aux%surf_to_subsurf, &
236) pmc%sim_aux%surf_head, &
237) pmc%sim_aux%subsurf_pres_top_bc, &
238) INSERT_VALUES,SCATTER_FORWARD, &
239) ierr);CHKERRQ(ierr)
240) call VecScatterEnd(pmc%sim_aux%surf_to_subsurf, &
241) pmc%sim_aux%surf_head, &
242) pmc%sim_aux%subsurf_pres_top_bc, &
243) INSERT_VALUES,SCATTER_FORWARD, &
244) ierr);CHKERRQ(ierr)
245) call EOSWaterdensity(option%reference_temperature, &
246) option%reference_pressure,den,dum1,ierr)
247)
248) #if 0
249) coupler_list => patch%source_sink_list
250) coupler => coupler_list%first
251) do
252) if (.not.associated(coupler)) exit
253)
254) ! FLOW
255) if (associated(coupler%flow_aux_real_var)) then
256)
257) ! Find the BC from the list of BCs
258) if (StringCompare(coupler%name,'from_surface_ss')) then
259) coupler_found = PETSC_TRUE
260)
261) call VecGetArrayF90(pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
262) mflux_p,ierr);CHKERRQ(ierr)
263) do iconn = 1,coupler%connection_set%num_connections
264) !coupler%flow_aux_real_var(ONE_INTEGER,iconn) = -mflux_p(iconn)/dt*den
265) enddo
266) call VecRestoreArrayF90(pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
267) mflux_p,ierr);CHKERRQ(ierr)
268)
269) call VecSet(pmc%sim_aux%surf_mflux_exchange_with_subsurf,0.d0, &
270) ierr);CHKERRQ(ierr)
271) endif
272) endif
273)
274) coupler => coupler%next
275) enddo
276) #endif
277)
278) coupler_list => patch%boundary_condition_list
279) coupler => coupler_list%first
280) do
281) if (.not.associated(coupler)) exit
282)
283) ! FLOW
284) if (associated(coupler%flow_aux_real_var)) then
285) ! Find the BC from the list of BCs
286) if (StringCompare(coupler%name,'from_surface_bc')) then
287) coupler_found = PETSC_TRUE
288) call VecGetArrayF90(pmc%sim_aux%subsurf_pres_top_bc, &
289) head_p,ierr);CHKERRQ(ierr)
290) do iconn = 1,coupler%connection_set%num_connections
291) surfpress = head_p(iconn)*(abs(option%gravity(3)))*den + &
292) option%reference_pressure
293) coupler%flow_aux_real_var(RICHARDS_PRESSURE_DOF,iconn) = &
294) surfpress
295) enddo
296) call VecRestoreArrayF90(pmc%sim_aux%subsurf_pres_top_bc, &
297) head_p,ierr);CHKERRQ(ierr)
298) endif
299) endif
300) coupler => coupler%next
301) enddo
302)
303) case (TH_MODE)
304) call VecScatterBegin(pmc%sim_aux%surf_to_subsurf, &
305) pmc%sim_aux%surf_head, &
306) pmc%sim_aux%subsurf_pres_top_bc, &
307) INSERT_VALUES,SCATTER_FORWARD, &
308) ierr);CHKERRQ(ierr)
309) call VecScatterEnd(pmc%sim_aux%surf_to_subsurf, &
310) pmc%sim_aux%surf_head, &
311) pmc%sim_aux%subsurf_pres_top_bc, &
312) INSERT_VALUES,SCATTER_FORWARD, &
313) ierr);CHKERRQ(ierr)
314)
315) call VecScatterBegin(pmc%sim_aux%surf_to_subsurf, &
316) pmc%sim_aux%surf_temp, &
317) pmc%sim_aux%subsurf_temp_top_bc, &
318) INSERT_VALUES,SCATTER_FORWARD, &
319) ierr);CHKERRQ(ierr)
320) call VecScatterEnd(pmc%sim_aux%surf_to_subsurf, &
321) pmc%sim_aux%surf_temp, &
322) pmc%sim_aux%subsurf_temp_top_bc, &
323) INSERT_VALUES,SCATTER_FORWARD, &
324) ierr);CHKERRQ(ierr)
325)
326) call VecScatterBegin(pmc%sim_aux%surf_to_subsurf, &
327) pmc%sim_aux%surf_hflux_exchange_with_subsurf, &
328) pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
329) INSERT_VALUES,SCATTER_FORWARD, &
330) ierr);CHKERRQ(ierr)
331) call VecScatterEnd(pmc%sim_aux%surf_to_subsurf, &
332) pmc%sim_aux%surf_hflux_exchange_with_subsurf, &
333) pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
334) INSERT_VALUES,SCATTER_FORWARD, &
335) ierr);CHKERRQ(ierr)
336)
337) coupler_list => patch%boundary_condition_list
338) coupler => coupler_list%first
339) do
340) if (.not.associated(coupler)) exit
341)
342) ! FLOW
343) if (associated(coupler%flow_aux_real_var)) then
344) ! Find the BC from the list of BCs
345) if (StringCompare(coupler%name,'from_surface_bc')) then
346) coupler_found = PETSC_TRUE
347)
348) call VecGetArrayF90(pmc%sim_aux%subsurf_pres_top_bc, &
349) head_p,ierr);CHKERRQ(ierr)
350) call VecGetArrayF90(pmc%sim_aux%subsurf_temp_top_bc, &
351) temp_p,ierr);CHKERRQ(ierr)
352)
353) do iconn = 1,coupler%connection_set%num_connections
354)
355) ! The pressure value needed to computed density should
356) ! be surf_press and not reference_pressure. But,
357) ! surf_pressure depends on density.
358) call EOSWaterdensity(temp_p(iconn), option%reference_pressure, &
359) den,dum1,ierr)
360)
361) surfpress = head_p(iconn)*(abs(option%gravity(3)))*den + &
362) option%reference_pressure
363) coupler%flow_aux_real_var(TH_PRESSURE_DOF,iconn) = &
364) surfpress
365) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF,iconn) = &
366) temp_p(iconn)
367) enddo
368)
369) call VecRestoreArrayF90(pmc%sim_aux%subsurf_pres_top_bc, &
370) head_p,ierr);CHKERRQ(ierr)
371) call VecRestoreArrayF90(pmc%sim_aux%subsurf_temp_top_bc, &
372) temp_p,ierr);CHKERRQ(ierr)
373) endif
374) endif
375)
376) if (StringCompare(coupler%name,'from_atm_subsurface_bc')) then
377) coupler_found = PETSC_TRUE
378)
379) call VecGetArrayF90(pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
380) mflux_p,ierr);CHKERRQ(ierr)
381)
382) do iconn = 1,coupler%connection_set%num_connections
383) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF,iconn) = &
384) mflux_p(iconn)
385) enddo
386)
387) call VecRestoreArrayF90(pmc%sim_aux%subsurf_mflux_exchange_with_surf, &
388) mflux_p,ierr);CHKERRQ(ierr)
389) endif
390)
391) coupler => coupler%next
392) enddo
393)
394) case default
395) this%option%io_buffer='PMCSubsurfaceGetAuxData() not supported for this mode.'
396) call printErrMsg(this%option)
397)
398) end select
399)
400) if ( .not. coupler_found) then
401) option%io_buffer = 'Coupler not found in PMCSubsurfaceGetAuxData()'
402) call printErrMsg(option)
403) endif
404) endif
405)
406) end select
407)
408) endif ! if (associated(this%sim_aux))
409)
410) end subroutine PMCSubsurfaceGetAuxDataFromSurf
411)
412) ! ************************************************************************** !
413)
414) subroutine PMCSubsurfaceSetAuxDataForSurf(this)
415) !
416) ! This routine sets auxiliary to be exchanged between process-models.
417) !
418) ! Author: Gautam Bisht, LBNL
419) ! Date: 08/21/13
420) !
421)
422) use Grid_module
423) use String_module
424) use Realization_Subsurface_class
425) use Option_module
426) use Patch_module
427) use Coupler_module
428) use Field_module
429) use Connection_module
430) use Realization_Base_class
431) use EOS_Water_module
432)
433) implicit none
434)
435) #include "petsc/finclude/petscvec.h"
436) #include "petsc/finclude/petscvec.h90"
437)
438) class(pmc_subsurface_type) :: this
439)
440) class(realization_subsurface_type), pointer :: realization
441) type (patch_type),pointer :: patch
442) type (grid_type),pointer :: grid
443) type (coupler_list_type), pointer :: coupler_list
444) type (coupler_type), pointer :: coupler
445) type (option_type), pointer :: option
446) type (field_type),pointer :: field
447) type (connection_set_type), pointer :: cur_connection_set
448) PetscInt :: local_id
449) PetscInt :: ghosted_id
450) PetscInt :: iconn
451) PetscInt :: istart
452) PetscInt :: iend
453) PetscReal :: den
454) PetscReal :: dum1
455) PetscReal, pointer :: xx_loc_p(:)
456) PetscReal, pointer :: pres_top_bc_p(:)
457) PetscReal, pointer :: temp_top_bc_p(:)
458) PetscReal, pointer :: head_p(:)
459) PetscErrorCode :: ierr
460)
461) #ifdef DEBUG
462) print *, 'PMCSubsurfaceSetAuxData()'
463) #endif
464)
465) if (associated(this%sim_aux)) then
466)
467) select type (pmc => this)
468) class is (pmc_subsurface_type)
469)
470) if (this%sim_aux%subsurf_pres_top_bc/=0) then
471) ! PETSc Vector to store relevant subsurface-flow data for
472) ! surface-flow model exists
473)
474) patch => pmc%realization%patch
475) grid => pmc%realization%discretization%grid
476) field => pmc%realization%field
477) option => pmc%realization%option
478)
479) call EOSWaterdensity(option%reference_temperature, option%reference_pressure, &
480) den,dum1,ierr)
481) coupler_list => patch%boundary_condition_list
482) coupler => coupler_list%first
483) do
484) if (.not.associated(coupler)) exit
485)
486) ! FLOW
487) if (associated(coupler%flow_aux_real_var)) then
488)
489) ! Find the BC from the list of BCs
490) if (StringCompare(coupler%name,'from_surface_bc')) then
491) select case(this%option%iflowmode)
492) case (RICHARDS_MODE)
493) call VecGetArrayF90(this%sim_aux%subsurf_pres_top_bc, &
494) pres_top_bc_p,ierr);CHKERRQ(ierr)
495) do iconn = 1,coupler%connection_set%num_connections
496) pres_top_bc_p(iconn) = &
497) coupler%flow_aux_real_var(RICHARDS_PRESSURE_DOF,iconn)
498) enddo
499) call VecRestoreArrayF90(this%sim_aux%subsurf_pres_top_bc, &
500) pres_top_bc_p,ierr);CHKERRQ(ierr)
501) case (TH_MODE)
502) call VecGetArrayF90(this%sim_aux%subsurf_pres_top_bc, &
503) pres_top_bc_p,ierr);CHKERRQ(ierr)
504) call VecGetArrayF90(this%sim_aux%subsurf_temp_top_bc, &
505) temp_top_bc_p,ierr);CHKERRQ(ierr)
506)
507) do iconn = 1,coupler%connection_set%num_connections
508) pres_top_bc_p(iconn) = &
509) coupler%flow_aux_real_var(TH_PRESSURE_DOF,iconn)
510) temp_top_bc_p(iconn) = &
511) coupler%flow_aux_real_var(TH_TEMPERATURE_DOF,iconn)
512) enddo
513)
514) call VecRestoreArrayF90(this%sim_aux%subsurf_pres_top_bc, &
515) pres_top_bc_p,ierr);CHKERRQ(ierr)
516) call VecRestoreArrayF90(this%sim_aux%subsurf_temp_top_bc, &
517) temp_top_bc_p,ierr);CHKERRQ(ierr)
518) case default
519) option%io_buffer = 'PMCSubsurfaceGetAuxData() not ' // &
520) 'supported in this FLOW_MODE'
521) call printErrMsg(option)
522) end select
523) endif
524) endif
525)
526) coupler => coupler%next
527) enddo
528)
529) endif
530) end select
531)
532) endif
533)
534) end subroutine PMCSubsurfaceSetAuxDataForSurf
535)
536) ! ************************************************************************** !
537)
538) subroutine PMCSubsurfaceGetAuxDataFromGeomech(this)
539) !
540) ! This routine updates subsurface data from geomechanics process model.
541) !
542) ! Author: Gautam Bisht, LBNL
543) ! Date: 01/04/14
544)
545) use Discretization_module, only : DiscretizationLocalToLocal
546) use Field_module
547) use Grid_module
548) use Option_module
549) use Realization_Subsurface_class
550) use PFLOTRAN_Constants_module
551) use Material_Aux_class
552) use Material_module
553) use Variables_module, only : POROSITY
554)
555) implicit none
556)
557) #include "petsc/finclude/petscvec.h"
558) #include "petsc/finclude/petscvec.h90"
559) #include "petsc/finclude/petscviewer.h"
560)
561) class (pmc_subsurface_type) :: this
562)
563) type(grid_type), pointer :: subsurf_grid
564) type(option_type), pointer :: option
565) type(field_type), pointer :: subsurf_field
566)
567) PetscScalar, pointer :: sim_por_p(:)
568) class(material_auxvar_type), pointer :: subsurf_material_auxvars(:)
569)
570) PetscInt :: local_id
571) PetscInt :: ghosted_id
572)
573) PetscErrorCode :: ierr
574) PetscViewer :: viewer
575)
576) if (associated(this%sim_aux)) then
577) select type (pmc => this)
578) class is (pmc_subsurface_type)
579) option => pmc%option
580) subsurf_grid => pmc%realization%discretization%grid
581) subsurf_field => pmc%realization%field
582) subsurf_material_auxvars => pmc%realization%patch%aux%Material%auxvars
583)
584) if (pmc%timestepper%steps == 0) return
585)
586) if (option%geomech_subsurf_coupling == GEOMECH_TWO_WAY_COUPLED) then
587)
588) call VecGetArrayF90(pmc%sim_aux%subsurf_por, sim_por_p, &
589) ierr);CHKERRQ(ierr)
590)
591) do local_id = 1, subsurf_grid%nlmax
592) ghosted_id = subsurf_grid%nL2G(local_id)
593) subsurf_material_auxvars(ghosted_id)%porosity = sim_por_p(local_id)
594) enddo
595)
596) call VecRestoreArrayF90(pmc%sim_aux%subsurf_por, sim_por_p, &
597) ierr);CHKERRQ(ierr)
598)
599) ! call PetscViewerBinaryOpen(pmc%realization%option%mycomm, &
600) ! 'por_before.bin',FILE_MODE_WRITE,viewer, &
601) ! ierr);CHKERRQ(ierr)
602) call MaterialGetAuxVarVecLoc(pmc%realization%patch%aux%Material, &
603) subsurf_field%work_loc, &
604) POROSITY,ZERO_INTEGER)
605)
606) ! call VecView(subsurf_field%work_loc,viewer,ierr);CHKERRQ(ierr)
607) ! call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
608)
609) call DiscretizationLocalToLocal(pmc%realization%discretization, &
610) subsurf_field%work_loc, &
611) subsurf_field%work_loc,ONEDOF)
612) ! call PetscViewerBinaryOpen(pmc%realization%option%mycomm, &
613) ! 'por_after.bin',FILE_MODE_WRITE,viewer, &
614) ! ierr);CHKERRQ(ierr)
615) ! call VecView(subsurf_field%work_loc,viewer,ierr);CHKERRQ(ierr)
616) ! call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
617)
618) call MaterialSetAuxVarVecLoc(pmc%realization%patch%aux%Material, &
619) subsurf_field%work_loc, &
620) POROSITY,ZERO_INTEGER)
621)
622) endif
623) end select
624) endif
625)
626) end subroutine PMCSubsurfaceGetAuxDataFromGeomech
627)
628) ! ************************************************************************** !
629)
630) subroutine PMCSubsurfaceSetAuxDataForGeomech(this)
631) !
632) ! This routine sets auxiliary needed by geomechanics process model.
633) !
634) ! Author: Gautam Bisht, LBNL
635) ! Date: 01/04/14
636)
637) use Option_module
638) use Realization_Subsurface_class
639) use Grid_module
640) use Field_module
641) use Material_Aux_class
642) use PFLOTRAN_Constants_module
643)
644) implicit none
645)
646) #include "petsc/finclude/petscvec.h"
647) #include "petsc/finclude/petscvec.h90"
648)
649) class (pmc_subsurface_type) :: this
650)
651) type(grid_type), pointer :: subsurf_grid
652) type(option_type), pointer :: option
653) type(field_type), pointer :: subsurf_field
654)
655) PetscScalar, pointer :: xx_loc_p(:)
656) PetscScalar, pointer :: pres_p(:)
657) PetscScalar, pointer :: temp_p(:)
658) PetscScalar, pointer :: sub_por_loc_p(:)
659) PetscScalar, pointer :: sim_por0_p(:)
660)
661) PetscInt :: local_id
662) PetscInt :: ghosted_id
663) PetscInt :: pres_dof
664) PetscInt :: temp_dof
665)
666) class(material_auxvar_type), pointer :: material_auxvars(:)
667)
668) PetscErrorCode :: ierr
669)
670) select case(this%option%iflowmode)
671) case (TH_MODE)
672) pres_dof = TH_PRESSURE_DOF
673) temp_dof = TH_TEMPERATURE_DOF
674) case (MPH_MODE)
675) pres_dof = MPH_PRESSURE_DOF
676) temp_dof = MPH_TEMPERATURE_DOF
677) case(RICHARDS_MODE)
678) pres_dof = RICHARDS_PRESSURE_DOF
679) case default
680) this%option%io_buffer = 'PMCSubsurfaceSetAuxDataForGeomech() not ' // &
681) 'supported for ' // trim(this%option%flowmode)
682) call printErrMsg(this%option)
683) end select
684)
685) if (associated(this%sim_aux)) then
686)
687) select type (pmc => this)
688) class is (pmc_subsurface_type)
689)
690) option => pmc%option
691) subsurf_grid => pmc%realization%discretization%grid
692) subsurf_field => pmc%realization%field
693)
694)
695) ! Extract pressure, temperature and porosity from subsurface realization
696) call VecGetArrayF90(subsurf_field%flow_xx_loc, xx_loc_p, &
697) ierr);CHKERRQ(ierr)
698) call VecGetArrayF90(pmc%sim_aux%subsurf_pres, pres_p, &
699) ierr);CHKERRQ(ierr)
700) call VecGetArrayF90(pmc%sim_aux%subsurf_temp, temp_p, &
701) ierr);CHKERRQ(ierr)
702)
703) do local_id = 1, subsurf_grid%nlmax
704) ghosted_id = subsurf_grid%nL2G(local_id)
705) pres_p(local_id) = xx_loc_p(option%nflowdof*(ghosted_id - 1) + &
706) pres_dof)
707) if (this%option%iflowmode == RICHARDS_MODE) then
708) temp_p(local_id) = this%option%reference_temperature
709) else
710) temp_p(local_id) = xx_loc_p(option%nflowdof*(ghosted_id - 1) + &
711) temp_dof)
712) endif
713) enddo
714)
715) call VecRestoreArrayF90(subsurf_field%flow_xx_loc, xx_loc_p, &
716) ierr);CHKERRQ(ierr)
717) call VecRestoreArrayF90(pmc%sim_aux%subsurf_pres, pres_p, &
718) ierr);CHKERRQ(ierr)
719) call VecRestoreArrayF90(pmc%sim_aux%subsurf_temp, temp_p, &
720) ierr);CHKERRQ(ierr)
721)
722) if (pmc%timestepper%steps == 0) then
723) material_auxvars => pmc%realization%patch%aux%Material%auxvars
724) call VecGetArrayF90(pmc%sim_aux%subsurf_por0, sim_por0_p, &
725) ierr);CHKERRQ(ierr)
726) do local_id = 1, subsurf_grid%nlmax
727) ghosted_id = subsurf_grid%nL2G(local_id)
728) sim_por0_p(local_id) = material_auxvars(ghosted_id)%porosity
729) enddo
730) call VecRestoreArrayF90(pmc%sim_aux%subsurf_por0, sim_por0_p, &
731) ierr);CHKERRQ(ierr)
732) endif
733) end select
734) endif
735)
736) end subroutine PMCSubsurfaceSetAuxDataForGeomech
737)
738) ! ************************************************************************** !
739) !
740) ! PMCSubsurfaceFinalizeRun: Finalizes the time stepping
741) ! author: Glenn Hammond
742) ! date: 03/18/13
743) !
744) ! ************************************************************************** !
745) recursive subroutine PMCSubsurfaceFinalizeRun(this)
746) !
747) ! Finalizes the time stepping
748) !
749) ! Author: Glenn Hammond
750) ! Date: 03/18/13
751) !
752)
753) use Option_module
754)
755) implicit none
756)
757) class(pmc_subsurface_type) :: this
758)
759) #ifdef DEBUG
760) call printMsg(this%option,'PMCSubsurface%FinalizeRun()')
761) #endif
762)
763) nullify(this%realization)
764)
765) end subroutine PMCSubsurfaceFinalizeRun
766)
767) ! ************************************************************************** !
768)
769) subroutine PMCSubsurfaceStrip(this)
770) !
771) ! Deallocates members of PMC Subsurface.
772) !
773) ! Author: Glenn Hammond
774) ! Date: 01/13/14
775)
776) implicit none
777)
778) class(pmc_subsurface_type) :: this
779)
780) call PMCBaseStrip(this)
781) nullify(this%realization)
782)
783) end subroutine PMCSubsurfaceStrip
784)
785) ! ************************************************************************** !
786)
787) recursive subroutine PMCSubsurfaceDestroy(this)
788) !
789) ! ProcessModelCouplerDestroy: Deallocates a process_model_coupler object
790) !
791) ! Author: Glenn Hammond
792) ! Date: 03/14/13
793) !
794)
795) use Option_module
796)
797) implicit none
798)
799) class(pmc_subsurface_type) :: this
800)
801) #ifdef DEBUG
802) call printMsg(this%option,'PMCSubsurface%Destroy()')
803) #endif
804)
805) if (associated(this%child)) then
806) call this%child%Destroy()
807) ! destroy does not currently destroy; it strips
808) deallocate(this%child)
809) nullify(this%child)
810) endif
811)
812) if (associated(this%peer)) then
813) call this%peer%Destroy()
814) ! destroy does not currently destroy; it strips
815) deallocate(this%peer)
816) nullify(this%peer)
817) endif
818)
819) call PMCSubsurfaceStrip(this)
820)
821) end subroutine PMCSubsurfaceDestroy
822)
823) end module PMC_Subsurface_class