pm_base_pointer.F90       coverage:  50.00 %func     44.44 %block


     1) module PM_Base_Pointer_module
     2) 
     3)   use PM_Base_class
     4)   
     5)   use PFLOTRAN_Constants_module
     6) 
     7)   implicit none
     8) 
     9)   private
    10) 
    11) #include "petsc/finclude/petscsys.h"
    12) 
    13)   ! Since the context (ctx) for procedures passed to PETSc must be declared 
    14)   ! as a "type" instead of a "class", object is a workaround for passing the 
    15)   ! process model as context of a procedure where one can pass the
    16)   ! pm_base_pointer_type to a procedure, declaring it as e.g.
    17)   !
    18)   ! type(pm_base_pointer_type) :: pm_ptr
    19)   !
    20)   ! and use the ptr:
    21)   !
    22)   ! pm_ptr%this%Residual
    23)   !  
    24)   type, public :: pm_base_pointer_type
    25)     class(pm_base_type), pointer :: pm
    26)   end type pm_base_pointer_type
    27) 
    28)   public :: PMResidual, &
    29)             PMJacobian, &
    30)             PMCheckUpdatePre, &
    31)             PMCheckUpdatePost, &
    32)             PMRHSFunction, &
    33)             PMResidualPtr, &
    34)             PMJacobianPtr, &
    35)             PMCheckUpdatePrePtr, &
    36)             PMCheckUpdatePostPtr, &
    37)             PMRHSFunctionPtr
    38) 
    39) contains
    40) 
    41) ! ************************************************************************** !
    42) 
    43) subroutine PMResidual(snes,xx,r,this,ierr)
    44)   ! 
    45)   ! Author: Glenn Hammond
    46)   ! Date: 03/14/13
    47)   ! 
    48) 
    49)   use Option_module
    50)   use Realization_Subsurface_class
    51)   
    52)   implicit none
    53)   
    54) #include "petsc/finclude/petscvec.h"
    55) #include "petsc/finclude/petscvec.h90"
    56) #include "petsc/finclude/petscsnes.h"
    57) 
    58)   SNES :: snes
    59)   Vec :: xx
    60)   Vec :: r
    61)   class(pm_base_type) :: this
    62)   PetscErrorCode :: ierr
    63)   
    64) #ifdef DEBUG
    65)   print *, 'PMResidual()'
    66) #endif
    67) 
    68)   call this%Residual(snes,xx,r,ierr)
    69) 
    70) end subroutine PMResidual
    71) 
    72) ! ************************************************************************** !
    73) 
    74) subroutine PMResidualPtr(snes,xx,r,this,ierr)
    75)   ! 
    76)   ! Author: Glenn Hammond
    77)   ! Date: 03/14/13
    78)   ! 
    79) 
    80)   use Option_module
    81)   use Realization_Subsurface_class
    82)   
    83)   implicit none
    84)   
    85) #include "petsc/finclude/petscvec.h"
    86) #include "petsc/finclude/petscvec.h90"
    87) #include "petsc/finclude/petscsnes.h"
    88) 
    89)   SNES :: snes
    90)   Vec :: xx
    91)   Vec :: r
    92)   type(pm_base_pointer_type) :: this
    93)   PetscErrorCode :: ierr
    94)   
    95) #ifdef DEBUG
    96)   print *, 'PMResidualPtr()'
    97) #endif
    98) 
    99)   call this%pm%Residual(snes,xx,r,ierr)
   100) 
   101) end subroutine PMResidualPtr
   102) 
   103) ! ************************************************************************** !
   104) 
   105) subroutine PMJacobian(snes,xx,A,B,this,ierr)
   106)   ! 
   107)   ! Author: Glenn Hammond
   108)   ! Date: 03/14/13
   109)   ! 
   110) 
   111)   use Option_module
   112)   
   113)   implicit none
   114)   
   115) #include "petsc/finclude/petscvec.h"
   116) #include "petsc/finclude/petscvec.h90"
   117) #include "petsc/finclude/petscmat.h"
   118) #include "petsc/finclude/petscsnes.h"
   119) 
   120)   SNES :: snes
   121)   Vec :: xx
   122)   Mat :: A, B
   123)   class(pm_base_type) :: this
   124)   PetscErrorCode :: ierr
   125)   
   126) #ifdef DEBUG
   127)   print *, 'PMJacobian()'
   128) #endif
   129) 
   130)   call this%Jacobian(snes,xx,A,B,ierr)
   131)     
   132) end subroutine PMJacobian
   133) 
   134) ! ************************************************************************** !
   135) 
   136) subroutine PMJacobianPtr(snes,xx,A,B,this,ierr)
   137)   ! 
   138)   ! Author: Glenn Hammond
   139)   ! Date: 03/14/13
   140)   ! 
   141) 
   142)   use Option_module
   143)   
   144)   implicit none
   145)   
   146) #include "petsc/finclude/petscvec.h"
   147) #include "petsc/finclude/petscvec.h90"
   148) #include "petsc/finclude/petscmat.h"
   149) #include "petsc/finclude/petscsnes.h"
   150) 
   151)   SNES :: snes
   152)   Vec :: xx
   153)   Mat :: A, B
   154)   type(pm_base_pointer_type) :: this
   155)   PetscErrorCode :: ierr
   156)   
   157) #ifdef DEBUG
   158)   print *, 'PMJacobianPtr()'
   159) #endif
   160) 
   161)   call this%pm%Jacobian(snes,xx,A,B,ierr)
   162)     
   163) end subroutine PMJacobianPtr
   164) 
   165) ! ************************************************************************** !
   166) 
   167) subroutine PMRHSFunction(ts,time,xx,ff,this,ierr)
   168)   ! 
   169)   ! Author: Gautam Bisht
   170)   ! Date: 04/12/13
   171)   ! 
   172) 
   173)   implicit none
   174)   
   175) #include "petsc/finclude/petscvec.h"
   176) #include "petsc/finclude/petscvec.h90"
   177) #include "petsc/finclude/petscts.h"
   178) 
   179)   TS :: ts
   180)   PetscReal :: time
   181)   Vec :: xx
   182)   Vec :: ff
   183)   class(pm_base_type) :: this
   184)   PetscErrorCode :: ierr
   185)   
   186) #ifdef DEBUG
   187)   print *, 'PMRHSFunction()'
   188) #endif
   189) 
   190)   call this%RHSFunction(ts,time,xx,ff,ierr)
   191) 
   192) end subroutine PMRHSFunction
   193) 
   194) ! ************************************************************************** !
   195) 
   196) subroutine PMRHSFunctionPtr(ts,time,xx,ff,this,ierr)
   197)   ! 
   198)   ! Author: Gautam Bisht
   199)   ! Date: 04/12/13
   200)   ! 
   201) 
   202)   implicit none
   203)   
   204) #include "petsc/finclude/petscvec.h"
   205) #include "petsc/finclude/petscvec.h90"
   206) #include "petsc/finclude/petscts.h"
   207) 
   208)   TS :: ts
   209)   PetscReal :: time
   210)   Vec :: xx
   211)   Vec :: ff
   212)   type(pm_base_pointer_type) :: this
   213)   PetscErrorCode :: ierr
   214)   
   215) #ifdef DEBUG
   216)   print *, 'PMRHSFunctionPtr()'
   217) #endif
   218) 
   219)   call this%pm%RHSFunction(ts,time,xx,ff,ierr)
   220) 
   221) end subroutine PMRHSFunctionPtr
   222) 
   223) ! ************************************************************************** !
   224) 
   225) subroutine PMCheckUpdatePre(line_search,X,dX,changed,this,ierr)
   226)   ! 
   227)   ! Wrapper for native call to XXXCheckUpdatePre
   228)   ! 
   229)   ! Author: Glenn Hammond
   230)   ! Date: 12/02/14
   231)   ! 
   232)   
   233)   implicit none
   234)   
   235) #include "petsc/finclude/petscvec.h"
   236) #include "petsc/finclude/petscvec.h90"
   237) #include "petsc/finclude/petscsnes.h"
   238) 
   239)   SNESLineSearch :: line_search
   240)   Vec :: X
   241)   Vec :: dX
   242)   PetscBool :: changed
   243)   class(pm_base_type) :: this
   244)   PetscErrorCode :: ierr
   245)   
   246) #ifdef DEBUG
   247)   print *, 'PMCheckUpdatePre()'
   248) #endif
   249) 
   250)   call this%CheckUpdatePre(line_search,X,dX,changed,ierr)
   251)     
   252) end subroutine PMCheckUpdatePre
   253) 
   254) ! ************************************************************************** !
   255) 
   256) subroutine PMCheckUpdatePrePtr(line_search,X,dX,changed,this,ierr)
   257)   ! 
   258)   ! Wrapper for native call to XXXCheckUpdatePre
   259)   ! 
   260)   ! Author: Glenn Hammond
   261)   ! Date: 12/02/14
   262)   ! 
   263)   
   264)   implicit none
   265)   
   266) #include "petsc/finclude/petscvec.h"
   267) #include "petsc/finclude/petscvec.h90"
   268) #include "petsc/finclude/petscsnes.h"
   269) 
   270)   SNESLineSearch :: line_search
   271)   Vec :: X
   272)   Vec :: dX
   273)   PetscBool :: changed
   274)   type(pm_base_pointer_type) :: this
   275)   PetscErrorCode :: ierr
   276)   
   277) #ifdef DEBUG
   278)   print *, 'PMCheckUpdatePrePtr()'
   279) #endif
   280) 
   281)   call this%pm%CheckUpdatePre(line_search,X,dX,changed,ierr)
   282)     
   283) end subroutine PMCheckUpdatePrePtr
   284) 
   285) ! ************************************************************************** !
   286) 
   287) subroutine PMCheckUpdatePost(line_search,X0,dX,X1,dX_changed,X1_changed,this, &
   288)                              ierr)
   289)   ! 
   290)   ! Wrapper for native call to XXXCheckUpdatePost
   291)   ! 
   292)   ! Author: Glenn Hammond
   293)   ! Date: 12/02/14
   294)   ! 
   295)   
   296)   implicit none
   297)   
   298) #include "petsc/finclude/petscvec.h"
   299) #include "petsc/finclude/petscvec.h90"
   300) #include "petsc/finclude/petscsnes.h"
   301) 
   302)   SNESLineSearch :: line_search
   303)   Vec :: X0
   304)   Vec :: dX
   305)   Vec :: X1
   306)   PetscBool :: dX_changed
   307)   PetscBool :: X1_changed
   308)   class(pm_base_type) :: this
   309)   PetscErrorCode :: ierr
   310)   
   311) #ifdef DEBUG
   312)   print *, 'PMCheckUpdatePost()'
   313) #endif
   314) 
   315)   call this%CheckUpdatePost(line_search,X0,dX,X1,dX_changed,X1_changed,ierr)
   316)     
   317) end subroutine PMCheckUpdatePost
   318) 
   319) ! ************************************************************************** !
   320) 
   321) subroutine PMCheckUpdatePostPtr(line_search,X0,dX,X1,dX_changed,X1_changed, &
   322)                                 this,ierr)
   323)   ! 
   324)   ! Wrapper for native call to XXXCheckUpdatePost
   325)   ! 
   326)   ! Author: Glenn Hammond
   327)   ! Date: 12/02/14
   328)   ! 
   329)   
   330)   implicit none
   331)   
   332) #include "petsc/finclude/petscvec.h"
   333) #include "petsc/finclude/petscvec.h90"
   334) #include "petsc/finclude/petscsnes.h"
   335) 
   336)   SNESLineSearch :: line_search
   337)   Vec :: X0
   338)   Vec :: dX
   339)   Vec :: X1
   340)   PetscBool :: dX_changed
   341)   PetscBool :: X1_changed
   342)   type(pm_base_pointer_type) :: this
   343)   PetscErrorCode :: ierr
   344)   
   345) #ifdef DEBUG
   346)   print *, 'PMCheckUpdatePostPtr()'
   347) #endif
   348) 
   349)   call this%pm%CheckUpdatePost(line_search,X0,dX,X1,dX_changed,X1_changed,ierr)
   350)     
   351) end subroutine PMCheckUpdatePostPtr
   352) 
   353) end module PM_Base_Pointer_module

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