geomechanics_global.F90       coverage:  28.57 %func     27.59 %block


     1) module Geomechanics_Global_module
     2) 
     3)   use Geomechanics_Global_Aux_module
     4)   use PFLOTRAN_Constants_module
     5) 
     6)   implicit none
     7) 
     8)   private
     9)   
    10) #include "petsc/finclude/petscsys.h"
    11) 
    12)   public :: GeomechGlobalSetup, &
    13)             GeomechGlobalSetAuxVarScalar, &
    14)             GeomechGlobalSetAuxVarVecLoc, &
    15)             GeomechGlobalUpdateAuxVars
    16) 
    17) contains
    18) 
    19) ! ************************************************************************** !
    20) 
    21) subroutine GeomechGlobalSetup(geomech_realization)
    22)   ! 
    23)   ! Set up global aux vars in a realization
    24)   ! 
    25)   ! Author: Satish Karra, LANL
    26)   ! Date: 06/17/13
    27)   ! 
    28) 
    29)   use Geomechanics_Realization_class
    30)   use Geomechanics_Patch_module
    31)   
    32)   implicit none
    33) 
    34)   class(realization_geomech_type) :: geomech_realization
    35)   
    36)   ! There is only one patch in each realization
    37)   call GeomechGlobalSetupPatch(geomech_realization)
    38)   
    39) end subroutine GeomechGlobalSetup
    40) 
    41) ! ************************************************************************** !
    42) 
    43) subroutine GeomechGlobalSetupPatch(geomech_realization)
    44)   ! 
    45)   ! Strips a geomech global auxvar
    46)   ! 
    47)   ! Author: Satish Karra, LANL
    48)   ! Date: 06/17/13
    49)   ! 
    50) 
    51)   use Geomechanics_Realization_class
    52)   use Geomechanics_Patch_module
    53)   use Option_module
    54)   use Geomechanics_Coupler_module
    55)   use Geomechanics_Grid_module
    56)   use Geomechanics_Grid_Aux_module
    57)  
    58)   implicit none
    59)   
    60)   class(realization_geomech_type) :: geomech_realization
    61) 
    62)   type(option_type), pointer :: option
    63)   type(geomech_patch_type),pointer :: patch
    64)   type(geomech_grid_type), pointer :: grid
    65)   type(geomech_coupler_type), pointer :: boundary_condition
    66)   type(geomech_coupler_type), pointer :: source_sink
    67) 
    68)   PetscInt :: ghosted_id
    69)   type(geomech_global_auxvar_type), pointer :: aux_vars(:)
    70)   PetscInt :: ivertex
    71)   
    72)   option => geomech_realization%option
    73)   patch => geomech_realization%geomech_patch
    74)   grid => patch%geomech_grid
    75) 
    76)   patch%geomech_aux%GeomechGlobal => GeomechGlobalAuxCreate()
    77)   
    78)   allocate(aux_vars(grid%ngmax_node))
    79)   do ghosted_id = 1, grid%ngmax_node
    80)     call GeomechGlobalAuxVarInit(aux_vars(ghosted_id),option)
    81)   enddo
    82)   patch%geomech_aux%GeomechGlobal%aux_vars => aux_vars
    83)   patch%geomech_aux%GeomechGlobal%num_aux = grid%ngmax_node
    84)    
    85) end subroutine GeomechGlobalSetupPatch
    86) 
    87) ! ************************************************************************** !
    88) 
    89) subroutine GeomechGlobalSetAuxVarScalar(geomech_realization,value,ivar)
    90)   ! 
    91)   ! Strips a geomech global auxvar
    92)   ! 
    93)   ! Author: Satish Karra, LANL
    94)   ! Date: 06/17/13
    95)   ! 
    96) 
    97)   use Geomechanics_Realization_class
    98)   use Geomechanics_Patch_module
    99) 
   100)   implicit none
   101) 
   102)   class(realization_geomech_type) :: geomech_realization
   103)   PetscReal :: value
   104)   PetscInt :: ivar
   105)   
   106)   type(geomech_patch_type), pointer :: cur_patch
   107)   
   108)   cur_patch => geomech_realization%geomech_patch
   109)   call GeomechGlobalSetAuxVarScalarPatch(geomech_realization,value,ivar)
   110)  
   111) end subroutine GeomechGlobalSetAuxVarScalar
   112) 
   113) ! ************************************************************************** !
   114) 
   115) subroutine GeomechGlobalSetAuxVarScalarPatch(geomech_realization,value,ivar)
   116)   ! 
   117)   ! Strips a geomech global auxvar
   118)   ! 
   119)   ! Author: Satish Karra, LANL
   120)   ! Date: 06/17/13
   121)   ! 
   122) 
   123)   use Geomechanics_Realization_class
   124)   use Option_module
   125)   use Geomechanics_Patch_module
   126)   use Variables_module, only : GEOMECH_DISP_X, &
   127)                                GEOMECH_DISP_Y, &
   128)                                GEOMECH_DISP_Z
   129)   
   130)   implicit none
   131) 
   132)   class(realization_geomech_type) :: geomech_realization
   133)   PetscReal :: value
   134)   PetscInt :: ivar
   135) 
   136)   type(option_type), pointer :: option
   137)   type(geomech_patch_type), pointer :: patch
   138)     
   139)   PetscInt :: i
   140)   
   141)   patch => geomech_realization%geomech_patch
   142)   option => geomech_realization%option  
   143)   
   144)   select case(ivar)
   145)     case(GEOMECH_DISP_X)
   146)       do i=1, patch%geomech_aux%GeomechGlobal%num_aux
   147)         patch%geomech_aux%GeomechGlobal%aux_vars(i)%disp_vector(&
   148)           GEOMECH_DISP_X_DOF) = value
   149)       enddo
   150)     case(GEOMECH_DISP_Y)
   151)       do i=1, patch%geomech_aux%GeomechGlobal%num_aux
   152)         patch%geomech_aux%GeomechGlobal%aux_vars(i)%disp_vector(&
   153)           GEOMECH_DISP_Y_DOF) = value
   154)       enddo
   155)     case(GEOMECH_DISP_Z)
   156)       do i=1, patch%geomech_aux%GeomechGlobal%num_aux
   157)         patch%geomech_aux%GeomechGlobal%aux_vars(i)%disp_vector(&
   158)           GEOMECH_DISP_Z_DOF) = value
   159)       enddo
   160)   end select
   161)   
   162) end subroutine GeomechGlobalSetAuxVarScalarPatch
   163) 
   164) ! ************************************************************************** !
   165) 
   166) subroutine GeomechGlobalSetAuxVarVecLoc(geomech_realization,vec_loc,ivar, &
   167)                                         isubvar)
   168)   ! 
   169)   ! Strips a geomech global auxvar
   170)   ! 
   171)   ! Author: Satish Karra, LANL
   172)   ! Date: 06/17/13
   173)   ! 
   174) 
   175)   use Geomechanics_Realization_class
   176)   use Geomechanics_Patch_module
   177) 
   178)   implicit none
   179)   
   180) #include "petsc/finclude/petscvec.h"
   181) #include "petsc/finclude/petscvec.h90"  
   182) 
   183)   class(realization_geomech_type) :: geomech_realization
   184)   Vec :: vec_loc
   185)   PetscInt :: ivar
   186)   PetscInt :: isubvar
   187)   
   188)   type(geomech_patch_type), pointer :: cur_patch
   189) 
   190)   cur_patch => geomech_realization%geomech_patch
   191)   call GeomechGlobalSetAuxVarVecLocPatch(geomech_realization,vec_loc,ivar,isubvar)
   192) 
   193) end subroutine GeomechGlobalSetAuxVarVecLoc
   194) 
   195) ! ************************************************************************** !
   196) 
   197) subroutine GeomechGlobalSetAuxVarVecLocPatch(geomech_realization,vec_loc,ivar,&
   198)                                              isubvar)
   199)   ! 
   200)   ! Strips a geomech global auxvar
   201)   ! 
   202)   ! Author: Satish Karra, LANL
   203)   ! Date: 06/17/13
   204)   ! 
   205) 
   206)   use Geomechanics_Realization_class
   207)   use Geomechanics_Patch_module
   208)   use Geomechanics_Grid_Aux_module
   209)   use Geomechanics_Grid_module
   210)   use Option_module
   211)   use Variables_module, only : GEOMECH_DISP_X, &
   212)                                GEOMECH_DISP_Y, &
   213)                                GEOMECH_DISP_Z
   214)   
   215)   implicit none
   216) 
   217) #include "petsc/finclude/petscvec.h"
   218) #include "petsc/finclude/petscvec.h90"
   219) 
   220)   class(realization_geomech_type) :: geomech_realization
   221)   Vec :: vec_loc
   222)   PetscInt :: ivar
   223)   PetscInt :: isubvar  
   224)   
   225)   type(option_type), pointer :: option
   226)   type(geomech_patch_type), pointer :: patch
   227)   type(geomech_grid_type), pointer :: grid
   228)   
   229)   PetscInt :: ghosted_id
   230)   PetscReal, pointer :: vec_loc_p(:)
   231)   PetscErrorCode :: ierr
   232)   
   233)   patch => geomech_realization%geomech_patch
   234)   grid => patch%geomech_grid
   235)   option => geomech_realization%option
   236)   
   237)   call GeomechGridVecGetArrayF90(grid,vec_loc,vec_loc_p,ierr)
   238)   
   239)   select case(ivar)
   240)     case(GEOMECH_DISP_X)
   241)       select case(isubvar)
   242)         case default
   243)           do ghosted_id=1, grid%ngmax_node
   244)             patch%geomech_aux%GeomechGlobal%aux_vars(&
   245)               ghosted_id)%disp_vector(GEOMECH_DISP_X_DOF) &
   246)               = vec_loc_p(ghosted_id)
   247)           enddo
   248)       end select
   249)     case(GEOMECH_DISP_Y)
   250)       select case(isubvar)
   251)         case default
   252)           do ghosted_id=1, grid%ngmax_node
   253)             patch%geomech_aux%GeomechGlobal%aux_vars(&
   254)               ghosted_id)%disp_vector(GEOMECH_DISP_Y_DOF) &
   255)               = vec_loc_p(ghosted_id)
   256)           enddo
   257)       end select
   258)     case(GEOMECH_DISP_Z)
   259)       select case(isubvar)
   260)         case default
   261)           do ghosted_id=1, grid%ngmax_node
   262)             patch%geomech_aux%GeomechGlobal%aux_vars(&
   263)               ghosted_id)%disp_vector(GEOMECH_DISP_Z_DOF) &
   264)               = vec_loc_p(ghosted_id)
   265)           enddo
   266)       end select
   267)   end select
   268) 
   269)   call GeomechGridVecRestoreArrayF90(grid,vec_loc,vec_loc_p,ierr)
   270) 
   271) end subroutine GeomechGlobalSetAuxVarVecLocPatch
   272) 
   273) ! ************************************************************************** !
   274) 
   275) subroutine GeomechGlobalUpdateAuxVars(geomech_realization,time_level)
   276)   ! 
   277)   ! Strips a geomech global auxvar
   278)   ! 
   279)   ! Author: Satish Karra, LANL
   280)   ! Date: 06/17/13
   281)   ! 
   282) 
   283)   use Geomechanics_Realization_class
   284)   use Geomechanics_Field_module
   285)   use Option_module
   286)   use Geomechanics_Discretization_module
   287)   use Variables_module, only : GEOMECH_DISP_X, &
   288)                                GEOMECH_DISP_Y, &
   289)                                GEOMECH_DISP_Z
   290)   
   291)   class(realization_geomech_type) :: geomech_realization
   292)   PetscInt :: time_level
   293)   
   294)   type(geomech_field_type), pointer :: geomech_field
   295)   type(option_type), pointer :: option
   296)   
   297)   option => geomech_realization%option
   298)   geomech_field => geomech_realization%geomech_field
   299)   
   300)   ! x displacement
   301)   call GeomechRealizGetDataset(geomech_realization,geomech_field%work, &
   302)                                GEOMECH_DISP_X,ZERO_INTEGER)
   303)   call GeomechDiscretizationGlobalToLocal(&
   304)                               geomech_realization%geomech_discretization, &
   305)                               geomech_field%work,geomech_field%work_loc,ONEDOF)
   306)   call GeomechGlobalSetAuxVarVecLoc(geomech_realization,&
   307)                                     geomech_field%work_loc, &
   308)                                     GEOMECH_DISP_X,time_level)
   309)                                   
   310)   ! y displacement
   311)   call GeomechRealizGetDataset(geomech_realization,geomech_field%work, &
   312)                                GEOMECH_DISP_Y,ZERO_INTEGER)
   313)   call GeomechDiscretizationGlobalToLocal(&
   314)                               geomech_realization%geomech_discretization, &
   315)                               geomech_field%work,geomech_field%work_loc,ONEDOF)
   316)   call GeomechGlobalSetAuxVarVecLoc(geomech_realization, &
   317)                                     geomech_field%work_loc, &
   318)                                     GEOMECH_DISP_Y,time_level)
   319) 
   320)   ! z displacement
   321)   call GeomechRealizGetDataset(geomech_realization,geomech_field%work, &
   322)                                GEOMECH_DISP_Z,ZERO_INTEGER)
   323)   call GeomechDiscretizationGlobalToLocal(&
   324)                               geomech_realization%geomech_discretization, &
   325)                               geomech_field%work,geomech_field%work_loc,ONEDOF)
   326)   call GeomechGlobalSetAuxVarVecLoc(geomech_realization, &
   327)                                     geomech_field%work_loc, &
   328)                                     GEOMECH_DISP_Z,time_level)
   329) 
   330) 
   331) end subroutine GeomechGlobalUpdateAuxVars
   332) 
   333) end module Geomechanics_Global_module

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