pmc_third_party.F90       coverage:  100.00 %func     87.01 %block


     1) module PMC_Third_Party_class
     2) 
     3)   use PMC_Base_class
     4)   use Realization_Subsurface_class
     5)   use Option_module
     6) 
     7)   use PFLOTRAN_Constants_module
     8) 
     9)   implicit none
    10) 
    11)   private
    12) 
    13) #include "petsc/finclude/petscsys.h"
    14) #include "petsc/finclude/petscvec.h"
    15) #include "petsc/finclude/petscvec.h90"
    16)   
    17)   type, public, extends(pmc_base_type) :: pmc_third_party_type
    18)     class(realization_subsurface_type), pointer :: realization
    19)   contains
    20)     procedure, public :: Init => PMCThirdPartyInit
    21) !    procedure, public :: InitializeRun => PMCThirdPartyInitializeRun
    22)     procedure, public :: RunToTime => PMCThirdPartyRunToTime
    23)     procedure, public :: FinalizeRun => PMCThirdPartyFinalizeRun
    24)     procedure, public :: Destroy => PMCThirdPartyDestroy
    25)     procedure, public :: GetAuxData => PMCThirdPartyGetAuxData
    26)   end type pmc_third_party_type
    27)   
    28)   public :: PMCThirdPartyCreate
    29)   
    30) contains
    31) 
    32) ! ************************************************************************** !
    33) 
    34) function PMCThirdPartyCreate()
    35)   ! 
    36)   ! Allocates and initializes a new
    37)   ! process_model_coupler object.
    38)   ! 
    39)   ! Author: Glenn Hammond
    40)   ! Date: 07/02/13
    41)   ! 
    42) 
    43)   implicit none
    44)   
    45)   class(pmc_third_party_type), pointer :: PMCThirdPartyCreate
    46)   
    47)   class(pmc_third_party_type), pointer :: pmc
    48) 
    49)   allocate(pmc)
    50)   call pmc%Init()
    51)   
    52)   PMCThirdPartyCreate => pmc  
    53)   
    54) end function PMCThirdPartyCreate
    55) 
    56) ! ************************************************************************** !
    57) 
    58) subroutine PMCThirdPartyInit(this)
    59)   ! 
    60)   ! Initializes a new process model coupler object.
    61)   ! 
    62)   ! Author: Glenn Hammond
    63)   ! Date: 07/02/13
    64)   ! 
    65) 
    66)   implicit none
    67)   
    68)   class(pmc_third_party_type) :: this
    69)   
    70)   call PMCBaseInit(this)
    71)   this%name = 'PMCThirdParty'
    72)   nullify(this%realization) 
    73)   
    74) end subroutine PMCThirdPartyInit
    75) 
    76) ! ************************************************************************** !
    77) 
    78) recursive subroutine PMCThirdPartyRunToTime(this,sync_time,stop_flag)
    79)   ! 
    80)   ! Runs the actual simulation.
    81)   ! 
    82)   ! Author: Glenn Hammond
    83)   ! Date: 07/02/13
    84)   ! 
    85) 
    86)   use Timestepper_Base_class, only : TS_CONTINUE, TS_STOP_FAILURE
    87) 
    88)   implicit none
    89)   
    90)   class(pmc_third_party_type), target :: this
    91)   PetscReal :: sync_time
    92)   PetscInt :: stop_flag
    93)   
    94)   class(pmc_base_type), pointer :: pmc_base
    95)   PetscErrorCode :: ierr
    96)   PetscInt :: local_stop_flag
    97)   
    98)   this%option%io_buffer = trim(this%name)
    99)   call printVerboseMsg(this%option)
   100)   
   101)   call this%GetAuxData()
   102)   
   103)   local_stop_flag = TS_CONTINUE
   104) 
   105)   call this%pm_list%InitializeTimestep()
   106)   call this%pm_list%Solve(sync_time,ierr)
   107)   call this%pm_list%FinalizeTimestep()
   108)   if (ierr /= 0) local_stop_flag = TS_STOP_FAILURE
   109) 
   110)   ! Run neighboring process model couplers
   111)   if (associated(this%child)) then
   112)     call this%child%RunToTime(sync_time,local_stop_flag)
   113)   endif
   114) 
   115)   ! Run neighboring process model couplers
   116)   if (associated(this%peer)) then
   117)     call this%peer%RunToTime(sync_time,local_stop_flag)
   118)   endif
   119) 
   120)   stop_flag = max(stop_flag,local_stop_flag)  
   121)   
   122) end subroutine PMCThirdPartyRunToTime
   123) 
   124) ! ************************************************************************** !
   125) 
   126) subroutine PMCThirdPartyGetAuxData(this)
   127)   ! 
   128)   ! Runs the actual simulation.
   129)   ! 
   130)   ! Author: Glenn Hammond
   131)   ! Date: 07/02/13
   132)   ! 
   133) 
   134)   implicit none
   135)   
   136) #include "petsc/finclude/petscvec.h"
   137) #include "petsc/finclude/petscvec.h90"
   138) #include "petsc/finclude/petscviewer.h"
   139) 
   140)   class(pmc_third_party_type) :: this
   141) 
   142)   PetscErrorCode :: ierr
   143)   PetscViewer :: viewer
   144) 
   145) end subroutine PMCThirdPartyGetAuxData
   146) 
   147) ! ************************************************************************** !
   148) 
   149) recursive subroutine PMCThirdPartyFinalizeRun(this)
   150)   ! 
   151)   ! Finalizes the time stepping
   152)   ! 
   153)   ! Author: Glenn Hammond
   154)   ! Date: 07/02/13
   155)   ! 
   156) 
   157)   implicit none
   158)   
   159)   class(pmc_third_party_type) :: this
   160)   
   161) !  call printMsg(this%option,'PMCThirdParty%FinalizeRun()')
   162)   
   163) end subroutine PMCThirdPartyFinalizeRun
   164) 
   165) ! ************************************************************************** !
   166) 
   167) subroutine PMCThirdPartyStrip(this)
   168)   !
   169)   ! Deallocates members of PMC Subsurface.
   170)   !
   171)   ! Author: Glenn Hammond
   172)   ! Date: 01/13/14
   173)   
   174)   implicit none
   175)   
   176)   class(pmc_third_party_type) :: this
   177)   
   178)   PetscErrorCode :: ierr
   179) 
   180)   call PMCBaseStrip(this)
   181)   nullify(this%realization)
   182)   
   183) end subroutine PMCThirdPartyStrip
   184) 
   185) ! ************************************************************************** !
   186) 
   187) recursive subroutine PMCThirdPartyDestroy(this)
   188)   ! 
   189)   ! Deallocates a process_model_coupler object
   190)   ! 
   191)   ! Author: Glenn Hammond
   192)   ! Date: 07/02/13
   193)   ! 
   194) 
   195)   use Utility_module, only: DeallocateArray 
   196) 
   197)   implicit none
   198)   
   199)   class(pmc_third_party_type) :: this
   200) 
   201)   PetscErrorCode :: ierr
   202)   
   203) !  call printMsg(this%option,'PMCThirdParty%Destroy()')
   204)   
   205)   call PMCThirdPartyStrip(this)
   206)   
   207)   if (associated(this%child)) then
   208)     call this%child%Destroy()
   209)   endif 
   210)   
   211)   if (associated(this%peer)) then
   212)     call this%peer%Destroy()
   213)   endif  
   214) 
   215) end subroutine PMCThirdPartyDestroy
   216)   
   217) end module PMC_Third_Party_class

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