reactive_transport.F90       coverage:  51.43 %func     37.16 %block


     1) module Reactive_Transport_module
     2) 
     3)   use Transport_module
     4)   use Reaction_module
     5) 
     6)   use Reactive_Transport_Aux_module
     7)   use Reaction_Aux_module
     8)   use Global_Aux_module
     9)   use Material_Aux_class
    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) #include "petsc/finclude/petscviewer.h"
    25) #include "petsc/finclude/petsclog.h"
    26) 
    27)   PetscReal, parameter :: perturbation_tolerance = 1.d-5
    28)   
    29)   public :: RTTimeCut, &
    30)             RTSetup, &
    31)             RTMaxChange, &
    32)             RTUpdateEquilibriumState, &
    33)             RTUpdateKineticState, &
    34)             RTUpdateMassBalance, &
    35)             RTResidual, &
    36)             RTJacobian, &
    37)             RTInitializeTimestep, &
    38)             RTUpdateAuxVars, &
    39)             RTComputeMassBalance, &
    40)             RTDestroy, &
    41)             RTUpdateTransportCoefs, &
    42)             RTUpdateRHSCoefs, &
    43)             RTCalculateRHS_t0, &
    44)             RTCalculateRHS_t1, &
    45)             RTCalculateTransportMatrix, &
    46)             RTReact, &
    47)             RTJumpStartKineticSorption, &
    48)             RTCheckpointKineticSorptionBinary, &
    49)             RTCheckpointKineticSorptionHDF5, &
    50)             RTExplicitAdvection, &
    51)             RTClearActivityCoefficients
    52)   
    53) contains
    54) 
    55) ! ************************************************************************** !
    56) 
    57) subroutine RTTimeCut(realization)
    58)   ! 
    59)   ! Resets arrays for time step cut
    60)   ! 
    61)   ! Author: Glenn Hammond
    62)   ! Date: 02/15/08
    63)   ! 
    64)  
    65)   use Realization_Subsurface_class
    66)   use Option_module
    67)   use Field_module
    68)   use Global_module
    69)   use Secondary_Continuum_module, only : SecondaryRTTimeCut
    70)  
    71)   implicit none
    72)   
    73)   type(realization_subsurface_type) :: realization
    74)   type(field_type), pointer :: field
    75)   type(option_type), pointer :: option
    76)   
    77)   PetscErrorCode :: ierr
    78) 
    79)   field => realization%field
    80)   option => realization%option
    81)  
    82)   ! copy previous solution back to current solution
    83)   call VecCopy(field%tran_yy,field%tran_xx,ierr);CHKERRQ(ierr)
    84)   
    85)   ! set densities and saturations to t
    86)   if (realization%option%nflowdof > 0) then
    87)     call GlobalWeightAuxVars(realization, &
    88)                                realization%option%transport%tran_weight_t0)
    89)   endif
    90)   
    91)   call RTInitializeTimestep(realization)  
    92)   ! note: RTUpdateTransportCoefs() is called within RTInitializeTimestep()
    93)   ! geh - not any longer, tran coefs should always be evaluated at time k+1  
    94)   
    95)   ! set densities and saturations to t+dt
    96)   if (realization%option%nflowdof > 0) then
    97)     call GlobalWeightAuxVars(realization, &
    98)                                realization%option%transport%tran_weight_t1)
    99)   endif
   100) 
   101)   call RTUpdateTransportCoefs(realization)
   102)   
   103)   if (option%use_mc) then
   104)     call SecondaryRTTimeCut(realization)
   105)   endif
   106)  
   107) end subroutine RTTimeCut
   108) 
   109) ! ************************************************************************** !
   110) 
   111) subroutine RTSetup(realization)
   112)   ! 
   113)   ! Author: Glenn Hammond
   114)   ! Date: 02/22/08
   115)   ! 
   116) 
   117)   use Realization_Subsurface_class
   118)   use Patch_module
   119)   use Option_module
   120)   use Grid_module
   121)   use Region_module
   122)   use Coupler_module
   123)   use Condition_module
   124)   use Connection_module
   125)   use Transport_Constraint_module
   126)   use Fluid_module
   127)   use Material_module
   128)   use Material_Aux_class
   129)   use Reaction_Surface_Complexation_Aux_module
   130)   !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
   131)   !      resolves a bug in the Intel Visual Fortran compiler.
   132)   use Secondary_Continuum_Aux_module, only : sec_transport_type, &
   133)                                              SecondaryAuxRTCreate
   134)   use Secondary_Continuum_module, only : SecondaryRTAuxVarInit
   135)   use Output_Aux_module
   136)  
   137)   implicit none
   138) 
   139)   type(realization_subsurface_type) :: realization
   140)   
   141)   type(patch_type), pointer :: patch
   142)   type(option_type), pointer :: option
   143)   type(grid_type), pointer :: grid
   144)   type(output_variable_list_type), pointer :: list
   145)   type(reaction_type), pointer :: reaction
   146)   type(coupler_type), pointer :: boundary_condition
   147)   type(coupler_type), pointer :: source_sink
   148)   type(fluid_property_type), pointer :: cur_fluid_property
   149)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
   150)   type(coupler_type), pointer :: initial_condition
   151)   type(tran_constraint_type), pointer :: sec_tran_constraint
   152)   class(material_auxvar_type), pointer :: material_auxvars(:)
   153) 
   154)   PetscInt :: ghosted_id, iconn, sum_connection
   155)   PetscInt :: iphase, local_id, i
   156)   PetscBool :: error_found
   157)   PetscInt :: flag(10)  
   158)   
   159)   option => realization%option
   160)   patch => realization%patch
   161)   grid => patch%grid
   162)   reaction => realization%reaction
   163)   sec_tran_constraint => realization%sec_transport_constraint
   164) 
   165)   patch%aux%RT => RTAuxCreate(option)
   166)   patch%aux%RT%rt_parameter%ncomp = reaction%ncomp
   167)   patch%aux%RT%rt_parameter%naqcomp = reaction%naqcomp
   168)   patch%aux%RT%rt_parameter%offset_aqueous = reaction%offset_aqueous
   169)   patch%aux%RT%rt_parameter%nimcomp = reaction%nimcomp
   170)   patch%aux%RT%rt_parameter%offset_immobile = reaction%offset_immobile
   171)   if (reaction%ncollcomp > 0) then
   172)     patch%aux%RT%rt_parameter%ncoll = reaction%ncoll
   173)     patch%aux%RT%rt_parameter%offset_colloid  = reaction%offset_colloid 
   174)     patch%aux%RT%rt_parameter%ncollcomp = reaction%ncollcomp
   175)     patch%aux%RT%rt_parameter%offset_collcomp = reaction%offset_collcomp
   176)     allocate(patch%aux%RT%rt_parameter%pri_spec_to_coll_spec(reaction%naqcomp))
   177)     patch%aux%RT%rt_parameter%pri_spec_to_coll_spec = &
   178)       reaction%pri_spec_to_coll_spec
   179)     allocate(patch%aux%RT%rt_parameter%coll_spec_to_pri_spec(reaction%ncollcomp))
   180)     patch%aux%RT%rt_parameter%coll_spec_to_pri_spec = &
   181)       reaction%coll_spec_to_pri_spec
   182)   endif
   183)   if (reaction%nimcomp > 0) then
   184)     patch%aux%RT%rt_parameter%nimcomp = reaction%nimcomp
   185)     patch%aux%RT%rt_parameter%offset_immobile = reaction%offset_immobile
   186)   endif
   187)   
   188)   material_auxvars => patch%aux%Material%auxvars
   189)   flag = 0
   190)   !TODO(geh): change to looping over ghosted ids once the legacy code is 
   191)   !           history and the communicator can be passed down.
   192)   do local_id = 1, grid%nlmax
   193)     ghosted_id = grid%nL2G(local_id)
   194) 
   195)     ! Ignore inactive cells with inactive materials
   196)     if (patch%imat(ghosted_id) <= 0) cycle
   197)     
   198)     if (material_auxvars(ghosted_id)%volume < 0.d0 .and. flag(1) == 0) then
   199)       flag(1) = 1
   200)       option%io_buffer = 'Non-initialized cell volume.'
   201)       call printMsg(option)
   202)     endif
   203)     if (material_auxvars(ghosted_id)%porosity < 0.d0 .and. flag(2) == 0) then
   204)       flag(2) = 1
   205)       option%io_buffer = 'Non-initialized porosity.'
   206)       call printMsg(option)
   207)     endif
   208)     if (material_auxvars(ghosted_id)%tortuosity < 0.d0 .and. flag(3) == 0) then
   209)       flag(3) = 1
   210)       option%io_buffer = 'Non-initialized tortuosity.'
   211)       call printMsg(option)
   212)     endif
   213)     if (reaction%neqkdrxn > 0) then
   214)       if (material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
   215)           flag(4) == 0) then
   216)         flag(4) = 1
   217)         option%io_buffer = 'Non-initialized soil particle density.'
   218)         call printMsg(option)
   219)       endif
   220)     endif
   221)     if (associated(reaction%surface_complexation)) then
   222)       if (associated(reaction%surface_complexation%srfcplxrxn_surf_type)) then
   223)         do i = 1, size(reaction%surface_complexation%srfcplxrxn_surf_type)
   224)           if (reaction%surface_complexation%srfcplxrxn_surf_type(i) == &
   225)               ROCK_SURFACE .and. &
   226)               material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
   227)               flag(4) == 0) then
   228)             flag(4) = 1
   229)             option%io_buffer = 'Non-initialized soil particle density.'
   230)             call printMsg(option)
   231)           endif
   232)         enddo
   233)       endif
   234)     endif
   235)   enddo  
   236)  
   237)   if (maxval(flag) > 0) then
   238)     option%io_buffer = &
   239)       'Material property errors found in RTSetup (reactive transport).'
   240)     call printErrMsg(option)
   241)   endif  
   242)   
   243) !============== Create secondary continuum variables - SK 2/5/13 ===============
   244) 
   245)   
   246)   if (option%use_mc) then
   247)     patch%aux%SC_RT => SecondaryAuxRTCreate(option)
   248)     initial_condition => patch%initial_condition_list%first
   249)     allocate(rt_sec_transport_vars(grid%nlmax))  
   250)     do local_id = 1, grid%nlmax
   251)     ! Assuming the same secondary continuum type for all regions
   252)       call SecondaryRTAuxVarInit(patch%material_property_array(1)%ptr, &
   253)                                  rt_sec_transport_vars(local_id), &
   254)                                  reaction,initial_condition, &
   255)                                  sec_tran_constraint,option)
   256)     enddo      
   257)     patch%aux%SC_RT%sec_transport_vars => rt_sec_transport_vars      
   258)   endif
   259) 
   260) !===============================================================================   
   261) 
   262)     
   263)   ! allocate auxvar data structures for all grid cells
   264) #ifdef COMPUTE_INTERNAL_MASS_FLUX
   265)   option%iflag = 1 ! allocate mass_balance array
   266) #else  
   267)   option%iflag = 0 ! be sure not to allocate mass_balance array
   268) #endif
   269)   allocate(patch%aux%RT%auxvars(grid%ngmax))
   270)   do ghosted_id = 1, grid%ngmax
   271)     call RTAuxVarInit(patch%aux%RT%auxvars(ghosted_id),reaction,option)
   272)   enddo
   273)   patch%aux%RT%num_aux = grid%ngmax
   274)   
   275)   ! count the number of boundary connections and allocate
   276)   ! auxvar data structures for them
   277)   sum_connection = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
   278)   if (sum_connection > 0) then
   279)     option%iflag = 1 ! enable allocation of mass_balance array 
   280)     allocate(patch%aux%RT%auxvars_bc(sum_connection))
   281)     do iconn = 1, sum_connection
   282)       call RTAuxVarInit(patch%aux%RT%auxvars_bc(iconn),reaction,option)
   283)     enddo
   284)   endif
   285)   patch%aux%RT%num_aux_bc = sum_connection
   286) 
   287)   ! count the number of boundary connections and allocate
   288)   ! auxvar data structures for them
   289)   sum_connection = CouplerGetNumConnectionsInList(patch%source_sink_list)
   290)   if (sum_connection > 0) then
   291)     option%iflag = 1 ! enable allocation of mass_balance array 
   292)     allocate(patch%aux%RT%auxvars_ss(sum_connection))
   293)     do iconn = 1, sum_connection
   294)       call RTAuxVarInit(patch%aux%RT%auxvars_ss(iconn),reaction,option)
   295)     enddo
   296)   endif
   297)   patch%aux%RT%num_aux_ss = sum_connection
   298)   option%iflag = 0
   299) 
   300)   ! initialize parameters
   301)   cur_fluid_property => realization%fluid_properties
   302)   do 
   303)     if (.not.associated(cur_fluid_property)) exit
   304)     iphase = cur_fluid_property%phase_id
   305)     patch%aux%RT%rt_parameter%diffusion_coefficient(iphase) = &
   306)       cur_fluid_property%diffusion_coefficient
   307)     patch%aux%RT%rt_parameter%diffusion_activation_energy(iphase) = &
   308)       cur_fluid_property%diffusion_activation_energy
   309)     cur_fluid_property => cur_fluid_property%next
   310)   enddo
   311)  
   312)   list => realization%output_option%output_snap_variable_list
   313)   call RTSetPlotVariables(realization,list)
   314)   if (.not.associated(realization%output_option%output_snap_variable_list, &
   315)                  realization%output_option%output_obs_variable_list)) then
   316)     list => realization%output_option%output_obs_variable_list
   317)     call RTSetPlotVariables(realization,list)
   318)   endif
   319)   
   320) end subroutine RTSetup
   321) 
   322) ! ************************************************************************** !
   323) 
   324) subroutine RTComputeMassBalance(realization,mass_balance)
   325)   ! 
   326)   ! Author: Glenn Hammond
   327)   ! Date: 12/23/08
   328)   ! 
   329) 
   330)   use Realization_Subsurface_class
   331)   use Option_module
   332)   use Patch_module
   333)   use Field_module
   334)   use Grid_module
   335) 
   336)   type(realization_subsurface_type) :: realization
   337)   PetscReal :: mass_balance(realization%option%ntrandof, &
   338)                             realization%option%nphase)
   339)   type(option_type), pointer :: option
   340)   type(patch_type), pointer :: patch
   341)   type(field_type), pointer :: field
   342)   type(grid_type), pointer :: grid
   343)   type(global_auxvar_type), pointer :: global_auxvars(:)
   344)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
   345)   class(material_auxvar_type), pointer :: material_auxvars(:)
   346)   type(reaction_type), pointer :: reaction
   347) 
   348)   PetscErrorCode :: ierr
   349)   PetscInt :: local_id
   350)   PetscInt :: ghosted_id
   351)   PetscInt :: iphase
   352)   PetscInt :: i, icomp, imnrl, ncomp, irate, irxn, naqcomp
   353) 
   354)   iphase = 1
   355)   option => realization%option
   356)   patch => realization%patch
   357)   grid => patch%grid
   358)   field => realization%field
   359) 
   360)   reaction => realization%reaction
   361) 
   362)   rt_auxvars => patch%aux%RT%auxvars
   363)   global_auxvars => patch%aux%Global%auxvars
   364)   material_auxvars => patch%aux%Material%auxvars
   365) 
   366)   mass_balance = 0.d0
   367)   naqcomp = reaction%naqcomp
   368) 
   369)   do local_id = 1, grid%nlmax
   370)     ghosted_id = grid%nL2G(local_id)
   371)     !geh - Ignore inactive cells with inactive materials
   372)     if (patch%imat(ghosted_id) <= 0) cycle
   373)     do iphase = 1, option%nphase
   374)     
   375) !     mass_balance(:,iphase) = mass_balance(:,iphase) + &
   376)       mass_balance(1:naqcomp,1) = &
   377)         mass_balance(1:naqcomp,1) + &
   378)         rt_auxvars(ghosted_id)%total(:,iphase) * &
   379)         global_auxvars(ghosted_id)%sat(iphase) * &
   380)         material_auxvars(ghosted_id)%porosity * &
   381)         material_auxvars(ghosted_id)%volume*1000.d0
   382)         
   383)       if (iphase == 1) then
   384)         ! add contribution of equilibrium sorption
   385)         if (reaction%neqsorb > 0) then
   386)           mass_balance(1:naqcomp,iphase) = mass_balance(1:naqcomp,iphase) + &
   387)             rt_auxvars(ghosted_id)%total_sorb_eq(:) * &
   388)             material_auxvars(ghosted_id)%volume
   389)         endif
   390) 
   391)         ! add contribution of kinetic multirate sorption
   392)         do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
   393)           do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
   394)             mass_balance(1:naqcomp,iphase) = mass_balance(1:naqcomp,iphase) + &
   395)               rt_auxvars(ghosted_id)%kinmr_total_sorb(:,irate,irxn) * &
   396)               material_auxvars(ghosted_id)%volume
   397)           enddo
   398)         enddo
   399) 
   400)         ! add contribution from mineral volume fractions
   401)         do imnrl = 1, reaction%mineral%nkinmnrl
   402)           ncomp = reaction%mineral%kinmnrlspecid(0,imnrl)
   403)           do i = 1, ncomp
   404)             icomp = reaction%mineral%kinmnrlspecid(i,imnrl)
   405)             mass_balance(icomp,iphase) = mass_balance(icomp,iphase) &
   406)             + reaction%mineral%kinmnrlstoich(i,imnrl) &
   407)             * rt_auxvars(ghosted_id)%mnrl_volfrac(imnrl) &
   408)             * material_auxvars(ghosted_id)%volume &
   409)             / reaction%mineral%kinmnrl_molar_vol(imnrl)
   410)           enddo
   411)         enddo
   412) 
   413)         ! add contribution of immobile mass (still considered aqueous phase)
   414)         do i = 1, reaction%nimcomp
   415)           mass_balance(reaction%offset_immobile+i,iphase) = &
   416)             mass_balance(reaction%offset_immobile+i,iphase) + &
   417)             rt_auxvars(ghosted_id)%immobile(i) * &
   418)             material_auxvars(ghosted_id)%volume
   419)         enddo
   420)       endif
   421)     enddo
   422)   enddo
   423) 
   424) end subroutine RTComputeMassBalance
   425) 
   426) ! ************************************************************************** !
   427) 
   428) subroutine RTZeroMassBalanceDelta(realization)
   429)   ! 
   430)   ! Zeros mass balance delta array
   431)   ! 
   432)   ! Author: Glenn Hammond
   433)   ! Date: 12/19/08
   434)   ! 
   435)  
   436)   use Realization_Subsurface_class
   437)   use Option_module
   438)   use Patch_module
   439)   use Grid_module
   440)  
   441)   implicit none
   442)   
   443)   type(realization_subsurface_type) :: realization
   444) 
   445)   type(option_type), pointer :: option
   446)   type(patch_type), pointer :: patch
   447)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
   448)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
   449) 
   450)   PetscInt :: iconn
   451) 
   452)   option => realization%option
   453)   patch => realization%patch
   454) 
   455)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
   456)   rt_auxvars_ss => patch%aux%RT%auxvars_ss
   457) 
   458) #ifdef COMPUTE_INTERNAL_MASS_FLUX
   459)   do iconn = 1, patch%aux%RT%num_aux
   460)     patch%aux%RT%auxvars(iconn)%mass_balance_delta = 0.d0
   461)   enddo
   462) #endif
   463) 
   464)   do iconn = 1, patch%aux%RT%num_aux_bc
   465)     rt_auxvars_bc(iconn)%mass_balance_delta = 0.d0
   466)   enddo
   467) 
   468)   do iconn = 1, patch%aux%RT%num_aux_ss
   469)     rt_auxvars_ss(iconn)%mass_balance_delta = 0.d0
   470)   enddo
   471) 
   472) end subroutine RTZeroMassBalanceDelta
   473) 
   474) ! ************************************************************************** !
   475) 
   476) subroutine RTUpdateMassBalance(realization)
   477)   ! 
   478)   ! Updates mass balance
   479)   ! 
   480)   ! Author: Glenn Hammond
   481)   ! Date: 12/19/08
   482)   ! 
   483)  
   484)   use Realization_Subsurface_class
   485)   use Option_module
   486)   use Patch_module
   487)   use Grid_module
   488)  
   489)   implicit none
   490)   
   491)   type(realization_subsurface_type) :: realization
   492) 
   493)   type(option_type), pointer :: option
   494)   type(patch_type), pointer :: patch
   495)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
   496)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
   497) 
   498)   PetscInt :: iconn
   499) 
   500)   option => realization%option
   501)   patch => realization%patch
   502) 
   503)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
   504)   rt_auxvars_ss => patch%aux%RT%auxvars_ss
   505) 
   506) #ifdef COMPUTE_INTERNAL_MASS_FLUX
   507)   do iconn = 1, patch%aux%RT%num_aux
   508)     patch%aux%RT%auxvars(iconn)%mass_balance = &
   509)       patch%aux%RT%auxvars(iconn)%mass_balance + &
   510)       patch%aux%RT%auxvars(iconn)%mass_balance_delta*option%tran_dt
   511)   enddo
   512) #endif
   513) 
   514)   do iconn = 1, patch%aux%RT%num_aux_bc
   515)     rt_auxvars_bc(iconn)%mass_balance = &
   516)       rt_auxvars_bc(iconn)%mass_balance + &
   517)       rt_auxvars_bc(iconn)%mass_balance_delta*option%tran_dt
   518)   enddo
   519) 
   520)   do iconn = 1, patch%aux%RT%num_aux_ss
   521)     rt_auxvars_ss(iconn)%mass_balance = &
   522)       rt_auxvars_ss(iconn)%mass_balance + &
   523)       rt_auxvars_ss(iconn)%mass_balance_delta*option%tran_dt
   524)   enddo
   525) 
   526) end subroutine RTUpdateMassBalance
   527) 
   528) ! ************************************************************************** !
   529) 
   530) subroutine RTInitializeTimestep(realization)
   531)   ! 
   532)   ! Author: Glenn Hammond
   533)   ! Date: 02/22/08
   534)   ! 
   535) 
   536)   use Realization_Subsurface_class
   537) 
   538)   type(realization_subsurface_type) :: realization
   539)   
   540)   call RTUpdateFixedAccumulation(realization)
   541)   ! geh: never use transport coefs evaluated at time k
   542) !  call RTUpdateTransportCoefs(realization)
   543) 
   544) end subroutine RTInitializeTimestep
   545) 
   546) ! ************************************************************************** !
   547) 
   548) subroutine RTUpdateEquilibriumState(realization)
   549)   ! 
   550)   ! Updates equilibrium state variables after a
   551)   ! successful time step
   552)   ! 
   553)   ! Author: Glenn Hammond
   554)   ! Date: 09/04/08
   555)   ! 
   556) 
   557)   use Realization_Subsurface_class
   558)   use Discretization_module
   559)   use Patch_module
   560)   use Option_module
   561)   use Grid_module
   562)   use Reaction_module
   563)   !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
   564)   !      resolves a bug in the Intel Visual Fortran compiler.
   565)   use Secondary_Continuum_Aux_module, only : sec_transport_type
   566)   use Secondary_Continuum_module, only : SecondaryRTUpdateEquilState
   567)  
   568)   implicit none
   569) 
   570)   type(realization_subsurface_type) :: realization
   571) 
   572)   type(patch_type), pointer :: patch
   573)   type(option_type), pointer :: option
   574)   type(reaction_type), pointer :: reaction
   575)   type(grid_type), pointer :: grid
   576)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
   577)   type(global_auxvar_type), pointer :: global_auxvars(:)  
   578)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
   579)   PetscInt :: ghosted_id, local_id
   580)   PetscReal :: conc, max_conc, min_conc
   581)   PetscErrorCode :: ierr
   582)   
   583)   option => realization%option
   584)   patch => realization%patch
   585)   reaction => realization%reaction
   586)   grid => patch%grid
   587) 
   588)   call VecCopy(realization%field%tran_xx,realization%field%tran_yy, &
   589)                ierr);CHKERRQ(ierr)
   590)   call DiscretizationGlobalToLocal(realization%discretization, &
   591)                                    realization%field%tran_xx, &
   592)                                    realization%field%tran_xx_loc,NTRANDOF)
   593)   
   594)   rt_auxvars => patch%aux%RT%auxvars
   595)   global_auxvars => patch%aux%Global%auxvars
   596) 
   597)   ! update:                             cells      bcs         act. coefs.
   598)   call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_FALSE,PETSC_FALSE)
   599) 
   600) !geh: for debugging max/min concentrations
   601) #if 0
   602)   max_conc = -1.d20
   603)   min_conc = 1.d20
   604)   do local_id = 1, grid%nlmax
   605)     ghosted_id = grid%nL2G(local_id)
   606)     conc = rt_auxvars(ghosted_id)%total(1,1)
   607)     max_conc = max(conc,max_conc)
   608)     min_conc = min(conc,min_conc)
   609)   enddo
   610)   call MPI_Allreduce(max_conc,conc,ONE_INTEGER_MPI, &
   611)                      MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
   612)   max_conc = conc
   613)   call MPI_Allreduce(min_conc,conc,ONE_INTEGER_MPI, &
   614)                      MPI_DOUBLE_PRECISION,MPI_MIN,option%mycomm,ierr)
   615)   min_conc = conc
   616)   if (option%print_screen_flag) then
   617)     write(*,'("Time: ",1pe12.5," Max: ",1pe12.5," Min: ",1pe12.5)') &
   618)       option%tran_time/realization%output_option%tconv,max_conc, min_conc
   619)   endif
   620) #endif
   621) 
   622)   ! update secondary continuum variables
   623)   if (option%use_mc) then
   624)     rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
   625)     do local_id = 1, grid%nlmax
   626)       ghosted_id = grid%nL2G(local_id)
   627)       if (patch%imat(ghosted_id) <= 0) cycle
   628)         call SecondaryRTUpdateEquilState(rt_sec_transport_vars(local_id), &
   629)                                           global_auxvars(ghosted_id), &
   630)                                           reaction,option)                     
   631)     enddo
   632)   endif
   633)   
   634) end subroutine RTUpdateEquilibriumState
   635) 
   636) ! ************************************************************************** !
   637) 
   638) subroutine RTUpdateKineticState(realization)
   639)   ! 
   640)   ! Updates kinetic state variables for reactive
   641)   ! transport
   642)   ! 
   643)   ! Author: Glenn Hammond
   644)   ! Date: 06/27/13
   645)   ! 
   646) 
   647)   use Realization_Subsurface_class
   648)   use Discretization_module
   649)   use Patch_module
   650)   use Option_module
   651)   use Grid_module
   652)   use Reaction_module
   653)   !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
   654)   !      resolves a bug in the Intel Visual Fortran compiler.
   655)   use Secondary_Continuum_Aux_module, only : sec_transport_type
   656)   use Secondary_Continuum_module, only : SecondaryRTUpdateKineticState
   657)  
   658)   implicit none
   659) 
   660)   type(realization_subsurface_type) :: realization
   661) 
   662)   type(patch_type), pointer :: patch
   663)   type(option_type), pointer :: option
   664)   type(reaction_type), pointer :: reaction
   665)   type(grid_type), pointer :: grid
   666)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
   667)   type(global_auxvar_type), pointer :: global_auxvars(:)  
   668)   class(material_auxvar_type), pointer :: material_auxvars(:)
   669)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
   670)   PetscInt :: ghosted_id, local_id
   671)   PetscReal :: conc, max_conc, min_conc
   672)   PetscErrorCode :: ierr
   673)   PetscReal :: sec_porosity
   674)   
   675)   option => realization%option
   676)   patch => realization%patch
   677)   reaction => realization%reaction
   678)   grid => patch%grid
   679) 
   680)   rt_auxvars => patch%aux%RT%auxvars
   681)   global_auxvars => patch%aux%Global%auxvars
   682)   material_auxvars => patch%aux%Material%auxvars
   683) 
   684)   ! update mineral volume fractions, multirate sorption concentrations, 
   685)   ! kinetic sorption concentration etc.  These updates must take place
   686)   ! within reaction so that auxiliary variables are updated when only
   687)   ! run in reaction mode.
   688)   do local_id = 1, grid%nlmax
   689)     ghosted_id = grid%nL2G(local_id)
   690)     if (patch%imat(ghosted_id) <= 0) cycle
   691) 
   692)     if (.not.option%use_isothermal) then
   693)       call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
   694)                                     PETSC_FALSE,option)
   695)     endif
   696) 
   697)     call RUpdateKineticState(rt_auxvars(ghosted_id), &
   698)                              global_auxvars(ghosted_id), &
   699)                              material_auxvars(ghosted_id), &
   700)                              reaction,option)
   701)   enddo
   702)   
   703)   ! update secondary continuum variables
   704)   if (option%use_mc) then
   705)     rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
   706)     do local_id = 1, grid%nlmax
   707)       ghosted_id = grid%nL2G(local_id)
   708)       if (patch%imat(ghosted_id) <= 0) cycle
   709)         sec_porosity = patch%material_property_array(1)%ptr% &
   710)                         secondary_continuum_porosity
   711) 
   712)         call SecondaryRTUpdateKineticState(rt_sec_transport_vars(local_id), &
   713)                                            global_auxvars(ghosted_id), &
   714)                                            reaction,sec_porosity,option)                     
   715)     enddo
   716)   endif
   717)   
   718) end subroutine RTUpdateKineticState
   719) 
   720) ! ************************************************************************** !
   721) 
   722) subroutine RTUpdateFixedAccumulation(realization)
   723)   ! 
   724)   ! Computes derivative of accumulation term in
   725)   ! residual function
   726)   ! 
   727)   ! Author: Glenn Hammond
   728)   ! Date: 02/15/08
   729)   ! 
   730) 
   731)   use Realization_Subsurface_class
   732)   use Patch_module
   733)   use Reactive_Transport_Aux_module
   734)   use Option_module
   735)   use Field_module  
   736)   use Grid_module
   737)   use Secondary_Continuum_Aux_module  
   738) 
   739)   implicit none
   740)   
   741)   type(realization_subsurface_type) :: realization
   742)   
   743)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
   744)   type(global_auxvar_type), pointer :: global_auxvars(:)
   745)   class(material_auxvar_type), pointer :: material_auxvars(:)  
   746)   type(option_type), pointer :: option
   747)   type(patch_type), pointer :: patch
   748)   type(grid_type), pointer :: grid
   749)   type(field_type), pointer :: field
   750)   type(reaction_type), pointer :: reaction
   751)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
   752)   PetscReal, pointer :: xx_p(:), accum_p(:)
   753)   PetscInt :: local_id, ghosted_id
   754)   PetscInt :: dof_offset, istart, iendaq, iendall
   755)   PetscInt :: istartim, iendim
   756)   PetscInt :: istartcoll, iendcoll
   757)   PetscErrorCode :: ierr
   758)   PetscReal :: vol_frac_prim
   759)   
   760)   option => realization%option
   761)   field => realization%field
   762)   patch => realization%patch
   763)   rt_auxvars => patch%aux%RT%auxvars
   764)   global_auxvars => patch%aux%Global%auxvars
   765)   material_auxvars => patch%aux%Material%auxvars
   766)   
   767)   grid => patch%grid
   768)   reaction => realization%reaction
   769)   if (option%use_mc) then
   770)     rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
   771)   endif
   772) 
   773)   ! cannot use tran_xx_loc vector here as it has not yet been updated.
   774)   call VecGetArrayReadF90(field%tran_xx,xx_p, ierr);CHKERRQ(ierr)
   775) 
   776)   call VecGetArrayF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
   777)   
   778)   vol_frac_prim = 1.d0
   779)   
   780) ! Do not use RTUpdateAuxVars() as it loops over ghosted ids
   781) 
   782)   do local_id = 1, grid%nlmax
   783)     ghosted_id = grid%nL2G(local_id)
   784)     !geh - Ignore inactive cells with inactive materials
   785)     if (patch%imat(ghosted_id) <= 0) cycle
   786)     
   787)     ! compute offset in solution vector for first dof in grid cell
   788)     dof_offset = (local_id-1)*reaction%ncomp
   789)     
   790)     ! calculate range of aqueous species
   791)     istart = dof_offset + 1
   792)     iendaq = dof_offset + reaction%naqcomp
   793)     iendall = dof_offset + reaction%ncomp
   794) 
   795)     ! copy primary aqueous species
   796)     rt_auxvars(ghosted_id)%pri_molal = xx_p(istart:iendaq)
   797)     
   798)     if (reaction%ncoll > 0) then
   799)       istartcoll = dof_offset + reaction%offset_colloid + 1
   800)       iendcoll = dof_offset + reaction%offset_colloid + reaction%ncoll
   801)       rt_auxvars(ghosted_id)%colloid%conc_mob = xx_p(istartcoll:iendcoll)* &
   802)         global_auxvars(ghosted_id)%den_kg(1)*1.d-3
   803)     endif
   804)     
   805)     if (reaction%nimcomp > 0) then
   806)       istartim = dof_offset + reaction%offset_immobile + 1
   807)       iendim = dof_offset + reaction%offset_immobile + reaction%nimcomp
   808)       rt_auxvars(ghosted_id)%immobile = xx_p(istartim:iendim)
   809)     endif
   810) 
   811)     if (.not.option%use_isothermal) then
   812)       call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
   813)                                      PETSC_FALSE,option)
   814)     endif
   815)     
   816)     ! DO NOT RECOMPUTE THE ACTIVITY COEFFICIENTS BEFORE COMPUTING THE
   817)     ! FIXED PORTION OF THE ACCUMULATION TERM - geh
   818)     call RTAuxVarCompute(rt_auxvars(ghosted_id), &
   819)                          global_auxvars(ghosted_id), &
   820)                          material_auxvars(ghosted_id), &
   821)                          reaction,option)
   822)     call RTAccumulation(rt_auxvars(ghosted_id), &
   823)                         global_auxvars(ghosted_id), &
   824)                         material_auxvars(ghosted_id), &
   825)                         reaction,option, &
   826)                         accum_p(istart:iendall)) 
   827)     if (reaction%neqsorb > 0) then
   828)       call RAccumulationSorb(rt_auxvars(ghosted_id), &
   829)                              global_auxvars(ghosted_id), &
   830)                              material_auxvars(ghosted_id), &
   831)                              reaction,option,accum_p(istart:iendall))
   832)     endif
   833)         
   834)     if (option%use_mc) then
   835)       vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
   836)       accum_p(istart:iendall) = accum_p(istart:iendall)*vol_frac_prim
   837)     endif
   838)     
   839)   enddo
   840) 
   841)   call VecRestoreArrayReadF90(field%tran_xx,xx_p, ierr);CHKERRQ(ierr)
   842)   call VecRestoreArrayF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
   843) 
   844) end subroutine RTUpdateFixedAccumulation
   845) 
   846) ! ************************************************************************** !
   847) 
   848) subroutine RTUpdateTransportCoefs(realization)
   849)   ! 
   850)   ! Calculates coefficients for transport matrix
   851)   ! 
   852)   ! Author: Glenn Hammond
   853)   ! Date: 02/24/10
   854)   ! 
   855) 
   856)   use Realization_Subsurface_class
   857)   use Discretization_module
   858)   use Patch_module
   859)   use Connection_module
   860)   use Coupler_module
   861)   use Option_module
   862)   use Field_module  
   863)   use Grid_module  
   864) 
   865)   implicit none
   866)   
   867)   type(realization_subsurface_type) :: realization
   868)   
   869)   type(global_auxvar_type), pointer :: global_auxvars(:)
   870)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
   871)   class(material_auxvar_type), pointer :: material_auxvars(:)
   872)   type(option_type), pointer :: option
   873)   type(patch_type), pointer :: patch
   874)   type(grid_type), pointer :: grid
   875)   type(field_type), pointer :: field
   876)   type(reactive_transport_param_type), pointer :: rt_parameter
   877)   PetscInt :: local_id, ghosted_id, ghosted_face_id, id
   878)   
   879)   type(coupler_type), pointer :: boundary_condition
   880)   type(connection_set_list_type), pointer :: connection_set_list
   881)   type(connection_set_type), pointer :: cur_connection_set  
   882)   PetscInt :: sum_connection, iconn, num_connections
   883)   PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
   884)   PetscReal, allocatable :: cell_centered_Darcy_velocities(:,:)
   885)   PetscReal, allocatable :: cell_centered_Darcy_velocities_ghosted(:,:)
   886)   PetscReal, pointer :: vec_ptr(:)
   887)   PetscInt :: i
   888)   PetscErrorCode :: ierr
   889)     
   890)   option => realization%option
   891)   field => realization%field
   892)   patch => realization%patch
   893)   global_auxvars => patch%aux%Global%auxvars
   894)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   895)   material_auxvars => patch%aux%Material%auxvars
   896)   grid => patch%grid
   897)   rt_parameter => patch%aux%RT%rt_parameter
   898) 
   899)   allocate(cell_centered_Darcy_velocities_ghosted(3,patch%grid%ngmax))
   900)   if (patch%material_property_array(1)%ptr%dispersivity(2) > 0.d0) then
   901)     allocate(cell_centered_Darcy_velocities(3,patch%grid%nlmax))
   902)     call PatchGetCellCenteredVelocities(patch,LIQUID_PHASE, &
   903)                                         cell_centered_Darcy_velocities)
   904)     ! at this point, velocities are at local cell centers; we need ghosted too.
   905)     do i=1,3
   906)       call VecGetArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
   907)       vec_ptr(:) = cell_centered_Darcy_velocities(i,:)
   908)       call VecRestoreArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
   909)       call DiscretizationGlobalToLocal(realization%discretization,field%work, &
   910)                                        field%work_loc,ONEDOF)
   911)       call VecGetArrayF90(field%work_loc,vec_ptr,ierr);CHKERRQ(ierr)
   912)       cell_centered_Darcy_velocities_ghosted(i,:) = vec_ptr(:)
   913)       call VecRestoreArrayF90(field%work_loc,vec_ptr,ierr);CHKERRQ(ierr)
   914)     enddo
   915)     deallocate(cell_centered_Darcy_velocities)
   916)   else
   917)     cell_centered_Darcy_velocities_ghosted = 0.d0
   918)   endif
   919)   
   920)   ! Interior Flux Terms -----------------------------------
   921)   connection_set_list => grid%internal_connection_set_list
   922)   cur_connection_set => connection_set_list%first
   923)   sum_connection = 0  
   924)   do 
   925)     if (.not.associated(cur_connection_set)) exit
   926)     do iconn = 1, cur_connection_set%num_connections
   927)       sum_connection = sum_connection + 1
   928) 
   929)       ghosted_id_up = cur_connection_set%id_up(iconn)
   930)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
   931) 
   932)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
   933)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
   934) 
   935)       if (patch%imat(ghosted_id_up) <= 0 .or.  &
   936)           patch%imat(ghosted_id_dn) <= 0) cycle
   937) 
   938)       call TDispersion(global_auxvars(ghosted_id_up), &
   939)                       material_auxvars(ghosted_id_up), &
   940)                       cell_centered_Darcy_velocities_ghosted(:,ghosted_id_up), &
   941)                       patch%material_property_array(patch%imat(ghosted_id_up))% &
   942)                         ptr%dispersivity, &
   943)                       global_auxvars(ghosted_id_dn), &
   944)                       material_auxvars(ghosted_id_dn), &
   945)                       cell_centered_Darcy_velocities_ghosted(:,ghosted_id_dn), &
   946)                       patch%material_property_array(patch%imat(ghosted_id_dn))% &
   947)                         ptr%dispersivity, &
   948)                       cur_connection_set%dist(:,iconn), &
   949)                       rt_parameter,option, &
   950)                       patch%internal_velocities(:,sum_connection), &
   951)                       patch%internal_tran_coefs(:,sum_connection))
   952)                                            
   953)     enddo
   954)     cur_connection_set => cur_connection_set%next
   955)   enddo    
   956)   
   957) ! Boundary Flux Terms -----------------------------------
   958)   boundary_condition => patch%boundary_condition_list%first
   959)   sum_connection = 0    
   960)   do 
   961)     if (.not.associated(boundary_condition)) exit
   962)  
   963)     cur_connection_set => boundary_condition%connection_set
   964)     num_connections = cur_connection_set%num_connections
   965)     do iconn = 1, num_connections
   966)       sum_connection = sum_connection + 1
   967)   
   968)       local_id = cur_connection_set%id_dn(iconn)
   969)       ghosted_id = grid%nL2G(local_id)
   970)       if (patch%imat(ghosted_id) <= 0) cycle
   971) 
   972)       call TDispersionBC(boundary_condition%tran_condition%itype, &
   973)                         global_auxvars_bc(sum_connection), &
   974)                         global_auxvars(ghosted_id), &
   975)                         material_auxvars(ghosted_id), &
   976)                         cell_centered_Darcy_velocities_ghosted(:,ghosted_id), &
   977)                         patch%material_property_array(patch%imat(ghosted_id))% &
   978)                           ptr%dispersivity, &
   979)                         cur_connection_set%dist(:,iconn), &
   980)                         rt_parameter,option, &
   981)                         patch%boundary_velocities(:,sum_connection), &
   982)                         patch%boundary_tran_coefs(:,sum_connection))
   983)     enddo
   984)     boundary_condition => boundary_condition%next
   985)   enddo
   986)   
   987)   if (allocated(cell_centered_Darcy_velocities_ghosted)) &
   988)     deallocate(cell_centered_Darcy_velocities_ghosted)
   989) 
   990) end subroutine RTUpdateTransportCoefs
   991) 
   992) ! ************************************************************************** !
   993) 
   994) subroutine RTUpdateRHSCoefs(realization)
   995)   ! 
   996)   ! Updates coefficients for the right hand side of
   997)   ! linear transport equation
   998)   ! 
   999)   ! Author: Glenn Hammond
  1000)   ! Date: 04/25/10
  1001)   ! 
  1002) 
  1003)   use Realization_Subsurface_class
  1004)   use Patch_module
  1005)   use Connection_module
  1006)   use Coupler_module
  1007)   use Option_module
  1008)   use Field_module  
  1009)   use Grid_module  
  1010) 
  1011)   implicit none
  1012)   
  1013)   type(realization_subsurface_type) :: realization
  1014)   
  1015)   type(global_auxvar_type), pointer :: global_auxvars(:)
  1016)   class(material_auxvar_type), pointer :: material_auxvars(:)
  1017)   type(option_type), pointer :: option
  1018)   type(patch_type), pointer :: patch
  1019)   type(grid_type), pointer :: grid
  1020)   type(field_type), pointer :: field
  1021)   PetscReal, pointer :: rhs_coef_p(:)
  1022)   PetscInt :: local_id, ghosted_id
  1023)   PetscInt :: iphase
  1024)   PetscErrorCode :: ierr
  1025)     
  1026)   option => realization%option
  1027)   field => realization%field
  1028)   patch => realization%patch
  1029)   global_auxvars => patch%aux%Global%auxvars
  1030)   material_auxvars => patch%aux%Material%auxvars
  1031)   grid => patch%grid
  1032) 
  1033)   ! Get vectors
  1034)   call VecGetArrayF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
  1035) 
  1036)   iphase = 1
  1037)   do local_id = 1, grid%nlmax
  1038)     ghosted_id = grid%nL2G(local_id)
  1039)     if (patch%imat(ghosted_id) <= 0) cycle
  1040)     rhs_coef_p(local_id) = material_auxvars(ghosted_id)%porosity* &
  1041)                            global_auxvars(ghosted_id)%sat(iphase)* &
  1042) ! total already has den_kg within 
  1043) !                           global_auxvars(ghosted_id)%den_kg(iphase)* &
  1044)                            1000.d0* &
  1045)                            material_auxvars(ghosted_id)%volume/option%tran_dt
  1046)   enddo
  1047) 
  1048)   ! Restore vectors
  1049)   call VecRestoreArrayF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
  1050) 
  1051) end subroutine RTUpdateRHSCoefs
  1052) 
  1053) ! ************************************************************************** !
  1054) 
  1055) subroutine RTCalculateRHS_t0(realization)
  1056)   ! 
  1057)   ! Calculate porition of RHS of transport system
  1058)   ! at time t0 or time level k
  1059)   ! 
  1060)   ! Author: Glenn Hammond
  1061)   ! Date: 04/25/10
  1062)   ! 
  1063) 
  1064)   use Realization_Subsurface_class
  1065)   use Patch_module
  1066)   use Connection_module
  1067)   use Coupler_module
  1068)   use Option_module
  1069)   use Field_module  
  1070)   use Grid_module  
  1071) 
  1072)   implicit none
  1073)   
  1074)   type(realization_subsurface_type) :: realization
  1075)   
  1076)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  1077)   type(option_type), pointer :: option
  1078)   type(patch_type), pointer :: patch
  1079)   type(grid_type), pointer :: grid
  1080)   type(field_type), pointer :: field
  1081)   type(reaction_type), pointer :: reaction
  1082)   PetscReal, pointer :: rhs_coef_p(:)
  1083)   PetscReal, pointer :: rhs_p(:)
  1084)   PetscInt :: local_id, ghosted_id
  1085)   PetscInt :: iphase
  1086)   PetscInt :: istartaq, iendaq
  1087) 
  1088)   PetscErrorCode :: ierr
  1089)     
  1090)   option => realization%option
  1091)   field => realization%field
  1092)   patch => realization%patch
  1093)   rt_auxvars => patch%aux%RT%auxvars
  1094)   grid => patch%grid
  1095)   reaction => realization%reaction
  1096) 
  1097)   ! Get vectors
  1098)   call VecGetArrayReadF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
  1099)   call VecGetArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
  1100) 
  1101)   iphase = 1
  1102)   do local_id = 1, grid%nlmax
  1103)     ghosted_id = grid%nL2G(local_id)
  1104)     if (patch%imat(ghosted_id) <= 0) cycle    
  1105)     iendaq = local_id*reaction%naqcomp
  1106)     istartaq = iendaq-reaction%naqcomp+1
  1107)     rhs_p(istartaq:iendaq) = rt_auxvars(ghosted_id)%total(:,iphase)* &
  1108)                              rhs_coef_p(local_id)
  1109)   enddo
  1110) 
  1111)   ! Restore vectors
  1112)   call VecRestoreArrayReadF90(field%tran_rhs_coef,rhs_coef_p, &
  1113)                               ierr);CHKERRQ(ierr)
  1114)   call VecRestoreArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
  1115) 
  1116) end subroutine RTCalculateRHS_t0
  1117) 
  1118) ! ************************************************************************** !
  1119) 
  1120) subroutine RTCalculateRHS_t1(realization)
  1121)   ! 
  1122)   ! Calculate porition of RHS of transport system
  1123)   ! at time level k+1
  1124)   ! 
  1125)   ! Author: Glenn Hammond
  1126)   ! Date: 04/25/10
  1127)   ! 
  1128) 
  1129)   use Realization_Subsurface_class
  1130)   use Patch_module
  1131)   use Connection_module
  1132)   use Coupler_module
  1133)   use Option_module
  1134)   use Field_module  
  1135)   use Grid_module
  1136) 
  1137)   implicit none
  1138)   
  1139)   type(realization_subsurface_type) :: realization
  1140)   
  1141)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  1142)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
  1143)   type(global_auxvar_type), pointer :: global_auxvars(:)
  1144)   type(option_type), pointer :: option
  1145)   type(patch_type), pointer :: patch
  1146)   type(grid_type), pointer :: grid
  1147)   type(field_type), pointer :: field
  1148)   type(reaction_type), pointer :: reaction
  1149)   PetscReal, pointer :: rhs_p(:)
  1150)   PetscInt :: local_id, ghosted_id
  1151)   PetscInt :: iphase
  1152)   PetscReal :: coef_up(1), coef_dn(1)
  1153)   PetscReal :: msrc(2)
  1154)   PetscReal :: Res(realization%reaction%naqcomp)
  1155)   PetscInt :: istartaq, iendaq
  1156) 
  1157)   type(coupler_type), pointer :: boundary_condition
  1158)   type(connection_set_list_type), pointer :: connection_set_list
  1159)   type(connection_set_type), pointer :: cur_connection_set
  1160)   type(coupler_type), pointer :: source_sink
  1161)   PetscInt :: sum_connection, iconn  
  1162)   PetscReal :: qsrc
  1163)   PetscInt :: offset, istartcoll, iendcoll, istartall, iendall, icomp, ieqgas
  1164)   PetscBool :: volumetric
  1165)   PetscInt :: flow_src_sink_type
  1166)   PetscReal :: coef_in, coef_out
  1167)   PetscErrorCode :: ierr
  1168)     
  1169)   option => realization%option
  1170)   field => realization%field
  1171)   patch => realization%patch
  1172)   rt_auxvars => patch%aux%RT%auxvars
  1173)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
  1174)   global_auxvars => patch%aux%Global%auxvars
  1175)   grid => patch%grid
  1176)   reaction => realization%reaction
  1177) 
  1178)   iphase = 1
  1179) 
  1180) !geh - activity coef updates must always be off!!!
  1181) !geh    ! update:                             cells      bcs        act. coefs.
  1182) !  call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
  1183)   if (reaction%act_coef_update_frequency /= ACT_COEF_FREQUENCY_OFF) then
  1184)     call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_TRUE)
  1185)   else
  1186)     call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
  1187)   endif
  1188) 
  1189)   ! Get vectors
  1190)   call VecGetArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
  1191) 
  1192)   ! add in inflowing boundary conditions
  1193)   ! Boundary Flux Terms -----------------------------------
  1194)   boundary_condition => patch%boundary_condition_list%first
  1195)   sum_connection = 0    
  1196)   do 
  1197)     if (.not.associated(boundary_condition)) exit
  1198)   
  1199)     cur_connection_set => boundary_condition%connection_set
  1200)   
  1201)     do iconn = 1, cur_connection_set%num_connections
  1202)       sum_connection = sum_connection + 1
  1203)   
  1204)       local_id = cur_connection_set%id_dn(iconn)
  1205)       ghosted_id = grid%nL2G(local_id)
  1206) 
  1207)       if (patch%imat(ghosted_id) <= 0) cycle
  1208) 
  1209)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  1210)                      patch%boundary_velocities(:,sum_connection), &
  1211)                      patch%boundary_tran_coefs(:,sum_connection), &
  1212)                      0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
  1213)                      coef_up,coef_dn)
  1214) 
  1215)       ! coef_dn not needed 
  1216)       iendaq = local_id*reaction%naqcomp
  1217)       istartaq = iendaq-reaction%naqcomp+1
  1218)       
  1219)       rhs_p(istartaq:iendaq) = rhs_p(istartaq:iendaq) + &
  1220)         coef_up(iphase)*rt_auxvars_bc(sum_connection)%total(:,iphase)
  1221) 
  1222)     enddo
  1223)     boundary_condition => boundary_condition%next
  1224)   enddo  
  1225) 
  1226)   ! add in inflowing sources
  1227) #if 1
  1228)   ! Source/sink terms -------------------------------------
  1229)   source_sink => patch%source_sink_list%first
  1230)   sum_connection = 0
  1231)   do 
  1232)     if (.not.associated(source_sink)) exit
  1233)     
  1234)     cur_connection_set => source_sink%connection_set
  1235)     
  1236)     qsrc = 0.d0
  1237)     flow_src_sink_type = 0
  1238)     if (associated(source_sink%flow_condition) .and. &
  1239)         associated(source_sink%flow_condition%rate)) then
  1240)       qsrc = source_sink%flow_condition%rate%dataset%rarray(1)
  1241)       flow_src_sink_type = source_sink%flow_condition%rate%itype
  1242)     endif
  1243)     
  1244)     ! only handle injection on rhs
  1245)     if (qsrc < 0.d0) then
  1246)       source_sink => source_sink%next
  1247)       cycle
  1248)     endif
  1249)     
  1250)     do iconn = 1, cur_connection_set%num_connections
  1251)       sum_connection = sum_connection + 1
  1252)       local_id = cur_connection_set%id_dn(iconn)
  1253)       ghosted_id = grid%nL2G(local_id)
  1254) 
  1255)       offset = (local_id-1)*reaction%ncomp
  1256) 
  1257)       if (patch%imat(ghosted_id) <= 0) cycle
  1258)       
  1259)       istartaq = reaction%offset_aqueous + 1
  1260)       iendaq = reaction%offset_aqueous + reaction%naqcomp
  1261)       
  1262)       if (reaction%ncoll > 0) then
  1263)         istartcoll = reaction%offset_colloid + 1
  1264)         iendcoll = reaction%offset_colloid + reaction%ncoll
  1265)       endif
  1266) 
  1267)       qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
  1268)       call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
  1269)                         coef_in,coef_out)      
  1270) 
  1271)       Res(istartaq:iendaq) = & !coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
  1272)                              coef_out*source_sink%tran_condition%cur_constraint_coupler% &
  1273)                                         rt_auxvar%total(:,iphase)
  1274)       if (reaction%ncoll > 0) then
  1275)         Res(istartcoll:iendcoll) = & !coef_in*rt_auxvars(ghosted_id)%colloid%conc_mob(:) !+ &
  1276)                                    coef_out*source_sink%tran_condition%cur_constraint_coupler% &
  1277)                                               rt_auxvar%colloid%conc_mob(:)
  1278)       endif
  1279)       istartall = offset + 1
  1280)       iendall = offset + reaction%ncomp
  1281)       ! subtract since the contribution is on the rhs
  1282)       rhs_p(istartall:iendall) = rhs_p(istartall:iendall) - Res(1:reaction%ncomp)                                  
  1283)     enddo
  1284)     source_sink => source_sink%next
  1285)   enddo
  1286) 
  1287)   ! CO2-specific
  1288)   select case(option%iflowmode)
  1289)     case(MPH_MODE,IMS_MODE,FLASH2_MODE)
  1290)       source_sink => patch%source_sink_list%first 
  1291)       do 
  1292)         if (.not.associated(source_sink)) exit
  1293) 
  1294) !geh begin change
  1295) !geh        msrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
  1296)         msrc(:) = source_sink%flow_condition%rate%dataset%rarray(:)
  1297) !geh end change
  1298)         msrc(1) =  msrc(1) / FMWH2O*1D3
  1299)         msrc(2) =  msrc(2) / FMWCO2*1D3
  1300)         ! print *,'RT SC source'
  1301)         do iconn = 1, cur_connection_set%num_connections      
  1302)           local_id = cur_connection_set%id_dn(iconn)
  1303)           ghosted_id = grid%nL2G(local_id)
  1304)           Res=0D0
  1305)           
  1306)           if (patch%imat(ghosted_id) <= 0) cycle
  1307)           
  1308)           select case(source_sink%flow_condition%itype(1))
  1309)             case(MASS_RATE_SS)
  1310)               do ieqgas = 1, reaction%ngas
  1311)                 if (abs(reaction%species_idx%co2_gas_id) == ieqgas) then
  1312)                   icomp = reaction%eqgasspecid(1,ieqgas)
  1313)                   iendall = local_id*reaction%ncomp
  1314)                   istartall = iendall-reaction%ncomp
  1315)                   Res(icomp) = -msrc(2)
  1316)                   rhs_p(istartall+icomp) = rhs_p(istartall+icomp) - Res(icomp)
  1317) !                 print *,'RT SC source', ieqgas,icomp, res(icomp)  
  1318)                 endif 
  1319)               enddo
  1320)           end select 
  1321)         enddo
  1322)         source_sink => source_sink%next
  1323)       enddo
  1324)   end select
  1325) #endif
  1326) 
  1327)   ! Restore vectors
  1328)   call VecRestoreArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
  1329) 
  1330)   ! Mass Transfer
  1331)   if (field%tran_mass_transfer /= 0) then
  1332)     ! scale by -1.d0 for contribution to residual.  A negative contribution
  1333)     ! indicates mass being added to system.
  1334)     call VecAXPY(field%tran_rhs,-1.d0,field%tran_mass_transfer)
  1335)   endif
  1336)   
  1337) end subroutine RTCalculateRHS_t1
  1338) 
  1339) ! ************************************************************************** !
  1340) 
  1341) subroutine RTCalculateTransportMatrix(realization,T)
  1342)   ! 
  1343)   ! Calculate transport matrix
  1344)   ! 
  1345)   ! Author: Glenn Hammond
  1346)   ! Date: 04/25/10
  1347)   ! 
  1348) 
  1349)   use Realization_Subsurface_class
  1350)   use Option_module
  1351)   use Grid_module
  1352)   use Patch_module
  1353)   use Field_module
  1354)   use Coupler_module
  1355)   use Connection_module
  1356)   use Debug_module
  1357) 
  1358)   implicit none
  1359)       
  1360)   type(realization_subsurface_type) :: realization
  1361)   Mat :: T
  1362)   
  1363)   type(global_auxvar_type), pointer :: global_auxvars(:)
  1364)   class(material_auxvar_type), pointer :: material_auxvars(:)
  1365)   type(option_type), pointer :: option
  1366)   type(patch_type), pointer :: patch
  1367)   type(grid_type), pointer :: grid
  1368)   type(field_type), pointer :: field
  1369)   PetscInt :: local_id, ghosted_id
  1370)   PetscInt :: local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  1371)   PetscInt :: iphase
  1372)   
  1373)   type(coupler_type), pointer :: boundary_condition
  1374)   type(connection_set_list_type), pointer :: connection_set_list
  1375)   type(connection_set_type), pointer :: cur_connection_set
  1376)   type(coupler_type), pointer :: source_sink
  1377)   PetscInt :: sum_connection, iconn
  1378)   PetscReal :: coef
  1379)   PetscReal :: coef_up(1), coef_dn(1)
  1380)   PetscReal :: qsrc
  1381)   PetscBool :: volumetric  
  1382)   PetscInt :: flow_pc
  1383)   PetscInt :: flow_src_sink_type
  1384)   PetscReal :: coef_in, coef_out
  1385)   PetscViewer :: viewer
  1386)   PetscErrorCode :: ierr
  1387) 
  1388)   character(len=MAXSTRINGLENGTH) :: string
  1389) 
  1390)   option => realization%option
  1391)   field => realization%field
  1392)   patch => realization%patch
  1393)   global_auxvars => patch%aux%Global%auxvars
  1394)   material_auxvars => patch%aux%Material%auxvars
  1395)   grid => patch%grid  
  1396) 
  1397)   call MatZeroEntries(T,ierr);CHKERRQ(ierr)
  1398)   
  1399)   ! Get vectors
  1400) 
  1401)   ! Interior Flux Terms -----------------------------------
  1402)   connection_set_list => grid%internal_connection_set_list
  1403)   cur_connection_set => connection_set_list%first
  1404)   sum_connection = 0  
  1405)   do 
  1406)     if (.not.associated(cur_connection_set)) exit
  1407)     do iconn = 1, cur_connection_set%num_connections
  1408)       sum_connection = sum_connection + 1
  1409) 
  1410)       ghosted_id_up = cur_connection_set%id_up(iconn)
  1411)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  1412) 
  1413)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  1414)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  1415) 
  1416)       if (patch%imat(ghosted_id_up) <= 0 .or.  &
  1417)           patch%imat(ghosted_id_dn) <= 0) cycle
  1418) 
  1419)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  1420)                      patch%internal_velocities(:,sum_connection), &
  1421)                      patch%internal_tran_coefs(:,sum_connection), &
  1422)                      cur_connection_set%dist(-1,iconn), &
  1423)                      coef_up,coef_dn)
  1424) 
  1425) !      coef_up = coef_up*global_auxvars(ghosted_id_up)%den_kg*1.d-3
  1426) !      coef_dn = coef_dn*global_auxvars(ghosted_id_dn)%den_kg*1.d-3
  1427)                      
  1428)       if (local_id_up > 0) then
  1429)         call MatSetValuesLocal(T,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  1430)                                coef_up,ADD_VALUES,ierr);CHKERRQ(ierr)
  1431)         call MatSetValuesLocal(T,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  1432)                                coef_dn,ADD_VALUES,ierr);CHKERRQ(ierr)
  1433)       endif
  1434)       if (local_id_dn > 0) then
  1435)         coef_up = -coef_up
  1436)         coef_dn = -coef_dn
  1437)         call MatSetValuesLocal(T,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  1438)                                coef_dn,ADD_VALUES,ierr);CHKERRQ(ierr)
  1439)         call MatSetValuesLocal(T,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  1440)                                coef_up,ADD_VALUES,ierr);CHKERRQ(ierr)
  1441)       endif
  1442)                      
  1443)     enddo
  1444)     cur_connection_set => cur_connection_set%next
  1445)   enddo    
  1446)   
  1447)   ! add in outflowing boundary conditions
  1448)   ! Boundary Flux Terms -----------------------------------
  1449)   boundary_condition => patch%boundary_condition_list%first
  1450)   sum_connection = 0    
  1451)   do 
  1452)     if (.not.associated(boundary_condition)) exit
  1453)   
  1454)     cur_connection_set => boundary_condition%connection_set
  1455)   
  1456)     do iconn = 1, cur_connection_set%num_connections
  1457)       sum_connection = sum_connection + 1
  1458)   
  1459)       local_id = cur_connection_set%id_dn(iconn)
  1460)       ghosted_id = grid%nL2G(local_id)
  1461) 
  1462)       if (patch%imat(ghosted_id) <= 0) cycle
  1463) 
  1464)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  1465)                      patch%boundary_velocities(:,sum_connection), &
  1466)                      patch%boundary_tran_coefs(:,sum_connection), &
  1467)                      0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
  1468)                      coef_up,coef_dn)
  1469) 
  1470)  !     coef_dn = coef_dn*global_auxvars(ghosted_id)%den_kg*1.d-3
  1471) 
  1472)       !Jup not needed 
  1473)       coef_dn = -coef_dn
  1474)       call MatSetValuesLocal(T,1,ghosted_id-1,1,ghosted_id-1,coef_dn, &
  1475)                              ADD_VALUES,ierr);CHKERRQ(ierr)
  1476)     
  1477)     enddo
  1478)     boundary_condition => boundary_condition%next
  1479)   enddo
  1480)   
  1481)   ! Accumulation term
  1482)   iphase = 1
  1483)   do local_id = 1, grid%nlmax
  1484)     ghosted_id = grid%nL2G(local_id)
  1485)     if (patch%imat(ghosted_id) <= 0) cycle    
  1486)     coef = material_auxvars(ghosted_id)%porosity* &
  1487)            global_auxvars(ghosted_id)%sat(iphase)* &
  1488) !geh           global_auxvars(ghosted_id)%den_kg(iphase)* &
  1489)            1000.d0* &
  1490)            material_auxvars(ghosted_id)%volume/option%tran_dt
  1491)     call MatSetValuesLocal(T,1,ghosted_id-1,1,ghosted_id-1,coef, &
  1492)                            ADD_VALUES,ierr);CHKERRQ(ierr)
  1493)   enddo
  1494)                         
  1495)   ! Source/sink terms -------------------------------------
  1496)   source_sink => patch%source_sink_list%first
  1497)   sum_connection = 0
  1498)   do 
  1499)     if (.not.associated(source_sink)) exit
  1500)     
  1501)     cur_connection_set => source_sink%connection_set
  1502)     
  1503)     qsrc = 0.d0
  1504)     flow_src_sink_type = 0
  1505)     if (associated(source_sink%flow_condition) .and. &
  1506)         associated(source_sink%flow_condition%rate)) then
  1507)       qsrc = source_sink%flow_condition%rate%dataset%rarray(1)
  1508)       flow_src_sink_type = source_sink%flow_condition%rate%itype
  1509)     endif
  1510)       
  1511)     ! only handle extraction on lhs
  1512)     if (qsrc > 0.d0) then
  1513)       source_sink => source_sink%next
  1514)       cycle
  1515)     endif
  1516)       
  1517)     do iconn = 1, cur_connection_set%num_connections
  1518)       sum_connection = sum_connection + 1
  1519)       local_id = cur_connection_set%id_dn(iconn)
  1520)       ghosted_id = grid%nL2G(local_id)
  1521) 
  1522)       if (patch%imat(ghosted_id) <= 0) cycle
  1523) 
  1524)       qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
  1525)       call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
  1526)                         coef_in,coef_out)
  1527) 
  1528)       coef_dn(1) = coef_in
  1529)       !geh: do not remove this conditional as otherwise MatSetValuesLocal() 
  1530)       !     will be called for injection too (wasted calls)
  1531)       if (coef_dn(1) > 0.d0) then
  1532)         call MatSetValuesLocal(T,1,ghosted_id-1,1,ghosted_id-1,coef_dn, &
  1533)                                ADD_VALUES,ierr);CHKERRQ(ierr)
  1534)       endif 
  1535) 
  1536)     enddo
  1537)     source_sink => source_sink%next
  1538)   enddo
  1539) 
  1540)   ! All CO2 source/sinks are handled on the RHS for now
  1541) 
  1542)   call MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  1543)   call MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  1544) 
  1545)   if (patch%aux%RT%inactive_cells_exist) then
  1546)     coef = 1.d0
  1547)     call MatZeroRowsLocal(T,patch%aux%RT%n_zero_rows, &
  1548)                           patch%aux%RT%zero_rows_local_ghosted,coef, &
  1549)                           PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  1550)                           ierr);CHKERRQ(ierr)
  1551)   endif
  1552) 
  1553)   if (realization%debug%matview_Jacobian) then
  1554)     string = 'Tmatrix'
  1555)     call DebugCreateViewer(realization%debug,string,option,viewer)
  1556)     call MatView(T,viewer,ierr);CHKERRQ(ierr)
  1557)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  1558)   endif  
  1559)   
  1560) end subroutine RTCalculateTransportMatrix
  1561) 
  1562) ! ************************************************************************** !
  1563) 
  1564) subroutine RTReact(realization)
  1565)   ! 
  1566)   ! Calculate reaction
  1567)   ! 
  1568)   ! Author: Glenn Hammond
  1569)   ! Date: 05/03/10
  1570)   ! 
  1571) 
  1572)   use Realization_Subsurface_class
  1573)   use Patch_module
  1574)   use Connection_module
  1575)   use Coupler_module
  1576)   use Option_module
  1577)   use Field_module  
  1578)   use Grid_module  
  1579)   use Secondary_Continuum_Aux_module
  1580)   use Logging_module
  1581)   
  1582) !$ use omp_lib
  1583)      
  1584)   implicit none
  1585)   
  1586)   type(realization_subsurface_type) :: realization
  1587)   
  1588)   type(global_auxvar_type), pointer :: global_auxvars(:)
  1589)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  1590)   class(material_auxvar_type), pointer :: material_auxvars(:)
  1591)   type(patch_type), pointer :: patch
  1592)   type(grid_type), pointer :: grid
  1593)   type(field_type), pointer :: field
  1594)   type(reaction_type), pointer :: reaction
  1595)   type(option_type), pointer :: option
  1596)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
  1597)   PetscInt :: local_id, ghosted_id
  1598)   PetscInt :: istart, iend, iendaq
  1599)   PetscInt :: iphase
  1600)   PetscInt :: ithread, vector_length
  1601)   PetscReal, pointer :: tran_xx_p(:)
  1602)   PetscReal, pointer :: mask_p(:)
  1603)   PetscInt :: num_iterations
  1604) #ifdef OS_STATISTICS
  1605)   PetscInt :: sum_iterations
  1606)   PetscInt :: max_iterations
  1607) #endif
  1608)   PetscInt :: icount
  1609)   PetscErrorCode :: ierr
  1610) 
  1611) #ifdef OS_STATISTICS
  1612)   PetscInt :: call_count
  1613)   PetscInt :: sum_newton_iterations
  1614)   PetscReal :: ave_newton_iterations_in_a_cell
  1615)   PetscInt :: max_newton_iterations_in_a_cell
  1616)   PetscInt :: max_newton_iterations_on_a_core
  1617)   PetscInt :: min_newton_iterations_on_a_core
  1618)   PetscInt :: temp_int_in(3)
  1619)   PetscInt :: temp_int_out(3)
  1620) #endif
  1621)   
  1622)   call PetscLogEventBegin(logging%event_rt_react,ierr);CHKERRQ(ierr)
  1623)                           
  1624) #ifdef OS_STATISTICS
  1625)   call_count = 0
  1626)   sum_newton_iterations = 0
  1627)   max_newton_iterations_in_a_cell = -99999999
  1628)   max_newton_iterations_on_a_core = -99999999
  1629)   min_newton_iterations_on_a_core = 99999999
  1630) #endif   
  1631)   
  1632)   option => realization%option
  1633)   field => realization%field
  1634)   patch => realization%patch
  1635)   global_auxvars => patch%aux%Global%auxvars
  1636)   rt_auxvars => patch%aux%RT%auxvars
  1637)   material_auxvars => patch%aux%Material%auxvars
  1638)   grid => patch%grid
  1639)   reaction => realization%reaction
  1640) 
  1641)   ! need up update aux vars based on current density/saturation,
  1642)   ! but NOT activity coefficients
  1643)   call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_FALSE,PETSC_FALSE)
  1644) 
  1645)   ! Get vectors
  1646)   call VecGetArrayReadF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
  1647)       
  1648)   iphase = 1
  1649)   ithread = 1
  1650) #ifdef OS_STATISTICS
  1651)   sum_iterations = 0
  1652)   max_iterations = 0
  1653)   icount = 0
  1654) #endif
  1655) 
  1656)   do local_id = 1, grid%nlmax
  1657)     ghosted_id = grid%nL2G(local_id)
  1658)     if (patch%imat(ghosted_id) <= 0) cycle
  1659)     
  1660)     istart = (local_id-1)*reaction%ncomp+1
  1661)     iend = istart + reaction%ncomp - 1
  1662)     iendaq = istart + reaction%naqcomp - 1
  1663)     
  1664)     
  1665)     call RReact(rt_auxvars(ghosted_id),global_auxvars(ghosted_id), &
  1666)                 material_auxvars(ghosted_id), &
  1667)                 tran_xx_p(istart:iend), &
  1668)                 num_iterations,reaction,option)
  1669)     ! set primary dependent var back to free-ion molality
  1670)     tran_xx_p(istart:iendaq) = rt_auxvars(ghosted_id)%pri_molal
  1671)     if (reaction%nimcomp > 0) then
  1672)       tran_xx_p(reaction%offset_immobile: &
  1673)                 reaction%offset_immobile + reaction%nimcomp) = &
  1674)         rt_auxvars(ghosted_id)%immobile
  1675)     endif
  1676) #ifdef OS_STATISTICS
  1677)     if (num_iterations > max_iterations) then
  1678)       max_iterations = num_iterations
  1679)     endif
  1680)     sum_iterations = sum_iterations + num_iterations
  1681)     icount = icount + 1
  1682) #endif
  1683)   enddo
  1684)   
  1685) #ifdef OS_STATISTICS
  1686)   patch%aux%RT%rt_parameter%newton_call_count = icount
  1687)   patch%aux%RT%rt_parameter%sum_newton_call_count = &
  1688)     patch%aux%RT%rt_parameter%sum_newton_call_count + dble(icount)
  1689)   patch%aux%RT%rt_parameter%newton_iterations = sum_iterations
  1690)   patch%aux%RT%rt_parameter%sum_newton_iterations = &
  1691)     patch%aux%RT%rt_parameter%sum_newton_iterations + dble(sum_iterations)
  1692)   patch%aux%RT%rt_parameter%max_newton_iterations = max_iterations
  1693) #endif
  1694)   
  1695)   ! Restore vectors
  1696)   call VecRestoreArrayReadF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
  1697) 
  1698)   if (option%compute_mass_balance_new) then
  1699)     call RTZeroMassBalanceDelta(realization)
  1700)     call RTComputeBCMassBalanceOS(realization)
  1701)   endif
  1702)   
  1703) #ifdef OS_STATISTICS
  1704)   call_count = call_count + cur_patch%aux%RT%rt_parameter%newton_call_count
  1705)   sum_newton_iterations = sum_newton_iterations + &
  1706)     cur_patch%aux%RT%rt_parameter%newton_iterations
  1707)   if (cur_patch%aux%RT%rt_parameter%max_newton_iterations > &
  1708)       max_newton_iterations_in_a_cell) then
  1709)     max_newton_iterations_in_a_cell = &
  1710)       cur_patch%aux%RT%rt_parameter%max_newton_iterations
  1711)   endif
  1712)   if (cur_patch%aux%RT%rt_parameter%max_newton_iterations > &
  1713)       cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations) then
  1714)     cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations = &
  1715)       cur_patch%aux%RT%rt_parameter%max_newton_iterations
  1716)   endif
  1717) #endif 
  1718) 
  1719)   ! Logging must come before statistics since the global reductions
  1720)   ! will synchonize the cores
  1721)   call PetscLogEventEnd(logging%event_rt_react,ierr);CHKERRQ(ierr)
  1722)                         
  1723) #ifdef OS_STATISTICS
  1724)   temp_int_in(1) = call_count
  1725)   temp_int_in(2) = sum_newton_iterations
  1726)   call MPI_Allreduce(temp_int_in,temp_int_out,TWO_INTEGER_MPI, &
  1727)                      MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
  1728)   ave_newton_iterations_in_a_cell = float(temp_int_out(2)) / temp_int_out(1)
  1729) 
  1730)   temp_int_in(1) = max_newton_iterations_in_a_cell
  1731)   temp_int_in(2) = sum_newton_iterations ! to calc max # iteration on a core
  1732)   temp_int_in(3) = -sum_newton_iterations ! to calc min # iteration on a core
  1733)   call MPI_Allreduce(temp_int_in,temp_int_out,THREE_INTEGER_MPI, &
  1734)                      MPIU_INTEGER,MPI_MAX,option%mycomm,ierr)
  1735)   max_newton_iterations_in_a_cell = temp_int_out(1)
  1736)   max_newton_iterations_on_a_core = temp_int_out(2)
  1737)   min_newton_iterations_on_a_core = -temp_int_out(3)
  1738)   
  1739)   if (option%print_screen_flag) then
  1740)     write(*, '(" OS Reaction Statistics: ",/, &
  1741)              & "   Ave Newton Its / Cell: ",1pe12.4,/, &
  1742)              & "   Max Newton Its / Cell: ",i4,/, &
  1743)              & "   Max Newton Its / Core: ",i6,/, &
  1744)              & "   Min Newton Its / Core: ",i6)') &
  1745)                ave_newton_iterations_in_a_cell, &
  1746)                max_newton_iterations_in_a_cell, &
  1747)                max_newton_iterations_on_a_core, &
  1748)                min_newton_iterations_on_a_core
  1749)   endif
  1750) 
  1751)   if (option%print_file_flag) then
  1752)     write(option%fid_out, '(" OS Reaction Statistics: ",/, &
  1753)              & "   Ave Newton Its / Cell: ",1pe12.4,/, &
  1754)              & "   Max Newton Its / Cell: ",i4,/, &
  1755)              & "   Max Newton Its / Core: ",i6,/, &
  1756)              & "   Min Newton Its / Core: ",i6)') &
  1757)                ave_newton_iterations_in_a_cell, &
  1758)                max_newton_iterations_in_a_cell, &
  1759)                max_newton_iterations_on_a_core, &
  1760)                min_newton_iterations_on_a_core
  1761)   endif
  1762) 
  1763) #endif   
  1764) 
  1765) end subroutine RTReact
  1766) 
  1767) ! ************************************************************************** !
  1768) 
  1769) subroutine RTComputeBCMassBalanceOS(realization)
  1770)   ! 
  1771)   ! Calculates mass balance at boundary
  1772)   ! conditions for operator split mode
  1773)   ! 
  1774)   ! Author: Glenn Hammond
  1775)   ! Date: 05/04/10
  1776)   ! 
  1777) 
  1778)   use Realization_Subsurface_class
  1779)   use Patch_module
  1780)   use Transport_module
  1781)   use Option_module
  1782)   use Field_module
  1783)   use Grid_module
  1784)   use Connection_module
  1785)   use Coupler_module  
  1786)   use Debug_module
  1787)   
  1788)   implicit none
  1789) 
  1790)   type(realization_subsurface_type) :: realization  
  1791) 
  1792)   PetscInt :: local_id, ghosted_id
  1793)   PetscInt, parameter :: iphase = 1
  1794)   type(grid_type), pointer :: grid
  1795)   type(option_type), pointer :: option
  1796)   type(field_type), pointer :: field
  1797)   type(patch_type), pointer :: patch
  1798)   type(reaction_type), pointer :: reaction
  1799)   type(reactive_transport_param_type), pointer :: rt_parameter
  1800)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  1801)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
  1802)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
  1803)   type(global_auxvar_type), pointer :: global_auxvars(:)
  1804)   type(global_auxvar_type), pointer :: global_auxvars_bc(:) 
  1805)   type(global_auxvar_type), pointer :: global_auxvars_ss(:) 
  1806)   PetscReal :: Res(realization%reaction%ncomp)
  1807)   
  1808)   PetscReal, pointer :: face_fluxes_p(:)
  1809) 
  1810)   type(coupler_type), pointer :: boundary_condition
  1811)   type(coupler_type), pointer :: source_sink
  1812)   type(connection_set_list_type), pointer :: connection_set_list
  1813)   type(connection_set_type), pointer :: cur_connection_set
  1814)   PetscInt :: sum_connection, iconn
  1815)   PetscInt :: flow_src_sink_type
  1816)   PetscReal :: qsrc
  1817)   
  1818)   PetscReal :: coef_up(realization%option%nphase)
  1819)   PetscReal :: coef_dn(realization%option%nphase)
  1820)   PetscReal :: coef_in, coef_out
  1821)   PetscErrorCode :: ierr
  1822) 
  1823)   option => realization%option
  1824)   field => realization%field
  1825)   patch => realization%patch
  1826)   reaction => realization%reaction
  1827)   grid => patch%grid
  1828)   rt_parameter => patch%aux%RT%rt_parameter
  1829)   rt_auxvars => patch%aux%RT%auxvars
  1830)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
  1831)   rt_auxvars_ss => patch%aux%RT%auxvars_ss
  1832)   global_auxvars => patch%aux%Global%auxvars
  1833)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  1834)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  1835)   
  1836) ! Boundary Flux Terms -----------------------------------
  1837)   boundary_condition => patch%boundary_condition_list%first
  1838)   sum_connection = 0    
  1839)   do 
  1840)     if (.not.associated(boundary_condition)) exit
  1841)   
  1842)     cur_connection_set => boundary_condition%connection_set
  1843)   
  1844)     do iconn = 1, cur_connection_set%num_connections
  1845)       sum_connection = sum_connection + 1
  1846)   
  1847)       local_id = cur_connection_set%id_dn(iconn)
  1848)       ghosted_id = grid%nL2G(local_id)
  1849) 
  1850)       if (patch%imat(ghosted_id) <= 0) cycle
  1851) 
  1852)       ! TFluxCoef accomplishes the same as what TBCCoef would
  1853)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  1854)                      patch%boundary_velocities(:,sum_connection), &
  1855)                      patch%boundary_tran_coefs(:,sum_connection), &
  1856)                      0.5d0, &
  1857)                      coef_up,coef_dn)
  1858)       ! TFlux accomplishes the same as what TBCFlux would
  1859)       call TFlux(rt_parameter, &
  1860)                  rt_auxvars_bc(sum_connection), &
  1861)                  global_auxvars_bc(sum_connection), &
  1862)                  rt_auxvars(ghosted_id), &
  1863)                  global_auxvars(ghosted_id), &
  1864)                  coef_up,coef_dn,option,Res)
  1865) 
  1866)     ! contribution to boundary 
  1867)       rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) = &
  1868)         rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) - Res
  1869) !        ! contribution to internal 
  1870) !        rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
  1871) !          rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) + Res
  1872)     
  1873)     enddo
  1874)     boundary_condition => boundary_condition%next
  1875)   enddo
  1876) 
  1877)   ! Source/sink terms -------------------------------------
  1878)   source_sink => patch%source_sink_list%first
  1879)   sum_connection = 0
  1880)   do 
  1881)     if (.not.associated(source_sink)) exit
  1882)     
  1883)     cur_connection_set => source_sink%connection_set
  1884) 
  1885)     flow_src_sink_type = 0
  1886)     if (associated(source_sink%flow_condition) .and. &
  1887)         associated(source_sink%flow_condition%rate)) then
  1888)       qsrc = source_sink%flow_condition%rate%dataset%rarray(1)
  1889)       flow_src_sink_type = source_sink%flow_condition%rate%itype
  1890)     endif
  1891)       
  1892)     do iconn = 1, cur_connection_set%num_connections 
  1893)       sum_connection = sum_connection + 1     
  1894)       local_id = cur_connection_set%id_dn(iconn)
  1895)       ghosted_id = grid%nL2G(local_id)
  1896) 
  1897)       if (patch%imat(ghosted_id) <= 0) cycle
  1898) 
  1899)       qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
  1900)       call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
  1901)                         coef_in,coef_out)
  1902)       
  1903)       Res = coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
  1904)             coef_out*source_sink%tran_condition%cur_constraint_coupler% &
  1905)             rt_auxvar%total(:,iphase)
  1906)       if (option%compute_mass_balance_new) then
  1907)         ! contribution to boundary 
  1908)         rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) = &
  1909)           rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) + Res
  1910)         ! contribution to internal 
  1911) !        rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
  1912) !          rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) - Res
  1913)         endif
  1914)     enddo
  1915)     source_sink => source_sink%next
  1916)   enddo
  1917) 
  1918) end subroutine RTComputeBCMassBalanceOS
  1919) 
  1920) ! ************************************************************************** !
  1921) 
  1922) subroutine RTNumericalJacobianTest(realization)
  1923)   ! 
  1924)   ! Computes the a test numerical jacobian
  1925)   ! 
  1926)   ! Author: Glenn Hammond
  1927)   ! Date: 02/20/08
  1928)   ! 
  1929) 
  1930)   use Realization_Subsurface_class
  1931)   use Patch_module
  1932)   use Option_module
  1933)   use Grid_module
  1934)   use Field_module
  1935) 
  1936)   implicit none
  1937) 
  1938)   Vec :: xx
  1939)   type(realization_subsurface_type) :: realization
  1940) 
  1941)   Vec :: xx_pert
  1942)   Vec :: res
  1943)   Vec :: res_pert
  1944)   Mat :: A
  1945)   PetscViewer :: viewer
  1946)   PetscErrorCode :: ierr
  1947)   
  1948)   PetscReal :: derivative, perturbation
  1949)   
  1950)   PetscReal, pointer :: vec_p(:), vec2_p(:)
  1951) 
  1952)   type(grid_type), pointer :: grid
  1953)   type(option_type), pointer :: option
  1954)   type(field_type), pointer :: field
  1955)   type(patch_type), pointer :: patch
  1956)   
  1957)   PetscInt :: idof, idof2, icell
  1958) 
  1959)   option => realization%option
  1960)   field => realization%field
  1961)   patch => realization%patch
  1962)   grid => patch%grid
  1963) 
  1964)   call VecDuplicate(field%tran_xx,xx_pert,ierr);CHKERRQ(ierr)
  1965)   call VecDuplicate(field%tran_xx,res,ierr);CHKERRQ(ierr)
  1966)   call VecDuplicate(field%tran_xx,res_pert,ierr);CHKERRQ(ierr)
  1967)   
  1968)   call MatCreate(option%mycomm,A,ierr);CHKERRQ(ierr)
  1969)   call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE, &
  1970)                    grid%nlmax*option%ntrandof, &
  1971)                    grid%nlmax*option%ntrandof,ierr);CHKERRQ(ierr)
  1972)   call MatSetType(A,MATAIJ,ierr);CHKERRQ(ierr)
  1973)   call MatSetFromOptions(A,ierr);CHKERRQ(ierr)
  1974)     
  1975)   call RTResidual(PETSC_NULL_OBJECT,field%tran_xx,res,realization,ierr)
  1976)   call VecGetArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
  1977)   do idof = 1,grid%nlmax*option%ntrandof
  1978)     icell = (idof-1)/option%ntrandof+1
  1979)     if (patch%imat(grid%nL2G(icell)) <= 0) cycle
  1980)     call VecCopy(field%tran_xx,xx_pert,ierr);CHKERRQ(ierr)
  1981)     call VecGetArrayF90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
  1982)     perturbation = vec_p(idof)*perturbation_tolerance
  1983)     vec_p(idof) = vec_p(idof)+perturbation
  1984)     call vecrestorearrayf90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
  1985)     call RTResidual(PETSC_NULL_OBJECT,xx_pert,res_pert,realization,ierr)
  1986)     call vecgetarrayf90(res_pert,vec_p,ierr);CHKERRQ(ierr)
  1987)     do idof2 = 1, grid%nlmax*option%ntrandof
  1988)       derivative = (vec_p(idof2)-vec2_p(idof2))/perturbation
  1989)       if (dabs(derivative) > 1.d-30) then
  1990)         call matsetvalue(a,idof2-1,idof-1,derivative,insert_values, &
  1991)                          ierr);CHKERRQ(ierr)
  1992)       endif
  1993)     enddo
  1994)     call VecRestoreArrayF90(res_pert,vec_p,ierr);CHKERRQ(ierr)
  1995)   enddo
  1996)   call VecRestoreArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
  1997) 
  1998)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  1999)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2000)   call PetscViewerASCIIOpen(option%mycomm,'RTnumerical_jacobian.out',viewer, &
  2001)                             ierr);CHKERRQ(ierr)
  2002)   call MatView(A,viewer,ierr);CHKERRQ(ierr)
  2003)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2004) 
  2005)   call MatDestroy(A,ierr);CHKERRQ(ierr)
  2006)   
  2007)   call VecDestroy(xx_pert,ierr);CHKERRQ(ierr)
  2008)   call VecDestroy(res,ierr);CHKERRQ(ierr)
  2009)   call VecDestroy(res_pert,ierr);CHKERRQ(ierr)
  2010)   
  2011) end subroutine RTNumericalJacobianTest
  2012) 
  2013) ! ************************************************************************** !
  2014) 
  2015) subroutine RTResidual(snes,xx,r,realization,ierr)
  2016)   ! 
  2017)   ! Computes the residual equation
  2018)   ! 
  2019)   ! Author: Glenn Hammond
  2020)   ! Date: 12/10/07
  2021)   ! 
  2022) 
  2023)   use Realization_Subsurface_class
  2024)   use Field_module
  2025)   use Patch_module
  2026)   use Discretization_module
  2027)   use Option_module
  2028)   use Grid_module
  2029)   use Logging_module
  2030)   use Debug_module
  2031) 
  2032)   implicit none
  2033) 
  2034)   SNES :: snes
  2035)   Vec :: xx
  2036)   Vec :: r
  2037)   type(realization_subsurface_type) :: realization
  2038)   PetscReal, pointer :: xx_p(:), log_xx_p(:)
  2039)   PetscErrorCode :: ierr
  2040)   
  2041)   type(discretization_type), pointer :: discretization
  2042)   type(field_type), pointer :: field
  2043)   type(patch_type), pointer :: patch
  2044)   type(option_type), pointer :: option
  2045)   PetscViewer :: viewer  
  2046)   
  2047)   character(len=MAXSTRINGLENGTH) :: string
  2048) 
  2049)   call PetscLogEventBegin(logging%event_rt_residual,ierr);CHKERRQ(ierr)
  2050) 
  2051)   patch => realization%patch
  2052)   field => realization%field
  2053)   discretization => realization%discretization
  2054)   option => realization%option
  2055) 
  2056)   ! Communication -----------------------------------------
  2057)   if (realization%reaction%use_log_formulation) then
  2058)     ! have to convert the log concentration to non-log form
  2059)     call VecGetArrayF90(field%tran_xx,xx_p,ierr);CHKERRQ(ierr)
  2060)     call VecGetArrayReadF90(xx,log_xx_p,ierr);CHKERRQ(ierr)
  2061)     xx_p(:) = exp(log_xx_p(:))
  2062)     call VecRestoreArrayF90(field%tran_xx,xx_p,ierr);CHKERRQ(ierr)
  2063)     call VecRestoreArrayReadF90(xx,log_xx_p,ierr);CHKERRQ(ierr)
  2064)     call DiscretizationGlobalToLocal(discretization,field%tran_xx, &
  2065)                                      field%tran_xx_loc,NTRANDOF)
  2066)   else
  2067)     call DiscretizationGlobalToLocal(discretization,xx,field%tran_xx_loc, &
  2068)                                      NTRANDOF)
  2069)   endif
  2070) 
  2071)   ! pass #1 for internal and boundary flux terms
  2072)   call RTResidualFlux(snes,xx,r,realization,ierr)
  2073) 
  2074)   ! pass #2 for everything else
  2075)   call RTResidualNonFlux(snes,xx,r,realization,ierr)
  2076) 
  2077) !#if 0
  2078)   select case(realization%option%iflowmode)
  2079)     case(MPH_MODE,FLASH2_MODE,IMS_MODE)
  2080)       call RTResidualEquilibrateCO2(r,realization)
  2081)   end select
  2082) !#endif
  2083) 
  2084)   if (realization%debug%vecview_residual) then
  2085)     string = 'RTresidual'
  2086)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2087)     call VecView(r,viewer,ierr);CHKERRQ(ierr)
  2088)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2089)   endif
  2090)   if (realization%debug%vecview_solution) then
  2091)     string = 'RTxx'
  2092)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2093)     call VecView(field%tran_xx,viewer,ierr);CHKERRQ(ierr)
  2094)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2095)   endif
  2096)   
  2097)   call PetscLogEventEnd(logging%event_rt_residual,ierr);CHKERRQ(ierr)
  2098) 
  2099) end subroutine RTResidual
  2100) 
  2101) ! ************************************************************************** !
  2102) 
  2103) subroutine RTResidualFlux(snes,xx,r,realization,ierr)
  2104)   ! 
  2105)   ! Computes the flux terms in the residual function for
  2106)   ! reactive transport
  2107)   ! 
  2108)   ! Author: Glenn Hammond
  2109)   ! Date: 02/14/08
  2110)   ! 
  2111) 
  2112)   use Realization_Subsurface_class
  2113)   use Patch_module
  2114)   use Transport_module
  2115)   use Option_module
  2116)   use Field_module
  2117)   use Grid_module
  2118)   use Connection_module
  2119)   use Coupler_module  
  2120)   use Debug_module
  2121)   use Secondary_Continuum_Aux_module
  2122)   
  2123)   implicit none
  2124) 
  2125)   type :: flux_ptrs
  2126)     PetscReal, dimension(:), pointer :: flux_p 
  2127)   end type
  2128) 
  2129)   type (flux_ptrs), dimension(0:2) :: fluxes
  2130)   SNES, intent(in) :: snes
  2131)   Vec, intent(inout) :: xx
  2132)   Vec, intent(out) :: r
  2133)   type(realization_subsurface_type) :: realization  
  2134)   PetscErrorCode :: ierr
  2135)   
  2136)   PetscReal, pointer :: r_p(:)
  2137)   PetscInt :: local_id, ghosted_id
  2138)   PetscInt, parameter :: iphase = 1
  2139)   PetscInt :: i, istart, iend                        
  2140)   type(grid_type), pointer :: grid
  2141)   type(option_type), pointer :: option
  2142)   type(field_type), pointer :: field
  2143)   type(patch_type), pointer :: patch
  2144)   type(reaction_type), pointer :: reaction
  2145)   type(reactive_transport_param_type), pointer :: rt_parameter
  2146)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
  2147)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:) 
  2148)   
  2149)   PetscReal, pointer :: face_fluxes_p(:)
  2150) 
  2151)   type(coupler_type), pointer :: boundary_condition
  2152)   type(connection_set_list_type), pointer :: connection_set_list
  2153)   type(connection_set_type), pointer :: cur_connection_set
  2154)   PetscInt :: sum_connection, iconn
  2155)   PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
  2156)   PetscReal :: fraction_upwind, distance, dist_up, dist_dn
  2157)   PetscInt :: axis, side, nlx, nly, nlz, ngx, ngxy, pstart, pend, flux_id
  2158)   PetscInt :: direction, max_x_conn, max_y_conn
  2159)   
  2160)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
  2161)   PetscReal :: vol_frac_prim
  2162)   
  2163) #ifdef CENTRAL_DIFFERENCE  
  2164)   PetscReal :: T_11(realization%option%nphase)
  2165)   PetscReal :: T_12(realization%option%nphase)
  2166)   PetscReal :: T_21(realization%option%nphase)
  2167)   PetscReal :: T_22(realization%option%nphase)
  2168)   PetscReal :: Res_1(realization%reaction%ncomp)
  2169)   PetscReal :: Res_2(realization%reaction%ncomp)
  2170) #else
  2171)   PetscReal :: coef_up(realization%option%nphase)
  2172)   PetscReal :: coef_dn(realization%option%nphase)
  2173)   PetscReal :: Res(realization%reaction%ncomp)
  2174) #endif
  2175) 
  2176)   ! CO2-specific
  2177)   PetscReal :: msrc(1:realization%option%nflowspec)
  2178)   PetscInt :: icomp, ieqgas
  2179) 
  2180)   option => realization%option
  2181)   field => realization%field
  2182)   patch => realization%patch
  2183)   reaction => realization%reaction
  2184)   grid => patch%grid
  2185)   rt_parameter => patch%aux%RT%rt_parameter
  2186)   rt_auxvars => patch%aux%RT%auxvars
  2187)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
  2188)   global_auxvars => patch%aux%Global%auxvars
  2189)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2190)   if (option%use_mc) then
  2191)     rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
  2192)   endif
  2193) 
  2194)   
  2195)   if (.not.patch%aux%RT%auxvars_up_to_date) then
  2196)     if (reaction%act_coef_update_frequency == ACT_COEF_FREQUENCY_NEWTON_ITER) then
  2197)       ! update: cells      bcs        act. coefs.
  2198)       call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_TRUE,PETSC_TRUE)
  2199)     else 
  2200)       ! update: cells      bcs        act. coefs.
  2201)       call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_TRUE,PETSC_FALSE)
  2202)     endif
  2203)   endif
  2204)   patch%aux%RT%auxvars_up_to_date = PETSC_FALSE 
  2205)   
  2206)   if (option%compute_mass_balance_new) then
  2207)     call RTZeroMassBalanceDelta(realization)
  2208)   endif
  2209)   
  2210)   ! Get pointer to Vector data
  2211)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2212)  
  2213)   r_p = 0.d0
  2214)   vol_frac_prim = 1.d0
  2215) 
  2216)   ! Interior Flux Terms -----------------------------------
  2217)   connection_set_list => grid%internal_connection_set_list
  2218)   cur_connection_set => connection_set_list%first
  2219)   sum_connection = 0  
  2220)   do 
  2221)     if (.not.associated(cur_connection_set)) exit
  2222)     do iconn = 1, cur_connection_set%num_connections
  2223)       sum_connection = sum_connection + 1
  2224) 
  2225)       ghosted_id_up = cur_connection_set%id_up(iconn)
  2226)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  2227) 
  2228)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  2229)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  2230) 
  2231)       if (patch%imat(ghosted_id_up) <= 0 .or.  &
  2232)           patch%imat(ghosted_id_dn) <= 0) cycle
  2233) 
  2234)       ! TFluxCoef will eventually be moved to another routine where it should be
  2235)       ! called only once per flux interface at the beginning of a transport
  2236)       ! time step.
  2237)       
  2238)       if (option%use_mc) then
  2239)         vol_frac_prim = rt_sec_transport_vars(local_id_up)%epsilon
  2240)       endif  
  2241)       
  2242)       
  2243) #ifndef CENTRAL_DIFFERENCE        
  2244)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  2245)                 patch%internal_velocities(:,sum_connection), &
  2246)                 patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
  2247)                 cur_connection_set%dist(-1,iconn), &
  2248)                 coef_up,coef_dn)
  2249)                       
  2250)       call TFlux(rt_parameter, &
  2251)                   rt_auxvars(ghosted_id_up), &
  2252)                   global_auxvars(ghosted_id_up), &
  2253)                   rt_auxvars(ghosted_id_dn), &
  2254)                   global_auxvars(ghosted_id_dn), &
  2255)                   coef_up,coef_dn,option,Res)
  2256) 
  2257) 
  2258) 
  2259) #ifdef COMPUTE_INTERNAL_MASS_FLUX
  2260)       rt_auxvars(local_id_up)%mass_balance_delta(:,iphase) = &
  2261)         rt_auxvars(local_id_up)%mass_balance_delta(:,iphase) - Res        
  2262) #endif
  2263)       
  2264)       if (local_id_up>0) then
  2265)         iend = local_id_up*reaction%ncomp
  2266)         istart = iend-reaction%ncomp+1
  2267)         r_p(istart:iend) = r_p(istart:iend) + Res(1:reaction%ncomp)
  2268)       endif
  2269)       
  2270)       if (local_id_dn>0) then
  2271)         iend = local_id_dn*reaction%ncomp
  2272)         istart = iend-reaction%ncomp+1
  2273)         r_p(istart:iend) = r_p(istart:iend) - Res(1:reaction%ncomp)
  2274)       endif
  2275) #else
  2276)       call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
  2277)                  patch%internal_velocities(:,sum_connection), &
  2278)                  patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
  2279)                  cur_connection_set%dist(-1,iconn), &
  2280)                  T_11,T_12,T_21,T_22)
  2281)       call TFlux_CD(rt_parameter, &
  2282)                   rt_auxvars(ghosted_id_up), &
  2283)                   global_auxvars(ghosted_id_up), &
  2284)                   rt_auxvars(ghosted_id_dn), &
  2285)                   global_auxvars(ghosted_id_dn), &
  2286)                   T_11,T_12,T_21,T_22,option,Res_1,Res_2)
  2287)                              
  2288)       if (local_id_up>0) then
  2289)         iend = local_id_up*reaction%ncomp
  2290)         istart = iend-reaction%ncomp+1
  2291)         r_p(istart:iend) = r_p(istart:iend) + Res_1(1:reaction%ncomp)
  2292)       endif
  2293)       
  2294)       if (local_id_dn>0) then
  2295)         iend = local_id_dn*reaction%ncomp
  2296)         istart = iend-reaction%ncomp+1
  2297)         r_p(istart:iend) = r_p(istart:iend) + Res_2(1:reaction%ncomp)
  2298)       endif
  2299) #endif
  2300)       if (associated(patch%internal_tran_fluxes)) then
  2301)         patch%internal_tran_fluxes(1:reaction%ncomp,iconn) = &
  2302)             Res(1:reaction%ncomp)
  2303)       endif
  2304)     enddo
  2305)     cur_connection_set => cur_connection_set%next
  2306)   enddo
  2307)     
  2308) ! Boundary Flux Terms -----------------------------------
  2309)   boundary_condition => patch%boundary_condition_list%first
  2310)   sum_connection = 0    
  2311)   do 
  2312)     if (.not.associated(boundary_condition)) exit
  2313)     
  2314)     cur_connection_set => boundary_condition%connection_set
  2315)     
  2316)     do iconn = 1, cur_connection_set%num_connections
  2317)       sum_connection = sum_connection + 1
  2318)     
  2319)       local_id = cur_connection_set%id_dn(iconn)
  2320)       ghosted_id = grid%nL2G(local_id)
  2321) 
  2322)       if (patch%imat(ghosted_id) <= 0) cycle
  2323) 
  2324)       if (option%use_mc) then
  2325)         vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
  2326)       endif  
  2327)       
  2328) #ifndef CENTRAL_DIFFERENCE
  2329)       ! TFluxCoef accomplishes the same as what TBCCoef would
  2330)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  2331)                   patch%boundary_velocities(:,sum_connection), &
  2332)                   patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
  2333)                   0.5d0, &
  2334)                   coef_up,coef_dn)
  2335)       ! TFlux accomplishes the same as what TBCFlux would
  2336)       call TFlux(rt_parameter, &
  2337)                   rt_auxvars_bc(sum_connection), &
  2338)                   global_auxvars_bc(sum_connection), &
  2339)                   rt_auxvars(ghosted_id), &
  2340)                   global_auxvars(ghosted_id), &
  2341)                   coef_up,coef_dn,option,Res)
  2342)                   
  2343)       iend = local_id*reaction%ncomp
  2344)       istart = iend-reaction%ncomp+1
  2345)       r_p(istart:iend)= r_p(istart:iend) - Res(1:reaction%ncomp)
  2346) 
  2347)       if (option%compute_mass_balance_new) then
  2348)       ! contribution to boundary 
  2349)         rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) = &
  2350)           rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) - Res
  2351) !        ! contribution to internal 
  2352) !        rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
  2353) !          rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) + Res
  2354)         endif  
  2355) 
  2356) #else
  2357)       call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
  2358)                 patch%boundary_velocities(:,sum_connection), &
  2359)                 patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
  2360)                 0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
  2361)                 T_11,T_12,T_21,T_22)
  2362)       call TFlux_CD(rt_parameter, &
  2363)                   rt_auxvars_bc(sum_connection), &
  2364)                   global_auxvars_bc(sum_connection), &
  2365)                   rt_auxvars(ghosted_id), &
  2366)                   global_auxvars(ghosted_id), &
  2367)                   T_11,T_12,T_21,T_22,option,Res_1,Res_2)
  2368) 
  2369)       iend = local_id*reaction%ncomp
  2370)       istart = iend-reaction%ncomp+1
  2371)       r_p(istart:iend)= r_p(istart:iend) + Res_2(1:reaction%ncomp)
  2372) 
  2373)       if (option%compute_mass_balance_new) then
  2374)       ! contribution to boundary 
  2375)         rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) = &
  2376)           rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) - Res_2
  2377) !        ! contribution to internal 
  2378) !        rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
  2379) !          rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) + Res
  2380)         endif  
  2381)       
  2382) #endif                   
  2383)       if (associated(patch%boundary_tran_fluxes)) then
  2384)         patch%boundary_tran_fluxes(1:reaction%ncomp,sum_connection) = &
  2385)             -Res(1:reaction%ncomp)
  2386)       endif
  2387)     enddo
  2388)     boundary_condition => boundary_condition%next
  2389)   enddo
  2390) 
  2391)   ! Restore vectors
  2392)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2393)  
  2394) end subroutine RTResidualFlux
  2395) 
  2396) ! ************************************************************************** !
  2397) 
  2398) subroutine RTResidualNonFlux(snes,xx,r,realization,ierr)
  2399)   ! 
  2400)   ! Computes the non-flux terms in the residual function for
  2401)   ! reactive transport
  2402)   ! 
  2403)   ! Author: Glenn Hammond
  2404)   ! Date: 02/14/08
  2405)   ! 
  2406) 
  2407)   use Realization_Subsurface_class
  2408)   use Patch_module
  2409)   use Transport_module
  2410)   use Option_module
  2411)   use Field_module
  2412)   use Grid_module
  2413)   use Connection_module
  2414)   use Coupler_module
  2415)   use Debug_module
  2416)   use Logging_module
  2417)   !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
  2418)   !      resolves a bug in the Intel Visual Fortran compiler.
  2419)   use Secondary_Continuum_Aux_module, only : sec_transport_type
  2420)   use Secondary_Continuum_module, only : SecondaryRTResJacMulti
  2421)   
  2422)   implicit none
  2423) 
  2424)   SNES, intent(in) :: snes
  2425)   Vec, intent(inout) :: xx
  2426)   Vec, intent(out) :: r
  2427)   type(realization_subsurface_type) :: realization  
  2428)   PetscErrorCode :: ierr
  2429)   
  2430)   PetscReal, pointer :: r_p(:), accum_p(:), vec_p(:)
  2431)   PetscInt :: local_id, ghosted_id
  2432)   PetscInt, parameter :: iphase = 1
  2433)   PetscInt :: i
  2434)   PetscInt :: istartaq, iendaq
  2435)   PetscInt :: istartcoll, iendcoll
  2436)   PetscInt :: istartall, iendall
  2437)   PetscInt :: idof
  2438)   PetscInt :: offset
  2439)   type(grid_type), pointer :: grid
  2440)   type(option_type), pointer :: option
  2441)   type(field_type), pointer :: field
  2442)   type(patch_type), pointer :: patch
  2443)   type(reaction_type), pointer :: reaction
  2444)   type(reactive_transport_param_type), pointer :: rt_parameter
  2445)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  2446)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
  2447)   type(global_auxvar_type), pointer :: global_auxvars(:)
  2448)   type(global_auxvar_type), pointer :: global_auxvars_ss(:) 
  2449)   class(material_auxvar_type), pointer :: material_auxvars(:)
  2450)   PetscReal :: Res(realization%reaction%ncomp)
  2451)   
  2452)   type(coupler_type), pointer :: source_sink
  2453)   type(connection_set_type), pointer :: cur_connection_set
  2454)   PetscInt :: iconn
  2455)   PetscReal :: qsrc, molality
  2456)   PetscInt :: flow_src_sink_type
  2457)   PetscReal :: scale, coef_in, coef_out
  2458)   PetscReal :: Jup(realization%reaction%ncomp,realization%reaction%ncomp)
  2459)   PetscBool :: volumetric
  2460)   PetscInt :: sum_connection
  2461) 
  2462)   ! CO2-specific
  2463)   PetscReal :: msrc(1:realization%option%nflowspec)
  2464)   PetscInt :: icomp, ieqgas
  2465) 
  2466)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
  2467)   PetscReal :: vol_frac_prim
  2468)   PetscReal :: sec_diffusion_coefficient
  2469)   PetscReal :: sec_porosity
  2470)   PetscReal :: res_sec_transport(realization%reaction%ncomp)
  2471) 
  2472)   option => realization%option
  2473)   field => realization%field
  2474)   patch => realization%patch
  2475)   reaction => realization%reaction
  2476)   grid => patch%grid
  2477)   rt_parameter => patch%aux%RT%rt_parameter
  2478)   rt_auxvars => patch%aux%RT%auxvars
  2479)   rt_auxvars_ss => patch%aux%RT%auxvars_ss
  2480)   global_auxvars => patch%aux%Global%auxvars
  2481)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  2482)   material_auxvars => patch%aux%Material%auxvars
  2483)   if (option%use_mc) then
  2484)     rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
  2485)   endif
  2486)   
  2487)   ! Get pointer to Vector data
  2488)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2489)   call VecGetArrayReadF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
  2490)  
  2491)   vol_frac_prim = 1.d0
  2492) 
  2493)   if (.not.option%steady_state) then
  2494)     r_p = r_p - accum_p
  2495) #if 1
  2496)     ! Accumulation terms ------------------------------------
  2497)     do local_id = 1, grid%nlmax  ! For each local node do...
  2498)       ghosted_id = grid%nL2G(local_id)
  2499)       !geh - Ignore inactive cells with inactive materials
  2500)       if (patch%imat(ghosted_id) <= 0) cycle
  2501) 
  2502)       offset = (local_id-1)*reaction%ncomp
  2503)       istartall = offset + 1
  2504)       iendall = offset + reaction%ncomp
  2505) 
  2506)       call RTAccumulation(rt_auxvars(ghosted_id), &
  2507)                           global_auxvars(ghosted_id), &
  2508)                           material_auxvars(ghosted_id), &
  2509)                           reaction,option,Res)
  2510)       if (reaction%neqsorb > 0) then
  2511)         call RAccumulationSorb(rt_auxvars(ghosted_id), &
  2512)                                global_auxvars(ghosted_id), &
  2513)                                material_auxvars(ghosted_id), &
  2514)                                reaction,option,Res)
  2515)       endif
  2516) 
  2517)       if (option%use_mc) then
  2518)         vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
  2519)         Res = Res*vol_frac_prim
  2520)       endif        
  2521)       
  2522)       r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
  2523)       
  2524)       ! Secondary continuum formation not implemented for Age equation
  2525)       if (reaction%calculate_water_age) then 
  2526)         call RAge(rt_auxvars(ghosted_id),global_auxvars(ghosted_id), &
  2527)                   material_auxvars(ghosted_id),option,reaction,Res)
  2528)         r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
  2529)       endif
  2530)       if (reaction%calculate_tracer_age) then 
  2531)         call RAge(rt_auxvars(ghosted_id),global_auxvars(ghosted_id), &
  2532)                   material_auxvars(ghosted_id),option,reaction,Res)
  2533)         r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
  2534)       endif
  2535)     enddo
  2536)   endif
  2537) #endif
  2538) #if 1
  2539) 
  2540) ! ========== Secondary continuum transport source terms -- MULTICOMPONENT ======
  2541)   if (option%use_mc) then
  2542)   ! Secondary continuum contribution (SK 1/31/2013)
  2543)   ! only one secondary continuum for now for each primary continuum node
  2544)     do local_id = 1, grid%nlmax  ! For each local node do...
  2545)       ghosted_id = grid%nL2G(local_id)
  2546)       if (patch%imat(ghosted_id) <= 0) cycle
  2547)       
  2548)       offset = (local_id-1)*reaction%ncomp
  2549)       istartall = offset + 1
  2550)       iendall = offset + reaction%ncomp
  2551)          
  2552)       sec_diffusion_coefficient = patch% &
  2553)                                   material_property_array(1)%ptr% &
  2554)                                   secondary_continuum_diff_coeff
  2555)       sec_porosity = patch%material_property_array(1)%ptr% &
  2556)                      secondary_continuum_porosity
  2557) 
  2558)       call SecondaryRTResJacMulti(rt_sec_transport_vars(local_id), &
  2559)                                   rt_auxvars(ghosted_id), &
  2560)                                   global_auxvars(ghosted_id), &
  2561)                                   material_auxvars(ghosted_id)%volume, &
  2562)                                   reaction, &
  2563)                                   sec_diffusion_coefficient, &
  2564)                                   sec_porosity, &
  2565)                                   option,res_sec_transport)
  2566) 
  2567)       r_p(istartall:iendall) = r_p(istartall:iendall) - &
  2568)                                res_sec_transport(1:reaction%ncomp) ! in mol/s
  2569)                                
  2570)     enddo   
  2571)   endif
  2572) ! ============== end secondary continuum coupling terms ========================
  2573) 
  2574)   ! Source/sink terms -------------------------------------
  2575)   source_sink => patch%source_sink_list%first
  2576)   sum_connection = 0
  2577)   do 
  2578)     if (.not.associated(source_sink)) exit
  2579)     
  2580)     cur_connection_set => source_sink%connection_set
  2581) 
  2582)     do iconn = 1, cur_connection_set%num_connections 
  2583)       sum_connection = sum_connection + 1     
  2584)       local_id = cur_connection_set%id_dn(iconn)
  2585)       ghosted_id = grid%nL2G(local_id)
  2586) 
  2587)       offset = (local_id-1)*reaction%ncomp
  2588) 
  2589)       if (patch%imat(ghosted_id) <= 0) cycle
  2590)       
  2591)       istartaq = reaction%offset_aqueous + 1
  2592)       iendaq = reaction%offset_aqueous + reaction%naqcomp
  2593)       
  2594)       if (reaction%ncoll > 0) then
  2595)         istartcoll = reaction%offset_colloid + 1
  2596)         iendcoll = reaction%offset_colloid + reaction%ncoll
  2597)       endif
  2598) 
  2599)       qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
  2600)       call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
  2601)                         coef_in,coef_out)
  2602) 
  2603)       Res = 0.d0
  2604)       Res(istartaq:iendaq) = coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
  2605)                              coef_out*source_sink%tran_condition%cur_constraint_coupler% &
  2606)                                         rt_auxvar%total(:,iphase)
  2607)       
  2608)       if (reaction%ncoll > 0) then
  2609)         Res(istartcoll:iendcoll) = coef_in*rt_auxvars(ghosted_id)%colloid%conc_mob(:) + &
  2610)                                    coef_out*source_sink%tran_condition%cur_constraint_coupler% &
  2611)                                               rt_auxvar%colloid%conc_mob(:)
  2612)       endif
  2613)       istartall = offset + 1
  2614)       iendall = offset + reaction%ncomp
  2615)       r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
  2616)       if (associated(patch%ss_tran_fluxes)) then
  2617)         patch%ss_tran_fluxes(:,sum_connection) = Res(:)
  2618)       endif
  2619)       if (option%compute_mass_balance_new) then
  2620)         ! contribution to boundary 
  2621)         rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) = &
  2622)           rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) + Res
  2623)         ! contribution to internal 
  2624) !        rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
  2625) !          rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) - Res
  2626)         endif
  2627)     enddo
  2628)     source_sink => source_sink%next
  2629)   enddo
  2630) 
  2631)   ! CO2-specific
  2632)   select case(option%iflowmode)
  2633)     case(MPH_MODE,IMS_MODE,FLASH2_MODE)
  2634)       source_sink => patch%source_sink_list%first 
  2635)       do 
  2636)         if (.not.associated(source_sink)) exit
  2637) 
  2638)         select case(source_sink%flow_condition%itype(1))
  2639)           case(MASS_RATE_SS)
  2640)             msrc(:) = source_sink%flow_condition%rate%dataset%rarray(:)
  2641)           case default
  2642)             msrc(:) = 0.d0
  2643)         end select
  2644) 
  2645)         msrc(1) =  msrc(1) / FMWH2O*1D3
  2646)         msrc(2) =  msrc(2) / FMWCO2*1D3
  2647)         ! print *,'RT SC source'
  2648)         do iconn = 1, cur_connection_set%num_connections      
  2649)           local_id = cur_connection_set%id_dn(iconn)
  2650)           ghosted_id = grid%nL2G(local_id)
  2651)           Res=0D0
  2652)           
  2653)           if (patch%imat(ghosted_id) <= 0) cycle
  2654)           
  2655)           select case(source_sink%flow_condition%itype(1))
  2656)             case(MASS_RATE_SS)
  2657)               do ieqgas = 1, reaction%ngas
  2658)                 if (abs(reaction%species_idx%co2_gas_id) == ieqgas) then
  2659)                   icomp = reaction%eqgasspecid(1,ieqgas)
  2660)                   iendall = local_id*reaction%ncomp
  2661)                   istartall = iendall-reaction%ncomp
  2662)                   Res(icomp) = -msrc(2)
  2663)                   r_p(istartall+icomp) = r_p(istartall+icomp) + Res(icomp)
  2664) !                 print *,'RT SC source', ieqgas,icomp, res(icomp)
  2665)                 endif 
  2666)               enddo
  2667)           end select 
  2668)         enddo
  2669)         source_sink => source_sink%next
  2670)       enddo
  2671)   end select
  2672) #endif
  2673) 
  2674) #if 1  
  2675) ! Reactions
  2676)   if (associated(reaction)) then
  2677)   
  2678)     call PetscLogEventBegin(logging%event_rt_res_reaction,ierr);CHKERRQ(ierr)
  2679)     
  2680)     do local_id = 1, grid%nlmax  ! For each local node do...
  2681)       ghosted_id = grid%nL2G(local_id)
  2682)       !geh - Ignore inactive cells with inactive materials
  2683)       if (patch%imat(ghosted_id) <= 0) cycle
  2684)       offset = (local_id-1)*reaction%ncomp
  2685)       istartall = offset + 1
  2686)       iendall = offset + reaction%ncomp
  2687)       Res = 0.d0
  2688)       Jup = 0.d0
  2689)       if (.not.option%use_isothermal) then
  2690)         call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
  2691)                                        PETSC_FALSE,option)
  2692)       endif      
  2693)       call RReaction(Res,Jup,PETSC_FALSE,rt_auxvars(ghosted_id), &
  2694)                      global_auxvars(ghosted_id), &
  2695)                      material_auxvars(ghosted_id), &
  2696)                      reaction,option)
  2697)       if (option%use_mc) then
  2698)         vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
  2699)         Res = Res*vol_frac_prim
  2700)       endif 
  2701)       r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)                    
  2702) 
  2703)     enddo
  2704) 
  2705)     call PetscLogEventEnd(logging%event_rt_res_reaction,ierr);CHKERRQ(ierr)
  2706)   endif
  2707) #endif
  2708) 
  2709)   if (patch%aux%RT%inactive_cells_exist) then
  2710)     do i=1,patch%aux%RT%n_zero_rows
  2711)       r_p(patch%aux%RT%zero_rows_local(i)) = 0.d0
  2712)     enddo
  2713)   endif
  2714) 
  2715)   ! Restore vectors
  2716)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2717)   call VecRestoreArrayReadF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
  2718)  
  2719)   ! Mass Transfer
  2720)   if (field%tran_mass_transfer /= 0) then
  2721)     ! scale by -1.d0 for contribution to residual.  A negative contribution
  2722)     ! indicates mass being added to system.
  2723)     call VecGetArrayF90(field%tran_mass_transfer,vec_p,ierr);CHKERRQ(ierr)
  2724)     call VecRestoreArrayF90(field%tran_mass_transfer,vec_p,ierr);CHKERRQ(ierr)
  2725)     call VecAXPY(r,-1.d0,field%tran_mass_transfer,ierr);CHKERRQ(ierr)
  2726)   endif
  2727) 
  2728) end subroutine RTResidualNonFlux
  2729) 
  2730) ! ************************************************************************** !
  2731) 
  2732) subroutine RTResidualEquilibrateCO2(r,realization)
  2733)   ! 
  2734)   ! Adds CO2 saturation constraint to residual for
  2735)   ! reactive transport
  2736)   ! 
  2737)   ! Author: Glenn Hammond/Peter Lichtner
  2738)   ! Date: 12/12/14
  2739)   ! 
  2740) 
  2741)   use Realization_Subsurface_class
  2742)   use Patch_module
  2743)   use Option_module
  2744)   use Field_module
  2745)   use Grid_module
  2746)   use EOS_Water_module
  2747) 
  2748)   ! CO2-specific
  2749)   use co2eos_module, only: Henry_duan_sun
  2750)   use co2_span_wagner_module, only: co2_span_wagner
  2751) 
  2752)   implicit none
  2753) 
  2754)   Vec :: r
  2755)   type(realization_subsurface_type) :: realization  
  2756)   
  2757)   PetscInt :: local_id, ghosted_id
  2758)   PetscInt :: jco2
  2759)   PetscReal :: tc, pg, henry, m_na, m_cl
  2760)   PetscReal :: Qkco2, mco2eq, xphi
  2761)   PetscReal :: eps = 1.d-6
  2762) 
  2763)   ! CO2-specific
  2764)   PetscReal :: dg,dddt,dddp,fg,dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,&
  2765)                yco2,sat_pressure,lngamco2
  2766)   PetscInt :: iflag
  2767) 
  2768)   type(grid_type), pointer :: grid
  2769)   type(option_type), pointer :: option
  2770)   type(field_type), pointer :: field
  2771)   type(patch_type), pointer :: patch
  2772)   type(reaction_type), pointer :: reaction
  2773)   PetscErrorCode :: ierr
  2774)     
  2775)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  2776)   type(global_auxvar_type), pointer :: global_auxvars(:)
  2777)   PetscReal, pointer :: r_p(:)
  2778)   
  2779)   option => realization%option
  2780)   field => realization%field
  2781)   patch => realization%patch  
  2782)   reaction => realization%reaction
  2783)   grid => patch%grid
  2784)   rt_auxvars => patch%aux%RT%auxvars
  2785)   global_auxvars => patch%aux%Global%auxvars
  2786) 
  2787)   ! Get pointer to Vector data
  2788)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2789) 
  2790)   do local_id = 1, grid%nlmax  ! For each local node do...
  2791)     ghosted_id = grid%nL2G(local_id)
  2792)     if (patch%imat(ghosted_id) <= 0) cycle
  2793)     if (global_auxvars(ghosted_id)%sat(GAS_PHASE) > eps .and. &
  2794)       global_auxvars(ghosted_id)%sat(GAS_PHASE) < 1.d0-eps) then
  2795) 
  2796)       jco2 = reaction%species_idx%co2_aq_id
  2797) 
  2798)       tc = global_auxvars(ghosted_id)%temp
  2799)       pg = global_auxvars(ghosted_id)%pres(2)
  2800)       m_na = 0.d0
  2801)       m_cl = 0.d0
  2802)       if (reaction%species_idx%na_ion_id /= 0 .and. &
  2803)         reaction%species_idx%cl_ion_id /= 0) then
  2804)         m_na = rt_auxvars(ghosted_id)%pri_molal(reaction%species_idx%na_ion_id)
  2805)         m_cl = rt_auxvars(ghosted_id)%pri_molal(reaction%species_idx%cl_ion_id)
  2806)         call Henry_duan_sun(tc,pg*1D-5,henry,lngamco2,m_na,m_cl)
  2807)       else
  2808)         call Henry_duan_sun(tc,pg*1D-5,henry,lngamco2,option%m_nacl,option%m_nacl)
  2809)       endif
  2810) !     call Henry_duan_sun(tc,pg*1.D-5,henry,lngamco2,m_na,m_cl)
  2811) 
  2812) !     print *,'check_EOSeq: ',local_id,jco2,reaction%ncomp, &
  2813) !         global_auxvars(ghosted_id)%sat(GAS_PHASE), &
  2814) !         rt_auxvars(ghosted_id)%pri_molal(jco2), &
  2815) !         global_auxvars(ghosted_id)%pres, &
  2816) !         global_auxvars(ghosted_id)%temp, &
  2817) !         r_p(jco2+(local_id-1)*reaction%ncomp)
  2818) 
  2819)       iflag = 1
  2820)       call co2_span_wagner(pg*1D-6,tc+273.15D0,dg,dddt,dddp,fg, &
  2821)               dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,iflag,option%itable)
  2822) 
  2823)       call EOSWaterSaturationPressure(tc, sat_pressure, ierr)
  2824) 
  2825)       yco2 = 1.d0-sat_pressure/pg
  2826)       xphi = fg*1.D6/pg/yco2
  2827)       Qkco2 = henry*xphi  ! QkCO2 = xphi * exp(-mu0) / gamma
  2828) 
  2829) !     sat_pressure = sat_pressure * 1.D5
  2830)       mco2eq = (pg - sat_pressure)*1.D-5 * Qkco2 ! molality CO2, y * P = P - Psat(T)
  2831) 
  2832)       r_p(jco2+(local_id-1)*reaction%ncomp) = &
  2833)       rt_auxvars(ghosted_id)%pri_molal(jco2) - mco2eq
  2834) 
  2835) !     print *,'check_EOS', local_id,jco2,reaction%ncomp, mco2eq, &
  2836) !       rt_auxvars(ghosted_id)%pri_molal(jco2), &
  2837) !       sat_pressure, henry, &
  2838) !       yco2, fg, xphi,r_p(jco2+(local_id-1)*reaction%ncomp)
  2839)     endif
  2840)   enddo
  2841)   
  2842)   ! Restore pointer to Vector data
  2843)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2844)   
  2845) end subroutine RTResidualEquilibrateCO2
  2846) 
  2847) ! ************************************************************************** !
  2848) 
  2849) subroutine RTJacobian(snes,xx,A,B,realization,ierr)
  2850)   ! 
  2851)   ! Computes the Jacobian
  2852)   ! 
  2853)   ! Author: Glenn Hammond
  2854)   ! Date: 12/10/07
  2855)   ! 
  2856) 
  2857)   use Realization_Subsurface_class
  2858)   use Patch_module
  2859)   use Grid_module
  2860)   use Option_module
  2861)   use Field_module
  2862)   use Logging_module
  2863)   use Debug_module
  2864) 
  2865)   implicit none
  2866) 
  2867)   SNES :: snes
  2868)   Vec :: xx
  2869)   Mat :: A, B
  2870)   type(realization_subsurface_type) :: realization
  2871)   PetscErrorCode :: ierr
  2872) 
  2873)   Mat :: J
  2874)   MatType :: mat_type
  2875)   PetscViewer :: viewer  
  2876)   type(grid_type),  pointer :: grid
  2877)   character(len=MAXSTRINGLENGTH) :: string
  2878) 
  2879)   call PetscLogEventBegin(logging%event_rt_jacobian,ierr);CHKERRQ(ierr)
  2880) 
  2881) #if 0
  2882)   call RTNumericalJacobianTest(realization)
  2883) #endif
  2884) 
  2885)   call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
  2886)   if (mat_type == MATMFFD) then
  2887)     J = B
  2888)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2889)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2890)   else
  2891)     J = A
  2892)   endif
  2893)     
  2894)   call MatZeroEntries(J,ierr);CHKERRQ(ierr)
  2895) 
  2896) 
  2897)   call PetscLogEventBegin(logging%event_rt_jacobian1,ierr);CHKERRQ(ierr)
  2898) 
  2899) 
  2900)   ! pass #1 for internal and boundary flux terms  
  2901)   call RTJacobianFlux(snes,xx,J,J,realization,ierr)
  2902) 
  2903)   call PetscLogEventEnd(logging%event_rt_jacobian1,ierr);CHKERRQ(ierr)
  2904)   call PetscLogEventBegin(logging%event_rt_jacobian2,ierr);CHKERRQ(ierr)
  2905)   
  2906)   ! pass #2 for everything else
  2907)   call RTJacobianNonFlux(snes,xx,J,J,realization,ierr)
  2908) 
  2909) !#if 0
  2910)   select case(realization%option%iflowmode)
  2911)     case(MPH_MODE,FLASH2_MODE,IMS_MODE)
  2912)     call RTJacobianEquilibrateCO2(J,realization)
  2913)   end select
  2914) !#endif
  2915) 
  2916)   call PetscLogEventEnd(logging%event_rt_jacobian2,ierr);CHKERRQ(ierr)
  2917)     
  2918)   if (realization%debug%matview_Jacobian) then
  2919)     string = 'RTjacobian'
  2920)     call DebugCreateViewer(realization%debug,string,realization%option,viewer)
  2921)     call MatView(J,viewer,ierr);CHKERRQ(ierr)
  2922)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2923)   endif
  2924) 
  2925)   if (realization%reaction%use_log_formulation) then
  2926)     call MatDiagonalScaleLocal(J,realization%field%tran_work_loc, &
  2927)                                ierr);CHKERRQ(ierr)
  2928) 
  2929)     if (realization%debug%matview_Jacobian) then
  2930)       string = 'RTjacobianLog'
  2931)       call DebugCreateViewer(realization%debug,string,realization%option,viewer)
  2932)       call MatView(J,viewer,ierr);CHKERRQ(ierr)
  2933)       call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2934)     endif
  2935)     
  2936)   endif
  2937) 
  2938)   call PetscLogEventEnd(logging%event_rt_jacobian,ierr);CHKERRQ(ierr)
  2939)   
  2940) end subroutine RTJacobian
  2941) 
  2942) ! ************************************************************************** !
  2943) 
  2944) subroutine RTJacobianFlux(snes,xx,A,B,realization,ierr)
  2945)   ! 
  2946)   ! Computes the flux term entries in the Jacobian for
  2947)   ! reactive transport
  2948)   ! 
  2949)   ! Author: Glenn Hammond
  2950)   ! Date: 02/14/08
  2951)   ! 
  2952) 
  2953)   use Realization_Subsurface_class
  2954)   use Patch_module
  2955)   use Transport_module
  2956)   use Option_module
  2957)   use Field_module
  2958)   use Grid_module
  2959)   use Connection_module
  2960)   use Coupler_module  
  2961)   use Debug_module
  2962)   use Logging_module  
  2963)   use Secondary_Continuum_Aux_module
  2964)   
  2965)   implicit none
  2966) 
  2967)   SNES :: snes
  2968)   Vec :: xx
  2969)   Mat :: A, B
  2970)   type(realization_subsurface_type) :: realization  
  2971)   PetscErrorCode :: ierr
  2972)   
  2973)   PetscReal, pointer :: r_p(:)
  2974)   PetscInt :: local_id, ghosted_id
  2975)   PetscInt :: istart, iend                        
  2976)   type(grid_type), pointer :: grid
  2977)   type(option_type), pointer :: option
  2978)   type(field_type), pointer :: field
  2979)   type(patch_type), pointer :: patch
  2980)   type(reactive_transport_param_type), pointer :: rt_parameter
  2981)   type(reaction_type), pointer :: reaction
  2982)       
  2983)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
  2984)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:) 
  2985)   
  2986)   type(coupler_type), pointer :: boundary_condition
  2987)   type(connection_set_list_type), pointer :: connection_set_list
  2988)   type(connection_set_type), pointer :: cur_connection_set
  2989)   PetscInt :: sum_connection, iconn
  2990)   PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
  2991)   PetscReal :: fraction_upwind, distance, dist_up, dist_dn, rdum
  2992)   
  2993)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
  2994)   PetscReal :: vol_frac_prim
  2995) 
  2996) #ifdef CENTRAL_DIFFERENCE
  2997)   PetscReal :: T_11(realization%option%nphase)
  2998)   PetscReal :: T_12(realization%option%nphase)
  2999)   PetscReal :: T_21(realization%option%nphase)
  3000)   PetscReal :: T_22(realization%option%nphase)
  3001)   PetscReal :: J_11(realization%reaction%ncomp,realization%reaction%ncomp)
  3002)   PetscReal :: J_12(realization%reaction%ncomp,realization%reaction%ncomp)
  3003)   PetscReal :: J_21(realization%reaction%ncomp,realization%reaction%ncomp)
  3004)   PetscReal :: J_22(realization%reaction%ncomp,realization%reaction%ncomp)
  3005)   PetscReal :: Res(realization%reaction%ncomp)  
  3006) #else
  3007)   PetscReal :: coef_up(realization%option%nphase)
  3008)   PetscReal :: coef_dn(realization%option%nphase)
  3009)   PetscReal :: Jup(realization%reaction%ncomp,realization%reaction%ncomp)
  3010)   PetscReal :: Jdn(realization%reaction%ncomp,realization%reaction%ncomp)
  3011)   PetscReal :: Res(realization%reaction%ncomp)  
  3012) #endif
  3013) 
  3014)   option => realization%option
  3015)   field => realization%field
  3016)   patch => realization%patch  
  3017)   grid => patch%grid
  3018)   reaction => realization%reaction
  3019)   rt_parameter => patch%aux%RT%rt_parameter
  3020)   rt_auxvars => patch%aux%RT%auxvars
  3021)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
  3022)   global_auxvars => patch%aux%Global%auxvars
  3023)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  3024)   if (option%use_mc) then
  3025)     rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
  3026)   endif
  3027) 
  3028) 
  3029)   vol_frac_prim = 1.d0
  3030) 
  3031)   ! Interior Flux Terms -----------------------------------
  3032)   ! must zero out Jacobian blocks
  3033) 
  3034)   call PetscLogEventBegin(logging%event_rt_jacobian_flux,ierr);CHKERRQ(ierr)
  3035) 
  3036)   connection_set_list => grid%internal_connection_set_list
  3037)   cur_connection_set => connection_set_list%first
  3038)   sum_connection = 0  
  3039)   do 
  3040)     if (.not.associated(cur_connection_set)) exit
  3041)     do iconn = 1, cur_connection_set%num_connections
  3042)       sum_connection = sum_connection + 1
  3043) 
  3044)       ghosted_id_up = cur_connection_set%id_up(iconn)
  3045)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  3046) 
  3047)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  3048)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  3049) 
  3050)       if (patch%imat(ghosted_id_up) <= 0 .or.  &
  3051)           patch%imat(ghosted_id_dn) <= 0) cycle
  3052) 
  3053)       if (option%use_mc) then
  3054)         vol_frac_prim = rt_sec_transport_vars(local_id_up)%epsilon
  3055)       endif 
  3056) 
  3057) #ifndef CENTRAL_DIFFERENCE
  3058)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  3059)                 patch%internal_velocities(:,sum_connection), &
  3060)                 patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
  3061)                 cur_connection_set%dist(-1,iconn), &
  3062)                 coef_up,coef_dn)
  3063)       call TFluxDerivative(rt_parameter, &
  3064)                            rt_auxvars(ghosted_id_up), &
  3065)                            global_auxvars(ghosted_id_up), &
  3066)                            rt_auxvars(ghosted_id_dn), &
  3067)                            global_auxvars(ghosted_id_dn), &
  3068)                            coef_up,coef_dn,option,Jup,Jdn)
  3069)       if (local_id_up>0) then
  3070)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  3071)                                       Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  3072)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  3073)                                       Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  3074)       endif
  3075)    
  3076)       if (local_id_dn>0) then
  3077)         Jup = -Jup
  3078)         Jdn = -Jdn
  3079)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  3080)                                       Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  3081)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  3082)                                       Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  3083)       endif
  3084) 
  3085) #else
  3086)       call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
  3087)                 patch%internal_velocities(:,sum_connection), &
  3088)                 patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
  3089)                 cur_connection_set%dist(-1,iconn), &
  3090)                 T_11,T_12,T_21,T_22)
  3091)       call TFluxDerivative_CD(rt_parameter, &
  3092)                            rt_auxvars(ghosted_id_up), &
  3093)                            global_auxvars(ghosted_id_up), &
  3094)                            rt_auxvars(ghosted_id_dn), &
  3095)                            global_auxvars(ghosted_id_dn), &
  3096)                            T_11,T_12,T_21,T_22,option, &
  3097)                            J_11,J_12,J_21,J_22)
  3098)       if (local_id_up>0) then
  3099)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  3100)                                       J_11,ADD_VALUES,ierr);CHKERRQ(ierr)
  3101)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  3102)                                       J_12,ADD_VALUES,ierr);CHKERRQ(ierr)
  3103)       endif
  3104)    
  3105)       if (local_id_dn>0) then
  3106)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  3107)                                       J_22,ADD_VALUES,ierr);CHKERRQ(ierr)
  3108)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  3109)                                       J_21,ADD_VALUES,ierr);CHKERRQ(ierr)
  3110)       endif
  3111) #endif
  3112) 
  3113) 
  3114)     enddo
  3115)     cur_connection_set => cur_connection_set%next
  3116)   enddo    
  3117) 
  3118)   call PetscLogEventEnd(logging%event_rt_jacobian_flux,ierr);CHKERRQ(ierr)
  3119)   
  3120)   ! Boundary Flux Terms -----------------------------------
  3121)   ! must zero out Jacobian block
  3122) 
  3123)   call PetscLogEventBegin(logging%event_rt_jacobian_fluxbc,ierr);CHKERRQ(ierr)
  3124) 
  3125)   boundary_condition => patch%boundary_condition_list%first
  3126)   sum_connection = 0    
  3127)   do 
  3128)     if (.not.associated(boundary_condition)) exit
  3129)     
  3130)     cur_connection_set => boundary_condition%connection_set
  3131)     
  3132)     do iconn = 1, cur_connection_set%num_connections
  3133)       sum_connection = sum_connection + 1
  3134)     
  3135)       local_id = cur_connection_set%id_dn(iconn)
  3136)       ghosted_id = grid%nL2G(local_id)
  3137) 
  3138)       if (patch%imat(ghosted_id) <= 0) cycle
  3139)     
  3140)       if (option%use_mc) then
  3141)         vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
  3142)       endif 
  3143) 
  3144) #ifndef CENTRAL_DIFFERENCE
  3145)       ! TFluxCoef accomplishes the same as what TBCCoef would
  3146)       call TFluxCoef(option,cur_connection_set%area(iconn), &
  3147)                 patch%boundary_velocities(:,sum_connection), &
  3148)                 patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
  3149)                 0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
  3150)                 coef_up,coef_dn)
  3151)       ! TFluxDerivative accomplishes the same as what TBCFluxDerivative would
  3152)       call TFluxDerivative(rt_parameter, &
  3153)                            rt_auxvars_bc(sum_connection), &
  3154)                            global_auxvars_bc(sum_connection), &
  3155)                            rt_auxvars(ghosted_id), &
  3156)                            global_auxvars(ghosted_id), &
  3157)                            coef_up,coef_dn,option,Jup,Jdn)
  3158) 
  3159)       !Jup not needed 
  3160)       Jdn = -Jdn
  3161)       
  3162)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jdn,ADD_VALUES, &
  3163)                                     ierr);CHKERRQ(ierr)
  3164)  
  3165) #else
  3166)       call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
  3167)                  patch%boundary_velocities(:,sum_connection), &
  3168)                  patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
  3169)                  0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
  3170)                  T_11,T_12,T_21,T_22)
  3171)       call TFluxDerivative_CD(rt_parameter, &
  3172)                            rt_auxvars_bc(sum_connection), &
  3173)                            global_auxvars_bc(sum_connection), &
  3174)                            rt_auxvars(ghosted_id), &
  3175)                            global_auxvars(ghosted_id), &
  3176)                            T_11,T_12,T_21,T_22,option, &
  3177)                            J_11,J_12,J_21,J_22)
  3178)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,J_22,ADD_VALUES, &
  3179)                                     ierr);CHKERRQ(ierr)
  3180) #endif
  3181)  
  3182)     enddo
  3183)     boundary_condition => boundary_condition%next
  3184)   enddo
  3185)   call PetscLogEventEnd(logging%event_rt_jacobian_fluxbc,ierr);CHKERRQ(ierr)
  3186) 
  3187) end subroutine RTJacobianFlux
  3188) 
  3189) ! ************************************************************************** !
  3190) 
  3191) subroutine RTJacobianNonFlux(snes,xx,A,B,realization,ierr)
  3192)   ! 
  3193)   ! Computes non-flux term entries in the Jacobian for
  3194)   ! reactive transport
  3195)   ! 
  3196)   ! Author: Glenn Hammond
  3197)   ! Date: 02/14/08
  3198)   ! 
  3199) 
  3200)   use Realization_Subsurface_class
  3201)   use Patch_module
  3202)   use Transport_module
  3203)   use Option_module
  3204)   use Field_module
  3205)   use Grid_module
  3206)   use Connection_module
  3207)   use Coupler_module  
  3208)   use Debug_module
  3209)   use Logging_module
  3210)   use Secondary_Continuum_Aux_module
  3211) 
  3212)   
  3213)   implicit none
  3214) 
  3215)   SNES :: snes
  3216)   Vec :: xx
  3217)   Mat :: A, B
  3218)   type(realization_subsurface_type) :: realization  
  3219)   PetscErrorCode :: ierr
  3220)   
  3221)   PetscReal, pointer :: r_p(:)
  3222)   PetscReal, pointer :: work_loc_p(:)
  3223)   PetscInt :: local_id, ghosted_id
  3224)   PetscInt :: istartaq, iendaq
  3225)   PetscInt :: istart, iend
  3226)   PetscInt :: offset, idof                  
  3227)   type(grid_type), pointer :: grid
  3228)   type(option_type), pointer :: option
  3229)   type(field_type), pointer :: field
  3230)   type(patch_type), pointer :: patch
  3231)   type(reaction_type), pointer :: reaction
  3232)   type(reactive_transport_param_type), pointer :: rt_parameter
  3233)   PetscInt :: tran_pc
  3234)     
  3235)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
  3236)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:) 
  3237)   class(material_auxvar_type), pointer :: material_auxvars(:)
  3238)   PetscReal :: Jup(realization%reaction%ncomp,realization%reaction%ncomp)
  3239)   PetscReal :: Res(realization%reaction%ncomp)    
  3240)   
  3241)   type(coupler_type), pointer :: source_sink
  3242)   type(connection_set_type), pointer :: cur_connection_set
  3243)   PetscInt :: iconn, sum_connection
  3244)   PetscReal :: qsrc, rdum
  3245)   PetscBool :: volumetric
  3246)   PetscInt :: flow_src_sink_type
  3247)   PetscReal :: coef_in, coef_out
  3248)   PetscReal :: scale
  3249)   
  3250)   ! secondary continuum variables
  3251)   type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
  3252)   PetscReal :: vol_frac_prim
  3253)   PetscReal :: sec_diffusion_coefficient
  3254)   PetscReal :: sec_porosity
  3255)   PetscReal :: jac_transport(realization%reaction%naqcomp,realization%reaction%naqcomp)
  3256)   PetscInt :: ncomp
  3257) 
  3258)   
  3259)   option => realization%option
  3260)   field => realization%field
  3261)   patch => realization%patch  
  3262)   reaction => realization%reaction
  3263)   grid => patch%grid
  3264)   rt_parameter => patch%aux%RT%rt_parameter
  3265)   rt_auxvars => patch%aux%RT%auxvars
  3266)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
  3267)   global_auxvars => patch%aux%Global%auxvars
  3268)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  3269)   material_auxvars => patch%aux%Material%auxvars
  3270)   if (option%use_mc) then
  3271)     rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
  3272)   endif
  3273) 
  3274)   vol_frac_prim = 1.d0
  3275)   
  3276)   if (.not.option%steady_state) then
  3277)   call PetscLogEventBegin(logging%event_rt_jacobian_accum,ierr);CHKERRQ(ierr)
  3278) #if 1  
  3279)     do local_id = 1, grid%nlmax  ! For each local node do...
  3280)       ghosted_id = grid%nL2G(local_id)
  3281)       !geh - Ignore inactive cells with inactive materials
  3282)       if (patch%imat(ghosted_id) <= 0) cycle
  3283)       
  3284)       call RTAccumulationDerivative(rt_auxvars(ghosted_id), &
  3285)                                     global_auxvars(ghosted_id), &
  3286)                                     material_auxvars(ghosted_id), &
  3287)                                     reaction,option,Jup) 
  3288)                                     
  3289)       if (reaction%neqsorb > 0) then
  3290)         call RAccumulationSorbDerivative(rt_auxvars(ghosted_id), &
  3291)                                          global_auxvars(ghosted_id), &
  3292)                                          material_auxvars(ghosted_id), &
  3293)                                          reaction,option,Jup)
  3294)       endif
  3295)       
  3296)       if (option%use_mc) then
  3297)       
  3298)         vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
  3299)         Jup = Jup*vol_frac_prim
  3300) 
  3301)         sec_diffusion_coefficient = patch%material_property_array(1)% &
  3302)                                     ptr%secondary_continuum_diff_coeff
  3303)         sec_porosity = patch%material_property_array(1)%ptr% &
  3304)                        secondary_continuum_porosity
  3305)                         
  3306)         if (realization%reaction%ncomp /= realization%reaction%naqcomp) then
  3307)           option%io_buffer = 'Current multicomponent implementation is for '// &
  3308)                              'aqueous reactions only'
  3309)           call printErrMsg(option)
  3310)         endif
  3311)         
  3312)         if (rt_sec_transport_vars(local_id)%sec_jac_update) then
  3313)           jac_transport = rt_sec_transport_vars(local_id)%sec_jac
  3314)         else
  3315)           option%io_buffer = 'RT secondary continuum term in primary '// &
  3316)                              'jacobian not updated'
  3317)           call printErrMsg(option)
  3318)         endif
  3319)          
  3320)         Jup = Jup - jac_transport                                                                   
  3321)                                                                                 
  3322)       endif
  3323) 
  3324)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
  3325)                                     ierr);CHKERRQ(ierr)
  3326)     enddo
  3327) #endif
  3328)   call PetscLogEventEnd(logging%event_rt_jacobian_accum,ierr);CHKERRQ(ierr)
  3329)   endif
  3330) #if 1
  3331)   ! Source/Sink terms -------------------------------------
  3332)   call PetscLogEventBegin(logging%event_rt_jacobian_ss,ierr);CHKERRQ(ierr)
  3333)   source_sink => patch%source_sink_list%first 
  3334)   sum_connection = 0
  3335)   do 
  3336)     if (.not.associated(source_sink)) exit
  3337)     
  3338)     cur_connection_set => source_sink%connection_set
  3339) 
  3340)     do iconn = 1, cur_connection_set%num_connections      
  3341)       sum_connection = sum_connection + 1
  3342)       local_id = cur_connection_set%id_dn(iconn)
  3343)       ghosted_id = grid%nL2G(local_id)
  3344) 
  3345)       if (patch%imat(ghosted_id) <= 0) cycle
  3346) 
  3347)       istartaq = reaction%offset_aqueous + 1
  3348)       iendaq = reaction%offset_aqueous + reaction%naqcomp
  3349)       
  3350)       qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
  3351)       call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype,coef_in,coef_out)
  3352) 
  3353)       Jup = 0.d0
  3354)       ! coef_in is non-zero
  3355)       if (dabs(coef_in-1.d20) > 0.d0) then
  3356)         Jup(istartaq:iendaq,istartaq:iendaq) = coef_in* &
  3357)           rt_auxvars(ghosted_id)%aqueous%dtotal(:,:,option%liquid_phase)
  3358)         if (reaction%ncoll > 0) then
  3359)           option%io_buffer = 'Source/sink not yet implemented for colloids'
  3360)           call printErrMsg(option)
  3361)         endif
  3362)         call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
  3363)                                       ierr);CHKERRQ(ierr)
  3364)       endif
  3365)     enddo                       
  3366)     source_sink => source_sink%next
  3367)   enddo
  3368)   
  3369)   call PetscLogEventEnd(logging%event_rt_jacobian_ss,ierr);CHKERRQ(ierr)
  3370) #endif
  3371) 
  3372) 
  3373) #if 1  
  3374) ! Reactions
  3375)   if (associated(reaction)) then
  3376) 
  3377)     call PetscLogEventBegin(logging%event_rt_jac_reaction,ierr);CHKERRQ(ierr)
  3378)                               
  3379)     do local_id = 1, grid%nlmax  ! For each local node do...
  3380)       ghosted_id = grid%nL2G(local_id)
  3381)       !geh - Ignore inactive cells with inactive materials
  3382)       if (patch%imat(ghosted_id) <= 0) cycle
  3383)       Res = 0.d0
  3384)       Jup = 0.d0
  3385)       if (.not.option%use_isothermal) then
  3386)         call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
  3387)                                        PETSC_FALSE,option)
  3388)       endif      
  3389)       call RReactionDerivative(Res,Jup,rt_auxvars(ghosted_id), &
  3390)                                global_auxvars(ghosted_id), &
  3391)                                material_auxvars(ghosted_id), &
  3392)                                reaction,option)
  3393)       if (option%use_mc) then
  3394)         vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
  3395)         Jup = Jup*vol_frac_prim
  3396)       endif
  3397)       call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1, &
  3398)                                     Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  3399)     enddo
  3400)     
  3401)     call PetscLogEventEnd(logging%event_rt_jac_reaction,ierr);CHKERRQ(ierr)
  3402)     
  3403)   endif
  3404) #endif
  3405)   
  3406)   ! Mass Transfer - since the current implementation of mass transfer has
  3407)   ! mass transfer being fixed.  Nothing to do here as the contribution to
  3408)   ! the derivatives is zero.
  3409) !  if (field%tran_mass_transfer /= 0) then
  3410) !  endif
  3411)  
  3412)   if (reaction%use_log_formulation) then
  3413)     call PetscLogEventBegin(logging%event_rt_jacobian_zero_calc, &
  3414)                             ierr);CHKERRQ(ierr)
  3415)     call VecGetArrayF90(field%tran_work_loc, work_loc_p, ierr);CHKERRQ(ierr)
  3416)     do ghosted_id = 1, grid%ngmax  ! For each local node do...
  3417)       offset = (ghosted_id-1)*reaction%ncomp
  3418)       if (patch%imat(ghosted_id) <= 0) then
  3419)         istart = offset + 1
  3420)         iend = offset + reaction%ncomp
  3421)         work_loc_p(istart:iend) = 1.d0
  3422)       else
  3423)         istartaq = offset + reaction%offset_aqueous + 1
  3424)         iendaq = offset + reaction%offset_aqueous + reaction%naqcomp
  3425)         work_loc_p(istartaq:iendaq) = rt_auxvars(ghosted_id)%pri_molal(:)
  3426)         if (reaction%nimcomp > 0) then
  3427)           istart = offset + reaction%offset_immobile + 1
  3428)           iend = offset + reaction%offset_immobile + reaction%nimcomp
  3429)           work_loc_p(istart:iend) = &
  3430)             rt_auxvars(ghosted_id)%immobile(:)
  3431)         endif
  3432)         if (reaction%ncoll > 0) then
  3433)           istart = offset + reaction%offset_colloid + 1
  3434)           iend = offset + reaction%offset_colloid + reaction%ncoll
  3435)           work_loc_p(istart:iend) = &
  3436)             rt_auxvars(ghosted_id)%colloid%conc_mob(:)
  3437)         endif
  3438)       endif
  3439)     enddo
  3440)     call VecRestoreArrayF90(field%tran_work_loc, work_loc_p,  &
  3441)                             ierr);CHKERRQ(ierr)
  3442)     call PetscLogEventEnd(logging%event_rt_jacobian_zero_calc, &
  3443)                           ierr);CHKERRQ(ierr)
  3444)   endif
  3445) 
  3446)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3447)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3448)   
  3449)   if (patch%aux%RT%inactive_cells_exist) then
  3450)     call PetscLogEventBegin(logging%event_rt_jacobian_zero,ierr);CHKERRQ(ierr)
  3451)     rdum = 1.d0
  3452)     call MatZeroRowsLocal(A,patch%aux%RT%n_zero_rows, &
  3453)                           patch%aux%RT%zero_rows_local_ghosted,rdum, &
  3454)                           PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  3455)                           ierr);CHKERRQ(ierr)
  3456)     call PetscLogEventEnd(logging%event_rt_jacobian_zero,ierr);CHKERRQ(ierr)
  3457)   endif
  3458) 
  3459) end subroutine RTJacobianNonFlux
  3460) 
  3461) ! ************************************************************************** !
  3462) 
  3463) subroutine RTJacobianEquilibrateCO2(J,realization)
  3464)   ! 
  3465)   ! Adds CO2 saturation constraint to Jacobian for
  3466)   ! reactive transport
  3467)   ! 
  3468)   ! Author: Glenn Hammond/Peter Lichtner
  3469)   ! Date: 12/12/14
  3470)   ! 
  3471) 
  3472)   use Realization_Subsurface_class
  3473)   use Patch_module
  3474)   use Option_module
  3475)   use Field_module
  3476)   use Grid_module
  3477) 
  3478)   implicit none
  3479) 
  3480)   Mat :: J
  3481)   type(realization_subsurface_type) :: realization  
  3482)   
  3483)   PetscInt :: local_id, ghosted_id
  3484)   PetscInt :: idof                  
  3485)   type(grid_type), pointer :: grid
  3486)   type(option_type), pointer :: option
  3487)   type(field_type), pointer :: field
  3488)   type(patch_type), pointer :: patch
  3489)   type(reaction_type), pointer :: reaction
  3490)   PetscErrorCode :: ierr
  3491)     
  3492)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  3493)   type(global_auxvar_type), pointer :: global_auxvars(:)
  3494)   PetscInt :: zero_rows(realization%patch%grid%nlmax * realization%option%ntrandof)
  3495)   PetscInt :: ghosted_rows(realization%patch%grid%nlmax)
  3496)   PetscInt :: zero_count
  3497)   PetscInt :: i, jco2
  3498)   PetscReal :: jacobian_entry
  3499)   PetscReal :: eps = 1.d-6
  3500) 
  3501)   option => realization%option
  3502)   field => realization%field
  3503)   patch => realization%patch  
  3504)   reaction => realization%reaction
  3505)   grid => patch%grid
  3506)   rt_auxvars => patch%aux%RT%auxvars
  3507)   global_auxvars => patch%aux%Global%auxvars
  3508) 
  3509)   ! loop over cells twice.  the first time to zero (all rows to be zeroed have
  3510)   ! to be zeroed in a single call by passing in a list).  the second loop to 
  3511)   ! add the equilibration
  3512) 
  3513)   jacobian_entry = 1.d0
  3514)   jco2 = reaction%species_idx%co2_aq_id
  3515)   zero_count = 0
  3516)   zero_rows = 0
  3517)   ghosted_rows = 0
  3518)   do local_id = 1, grid%nlmax  ! For each local node do...
  3519)     ghosted_id = grid%nL2G(local_id)
  3520)     if (patch%imat(ghosted_id) <= 0) cycle
  3521)     if (global_auxvars(ghosted_id)%sat(GAS_PHASE) > eps .and. &
  3522)       global_auxvars(ghosted_id)%sat(GAS_PHASE) < 1.d0-eps) then
  3523)       zero_count = zero_count + 1
  3524)       zero_rows(zero_count) = jco2+(ghosted_id-1)*reaction%ncomp-1
  3525)       ghosted_rows(zero_count) = ghosted_id
  3526)     endif
  3527)   enddo
  3528) 
  3529)   call MatZeroRowsLocal(J,zero_count,zero_rows(1:zero_count),jacobian_entry, &
  3530)                         PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  3531)                         ierr);CHKERRQ(ierr)
  3532) 
  3533)   do i = 1, zero_count
  3534)     ghosted_id = ghosted_rows(i) ! zero indexing back to 1-based
  3535)     if (patch%imat(ghosted_id) <= 0) cycle
  3536)     if (reaction%use_log_formulation) then
  3537)       jacobian_entry = rt_auxvars(ghosted_id)%pri_molal(jco2)
  3538)     else
  3539)       jacobian_entry = 1.d0
  3540)     endif
  3541) 
  3542)     idof = (ghosted_id-1)*option%ntrandof + jco2
  3543)     call MatSetValuesLocal(J,1,idof-1,1,idof-1,jacobian_entry,INSERT_VALUES, &
  3544)                            ierr);CHKERRQ(ierr)
  3545)   enddo
  3546) 
  3547)   call MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3548)   call MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  3549) 
  3550) end subroutine RTJacobianEquilibrateCO2
  3551) 
  3552) ! ************************************************************************** !
  3553) 
  3554) subroutine RTUpdateAuxVars(realization,update_cells,update_bcs, &
  3555)                            update_activity_coefs)
  3556)   ! 
  3557)   ! Updates the auxiliary variables associated with
  3558)   ! reactive transport
  3559)   ! 
  3560)   ! Author: Glenn Hammond
  3561)   ! Date: 02/15/08
  3562)   ! 
  3563) 
  3564)   use Realization_Subsurface_class
  3565)   use Patch_module
  3566)   use Grid_module
  3567)   use Coupler_module
  3568)   use Connection_module
  3569)   use Option_module
  3570)   use Field_module
  3571)   use Logging_module
  3572)   
  3573) #ifdef XINGYUAN_BC
  3574) !  use Dataset_module
  3575) !  use Dataset_Aux_module
  3576)   use Output_Tecplot_module
  3577) #endif
  3578)   
  3579)   implicit none
  3580) 
  3581)   type(realization_subsurface_type) :: realization
  3582)   PetscBool :: update_bcs
  3583)   PetscBool :: update_cells
  3584)   PetscBool :: update_activity_coefs
  3585)   
  3586)   type(option_type), pointer :: option
  3587)   type(field_type), pointer :: field
  3588)   type(grid_type), pointer :: grid
  3589)   type(patch_type), pointer :: patch
  3590)   type(reaction_type), pointer :: reaction
  3591)   type(coupler_type), pointer :: boundary_condition
  3592)   type(connection_set_type), pointer :: cur_connection_set
  3593) 
  3594)   PetscInt :: ghosted_id, local_id, sum_connection, idof, iconn
  3595)   PetscInt :: istartaq, iendaq 
  3596)   PetscInt :: istartcoll, iendcoll
  3597)   PetscInt :: istartaq_loc, iendaq_loc
  3598)   PetscInt :: istartcoll_loc, iendcoll_loc
  3599)   PetscInt :: istartim, iendim
  3600)   PetscReal, pointer :: xx_loc_p(:)
  3601)   PetscReal :: xxbc(realization%reaction%ncomp)
  3602)   PetscReal, pointer :: basis_molarity_p(:)
  3603)   PetscReal, pointer :: basis_coll_conc_p(:)
  3604)   PetscReal :: weight
  3605)   PetscInt, parameter :: iphase = 1
  3606)   PetscInt :: offset
  3607)   PetscErrorCode :: ierr
  3608)   PetscBool :: skip_equilibrate_constraint
  3609)   PetscInt, save :: icall
  3610)   
  3611) #ifdef XINGYUAN_BC
  3612)   character(len=MAXSTRINGLENGTH) :: string
  3613)   character(len=MAXWORDLENGTH) :: name
  3614)   PetscInt :: idof_aq_dataset
  3615)   class(dataset_type), pointer :: dataset
  3616)   PetscReal :: temp_real
  3617)   PetscBool, save :: first = PETSC_TRUE
  3618)   PetscReal, pointer :: work_p(:)
  3619) #endif  
  3620)   
  3621)   data icall/0/
  3622) 
  3623)   option => realization%option
  3624)   patch => realization%patch  
  3625)   grid => patch%grid
  3626)   field => realization%field
  3627)   reaction => realization%reaction
  3628) 
  3629) #ifdef XINGYUAN_BC
  3630) !geh  call VecZeroEntries(field%work,ierr)
  3631) !geh  call VecGetArrayReadF90(field%work,work_p,ierr)
  3632) #endif  
  3633)   
  3634)   call VecGetArrayReadF90(field%tran_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
  3635) 
  3636)   if (update_cells) then
  3637) 
  3638)     call PetscLogEventBegin(logging%event_rt_auxvars,ierr);CHKERRQ(ierr)
  3639)   
  3640)     do ghosted_id = 1, grid%ngmax
  3641)       if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
  3642)       !geh - Ignore inactive cells with inactive materials
  3643) 
  3644)       if (patch%imat(ghosted_id) <= 0) cycle
  3645) 
  3646)       offset = (ghosted_id-1)*reaction%ncomp
  3647)       istartaq = offset + reaction%offset_aqueous + 1
  3648)       iendaq = offset + reaction%offset_aqueous + reaction%naqcomp
  3649)       
  3650)       patch%aux%RT%auxvars(ghosted_id)%pri_molal = xx_loc_p(istartaq:iendaq)
  3651)       if (reaction%nimcomp > 0) then
  3652)         istartim = offset + reaction%offset_immobile + 1
  3653)         iendim = offset + reaction%offset_immobile + reaction%nimcomp
  3654)         patch%aux%RT%auxvars(ghosted_id)%immobile = xx_loc_p(istartim:iendim)
  3655)       endif
  3656)       if (reaction%ncoll > 0) then
  3657)         istartcoll = offset + reaction%offset_colloid + 1
  3658)         iendcoll = offset + reaction%offset_colloid + reaction%ncoll
  3659)         patch%aux%RT%auxvars(ghosted_id)%colloid%conc_mob = &
  3660)           xx_loc_p(istartcoll:iendcoll)* &
  3661)           patch%aux%Global%auxvars(ghosted_id)%den_kg(1)*1.d-3
  3662)       endif
  3663)       if (.not.option%use_isothermal) then
  3664)         call RUpdateTempDependentCoefs(patch%aux%Global%auxvars(ghosted_id), &
  3665)                                        reaction,PETSC_FALSE, &
  3666)                                        option)
  3667)       endif
  3668)       if (update_activity_coefs) then
  3669)         call RActivityCoefficients(patch%aux%RT%auxvars(ghosted_id), &
  3670)                                    patch%aux%Global%auxvars(ghosted_id), &
  3671)                                    reaction,option)
  3672)         if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
  3673)           call CO2AqActCoeff(patch%aux%RT%auxvars(ghosted_id), &
  3674)                                    patch%aux%Global%auxvars(ghosted_id), &
  3675)                                    reaction,option)
  3676)         endif                           
  3677)       endif
  3678)       call RTAuxVarCompute(patch%aux%RT%auxvars(ghosted_id), &
  3679)                            patch%aux%Global%auxvars(ghosted_id), &
  3680)                            patch%aux%Material%auxvars(ghosted_id), &
  3681)                            reaction,option)
  3682) #if 0                           
  3683)       if (associated(reaction%species_idx) .and. &
  3684)           associated(patch%aux%Global%auxvars(ghosted_id)%m_nacl)) then
  3685)         if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
  3686)           patch%aux%Global%auxvars(ghosted_id)%m_nacl(1) = &
  3687)                 patch%aux%RT%auxvars(ghosted_id)%pri_molal(reaction%species_idx%na_ion_id)
  3688)           patch%aux%Global%auxvars(ghosted_id)%m_nacl(2) = &
  3689)                 patch%aux%RT%auxvars(ghosted_id)%pri_molal(reaction%species_idx%cl_ion_id)
  3690)          else
  3691)           patch%aux%Global%auxvars(ghosted_id)%m_nacl = option%m_nacl
  3692)         endif
  3693)       endif
  3694) #endif
  3695)     enddo
  3696) 
  3697)     call PetscLogEventEnd(logging%event_rt_auxvars,ierr);CHKERRQ(ierr)
  3698)   endif
  3699) 
  3700)   if (update_bcs) then
  3701) 
  3702)     call PetscLogEventBegin(logging%event_rt_auxvars_bc,ierr);CHKERRQ(ierr)
  3703) 
  3704)     boundary_condition => patch%boundary_condition_list%first
  3705)     sum_connection = 0    
  3706)     do 
  3707)       if (.not.associated(boundary_condition)) exit
  3708)       cur_connection_set => boundary_condition%connection_set
  3709) 
  3710)       basis_molarity_p => boundary_condition%tran_condition% &
  3711)         cur_constraint_coupler%aqueous_species%basis_molarity
  3712) 
  3713)       if (reaction%ncoll > 0) then
  3714)         basis_coll_conc_p => boundary_condition%tran_condition% &
  3715)                              cur_constraint_coupler%colloids%basis_conc_mob
  3716)       endif
  3717) 
  3718) #ifdef XINGYUAN_BC
  3719)       idof_aq_dataset = 0
  3720)       do idof = 1, reaction%naqcomp ! primary aqueous concentrations
  3721)         if (boundary_condition%tran_condition% &
  3722)             cur_constraint_coupler%aqueous_species%external_dataset(idof)) then
  3723)           idof_aq_dataset = idof
  3724)           string = 'constraint ' // trim(boundary_condition%tran_condition% &
  3725)                                          cur_constraint_coupler%constraint_name)
  3726)           dataset => DatasetGetPointer(realization%datasets, &
  3727)                         boundary_condition%tran_condition% &
  3728)                           cur_constraint_coupler%aqueous_species% &
  3729)                           constraint_aux_string(idof), &
  3730)                         string,option)
  3731)           call DatasetLoad(dataset,option)
  3732)           exit
  3733)         endif
  3734)       enddo
  3735) #endif      
  3736) 
  3737)       do iconn = 1, cur_connection_set%num_connections
  3738)         sum_connection = sum_connection + 1
  3739)         local_id = cur_connection_set%id_dn(iconn)
  3740)         ghosted_id = grid%nL2G(local_id)
  3741)         
  3742)         if (patch%imat(ghosted_id) <= 0) cycle
  3743) 
  3744)         offset = (ghosted_id-1)*reaction%ncomp
  3745)         istartaq_loc = reaction%offset_aqueous + 1
  3746)         iendaq_loc = reaction%offset_aqueous + reaction%naqcomp
  3747)         istartaq = offset + istartaq_loc
  3748)         iendaq = offset + iendaq_loc
  3749)     
  3750)         if (reaction%ncoll > 0) then
  3751)           istartcoll_loc = reaction%offset_colloid + 1
  3752)           iendcoll_loc = reaction%offset_colloid + reaction%ncoll
  3753)           istartcoll = offset + istartcoll_loc
  3754)           iendcoll = offset + iendcoll_loc
  3755)         endif
  3756) 
  3757) #ifdef XINGYUAN_BC
  3758)   if (idof_aq_dataset > 0) then
  3759)     call DatasetInterpolateReal(dataset, &
  3760)             grid%x(ghosted_id)- &
  3761)               boundary_condition%connection_set%dist(0,iconn)* &
  3762)               boundary_condition%connection_set%dist(1,iconn), &
  3763)             grid%y(ghosted_id)- &
  3764)               boundary_condition%connection_set%dist(0,iconn)* &
  3765)               boundary_condition%connection_set%dist(2,iconn), &
  3766)             0.d0, &  ! z
  3767)             option%tran_time,temp_real,option)
  3768) !geh    work_p(local_id) = temp_real
  3769)     boundary_condition%tran_condition%cur_constraint_coupler% &
  3770)       aqueous_species%constraint_conc(idof_aq_dataset) = temp_real
  3771)     if (first) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = basis_molarity_p
  3772)     call ReactionEquilibrateConstraint( &
  3773)         patch%aux%RT%auxvars_bc(sum_connection), &
  3774)         patch%aux%Global%auxvars_bc(sum_connection),reaction, &
  3775)         boundary_condition%tran_condition%cur_constraint_coupler%constraint_name, &
  3776)         boundary_condition%tran_condition%cur_constraint_coupler%aqueous_species, &
  3777)         boundary_condition%tran_condition%cur_constraint_coupler%free_ion_guess, &
  3778)         boundary_condition%tran_condition%cur_constraint_coupler%minerals, &
  3779)         boundary_condition%tran_condition%cur_constraint_coupler%surface_complexes, &
  3780)         boundary_condition%tran_condition%cur_constraint_coupler%colloids, &
  3781)         boundary_condition%tran_condition%cur_constraint_coupler%immobile_species, &
  3782)         patch%aux%Material%auxvars(ghosted_id)%porosity, &
  3783)         boundary_condition%tran_condition%cur_constraint_coupler%num_iterations, &
  3784)         PETSC_TRUE,option)
  3785)     basis_molarity_p => boundary_condition%tran_condition% &
  3786)       cur_constraint_coupler%aqueous_species%basis_molarity 
  3787)   endif
  3788) #endif        
  3789) 
  3790) !       if (option%iflowmode /= MPH_MODE .or. icall>1) then
  3791)         if (option%iflowmode /= MPH_MODE .and. option%iflowmode /= FLASH2_MODE) then
  3792)   !       Note: the  DIRICHLET_BC is not time dependent in this case (icall)    
  3793)           select case(boundary_condition%tran_condition%itype)
  3794)             case(CONCENTRATION_SS,DIRICHLET_BC,NEUMANN_BC)
  3795)               ! since basis_molarity is in molarity, must convert to molality
  3796)                 ! by dividing by density of water (mol/L -> mol/kg)
  3797)               xxbc(istartaq_loc:iendaq_loc) = &
  3798)                 basis_molarity_p(1:reaction%naqcomp) / &
  3799)                 patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
  3800)                 1000.d0
  3801)               if (reaction%ncoll > 0) then
  3802)                 xxbc(istartcoll_loc:iendcoll_loc) = &
  3803)                   basis_coll_conc_p(1:reaction%ncoll) / &
  3804)                   patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
  3805)                   1000.d0
  3806)               endif
  3807)             case(DIRICHLET_ZERO_GRADIENT_BC)
  3808)   !geh            do iphase = 1, option%nphase
  3809)                 if (patch%boundary_velocities(iphase,sum_connection) >= 0.d0) then
  3810)                   ! same as dirichlet above
  3811)                   xxbc(istartaq_loc:iendaq_loc) = &
  3812)                     basis_molarity_p(1:reaction%naqcomp) / &
  3813)                     patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
  3814)                   & 1000.d0
  3815)                   if (reaction%ncoll > 0) then
  3816)                     xxbc(istartcoll_loc:iendcoll_loc) = &
  3817)                       basis_coll_conc_p(1:reaction%ncoll) / &
  3818)                       patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
  3819)                       1000.d0
  3820)                   endif
  3821)                 else
  3822)                   ! same as zero_gradient below
  3823)                   xxbc(istartaq_loc:iendaq_loc) = xx_loc_p(istartaq:iendaq)
  3824)                   if (reaction%ncoll > 0) then
  3825)                     xxbc(istartcoll_loc:iendcoll_loc) = &
  3826)                       basis_coll_conc_p(1:reaction%ncoll) / &
  3827)                       patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
  3828)                       1000.d0
  3829)                   endif
  3830)                 endif
  3831)   !geh          enddo
  3832)             case(ZERO_GRADIENT_BC)
  3833)               xxbc(istartaq_loc:iendaq_loc) = xx_loc_p(istartaq:iendaq)
  3834)               if (reaction%ncoll > 0) then
  3835)                 xxbc(istartcoll_loc:iendcoll_loc) = &
  3836)                   basis_coll_conc_p(1:reaction%ncoll) / &
  3837)                   patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
  3838)                   1000.d0
  3839)               endif
  3840)           end select
  3841)           ! no need to update boundary fluid density since it is already set
  3842)           patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
  3843)             xxbc(istartaq_loc:iendaq_loc)
  3844)           if (reaction%ncoll > 0) then
  3845)             patch%aux%RT%auxvars_bc(sum_connection)%colloid%conc_mob = &
  3846)               xxbc(istartcoll_loc:iendcoll_loc)* &
  3847)               patch%aux%Global%auxvars_bc(sum_connection)%den_kg(1)*1.d-3
  3848)           endif
  3849)           if (.not.option%use_isothermal) then
  3850)             call RUpdateTempDependentCoefs(patch%aux%Global% &
  3851)                                              auxvars_bc(sum_connection), &
  3852)                                            reaction,PETSC_FALSE, &
  3853)                                            option)
  3854)           endif          
  3855)           if (update_activity_coefs) then
  3856)             call RActivityCoefficients(patch%aux%RT%auxvars_bc(sum_connection), &
  3857)                                         patch%aux%Global%auxvars_bc(sum_connection), &
  3858)                                         reaction,option)
  3859)             if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
  3860)               call CO2AqActCoeff(patch%aux%RT%auxvars_bc(sum_connection), &
  3861)                                   patch%aux%Global%auxvars_bc(sum_connection), &
  3862)                                   reaction,option) 
  3863)               endif                           
  3864)           endif
  3865)           call RTAuxVarCompute(patch%aux%RT%auxvars_bc(sum_connection), &
  3866)                                patch%aux%Global%auxvars_bc(sum_connection), &
  3867)                                patch%aux%Material%auxvars(ghosted_id), &
  3868)                                reaction,option)
  3869)         else
  3870)           skip_equilibrate_constraint = PETSC_FALSE
  3871)         ! Chuan needs to fill this in.
  3872)           select case(boundary_condition%tran_condition%itype)
  3873)             case(CONCENTRATION_SS,DIRICHLET_BC,NEUMANN_BC)
  3874)               ! don't need to do anything as the constraint below provides all
  3875)               ! the concentrations, etc.
  3876)               
  3877)               !geh: terrible kludge, but should work for now.
  3878)               !geh: the problem is that ...%pri_molal() on first call is zero and 
  3879)               !     PETSC_TRUE is passed into ReactionEquilibrateConstraint() below
  3880)               !     for use_prev_soln_as_guess.  If the previous solution is zero,
  3881)               !     the code will crash.
  3882)               if (patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(1) < 1.d-200) then
  3883) !               patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = 1.d-9
  3884)                 patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
  3885)                     xx_loc_p(istartaq:iendaq)
  3886)               endif
  3887)             case(DIRICHLET_ZERO_GRADIENT_BC)
  3888)               if (patch%boundary_velocities(iphase,sum_connection) >= 0.d0) then
  3889)                   ! don't need to do anything as the constraint below provides all
  3890)                   ! the concentrations, etc.
  3891)                   
  3892)                 if (patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(1) < 1.d-200) then
  3893) !                 patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = 1.d-9
  3894)                   patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
  3895)                     xx_loc_p(istartaq:iendaq)
  3896)                 endif
  3897)               else
  3898)                 ! same as zero_gradient below
  3899)                 skip_equilibrate_constraint = PETSC_TRUE
  3900)                 patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
  3901)                   xx_loc_p(istartaq:iendaq)
  3902)                 if (reaction%ncoll > 0) then
  3903)                   patch%aux%RT%auxvars_bc(sum_connection)%colloid%conc_mob = &
  3904)                     xx_loc_p(istartcoll:iendcoll)* &
  3905)                       patch%aux%Global%auxvars_bc(sum_connection)%den_kg(1)*1.d-3
  3906)                 endif
  3907)               endif
  3908)             case(ZERO_GRADIENT_BC)
  3909)               skip_equilibrate_constraint = PETSC_TRUE
  3910)               patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
  3911)                 xx_loc_p(istartaq:iendaq)
  3912)               if (reaction%ncoll > 0) then
  3913)                 patch%aux%RT%auxvars_bc(sum_connection)%colloid%conc_mob = &
  3914)                   xx_loc_p(istartcoll:iendcoll)* &
  3915)                   patch%aux%Global%auxvars_bc(sum_connection)%den_kg(1)*1.d-3
  3916)               endif                
  3917)           end select
  3918)           ! no need to update boundary fluid density since it is already set
  3919)           if (.not.skip_equilibrate_constraint) then
  3920)             ! print *,'RT redo constrain on BCs: 1: ', sum_connection
  3921)             call ReactionEquilibrateConstraint(patch%aux%RT%auxvars_bc(sum_connection), &
  3922)               patch%aux%Global%auxvars_bc(sum_connection), &
  3923)               patch%aux%Material%auxvars(ghosted_id),reaction, &
  3924)               boundary_condition%tran_condition%cur_constraint_coupler%constraint_name, &
  3925)               boundary_condition%tran_condition%cur_constraint_coupler%aqueous_species, &
  3926)               boundary_condition%tran_condition%cur_constraint_coupler%free_ion_guess, &
  3927)               boundary_condition%tran_condition%cur_constraint_coupler%minerals, &
  3928)               boundary_condition%tran_condition%cur_constraint_coupler%surface_complexes, &
  3929)               boundary_condition%tran_condition%cur_constraint_coupler%colloids, &
  3930)               boundary_condition%tran_condition%cur_constraint_coupler%immobile_species, &
  3931)               boundary_condition%tran_condition%cur_constraint_coupler%num_iterations, &
  3932)               PETSC_TRUE,option)
  3933)             ! print *,'RT redo constrain on BCs: 2: ', sum_connection  
  3934)           endif         
  3935)         endif
  3936) #if 0
  3937)         if (associated(reaction%species_idx) .and. &
  3938)             associated(patch%aux%Global%auxvars_bc(sum_connection)%m_nacl)) then
  3939)           if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
  3940)             patch%aux%Global%auxvars_bc(sum_connection)%m_nacl(1) = &
  3941)                   patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(reaction%species_idx%na_ion_id)
  3942)             patch%aux%Global%auxvars_bc(sum_connection)%m_nacl(2) = &
  3943)                   patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(reaction%species_idx%cl_ion_id)
  3944)             else
  3945)             patch%aux%Global%auxvars_bc(sum_connection)%m_nacl = option%m_nacl
  3946)           endif
  3947)         endif
  3948) #endif        
  3949)       enddo ! iconn
  3950)       boundary_condition => boundary_condition%next
  3951)     enddo
  3952) 
  3953)     call PetscLogEventEnd(logging%event_rt_auxvars_bc,ierr);CHKERRQ(ierr)
  3954) 
  3955) #ifdef XINGYUAN_BC
  3956)     first = PETSC_FALSE
  3957)     !call VecRestoreArrayReadF90(field%work,work_p,ierr)
  3958)     !string = 'xingyuan_bc.tec'
  3959)     !name = 'xingyuan_bc'
  3960)     !call OutputVectorTecplot(string,name,realization,field%work)
  3961) #endif
  3962) 
  3963)   endif 
  3964) 
  3965)   patch%aux%RT%auxvars_up_to_date = update_cells .and. update_bcs
  3966)   
  3967)   call VecRestoreArrayReadF90(field%tran_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
  3968)   icall = icall+ 1
  3969)   
  3970) end subroutine RTUpdateAuxVars
  3971) 
  3972) ! ************************************************************************** !
  3973) 
  3974) subroutine RTMaxChange(realization,dcmax,dvfmax)
  3975)   ! 
  3976)   ! Computes the maximum change in the solution vector
  3977)   ! 
  3978)   ! Author: Glenn Hammond
  3979)   ! Date: 02/15/08
  3980)   ! 
  3981) 
  3982)   use Realization_Subsurface_class
  3983)   use Option_module
  3984)   use Field_module
  3985)   use Patch_module
  3986)   use Grid_module
  3987)   
  3988)   implicit none
  3989)   
  3990)   type(realization_subsurface_type) :: realization
  3991)   PetscReal :: dcmax
  3992)   PetscReal :: dvfmax
  3993)   
  3994)   type(option_type), pointer :: option
  3995)   type(field_type), pointer :: field 
  3996)   type(reaction_type), pointer :: reaction
  3997)   type(patch_type), pointer :: patch
  3998)   type(grid_type), pointer :: grid
  3999)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  4000)   PetscReal, pointer :: dxx_ptr(:), xx_ptr(:), yy_ptr(:)
  4001)   PetscInt :: local_id, ghosted_id, imnrl
  4002)   PetscReal :: delta_volfrac
  4003)   PetscErrorCode :: ierr
  4004)   
  4005)   option => realization%option
  4006)   field => realization%field
  4007)   reaction => realization%reaction
  4008)   patch => realization%patch
  4009)   grid => patch%grid
  4010)   rt_auxvars => patch%aux%RT%auxvars  
  4011) 
  4012)   dcmax = 0.d0
  4013)   dvfmax = 0.d0
  4014)   
  4015)   call VecWAXPY(field%tran_dxx,-1.d0,field%tran_xx,field%tran_yy, &
  4016)                 ierr);CHKERRQ(ierr)
  4017)   
  4018)   call VecStrideNorm(field%tran_dxx,ZERO_INTEGER,NORM_INFINITY,dcmax, &
  4019)                      ierr);CHKERRQ(ierr)
  4020)                      
  4021) #if 1
  4022)   ! update mineral volume fractions
  4023)   if (reaction%mineral%nkinmnrl > 0) then
  4024)     do local_id = 1, grid%nlmax
  4025)       ghosted_id = grid%nL2G(local_id)
  4026)       !geh - Ignore inactive cells with inactive materials
  4027)       if (patch%imat(ghosted_id) <= 0) cycle
  4028)       do imnrl = 1, reaction%mineral%nkinmnrl
  4029)         delta_volfrac = rt_auxvars(ghosted_id)%mnrl_rate(imnrl)* &
  4030)                         reaction%mineral%kinmnrl_molar_vol(imnrl)* &
  4031)                         option%tran_dt
  4032)         dvfmax = max(dabs(delta_volfrac),dvfmax)
  4033)       enddo
  4034)     enddo
  4035)   endif 
  4036) #endif
  4037)       
  4038) end subroutine RTMaxChange
  4039) 
  4040) ! ************************************************************************** !
  4041) 
  4042) subroutine RTSetPlotVariables(realization,list)
  4043)   ! 
  4044)   ! Adds variables to be printed to list
  4045)   ! 
  4046)   ! Author: Glenn Hammond
  4047)   ! Date: 10/15/12
  4048)   ! 
  4049)   
  4050)   use Realization_Subsurface_class
  4051)   use Option_module
  4052)   use Output_Aux_module
  4053)   use Variables_module
  4054)     
  4055)   implicit none
  4056)   
  4057)   type(realization_subsurface_type) :: realization
  4058)   type(output_variable_list_type), pointer :: list
  4059)   
  4060)   character(len=MAXWORDLENGTH) :: name,  units
  4061)   character(len=MAXSTRINGLENGTH) string
  4062)   character(len=2) :: free_mol_char, tot_mol_char, sec_mol_char
  4063)   type(option_type), pointer :: option
  4064)   type(reaction_type), pointer :: reaction
  4065)   PetscInt :: i
  4066)   
  4067)   option => realization%option
  4068)   reaction => realization%reaction
  4069)   
  4070)   if (reaction%print_free_conc_type == PRIMARY_MOLALITY) then
  4071)     free_mol_char = 'm'
  4072)   else
  4073)     free_mol_char = 'M'
  4074)   endif
  4075)   
  4076)   if (reaction%print_tot_conc_type == TOTAL_MOLALITY) then
  4077)     tot_mol_char = 'm'
  4078)   else
  4079)     tot_mol_char = 'M'
  4080)   endif
  4081)   
  4082)   if (reaction%print_secondary_conc_type == SECONDARY_MOLALITY) then
  4083)     sec_mol_char = 'm'
  4084)   else
  4085)     sec_mol_char = 'M'
  4086)   endif
  4087)   
  4088)   if (reaction%print_pH .and. associated(reaction%species_idx)) then
  4089)     if (reaction%species_idx%h_ion_id /= 0) then
  4090)       name = 'pH'
  4091)       units = ''
  4092)       call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,PH, &
  4093)                                    reaction%species_idx%h_ion_id)
  4094)     else
  4095)       option%io_buffer = 'pH may not be printed when H+ is not ' // &
  4096)         'defined as a species.'
  4097)       call printErrMsg(option)
  4098)     endif
  4099)   endif  
  4100)   
  4101)   if (reaction%print_EH .and. associated(reaction%species_idx)) then
  4102)     if (reaction%species_idx%o2_gas_id > 0) then
  4103)       name = 'Eh'
  4104)       units = 'V'
  4105)       call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,EH, &
  4106)                                    reaction%species_idx%h_ion_id)
  4107)     else
  4108)       option%io_buffer = 'Eh may not be printed when O2(g) is not ' // &
  4109)         'defined as a species.'
  4110)       call printErrMsg(option)
  4111)     endif
  4112)   endif  
  4113)   
  4114)   if (reaction%print_pe .and. associated(reaction%species_idx)) then
  4115)     if (reaction%species_idx%o2_gas_id > 0) then
  4116)       name = 'pe'
  4117)       units = ''
  4118)       call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,PE, &
  4119)                                    reaction%species_idx%h_ion_id)
  4120)     else
  4121)       option%io_buffer = 'pe may not be printed when O2(g) is not ' // &
  4122)         'defined as a species.'
  4123)       call printErrMsg(option)   
  4124)     endif
  4125)   endif  
  4126)   
  4127)   if (reaction%print_O2 .and. associated(reaction%species_idx)) then
  4128)     if (reaction%species_idx%o2_gas_id > 0) then
  4129)       name = 'logfO2'
  4130)       units = 'bars'
  4131)       call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,O2, &
  4132)                                    reaction%species_idx%o2_gas_id)
  4133)     else
  4134)       option%io_buffer = 'logfO2 may not be printed when O2(g) is not ' // &
  4135)         'defined as a species.'
  4136)       call printErrMsg(option)
  4137)     endif
  4138)   endif  
  4139)   
  4140)   if (reaction%print_total_component) then
  4141)     do i=1,reaction%naqcomp
  4142)       if (reaction%primary_species_print(i)) then
  4143)         name = 'Total ' // trim(reaction%primary_species_names(i))
  4144)         units = trim(tot_mol_char)
  4145)         call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4146)                                      reaction%print_tot_conc_type,i)
  4147)       endif
  4148)     enddo
  4149)   endif  
  4150)   
  4151)   if (reaction%print_free_ion) then
  4152)     do i=1,reaction%naqcomp
  4153)       if (reaction%primary_species_print(i)) then
  4154)         name = 'Free ' // trim(reaction%primary_species_names(i)) 
  4155)         units = trim(free_mol_char)
  4156)         call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4157)                                       reaction%print_free_conc_type,i)
  4158)       endif
  4159)     enddo
  4160)   endif  
  4161)   
  4162)   if (reaction%print_all_gas_species) then
  4163)     do i=1,reaction%ngas
  4164)       name = 'Gas species ' // trim(reaction%gas_species_names(i))
  4165)       units = trim('mol/m^3')
  4166)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4167)           GAS_CONCENTRATION,i)
  4168)     enddo
  4169)   endif
  4170) 
  4171)   if (reaction%print_total_bulk) then
  4172)     do i=1,reaction%naqcomp
  4173)       if (reaction%primary_species_print(i)) then
  4174)         name = 'Total Bulk ' // trim(reaction%primary_species_names(i))
  4175)         units = 'mol/m^3 bulk'
  4176)         call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4177)                                      TOTAL_BULK,i)   
  4178)       endif
  4179)     enddo
  4180)   endif
  4181)   
  4182)   if (reaction%print_act_coefs) then
  4183)     do i=1,reaction%naqcomp
  4184)       if (reaction%primary_species_print(i)) then
  4185)         name = 'Gamma ' // trim(reaction%primary_species_names(i))
  4186)         units = ''
  4187)         call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4188)                                      PRIMARY_ACTIVITY_COEF,i) 
  4189)       endif
  4190)     enddo
  4191)   endif
  4192)   
  4193)   do i=1,reaction%neqcplx
  4194)     if (reaction%secondary_species_print(i)) then
  4195)       name = trim(reaction%secondary_species_names(i))
  4196)       units = trim(sec_mol_char)
  4197)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4198)                                    reaction%print_secondary_conc_type,i) 
  4199)     endif
  4200)   enddo   
  4201) 
  4202)   do i=1,reaction%mineral%nkinmnrl
  4203)     if (reaction%mineral%kinmnrl_print(i)) then
  4204)       name = trim(reaction%mineral%kinmnrl_names(i)) // ' VF'
  4205)       units = ''
  4206)       call OutputVariableAddToList(list,name,OUTPUT_VOLUME_FRACTION,units, &
  4207)                                    MINERAL_VOLUME_FRACTION,i)     
  4208)     endif
  4209)   enddo
  4210)   
  4211)   do i=1,reaction%mineral%nkinmnrl
  4212)     if (reaction%mineral%kinmnrl_print(i)) then
  4213)       name = trim(reaction%mineral%kinmnrl_names(i)) // ' Rate'
  4214)       units = 'mol/m^3/sec'
  4215)       call OutputVariableAddToList(list,name,OUTPUT_RATE,units, &
  4216)                                    MINERAL_RATE,i)      
  4217)     endif
  4218)   enddo  
  4219)   
  4220)   if (reaction%mineral%print_saturation_index) then
  4221)     do i=1,reaction%mineral%nmnrl
  4222)       if (reaction%mineral%mnrl_print(i)) then
  4223)         name = trim(reaction%mineral%mineral_names(i)) // ' SI'
  4224)         units = ''
  4225)         call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4226)                                      MINERAL_SATURATION_INDEX,i)    
  4227)       endif
  4228)     enddo
  4229)   endif
  4230)   
  4231)   do i=1,reaction%immobile%nimmobile
  4232)     if (reaction%immobile%print_me(i)) then
  4233)       name = trim(reaction%immobile%names(i)) 
  4234)       units = 'mol/m^3'
  4235)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4236)                                    IMMOBILE_SPECIES,i)
  4237)     endif
  4238)   enddo
  4239)   
  4240)   do i=1,realization%reaction%surface_complexation%nsrfcplxrxn
  4241)     if (reaction%surface_complexation%srfcplxrxn_site_density_print(i)) then
  4242)       name = trim(reaction%surface_complexation%srfcplxrxn_site_names(i)) // &
  4243)              ' Site Density'
  4244)       units = 'mol/m^3 bulk'
  4245)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4246)                                    SURFACE_SITE_DENSITY,i)
  4247)     endif
  4248)   enddo  
  4249) 
  4250)   do i=1,realization%reaction%surface_complexation%nsrfcplxrxn
  4251)     if (reaction%surface_complexation%srfcplxrxn_site_print(i)) then
  4252)       name = 'Free ' // &
  4253)              trim(reaction%surface_complexation%srfcplxrxn_site_names(i))
  4254)       units = 'mol/m^3 bulk'
  4255)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4256)                                    SURFACE_CMPLX_FREE,i)
  4257)     endif
  4258)   enddo
  4259)   
  4260)   
  4261)   do i=1,realization%reaction%surface_complexation%nsrfcplx
  4262)     if (reaction%surface_complexation%srfcplx_print(i)) then
  4263)       name = reaction%surface_complexation%srfcplx_names(i)
  4264)       units = 'mol/m^3 bulk'
  4265)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4266)                                    SURFACE_CMPLX,i)
  4267)     endif
  4268)   enddo
  4269) 
  4270)   do i=1,realization%reaction%surface_complexation%nkinsrfcplxrxn
  4271)     if (reaction%surface_complexation%srfcplxrxn_site_print(i)) then
  4272)       option%io_buffer = 'Printing of kinetic surface complexes needs to be fixed'
  4273)       call printErrMsg(option)
  4274)       name = 'Free ' // &
  4275)              trim(reaction%surface_complexation%srfcplxrxn_site_names(i))
  4276)       units = 'mol/m^3 bulk'
  4277)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4278)                                    KIN_SURFACE_CMPLX_FREE,i)
  4279)     endif
  4280)   enddo  
  4281)   
  4282)   do i=1,realization%reaction%surface_complexation%nkinsrfcplx
  4283)     if (reaction%surface_complexation%srfcplx_print(i)) then
  4284)       option%io_buffer = 'Printing of kinetic surface complexes needs to be fixed'
  4285)       call printErrMsg(option)
  4286)       name = reaction%surface_complexation%srfcplx_names(i)
  4287)       units = 'mol/m^3 bulk'
  4288)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4289)                                    KIN_SURFACE_CMPLX,i)
  4290)     endif
  4291)   enddo  
  4292) 
  4293)   if (associated(reaction%kd_print)) then
  4294)     do i=1,reaction%naqcomp
  4295)       if (reaction%kd_print(i)) then
  4296)       name = trim(reaction%primary_species_names(i)) // ' KD'
  4297)       units = '-'
  4298)       call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4299)                                    PRIMARY_KD,i)
  4300)       endif
  4301)     enddo
  4302)   endif
  4303)   
  4304)   if (associated(reaction%total_sorb_print)) then
  4305)     do i=1,reaction%naqcomp
  4306)       if (reaction%total_sorb_print(i)) then
  4307)         name = 'Total Sorbed ' // trim(reaction%primary_species_names(i))
  4308)         units = 'mol/m^3'
  4309)         call  OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4310)                                       TOTAL_SORBED,i)        
  4311)       endif
  4312)     enddo
  4313)   endif
  4314)   
  4315)   if (associated(reaction%total_sorb_mobile_print)) then
  4316)     do i=1,reaction%ncollcomp
  4317)       if (reaction%total_sorb_mobile_print(i)) then
  4318)         name = 'Total Sorbed Mobile ' // &
  4319)                trim(reaction%colloid_species_names(i))
  4320)         units = trim(tot_mol_char)
  4321)         call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4322)                                      TOTAL_SORBED_MOBILE,i)  
  4323)       endif
  4324)     enddo
  4325)   endif  
  4326)   
  4327)   if (reaction%print_colloid) then
  4328)     do i=1,reaction%ncoll
  4329)       if (reaction%colloid_print(i)) then
  4330)         name = 'Mobile Colloidal ' // trim(reaction%colloid_names(i)) 
  4331)         units = trim(tot_mol_char)
  4332)         call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4333)                                      COLLOID_MOBILE,i)         
  4334)       endif
  4335)     enddo
  4336)     do i=1,reaction%ncoll
  4337)       if (reaction%colloid_print(i)) then
  4338)         name = 'Mobile Colloidal ' // trim(reaction%colloid_names(i))
  4339)         units = trim(tot_mol_char)
  4340)         call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
  4341)                                      COLLOID_IMMOBILE,i)         
  4342)       endif
  4343)     enddo
  4344)   endif
  4345) 
  4346)   if (reaction%print_age) then
  4347)     if (reaction%species_idx%tracer_age_id > 0) then
  4348)       name = 'Tracer Age'
  4349)       units = 'sec-molar'
  4350)       call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  4351)                                    AGE,reaction%species_idx%tracer_age_id, &
  4352)                                    reaction%species_idx%tracer_aq_id)       
  4353)     endif
  4354)   endif  
  4355)   
  4356) end subroutine RTSetPlotVariables
  4357) 
  4358) ! ************************************************************************** !
  4359) 
  4360) subroutine RTJumpStartKineticSorption(realization)
  4361)   ! 
  4362)   ! Calculates the concentrations of species sorbing
  4363)   ! through kinetic sorption processes based
  4364)   ! on equilibrium with the aqueous phase.
  4365)   ! 
  4366)   ! Author: Glenn Hammond
  4367)   ! Date: 08/05/09
  4368)   ! 
  4369) 
  4370)   use Realization_Subsurface_class
  4371)   use Patch_module
  4372)   use Grid_module
  4373)   use Option_module
  4374)   use Field_module
  4375)   
  4376)   implicit none
  4377) 
  4378)   type(realization_subsurface_type) :: realization
  4379)   
  4380)   type(option_type), pointer :: option
  4381)   type(field_type), pointer :: field
  4382)   type(grid_type), pointer :: grid
  4383)   type(patch_type), pointer :: patch
  4384)   type(reaction_type), pointer :: reaction
  4385) 
  4386)   PetscInt :: ghosted_id
  4387)   PetscErrorCode :: ierr
  4388)   
  4389)   option => realization%option
  4390)   patch => realization%patch  
  4391)   grid => patch%grid
  4392)   field => realization%field
  4393)   reaction => realization%reaction
  4394)   
  4395)   ! This subroutine assumes that the auxiliary variables are current!
  4396) 
  4397)   if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
  4398)     do ghosted_id = 1, grid%ngmax
  4399)       if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
  4400)       !geh - Ignore inactive cells with inactive materials
  4401)       if (patch%imat(ghosted_id) <= 0) cycle
  4402)       call RJumpStartKineticSorption(patch%aux%RT%auxvars(ghosted_id), &
  4403)                                      patch%aux%Global%auxvars(ghosted_id), &
  4404)                                      patch%aux%Material%auxvars(ghosted_id), &
  4405)                                      reaction,option)
  4406)     enddo
  4407)   endif
  4408) 
  4409) end subroutine RTJumpStartKineticSorption
  4410) 
  4411) ! ************************************************************************** !
  4412) 
  4413) subroutine RTCheckpointKineticSorptionBinary(realization,viewer,checkpoint)
  4414)   ! 
  4415)   ! Checkpoints expliclity stored sorbed
  4416)   ! concentrations
  4417)   ! 
  4418)   ! Author: Glenn Hammond
  4419)   ! Date: 08/06/09
  4420)   ! 
  4421) 
  4422)   use Realization_Subsurface_class
  4423)   use Patch_module
  4424)   use Grid_module
  4425)   use Option_module
  4426)   use Field_module
  4427)   
  4428)   type(realization_subsurface_type) :: realization
  4429)   PetscViewer :: viewer
  4430)   PetscBool :: checkpoint
  4431)   
  4432)   type(option_type), pointer :: option
  4433)   type(reaction_type), pointer :: reaction
  4434)   type(grid_type), pointer :: grid
  4435)   type(field_type), pointer :: field
  4436)   type(patch_type), pointer :: patch
  4437)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  4438)   PetscReal, pointer :: vec_p(:)
  4439) 
  4440)   PetscBool :: checkpoint_flag(realization%reaction%naqcomp)
  4441)   PetscInt :: i, j, irxn, icomp, icplx, ncomp, ncplx, irate, ikinmrrxn
  4442)   PetscInt :: local_id
  4443)   PetscErrorCode :: ierr
  4444)   
  4445)   option => realization%option
  4446)   reaction => realization%reaction
  4447)   field => realization%field
  4448)   patch => realization%patch
  4449)   
  4450)   checkpoint_flag = PETSC_FALSE
  4451) 
  4452)   ! Loop over sorption reactions to find the necessary components
  4453)   
  4454)   do ikinmrrxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
  4455)     irxn = reaction%surface_complexation%kinmrsrfcplxrxn_to_srfcplxrxn(ikinmrrxn)
  4456)     ncplx = reaction%surface_complexation%srfcplxrxn_to_complex(0,irxn)
  4457)     do j = 1, ncplx
  4458)       icplx = reaction%surface_complexation%srfcplxrxn_to_complex(j,irxn)
  4459)       ncomp = reaction%surface_complexation%srfcplxspecid(0,icplx)
  4460)       do i = 1, ncomp
  4461)         icomp = reaction%surface_complexation%srfcplxspecid(i,icplx)
  4462)         checkpoint_flag(icomp) = PETSC_TRUE
  4463)       enddo
  4464)     enddo
  4465)   enddo
  4466) 
  4467)   rt_auxvars => patch%aux%RT%auxvars
  4468)   grid => patch%grid
  4469)   do icomp = 1, reaction%naqcomp
  4470)     if (checkpoint_flag(icomp)) then
  4471)       do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
  4472)         do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
  4473)           if (checkpoint) then
  4474)             call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4475)             do local_id = 1, grid%nlmax
  4476)               vec_p(local_id) = &
  4477)                 rt_auxvars(grid%nL2G(local_id))% &
  4478)                   kinmr_total_sorb(icomp,irate,irxn)
  4479)             enddo
  4480)             call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4481)             call VecView(field%work,viewer,ierr);CHKERRQ(ierr)
  4482)           else
  4483)             call VecLoad(field%work,viewer,ierr);CHKERRQ(ierr)
  4484)             if (.not.option%transport%no_restart_kinetic_sorption) then
  4485)               call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4486)               do local_id = 1, grid%nlmax
  4487)                 rt_auxvars(grid%nL2G(local_id))% &
  4488)                   kinmr_total_sorb(icomp,irate,irxn) = &
  4489)                     vec_p(local_id)
  4490)               enddo
  4491)               call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4492)             endif
  4493)           endif
  4494)         enddo
  4495)       enddo
  4496)     endif
  4497)   enddo
  4498) 
  4499) end subroutine RTCheckpointKineticSorptionBinary
  4500) 
  4501) ! ************************************************************************** !
  4502) 
  4503) subroutine RTCheckpointKineticSorptionHDF5(realization, pm_grp_id, checkpoint)
  4504)   !
  4505)   ! Checkpoints expliclity stored sorbed
  4506)   ! concentrations
  4507)   !
  4508)   ! Author: Gautam Bisht, LBNL
  4509)   ! Date: 07/30/15
  4510)   !
  4511) 
  4512) #if  !defined(PETSC_HAVE_HDF5)
  4513)   use Realization_Subsurface_class
  4514)   use Option_module
  4515) 
  4516)   implicit none
  4517) 
  4518)   type(realization_subsurface_type) :: realization
  4519)   integer :: pm_grp_id
  4520)   PetscBool :: checkpoint
  4521) 
  4522)   PetscErrorCode :: ierr
  4523) 
  4524)   call printMsg(realization%option,'')
  4525)   write(realization%option%io_buffer, &
  4526)         '("PFLOTRAN must be compiled with HDF5 to &
  4527)         &write HDF5 formatted checkpoint file. Darn.")')
  4528)   call printErrMsg(realization%option)
  4529) 
  4530) #else
  4531) 
  4532)   use Realization_Subsurface_class
  4533)   use Patch_module
  4534)   use Grid_module
  4535)   use Option_module
  4536)   use Field_module
  4537)   use hdf5
  4538)   use Discretization_module
  4539)   use HDF5_module, only : HDF5WriteDataSetFromVec, &
  4540)                           HDF5ReadDataSetInVec
  4541) 
  4542)   type(realization_subsurface_type) :: realization
  4543) #if defined(SCORPIO_WRITE)
  4544)   integer :: pm_grp_id
  4545) #else
  4546)   integer(HID_T) :: pm_grp_id
  4547) #endif
  4548)   PetscBool :: checkpoint
  4549) 
  4550)   type(option_type), pointer :: option
  4551)   type(reaction_type), pointer :: reaction
  4552)   type(grid_type), pointer :: grid
  4553)   type(field_type), pointer :: field
  4554)   type(patch_type), pointer :: patch
  4555)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  4556)   PetscReal, pointer :: vec_p(:)
  4557) 
  4558)   Vec :: natural_vec
  4559)   character(len=MAXSTRINGLENGTH) :: string
  4560)   character(len=MAXSTRINGLENGTH) :: dataset_name
  4561) 
  4562)   PetscBool :: checkpoint_flag(realization%reaction%naqcomp)
  4563)   PetscInt :: i, j, irxn, icomp, icplx, ncomp, ncplx, irate, ikinmrrxn
  4564)   PetscInt :: local_id
  4565)   PetscErrorCode :: ierr
  4566) 
  4567)   option => realization%option
  4568)   reaction => realization%reaction
  4569)   field => realization%field
  4570)   patch => realization%patch
  4571)   
  4572)   checkpoint_flag = PETSC_FALSE
  4573) 
  4574)   call DiscretizationCreateVector(realization%discretization, ONEDOF, &
  4575)                                   natural_vec, NATURAL, option)
  4576) 
  4577)   ! Loop over sorption reactions to find the necessary components
  4578) 
  4579)   do ikinmrrxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
  4580)     irxn = reaction%surface_complexation%kinmrsrfcplxrxn_to_srfcplxrxn(ikinmrrxn)
  4581)     ncplx = reaction%surface_complexation%srfcplxrxn_to_complex(0,irxn)
  4582)     do j = 1, ncplx
  4583)       icplx = reaction%surface_complexation%srfcplxrxn_to_complex(j,irxn)
  4584)       ncomp = reaction%surface_complexation%srfcplxspecid(0,icplx)
  4585)       do i = 1, ncomp
  4586)         icomp = reaction%surface_complexation%srfcplxspecid(i,icplx)
  4587)         checkpoint_flag(icomp) = PETSC_TRUE
  4588)       enddo
  4589)     enddo
  4590)   enddo
  4591) 
  4592)   rt_auxvars => patch%aux%RT%auxvars
  4593)   grid => patch%grid
  4594)   do icomp = 1, reaction%naqcomp
  4595)     if (checkpoint_flag(icomp)) then
  4596)       do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
  4597)         do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
  4598)           if (checkpoint) then
  4599) 
  4600)             ! Write in a HDF5
  4601)             call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4602)             do local_id = 1, grid%nlmax
  4603)               vec_p(local_id) = &
  4604)                 rt_auxvars(grid%nL2G(local_id))% &
  4605)                   kinmr_total_sorb(icomp,irate,irxn)
  4606)             enddo
  4607)             call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4608) 
  4609)             call DiscretizationGlobalToNatural(realization%discretization, field%work, &
  4610)                                         natural_vec, NTRANDOF)
  4611)             write(string,*) icomp
  4612)             dataset_name = 'Kinetic_sorption_' // trim(adjustl(string)) // 'comp_'
  4613)             write(string,*) irxn
  4614)             dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rxn_'
  4615)             write(string,*) irate
  4616)             dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rate'
  4617)             call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
  4618)                   pm_grp_id, H5T_NATIVE_DOUBLE)
  4619) 
  4620)           else
  4621) 
  4622)             ! Read from a HDF5
  4623)             write(string,*) icomp
  4624)             dataset_name = 'Kinetic_sorption_' // trim(adjustl(string)) // 'comp_'
  4625)             write(string,*) irxn
  4626)             dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rxn_'
  4627)             write(string,*) irate
  4628)             dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rate'
  4629) 
  4630)             call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
  4631)                                       pm_grp_id, H5T_NATIVE_DOUBLE)
  4632)             call DiscretizationNaturalToGlobal(realization%discretization, natural_vec, &
  4633)                                                field%work, ONEDOF)
  4634) 
  4635)             if (.not.option%transport%no_restart_kinetic_sorption) then
  4636)               call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4637)               do local_id = 1, grid%nlmax
  4638)                 rt_auxvars(grid%nL2G(local_id))% &
  4639)                   kinmr_total_sorb(icomp,irate,irxn) = &
  4640)                     vec_p(local_id)
  4641)               enddo
  4642)               call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
  4643)             endif
  4644) 
  4645)           endif
  4646)         enddo
  4647)       enddo
  4648)     endif
  4649)   enddo
  4650) #endif
  4651) 
  4652) end subroutine RTCheckpointKineticSorptionHDF5
  4653) 
  4654) ! ************************************************************************** !
  4655) 
  4656) subroutine RTExplicitAdvection(realization)
  4657)   ! 
  4658)   ! Updates advective transport explicitly
  4659)   ! 
  4660)   ! Author: Glenn Hammond
  4661)   ! Date: 02/03/12
  4662)   ! 
  4663) 
  4664)   use Realization_Subsurface_class
  4665) 
  4666)   use Discretization_module
  4667)   use Patch_module
  4668)   use Option_module
  4669)   use Field_module
  4670)   use Grid_module
  4671)   use Connection_module
  4672)   use Coupler_module  
  4673)   use Debug_module
  4674)   
  4675)   implicit none
  4676)   
  4677)   type(realization_subsurface_type) :: realization
  4678)   
  4679)   PetscInt :: local_id, ghosted_id
  4680)   type(grid_type), pointer :: grid
  4681)   type(option_type), pointer :: option
  4682)   type(field_type), pointer :: field
  4683)   type(patch_type), pointer :: patch
  4684)   type(reaction_type), pointer :: reaction
  4685)   type(discretization_type), pointer :: discretization
  4686)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
  4687)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  4688)   class(material_auxvar_type), pointer :: material_auxvars(:)
  4689)   
  4690)   type(coupler_type), pointer :: boundary_condition, source_sink
  4691)   type(connection_set_list_type), pointer :: connection_set_list
  4692)   type(connection_set_type), pointer :: cur_connection_set
  4693)   PetscInt :: sum_connection, iconn
  4694)   PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
  4695)   PetscInt :: iphase
  4696)   PetscInt :: id_up2, id_dn2
  4697)   PetscInt :: local_start, local_end, istart, iend
  4698)   PetscInt :: ntvddof
  4699)   PetscReal :: qsrc, coef_in, coef_out
  4700)   PetscReal :: velocity, area, psv_t  
  4701)   PetscReal :: flux(realization%reaction%ncomp)
  4702)   
  4703)   PetscReal :: sum_flux(realization%reaction%ncomp,realization%patch%grid%ngmax)
  4704)   
  4705)   PetscReal, pointer :: tran_xx_p(:)
  4706)   PetscReal, pointer :: tvd_ghosts_p(:)
  4707)   PetscReal, pointer :: rhs_coef_p(:)
  4708)   PetscReal, pointer :: total_up2(:,:), total_dn2(:,:)
  4709)   PetscErrorCode :: ierr
  4710)   PetscViewer :: viewer
  4711) 
  4712)   procedure (TFluxLimiterDummy), pointer :: TFluxLimitPtr
  4713)   
  4714)   select case(realization%option%transport%tvd_flux_limiter)
  4715)     case(TVD_LIMITER_UPWIND)
  4716)       TFluxLimitPtr => TFluxLimitUpwind
  4717)     case(TVD_LIMITER_MC)
  4718)       TFluxLimitPtr => TFluxLimitMC
  4719)     case(TVD_LIMITER_MINMOD)
  4720)       TFluxLimitPtr => TFluxLimitMinmod
  4721)     case(TVD_LIMITER_SUPERBEE)
  4722)       TFluxLimitPtr => TFluxLimitSuperBee
  4723)     case(TVD_LIMITER_VAN_LEER)
  4724)       TFluxLimitPtr => TFluxLimitVanLeer
  4725)     case default
  4726)       TFluxLimitPtr => TFluxLimiter
  4727)   end select
  4728) 
  4729)   option => realization%option
  4730)   field => realization%field
  4731)   patch => realization%patch
  4732)   discretization => realization%discretization
  4733)   reaction => realization%reaction
  4734)   grid => patch%grid
  4735) !  rt_parameter => patch%aux%RT%rt_parameter
  4736)   rt_auxvars => patch%aux%RT%auxvars
  4737)   rt_auxvars_bc => patch%aux%RT%auxvars_bc
  4738)   global_auxvars => patch%aux%Global%auxvars
  4739)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  4740)   material_auxvars => patch%aux%Material%auxvars
  4741)   
  4742)   ntvddof = patch%aux%RT%rt_parameter%naqcomp
  4743)   
  4744)   if (realization%option%transport%tvd_flux_limiter /= TVD_LIMITER_UPWIND) then
  4745)     allocate(total_up2(option%nphase,ntvddof))
  4746)     allocate(total_dn2(option%nphase,ntvddof))
  4747)   else
  4748)     ! these must be nullifed so that the explicit scheme ignores them
  4749)     nullify(total_up2)
  4750)     nullify(total_up2)
  4751)   endif
  4752) 
  4753)   ! load total component concentrations into tran_xx_p.  it will be used
  4754)   ! as local storage here and eventually be overwritten upon leaving 
  4755)   ! this routine
  4756)   call VecGetArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
  4757)   tran_xx_p = 0.d0
  4758)   do local_id = 1, grid%nlmax
  4759)     ghosted_id = grid%nL2G(local_id)
  4760)     if (patch%imat(ghosted_id) <= 0) cycle
  4761)     local_end = local_id*ntvddof
  4762)     local_start = local_end-ntvddof+1
  4763)     do iphase = 1, option%nphase
  4764)       tran_xx_p(local_start:local_end) = &
  4765)         rt_auxvars(ghosted_id)%total(:,iphase)
  4766)     enddo
  4767)   enddo
  4768)   call VecRestoreArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
  4769)   call VecScatterBegin(discretization%tvd_ghost_scatter,field%tran_xx, &
  4770)                        field%tvd_ghosts,INSERT_VALUES,SCATTER_FORWARD, &
  4771)                        ierr);CHKERRQ(ierr)
  4772)   call VecScatterEnd(discretization%tvd_ghost_scatter,field%tran_xx, &
  4773)                      field%tvd_ghosts,INSERT_VALUES,SCATTER_FORWARD, &
  4774)                      ierr);CHKERRQ(ierr)
  4775) 
  4776) ! Update Boundary Concentrations------------------------------
  4777)   call VecGetArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
  4778)   boundary_condition => patch%boundary_condition_list%first
  4779)   sum_connection = 0    
  4780)   do 
  4781)     if (.not.associated(boundary_condition)) exit
  4782)     cur_connection_set => boundary_condition%connection_set
  4783)     if (associated(cur_connection_set%id_dn2)) then
  4784)       do iconn = 1, cur_connection_set%num_connections
  4785)         sum_connection = sum_connection + 1
  4786)         id_dn2 = cur_connection_set%id_dn2(iconn)
  4787)         if (id_dn2 < 0) then
  4788)           iend = abs(id_dn2)*ntvddof
  4789)           istart = iend-ntvddof+1
  4790)           tvd_ghosts_p(istart:iend) = rt_auxvars_bc(sum_connection)%total(1,:)
  4791)         endif
  4792)       enddo
  4793)     endif
  4794)     boundary_condition => boundary_condition%next
  4795)   enddo  
  4796)   call VecRestoreArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
  4797) #if TVD_DEBUG
  4798)   call PetscViewerASCIIOpen(option%mycomm,'tvd_ghosts.out', &
  4799)                             viewer,ierr);CHKERRQ(ierr)
  4800)   call VecView(field%tvd_ghosts,viewer,ierr);CHKERRQ(ierr)
  4801)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  4802) #endif
  4803) 
  4804)   sum_flux = 0.d0
  4805)   
  4806)   if (reaction%ncoll > 0) then
  4807)     option%io_buffer = &
  4808)       'Need to add colloidal source/sinks to RTExplicitAdvection()'
  4809)     call printErrMsg(option)
  4810)   endif
  4811)   if (option%nphase > 1) then
  4812)     option%io_buffer = &
  4813)       'Need to add multiphase source/sinks to RTExplicitAdvection()'
  4814)     call printErrMsg(option)
  4815)   endif
  4816)   if (reaction%ncomp /= reaction%naqcomp) then
  4817)     option%io_buffer = &
  4818)       'Need to account for non-aqueous species to RTExplicitAdvection()'
  4819)     call printErrMsg(option)
  4820)   endif
  4821)   if (option%compute_mass_balance_new) then  
  4822)     option%io_buffer = &
  4823)       'Mass balance not yet supported in RTExplicitAdvection()'
  4824)     call printErrMsg(option)
  4825)   endif
  4826)   
  4827) ! Interior Flux Terms -----------------------------------
  4828)   call VecGetArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
  4829)   connection_set_list => grid%internal_connection_set_list
  4830)   cur_connection_set => connection_set_list%first
  4831)   sum_connection = 0  
  4832)   do 
  4833)     if (.not.associated(cur_connection_set)) exit
  4834)     do iconn = 1, cur_connection_set%num_connections
  4835)       sum_connection = sum_connection + 1
  4836) 
  4837)       ghosted_id_up = cur_connection_set%id_up(iconn)
  4838)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  4839) 
  4840)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  4841)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  4842) 
  4843)       if (patch%imat(ghosted_id_up) <= 0 .or.  &
  4844)           patch%imat(ghosted_id_dn) <= 0) cycle
  4845)         
  4846)       if (associated(cur_connection_set%id_dn2)) then
  4847)         id_up2 = cur_connection_set%id_up2(iconn)
  4848)         if (id_up2 > 0) then
  4849)           total_up2 = rt_auxvars(id_up2)%total
  4850)         else
  4851)           iend = abs(id_up2)*ntvddof
  4852)           istart = iend-ntvddof+1
  4853)           total_up2(1,:) = tvd_ghosts_p(istart:iend)
  4854)         endif
  4855)         id_dn2 = cur_connection_set%id_dn2(iconn)
  4856)         if (id_dn2 > 0) then
  4857)           total_dn2 = rt_auxvars(id_dn2)%total
  4858)         else
  4859)           iend = abs(id_dn2)*ntvddof
  4860)           istart = iend-ntvddof+1
  4861)           total_dn2(1,:) = tvd_ghosts_p(istart:iend)
  4862)         endif
  4863)       endif
  4864)       call TFluxTVD(patch%aux%RT%rt_parameter, &
  4865)                     patch%internal_velocities(:,sum_connection), &
  4866)                     cur_connection_set%area(iconn), &
  4867)                     cur_connection_set%dist(:,iconn), &
  4868)                     total_up2, &
  4869)                     rt_auxvars(ghosted_id_up), &
  4870)                     rt_auxvars(ghosted_id_dn), &
  4871)                     total_dn2, &
  4872)                     TFluxLimitPtr, &
  4873)                     option,flux)
  4874)           
  4875)       ! contribution upwind
  4876)       sum_flux(:,ghosted_id_up) = sum_flux(:,ghosted_id_up) - flux
  4877)         
  4878)       ! contribution downwind
  4879)       sum_flux(:,ghosted_id_dn) = sum_flux(:,ghosted_id_dn) + flux
  4880)           
  4881)     enddo ! iconn
  4882)     cur_connection_set => cur_connection_set%next
  4883)   enddo
  4884)   call VecRestoreArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
  4885)     
  4886) ! Boundary Flux Terms -----------------------------------
  4887)   boundary_condition => patch%boundary_condition_list%first
  4888)   sum_connection = 0    
  4889)   do 
  4890)     if (.not.associated(boundary_condition)) exit
  4891)     
  4892)     cur_connection_set => boundary_condition%connection_set
  4893)     
  4894)     do iconn = 1, cur_connection_set%num_connections
  4895)       sum_connection = sum_connection + 1
  4896)     
  4897)       local_id = cur_connection_set%id_dn(iconn)
  4898)       ghosted_id = grid%nL2G(local_id)
  4899) 
  4900)       if (patch%imat(ghosted_id) <= 0) cycle
  4901) 
  4902)       if (associated(cur_connection_set%id_dn2)) then
  4903)         total_up2 = rt_auxvars_bc(sum_connection)%total
  4904)         id_dn2 = cur_connection_set%id_dn2(iconn)
  4905)         if (id_dn2 > 0) then
  4906)           total_dn2 = rt_auxvars(id_dn2)%total
  4907)         else
  4908)           iend = abs(id_dn2)*ntvddof
  4909)           istart = iend-ntvddof+1
  4910)           total_dn2(1,:) = tvd_ghosts_p(istart:iend)
  4911)         endif
  4912)       endif
  4913)       call TFluxTVD(patch%aux%RT%rt_parameter, &
  4914)                     patch%boundary_velocities(:,sum_connection), &
  4915)                     cur_connection_set%area(iconn), &
  4916)                     cur_connection_set%dist(:,iconn), &
  4917)                     total_up2, &
  4918)                     rt_auxvars_bc(sum_connection), &
  4919)                     rt_auxvars(ghosted_id), &
  4920)                     total_dn2, &
  4921)                     TFluxLimitPtr, &
  4922)                     option,flux)
  4923) 
  4924)       ! contribution downwind
  4925)       sum_flux(:,ghosted_id) = sum_flux(:,ghosted_id) + flux
  4926) #if 0      
  4927)       
  4928)       do iphase = 1, option%nphase
  4929)         velocity = patch%boundary_velocities(iphase,sum_connection)
  4930)         area = cur_connection_set%area(iconn)
  4931)         
  4932)         if (velocity > 0.d0) then  ! inflow
  4933)           flux = velocity*area* &
  4934)                   rt_auxvars_bc(sum_connection)%total(:,iphase)
  4935)         else  ! outflow
  4936)           flux = velocity*area* &
  4937)                   rt_auxvars(ghosted_id)%total(:,iphase)
  4938)         endif
  4939)           
  4940)         ! contribution downwind
  4941)         sum_flux(:,ghosted_id) = sum_flux(:,ghosted_id) + flux
  4942)           
  4943)       enddo ! iphase
  4944) #endif        
  4945)      
  4946)     enddo
  4947)     boundary_condition => boundary_condition%next
  4948)   enddo
  4949) 
  4950)   ! Source/sink terms -------------------------------------
  4951)   source_sink => patch%source_sink_list%first
  4952)   sum_connection = 0
  4953)   do 
  4954)     if (.not.associated(source_sink)) exit
  4955)     cur_connection_set => source_sink%connection_set
  4956)     do iconn = 1, cur_connection_set%num_connections 
  4957)       sum_connection = sum_connection + 1     
  4958)       local_id = cur_connection_set%id_dn(iconn)
  4959)       ghosted_id = grid%nL2G(local_id)
  4960) 
  4961)       if (patch%imat(ghosted_id) <= 0) cycle
  4962) 
  4963)       do iphase = 1, option%nphase
  4964)         qsrc = patch%ss_flow_vol_fluxes(iphase,sum_connection)
  4965)         call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
  4966)                           coef_in,coef_out)
  4967)         flux = coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
  4968)                coef_out*source_sink%tran_condition%cur_constraint_coupler% &
  4969)                                           rt_auxvar%total(:,iphase)
  4970)         !geh: TSrcSinkCoef() unit are in L/s.
  4971)          sum_flux(:,ghosted_id) = sum_flux(:,ghosted_id) + flux
  4972)       enddo
  4973)     enddo
  4974)     source_sink => source_sink%next
  4975)   enddo
  4976)   
  4977)   call VecGetArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
  4978)   call VecGetArrayReadF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
  4979) 
  4980)   
  4981)   ! update concentration
  4982)   iphase = 1
  4983)   do local_id = 1, grid%nlmax
  4984)     ghosted_id = grid%nL2G(local_id)
  4985)     if (patch%imat(ghosted_id) <= 0) cycle
  4986)     local_end = local_id*ntvddof
  4987)     local_start = local_end-ntvddof+1
  4988) !    do iphase = 1, option%nphase
  4989)       ! psv_t must have same units [mol/sec] and be consistent with rhs_coef_p
  4990)       ! in RTUpdateRHSCoefs()
  4991)       psv_t = material_auxvars(ghosted_id)%porosity* &
  4992)               global_auxvars(ghosted_id)%sat(iphase)* &
  4993)               1000.d0* &
  4994)               material_auxvars(ghosted_id)%volume/option%tran_dt
  4995)       !geh: clearly dangerous that I reload into total, but I am going to do it!
  4996)       tran_xx_p(local_start:local_end) = &
  4997)         ((rhs_coef_p(local_id)*rt_auxvars(ghosted_id)%total(:,iphase)) + &
  4998)          sum_flux(:,ghosted_id)) / psv_t
  4999) !    enddo
  5000)   enddo
  5001)   
  5002)   if (associated(total_up2)) then
  5003)     deallocate(total_up2)
  5004)     nullify(total_up2)
  5005)     deallocate(total_dn2)
  5006)     nullify(total_dn2)
  5007)   endif
  5008)   
  5009)   ! Restore vectors
  5010)   call VecRestoreArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
  5011)   call VecRestoreArrayReadF90(field%tran_rhs_coef,rhs_coef_p, &
  5012)                               ierr);CHKERRQ(ierr)
  5013)   
  5014) end subroutine RTExplicitAdvection
  5015) 
  5016) ! ************************************************************************** !
  5017) 
  5018) subroutine RTWriteToHeader(fid,variable_string,cell_string,icolumn)
  5019)   ! 
  5020)   ! Appends formatted strings to header string
  5021)   ! 
  5022)   ! Author: Glenn Hammond
  5023)   ! Date: 10/27/11
  5024)   ! 
  5025) 
  5026)   PetscInt :: fid
  5027)   character(len=*) :: variable_string
  5028)   character(len=MAXSTRINGLENGTH) :: cell_string
  5029)   character(len=MAXSTRINGLENGTH) :: variable_string_adj
  5030)   character(len=MAXWORDLENGTH) :: column_string
  5031)   PetscInt :: icolumn
  5032) 
  5033)   character(len=MAXSTRINGLENGTH) :: string
  5034)   PetscInt :: len_cell_string
  5035) 
  5036)   variable_string_adj = variable_string
  5037)   !geh: Shift to left.  Cannot perform on same string since len=*
  5038)   variable_string_adj = adjustl(variable_string_adj)
  5039)   
  5040)   if (icolumn > 0) then
  5041)     icolumn = icolumn + 1
  5042)     write(column_string,'(i4,''-'')') icolumn
  5043)     column_string = trim(adjustl(column_string))
  5044)   else
  5045)     column_string = ''
  5046)   endif
  5047) 
  5048)   !geh: this is all to remove the lousy spaces
  5049)   len_cell_string = len_trim(cell_string) 
  5050) 
  5051)   if (len_cell_string > 0) then
  5052)     write(string,'('',"'',a,a,'' '',a,''"'')') trim(column_string), &
  5053)           trim(variable_string_adj), trim(cell_string)
  5054)   else
  5055)     write(string,'('',"'',a,a,''"'')') trim(column_string), &
  5056)           trim(variable_string_adj)
  5057)   endif
  5058)   write(fid,'(a)',advance="no") trim(string)
  5059) 
  5060) end subroutine RTWriteToHeader
  5061) 
  5062) ! ************************************************************************** !
  5063) 
  5064) subroutine RTClearActivityCoefficients(realization)
  5065)   ! 
  5066)   ! Sets activity coefficients back to 1.
  5067)   ! 
  5068)   ! Author: Glenn Hammond
  5069)   ! Date: 08/11/14
  5070)   ! 
  5071) 
  5072)   use Realization_Subsurface_class
  5073)   use Reactive_Transport_Aux_module
  5074)   use Option_module
  5075)   use Field_module  
  5076)   use Grid_module
  5077)   use Secondary_Continuum_Aux_module  
  5078) 
  5079)   implicit none
  5080)   
  5081)   type(realization_subsurface_type) :: realization
  5082)   
  5083)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  5084)   PetscInt :: ghosted_id
  5085)   
  5086)   rt_auxvars => realization%patch%aux%RT%auxvars
  5087)   
  5088)   do ghosted_id = 1, realization%patch%grid%ngmax
  5089)     rt_auxvars(ghosted_id)%pri_act_coef = 1.d0
  5090)     if (associated(rt_auxvars(ghosted_id)%sec_act_coef)) then
  5091)       rt_auxvars(ghosted_id)%sec_act_coef = 1.d0
  5092)     endif
  5093)   enddo
  5094) 
  5095) end subroutine RTClearActivityCoefficients
  5096) 
  5097) ! ************************************************************************** !
  5098) 
  5099) subroutine RTDestroy(realization)
  5100)   ! 
  5101)   ! Deallocates variables associated with Reactive Transport
  5102)   ! 
  5103)   ! Author: Glenn Hammond
  5104)   ! Date: 02/03/09
  5105)   ! 
  5106) 
  5107)   use Realization_Subsurface_class
  5108)   use Patch_module
  5109)   use Option_module
  5110) 
  5111)   type(realization_subsurface_type) :: realization
  5112)   
  5113) #ifdef OS_STATISTICS
  5114)   type(option_type), pointer :: option
  5115)   PetscErrorCode :: ierr
  5116)   
  5117)   PetscReal :: temp_real_in(3), temp_real_out(3)
  5118)   PetscReal :: call_count
  5119)   PetscReal :: sum_newton_iterations
  5120)   PetscReal :: ave_newton_iterations_in_a_cell
  5121)   PetscInt :: max_newton_iterations_in_a_cell
  5122)   PetscReal :: max_newton_iterations_on_a_core
  5123)   PetscReal :: min_newton_iterations_on_a_core
  5124)   
  5125)   PetscReal :: sum, ave, var, value
  5126)   PetscInt :: irank
  5127)   PetscReal, allocatable :: tot_newton_iterations(:)
  5128)   
  5129)   option => realization%option
  5130)   call_count = 0.d0
  5131)   sum_newton_iterations = 0.d0
  5132)   max_newton_iterations_in_a_cell = -99999999
  5133)   max_newton_iterations_on_a_core = -99999999.d0
  5134)   min_newton_iterations_on_a_core = 99999999.d0
  5135)   
  5136) #endif  
  5137) 
  5138) #ifdef OS_STATISTICS
  5139)   call_count = call_count + &
  5140)     cur_patch%aux%RT%rt_parameter%sum_newton_call_count
  5141)   sum_newton_iterations = sum_newton_iterations + &
  5142)     cur_patch%aux%RT%rt_parameter%sum_newton_iterations
  5143)   if (cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations > &
  5144)       max_newton_iterations_in_a_cell) then
  5145)     max_newton_iterations_in_a_cell = &
  5146)       cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations
  5147)   endif
  5148) #endif
  5149) 
  5150) #ifdef OS_STATISTICS
  5151)   if (option%reactive_transport_coupling == OPERATOR_SPLIT) then
  5152)     temp_real_in(1) = call_count
  5153)     temp_real_in(2) = sum_newton_iterations
  5154)     call MPI_Allreduce(temp_real_in,temp_real_out,TWO_INTEGER_MPI, &
  5155)                        MPI_DOUBLE_PRECISION,MPI_SUM,option%mycomm,ierr)
  5156)     ave_newton_iterations_in_a_cell = temp_real_out(2)/temp_real_out(1)
  5157) 
  5158)     temp_real_in(1) = dble(max_newton_iterations_in_a_cell)
  5159)     temp_real_in(2) = sum_newton_iterations
  5160)     temp_real_in(3) = -sum_newton_iterations
  5161)     call MPI_Allreduce(temp_real_in,temp_real_out,THREE_INTEGER_MPI, &
  5162)                        MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
  5163)     max_newton_iterations_in_a_cell = int(temp_real_out(1)+1.d-4)
  5164)     max_newton_iterations_on_a_core = temp_real_out(2)
  5165)     min_newton_iterations_on_a_core = -temp_real_out(3)
  5166) 
  5167)     ! Now let's compute the variance!
  5168)     call OptionMeanVariance(sum_newton_iterations,ave,var,PETSC_TRUE,option)
  5169)   
  5170)     if (option%print_screen_flag) then
  5171)       write(*, '(/,/" OS Reaction Statistics (Overall): ",/, &
  5172)                & "       Ave Newton Its / Cell: ",1pe12.4,/, &
  5173)                & "       Max Newton Its / Cell: ",i4,/, &
  5174)                & "       Max Newton Its / Core: ",1pe12.4,/, &
  5175)                & "       Min Newton Its / Core: ",1pe12.4,/, &
  5176)                & "       Ave Newton Its / Core: ",1pe12.4,/, &
  5177)                & "   Std Dev Newton Its / Core: ",1pe12.4,/)') &
  5178)                  ave_newton_iterations_in_a_cell, &
  5179)                  max_newton_iterations_in_a_cell, &
  5180)                  max_newton_iterations_on_a_core, &
  5181)                  min_newton_iterations_on_a_core, &
  5182)                  ave, &
  5183)                  sqrt(var)
  5184) 
  5185)     endif
  5186) 
  5187)     if (option%print_file_flag) then
  5188)       write(option%fid_out, '(/,/" OS Reaction Statistics (Overall): ",/, &
  5189)                & "       Ave Newton Its / Cell: ",1pe12.4,/, &
  5190)                & "       Max Newton Its / Cell: ",i4,/, &
  5191)                & "       Max Newton Its / Core: ",1pe12.4,/, &
  5192)                & "       Min Newton Its / Core: ",1pe12.4,/, &
  5193)                & "       Ave Newton Its / Core: ",1pe12.4,/, &
  5194)                & "   Std Dev Newton Its / Core: ",1pe12.4,/)') &
  5195)                  ave_newton_iterations_in_a_cell, &
  5196)                  max_newton_iterations_in_a_cell, &
  5197)                  max_newton_iterations_on_a_core, &
  5198)                  min_newton_iterations_on_a_core, &
  5199)                  ave, &
  5200)                  sqrt(var)
  5201)     endif
  5202)   endif
  5203) 
  5204) #endif 
  5205) 
  5206) 
  5207) end subroutine RTDestroy
  5208) 
  5209) end module Reactive_Transport_module

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