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

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