pm_geomechanics_force.F90       coverage:  73.33 %func     66.67 %block


     1) module PM_Geomechanics_Force_class
     2) 
     3)   use PM_Base_class
     4)   use Geomechanics_Realization_class
     5)   use Communicator_Base_module
     6)   use Option_module
     7)   use PFLOTRAN_Constants_module
     8) 
     9)   implicit none
    10) 
    11)   private
    12) 
    13) #include "petsc/finclude/petscsys.h"
    14) 
    15) #include "petsc/finclude/petscvec.h"
    16) #include "petsc/finclude/petscvec.h90"
    17) #include "petsc/finclude/petscmat.h"
    18) #include "petsc/finclude/petscmat.h90"
    19) #include "petsc/finclude/petscsnes.h"
    20) #include "petsc/finclude/petscts.h"
    21) 
    22)   type, public, extends(pm_base_type) :: pm_geomech_force_type
    23)     class(realization_geomech_type), pointer :: geomech_realization
    24)     class(communicator_type), pointer :: comm1
    25)   contains
    26)     procedure, public :: Setup => PMGeomechForceSetup
    27)     procedure, public :: PMGeomechForceSetRealization
    28)     procedure, public :: InitializeRun => PMGeomechForceInitializeRun
    29)     procedure, public :: FinalizeRun => PMGeomechForceFinalizeRun
    30)     procedure, public :: InitializeTimestep => PMGeomechForceInitializeTimestep
    31)     procedure, public :: Residual => PMGeomechForceResidual
    32)     procedure, public :: Jacobian => PMGeomechForceJacobian
    33)     procedure, public :: PreSolve => PMGeomechForcePreSolve
    34)     procedure, public :: UpdateSolution => PMGeomechForceUpdateSolution
    35)     procedure, public :: CheckpointBinary => PMGeomechForceCheckpointBinary
    36)     procedure, public :: RestartBinary => PMGeomechForceRestartBinary
    37)     procedure, public :: InputRecord => PMGeomechForceInputRecord
    38)     procedure, public :: Destroy => PMGeomechForceDestroy
    39)     procedure, public :: FinalizeTimestep => PMGeomechForceFinalizeTimestep
    40)   end type pm_geomech_force_type
    41) 
    42)   public :: PMGeomechForceCreate
    43) 
    44) contains
    45) 
    46) ! ************************************************************************** !
    47) 
    48) function PMGeomechForceCreate()
    49)   ! 
    50)   ! This routine creates
    51)   ! 
    52)   ! Author: Gautam Bisht, LBNL
    53)   ! Date: 12/31/13
    54)   ! 
    55) 
    56)   implicit none
    57) 
    58)   class(pm_geomech_force_type), pointer :: PMGeomechForceCreate
    59) 
    60)   class(pm_geomech_force_type), pointer :: geomech_force_pm
    61) 
    62)   allocate(geomech_force_pm)
    63)   nullify(geomech_force_pm%option)
    64)   nullify(geomech_force_pm%output_option)
    65)   nullify(geomech_force_pm%geomech_realization)
    66)   nullify(geomech_force_pm%comm1)
    67) 
    68)   call PMBaseInit(geomech_force_pm)
    69) 
    70)   PMGeomechForceCreate => geomech_force_pm
    71) 
    72) end function PMGeomechForceCreate
    73) 
    74) ! ************************************************************************** !
    75) 
    76) subroutine PMGeomechForceSetup(this)
    77)   ! 
    78)   ! This routine
    79)   ! 
    80)   ! Author: Gautam Bisht, LBNL
    81)   ! Date: 12/31/13
    82)   ! 
    83) 
    84)   use Geomechanics_Discretization_module
    85)   use Communicator_Structured_class
    86)   use Communicator_Unstructured_class
    87)   use Grid_module
    88) 
    89)   implicit none
    90) 
    91)   class(pm_geomech_force_type) :: this
    92) 
    93)   ! set up communicator
    94)   select case(this%geomech_realization%geomech_discretization%itype)
    95)     case(STRUCTURED_GRID)
    96)       this%comm1 => StructuredCommunicatorCreate()
    97)     case(UNSTRUCTURED_GRID)
    98)       this%comm1 => UnstructuredCommunicatorCreate()
    99)   end select
   100) 
   101)   !call this%comm1%SetDM(this%geomech_realization%geomech_discretization%dm_1dof)
   102) 
   103) end subroutine PMGeomechForceSetup
   104) 
   105) ! ************************************************************************** !
   106) 
   107) recursive subroutine PMGeomechForceInitializeRun(this)
   108)   ! 
   109)   ! This routine
   110)   ! 
   111)   ! Author: Gautam Bisht, LBNL
   112)   ! Date: 12/31/13
   113)   ! 
   114) 
   115)   use Geomechanics_Force_module, only : GeomechUpdateSolution
   116) 
   117)   implicit none
   118) 
   119)   class(pm_geomech_force_type) :: this
   120) 
   121) end subroutine PMGeomechForceInitializeRun
   122) 
   123) ! ************************************************************************** !
   124) 
   125) recursive subroutine PMGeomechForceFinalizeRun(this)
   126)   ! 
   127)   ! This routine
   128)   ! 
   129)   ! Author: Gautam Bisht, LBNL
   130)   ! Date: 12/31/13
   131)   ! 
   132) 
   133)   implicit none
   134) 
   135)   class(pm_geomech_force_type) :: this
   136) 
   137) #ifdef PM_GEOMECH_FORCE_DEBUG
   138)   call printMsg(this%option,'PMGeomechForce%FinalizeRun()')
   139) #endif
   140) 
   141)   if (associated(this%next)) then
   142)     call this%next%FinalizeRun()
   143)   endif
   144) 
   145) end subroutine PMGeomechForceFinalizeRun
   146) 
   147) ! ************************************************************************** !
   148) 
   149) subroutine PMGeomechForceSetRealization(this, geomech_realization)
   150)   ! 
   151)   ! This routine
   152)   ! 
   153)   ! Author: Gautam Bisht, LBNL
   154)   ! Date: 12/31/13
   155)   ! 
   156) 
   157)   use Grid_module
   158) 
   159)   implicit none
   160) 
   161)   class(pm_geomech_force_type) :: this
   162)   class(realization_geomech_type), pointer :: geomech_realization
   163) 
   164)   this%geomech_realization => geomech_realization
   165)   this%realization_base => geomech_realization
   166) 
   167)   this%solution_vec = geomech_realization%geomech_field%disp_xx
   168)   this%residual_vec = geomech_realization%geomech_field%disp_r
   169) 
   170) end subroutine PMGeomechForceSetRealization
   171) 
   172) ! ************************************************************************** !
   173) 
   174) subroutine PMGeomechForceInitializeTimestep(this)
   175)   ! 
   176)   ! This routine
   177)   ! 
   178)   ! Author: Gautam Bisht, LBNL
   179)   ! Date: 12/31/13
   180)   ! 
   181) 
   182)   use Geomechanics_Force_module, only : GeomechanicsForceInitialGuess
   183)   use Global_module
   184)   
   185)   implicit none
   186)   
   187)   class(pm_geomech_force_type) :: this
   188) 
   189) #ifdef PM_GEOMECH_FORCE_DEBUG  
   190)   call printMsg(this%option,'PMGeomechForce%InitializeTimestep()')
   191) #endif
   192) 
   193)   if (this%option%print_screen_flag) then
   194)     write(*,'(/,2("=")," GEOMECHANICS ",62("="))')
   195)   endif
   196)   
   197)   call GeomechanicsForceInitialGuess(this%geomech_realization)
   198)   
   199) end subroutine PMGeomechForceInitializeTimestep
   200) 
   201) ! ************************************************************************** !
   202) 
   203) subroutine PMGeomechForceResidual(this,snes,xx,r,ierr)
   204)   ! 
   205)   ! This routine
   206)   ! 
   207)   ! Author: Gautam Bisht, LBNL
   208)   ! Date: 12/31/13
   209)   ! 
   210) 
   211)   use Geomechanics_Force_module, only : GeomechForceResidual
   212) 
   213)   implicit none
   214)   
   215)   class(pm_geomech_force_type) :: this
   216)   SNES :: snes
   217)   Vec :: xx
   218)   Vec :: r
   219)   PetscErrorCode :: ierr
   220)   
   221) #ifdef PM_GEOMECH_FORCE_DEBUG  
   222)   call printMsg(this%option,'PMGeomechForce%Residual()')
   223) #endif
   224)   
   225)   call GeomechForceResidual(snes,xx,r,this%geomech_realization,ierr)
   226) 
   227) end subroutine PMGeomechForceResidual
   228) 
   229) ! ************************************************************************** !
   230) 
   231) subroutine PMGeomechForceJacobian(this,snes,xx,A,B,ierr)
   232)   ! 
   233)   ! This routine
   234)   ! 
   235)   ! Author: Gautam Bisht, LBNL
   236)   ! Date: 12/31/13
   237)   ! 
   238) 
   239)   use Geomechanics_Force_module, only : GeomechForceJacobian
   240) 
   241)   implicit none
   242)   
   243)   class(pm_geomech_force_type) :: this
   244)   SNES :: snes
   245)   Vec :: xx
   246)   Mat :: A, B
   247)   PetscErrorCode :: ierr
   248)   
   249) #ifdef PM_GEOMECH_FORCE_DEBUG  
   250)   call printMsg(this%option,'PMGeomechForce%Jacobian()')
   251) #endif
   252)   
   253)   call GeomechForceJacobian(snes,xx,A,B,this%geomech_realization,ierr)
   254) 
   255) end subroutine PMGeomechForceJacobian
   256) 
   257) ! ************************************************************************** !
   258) 
   259) subroutine PMGeomechForcePreSolve(this)
   260)   ! 
   261)   ! This routine
   262)   ! 
   263)   ! Author: Gautam Bisht, LBNL
   264)   ! Date: 12/31/13
   265)   ! 
   266) 
   267)   implicit none
   268) 
   269)   class(pm_geomech_force_type) :: this
   270) 
   271) end subroutine PMGeomechForcePreSolve
   272) 
   273) ! ************************************************************************** !
   274) 
   275) subroutine PMGeomechForceUpdateSolution(this)
   276)   ! 
   277)   ! This routine
   278)   ! 
   279)   ! Author: Gautam Bisht, LBNL
   280)   ! Date: 12/31/13
   281)   ! 
   282) 
   283)   use Geomechanics_Force_module, only : GeomechUpdateSolution, &
   284)                                         GeomechStoreInitialDisp, &
   285)                                         GeomechForceUpdateAuxVars
   286)   use Condition_module
   287) 
   288)   implicit none
   289) 
   290)   class(pm_geomech_force_type) :: this
   291) 
   292)   PetscBool :: force_update_flag = PETSC_FALSE
   293) 
   294) #ifdef PM_GEOMECH_FORCE_DEBUG
   295)   call printMsg(this%option,'PMGeomechForce%UpdateSolution()')
   296) #endif
   297) 
   298)   ! begin from RealizationUpdate()
   299)   call GeomechUpdateSolution(this%geomech_realization)
   300)   if (this%option%geomech_initial) then
   301)     call GeomechStoreInitialDisp(this%geomech_realization)
   302)     this%option%geomech_initial = PETSC_FALSE
   303)   endif
   304)   call GeomechForceUpdateAuxVars(this%geomech_realization)
   305) 
   306) end subroutine PMGeomechForceUpdateSolution
   307) 
   308) ! ************************************************************************** !
   309) 
   310) subroutine PMGeomechForceFinalizeTimestep(this)
   311)   ! 
   312)   ! This routine
   313)   ! 
   314)   ! Author: Gautam Bisht, LBNL
   315)   ! Date: 12/31/13
   316)   ! 
   317) 
   318)   use Global_module
   319) 
   320)   implicit none
   321)   
   322)   class(pm_geomech_force_type) :: this
   323)   
   324) #ifdef PM_GEOMECH_FORCE_DEBUG  
   325)   call printMsg(this%option,'PMGeomechForce%FinalizeTimestep()')
   326) #endif
   327) 
   328) end subroutine PMGeomechForceFinalizeTimestep
   329) 
   330) ! ************************************************************************** !
   331) 
   332) subroutine PMGeomechForceCheckpointBinary(this,viewer)
   333)   ! 
   334)   ! This routine
   335)   ! 
   336)   ! Author: Gautam Bisht, LBNL
   337)   ! Date: 12/31/13
   338)   ! 
   339) 
   340)   use Checkpoint_module
   341) 
   342)   implicit none
   343) #include "petsc/finclude/petscviewer.h"      
   344) 
   345)   class(pm_geomech_force_type) :: this
   346)   PetscViewer :: viewer
   347)   
   348)   call printErrMsg(this%option,'add code for checkpointing Geomech in PM approach')
   349)   
   350) end subroutine PMGeomechForceCheckpointBinary
   351) 
   352) ! ************************************************************************** !
   353) 
   354) subroutine PMGeomechForceRestartBinary(this,viewer)
   355)   ! 
   356)   ! This routine
   357)   ! 
   358)   ! Author: Gautam Bisht, LBNL
   359)   ! Date: 12/31/13
   360)   ! 
   361) 
   362)   use Checkpoint_module
   363) 
   364)   implicit none
   365) #include "petsc/finclude/petscviewer.h"      
   366) 
   367)   class(pm_geomech_force_type) :: this
   368)   PetscViewer :: viewer
   369)   
   370)   call printErrMsg(this%option,'add code for restarting Geomech in PM approach')
   371)   
   372) end subroutine PMGeomechForceRestartBinary
   373) 
   374) ! ************************************************************************** !
   375) 
   376) subroutine PMGeomechForceInputRecord(this)
   377)   ! 
   378)   ! Writes ingested information to the input record file.
   379)   ! 
   380)   ! Author: Jenn Frederick, SNL
   381)   ! Date: 03/21/2016
   382)   ! 
   383)   
   384)   implicit none
   385)   
   386)   class(pm_geomech_force_type) :: this
   387) 
   388)   character(len=MAXWORDLENGTH) :: word
   389)   PetscInt :: id
   390) 
   391)   id = INPUT_RECORD_UNIT
   392) 
   393)   write(id,'(a29)',advance='no') 'pm: '
   394)   write(id,'(a)') this%name
   395) 
   396) end subroutine PMGeomechForceInputRecord
   397) 
   398) ! ************************************************************************** !
   399) 
   400) subroutine PMGeomechForceDestroy(this)
   401)   ! 
   402)   ! This routine
   403)   ! 
   404)   ! Author: Gautam Bisht, LBNL
   405)   ! Date: 12/31/13
   406)   ! 
   407) 
   408)   use Geomechanics_Realization_class, only : GeomechRealizDestroy
   409) 
   410)   implicit none
   411)   
   412)   class(pm_geomech_force_type) :: this
   413)   
   414)   if (associated(this%next)) then
   415)     call this%next%Destroy()
   416)   endif
   417) 
   418) #ifdef PM_GEOMECH_FORCE_DEBUG
   419)   call printMsg(this%option,'PMGeomechForce%Destroy()')
   420) #endif
   421) 
   422)   call GeomechRealizDestroy(this%geomech_realization)
   423) 
   424)   call this%comm1%Destroy()
   425)   
   426) end subroutine PMGeomechForceDestroy
   427) 
   428) end module PM_Geomechanics_Force_class

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