pm_rt.F90       coverage:  79.31 %func     77.16 %block


     1) module PM_RT_class
     2) 
     3)   use PM_Base_class
     4) !geh: using Reactive_Transport_module here fails with gfortran (internal 
     5) !     compiler error)
     6) !  use Reactive_Transport_module
     7)   use Realization_Subsurface_class
     8)   use Communicator_Base_module  
     9)   use Option_module
    10)   
    11)   use PFLOTRAN_Constants_module
    12) 
    13)   implicit none
    14) 
    15)   private
    16) 
    17) #include "petsc/finclude/petscsys.h"
    18) 
    19) #include "petsc/finclude/petscvec.h"
    20) #include "petsc/finclude/petscvec.h90"
    21) #include "petsc/finclude/petscmat.h"
    22) #include "petsc/finclude/petscmat.h90"
    23) #include "petsc/finclude/petscsnes.h"
    24) 
    25)   type, public, extends(pm_base_type) :: pm_rt_type
    26)     class(realization_subsurface_type), pointer :: realization
    27)     class(communicator_type), pointer :: comm1
    28)     class(communicator_type), pointer :: commN
    29)     ! local variables
    30)     PetscBool :: steady_flow
    31)     PetscReal :: tran_weight_t0
    32)     PetscReal :: tran_weight_t1
    33)     PetscBool :: check_post_convergence
    34)     ! these govern the size of subsequent time steps
    35)     PetscReal :: max_concentration_change
    36)     PetscReal :: max_volfrac_change
    37)     PetscReal :: volfrac_change_governor
    38)     ! for transport only
    39)     PetscBool :: transient_porosity
    40)   contains
    41)     procedure, public :: Setup => PMRTSetup
    42)     procedure, public :: Read => PMRTRead
    43)     procedure, public :: PMRTSetRealization
    44)     procedure, public :: InitializeRun => PMRTInitializeRun
    45)     procedure, public :: FinalizeRun => PMRTFinalizeRun
    46)     procedure, public :: InitializeTimestep => PMRTInitializeTimestep
    47)     procedure, public :: FinalizeTimestep => PMRTFinalizeTimestep
    48)     procedure, public :: Residual => PMRTResidual
    49)     procedure, public :: Jacobian => PMRTJacobian
    50)     procedure, public :: UpdateTimestep => PMRTUpdateTimestep
    51)     procedure, public :: PreSolve => PMRTPreSolve
    52)     procedure, public :: PostSolve => PMRTPostSolve
    53)     procedure, public :: AcceptSolution => PMRTAcceptSolution
    54)     procedure, public :: CheckUpdatePre => PMRTCheckUpdatePre
    55)     procedure, public :: CheckUpdatePost => PMRTCheckUpdatePost
    56)     procedure, public :: TimeCut => PMRTTimeCut
    57)     procedure, public :: UpdateSolution => PMRTUpdateSolution1
    58)     procedure, public :: UpdateAuxVars => PMRTUpdateAuxVars
    59)     procedure, public :: MaxChange => PMRTMaxChange
    60)     procedure, public :: ComputeMassBalance => PMRTComputeMassBalance
    61)     procedure, public :: SetTranWeights => SetTranWeights
    62)     procedure, public :: CheckpointBinary => PMRTCheckpointBinary
    63)     procedure, public :: CheckpointHDF5 => PMRTCheckpointHDF5
    64)     procedure, public :: RestartBinary => PMRTRestartBinary
    65)     procedure, public :: RestartHDF5 => PMRTRestartHDF5
    66)     procedure, public :: InputRecord => PMRTInputRecord
    67)     procedure, public :: Destroy => PMRTDestroy
    68)   end type pm_rt_type
    69)   
    70)   type, public, extends(pm_base_header_type) :: pm_rt_header_type
    71)     PetscInt :: checkpoint_activity_coefs
    72)   end type pm_rt_header_type  
    73)   
    74)   public :: PMRTCreate
    75) 
    76) contains
    77) 
    78) ! ************************************************************************** !
    79) 
    80) function PMRTCreate()
    81)   ! 
    82)   ! Creates reactive transport process models shell
    83)   ! 
    84)   ! Author: Glenn Hammond
    85)   ! Date: 03/14/13
    86)   ! 
    87) 
    88)   implicit none
    89)   
    90)   class(pm_rt_type), pointer :: PMRTCreate
    91) 
    92)   class(pm_rt_type), pointer :: rt_pm
    93)   
    94) #ifdef PM_RT_DEBUG  
    95)   print *, 'PMRTCreate()'
    96) #endif
    97)   
    98)   allocate(rt_pm)
    99)   nullify(rt_pm%option)
   100)   nullify(rt_pm%output_option)
   101)   nullify(rt_pm%realization)
   102)   nullify(rt_pm%comm1)
   103)   nullify(rt_pm%commN)
   104)   
   105)   ! local variables
   106)   rt_pm%steady_flow = PETSC_FALSE
   107)   rt_pm%tran_weight_t0 = 0.d0
   108)   rt_pm%tran_weight_t1 = 0.d0
   109)   rt_pm%check_post_convergence = PETSC_FALSE
   110)   rt_pm%max_concentration_change = 0.d0
   111)   rt_pm%max_volfrac_change = 0.d0
   112)   rt_pm%volfrac_change_governor = 1.d0
   113)   ! these flags can only be true for transport only
   114)   rt_pm%transient_porosity = PETSC_FALSE
   115) 
   116)   call PMBaseInit(rt_pm)
   117)   rt_pm%name = 'PMRT'
   118)   
   119)   PMRTCreate => rt_pm
   120)   
   121) end function PMRTCreate
   122) 
   123) ! ************************************************************************** !
   124) 
   125) subroutine PMRTRead(this,input)
   126)   ! 
   127)   ! Reads input file parameters associated with the reactive transport 
   128)   ! process model
   129)   ! 
   130)   ! Author: Glenn Hammond
   131)   ! Date: 01/25/16
   132)   !
   133)   use Input_Aux_module
   134)   use String_module
   135)   use Option_module
   136)   use Reactive_Transport_Aux_module
   137)  
   138)   implicit none
   139)   
   140)   class(pm_rt_type) :: this
   141)   type(input_type), pointer :: input
   142)   
   143)   character(len=MAXWORDLENGTH) :: word
   144)   character(len=MAXSTRINGLENGTH) :: error_string
   145)   type(option_type), pointer :: option
   146) 
   147)   option => this%option
   148)   
   149)   error_string = 'Reactive Transport Options'
   150)   
   151)   input%ierr = 0
   152)   do
   153)   
   154)     call InputReadPflotranString(input,option)
   155)     if (InputError(input)) exit
   156)     if (InputCheckExit(input,option)) exit
   157)     
   158)     call InputReadWord(input,option,word,PETSC_TRUE)
   159)     call InputErrorMsg(input,option,'keyword',error_string)
   160)     call StringToUpper(word)
   161)     
   162)     select case(trim(word))
   163)       case('GLOBAL_IMPLICIT','OPERATOR_SPLIT','OPERATOR_SPLITTING')
   164)       case('MAX_VOLUME_FRACTION_CHANGE')
   165)         call InputReadDouble(input,option,this%volfrac_change_governor)
   166)         call InputDefaultMsg(input,option,'maximum volume fraction change')
   167)       case('ITOL_RELATIVE_UPDATE')
   168)         call InputReadDouble(input,option,rt_itol_rel_update)
   169)         call InputDefaultMsg(input,option,'rt_itol_rel_update')
   170)         this%check_post_convergence = PETSC_TRUE
   171)       case('NUMERICAL_JACOBIAN')
   172)         option%transport%numerical_derivatives = PETSC_TRUE
   173)       case default
   174)         call InputKeywordUnrecognized(word,error_string,option)
   175)     end select
   176)   enddo
   177)   
   178) end subroutine PMRTRead
   179) 
   180) ! ************************************************************************** !
   181) 
   182) subroutine PMRTSetup(this)
   183)   ! 
   184)   ! Initializes variables associated with reactive transport
   185)   ! 
   186)   ! Author: Glenn Hammond
   187)   ! Date: 03/14/13
   188)   ! 
   189) 
   190) #ifndef SIMPLIFY
   191)   use Discretization_module
   192)   use Communicator_Structured_class
   193)   use Communicator_Unstructured_class
   194)   use Grid_module 
   195) #endif  
   196)   
   197)   implicit none
   198)   
   199)   class(pm_rt_type) :: this
   200) 
   201) #ifdef PM_RT_DEBUG  
   202)   call printMsg(this%option,'PMRT%Setup()')
   203) #endif
   204)   
   205) #ifndef SIMPLIFY  
   206)   ! set up communicator
   207)   select case(this%realization%discretization%itype)
   208)     case(STRUCTURED_GRID)
   209)       this%commN => StructuredCommunicatorCreate()
   210)     case(UNSTRUCTURED_GRID)
   211)       this%commN => UnstructuredCommunicatorCreate()
   212)   end select
   213)   call this%commN%SetDM(this%realization%discretization%dm_ntrandof)
   214) #endif
   215) 
   216)   ! set the communicator
   217)   this%comm1 => this%realization%comm1
   218) 
   219)   ! only set these flags if transport only
   220)   if (this%option%nflowdof == 0) then
   221)     if (associated(this%realization%reaction)) then
   222)       if (this%realization%reaction%update_porosity & !.or. &
   223) !          this%realization%reaction%update_tortuosity .or. &
   224) !          this%realization%reaction%update_mnrl_surf_with_porosity &
   225)           ) then
   226)         this%transient_porosity = PETSC_TRUE
   227)       endif
   228)     endif
   229)   endif
   230)   
   231) end subroutine PMRTSetup
   232) 
   233) ! ************************************************************************** !
   234) 
   235) subroutine PMRTSetRealization(this,realization)
   236)   ! 
   237)   ! Author: Glenn Hammond
   238)   ! Date: 03/14/13
   239)   ! 
   240) 
   241)   use Realization_Subsurface_class  
   242) 
   243)   implicit none
   244)   
   245)   class(pm_rt_type) :: this
   246)   class(realization_subsurface_type), pointer :: realization
   247) 
   248) #ifdef PM_RT_DEBUG  
   249)   call printMsg(this%option,'PMRT%SetRealization()')
   250) #endif
   251)   
   252)   this%realization => realization
   253)   this%realization_base => realization
   254)   
   255)   if (realization%reaction%use_log_formulation) then
   256)     this%solution_vec = realization%field%tran_log_xx
   257)   else
   258)     this%solution_vec = realization%field%tran_xx
   259)   endif
   260)   this%residual_vec = realization%field%tran_r
   261)   
   262) end subroutine PMRTSetRealization
   263) 
   264) ! ************************************************************************** !
   265) 
   266) recursive subroutine PMRTInitializeRun(this)
   267)   ! 
   268)   ! Initializes the time stepping
   269)   ! 
   270)   ! Author: Glenn Hammond
   271)   ! Date: 03/18/13
   272)   ! 
   273) 
   274)   use Reactive_Transport_module, only : RTUpdateEquilibriumState, &
   275)                                         RTJumpStartKineticSorption
   276)   use Condition_Control_module
   277)   use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
   278)   use Reactive_Transport_module, only : RTUpdateAuxVars, &
   279)                                         RTClearActivityCoefficients
   280)   use Variables_module, only : POROSITY
   281)   use Material_Aux_class, only : POROSITY_MINERAL 
   282)   use Material_module, only : MaterialGetAuxVarVecLoc
   283) 
   284)   implicit none
   285)   
   286)   class(pm_rt_type) :: this
   287)   PetscErrorCode :: ierr
   288)   
   289) #ifdef PM_RT_DEBUG  
   290)   call printMsg(this%option,'PMRT%InitializeRun()')
   291) #endif
   292) 
   293)   ! check for uninitialized flow variables
   294)   call RealizUnInitializedVarsTran(this%realization)
   295) 
   296)   if (this%transient_porosity) then
   297)     call RealizationCalcMineralPorosity(this%realization)
   298)     call MaterialGetAuxVarVecLoc(this%realization%patch%aux%Material, &
   299)                                  this%realization%field%work_loc, &
   300)                                  POROSITY,POROSITY_MINERAL)
   301)     call this%comm1%LocalToGlobal(this%realization%field%work_loc, &
   302)                                   this%realization%field%porosity0)
   303)     call VecCopy(this%realization%field%porosity0, &
   304)                  this%realization%field%porosity_t,ierr);CHKERRQ(ierr)
   305)     call VecCopy(this%realization%field%porosity0, &
   306)                  this%realization%field%porosity_tpdt,ierr);CHKERRQ(ierr)
   307)   endif
   308)   
   309)   ! restart
   310)   if (this%option%restart_flag .and. &
   311)       this%option%overwrite_restart_transport) then
   312)     call RTClearActivityCoefficients(this%realization)
   313)     call CondControlAssignTranInitCond(this%realization)  
   314)   endif
   315)   
   316)   ! pass PETSC_FALSE to turn off update of kinetic state variables
   317)   call PMRTUpdateSolution2(this,PETSC_FALSE)
   318)   
   319) #if 0
   320)   if (this%option%jumpstart_kinetic_sorption .and. &
   321)       this%option%time < 1.d-40) then
   322)     ! only user jumpstart for a restarted simulation
   323)     if (.not. this%option%restart_flag) then
   324)       this%option%io_buffer = 'Only use JUMPSTART_KINETIC_SORPTION on a ' // &
   325)         'restarted simulation.  ReactionEquilibrateConstraint() will ' // &
   326)         'appropriately set sorbed initial concentrations for a normal ' // &
   327)         '(non-restarted) simulation.'
   328)       call printErrMsg(this%option)
   329)     endif
   330)     call RTJumpStartKineticSorption(this%realization)
   331)   endif
   332)   ! check on MAX_STEPS < 0 to quit after initialization.
   333) #endif  
   334)     
   335) end subroutine PMRTInitializeRun
   336) 
   337) ! ************************************************************************** !
   338) 
   339) subroutine PMRTInitializeTimestep(this)
   340)   ! 
   341)   ! Author: Glenn Hammond
   342)   ! Date: 03/14/13
   343)   ! 
   344) 
   345)   use Reactive_Transport_module, only : RTInitializeTimestep, &
   346)                                         RTUpdateTransportCoefs
   347)   use Global_module
   348)   use Material_module
   349) 
   350)   implicit none
   351)   
   352)   class(pm_rt_type) :: this
   353)   PetscReal :: time
   354)  
   355) #ifdef PM_RT_DEBUG  
   356)   call printMsg(this%option,'PMRT%InitializeTimestep()')
   357) #endif
   358)   
   359)   this%option%tran_dt = this%option%dt
   360) 
   361)   if (this%option%print_screen_flag) then
   362)     write(*,'(/,2("=")," REACTIVE TRANSPORT ",58("="))')
   363)   endif
   364)   
   365)   ! interpolate flow parameters/data
   366)   ! this must remain here as these weighted values are used by both
   367)   ! RTInitializeTimestep and RTTimeCut (which calls RTInitializeTimestep)
   368)   if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
   369)     call this%SetTranWeights()
   370)     if (this%option%flow%transient_porosity) then
   371)       ! weight material properties (e.g. porosity)
   372)       call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
   373)                                  this%tran_weight_t0, &
   374)                                  this%realization%field,this%comm1)
   375)     endif
   376)     ! set densities and saturations to t
   377)     call GlobalWeightAuxVars(this%realization,this%tran_weight_t0)
   378)   else if (this%transient_porosity) then
   379)     this%tran_weight_t0 = 0.d0
   380)     call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
   381)                                this%tran_weight_t0, &
   382)                                this%realization%field,this%comm1)
   383)   endif
   384) 
   385)   call RTInitializeTimestep(this%realization)
   386) 
   387)   !geh: this is a bug and should be moved to PreSolve()
   388) #if 0
   389)   ! set densities and saturations to t+dt
   390)   if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
   391)     if (this%option%flow%transient_porosity) then
   392)       ! weight material properties (e.g. porosity)
   393)       call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
   394)                                  this%tran_weight_t1, &
   395)                                  this%realization%field,this%comm1)
   396)     endif
   397)     call GlobalWeightAuxVars(this%realization,this%tran_weight_t1)
   398)   else if (this%transient_porosity) then
   399)     this%tran_weight_t1 = 1.d0
   400)     call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
   401)                                this%tran_weight_t1, &
   402)                                this%realization%field,this%comm1)
   403)   endif
   404) 
   405)   call RTUpdateTransportCoefs(this%realization)
   406) #endif  
   407) 
   408) end subroutine PMRTInitializeTimestep
   409) 
   410) ! ************************************************************************** !
   411) 
   412) subroutine PMRTPreSolve(this)
   413)   ! 
   414)   ! Author: Glenn Hammond
   415)   ! Date: 03/14/13
   416)   ! 
   417) 
   418)   use Reactive_Transport_module, only : RTUpdateTransportCoefs, &
   419)                                         RTUpdateAuxVars
   420)   use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
   421)   use Global_module  
   422)   use Material_module
   423)   use Data_Mediator_module
   424) 
   425)   implicit none
   426)   
   427)   class(pm_rt_type) :: this
   428)   
   429)   PetscErrorCode :: ierr
   430)   
   431) #ifdef PM_RT_DEBUG  
   432)   call printMsg(this%option,'PMRT%UpdatePreSolve()')
   433) #endif
   434)   
   435) #if 1
   436)   call RTUpdateTransportCoefs(this%realization)
   437)   ! set densities and saturations to t+dt
   438)   if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
   439)     if (this%option%flow%transient_porosity) then
   440)       ! weight material properties (e.g. porosity)
   441)       call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
   442)                                  this%tran_weight_t1, &
   443)                                  this%realization%field,this%comm1)
   444)     endif
   445)     call GlobalWeightAuxVars(this%realization,this%tran_weight_t1)
   446)   else if (this%transient_porosity) then
   447)     this%tran_weight_t1 = 1.d0
   448)     call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
   449)                                this%tran_weight_t1, &
   450)                                this%realization%field,this%comm1)
   451)   endif
   452) 
   453)   call RTUpdateTransportCoefs(this%realization)
   454) #endif  
   455)   
   456)   if (this%realization%reaction%act_coef_update_frequency /= &
   457)       ACT_COEF_FREQUENCY_OFF) then
   458)       call RTUpdateAuxVars(this%realization,PETSC_TRUE,PETSC_TRUE,PETSC_TRUE)
   459) !       The below is set within RTUpdateAuxVarsPatch() when 
   460) !         PETSC_TRUE,PETSC_TRUE,* are passed
   461) !       patch%aux%RT%auxvars_up_to_date = PETSC_TRUE 
   462)   endif
   463)   if (this%realization%reaction%use_log_formulation) then
   464)     call VecCopy(this%realization%field%tran_xx, &
   465)                  this%realization%field%tran_log_xx,ierr);CHKERRQ(ierr)
   466)     call VecLog(this%realization%field%tran_log_xx,ierr);CHKERRQ(ierr)
   467)   endif
   468)   
   469)   call DataMediatorUpdate(this%realization%tran_data_mediator_list, &
   470)                           this%realization%field%tran_mass_transfer, &
   471)                           this%realization%option)
   472)   
   473) end subroutine PMRTPreSolve
   474) 
   475) ! ************************************************************************** !
   476) 
   477) subroutine PMRTPostSolve(this)
   478)   ! 
   479)   ! Author: Glenn Hammond
   480)   ! Date: 03/14/13
   481)   ! 
   482) 
   483)   implicit none
   484)   
   485)   class(pm_rt_type) :: this
   486)   
   487) #ifdef PM_RT_DEBUG  
   488)   call printMsg(this%option,'PMRT%PostSolve()')
   489) #endif
   490)   
   491) end subroutine PMRTPostSolve
   492) 
   493) ! ************************************************************************** !
   494) 
   495) subroutine PMRTFinalizeTimestep(this)
   496)   ! 
   497)   ! Author: Glenn Hammond
   498)   ! Date: 04/03/13
   499)   ! 
   500) 
   501)   use Reactive_Transport_module, only : RTMaxChange
   502)   use Variables_module, only : POROSITY
   503)   use Material_module, only : MaterialGetAuxVarVecLoc
   504)   use Material_Aux_class, only : POROSITY_MINERAL 
   505)   use Global_module
   506) 
   507)   implicit none
   508)   
   509)   class(pm_rt_type) :: this
   510)   PetscReal :: time  
   511)   PetscErrorCode :: ierr
   512) 
   513)   if (this%transient_porosity) then
   514)     call VecCopy(this%realization%field%porosity_tpdt, &
   515)                  this%realization%field%porosity_t,ierr);CHKERRQ(ierr)
   516)     call RealizationUpdatePropertiesTS(this%realization)
   517)     call MaterialGetAuxVarVecLoc(this%realization%patch%aux%Material, &
   518)                                  this%realization%field%work_loc, &
   519)                                  POROSITY,POROSITY_MINERAL)
   520)     call this%comm1%LocalToGlobal(this%realization%field%work_loc, &
   521)                                   this%realization%field%porosity_tpdt)
   522)   endif
   523)   
   524)   call RTMaxChange(this%realization,this%max_concentration_change, &
   525)                    this%max_volfrac_change)
   526)   if (this%option%print_screen_flag) then
   527)     write(*,'("  --> max chng: dcmx= ",1pe12.4,"  dc/dt= ",1pe12.4, &
   528)             &" [mol/s]")') &
   529)       this%max_concentration_change, &
   530)       this%max_concentration_change/this%option%tran_dt
   531)     if (this%realization%reaction%mineral%nkinmnrl > 0) then
   532)       write(*,'("               dvfmx= ",1pe12.4," dvf/dt= ",1pe12.4, &
   533)             &" [1/s]")') &
   534)         this%max_volfrac_change, this%max_volfrac_change/this%option%tran_dt
   535)     endif
   536)   endif
   537)   if (this%option%print_file_flag) then  
   538)     write(this%option%fid_out,&
   539)             '("  --> max chng: dcmx= ",1pe12.4,"  dc/dt= ",1pe12.4, &
   540)             &" [mol/s]")') &
   541)       this%max_concentration_change, &
   542)       this%max_concentration_change/this%option%tran_dt
   543)     if (this%realization%reaction%mineral%nkinmnrl > 0) then
   544)       write(this%option%fid_out, &
   545)         '("               dvfmx= ",1pe12.4," dvf/dt= ",1pe12.4," [1/s]")') &
   546)         this%max_volfrac_change, this%max_volfrac_change/this%option%tran_dt
   547)     endif
   548)   endif
   549)   
   550) end subroutine PMRTFinalizeTimestep
   551) 
   552) ! ************************************************************************** !
   553) 
   554) function PMRTAcceptSolution(this)
   555)   ! 
   556)   ! PMRichardsAcceptSolution:
   557)   ! 
   558)   ! Author: Glenn Hammond
   559)   ! Date: 03/14/13
   560)   ! 
   561) 
   562)   implicit none
   563)   
   564)   class(pm_rt_type) :: this
   565)   
   566)   PetscBool :: PMRTAcceptSolution
   567)   
   568) #ifdef PM_RT_DEBUG  
   569)   call printMsg(this%option,'PMRT%AcceptSolution()')
   570) #endif
   571)   ! do nothing
   572)   PMRTAcceptSolution = PETSC_TRUE
   573)   
   574) end function PMRTAcceptSolution
   575) 
   576) ! ************************************************************************** !
   577) 
   578) subroutine PMRTUpdateTimestep(this,dt,dt_min,dt_max,iacceleration, &
   579)                               num_newton_iterations,tfac)
   580)   ! 
   581)   ! Author: Glenn Hammond
   582)   ! Date: 03/14/13
   583)   ! 
   584) 
   585)   implicit none
   586)   
   587)   class(pm_rt_type) :: this
   588)   PetscReal :: dt
   589)   PetscReal :: dt_min,dt_max
   590)   PetscInt :: iacceleration
   591)   PetscInt :: num_newton_iterations
   592)   PetscReal :: tfac(:)
   593)   
   594)   PetscReal :: dtt, uvf, dt_vf, dt_tfac, fac
   595)   PetscInt :: ifac
   596)   PetscReal, parameter :: pert = 1.d-20
   597)   
   598) #ifdef PM_RT_DEBUG  
   599)   call printMsg(this%option,'PMRT%UpdateTimestep()')  
   600) #endif
   601)   
   602)   if (this%volfrac_change_governor < 1.d0) then
   603)     ! with volume fraction potentially scaling the time step.
   604)     if (iacceleration > 0) then
   605)       fac = 0.5d0
   606)       if (num_newton_iterations >= iacceleration) then
   607)         fac = 0.33d0
   608)         uvf = 0.d0
   609)       else
   610)         uvf = this%volfrac_change_governor/(this%max_volfrac_change+pert)
   611)       endif
   612)       dtt = fac * dt * (1.d0 + uvf)
   613)     else
   614)       ifac = max(min(num_newton_iterations,size(tfac)),1)
   615)       dt_tfac = tfac(ifac) * dt
   616) 
   617)       fac = 0.5d0
   618)       uvf= this%volfrac_change_governor/(this%max_volfrac_change+pert)
   619)       dt_vf = fac * dt * (1.d0 + uvf)
   620) 
   621)       dtt = min(dt_tfac,dt_vf)
   622)     endif
   623)   else
   624)     ! original implementation
   625)     dtt = dt
   626)     if (num_newton_iterations <= iacceleration) then
   627)       if (num_newton_iterations <= size(tfac)) then
   628)         dtt = tfac(num_newton_iterations) * dt
   629)       else
   630)         dtt = 0.5d0 * dt
   631)       endif
   632)     else
   633)       dtt = 0.5d0 * dt
   634)     endif
   635)   endif
   636) 
   637)   if (dtt > 2.d0 * dt) dtt = 2.d0 * dt
   638)   if (dtt > dt_max) dtt = dt_max
   639)   ! geh: see comment above under flow stepper
   640)   dtt = max(dtt,dt_min)
   641)   dt = dtt
   642)   
   643) end subroutine PMRTUpdateTimestep
   644) 
   645) ! ************************************************************************** !
   646) 
   647) recursive subroutine PMRTFinalizeRun(this)
   648)   ! 
   649)   ! Finalizes the time stepping
   650)   ! 
   651)   ! Author: Glenn Hammond
   652)   ! Date: 03/18/13
   653)   ! 
   654) 
   655)   implicit none
   656)   
   657)   class(pm_rt_type) :: this
   658)   
   659) #ifdef PM_RT_DEBUG  
   660)   call printMsg(this%option,'PMRT%PMRTFinalizeRun()')
   661) #endif
   662)   
   663)   ! do something here
   664)   
   665)   if (associated(this%next)) then
   666)     call this%next%FinalizeRun()
   667)   endif  
   668)   
   669) end subroutine PMRTFinalizeRun
   670) 
   671) ! ************************************************************************** !
   672) 
   673) subroutine PMRTResidual(this,snes,xx,r,ierr)
   674)   ! 
   675)   ! Author: Glenn Hammond
   676)   ! Date: 03/14/13
   677)   ! 
   678) 
   679)   use Reactive_Transport_module, only : RTResidual
   680) 
   681)   implicit none
   682)   
   683)   class(pm_rt_type) :: this
   684)   SNES :: snes
   685)   Vec :: xx
   686)   Vec :: r
   687)   PetscErrorCode :: ierr
   688)   
   689) #ifdef PM_RT_DEBUG  
   690)   call printMsg(this%option,'PMRT%Residual()')  
   691) #endif
   692)   
   693)   call RTResidual(snes,xx,r,this%realization,ierr)
   694) 
   695) end subroutine PMRTResidual
   696) 
   697) ! ************************************************************************** !
   698) 
   699) subroutine PMRTJacobian(this,snes,xx,A,B,ierr)
   700)   ! 
   701)   ! Author: Glenn Hammond
   702)   ! Date: 03/14/13
   703)   ! 
   704) 
   705)   use Reactive_Transport_module, only : RTJacobian
   706) 
   707)   implicit none
   708)   
   709)   class(pm_rt_type) :: this
   710)   SNES :: snes
   711)   Vec :: xx
   712)   Mat :: A, B
   713)   PetscErrorCode :: ierr
   714)   
   715) #ifdef PM_RT_DEBUG  
   716)   call printMsg(this%option,'PMRT%Jacobian()')  
   717) #endif
   718) 
   719)   call RTJacobian(snes,xx,A,B,this%realization,ierr)
   720) 
   721) end subroutine PMRTJacobian
   722) 
   723) ! ************************************************************************** !
   724) 
   725) subroutine PMRTCheckUpdatePre(this,line_search,X,dX,changed,ierr)
   726)   ! 
   727)   ! In the case of the log formulation, ensures that the update
   728)   ! vector does not exceed a prescribed tolerance
   729)   ! 
   730)   ! Author: Glenn Hammond
   731)   ! Date: 03/16/09
   732)   ! 
   733) 
   734)   use Realization_Subsurface_class
   735)   use Grid_module
   736)   use Option_module
   737)   use Reaction_Aux_module
   738) 
   739)   implicit none
   740)   
   741)   class(pm_rt_type) :: this
   742)   SNESLineSearch :: line_search
   743)   Vec :: X
   744)   Vec :: dX
   745)   PetscBool :: changed
   746)   PetscErrorCode :: ierr
   747)   
   748)   PetscReal, pointer :: C_p(:)
   749)   PetscReal, pointer :: dC_p(:)
   750)   type(grid_type), pointer :: grid
   751)   type(reaction_type), pointer :: reaction
   752)   PetscReal :: ratio, min_ratio
   753)   PetscReal, parameter :: min_allowable_scale = 1.d-10
   754)   character(len=MAXSTRINGLENGTH) :: string
   755)   PetscInt :: i, n
   756)   
   757)   grid => this%realization%patch%grid
   758)   reaction => this%realization%reaction
   759)   
   760)   call VecGetArrayF90(dX,dC_p,ierr);CHKERRQ(ierr)
   761) 
   762)   if (reaction%use_log_formulation) then
   763)     ! C and dC are actually lnC and dlnC
   764)     dC_p = dsign(1.d0,dC_p)*min(dabs(dC_p),reaction%max_dlnC)
   765)     ! at this point, it does not matter whether "changed" is set to true, 
   766)     ! since it is not checkied in PETSc.  Thus, I don't want to spend 
   767)     ! time checking for changes and performing an allreduce for log 
   768)     ! formulation.
   769)     if (Initialized(reaction%truncated_concentration)) then
   770)       call VecGetArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
   771)       dC_p = min(C_p-log(reaction%truncated_concentration),dC_p)
   772)       call VecRestoreArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
   773)     endif
   774)   else
   775)     call VecGetLocalSize(X,n,ierr);CHKERRQ(ierr)
   776)     call VecGetArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
   777)     
   778)     if (Initialized(reaction%truncated_concentration)) then
   779)       dC_p = min(dC_p,C_p-reaction%truncated_concentration)
   780)     else
   781)       ! C^p+1 = C^p - dC^p
   782)       ! if dC is positive and abs(dC) larger than C
   783)       ! we need to scale the update
   784)       
   785)       ! compute smallest ratio of C to dC
   786) #if 0
   787)       min_ratio = 1.d0/maxval(dC_p/C_p)
   788) #else
   789)       min_ratio = 1.d20 ! large number
   790)       do i = 1, n
   791)         if (C_p(i) <= dC_p(i)) then
   792)           ratio = abs(C_p(i)/dC_p(i))
   793)           if (ratio < min_ratio) min_ratio = ratio
   794)         endif
   795)       enddo
   796) #endif
   797)       ratio = min_ratio
   798)     
   799)       ! get global minimum
   800)       call MPI_Allreduce(ratio,min_ratio,ONE_INTEGER_MPI,MPI_DOUBLE_PRECISION, &
   801)                          MPI_MIN,this%realization%option%mycomm,ierr)
   802)                        
   803)       ! scale if necessary
   804)       if (min_ratio < 1.d0) then
   805)         if (min_ratio < this%realization%option%min_allowable_scale) then
   806)           write(string,'(es10.3)') min_ratio
   807)           string = 'The update of primary species concentration is being ' // &
   808)             'scaled by a very small value (i.e. ' // &
   809)             trim(adjustl(string)) // &
   810)             ') to prevent negative concentrations.  This value is too ' // &
   811)             'small and will likely cause the solver to mistakenly ' // &
   812)             'converge based on the infinity norm of the update vector. ' // &
   813)             'In this case, it is recommended that you use the ' // &
   814)             'LOG_FORMULATION for chemistry or truncate concentrations ' // &
   815)             '(TRUNCATE_CONCENTRATION <float> in CHEMISTRY block). ' // &
   816)             'If that does not work, please send your input deck to ' // &
   817)             'pflotran-dev@googlegroups.com.'
   818)           this%realization%option%io_buffer = string
   819)           call printErrMsg(this%realization%option)
   820)         endif
   821)         ! scale by 0.99 to make the update slightly smaller than the min_ratio
   822)         dC_p = dC_p*min_ratio*0.99d0
   823)         changed = PETSC_TRUE
   824)       endif
   825)     endif
   826)     call VecRestoreArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
   827)   endif
   828) 
   829)   call VecRestoreArrayF90(dX,dC_p,ierr);CHKERRQ(ierr)
   830) 
   831) end subroutine PMRTCheckUpdatePre
   832) 
   833) ! ************************************************************************** !
   834) 
   835) subroutine PMRTCheckUpdatePost(this,line_search,X0,dX,X1,dX_changed, &
   836)                                X1_changed,ierr)
   837)   ! 
   838)   ! Checks convergence after to update
   839)   ! 
   840)   ! Author: Glenn Hammond
   841)   ! Date: 03/04/14
   842)   ! 
   843)   use Realization_Subsurface_class
   844)   use Grid_module
   845)   use Field_module
   846)   use Patch_module
   847)   use Option_module
   848)   use Secondary_Continuum_module, only : SecondaryRTUpdateIterate
   849)   use Output_EKG_module
   850)   use Reactive_Transport_Aux_module
   851) 
   852)   implicit none
   853)   
   854)   class(pm_rt_type) :: this
   855)   SNESLineSearch :: line_search
   856)   Vec :: X0
   857)   Vec :: dX
   858)   Vec :: X1
   859)   PetscBool :: dX_changed
   860)   PetscBool :: X1_changed
   861)   PetscErrorCode :: ierr
   862)   
   863)   type(grid_type), pointer :: grid
   864)   type(option_type), pointer :: option
   865)   type(field_type), pointer :: field
   866)   type(patch_type), pointer :: patch  
   867)   PetscReal, pointer :: C0_p(:)
   868)   PetscReal, pointer :: dC_p(:)
   869)   PetscReal, pointer :: r_p(:)
   870)   PetscReal, pointer :: accum_p(:)  
   871)   PetscBool :: converged_due_to_rel_update
   872)   PetscBool :: converged_due_to_residual
   873)   PetscReal :: max_relative_change
   874)   PetscReal :: max_scaled_residual
   875)   PetscInt :: converged_flag
   876)   PetscInt :: temp_int
   877)   PetscReal :: max_relative_change_by_dof(this%option%ntrandof)
   878)   PetscReal :: global_max_rel_change_by_dof(this%option%ntrandof)
   879)   PetscMPIInt :: mpi_int
   880)   PetscInt :: local_id, offset, idof, index
   881)   PetscReal :: tempreal
   882)   
   883)   grid => this%realization%patch%grid
   884)   option => this%realization%option
   885)   field => this%realization%field
   886)   patch => this%realization%patch
   887)   
   888)   dX_changed = PETSC_FALSE
   889)   X1_changed = PETSC_FALSE
   890)   
   891)   converged_flag = 0
   892)   if (this%check_post_convergence) then
   893)     converged_due_to_rel_update = PETSC_FALSE
   894)     converged_due_to_residual = PETSC_FALSE
   895)     call VecGetArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
   896)     call VecGetArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
   897)     max_relative_change = maxval(dabs(dC_p(:)/C0_p(:)))
   898)     call VecRestoreArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
   899)     call VecRestoreArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
   900)     call VecGetArrayReadF90(field%tran_r,r_p,ierr);CHKERRQ(ierr)
   901)     call VecGetArrayReadF90(field%tran_accum,accum_p,ierr);CHKERRQ(ierr)
   902)     max_scaled_residual = maxval(dabs(r_p(:)/accum_p(:)))
   903)     call VecRestoreArrayReadF90(field%tran_r,r_p,ierr);CHKERRQ(ierr)
   904)     call VecRestoreArrayReadF90(field%tran_accum,accum_p,ierr);CHKERRQ(ierr)
   905)     converged_due_to_rel_update = (Initialized(rt_itol_rel_update) .and. &
   906)                                    max_relative_change < rt_itol_rel_update)
   907)     converged_due_to_residual = (Initialized(rt_itol_scaled_res) .and. &
   908)                                 max_scaled_residual < rt_itol_scaled_res)
   909)     if (converged_due_to_rel_update .or. converged_due_to_residual) then
   910)       converged_flag = 1
   911)     endif
   912)   endif
   913)   
   914)   ! get global minimum
   915)   call MPI_Allreduce(converged_flag,temp_int,ONE_INTEGER_MPI,MPI_INTEGER, &
   916)                      MPI_MIN,this%realization%option%mycomm,ierr)
   917) 
   918)   option%converged = PETSC_FALSE
   919)   if (temp_int == 1) then
   920)     option%converged = PETSC_TRUE
   921)   endif
   922)   
   923)   if (option%use_mc) then  
   924)     call SecondaryRTUpdateIterate(line_search,X0,dX,X1,dX_changed, &
   925)                                   X1_changed,this%realization,ierr)
   926)   endif
   927)   
   928)   if (this%print_ekg) then
   929)     call VecGetArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
   930)     call VecGetArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
   931)     max_relative_change_by_dof = -1.d20
   932)     do local_id = 1, grid%nlmax
   933)       offset = (local_id-1)*option%ntrandof
   934)       do idof = 1, option%ntrandof
   935)         index = idof + offset
   936)         tempreal = dabs(dC_p(index)/C0_p(index))
   937)         max_relative_change_by_dof(idof) = &
   938)           max(max_relative_change_by_dof(idof),tempreal)
   939)       enddo
   940)     enddo
   941)     call VecRestoreArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
   942)     call VecRestoreArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
   943)     mpi_int = option%ntrandof
   944)     call MPI_Allreduce(MPI_IN_PLACE,max_relative_change_by_dof,mpi_int, &
   945)                        MPI_DOUBLE_PRECISION,MPI_MAX,this%option%mycomm,ierr)
   946)     if (OptionPrintToFile(option)) then
   947) 100 format("REACTIVE TRANSPORT  NEWTON_ITERATION ",30es16.8)
   948)       write(IUNIT_EKG,100) max_relative_change_by_dof(:)
   949)     endif    
   950)   endif
   951) 
   952) end subroutine PMRTCheckUpdatePost
   953) 
   954) ! ************************************************************************** !
   955) 
   956) subroutine PMRTTimeCut(this)
   957)   ! 
   958)   ! Author: Glenn Hammond
   959)   ! Date: 03/14/13
   960)   ! 
   961) 
   962)   use Reactive_Transport_module, only : RTTimeCut
   963) 
   964)   implicit none
   965)   
   966)   class(pm_rt_type) :: this
   967)   
   968) #ifdef PM_RT_DEBUG  
   969)   call printMsg(this%option,'PMRT%TimeCut()')
   970) #endif
   971)   
   972)   this%option%tran_dt = this%option%dt
   973)   if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
   974)     call this%SetTranWeights()
   975)   endif
   976)   call RTTimeCut(this%realization)
   977) 
   978) end subroutine PMRTTimeCut
   979) 
   980) ! ************************************************************************** !
   981) 
   982) subroutine PMRTUpdateSolution1(this)
   983)   ! 
   984)   ! Author: Glenn Hammond
   985)   ! Date: 03/14/13
   986)   ! 
   987) 
   988)   use Reactive_Transport_module
   989)   use Condition_module
   990) 
   991)   implicit none
   992)   
   993)   class(pm_rt_type) :: this
   994)                                 ! update kinetics
   995)   call PMRTUpdateSolution2(this,PETSC_TRUE)
   996)   
   997) end subroutine PMRTUpdateSolution1
   998) 
   999) ! ************************************************************************** !
  1000) 
  1001) subroutine PMRTUpdateSolution2(this, update_kinetics)
  1002)   ! 
  1003)   ! Author: Glenn Hammond
  1004)   ! Date: 03/14/13
  1005)   ! 
  1006) 
  1007)   use Reactive_Transport_module
  1008)   use Condition_module
  1009)   use Integral_Flux_module
  1010) 
  1011)   implicit none
  1012)   
  1013)   class(pm_rt_type) :: this
  1014)   PetscBool :: update_kinetics
  1015)   
  1016) #ifdef PM_RT_DEBUG  
  1017)   call printMsg(this%option,'PMRT%UpdateSolution()')
  1018) #endif
  1019)   
  1020)   ! begin from RealizationUpdate()
  1021)   call TranConditionUpdate(this%realization%transport_conditions, &
  1022)                            this%realization%option, &
  1023)                            this%realization%option%time)
  1024)   if (associated(this%realization%uniform_velocity_dataset)) then
  1025)     call RealizUpdateUniformVelocity(this%realization)
  1026)   endif  
  1027)   ! end from RealizationUpdate()
  1028)   ! The update of status must be in this order!
  1029)   call RTUpdateEquilibriumState(this%realization)
  1030)   if (update_kinetics) &
  1031)     call RTUpdateKineticState(this%realization)
  1032)   
  1033) !TODO(geh): MassTransfer
  1034) !geh - moved to RTPreSolve()
  1035) !  call MassTransferUpdate(this%realization%rt_data_mediator_list, &
  1036) !                          this%realization%patch%grid, &
  1037) !                          this%realization%option)
  1038)   
  1039)   if (this%realization%option%compute_mass_balance_new) then
  1040)     call RTUpdateMassBalance(this%realization)
  1041)   endif
  1042)   if (this%option%transport%store_fluxes) then
  1043)     call IntegralFluxUpdate(this%realization%patch%integral_flux_list, &
  1044)                             this%realization%patch%internal_tran_fluxes, &
  1045)                             this%realization%patch%boundary_tran_fluxes, &
  1046)                             INTEGRATE_TRANSPORT,this%option)
  1047)   endif
  1048) 
  1049) end subroutine PMRTUpdateSolution2     
  1050) 
  1051) ! ************************************************************************** !
  1052) 
  1053) subroutine PMRTUpdateAuxVars(this)
  1054)   ! 
  1055)   ! Author: Glenn Hammond
  1056)   ! Date: 04/21/14
  1057) 
  1058)   use Reactive_Transport_module, only : RTUpdateAuxVars
  1059)   
  1060)   implicit none
  1061)   
  1062)   class(pm_rt_type) :: this
  1063)                                       ! cells      bcs         act. coefs.
  1064)   call RTUpdateAuxVars(this%realization,PETSC_TRUE,PETSC_FALSE,PETSC_FALSE)
  1065) 
  1066) end subroutine PMRTUpdateAuxVars  
  1067) 
  1068) ! ************************************************************************** !
  1069) 
  1070) subroutine PMRTMaxChange(this)
  1071)   ! 
  1072)   ! Author: Glenn Hammond
  1073)   ! Date: 03/14/13
  1074)   ! 
  1075) 
  1076)   use Reactive_Transport_module, only : RTMaxChange
  1077) 
  1078)   implicit none
  1079)   
  1080)   class(pm_rt_type) :: this
  1081)   
  1082) #ifdef PM_RT_DEBUG  
  1083)   call printMsg(this%option,'PMRT%MaxChange()')
  1084) #endif
  1085) 
  1086)   print *, 'PMRTMaxChange not implemented'
  1087)   stop
  1088) !  call RTMaxChange(this%realization)
  1089) 
  1090) end subroutine PMRTMaxChange
  1091) 
  1092) ! ************************************************************************** !
  1093) 
  1094) subroutine PMRTComputeMassBalance(this,mass_balance_array)
  1095)   ! 
  1096)   ! Author: Glenn Hammond
  1097)   ! Date: 03/14/13
  1098)   ! 
  1099) 
  1100)   use Reactive_Transport_module, only : RTComputeMassBalance
  1101) 
  1102)   implicit none
  1103)   
  1104)   class(pm_rt_type) :: this
  1105)   PetscReal :: mass_balance_array(:)
  1106) 
  1107) #ifdef PM_RT_DEBUG  
  1108)   call printMsg(this%option,'PMRT%MassBalance()')
  1109) #endif
  1110) 
  1111) #ifndef SIMPLIFY 
  1112)   call RTComputeMassBalance(this%realization,mass_balance_array)
  1113) #endif
  1114) 
  1115) end subroutine PMRTComputeMassBalance
  1116) 
  1117) ! ************************************************************************** !
  1118) 
  1119) subroutine SetTranWeights(this)
  1120)   ! 
  1121)   ! Sets the weights at t0 or t1 for transport
  1122)   ! 
  1123)   ! Author: Glenn Hammond
  1124)   ! Date: 01/17/11; 04/03/13
  1125)   ! 
  1126) 
  1127)   use Option_module
  1128) 
  1129)   implicit none
  1130)   
  1131)   class(pm_rt_type) :: this
  1132) 
  1133)   PetscReal :: flow_dt
  1134)   PetscReal :: flow_t0
  1135)   PetscReal :: flow_t1
  1136) 
  1137)   ! option%tran_time is the time at beginning of transport step
  1138)   flow_t0 = this%realization%patch%aux%Global%time_t
  1139)   flow_t1 = this%realization%patch%aux%Global%time_tpdt
  1140)   flow_dt = flow_t1-flow_t0
  1141)   this%tran_weight_t0 = max(0.d0,(this%option%time-flow_t0)/flow_dt)
  1142)   this%tran_weight_t1 = min(1.d0, &
  1143)                             (this%option%time+this%option%tran_dt-flow_t0)/ &
  1144)                             flow_dt)
  1145) 
  1146) end subroutine SetTranWeights
  1147) 
  1148) ! ************************************************************************** !
  1149) 
  1150) subroutine PMRTCheckpointBinary(this,viewer)
  1151)   ! 
  1152)   ! Checkpoints flow reactive transport process model
  1153)   ! 
  1154)   ! Author: Glenn Hammond
  1155)   ! Date: 07/29/13
  1156)   ! 
  1157) 
  1158)   use Option_module
  1159)   use Realization_Subsurface_class
  1160)   use Realization_Base_class
  1161)   use Field_module
  1162)   use Discretization_module
  1163)   use Grid_module
  1164)   use Reactive_Transport_module, only : RTCheckpointKineticSorptionBinary  
  1165)   use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
  1166)   use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
  1167)                                SECONDARY_ACTIVITY_COEF, &
  1168)                                MINERAL_VOLUME_FRACTION
  1169)   
  1170)   implicit none
  1171) 
  1172) #include "petsc/finclude/petscviewer.h"
  1173) #include "petsc/finclude/petscvec.h"
  1174) #include "petsc/finclude/petscvec.h90"
  1175) #include "petsc/finclude/petscbag.h"      
  1176) 
  1177)   interface PetscBagGetData
  1178) 
  1179) ! ************************************************************************** !
  1180) 
  1181)     subroutine PetscBagGetData(bag,header,ierr)
  1182)       import :: pm_rt_header_type
  1183)       implicit none
  1184) #include "petsc/finclude/petscbag.h"      
  1185)       PetscBag :: bag
  1186)       class(pm_rt_header_type), pointer :: header
  1187)       PetscErrorCode :: ierr
  1188)     end subroutine
  1189)   end interface PetscBagGetData 
  1190) 
  1191)   PetscViewer :: viewer
  1192)   class(pm_rt_type) :: this
  1193)   PetscErrorCode :: ierr
  1194) 
  1195)   class(realization_subsurface_type), pointer :: realization
  1196)   type(option_type), pointer :: option
  1197)   type(field_type), pointer :: field
  1198)   type(discretization_type), pointer :: discretization
  1199)   type(grid_type), pointer :: grid
  1200)   Vec :: global_vec
  1201)   PetscInt :: i
  1202) 
  1203)   class(pm_rt_header_type), pointer :: header
  1204)   type(pm_rt_header_type) :: dummy_header
  1205)   character(len=1),pointer :: dummy_char(:)
  1206)   PetscBag :: bag
  1207)   PetscSizeT :: bagsize
  1208)   
  1209)   realization => this%realization
  1210)   option => realization%option
  1211)   field => realization%field
  1212)   discretization => realization%discretization
  1213)   grid => realization%patch%grid
  1214)   
  1215)   global_vec = 0
  1216) 
  1217)   bagsize = size(transfer(dummy_header,dummy_char))
  1218)   
  1219)   call PetscBagCreate(option%mycomm,bagsize,bag,ierr);CHKERRQ(ierr)
  1220)   call PetscBagGetData(bag,header,ierr);CHKERRQ(ierr)
  1221)   call PetscBagRegisterInt(bag,header%checkpoint_activity_coefs,0, &
  1222)                            "checkpoint_activity_coefs","",ierr);CHKERRQ(ierr)
  1223)   call PetscBagRegisterInt(bag,header%ndof,0, &
  1224)                            "ndof","",ierr);CHKERRQ(ierr)
  1225)   if (associated(realization%reaction)) then
  1226)     if (realization%reaction%checkpoint_activity_coefs .and. &
  1227)         realization%reaction%act_coef_update_frequency /= &
  1228)         ACT_COEF_FREQUENCY_OFF) then
  1229)       header%checkpoint_activity_coefs = ONE_INTEGER
  1230)     else
  1231)       header%checkpoint_activity_coefs = ZERO_INTEGER
  1232)     endif
  1233)   else
  1234)     header%checkpoint_activity_coefs = ZERO_INTEGER
  1235)   endif
  1236)   !geh: %ndof should be pushed down to the base class, but this is not possible
  1237)   !     as long as option%ntrandof is used.
  1238)   header%ndof = option%ntrandof
  1239)   call PetscBagView(bag,viewer,ierr);CHKERRQ(ierr)
  1240)   call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
  1241)   
  1242)   if (option%ntrandof > 0) then
  1243)     call VecView(field%tran_xx, viewer, ierr);CHKERRQ(ierr)
  1244)     ! create a global vec for writing below 
  1245)     if (global_vec == 0) then
  1246)       call DiscretizationCreateVector(realization%discretization,ONEDOF, &
  1247)                                       global_vec,GLOBAL,option)
  1248)     endif
  1249)     if (realization%reaction%checkpoint_activity_coefs .and. &
  1250)         realization%reaction%act_coef_update_frequency /= &
  1251)         ACT_COEF_FREQUENCY_OFF) then
  1252)       ! allocated vector
  1253)       do i = 1, realization%reaction%naqcomp
  1254)         call RealizationGetVariable(realization,global_vec, &
  1255)                                    PRIMARY_ACTIVITY_COEF,i)
  1256)         call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
  1257)       enddo
  1258)       do i = 1, realization%reaction%neqcplx
  1259)         call RealizationGetVariable(realization,global_vec, &
  1260)                                    SECONDARY_ACTIVITY_COEF,i)
  1261)         call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
  1262)       enddo
  1263)     endif
  1264)     ! mineral volume fractions for kinetic minerals
  1265)     if (realization%reaction%mineral%nkinmnrl > 0) then
  1266)       do i = 1, realization%reaction%mineral%nkinmnrl
  1267)         call RealizationGetVariable(realization,global_vec, &
  1268)                                    MINERAL_VOLUME_FRACTION,i)
  1269)         call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
  1270)       enddo
  1271)     endif
  1272)     ! sorbed concentrations for multirate kinetic sorption
  1273)     if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
  1274)         .not.option%transport%no_checkpoint_kinetic_sorption) then
  1275)       ! PETSC_TRUE flag indicates write to file
  1276)       call RTCheckpointKineticSorptionBinary(realization,viewer,PETSC_TRUE)
  1277)     endif
  1278)   endif
  1279) 
  1280)   if (global_vec /= 0) then
  1281)     call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
  1282)   endif
  1283)   
  1284) end subroutine PMRTCheckpointBinary
  1285) 
  1286) ! ************************************************************************** !
  1287) 
  1288) subroutine PMRTRestartBinary(this,viewer)
  1289)   ! 
  1290)   ! Restarts flow reactive transport process model
  1291)   ! 
  1292)   ! Author: Glenn Hammond
  1293)   ! Date: 07/29/13
  1294)   ! 
  1295) 
  1296)   use Option_module
  1297)   use Realization_Subsurface_class
  1298)   use Realization_Base_class
  1299)   use Field_module
  1300)   use Discretization_module
  1301)   use Grid_module
  1302)   use Reactive_Transport_module, only : RTCheckpointKineticSorptionBinary, &
  1303)                                         RTUpdateAuxVars
  1304)   use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
  1305)   use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
  1306)                                SECONDARY_ACTIVITY_COEF, &
  1307)                                MINERAL_VOLUME_FRACTION
  1308)   
  1309)   implicit none
  1310) 
  1311) #include "petsc/finclude/petscviewer.h"
  1312) #include "petsc/finclude/petscvec.h"
  1313) #include "petsc/finclude/petscvec.h90"
  1314) #include "petsc/finclude/petscbag.h"      
  1315) 
  1316)   interface PetscBagGetData
  1317) 
  1318) ! ************************************************************************** !
  1319) 
  1320)     subroutine PetscBagGetData(bag,header,ierr)
  1321)       import :: pm_rt_header_type
  1322)       implicit none
  1323) #include "petsc/finclude/petscbag.h"      
  1324)       PetscBag :: bag
  1325)       class(pm_rt_header_type), pointer :: header
  1326)       PetscErrorCode :: ierr
  1327)     end subroutine
  1328)   end interface PetscBagGetData 
  1329) 
  1330)   PetscViewer :: viewer
  1331)   class(pm_rt_type) :: this
  1332)   PetscErrorCode :: ierr
  1333) 
  1334)   class(realization_subsurface_type), pointer :: realization
  1335)   type(option_type), pointer :: option
  1336)   type(field_type), pointer :: field
  1337)   type(discretization_type), pointer :: discretization
  1338)   type(grid_type), pointer :: grid
  1339)   Vec :: global_vec, local_vec
  1340)   PetscInt :: i
  1341) 
  1342)   class(pm_rt_header_type), pointer :: header
  1343)   type(pm_rt_header_type) :: dummy_header
  1344)   character(len=1),pointer :: dummy_char(:)
  1345)   PetscBag :: bag
  1346)   PetscSizeT :: bagsize
  1347)   
  1348)   realization => this%realization
  1349)   option => realization%option
  1350)   field => realization%field
  1351)   discretization => realization%discretization
  1352)   grid => realization%patch%grid
  1353)   
  1354)   global_vec = 0
  1355)   local_vec = 0
  1356)   
  1357)   bagsize = size(transfer(dummy_header,dummy_char))
  1358) 
  1359)   call PetscBagCreate(this%option%mycomm, bagsize, bag, ierr);CHKERRQ(ierr)
  1360)   call PetscBagGetData(bag, header, ierr);CHKERRQ(ierr)
  1361)   call PetscBagRegisterInt(bag,header%checkpoint_activity_coefs,0, &
  1362)                            "checkpoint_activity_coefs","",ierr);CHKERRQ(ierr)
  1363)   call PetscBagRegisterInt(bag,header%ndof,0, &
  1364)                            "ndof","",ierr);CHKERRQ(ierr)
  1365)   call PetscBagLoad(viewer, bag, ierr);CHKERRQ(ierr)
  1366)   option%ntrandof = header%ndof
  1367)   
  1368)   call VecLoad(field%tran_xx,viewer,ierr);CHKERRQ(ierr)
  1369)   call DiscretizationGlobalToLocal(discretization,field%tran_xx, &
  1370)                                     field%tran_xx_loc,NTRANDOF)
  1371)   call VecCopy(field%tran_xx,field%tran_yy,ierr);CHKERRQ(ierr)
  1372) 
  1373)   if (global_vec == 0) then
  1374)     call DiscretizationCreateVector(realization%discretization,ONEDOF, &
  1375)                                     global_vec,GLOBAL,option)
  1376)   endif    
  1377)   if (header%checkpoint_activity_coefs == ONE_INTEGER) then
  1378)     call DiscretizationCreateVector(discretization,ONEDOF,local_vec, &
  1379)                                     LOCAL,option)
  1380)     do i = 1, realization%reaction%naqcomp
  1381)       call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
  1382)       call DiscretizationGlobalToLocal(discretization,global_vec, &
  1383)                                         local_vec,ONEDOF)
  1384)       call RealizationSetVariable(realization,local_vec,LOCAL, &
  1385)                                   PRIMARY_ACTIVITY_COEF,i)
  1386)     enddo
  1387)     do i = 1, realization%reaction%neqcplx
  1388)       call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
  1389)       call DiscretizationGlobalToLocal(discretization,global_vec, &
  1390)                                         local_vec,ONEDOF)
  1391)       call RealizationSetVariable(realization,local_vec,LOCAL, &
  1392)                                   SECONDARY_ACTIVITY_COEF,i)
  1393)     enddo
  1394)   endif
  1395)   ! mineral volume fractions for kinetic minerals
  1396)   if (realization%reaction%mineral%nkinmnrl > 0) then
  1397)     do i = 1, realization%reaction%mineral%nkinmnrl
  1398)       ! have to load the vecs no matter what
  1399)       call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
  1400)       if (.not.option%transport%no_restart_mineral_vol_frac) then
  1401)         call RealizationSetVariable(realization,global_vec,GLOBAL, &
  1402)                                     MINERAL_VOLUME_FRACTION,i)
  1403)       endif
  1404)     enddo
  1405)   endif
  1406)   ! sorbed concentrations for multirate kinetic sorption
  1407)   if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
  1408)       .not.option%transport%no_checkpoint_kinetic_sorption .and. &
  1409)       ! we need to fix this.  We need something to skip over the reading
  1410)       ! of sorbed concentrations altogether if they do not exist in the
  1411)       ! checkpoint file
  1412)       .not.option%transport%no_restart_kinetic_sorption) then
  1413)     ! PETSC_FALSE flag indicates read from file
  1414)     call RTCheckpointKineticSorptionBinary(realization,viewer,PETSC_FALSE)
  1415)   endif
  1416)     
  1417)   ! We are finished, so clean up.
  1418)   if (global_vec /= 0) then
  1419)     call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
  1420)   endif
  1421)   if (local_vec /= 0) then
  1422)     call VecDestroy(local_vec,ierr);CHKERRQ(ierr)
  1423)   endif
  1424)   
  1425)   call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
  1426)   
  1427)   if (realization%reaction%use_full_geochemistry) then
  1428)                                      ! cells     bcs        act coefs.
  1429)     call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
  1430)   endif
  1431)   ! do not update kinetics.
  1432)   call PMRTUpdateSolution2(this,PETSC_FALSE)
  1433)   
  1434) end subroutine PMRTRestartBinary
  1435) 
  1436) ! ************************************************************************** !
  1437) 
  1438) subroutine PMRTCheckpointHDF5(this, pm_grp_id)
  1439)   ! 
  1440)   ! Checkpoints flow reactive transport process model
  1441)   ! 
  1442)   ! Author: Gautam Bisht
  1443)   ! Date: 07/30/15
  1444)   ! 
  1445) 
  1446) #if  !defined(PETSC_HAVE_HDF5)
  1447)   implicit none
  1448)   class(pm_rt_type) :: this
  1449)   integer :: pm_grp_id
  1450)   type(option_type) :: option
  1451)   print *, 'PFLOTRAN must be compiled with HDF5 to ' // &
  1452)         'write HDF5 formatted checkpoint file. Darn.'
  1453)   stop
  1454) #else
  1455) 
  1456)   use Option_module
  1457)   use Realization_Subsurface_class
  1458)   use Realization_Base_class
  1459)   use Field_module
  1460)   use Discretization_module
  1461)   use Grid_module
  1462)   use Reactive_Transport_module, only : RTCheckpointKineticSorptionHDF5
  1463)   use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
  1464)   use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
  1465)                                SECONDARY_ACTIVITY_COEF, &
  1466)                                MINERAL_VOLUME_FRACTION
  1467)   use hdf5
  1468)   use Checkpoint_module, only: CheckPointWriteIntDatasetHDF5
  1469)   use HDF5_module, only : HDF5WriteDataSetFromVec
  1470) 
  1471)   implicit none
  1472) 
  1473) #include "petsc/finclude/petscvec.h"
  1474) #include "petsc/finclude/petscvec.h90"
  1475) 
  1476)   class(pm_rt_type) :: this
  1477) #if defined(SCORPIO_WRITE)
  1478)   integer :: pm_grp_id
  1479) #else
  1480)   integer(HID_T) :: pm_grp_id
  1481) #endif
  1482) 
  1483) #if defined(SCORPIO_WRITE)
  1484)   integer, pointer :: dims(:)
  1485)   integer, pointer :: start(:)
  1486)   integer, pointer :: stride(:)
  1487)   integer, pointer :: length(:)
  1488) #else
  1489)   integer(HSIZE_T), pointer :: dims(:)
  1490)   integer(HSIZE_T), pointer :: start(:)
  1491)   integer(HSIZE_T), pointer :: stride(:)
  1492)   integer(HSIZE_T), pointer :: length(:)
  1493) #endif
  1494) 
  1495)   PetscMPIInt :: dataset_rank
  1496)   character(len=MAXSTRINGLENGTH) :: dataset_name
  1497)   PetscInt, pointer :: int_array(:)
  1498) 
  1499)   class(realization_subsurface_type), pointer :: realization
  1500)   type(option_type), pointer :: option
  1501)   type(field_type), pointer :: field
  1502)   type(discretization_type), pointer :: discretization
  1503)   type(grid_type), pointer :: grid
  1504)   Vec :: global_vec
  1505)   Vec :: natural_vec
  1506)   PetscInt :: i
  1507)   PetscErrorCode :: ierr
  1508) 
  1509)   realization => this%realization
  1510)   option => realization%option
  1511)   field => realization%field
  1512)   discretization => realization%discretization
  1513)   grid => realization%patch%grid
  1514) 
  1515)   allocate(start(1))
  1516)   allocate(dims(1))
  1517)   allocate(length(1))
  1518)   allocate(stride(1))
  1519)   allocate(int_array(1))
  1520) 
  1521)   dataset_rank = 1
  1522)   dims(1) = ONE_INTEGER
  1523)   start(1) = 0
  1524)   length(1) = ONE_INTEGER
  1525)   stride(1) = ONE_INTEGER
  1526) 
  1527)   if (associated(realization%reaction)) then
  1528)     if (realization%reaction%checkpoint_activity_coefs .and. &
  1529)         realization%reaction%act_coef_update_frequency /= &
  1530)         ACT_COEF_FREQUENCY_OFF) then
  1531)       int_array(1) = ONE_INTEGER
  1532)     else
  1533)       int_array(1) = ZERO_INTEGER
  1534)     endif
  1535)   else
  1536)     int_array(1) = ZERO_INTEGER
  1537)   endif
  1538) 
  1539)   dataset_name = "Checkpoint_Activity_Coefs" // CHAR(0)
  1540)   call CheckPointWriteIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
  1541)                                      dims, start, length, stride, int_array, option)
  1542) 
  1543)   dataset_name = "NDOF" // CHAR(0)
  1544)   int_array(1) = option%ntrandof
  1545)   call CheckPointWriteIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
  1546)                                      dims, start, length, stride, int_array, option)
  1547) 
  1548)   !geh: %ndof should be pushed down to the base class, but this is not possible
  1549)   !     as long as option%ntrandof is used.
  1550) 
  1551)   if (option%ntrandof > 0) then
  1552) 
  1553)     call DiscretizationCreateVector(realization%discretization, NTRANDOF, &
  1554)                                      natural_vec, NATURAL, option)
  1555)     call DiscretizationGlobalToNatural(realization%discretization, field%tran_xx, &
  1556)                                         natural_vec, NTRANDOF)
  1557)     dataset_name = "Primary_Variable" // CHAR(0)
  1558)     call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
  1559)            pm_grp_id, H5T_NATIVE_DOUBLE)
  1560)     call VecDestroy(natural_vec, ierr); CHKERRQ(ierr)
  1561) 
  1562)     ! create a global vec for writing below
  1563)     call DiscretizationCreateVector(realization%discretization,ONEDOF, &
  1564)                                       global_vec,GLOBAL,option)
  1565)     call DiscretizationCreateVector(realization%discretization, ONEDOF, &
  1566)                                      natural_vec, NATURAL, option)
  1567) 
  1568)     if (realization%reaction%checkpoint_activity_coefs .and. &
  1569)         realization%reaction%act_coef_update_frequency /= &
  1570)         ACT_COEF_FREQUENCY_OFF) then
  1571) 
  1572)       do i = 1, realization%reaction%naqcomp
  1573)         call RealizationGetVariable(realization,global_vec, &
  1574)                                     PRIMARY_ACTIVITY_COEF,i)
  1575)         call DiscretizationGlobalToNatural(realization%discretization, global_vec, &
  1576)                                         natural_vec, ONEDOF)
  1577)         write(dataset_name,*) i
  1578)         dataset_name = 'Aq_comp_' // trim(adjustl(dataset_name))
  1579)         call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
  1580)            pm_grp_id, H5T_NATIVE_DOUBLE)
  1581)       enddo
  1582) 
  1583)       do i = 1, realization%reaction%neqcplx
  1584)         call RealizationGetVariable(realization,global_vec, &
  1585)                                    SECONDARY_ACTIVITY_COEF,i)
  1586)         call DiscretizationGlobalToNatural(realization%discretization, global_vec, &
  1587)                                         natural_vec, ONEDOF)
  1588)         write(dataset_name,*) i
  1589)         dataset_name = 'Eq_cplx_' // trim(adjustl(dataset_name))
  1590)         call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
  1591)            pm_grp_id, H5T_NATIVE_DOUBLE)
  1592)       enddo
  1593)     endif
  1594) 
  1595)     ! mineral volume fractions for kinetic minerals
  1596)     if (realization%reaction%mineral%nkinmnrl > 0) then
  1597)       do i = 1, realization%reaction%mineral%nkinmnrl
  1598)         call RealizationGetVariable(realization,global_vec, &
  1599)                                    MINERAL_VOLUME_FRACTION,i)
  1600)         call DiscretizationGlobalToNatural(realization%discretization, global_vec, &
  1601)                                         natural_vec, ONEDOF)
  1602)         write(dataset_name,*) i
  1603)         dataset_name = 'Kinetic_mineral_' // trim(adjustl(dataset_name))
  1604)         call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
  1605)            pm_grp_id, H5T_NATIVE_DOUBLE)
  1606)       enddo
  1607)     endif
  1608) 
  1609)     if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
  1610)         .not.option%transport%no_checkpoint_kinetic_sorption) then
  1611)       ! PETSC_TRUE flag indicates write to file
  1612)       call RTCheckpointKineticSorptionHDF5(realization, pm_grp_id, PETSC_TRUE)
  1613)     endif
  1614) 
  1615)     call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
  1616)     call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
  1617) 
  1618)    endif
  1619) #endif
  1620) 
  1621) end subroutine PMRTCheckpointHDF5
  1622) 
  1623) ! ************************************************************************** !
  1624) 
  1625) subroutine PMRTRestartHDF5(this, pm_grp_id)
  1626)   ! 
  1627)   ! Checkpoints flow reactive transport process model
  1628)   ! 
  1629)   ! Author: Gautam Bisht
  1630)   ! Date: 07/30/15
  1631)   ! 
  1632) 
  1633) #if  !defined(PETSC_HAVE_HDF5)
  1634)   implicit none
  1635)   class(pm_rt_type) :: this
  1636)   integer :: pm_grp_id
  1637)   type(option_type) :: option
  1638)   print *, 'PFLOTRAN must be compiled with HDF5 to ' // &
  1639)         'write HDF5 formatted checkpoint file. Darn.'
  1640)   stop
  1641) #else
  1642) 
  1643)   use Option_module
  1644)   use Realization_Subsurface_class
  1645)   use Realization_Base_class
  1646)   use Field_module
  1647)   use Discretization_module
  1648)   use Grid_module
  1649)   use Reactive_Transport_module, only : RTCheckpointKineticSorptionHDF5, &
  1650)                                         RTUpdateAuxVars
  1651)   use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
  1652)   use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
  1653)                                SECONDARY_ACTIVITY_COEF, &
  1654)                                MINERAL_VOLUME_FRACTION
  1655)   use hdf5
  1656)   use Checkpoint_module, only: CheckPointReadIntDatasetHDF5
  1657)   use HDF5_module, only : HDF5ReadDataSetInVec
  1658) 
  1659)   implicit none
  1660) 
  1661) #include "petsc/finclude/petscvec.h"
  1662) #include "petsc/finclude/petscvec.h90"
  1663) 
  1664)   class(pm_rt_type) :: this
  1665) #if defined(SCORPIO_WRITE)
  1666)   integer :: pm_grp_id
  1667) #else
  1668)   integer(HID_T) :: pm_grp_id
  1669) #endif
  1670) 
  1671) #if defined(SCORPIO_WRITE)
  1672)   integer, pointer :: dims(:)
  1673)   integer, pointer :: start(:)
  1674)   integer, pointer :: stride(:)
  1675)   integer, pointer :: length(:)
  1676) #else
  1677)   integer(HSIZE_T), pointer :: dims(:)
  1678)   integer(HSIZE_T), pointer :: start(:)
  1679)   integer(HSIZE_T), pointer :: stride(:)
  1680)   integer(HSIZE_T), pointer :: length(:)
  1681) #endif
  1682) 
  1683)   PetscMPIInt :: dataset_rank
  1684)   character(len=MAXSTRINGLENGTH) :: dataset_name
  1685)   PetscInt, pointer :: int_array(:)
  1686) 
  1687)   class(realization_subsurface_type), pointer :: realization
  1688)   type(option_type), pointer :: option
  1689)   type(field_type), pointer :: field
  1690)   type(discretization_type), pointer :: discretization
  1691)   type(grid_type), pointer :: grid
  1692)   Vec :: local_vec
  1693)   Vec :: global_vec
  1694)   Vec :: natural_vec
  1695)   PetscInt :: i
  1696)   PetscInt :: checkpoint_activity_coefs
  1697)   PetscErrorCode :: ierr
  1698) 
  1699)   realization => this%realization
  1700)   option => realization%option
  1701)   field => realization%field
  1702)   discretization => realization%discretization
  1703)   grid => realization%patch%grid
  1704) 
  1705)   allocate(start(1))
  1706)   allocate(dims(1))
  1707)   allocate(length(1))
  1708)   allocate(stride(1))
  1709)   allocate(int_array(1))
  1710) 
  1711)   dataset_rank = 1
  1712)   dims(1) = ONE_INTEGER
  1713)   start(1) = 0
  1714)   length(1) = ONE_INTEGER
  1715)   stride(1) = ONE_INTEGER
  1716) 
  1717)   dataset_name = "Checkpoint_Activity_Coefs" // CHAR(0)
  1718)   call CheckPointReadIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
  1719)                                      dims, start, length, stride, int_array, option)
  1720)   checkpoint_activity_coefs = int_array(1)
  1721)   
  1722)   dataset_name = "NDOF" // CHAR(0)
  1723)   int_array(1) = option%ntrandof
  1724)   call CheckPointReadIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
  1725)                                     dims, start, length, stride, int_array, option)
  1726)   option%ntrandof = int_array(1)
  1727)   
  1728)   !geh: %ndof should be pushed down to the base class, but this is not possible
  1729)   !     as long as option%ntrandof is used.
  1730) 
  1731)   if (option%ntrandof > 0) then
  1732) 
  1733)     call DiscretizationCreateVector(discretization, NTRANDOF, &
  1734)                                      natural_vec, NATURAL, option)
  1735)     dataset_name = "Primary_Variable" // CHAR(0)
  1736)     call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
  1737)                              pm_grp_id, H5T_NATIVE_DOUBLE)
  1738)     call DiscretizationNaturalToGlobal(discretization, natural_vec, field%tran_xx, &
  1739)                                        NTRANDOF)
  1740)     call DiscretizationGlobalToLocal(discretization,field%tran_xx, &
  1741)                                     field%tran_xx_loc,NTRANDOF)
  1742)     call VecCopy(field%tran_xx,field%tran_yy,ierr);CHKERRQ(ierr)
  1743)     call VecDestroy(natural_vec, ierr); CHKERRQ(ierr)
  1744) 
  1745)     ! create a global vec for reading
  1746)     call DiscretizationCreateVector(discretization,ONEDOF, &
  1747)                                     global_vec,GLOBAL,option)
  1748)     call DiscretizationCreateVector(discretization, ONEDOF, &
  1749)                                     natural_vec, NATURAL, option)
  1750)     call DiscretizationCreateVector(discretization,ONEDOF,local_vec, &
  1751)                                     LOCAL,option)
  1752) 
  1753)     if (checkpoint_activity_coefs == ONE_INTEGER) then
  1754) 
  1755)       do i = 1, realization%reaction%naqcomp
  1756)         write(dataset_name,*) i
  1757)         dataset_name = 'Aq_comp_' // trim(adjustl(dataset_name))
  1758)         call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
  1759)            pm_grp_id, H5T_NATIVE_DOUBLE)
  1760) 
  1761)         call DiscretizationNaturalToGlobal(discretization, natural_vec, &
  1762)                                            global_vec, ONEDOF)
  1763)         call DiscretizationGlobalToLocal(discretization, global_vec, &
  1764)                                          local_vec, ONEDOF)
  1765)         call RealizationSetVariable(realization, local_vec, LOCAL, &
  1766)                                     PRIMARY_ACTIVITY_COEF,i)
  1767)       enddo
  1768) 
  1769)       do i = 1, realization%reaction%neqcplx
  1770)         write(dataset_name,*) i
  1771)         dataset_name = 'Eq_cplx_' // trim(adjustl(dataset_name))
  1772)         call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
  1773)            pm_grp_id, H5T_NATIVE_DOUBLE)
  1774) 
  1775)         call DiscretizationNaturalToGlobal(discretization, natural_vec, &
  1776)                                            global_vec, ONEDOF)
  1777)         call DiscretizationGlobalToLocal(discretization, global_vec, &
  1778)                                          local_vec, ONEDOF)
  1779)         call RealizationSetVariable(realization, local_vec, LOCAL, &
  1780)                                    SECONDARY_ACTIVITY_COEF, i)
  1781)       enddo
  1782)     endif
  1783) 
  1784)     ! mineral volume fractions for kinetic minerals
  1785)     if (realization%reaction%mineral%nkinmnrl > 0) then
  1786)       do i = 1, realization%reaction%mineral%nkinmnrl
  1787)         write(dataset_name,*) i
  1788)         dataset_name = 'Kinetic_mineral_' // trim(adjustl(dataset_name))
  1789)         call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
  1790)            pm_grp_id, H5T_NATIVE_DOUBLE)
  1791) 
  1792)         call DiscretizationNaturalToGlobal(discretization, natural_vec, &
  1793)                                            global_vec, ONEDOF)
  1794)         call DiscretizationGlobalToLocal(discretization, global_vec, &
  1795)                                          local_vec, ONEDOF)
  1796)         call RealizationSetVariable(realization, local_vec, LOCAL, &
  1797)                                    MINERAL_VOLUME_FRACTION,i)
  1798)       enddo
  1799)     endif
  1800) 
  1801)     if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
  1802)         .not.option%transport%no_checkpoint_kinetic_sorption) then
  1803)       ! PETSC_TRUE flag indicates write to file
  1804)       call RTCheckpointKineticSorptionHDF5(realization, pm_grp_id, PETSC_TRUE)
  1805)     endif
  1806) 
  1807)     call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
  1808)     call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
  1809) 
  1810)   endif
  1811) 
  1812)   if (realization%reaction%use_full_geochemistry) then
  1813)                                      ! cells     bcs        act coefs.
  1814)     call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
  1815)   endif
  1816)   ! do not update kinetics.
  1817)   call PMRTUpdateSolution2(this,PETSC_FALSE)
  1818) 
  1819)   deallocate(start)
  1820)   deallocate(dims)
  1821)   deallocate(length)
  1822)   deallocate(stride)
  1823)   deallocate(int_array)
  1824) 
  1825) #endif
  1826) 
  1827) end subroutine PMRTRestartHDF5
  1828) 
  1829) ! ************************************************************************** !
  1830) 
  1831) subroutine PMRTInputRecord(this)
  1832)   ! 
  1833)   ! Writes ingested information to the input record file.
  1834)   ! 
  1835)   ! Author: Jenn Frederick, SNL
  1836)   ! Date: 03/21/2016
  1837)   ! 
  1838)   
  1839)   implicit none
  1840)   
  1841)   class(pm_rt_type) :: this
  1842) 
  1843)   character(len=MAXWORDLENGTH) :: word
  1844)   PetscInt :: id
  1845) 
  1846)   id = INPUT_RECORD_UNIT
  1847) 
  1848)   write(id,'(a29)',advance='no') 'pm: '
  1849)   write(id,'(a)') this%name
  1850) 
  1851) end subroutine PMRTInputRecord
  1852) 
  1853) ! ************************************************************************** !
  1854) 
  1855) subroutine PMRTDestroy(this)
  1856)   ! 
  1857)   ! Destroys RT process model
  1858)   ! 
  1859)   ! Author: Glenn Hammond
  1860)   ! Date: 03/14/13
  1861)   ! 
  1862) 
  1863)   use Reactive_Transport_module, only : RTDestroy
  1864) 
  1865)   implicit none
  1866)   
  1867)   class(pm_rt_type) :: this
  1868) 
  1869)   call RTDestroy(this%realization)
  1870)   ! destroyed in realization
  1871)   nullify(this%comm1)
  1872)   nullify(this%option)
  1873)   nullify(this%output_option)
  1874)   call this%commN%Destroy()
  1875)   if (associated(this%commN)) deallocate(this%commN)
  1876)   nullify(this%commN)  
  1877) 
  1878) end subroutine PMRTDestroy
  1879)   
  1880) end module PM_RT_class

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