reaction.F90       coverage:  75.00 %func     56.74 %block


     1) module Reaction_module
     2) 
     3)   use Reaction_Aux_module
     4)   use Reactive_Transport_Aux_module  
     5)   use Global_Aux_module
     6)   use Material_Aux_class
     7)   
     8)   use Reaction_Surface_Complexation_module
     9)   use Reaction_Mineral_module
    10)   use Reaction_Microbial_module
    11)   use Reaction_Immobile_module
    12) 
    13)   use Reaction_Surface_Complexation_Aux_module
    14)   use Reaction_Mineral_Aux_module
    15)   use Reaction_Microbial_Aux_module
    16)   use Reaction_Immobile_Aux_module
    17) 
    18) #ifdef SOLID_SOLUTION  
    19)   use Reaction_Solid_Solution_module
    20)   use Reaction_Solid_Soln_Aux_module
    21) #endif  
    22) 
    23)   use Reaction_Sandbox_module
    24)   use CLM_Rxn_module
    25) 
    26)   use PFLOTRAN_Constants_module
    27) 
    28)   implicit none
    29)  
    30)   private
    31) 
    32) #include "petsc/finclude/petscsys.h"
    33) 
    34)   PetscReal, parameter :: perturbation_tolerance = 1.d-5
    35)   
    36)   public :: ReactionInit, &
    37)             ReactionReadPass1, &
    38)             ReactionReadPass2, &
    39)             ReactionReadOutput, &
    40)             ReactionReadRedoxSpecies, &
    41)             RTotal, &
    42)             RTotalSorb, &
    43)             CO2AqActCoeff, &
    44)             RActivityCoefficients, &
    45)             RReaction, &
    46)             RReactionDerivative, &
    47)             ReactionProcessConstraint, &
    48)             ReactionEquilibrateConstraint, &
    49)             ReactionPrintConstraint, &
    50)             ReactionFitLogKCoef, &
    51)             ReactionInitializeLogK, &
    52)             ReactionComputeKd, &
    53)             RAccumulationSorb, &
    54)             RAccumulationSorbDerivative, &
    55)             RJumpStartKineticSorption, &
    56)             RAge, &
    57)             RReact, &
    58)             RTAuxVarCompute, &
    59)             RTAccumulation, &
    60)             RTAccumulationDerivative, &
    61)             RTPrintAuxVar, &
    62)             ReactionInterpolateLogK_hpt, &
    63)             ReactionInitializeLogK_hpt, &
    64)             RUpdateKineticState, &
    65)             RUpdateTempDependentCoefs, &
    66)             RZeroSorb, &
    67)             RCO2MoleFraction
    68) 
    69) contains
    70) 
    71) ! ************************************************************************** !
    72) 
    73) subroutine ReactionInit(reaction,input,option)
    74)   ! 
    75)   ! ReactionReadPass1: Initializes the reaction object, creating object and
    76)   ! reading first pass of CHEMISTRY input file block
    77)   ! 
    78)   ! Author: Glenn Hammond
    79)   ! Date: 01/03/13
    80)   ! 
    81) 
    82)   use Option_module
    83)   use Input_Aux_module
    84)   use CLM_Rxn_module, only : RCLMRxnInit
    85)   
    86)   implicit none
    87)   
    88)   type(reaction_type), pointer :: reaction
    89)   type(input_type), pointer :: input
    90)   type(option_type) :: option
    91)   
    92)   reaction => ReactionCreate()
    93)   
    94)   ! must be called prior to the first pass
    95)   call RSandboxInit(option)
    96)   call RCLMRxnInit(option) 
    97)  
    98)   call ReactionReadPass1(reaction,input,option)
    99)   reaction%primary_species_names => GetPrimarySpeciesNames(reaction)
   100)   ! PCL add in colloid dofs
   101)   option%ntrandof = GetPrimarySpeciesCount(reaction)
   102)   option%ntrandof = option%ntrandof + GetColloidCount(reaction)
   103)   option%ntrandof = option%ntrandof + GetImmobileCount(reaction)
   104)   reaction%ncomp = option%ntrandof  
   105) 
   106) end subroutine ReactionInit
   107) 
   108) ! ************************************************************************** !
   109) 
   110) subroutine ReactionReadPass1(reaction,input,option)
   111)   ! 
   112)   ! Reads chemistry (first pass)
   113)   ! 
   114)   ! Author: Glenn Hammond
   115)   ! Date: 05/02/08
   116)   ! 
   117) 
   118)   use Option_module
   119)   use String_module
   120)   use Input_Aux_module
   121)   use Utility_module
   122)   use Units_module
   123)   use Variables_module, only : PRIMARY_MOLALITY, PRIMARY_MOLARITY, &
   124)                                TOTAL_MOLALITY, TOTAL_MOLARITY, &
   125)                                SECONDARY_MOLALITY, SECONDARY_MOLARITY
   126)   use CLM_Rxn_module, only : RCLMRxnRead
   127)   
   128)   implicit none
   129)   
   130)   type(reaction_type) :: reaction
   131)   type(input_type), pointer :: input
   132)   type(option_type) :: option
   133)   
   134)   character(len=MAXSTRINGLENGTH) :: string
   135)   character(len=MAXWORDLENGTH) :: word
   136)   character(len=MAXWORDLENGTH) :: name
   137)   character(len=MAXWORDLENGTH) :: card
   138)   character(len=MAXWORDLENGTH) :: internal_units
   139)   character(len=MAXWORDLENGTH) :: kd_units
   140)   type(aq_species_type), pointer :: species, prev_species
   141)   type(gas_species_type), pointer :: gas, prev_gas
   142)   type(immobile_species_type), pointer :: immobile_species
   143)   type(immobile_species_type), pointer :: prev_immobile_species
   144)   type(colloid_type), pointer :: colloid, prev_colloid
   145)   type(ion_exchange_rxn_type), pointer :: ionx_rxn, prev_ionx_rxn
   146)   type(ion_exchange_cation_type), pointer :: cation, prev_cation
   147)   type(general_rxn_type), pointer :: general_rxn, prev_general_rxn
   148)   type(radioactive_decay_rxn_type), pointer :: radioactive_decay_rxn
   149)   type(radioactive_decay_rxn_type), pointer :: prev_radioactive_decay_rxn
   150)   type(kd_rxn_type), pointer :: kd_rxn, prev_kd_rxn
   151)   type(kd_rxn_type), pointer :: sec_cont_kd_rxn, sec_cont_prev_kd_rxn
   152)   PetscInt :: i, temp_int
   153)   PetscReal :: temp_real
   154)   PetscInt :: srfcplx_count
   155)   PetscInt :: temp_srfcplx_count
   156)   PetscBool :: found
   157)   PetscBool :: reaction_sandbox_read
   158)   PetscBool :: reaction_clm_read
   159) 
   160)   nullify(prev_species)
   161)   nullify(prev_gas)
   162)   nullify(prev_immobile_species)
   163)   nullify(prev_colloid)
   164)   nullify(prev_cation)
   165)   nullify(prev_general_rxn)
   166)   nullify(prev_radioactive_decay_rxn)
   167)   nullify(prev_kd_rxn)
   168)   nullify(prev_ionx_rxn)
   169)   
   170)   if (option%use_mc) then
   171)     nullify(sec_cont_prev_kd_rxn)
   172)   endif
   173)   
   174)   reaction_sandbox_read = PETSC_FALSE
   175)   reaction_clm_read = PETSC_FALSE
   176)   
   177)   kd_units = ''
   178)   srfcplx_count = 0
   179)   input%ierr = 0
   180)   do
   181)   
   182)     call InputReadPflotranString(input,option)
   183)     if (InputError(input)) exit
   184)     if (InputCheckExit(input,option)) exit
   185)     
   186)     call InputReadWord(input,option,word,PETSC_TRUE)
   187)     call InputErrorMsg(input,option,'keyword','CHEMISTRY')
   188)     call StringToUpper(word)
   189)     
   190)     select case(trim(word))
   191)     
   192)       case('PRIMARY_SPECIES')
   193)         nullify(prev_species)
   194)         do
   195)           call InputReadPflotranString(input,option)
   196)           if (InputError(input)) exit
   197)           if (InputCheckExit(input,option)) exit
   198)           
   199)           reaction%naqcomp = reaction%naqcomp + 1
   200)           
   201)           species => AqueousSpeciesCreate()
   202)           call InputReadWord(input,option,species%name,PETSC_TRUE)  
   203)           call InputErrorMsg(input,option,'keyword','CHEMISTRY,&
   204)                              &PRIMARY_SPECIES')    
   205)           if (.not.associated(reaction%primary_species_list)) then
   206)             reaction%primary_species_list => species
   207)             species%id = 1
   208)           endif
   209)           if (associated(prev_species)) then
   210)             prev_species%next => species
   211)             species%id = prev_species%id + 1
   212)           endif
   213)           prev_species => species
   214)           nullify(species)
   215)         enddo
   216)       case('SECONDARY_SPECIES')
   217)         nullify(prev_species)
   218)         do
   219)           call InputReadPflotranString(input,option)
   220)           if (InputError(input)) exit
   221)           if (InputCheckExit(input,option)) exit
   222)           
   223)           reaction%neqcplx = reaction%neqcplx + 1
   224)           
   225)           species => AqueousSpeciesCreate()
   226)           call InputReadWord(input,option,species%name,PETSC_TRUE)  
   227)           call InputErrorMsg(input,option,'keyword','CHEMISTRY,&
   228)                              &SECONDARY_SPECIES')
   229)           if (.not.associated(reaction%secondary_species_list)) then
   230)             reaction%secondary_species_list => species
   231)             species%id = 1
   232)           endif
   233)           if (associated(prev_species)) then
   234)             prev_species%next => species
   235)             species%id = prev_species%id + 1            
   236)           endif
   237)           prev_species => species
   238)           nullify(species)
   239)         enddo
   240)       case('GAS_SPECIES')
   241)         nullify(prev_gas)
   242)         do
   243)           call InputReadPflotranString(input,option)
   244)           if (InputError(input)) exit
   245)           if (InputCheckExit(input,option)) exit
   246) 
   247)           reaction%ngas = reaction%ngas + 1
   248)           
   249)           gas => GasSpeciesCreate()
   250)           call InputReadWord(input,option,gas%name,PETSC_TRUE)  
   251)           call InputErrorMsg(input,option,'keyword','CHEMISTRY,GAS_SPECIES')    
   252)           if (.not.associated(reaction%gas_species_list)) then
   253)             reaction%gas_species_list => gas
   254)             gas%id = 1
   255)           endif
   256)           if (associated(prev_gas)) then
   257)             prev_gas%next => gas
   258)             gas%id = prev_gas%id + 1
   259)           endif
   260)           prev_gas => gas
   261)           nullify(gas)
   262)         enddo
   263)       case('IMMOBILE_SPECIES')
   264)         ! find end of list if it exists
   265)         if (associated(reaction%immobile%list)) then
   266)           immobile_species => reaction%immobile%list
   267)           do
   268)             if (.not.associated(immobile_species%next)) exit
   269)             immobile_species => immobile_species%next
   270)           enddo
   271)           prev_immobile_species => immobile_species
   272)           nullify(immobile_species)
   273)         else
   274)           nullify(prev_immobile_species)
   275)         endif
   276)         do
   277)           call InputReadPflotranString(input,option)
   278)           if (InputError(input)) exit
   279)           if (InputCheckExit(input,option)) exit
   280) 
   281)           reaction%immobile%nimmobile = reaction%immobile%nimmobile + 1
   282)           
   283)           immobile_species => ImmobileSpeciesCreate()
   284)           call InputReadWord(input,option,immobile_species%name,PETSC_TRUE)  
   285)           call InputErrorMsg(input,option,'keyword', &
   286)                              'CHEMISTRY,IMMOBILE_SPECIES')
   287)           if (.not.associated(prev_immobile_species)) then
   288)             reaction%immobile%list => immobile_species
   289)             immobile_species%id = 1
   290)           else
   291)             prev_immobile_species%next => immobile_species
   292)             immobile_species%id = prev_immobile_species%id + 1
   293)           endif
   294)           prev_immobile_species => immobile_species
   295)           nullify(immobile_species)
   296)         enddo        
   297)       case('IMMOBILE_DECAY_REACTION')
   298)         call ImmobileDecayRxnRead(reaction%immobile,input,option)
   299)       case('RADIOACTIVE_DECAY_REACTION')
   300)         reaction%nradiodecay_rxn = reaction%nradiodecay_rxn + 1
   301)         radioactive_decay_rxn => RadioactiveDecayRxnCreate()
   302)         radioactive_decay_rxn%rate_constant = UNINITIALIZED_DOUBLE
   303)         do 
   304)           call InputReadPflotranString(input,option)
   305)           if (InputError(input)) exit
   306)           if (InputCheckExit(input,option)) exit
   307) 
   308)           call InputReadWord(input,option,word,PETSC_TRUE)
   309)           call InputErrorMsg(input,option,'keyword', &
   310)                              'CHEMISTRY,RADIOACTIVE_DECAY_REACTION')
   311)           call StringToUpper(word)   
   312) 
   313)           select case(trim(word))
   314)             case('REACTION')
   315)               ! remainder of string should be the reaction equation
   316)               radioactive_decay_rxn%reaction = trim(adjustl(input%buf))
   317)               ! set flag for error message
   318)               if (len_trim(radioactive_decay_rxn%reaction) < 2) input%ierr = 1
   319)               call InputErrorMsg(input,option,'reaction', &
   320)                                'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,REACTION') 
   321)             case('RATE_CONSTANT')
   322)               call InputReadDouble(input,option, &
   323)                                    radioactive_decay_rxn%rate_constant)
   324)               call InputErrorMsg(input,option,'rate constant', &
   325)                 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,RATE_CONSTANT') 
   326)               call InputReadAndConvertUnits(input, &
   327)                      radioactive_decay_rxn%rate_constant,'unitless/sec', &
   328)                     'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,RATE_CONSTANT',option)
   329)             case('HALF_LIFE')
   330)               call InputReadDouble(input,option, &
   331)                                    radioactive_decay_rxn%half_life)
   332)               call InputErrorMsg(input,option,'half life', &
   333)                 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,HALF_LIFE') 
   334)               call InputReadAndConvertUnits(input, &
   335)                      radioactive_decay_rxn%half_life,'sec', &
   336)                     'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,HALF_LIFE',option)
   337)               ! convert half life to rate constant
   338)               radioactive_decay_rxn%rate_constant = &
   339)                 -1.d0*log(0.5d0)/radioactive_decay_rxn%half_life
   340)             case default
   341)               call InputKeywordUnrecognized(word, &
   342)                 'CHEMISTRY,IMMOBILE_DECAY_REACTION',option)
   343)           end select
   344)         enddo   
   345)         if (Uninitialized(radioactive_decay_rxn%rate_constant)) then
   346)           option%io_buffer = 'RATE_CONSTANT or HALF_LIFE must be set in ' // &
   347)             'RADIOACTIVE_DECAY_REACTION.'
   348)           call printErrMsg(option)
   349)         endif
   350)         if (.not.associated(reaction%radioactive_decay_rxn_list)) then
   351)           reaction%radioactive_decay_rxn_list => radioactive_decay_rxn
   352)           radioactive_decay_rxn%id = 1
   353)         endif
   354)         if (associated(prev_radioactive_decay_rxn)) then
   355)           prev_radioactive_decay_rxn%next => radioactive_decay_rxn
   356)           radioactive_decay_rxn%id = prev_radioactive_decay_rxn%id + 1
   357)         endif
   358)         prev_radioactive_decay_rxn => radioactive_decay_rxn
   359)         nullify(radioactive_decay_rxn)
   360)       case('GENERAL_REACTION')
   361)         reaction%ngeneral_rxn = reaction%ngeneral_rxn + 1
   362)         general_rxn => GeneralRxnCreate()
   363)         do 
   364)           call InputReadPflotranString(input,option)
   365)           if (InputError(input)) exit
   366)           if (InputCheckExit(input,option)) exit
   367) 
   368)           call InputReadWord(input,option,word,PETSC_TRUE)
   369)           call InputErrorMsg(input,option,'keyword','CHEMISTRY,GENERAL_REACTION')
   370)           call StringToUpper(word)   
   371) 
   372)           select case(trim(word))
   373)             case('REACTION')
   374)               ! remainder of string should be the reaction equation
   375)               general_rxn%reaction = trim(adjustl(input%buf))
   376)               ! set flag for error message
   377)               if (len_trim(general_rxn%reaction) < 2) input%ierr = 1
   378)               call InputErrorMsg(input,option,'reaction', &
   379)                                  'CHEMISTRY,GENERAL_REACTION,REACTION') 
   380) ! For now, the reactants are negative stoich, products positive in reaction equation - geh
   381) #if 0
   382)             case('FORWARD_SPECIES')
   383)               nullify(prev_species)
   384)               do
   385)                 call InputReadPflotranString(input,option)
   386)                 if (InputError(input)) exit
   387)                 if (InputCheckExit(input,option)) exit
   388)                 
   389)                 species => AqueousSpeciesCreate()
   390)                 call InputReadWord(input,option,species%name,PETSC_TRUE)  
   391)                 call InputErrorMsg(input,option,'keyword','CHEMISTRY, &
   392)                                    GENERAL_REACTION,FORWARD_SPECIES')    
   393)                 if (.not.associated(general_rxn%forward_species_list)) then
   394)                   general_rxn%forward_species_list => species
   395)                   species%id = 1
   396)                 endif
   397)                 if (associated(prev_species)) then
   398)                   prev_species%next => species
   399)                   species%id = prev_species%id + 1
   400)                 endif
   401)                 prev_species => species
   402)                 nullify(species)
   403)               enddo
   404)               nullify(prev_species)
   405)             case('BACKWARD_SPECIES')
   406)               nullify(prev_species)
   407)               do
   408)                 call InputReadPflotranString(input,option)
   409)                 if (InputError(input)) exit
   410)                 if (InputCheckExit(input,option)) exit
   411)                 
   412)                 species => AqueousSpeciesCreate()
   413)                 call InputReadWord(input,option,species%name,PETSC_TRUE)  
   414)                 call InputErrorMsg(input,option,'keyword','CHEMISTRY, &
   415)                                    GENERAL_REACTION,BACKWARD_SPECIES')    
   416)                 if (.not.associated(general_rxn%backward_species_list)) then
   417)                   general_rxn%forward_species_list => species
   418)                   species%id = 1
   419)                 endif
   420)                 if (associated(prev_species)) then
   421)                   prev_species%next => species
   422)                   species%id = prev_species%id + 1
   423)                 endif
   424)                 prev_species => species
   425)                 nullify(species)
   426)               enddo
   427)               nullify(prev_species)
   428) #endif                
   429)             case('FORWARD_RATE')
   430)               call InputReadDouble(input,option,general_rxn%forward_rate)  
   431)               call InputErrorMsg(input,option,'forward rate', &
   432)                                  'CHEMISTRY,GENERAL_REACTION') 
   433)             case('BACKWARD_RATE')
   434)               call InputReadDouble(input,option,general_rxn%backward_rate)  
   435)               call InputErrorMsg(input,option,'backward rate', &
   436)                                  'CHEMISTRY,GENERAL_REACTION') 
   437)           end select
   438)         enddo   
   439)         if (.not.associated(reaction%general_rxn_list)) then
   440)           reaction%general_rxn_list => general_rxn
   441)           general_rxn%id = 1
   442)         endif
   443)         if (associated(prev_general_rxn)) then
   444)           prev_general_rxn%next => general_rxn
   445)           general_rxn%id = prev_general_rxn%id + 1
   446)         endif
   447)         prev_general_rxn => general_rxn
   448)         nullify(general_rxn)
   449) 
   450)       case('REACTION_SANDBOX')
   451)         call RSandboxRead(input,option)
   452)         reaction_sandbox_read = PETSC_TRUE
   453)       case('CLM_REACTION')
   454)         call RCLMRxnRead(input,option)
   455)         reaction_clm_read = PETSC_TRUE
   456)       case('MICROBIAL_REACTION')
   457)         call MicrobialRead(reaction%microbial,input,option)
   458)       case('MINERALS')
   459)         call MineralRead(reaction%mineral,input,option)
   460)       case('MINERAL_KINETICS') ! mineral kinetics read on second round
   461)         !geh: but we need to count the number of kinetic minerals this round
   462)         temp_int = 0 ! used to count kinetic minerals
   463)         do
   464)           call InputReadPflotranString(input,option)
   465)           call InputReadStringErrorMsg(input,option,card)
   466)           if (InputCheckExit(input,option)) exit
   467)           call InputReadWord(input,option,name,PETSC_TRUE)
   468)           call InputErrorMsg(input,option,name,'CHEMISTRY,MINERAL_KINETICS')
   469)           temp_int = temp_int + 1
   470) 
   471)           do
   472)             call InputReadPflotranString(input,option)
   473)             call InputReadStringErrorMsg(input,option,card)
   474)             if (InputCheckExit(input,option)) exit
   475)             call InputReadWord(input,option,word,PETSC_TRUE)
   476)             call InputErrorMsg(input,option,'keyword', &
   477)                                     'CHEMISTRY,MINERAL_KINETICS')
   478)             call StringToUpper(word)
   479)             select case(word)
   480)               case('PREFACTOR')
   481)                 do 
   482)                   call InputReadPflotranString(input,option)
   483)                   call InputReadStringErrorMsg(input,option,card)
   484)                   if (InputCheckExit(input,option)) exit
   485)                   call InputReadWord(input,option,word,PETSC_TRUE)
   486)                   call InputErrorMsg(input,option,'keyword', &
   487)                                       'CHEMISTRY,MINERAL_KINETICS,PREFACTOR')
   488)                   call StringToUpper(word)
   489)                   select case(word)
   490)                     case('PREFACTOR_SPECIES')
   491)                       call InputSkipToEnd(input,option,word)
   492)                   end select
   493)                 enddo
   494)             end select
   495)           enddo
   496)         enddo
   497)         reaction%mineral%nkinmnrl = reaction%mineral%nkinmnrl + temp_int
   498) 
   499)       case('SOLID_SOLUTIONS') ! solid solutions read on second round
   500) #ifdef SOLID_SOLUTION
   501)         do
   502)           call InputReadPflotranString(input,option)
   503)           call InputReadStringErrorMsg(input,option,card)
   504)           if (InputCheckExit(input,option)) exit
   505)           call InputSkipToEnd(input,option,word)
   506)         enddo       
   507) #else
   508)         option%io_buffer = 'To use solid solutions, must compile with -DSOLID_SOLUTION'
   509)         call printErrMsg(option)
   510) #endif
   511) 
   512)       case('COLLOIDS')
   513)         nullify(prev_colloid)
   514)         do
   515)           call InputReadPflotranString(input,option)
   516)           if (InputError(input)) exit
   517)           if (InputCheckExit(input,option)) exit
   518)           
   519)           reaction%ncoll = reaction%ncoll + 1
   520)           
   521)           colloid => ColloidCreate()
   522)           call InputReadWord(input,option,colloid%name,PETSC_TRUE)  
   523)           call InputErrorMsg(input,option,'keyword','CHEMISTRY,COLLOIDS')    
   524)           call InputReadDouble(input,option,colloid%mobile_fraction)  
   525)           call InputDefaultMsg(input,option,'CHEMISTRY,COLLOIDS,MOBILE_FRACTION')          
   526)           if (.not.associated(reaction%colloid_list)) then
   527)             reaction%colloid_list => colloid
   528)             colloid%id = 1
   529)           endif
   530)           if (associated(prev_colloid)) then
   531)             prev_colloid%next => colloid
   532)             colloid%id = prev_colloid%id + 1
   533)           endif
   534)           prev_colloid => colloid
   535)           nullify(colloid)
   536)         enddo
   537)       case('SORPTION')
   538) !geh        nullify(prev_srfcplx_rxn)
   539)         do
   540)           call InputReadPflotranString(input,option)
   541)           if (InputError(input)) exit
   542)           if (InputCheckExit(input,option)) exit
   543) 
   544)           call InputReadWord(input,option,word,PETSC_TRUE)
   545)           call InputErrorMsg(input,option,'keyword','CHEMISTRY,SORPTION')
   546)           call StringToUpper(word)   
   547) 
   548)           select case(trim(word))
   549) 
   550)             case('ISOTHERM_REACTIONS')
   551)               do
   552)                 call InputReadPflotranString(input,option)
   553)                 if (InputError(input)) exit
   554)                 if (InputCheckExit(input,option)) exit
   555) 
   556)                 reaction%neqkdrxn = reaction%neqkdrxn + 1
   557) 
   558)                 kd_rxn => KDRxnCreate()
   559)                 if (option%use_mc) then
   560)                   sec_cont_kd_rxn => KDRxnCreate()
   561)                 endif
   562)                 ! first string is species name
   563)                 call InputReadWord(input,option,word,PETSC_TRUE)
   564)                 call InputErrorMsg(input,option,'species name', &
   565)                                    'CHEMISTRY,ISOTHERM_REACTIONS')
   566)                 kd_rxn%species_name = trim(word)
   567)                 if (option%use_mc) then
   568)                   sec_cont_kd_rxn%species_name = kd_rxn%species_name
   569)                 endif
   570)                 do 
   571)                   call InputReadPflotranString(input,option)
   572)                   if (InputError(input)) exit
   573)                   if (InputCheckExit(input,option)) exit
   574) 
   575)                   call InputReadWord(input,option,word,PETSC_TRUE)
   576)                   call InputErrorMsg(input,option,'keyword', &
   577)                                      'CHEMISTRY,ISOTHERM_REACTIONS')
   578)                   call StringToUpper(word)
   579)                   
   580)                   ! default type is linear
   581)                   kd_rxn%itype = SORPTION_LINEAR
   582)                   select case(trim(word))
   583)                     case('TYPE')
   584)                       call InputReadWord(input,option,word,PETSC_TRUE)
   585)                       call InputErrorMsg(input,option,'type', &
   586)                                          'CHEMISTRY,ISOTHERM_REACTIONS')
   587)                       select case(word)
   588)                         case('LINEAR')
   589)                           kd_rxn%itype = SORPTION_LINEAR
   590)                         case('LANGMUIR')
   591)                           kd_rxn%itype = SORPTION_LANGMUIR
   592)                         case('FREUNDLICH')
   593)                           kd_rxn%itype = SORPTION_FREUNDLICH
   594)                         case default
   595)                           call InputKeywordUnrecognized(word, &
   596)                                 'CHEMISTRY,SORPTION,ISOTHERM_REACTIONS,TYPE', &
   597)                                 option)
   598)                       end select
   599)                       if (option%use_mc) then
   600)                         sec_cont_kd_rxn%itype = kd_rxn%itype
   601)                       endif
   602)                     case('DISTRIBUTION_COEFFICIENT','KD')
   603)                       call InputReadDouble(input,option,kd_rxn%Kd)
   604)                       call InputErrorMsg(input,option, &
   605)                                          'DISTRIBUTION_COEFFICIENT', &
   606)                                          'CHEMISTRY,ISOTHERM_REACTIONS')
   607)                       call InputReadWord(input,option,word,PETSC_TRUE)
   608)                       if (input%ierr == 0) kd_units = trim(word)
   609)                     ! S.Karra, 02/20/2014
   610)                     case('SEC_CONT_DISTRIBUTION_COEFFICIENT', &
   611)                          'SEC_CONT_KD')
   612)                          if (.not.option%use_mc) then
   613)                            option%io_buffer = 'Make sure MULTIPLE_CONTINUUM ' &
   614)                                    // 'keyword is set, SECONDARY_CONTINUUM_KD.'
   615)                            call printErrMsg(option)
   616)                          else
   617)                            call InputReadDouble(input,option,sec_cont_kd_rxn%Kd)
   618)                            call InputErrorMsg(input,option, &
   619)                              'SECONDARY_CONTINUUM_DISTRIBUTION_COEFFICIENT', &
   620)                              'CHEMISTRY,ISOTHERM_REACTIONS')                    
   621)                         endif
   622)                     case('LANGMUIR_B')
   623)                       call InputReadDouble(input,option,kd_rxn%Langmuir_B)
   624)                       call InputErrorMsg(input,option,'Langmuir_B', &
   625)                                          'CHEMISTRY,ISOTHERM_REACTIONS')
   626)                       kd_rxn%itype = SORPTION_LANGMUIR
   627)                     case('FREUNDLICH_N')
   628)                       call InputReadDouble(input,option,kd_rxn%Freundlich_N)
   629)                       call InputErrorMsg(input,option,'Freundlich_N', &
   630)                                          'CHEMISTRY,ISOTHERM_REACTIONS')
   631)                       kd_rxn%itype = SORPTION_FREUNDLICH
   632)                     case('KD_MINERAL_NAME')
   633)                       call InputReadWord(input,option,word,PETSC_TRUE)
   634)                       call InputErrorMsg(input,option,'KD_MINERAL_NAME', &
   635)                                          'ISOTHERM_REACTIONS,KD_MINERAL_NAME')
   636)                       kd_rxn%kd_mineral_name = word                      
   637)                     case default
   638)                       call InputKeywordUnrecognized(word, &
   639)                               'CHEMISTRY,SORPTION,ISOTHERM_REACTIONS',option)
   640)                   end select
   641)                 enddo
   642) 
   643)                 if (len_trim(kd_units) > 0) then
   644)                   if (len_trim(kd_rxn%kd_mineral_name) > 0) then
   645)                     internal_units = 'L/kg'
   646)                     kd_rxn%Kd = kd_rxn%Kd * &
   647)                       UnitsConvertToInternal(kd_units,internal_units,option)
   648)                   else
   649)                     internal_units = 'kg/m^3'
   650)                     kd_rxn%Kd = kd_rxn%Kd * &
   651)                       UnitsConvertToInternal(kd_units,internal_units,option)
   652)                   endif
   653)                 endif
   654) 
   655)                 ! add to list
   656)                 if (.not.associated(reaction%kd_rxn_list)) then
   657)                   reaction%kd_rxn_list => kd_rxn
   658)                   kd_rxn%id = 1
   659)                 endif
   660)                 if (associated(prev_kd_rxn)) then
   661)                   prev_kd_rxn%next => kd_rxn
   662)                   kd_rxn%id = prev_kd_rxn%id + 1
   663)                 endif
   664)                 prev_kd_rxn => kd_rxn
   665)                 nullify(kd_rxn)
   666)                 
   667)                 if (option%use_mc) then
   668)                 ! add to list
   669)                   if (.not.associated(reaction%sec_cont_kd_rxn_list)) then
   670)                     reaction%sec_cont_kd_rxn_list => sec_cont_kd_rxn
   671)                     sec_cont_kd_rxn%id = 1
   672)                   endif
   673)                   if (associated(sec_cont_prev_kd_rxn)) then
   674)                     sec_cont_prev_kd_rxn%next => sec_cont_kd_rxn
   675)                     sec_cont_kd_rxn%id = sec_cont_prev_kd_rxn%id + 1
   676)                   endif
   677)                   sec_cont_prev_kd_rxn => sec_cont_kd_rxn
   678)                   nullify(sec_cont_kd_rxn)
   679)                 endif
   680)               enddo
   681)             
   682)             case('SURFACE_COMPLEXATION_RXN')
   683)               call SurfaceComplexationRead(reaction,input,option)
   684)             case('ION_EXCHANGE_RXN')
   685)               ionx_rxn => IonExchangeRxnCreate()
   686)               do
   687)                 call InputReadPflotranString(input,option)
   688)                 if (InputError(input)) exit
   689)                 if (InputCheckExit(input,option)) exit
   690) 
   691)                 call InputReadWord(input,option,word,PETSC_TRUE)
   692)                 call InputErrorMsg(input,option,'keyword', &
   693)                                    'CHEMISTRY,ION_EXCHANGE_RXN')
   694)                 call StringToUpper(word)
   695)                 
   696)                 select case(trim(word))
   697)                   case('MINERAL')
   698)                     call InputReadWord(input,option,ionx_rxn%mineral_name, &
   699)                                        PETSC_TRUE)
   700)                     call InputErrorMsg(input,option,'keyword', &
   701)                       'CHEMISTRY,ION_EXCHANGE_RXN,MINERAL_NAME')
   702)                   case('CEC')
   703)                     call InputReadDouble(input,option,ionx_rxn%CEC)
   704)                     call InputErrorMsg(input,option,'keyword', &
   705)                                        'CHEMISTRY,ION_EXCHANGE_RXN,CEC')
   706)                   case('CATIONS')
   707)                     string = '' ! string denotes the reference cation 
   708)                     nullify(prev_cation)
   709)                     do
   710)                       call InputReadPflotranString(input,option)
   711)                       if (InputError(input)) exit
   712)                       if (InputCheckExit(input,option)) exit
   713)                       
   714)                       cation => IonExchangeCationCreate()
   715)                       reaction%neqionxcation = reaction%neqionxcation + 1
   716)                       call InputReadWord(input,option,cation%name,PETSC_TRUE)
   717)                       call InputErrorMsg(input,option,'keyword', &
   718)                         'CHEMISTRY,ION_EXCHANGE_RXN,CATION_NAME')
   719)                       call InputReadDouble(input,option,cation%k)
   720)                       call InputErrorMsg(input,option,'keyword', &
   721)                                          'CHEMISTRY,ION_EXCHANGE_RXN,K')
   722)                       call InputReadWord(input,option,word,PETSC_TRUE)
   723)                       if (input%ierr == 0) then
   724)                         if (StringCompareIgnoreCase(word,'REFERENCE')) then
   725)                           string = cation%name
   726)                         else
   727)                           call InputKeywordUnrecognized(word, &
   728)                                   'CHEMISTRY,ION_EXCHANGE_RXN,CATIONS',option)
   729)                         endif
   730)                       endif
   731)                       if (.not.associated(ionx_rxn%cation_list)) then
   732)                         ionx_rxn%cation_list => cation
   733)                       endif
   734)                       if (associated(prev_cation)) then
   735)                         prev_cation%next => cation
   736)                       endif
   737)                       prev_cation => cation
   738)                       nullify(cation)
   739)                     enddo
   740)                     if (len_trim(string) == 0) then
   741)                       option%io_buffer = &
   742)                         'Reference cation missing in Ion Exchange reaction.'
   743)                       call printErrMsg(option)
   744)                     endif
   745)                     cation => ionx_rxn%cation_list
   746)                     nullify(prev_cation)
   747)                     do
   748)                       if (.not.associated(cation)) exit
   749)                       if (StringCompare(cation%name,string)) then
   750)                         if (dabs(cation%k - 1.d0) > 1.d-40) then
   751)                           option%io_buffer = 'Reference cation "' // &
   752)                             trim(cation%name) // '" must have k = 1.d0.'
   753)                           call printErrMsg(option)
   754)                         endif
   755)                         ! move it to the front of the list
   756)                         if (associated(prev_cation)) then
   757)                           prev_cation%next => cation%next
   758)                           cation%next => ionx_rxn%cation_list
   759)                           ionx_rxn%cation_list => cation
   760)                         else
   761)                           ! nothing to do as it is at the front of the list
   762)                         endif
   763)                         exit
   764)                       endif
   765)                       prev_cation => cation
   766)                       cation => cation%next
   767)                     enddo
   768)                   case default
   769)                     call InputKeywordUnrecognized(word, &
   770)                               'CHEMISTRY,ION_EXCHANGE_RXN',option)
   771)                 end select
   772)               enddo
   773)               if (.not.associated(reaction%ion_exchange_rxn_list)) then
   774)                 reaction%ion_exchange_rxn_list => ionx_rxn
   775)                 ionx_rxn%id = 1
   776)               endif
   777)               if (associated(prev_ionx_rxn)) then
   778)                 prev_ionx_rxn%next => ionx_rxn
   779)                 ionx_rxn%id = prev_ionx_rxn%id + 1
   780)               endif
   781)               prev_ionx_rxn => ionx_rxn
   782) 
   783)               reaction%neqionxrxn = ionx_rxn%id
   784) 
   785)               nullify(ionx_rxn)          
   786)             case('JUMPSTART_KINETIC_SORPTION')
   787)               option%transport%jumpstart_kinetic_sorption = PETSC_TRUE
   788)               option%transport%no_restart_kinetic_sorption = PETSC_TRUE
   789)             case('NO_CHECKPOINT_KINETIC_SORPTION')
   790)               option%transport%no_checkpoint_kinetic_sorption = PETSC_TRUE
   791)             case('NO_RESTART_KINETIC_SORPTION')
   792)               option%transport%no_restart_kinetic_sorption = PETSC_TRUE
   793)           end select
   794)         enddo
   795)       case('DATABASE')
   796)         call InputReadNChars(input,option,reaction%database_filename, &
   797)                              MAXSTRINGLENGTH,PETSC_TRUE)  
   798)         call InputErrorMsg(input,option,'keyword', &
   799)                            'CHEMISTRY,DATABASE FILENAME')  
   800)       case('LOG_FORMULATION')
   801)         reaction%use_log_formulation = PETSC_TRUE
   802)       case('TRUNCATE_CONCENTRATION')
   803)         call InputReadDouble(input,option,reaction%truncated_concentration)
   804)         call InputErrorMsg(input,option,'truncate_concentration','CHEMISTRY')
   805)       case('GEOTHERMAL_HPT')
   806)         reaction%use_geothermal_hpt = PETSC_TRUE           
   807)       case('NO_CHECK_UPDATE')
   808)         reaction%check_update = PETSC_FALSE       
   809)       case('NO_RESTART_MINERAL_VOL_FRAC')
   810)         option%transport%no_restart_mineral_vol_frac = PETSC_TRUE
   811)       case('NO_CHECKPOINT_ACT_COEFS')
   812)         reaction%checkpoint_activity_coefs = PETSC_FALSE
   813)       case('ACTIVITY_COEFFICIENTS')
   814)         reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_LAG        
   815)         reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_TIMESTEP        
   816)         do 
   817)           call InputReadWord(input,option,word,PETSC_TRUE)
   818)           if (input%ierr /= 0) exit
   819)           select case(trim(word))
   820)             case('OFF')
   821)               reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_OFF
   822)             case('LAG')
   823)               reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_LAG    
   824)             case('NEWTON')
   825)               reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_NEWTON       
   826)             case('TIMESTEP')
   827)               reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_TIMESTEP
   828)             case('NEWTON_ITERATION')
   829)               reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_NEWTON_ITER
   830)             case default
   831)               call InputKeywordUnrecognized(word, &
   832)                         'CHEMISTRY,ACTIVITY_COEFFICIENTS',option)
   833)           end select
   834)         enddo
   835)       case('NO_BDOT')
   836)         reaction%act_coef_use_bdot = PETSC_FALSE
   837)       case('UPDATE_POROSITY')
   838)         reaction%update_porosity = PETSC_TRUE
   839)         option%flow%transient_porosity = PETSC_TRUE
   840)       case('UPDATE_TORTUOSITY')
   841)         reaction%update_tortuosity = PETSC_TRUE
   842)       case('UPDATE_PERMEABILITY')
   843)         reaction%update_permeability = PETSC_TRUE
   844)       case('UPDATE_MINERAL_SURFACE_AREA')
   845)         reaction%update_mineral_surface_area = PETSC_TRUE
   846)       case('UPDATE_MNRL_SURF_AREA_WITH_POR')
   847)         reaction%update_mnrl_surf_with_porosity = PETSC_TRUE
   848)       case('UPDATE_ARMOR_MINERAL_SURFACE')
   849)         reaction%update_armor_mineral_surface = PETSC_TRUE
   850)       case('UPDATE_ARMOR_MINERAL_SURFACE_FLAG')
   851)         reaction%update_armor_mineral_surface = PETSC_TRUE
   852)       case('MOLAL','MOLALITY')
   853)         reaction%initialize_with_molality = PETSC_TRUE
   854)       case('ACTIVITY_H2O','ACTIVITY_WATER')
   855)         reaction%use_activity_h2o = PETSC_TRUE
   856)       case('REDOX_SPECIES')
   857)         call InputSkipToEnd(input,option,word)
   858)       case('OUTPUT')
   859)         call InputSkipToEnd(input,option,word)
   860)       case('MAX_DLNC')
   861)         call InputReadDouble(input,option,reaction%max_dlnC)
   862)         call InputErrorMsg(input,option,trim(word),'CHEMISTRY')
   863)       case('OPERATOR_SPLIT','OPERATOR_SPLITTING')
   864)         option%io_buffer = 'OPERATOR_SPLIT functionality has not been ' // &
   865)           'reimplemented in the refactored PFLOTRAN at this time.  Please ' // &
   866)           'GLOBAL_IMPLICIT (remove OPERATOR_SPLIT(TING)) or ask for the ' // &
   867)           'capability through pflotran-dev@googlegroups.com if you really ' // &
   868)           'need it.'
   869)         call printErrMsg(option)
   870)         option%transport%reactive_transport_coupling = OPERATOR_SPLIT    
   871)       case('EXPLICIT_ADVECTION')
   872)         option%itranmode = EXPLICIT_ADVECTION
   873)         call InputReadWord(input,option,word,PETSC_TRUE)
   874)         if (input%ierr == 0) then
   875)           call StringToUpper(word)
   876)           select case(word)
   877)             !TODO(geh): fix these hardwired values.
   878)             case('UPWIND')
   879)               option%transport%tvd_flux_limiter = 1
   880)             case('MINMOD')
   881)               option%transport%tvd_flux_limiter = 3
   882)             case('MC')
   883)               option%transport%tvd_flux_limiter = 2
   884)             case('SUPERBEE')
   885)               option%transport%tvd_flux_limiter = 4
   886)             case('VANLEER')
   887)               option%transport%tvd_flux_limiter = 5
   888)             case default
   889)               call InputKeywordUnrecognized(word, &
   890)                         'CHEMISTRY,EXPLICIT_ADVECTION',option)
   891)           end select
   892)           option%io_buffer = 'Flux Limiter: ' // trim(word)
   893)           call printMsg(option)
   894)         else
   895)           call InputDefaultMsg(input,option,'TVD Flux Limiter')
   896)         endif
   897)       case('MAX_RELATIVE_CHANGE_TOLERANCE','REACTION_TOLERANCE')
   898)         call InputReadDouble(input,option,reaction%max_relative_change_tolerance)
   899)         call InputErrorMsg(input,option,'maximum relative change tolerance','CHEMISTRY')
   900)       case('MAX_RESIDUAL_TOLERANCE')
   901)         call InputReadDouble(input,option,reaction%max_residual_tolerance)
   902)         call InputErrorMsg(input,option,'maximum residual tolerance','CHEMISTRY')
   903)       case('MINIMUM_POROSITY')
   904)         call InputReadDouble(input,option,reaction%minimum_porosity)
   905)         call InputErrorMsg(input,option,'minimim porosity','CHEMISTRY')
   906)       case default
   907)         call InputKeywordUnrecognized(word,'CHEMISTRY',option)
   908)     end select
   909)   enddo
   910)   
   911)   reaction%neqsorb = reaction%neqionxrxn + &
   912)                      reaction%neqkdrxn + &
   913)                      reaction%surface_complexation%neqsrfcplxrxn
   914)   reaction%nsorb = reaction%neqsorb + &
   915)                    reaction%surface_complexation%nkinmrsrfcplxrxn + &
   916)                    reaction%surface_complexation%nkinsrfcplxrxn
   917)     
   918) 
   919)   if (reaction%print_free_conc_type == 0) then
   920)     if (reaction%initialize_with_molality) then
   921)       reaction%print_free_conc_type = PRIMARY_MOLALITY
   922)     else
   923)       reaction%print_free_conc_type = PRIMARY_MOLARITY
   924)     endif
   925)   endif
   926)   if (reaction%print_tot_conc_type == 0) then
   927)     if (reaction%initialize_with_molality) then
   928)       reaction%print_tot_conc_type = TOTAL_MOLALITY
   929)     else
   930)       reaction%print_tot_conc_type = TOTAL_MOLARITY
   931)     endif
   932)   endif
   933)   if (reaction%print_secondary_conc_type == 0) then
   934)     if (reaction%initialize_with_molality) then
   935)       reaction%print_secondary_conc_type = SECONDARY_MOLALITY
   936)     else
   937)       reaction%print_secondary_conc_type = SECONDARY_MOLARITY
   938)     endif
   939)   endif
   940)   if (reaction%neqcplx + reaction%nsorb + reaction%mineral%nmnrl + &
   941)       reaction%ngeneral_rxn + reaction%microbial%nrxn + &
   942)       reaction%nradiodecay_rxn + reaction%immobile%nimmobile > 0 .or. &
   943)       reaction_clm_read .or. &
   944)       reaction_sandbox_read) then
   945)     reaction%use_full_geochemistry = PETSC_TRUE
   946)   endif
   947)       
   948)   ! ensure that update porosity is ON if update of tortuosity, permeability or
   949)   ! mineral surface area are ON
   950)   if (.not.reaction%update_porosity .and. &
   951)       (reaction%update_tortuosity .or. &
   952)        reaction%update_permeability .or. &
   953)        reaction%update_mnrl_surf_with_porosity)) then
   954)     option%io_buffer = 'UPDATE_POROSITY must be listed under CHEMISTRY ' // &
   955)       'card when UPDATE_TORTUOSITY, UPDATE_PERMEABILITY, or ' // &
   956)       'UPDATE_MNRL_SURF_WITH_POR are listed.'
   957)     call printErrMsg(option)
   958)   endif
   959)     
   960)   if (len_trim(reaction%database_filename) < 2) &
   961)     reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_OFF
   962)   
   963) end subroutine ReactionReadPass1
   964) 
   965) ! ************************************************************************** !
   966) 
   967) subroutine ReactionReadPass2(reaction,input,option)
   968)   ! 
   969)   ! Reads chemistry on pass 2
   970)   ! 
   971)   ! Author: Glenn Hammond
   972)   ! Date: 01/03/13
   973)   ! 
   974) 
   975)   use Option_module
   976)   use String_module
   977)   use Input_Aux_module
   978)   use Utility_module
   979)   
   980)   implicit none
   981) 
   982)   type(reaction_type) :: reaction
   983)   type(input_type), pointer :: input
   984)   type(option_type) :: option
   985)   
   986)   character(len=MAXSTRINGLENGTH) :: string
   987)   character(len=MAXWORDLENGTH) :: word
   988)   character(len=MAXWORDLENGTH) :: name
   989)   character(len=MAXWORDLENGTH) :: card
   990)   
   991)   do
   992)     call InputReadPflotranString(input,option)
   993)     call InputReadStringErrorMsg(input,option,card)
   994)     if (InputCheckExit(input,option)) exit
   995)     call InputReadWord(input,option,word,PETSC_TRUE)
   996)     call InputErrorMsg(input,option,'word','CHEMISTRY') 
   997)     select case(trim(word))
   998)       case('PRIMARY_SPECIES','SECONDARY_SPECIES','GAS_SPECIES', &
   999)             'MINERALS','COLLOIDS','GENERAL_REACTION', &
  1000)             'IMMOBILE_SPECIES','RADIOACTIVE_DECAY_REACTION', &
  1001)             'IMMOBILE_DECAY_REACTION')
  1002)         call InputSkipToEND(input,option,card)
  1003)       case('REDOX_SPECIES')
  1004)         call ReactionReadRedoxSpecies(reaction,input,option)
  1005)       case('OUTPUT')
  1006)         call ReactionReadOutput(reaction,input,option)
  1007)       case('MINERAL_KINETICS')
  1008)         call MineralReadKinetics(reaction%mineral,input,option)
  1009)       case('REACTION_SANDBOX')
  1010)         call RSandboxSkipInput(input,option)
  1011)       case('CLM_REACTION')
  1012)         call RCLMRxnSkipInput(input,option)
  1013)       case('SOLID_SOLUTIONS')
  1014) #ifdef SOLID_SOLUTION                
  1015)         call SolidSolutionReadFromInputFile(reaction%solid_solution_list, &
  1016)                                             input,option)
  1017) #endif
  1018)       case('SORPTION')
  1019)         do
  1020)           call InputReadPflotranString(input,option)
  1021)           call InputReadStringErrorMsg(input,option,card)
  1022)           if (InputCheckExit(input,option)) exit
  1023)           call InputReadWord(input,option,word,PETSC_TRUE)
  1024)           call InputErrorMsg(input,option,'SORPTION','CHEMISTRY') 
  1025)           select case(trim(word))
  1026)             case('ISOTHERM_REACTIONS')
  1027)               do
  1028)                 call InputReadPflotranString(input,option)
  1029)                 call InputReadStringErrorMsg(input,option,card)
  1030)                 if (InputCheckExit(input,option)) exit
  1031)                 call InputReadWord(input,option,word,PETSC_TRUE)
  1032)                 call InputErrorMsg(input,option,word, &
  1033)                                     'CHEMISTRY,SORPTION,ISOTHERM_REACTIONS') 
  1034)                 ! skip over remaining cards to end of each kd entry
  1035)                 call InputSkipToEnd(input,option,word)
  1036)               enddo
  1037)             case('SURFACE_COMPLEXATION_RXN','ION_EXCHANGE_RXN')
  1038)               do
  1039)                 call InputReadPflotranString(input,option)
  1040)                 call InputReadStringErrorMsg(input,option,card)
  1041)                 if (InputCheckExit(input,option)) exit
  1042)                 call InputReadWord(input,option,word,PETSC_TRUE)
  1043)                 call InputErrorMsg(input,option,'SORPTION','CHEMISTRY')
  1044)                 select case(trim(word))
  1045)                   case('COMPLEXES','CATIONS')
  1046)                     call InputSkipToEND(input,option,word)
  1047)                   case('COMPLEX_KINETICS')
  1048)                     do
  1049)                       call InputReadPflotranString(input,option)
  1050)                       call InputReadStringErrorMsg(input,option,card)
  1051)                       if (InputCheckExit(input,option)) exit
  1052)                       call InputReadWord(input,option,word,PETSC_TRUE)
  1053)                       call InputErrorMsg(input,option,word, &
  1054)                              'CHEMISTRY,SURFACE_COMPLEXATION_RXN,KINETIC_RATES')
  1055)                       ! skip over remaining cards to end of each mineral entry
  1056)                       call InputSkipToEnd(input,option,word)
  1057)                     enddo
  1058)                 end select 
  1059)               enddo
  1060)             case('NUM_THREADS')
  1061)             case('JUMPSTART_KINETIC_SORPTION')
  1062)             case('NO_CHECKPOINT_KINETIC_SORPTION')
  1063)             case('NO_RESTART_KINETIC_SORPTION')
  1064)               ! dummy placeholder
  1065)           end select
  1066)         enddo
  1067)       case('MICROBIAL_REACTION')
  1068)         do
  1069)           call InputReadPflotranString(input,option)
  1070)           call InputReadStringErrorMsg(input,option,card)
  1071)           if (InputCheckExit(input,option)) exit
  1072)           call InputReadWord(input,option,word,PETSC_TRUE)
  1073)           call InputErrorMsg(input,option,'MICROBIAL_REACTION','CHEMISTRY')
  1074)           select case(trim(word))
  1075)             case('INHIBITION','MONOD','BIOMASS')
  1076)               call InputSkipToEND(input,option,word)
  1077)           end select 
  1078)         enddo
  1079)       case('MOLAL','MOLALITY', &
  1080)             'UPDATE_POROSITY','UPDATE_TORTUOSITY', &
  1081)             'UPDATE_PERMEABILITY','UPDATE_MINERAL_SURFACE_AREA', &
  1082)             'NO_RESTART_MINERAL_VOL_FRAC')
  1083)         ! dummy placeholder
  1084)     end select
  1085)   enddo  
  1086)   
  1087) end subroutine ReactionReadPass2
  1088) 
  1089) ! ************************************************************************** !
  1090) 
  1091) subroutine ReactionReadRedoxSpecies(reaction,input,option)
  1092)   ! 
  1093)   ! Reads names of mineral species and sets flag
  1094)   ! 
  1095)   ! Author: Glenn Hammond
  1096)   ! Date: 04/01/11
  1097)   ! 
  1098) 
  1099)   use Input_Aux_module
  1100)   use String_module  
  1101)   use Option_module
  1102)   
  1103)   implicit none
  1104)   
  1105)   type(reaction_type) :: reaction
  1106)   type(input_type), pointer :: input
  1107)   type(option_type) :: option
  1108)   
  1109)   character(len=MAXWORDLENGTH) :: name
  1110)   
  1111)   type(aq_species_type), pointer :: cur_species
  1112) 
  1113)   input%ierr = 0
  1114)   do
  1115)     call InputReadPflotranString(input,option)
  1116)     if (InputError(input)) exit
  1117)     if (InputCheckExit(input,option)) exit  
  1118) 
  1119)     call InputReadWord(input,option,name,PETSC_TRUE)
  1120)     call InputErrorMsg(input,option,'keyword','CHEMISTRY,REDOX_SPECIES')
  1121)     
  1122)     cur_species => reaction%primary_species_list
  1123)     do 
  1124)       if (.not.associated(cur_species)) exit
  1125)       if (StringCompare(cur_species%name,name,MAXWORDLENGTH)) then
  1126)         cur_species%is_redox = PETSC_TRUE
  1127)         exit
  1128)       endif
  1129)       cur_species => cur_species%next
  1130)     enddo
  1131)     
  1132)     if (.not.associated(cur_species)) then
  1133)       option%io_buffer = 'Redox species "' // trim(name) // &
  1134)         '" not found among primary species.'
  1135)       call printErrMsg(option)
  1136)     endif
  1137)   enddo
  1138)   
  1139) end subroutine ReactionReadRedoxSpecies
  1140) 
  1141) ! ************************************************************************** !
  1142) 
  1143) subroutine ReactionProcessConstraint(reaction,constraint_name, &
  1144)                                      aq_species_constraint, &
  1145)                                      free_ion_guess, &
  1146)                                      mineral_constraint, &
  1147)                                      srfcplx_constraint, &
  1148)                                      colloid_constraint, &
  1149)                                      immobile_constraint, &
  1150)                                      option)
  1151)   ! 
  1152)   ! Initializes constraints based on primary
  1153)   ! species in system
  1154)   ! 
  1155)   ! Author: Glenn Hammond
  1156)   ! Date: 10/14/08
  1157)   ! 
  1158)   use Option_module
  1159)   use Input_Aux_module
  1160)   use String_module
  1161)   use Utility_module
  1162)   use Transport_Constraint_module
  1163)   
  1164)   implicit none
  1165)   
  1166)   type(reaction_type), pointer :: reaction
  1167)   character(len=MAXWORDLENGTH) :: constraint_name
  1168)   type(aq_species_constraint_type), pointer :: aq_species_constraint
  1169)   type(guess_constraint_type), pointer :: free_ion_guess
  1170)   type(mineral_constraint_type), pointer :: mineral_constraint
  1171)   type(srfcplx_constraint_type), pointer :: srfcplx_constraint
  1172)   type(colloid_constraint_type), pointer :: colloid_constraint
  1173)   type(immobile_constraint_type), pointer :: immobile_constraint
  1174)   type(option_type) :: option
  1175)   
  1176)   PetscBool :: found
  1177)   PetscInt :: icomp, jcomp
  1178)   PetscInt :: icoll, jcoll
  1179)   PetscInt :: igas, imnrl
  1180)   PetscReal :: constraint_conc(reaction%naqcomp)
  1181)   PetscInt :: constraint_type(reaction%naqcomp)
  1182)   character(len=MAXWORDLENGTH) :: constraint_aux_string(reaction%naqcomp)
  1183)   character(len=MAXWORDLENGTH) :: constraint_colloid_name(reaction%ncoll)
  1184)   PetscInt :: constraint_id(reaction%naqcomp)
  1185)   PetscBool :: external_dataset(reaction%naqcomp)
  1186)   
  1187)   constraint_id = 0
  1188)   constraint_aux_string = ''
  1189)   constraint_type = 0
  1190)   constraint_conc = 0.d0
  1191)   external_dataset = PETSC_FALSE
  1192)   
  1193)   ! aqueous species
  1194)   do icomp = 1, reaction%naqcomp
  1195)     found = PETSC_FALSE
  1196)     do jcomp = 1, reaction%naqcomp
  1197)       if (StringCompare(aq_species_constraint%names(icomp), &
  1198)                         reaction%primary_species_names(jcomp), &
  1199)                         MAXWORDLENGTH)) then
  1200)         found = PETSC_TRUE
  1201)         exit
  1202)       endif
  1203)     enddo
  1204)     if (.not.found) then
  1205)       option%io_buffer = &
  1206)                'Species ' // trim(aq_species_constraint%names(icomp)) // &
  1207)                ' from CONSTRAINT ' // trim(constraint_name) // &
  1208)                ' not found among primary species.'
  1209)       call printErrMsg(option)
  1210)     else
  1211)       constraint_type(jcomp) = aq_species_constraint%constraint_type(icomp)
  1212)       constraint_aux_string(jcomp) = aq_species_constraint%constraint_aux_string(icomp)
  1213)       constraint_conc(jcomp) = aq_species_constraint%constraint_conc(icomp)
  1214)       external_dataset(jcomp) = aq_species_constraint%external_dataset(icomp)
  1215)       
  1216)       ! link constraint species
  1217)       select case(constraint_type(jcomp))
  1218)         case(CONSTRAINT_MINERAL)
  1219)           found = PETSC_FALSE
  1220)           do imnrl = 1, reaction%mineral%nmnrl
  1221)             if (StringCompare(constraint_aux_string(jcomp), &
  1222)                               reaction%mineral%mineral_names(imnrl), &
  1223)                                 MAXWORDLENGTH)) then
  1224)               constraint_id(jcomp) = imnrl
  1225)               found = PETSC_TRUE
  1226)               exit
  1227)             endif
  1228)           enddo
  1229)           if (.not.found) then
  1230)             option%io_buffer = 'Constraint mineral: ' // &
  1231)                      trim(constraint_aux_string(jcomp)) // &
  1232)                      ' for aqueous species: ' // &
  1233)                      trim(reaction%primary_species_names(jcomp)) // &
  1234)                      ' in constraint: ' // &
  1235)                      trim(constraint_name) // ' not found.' 
  1236)             call printErrMsg(option)         
  1237)           endif
  1238)         case(CONSTRAINT_GAS, CONSTRAINT_SUPERCRIT_CO2)
  1239)           found = PETSC_FALSE
  1240)           do igas = 1, reaction%ngas
  1241)             if (StringCompare(constraint_aux_string(jcomp), &
  1242)                                 reaction%gas_species_names(igas), &
  1243)                                 MAXWORDLENGTH)) then
  1244)               constraint_id(jcomp) = igas
  1245)               found = PETSC_TRUE
  1246)               exit
  1247)             endif
  1248)           enddo
  1249)           if (.not.found) then
  1250)             option%io_buffer = 'Constraint gas: ' // &
  1251)                      trim(constraint_aux_string(jcomp)) // &
  1252)                      ' for aqueous species: ' // &
  1253)                      trim(reaction%primary_species_names(jcomp)) // &
  1254)                      ' in constraint: ' // &
  1255)                      trim(constraint_name) // ' not found.' 
  1256)             call printErrMsg(option)         
  1257)           endif
  1258)       end select
  1259) 
  1260)     endif
  1261)   enddo
  1262)   
  1263)   ! place ordered constraint parameters back in original arrays
  1264)   aq_species_constraint%constraint_type = constraint_type
  1265)   aq_species_constraint%constraint_aux_string = constraint_aux_string
  1266)   aq_species_constraint%constraint_spec_id = constraint_id
  1267)   aq_species_constraint%constraint_conc = constraint_conc
  1268)   aq_species_constraint%external_dataset = external_dataset
  1269) 
  1270)   
  1271)   if (.not.reaction%use_full_geochemistry) return
  1272)   
  1273)   ! free ion guess
  1274)   if (associated(free_ion_guess)) then
  1275)     constraint_conc = 0.d0
  1276)     do icomp = 1, reaction%naqcomp
  1277)       found = PETSC_FALSE
  1278)       do jcomp = 1, reaction%naqcomp
  1279)         if (StringCompare(free_ion_guess%names(icomp), &
  1280)                           reaction%primary_species_names(jcomp), &
  1281)                           MAXWORDLENGTH)) then
  1282)           found = PETSC_TRUE
  1283)           exit
  1284)         endif
  1285)       enddo
  1286)       if (.not.found) then
  1287)         option%io_buffer = &
  1288)                  'Guess species ' // trim(free_ion_guess%names(icomp)) // &
  1289)                  ' from CONSTRAINT ' // trim(constraint_name) // &
  1290)                  ' not found among primary species.'
  1291)         call printErrMsg(option)
  1292)       else
  1293)         constraint_conc(jcomp) = free_ion_guess%conc(icomp)
  1294)       endif
  1295)     enddo
  1296)     ! place ordered concentrations back in original array
  1297)     free_ion_guess%conc = constraint_conc
  1298)   endif
  1299)   
  1300)   ! minerals
  1301)   call MineralProcessConstraint(reaction%mineral,constraint_name, &
  1302)                                 mineral_constraint,option)
  1303) 
  1304)   ! surface complexes
  1305)   call SrfCplxProcessConstraint(reaction%surface_complexation, &
  1306)                                 constraint_name, &
  1307)                                 srfcplx_constraint,option)
  1308) 
  1309)   ! microbial immobile
  1310)   call ImmobileProcessConstraint(reaction%immobile,constraint_name, &
  1311)                                  immobile_constraint,option)
  1312)   
  1313) end subroutine ReactionProcessConstraint
  1314) 
  1315) ! ************************************************************************** !
  1316) 
  1317) subroutine ReactionEquilibrateConstraint(rt_auxvar,global_auxvar, &
  1318)                                          material_auxvar, &
  1319)                                          reaction,constraint_name, &
  1320)                                          aq_species_constraint, &
  1321)                                          free_ion_guess_constraint, &
  1322)                                          mineral_constraint, &
  1323)                                          srfcplx_constraint, &
  1324)                                          colloid_constraint, &
  1325)                                          immobile_constraint, &
  1326)                                          num_iterations, &
  1327)                                          use_prev_soln_as_guess,option)
  1328)   ! 
  1329)   ! Equilibrates constraint concentrations
  1330)   ! with prescribed geochemistry
  1331)   ! 
  1332)   ! Author: Glenn Hammond
  1333)   ! Date: 10/22/08
  1334)   ! 
  1335)   use Option_module
  1336)   use Input_Aux_module
  1337)   use String_module  
  1338)   use Utility_module
  1339)   use Transport_Constraint_module
  1340)   use EOS_Water_module
  1341)   use Material_Aux_class
  1342) 
  1343)   ! CO2-specific
  1344)   use co2eos_module, only: Henry_duan_sun
  1345)   use co2_span_wagner_module, only: co2_span_wagner
  1346) 
  1347)   implicit none
  1348)   
  1349)   type(reactive_transport_auxvar_type) :: rt_auxvar
  1350)   type(global_auxvar_type) :: global_auxvar
  1351)   class(material_auxvar_type) :: material_auxvar
  1352)   type(reaction_type), pointer :: reaction
  1353)   character(len=MAXWORDLENGTH) :: constraint_name
  1354)   type(aq_species_constraint_type), pointer :: aq_species_constraint
  1355)   type(guess_constraint_type), pointer :: free_ion_guess_constraint
  1356)   type(mineral_constraint_type), pointer :: mineral_constraint
  1357)   type(srfcplx_constraint_type), pointer :: srfcplx_constraint
  1358)   type(colloid_constraint_type), pointer :: colloid_constraint
  1359)   type(immobile_constraint_type), pointer :: immobile_constraint
  1360)   PetscInt :: num_iterations
  1361)   
  1362)   PetscBool :: use_prev_soln_as_guess
  1363)   type(option_type) :: option
  1364)   
  1365)   character(len=MAXSTRINGLENGTH) :: string
  1366)   PetscInt :: icomp, jcomp, kcomp
  1367)   PetscInt :: imnrl, jmnrl
  1368)   PetscInt :: icplx
  1369)   PetscInt :: irxn, isite, ncplx, k, ikinrxn
  1370)   PetscInt :: igas
  1371)   PetscReal :: conc(reaction%naqcomp)
  1372)   PetscInt :: constraint_type(reaction%naqcomp)
  1373)   character(len=MAXWORDLENGTH) :: constraint_aux_string(reaction%naqcomp)
  1374)   type(surface_complexation_type), pointer :: surface_complexation
  1375)   type(mineral_type), pointer :: mineral_reaction
  1376) 
  1377)   PetscReal :: Res(reaction%naqcomp)
  1378)   PetscReal :: update(reaction%naqcomp)
  1379)   PetscReal :: total_conc(reaction%naqcomp)
  1380)   PetscReal :: free_conc(reaction%naqcomp)
  1381)   PetscReal :: Jac(reaction%naqcomp,reaction%naqcomp)
  1382)   PetscInt :: indices(reaction%naqcomp)
  1383)   PetscReal :: norm
  1384)   PetscReal :: maximum_residual, maximum_relative_change
  1385)   PetscReal :: ratio, min_ratio
  1386)   PetscReal :: prev_molal(reaction%naqcomp)
  1387)   PetscBool :: compute_activity_coefs
  1388) 
  1389)   PetscInt :: constraint_id(reaction%naqcomp)
  1390)   PetscReal :: lnQK, QK
  1391)   PetscReal :: tempreal
  1392)   PetscReal :: pres, tc, xphico2, henry, m_na, m_cl, xmass 
  1393)   PetscInt :: comp_id
  1394)   PetscReal :: convert_molal_to_molar
  1395)   PetscReal :: convert_molar_to_molal
  1396)   
  1397)   PetscBool :: charge_balance_warning_flag = PETSC_FALSE
  1398)   PetscBool :: use_log_formulation
  1399)   
  1400)   PetscReal :: Jac_num(reaction%naqcomp)
  1401)   PetscReal :: Res_pert, pert, prev_value, coh0
  1402) 
  1403)   PetscInt :: iphase
  1404)   PetscInt :: idof
  1405)   PetscInt :: istartaq, iendaq
  1406)   PetscInt :: irate
  1407) 
  1408)   PetscInt :: num_it_act_coef_turned_on
  1409)   
  1410)   ! CO2-specific
  1411)   PetscReal :: dg,dddt,dddp,fg,dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,&
  1412)                yco2,pco2,sat_pressure,lngamco2
  1413)   PetscInt :: iflag
  1414)   PetscErrorCode :: ierr
  1415) 
  1416)   surface_complexation => reaction%surface_complexation
  1417)   mineral_reaction => reaction%mineral
  1418)     
  1419)   constraint_type = aq_species_constraint%constraint_type
  1420)   constraint_aux_string = aq_species_constraint%constraint_aux_string
  1421)   constraint_id = aq_species_constraint%constraint_spec_id
  1422)   conc = aq_species_constraint%constraint_conc
  1423) 
  1424)   istartaq = reaction%offset_aqueous
  1425)   iendaq = reaction%offset_aqueous + reaction%naqcomp    
  1426) 
  1427)   iphase = 1
  1428)   
  1429)   xmass = 1.d0
  1430)   if (associated(global_auxvar%xmass)) xmass = global_auxvar%xmass(iphase)
  1431)   
  1432)   if (reaction%initialize_with_molality) then
  1433)     convert_molal_to_molar = global_auxvar%den_kg(iphase)*xmass/1000.d0
  1434)     convert_molar_to_molal = 1.d0
  1435)   else
  1436)     convert_molal_to_molar = 1.d0
  1437)     convert_molar_to_molal = 1000.d0/global_auxvar%den_kg(iphase)/xmass
  1438)   endif
  1439) 
  1440)   !geh: We do need this setting of mineral volume fractions.  If not specified
  1441)   !     by a dataset, we must set the volume fraction and areas so that
  1442)   !     surface complexation is scaled correctly.  Yes, these will get 
  1443)   !     overwrittent with the same values when called from 
  1444)   !     CondControlAssignTranInitCond(), but big deal.
  1445)   if (associated(mineral_constraint)) then
  1446)     do imnrl = 1, mineral_reaction%nkinmnrl
  1447)       ! if read from a dataset, the mineral volume frac has already been set.
  1448)       if (.not.mineral_constraint%external_vol_frac_dataset(imnrl)) then
  1449)         rt_auxvar%mnrl_volfrac0(imnrl) = &
  1450)           mineral_constraint%constraint_vol_frac(imnrl)
  1451)         rt_auxvar%mnrl_volfrac(imnrl) = &
  1452)           mineral_constraint%constraint_vol_frac(imnrl)
  1453)       endif
  1454)       if (.not.mineral_constraint%external_area_dataset(imnrl)) then
  1455)         rt_auxvar%mnrl_area0(imnrl) = &
  1456)           mineral_constraint%constraint_area(imnrl)
  1457)         rt_auxvar%mnrl_area(imnrl) = &
  1458)           mineral_constraint%constraint_area(imnrl)
  1459)       endif
  1460)     enddo
  1461)   endif
  1462) 
  1463)   if (associated(colloid_constraint)) then      
  1464)     colloid_constraint%basis_conc_mob = colloid_constraint%constraint_conc_mob        
  1465)     colloid_constraint%basis_conc_imb = colloid_constraint%constraint_conc_imb        
  1466)     rt_auxvar%colloid%conc_mob = colloid_constraint%basis_conc_mob* &
  1467)                                  convert_molar_to_molal
  1468)     !TODO(geh): this can't be correct as immobile concentrations are mol/m^3
  1469)     rt_auxvar%colloid%conc_imb = colloid_constraint%basis_conc_imb* &
  1470)                                  convert_molar_to_molal
  1471)   endif  
  1472)   
  1473)   if (.not.reaction%use_full_geochemistry) then
  1474)     aq_species_constraint%basis_molarity = conc ! don't need to convert
  1475)     rt_auxvar%pri_molal = aq_species_constraint%basis_molarity* &
  1476)                           convert_molar_to_molal
  1477)     rt_auxvar%total(:,iphase) = aq_species_constraint%basis_molarity
  1478)     return
  1479)   endif
  1480)   
  1481)   if (.not.option%use_isothermal) then
  1482)     call RUpdateTempDependentCoefs(global_auxvar,reaction,PETSC_TRUE,option)
  1483)   endif
  1484)   
  1485)   if (use_prev_soln_as_guess) then
  1486)     free_conc = rt_auxvar%pri_molal
  1487)   else if (associated(free_ion_guess_constraint)) then
  1488)     free_conc = free_ion_guess_constraint%conc
  1489)   else
  1490)     free_conc = 1.d-9
  1491)   endif
  1492)   total_conc = 0.d0
  1493)   do icomp = 1, reaction%naqcomp
  1494)     select case(constraint_type(icomp))
  1495)       case(CONSTRAINT_NULL,CONSTRAINT_TOTAL)
  1496)         ! units = mol/L
  1497)         total_conc(icomp) = conc(icomp)*convert_molal_to_molar
  1498)         ! free_conc guess set above
  1499)       case(CONSTRAINT_TOTAL_SORB)
  1500)         ! units = mol/m^3 bulk
  1501)         total_conc(icomp) = conc(icomp)
  1502)       case(CONSTRAINT_FREE)
  1503)         free_conc(icomp) = conc(icomp)*convert_molar_to_molal
  1504)       case(CONSTRAINT_LOG)
  1505)         free_conc(icomp) = (10.d0**conc(icomp))*convert_molar_to_molal
  1506)       case(CONSTRAINT_CHARGE_BAL)
  1507)         if (.not.use_prev_soln_as_guess) then
  1508)           free_conc(icomp) = conc(icomp)*convert_molar_to_molal ! just a guess
  1509)         endif
  1510)       case(CONSTRAINT_PH)
  1511)         ! check if H+ id set
  1512)         if (associated(reaction%species_idx)) then
  1513)           if (reaction%species_idx%h_ion_id /= 0) then
  1514)             ! check if icomp is H+
  1515)             if (reaction%species_idx%h_ion_id /= icomp) then
  1516)               string = 'OH-'
  1517)               if (.not.StringCompare(reaction%primary_species_names(icomp), &
  1518)                                      string,MAXWORDLENGTH)) then
  1519)                 option%io_buffer = &
  1520)                          'pH specified as constraint (constraint =' // &
  1521)                          trim(constraint_name) // &
  1522)                          ') for species other than H+ or OH-: ' // &
  1523)                          trim(reaction%primary_species_names(icomp))
  1524)                 call printErrMsg(option)
  1525)               endif
  1526)             endif
  1527)             free_conc(icomp) = 10.d0**(-conc(icomp))
  1528)           else
  1529)             option%io_buffer = &
  1530)                      'pH specified as constraint (constraint =' // &
  1531)                      trim(constraint_name) // &
  1532)                      '), but H+ not found in chemical species.'
  1533)             call printErrMsg(option)
  1534)           endif
  1535)         endif        
  1536)       case(CONSTRAINT_MINERAL)
  1537)         if (.not.use_prev_soln_as_guess) then
  1538)           free_conc(icomp) = conc(icomp)*convert_molar_to_molal ! guess
  1539)         endif
  1540)       case(CONSTRAINT_GAS, CONSTRAINT_SUPERCRIT_CO2)
  1541)         if (conc(icomp) <= 0.d0) then ! log form
  1542)           conc(icomp) = 10.d0**conc(icomp) ! conc log10 partial pressure gas
  1543)         endif
  1544)         ! free_conc guess set above
  1545)     end select
  1546)   enddo
  1547) 
  1548)   rt_auxvar%pri_molal = free_conc
  1549) 
  1550)   num_iterations = 0
  1551)   num_it_act_coef_turned_on = 0
  1552) 
  1553)   ! if previous solution is provided as a guess, it should be close enough
  1554)   ! to use activity coefficients right away. - geh
  1555)   ! essentially the same as:
  1556)   !   compute_activity_coefficients = (use_prev_soln_as_guess == PETSC_TRUE)
  1557)   compute_activity_coefs = use_prev_soln_as_guess
  1558)   
  1559)   do
  1560) 
  1561)     if (reaction%act_coef_update_frequency /= ACT_COEF_FREQUENCY_OFF .and. &
  1562)         compute_activity_coefs) then
  1563)       call RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
  1564)       if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
  1565)         call CO2AqActCoeff(rt_auxvar,global_auxvar,reaction,option)  
  1566)       endif
  1567)     endif
  1568)     call RTotal(rt_auxvar,global_auxvar,reaction,option)
  1569)     if (reaction%nsorb > 0) then
  1570)       if (reaction%neqsorb > 0) then
  1571)         call RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
  1572)       endif
  1573)       if (reaction%surface_complexation%nkinmrsrfcplx > 0) then
  1574)         call RTotalSorbMultiRateAsEQ(rt_auxvar,global_auxvar,material_auxvar, &
  1575)                                      reaction,option)
  1576)       endif
  1577)     endif
  1578)     
  1579)     ! geh - for debugging
  1580)     !call RTPrintAuxVar(rt_auxvar,reaction,option)
  1581) 
  1582)     Jac = 0.d0
  1583) 
  1584) ! for colloids later on    
  1585) !    if (reaction%ncoll > 0) then
  1586) !      do idof = istartcoll, iendcoll
  1587) !        Jac(idof,idof) = 1.d0
  1588) !      enddo
  1589) !    endif
  1590)         
  1591)     do icomp = 1, reaction%naqcomp
  1592) 
  1593)       select case(constraint_type(icomp))
  1594)       
  1595)         case(CONSTRAINT_NULL,CONSTRAINT_TOTAL)
  1596)         
  1597)           ! units = mol/L water
  1598)           Res(icomp) = rt_auxvar%total(icomp,1) - total_conc(icomp)
  1599)           ! dtotal units = kg water/L water
  1600) 
  1601)           ! Jac units = kg water/L water
  1602)           Jac(icomp,:) = rt_auxvar%aqueous%dtotal(icomp,:,1)
  1603)           
  1604)         case(CONSTRAINT_TOTAL_SORB)
  1605)         
  1606)           ! units = mol/m^3 bulk
  1607)           Res(icomp) = rt_auxvar%total_sorb_eq(icomp) - total_conc(icomp)
  1608)           ! dtotal_sorb units = kg water/m^3 bulk
  1609)           ! Jac units = kg water/m^3 bulk
  1610)           Jac(icomp,:) = rt_auxvar%dtotal_sorb_eq(icomp,:)
  1611) 
  1612)         case(CONSTRAINT_FREE,CONSTRAINT_LOG)
  1613)         
  1614)           Res(icomp) = 0.d0
  1615)           Jac(icomp,:) = 0.d0
  1616) !          Jac(:,icomp) = 0.d0
  1617)           Jac(icomp,icomp) = 1.d0
  1618)           
  1619)         case(CONSTRAINT_CHARGE_BAL)
  1620)         
  1621)           Res(icomp) = 0.d0
  1622)           Jac(icomp,:) = 0.d0
  1623)           do jcomp = 1, reaction%naqcomp
  1624)             Res(icomp) = Res(icomp) + reaction%primary_spec_Z(jcomp) * &
  1625)               rt_auxvar%total(jcomp,1)
  1626)             do kcomp = 1, reaction%naqcomp
  1627)               Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
  1628)                 reaction%primary_spec_Z(kcomp)*rt_auxvar%aqueous%dtotal(kcomp,jcomp,1)
  1629)             enddo
  1630)           enddo
  1631)           if (rt_auxvar%pri_molal(icomp) < 1.d-20 .and. &
  1632)               .not.charge_balance_warning_flag) then
  1633)             if ((Res(icomp) > 0.d0 .and. &
  1634)                  reaction%primary_spec_Z(icomp) > 0.d0) .or. &
  1635)                 (Res(icomp) < 0.d0 .and. &
  1636)                  reaction%primary_spec_Z(icomp) < 0.d0)) then
  1637)               option%io_buffer = &
  1638)                        'Charge balance species ' // &
  1639)                        trim(reaction%primary_species_names(icomp)) // &
  1640)                        ' may not satisfy constraint ' // &
  1641)                        trim(constraint_name) // &
  1642)                        '.  Molality already below 1.e-20.'
  1643)               call printMsg(option)
  1644)               charge_balance_warning_flag = PETSC_TRUE
  1645)               rt_auxvar%pri_molal(icomp) = 1.e-3 ! reset guess
  1646)             endif
  1647)           endif
  1648)           
  1649)         case(CONSTRAINT_PH)
  1650)         
  1651)           Res(icomp) = 0.d0
  1652)           Jac(icomp,:) = 0.d0
  1653)           if (associated(reaction%species_idx)) then
  1654)             if (reaction%species_idx%h_ion_id > 0) then ! conc(icomp) = 10**-pH
  1655)               rt_auxvar%pri_molal(icomp) = 10.d0**(-conc(icomp)) / &
  1656)                                             rt_auxvar%pri_act_coef(icomp)
  1657)               Jac(icomp,icomp) = 1.d0
  1658)             else ! H+ is a complex
  1659)             
  1660)               icplx = abs(reaction%species_idx%h_ion_id)
  1661)               
  1662)               ! compute secondary species concentration
  1663)               ! *note that the sign was flipped below
  1664)               lnQK = -reaction%eqcplx_logK(icplx)*LOG_TO_LN
  1665) 
  1666)               ! activity of water
  1667)               if (reaction%eqcplxh2oid(icplx) > 0) then
  1668)                 lnQK = lnQK + reaction%eqcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
  1669)               endif
  1670) 
  1671)               do jcomp = 1, reaction%eqcplxspecid(0,icplx)
  1672)                 comp_id = reaction%eqcplxspecid(jcomp,icplx)
  1673)                 lnQK = lnQK + reaction%eqcplxstoich(jcomp,icplx)* &
  1674)                               log(rt_auxvar%pri_molal(comp_id)* &
  1675)                               rt_auxvar%pri_act_coef(comp_id))
  1676)               enddo
  1677)               lnQK = lnQK + conc(icomp)*LOG_TO_LN ! this is log activity H+
  1678)               QK = exp(lnQK)
  1679)               
  1680)               Res(icomp) = 1.d0 - QK
  1681) 
  1682)               do jcomp = 1,reaction%eqcplxspecid(0,icplx)
  1683)                 comp_id = reaction%eqcplxspecid(jcomp,icplx)
  1684)                 Jac(icomp,comp_id) = -QK/rt_auxvar%pri_molal(comp_id)* &
  1685)                                           reaction%eqcplxstoich(jcomp,icplx)
  1686)               enddo
  1687)             endif
  1688)           endif
  1689)                       
  1690)         case(CONSTRAINT_MINERAL)
  1691) 
  1692)           imnrl = constraint_id(icomp)
  1693)           lnQK = -mineral_reaction%mnrl_logK(imnrl)*LOG_TO_LN
  1694) 
  1695)           ! activity of water
  1696)           if (mineral_reaction%mnrlh2oid(imnrl) > 0) then
  1697)             lnQK = lnQK + mineral_reaction%mnrlh2ostoich(imnrl)*rt_auxvar%ln_act_h2o
  1698)           endif
  1699) 
  1700)           ! compute ion activity product
  1701)           do jcomp = 1, mineral_reaction%mnrlspecid(0,imnrl)
  1702)             comp_id = mineral_reaction%mnrlspecid(jcomp,imnrl)
  1703)             lnQK = lnQK + mineral_reaction%mnrlstoich(jcomp,imnrl)* &
  1704)                           log(rt_auxvar%pri_molal(comp_id)* &
  1705)                           rt_auxvar%pri_act_coef(comp_id))
  1706)           enddo
  1707)           
  1708)           Res(icomp) = lnQK
  1709) 
  1710)           do jcomp = 1,mineral_reaction%mnrlspecid(0,imnrl)
  1711)             comp_id = mineral_reaction%mnrlspecid(jcomp,imnrl)
  1712)             Jac(icomp,comp_id) = mineral_reaction%mnrlstoich(jcomp,imnrl)/ &
  1713)               rt_auxvar%pri_molal(comp_id)
  1714)           enddo
  1715)   
  1716)         case(CONSTRAINT_GAS)
  1717) 
  1718)           igas = constraint_id(icomp)
  1719)           lnQK = -reaction%eqgas_logK(igas)*LOG_TO_LN
  1720)  
  1721)           ! divide K by RT
  1722)           !lnQK = lnQK - log((auxvar%temp+273.15d0)*IDEAL_GAS_CONSTANT)
  1723)           
  1724)           ! activity of water
  1725)           if (reaction%eqgash2oid(igas) > 0) then
  1726)             lnQK = lnQK + reaction%eqgash2ostoich(igas)*rt_auxvar%ln_act_h2o
  1727)           endif
  1728) 
  1729)           ! compute ion activity product
  1730)           do jcomp = 1, reaction%eqgasspecid(0,igas)
  1731)             comp_id = reaction%eqgasspecid(jcomp,igas)
  1732)             lnQK = lnQK + reaction%eqgasstoich(jcomp,igas)* &
  1733)               log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
  1734)           enddo
  1735)           
  1736) !         QK = exp(lnQK)
  1737)           
  1738) !         Res(icomp) = QK - conc(icomp)
  1739)           Res(icomp) = lnQK - log(conc(icomp)) ! gas pressure
  1740)           Jac(icomp,:) = 0.d0
  1741)           do jcomp = 1,reaction%eqgasspecid(0,igas)
  1742)             comp_id = reaction%eqgasspecid(jcomp,igas)
  1743) !           Jac(icomp,comp_id) = QK/auxvar%primary_spec(comp_id)* &
  1744) !                                reaction%eqgasstoich(jcomp,igas)
  1745)             Jac(icomp,comp_id) = reaction%eqgasstoich(jcomp,igas)/ &
  1746)               rt_auxvar%pri_molal(comp_id)
  1747)           enddo
  1748) 
  1749)         ! CO2-specific
  1750)         case(CONSTRAINT_SUPERCRIT_CO2)
  1751)           
  1752)           igas = constraint_id(icomp)
  1753)          
  1754)           ! compute secondary species concentration
  1755)           if (abs(reaction%species_idx%co2_gas_id) == igas) then
  1756)            
  1757) !           pres = global_auxvar%pres(2)
  1758)             pres = conc(icomp)*1.D5
  1759)             global_auxvar%pres(2) = pres
  1760)             
  1761)             tc = global_auxvar%temp
  1762) 
  1763)             call EOSWaterSaturationPressure(tc, sat_pressure, ierr)
  1764)             
  1765)             pco2 = conc(icomp)*1.e5
  1766) !           pco2 = pres - sat_pressure
  1767)             
  1768)             pres = pco2 + sat_pressure
  1769)             yco2 = pco2/pres
  1770)              
  1771)             iflag = 1
  1772)             call co2_span_wagner(pres*1D-6,tc+273.15D0,dg,dddt,dddp,fg, &
  1773)               dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,iflag,option%itable)
  1774) 
  1775) !            call co2_span_wagner(pco2*1D-6,tc+273.15D0,dg,dddt,dddp,fg, &
  1776) !              dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,option%itable)
  1777)             
  1778)             global_auxvar%den_kg(2) = dg
  1779)             
  1780)             !compute fugacity coefficient
  1781)             fg = fg*1.D6
  1782)             xphico2 = fg / pres
  1783)             global_auxvar%fugacoeff(1) = xphico2
  1784) 
  1785)             m_na = 0.d0
  1786)             m_cl = 0.d0
  1787)             if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
  1788)               m_na = rt_auxvar%pri_molal(reaction%species_idx%na_ion_id)
  1789)               m_cl = rt_auxvar%pri_molal(reaction%species_idx%cl_ion_id)
  1790) !              call Henry_duan_sun(tc,pco2*1D-5,henry,lngamco2,m_na,m_cl)
  1791)               call Henry_duan_sun(tc,pres*1D-5,henry,lngamco2,m_na,m_cl)
  1792)             else
  1793)               call Henry_duan_sun(tc,pres*1D-5,henry,lngamco2, &
  1794)                 option%m_nacl,option%m_nacl)
  1795)              !   print *, 'SC: mnacl=', option%m_nacl,'stioh2o=',reaction%eqgash2ostoich(igas)
  1796)             endif
  1797)             
  1798)             lnQk = -log(xphico2*henry)-lngamco2
  1799) 
  1800)             reaction%eqgas_logK(igas) = -lnQK*LN_TO_LOG
  1801) !           reaction%scco2_eq_logK = -lnQK*LN_TO_LOG
  1802) !geh: scco2_eq_logK is only used in one location.  Why add to global_auxvar???
  1803) !geh            global_auxvar%scco2_eq_logK = -lnQK*LN_TO_LOG
  1804)                         
  1805)             ! activity of water
  1806)             if (reaction%eqgash2oid(igas) > 0) then
  1807)               lnQK = lnQK + reaction%eqgash2ostoich(igas)*rt_auxvar%ln_act_h2o
  1808)             endif
  1809)             do jcomp = 1, reaction%eqgasspecid(0,igas)
  1810)               comp_id = reaction%eqgasspecid(jcomp,igas)
  1811)               lnQK = lnQK + reaction%eqgasstoich(jcomp,igas)* &
  1812) !                log(rt_auxvar%pri_molal(comp_id))
  1813)                log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
  1814) !                print *,'SC: ',rt_auxvar%pri_molal(comp_id), &
  1815) !                  rt_auxvar%pri_act_coef(comp_id),exp(lngamco2)
  1816)             enddo
  1817)           
  1818) !           QK = exp(lnQK)
  1819)              
  1820)             Res(icomp) = lnQK - log(pco2*1D-5) ! gas pressure bars
  1821)             Jac(icomp,:) = 0.d0
  1822)             do jcomp = 1,reaction%eqgasspecid(0,igas)
  1823)               comp_id = reaction%eqgasspecid(jcomp,igas)
  1824) !             Jac(icomp,comp_id) = QK/auxvar%primary_spec(comp_id)* &
  1825) !                                reaction%eqgasstoich(jcomp,igas)
  1826)               Jac(icomp,comp_id) = reaction%eqgasstoich(jcomp,igas)/ &
  1827)                 rt_auxvar%pri_molal(comp_id)
  1828)               
  1829)             enddo
  1830)          endif       
  1831)         ! end CO2-specific
  1832)       end select
  1833)     enddo
  1834)     
  1835)     maximum_residual = maxval(abs(Res))
  1836)     
  1837)     if (reaction%use_log_formulation) then
  1838)       ! force at least 4 log updates, then cycle the next 5 updates between
  1839)       ! log/linear.  This improves convergence of linear problems or 
  1840)       ! primary components with no complexes, reactions, etc. (e.g. tracers)
  1841)       if (num_iterations > 3 .and. num_iterations < 9) then
  1842)         use_log_formulation = (mod(num_iterations,2) == 0)
  1843)       else
  1844)         use_log_formulation = PETSC_TRUE
  1845)       endif
  1846)     else
  1847)       use_log_formulation = PETSC_FALSE
  1848)     endif
  1849)       
  1850)     call RSolve(Res,Jac,rt_auxvar%pri_molal,update,reaction%naqcomp, &
  1851)                 use_log_formulation)
  1852)     
  1853)     prev_molal = rt_auxvar%pri_molal
  1854) 
  1855)     if (use_log_formulation) then
  1856)       update = dsign(1.d0,update)*min(dabs(update),reaction%max_dlnC)
  1857)       rt_auxvar%pri_molal = rt_auxvar%pri_molal*exp(-update)    
  1858)     else ! linear update
  1859)       ! ensure non-negative concentration
  1860)       min_ratio = 1.d20 ! large number
  1861)       do icomp = 1, reaction%naqcomp
  1862)         if (prev_molal(icomp) <= update(icomp)) then
  1863)           ratio = abs(prev_molal(icomp)/update(icomp))
  1864)           if (ratio < min_ratio) min_ratio = ratio
  1865)         endif
  1866)       enddo
  1867)       if (min_ratio <= 1.d0) then
  1868)         ! scale by 0.99 to make the update slightly smaller than the min_ratio
  1869)         update = update*min_ratio*0.99d0
  1870)       endif
  1871)       rt_auxvar%pri_molal = prev_molal - update
  1872)       ! could use:
  1873)       ! rt_auxvar%pri_molal = prev_molal - update * minval(abs(prev_molal/update))
  1874)     endif
  1875)     
  1876)     ! check to ensure that minimum concentration is not less than or equal
  1877)     ! to zero
  1878)     tempreal = minval(rt_auxvar%pri_molal)
  1879)     if (tempreal <= 0.d0) then
  1880)       option%io_buffer = 'ERROR: Zero concentrations found in ' // &
  1881)         'constraint "' // trim(constraint_name) // '".'
  1882)       call printMsgByRank(option)
  1883)       ! now figure out which species have zero concentrations
  1884)       do idof = 1, reaction%naqcomp
  1885)         if (rt_auxvar%pri_molal(idof) <= 0.d0) then
  1886)           write(string,*) rt_auxvar%pri_molal(idof)
  1887)           option%io_buffer = '  Species "' // &
  1888)             trim(reaction%primary_species_names(idof)) // &
  1889)             '" has zero concentration (' // &
  1890)             trim(adjustl(string)) // ').'
  1891)           call printMsgByRank(option)
  1892)         endif
  1893)       enddo
  1894)       option%io_buffer = 'Free ion concentations RESULTING from ' // &
  1895)         'constraint concentrations must be positive.'
  1896)       call printErrMsgByRank(option)
  1897)     endif
  1898)     
  1899) #if 0
  1900) !geh cannot use this check as for many problems (e.g. Hanford 300 Area U), the 
  1901) !    concentrations temporarily go well above 100.
  1902) 
  1903)     ! check for excessively large maximum values, which likely indicates
  1904)     ! reaction going awry.
  1905)     tempreal = maxval(rt_auxvar%pri_molal)
  1906)     ! allow a few iterations; sometime charge balance constraint jumps
  1907)     ! during initial iterations
  1908)     if (tempreal > 100.d0 .and. num_iterations > 500) then
  1909)       !geh: for some reason, needs the array rank included in call to maxloc
  1910)       idof = maxloc(rt_auxvar%pri_molal,1)
  1911)       option%io_buffer = 'ERROR: Excessively large concentration for ' // &
  1912)         'species "' // trim(reaction%primary_species_names(idof)) // &
  1913)         '" in constraint "' // trim(constraint_name) // &
  1914)         '" in ReactionEquilibrateConstraint. Email input deck to ' // &
  1915)         'pflotran-dev@googlegroups.com.'
  1916)       call printErrMsg(option)
  1917)     endif
  1918) #endif
  1919)     
  1920)     maximum_relative_change = maxval(abs((rt_auxvar%pri_molal-prev_molal)/ &
  1921)                                          prev_molal))
  1922)     
  1923)     num_iterations = num_iterations + 1
  1924)     
  1925)     if (mod(num_iterations,1000) == 0) then
  1926) 100   format('Constraint iteration count has exceeded: ',i5)
  1927)       write(option%io_buffer,100) num_iterations
  1928)       call printMsg(option)
  1929)       do icomp=1,reaction%naqcomp
  1930)         write(option%io_buffer,200) reaction%primary_species_names(icomp), &
  1931)         prev_molal(icomp),Res(icomp)
  1932)         call printMsg(option)
  1933)       enddo
  1934) 200   format(a12,1x,1p2e12.4)
  1935)       if (num_iterations >= 10000) then
  1936)         print *, 'cell id (natural):', option%iflag 
  1937)         print *, 'constraint:', conc
  1938)         print *, 'constraint type:', constraint_type
  1939)         print *, 'free_conc:', free_conc
  1940)         option%io_buffer = 'Equilibration of constraint "' // &
  1941)           trim(constraint_name) // &
  1942)           '" stopping due to excessive iteration count!'
  1943)         call printErrMsgByRank(option)
  1944)       endif
  1945)     endif
  1946)     
  1947)     ! check for convergence
  1948)     if (maximum_residual < reaction%max_residual_tolerance .and. &
  1949)         maximum_relative_change < reaction%max_relative_change_tolerance) then
  1950)       ! Need some sort of convergence before we kick in activities
  1951)       if (compute_activity_coefs .and. &
  1952)           ! With some constraints (e.g. pH), the total component concentration
  1953)           ! is not updated immediately after activity coefficients are turned
  1954)           ! on.  Therefore, we need at least two iterations to declare 
  1955)           ! convergence. - geh
  1956)           num_iterations - num_it_act_coef_turned_on > 1) exit
  1957)       if (.not. compute_activity_coefs) &
  1958)         num_it_act_coef_turned_on = num_iterations
  1959)       compute_activity_coefs = PETSC_TRUE
  1960)     endif
  1961) 
  1962)   enddo
  1963) 
  1964)   ! once equilibrated, compute sorbed concentrations
  1965)   if (reaction%nsorb > 0) then
  1966)     if (reaction%neqsorb > 0) then
  1967)       call RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
  1968)     endif
  1969)     if (reaction%surface_complexation%nkinmrsrfcplx > 0) then
  1970)       call RTotalSorbMultiRateAsEQ(rt_auxvar,global_auxvar,material_auxvar, &
  1971)                                    reaction,option)
  1972)     endif
  1973)   endif
  1974)   
  1975)   ! WARNING: below assumes site concentration multiplicative factor
  1976)   if (surface_complexation%nsrfcplxrxn > 0) then
  1977)     do irxn = 1, surface_complexation%nkinmrsrfcplxrxn
  1978)       do irate = 1, surface_complexation%kinmr_nrate(irxn)
  1979)         rt_auxvar%kinmr_total_sorb(:,irate,irxn) = &
  1980)           surface_complexation%kinmr_frac(irate,irxn) * &
  1981)           rt_auxvar%kinmr_total_sorb(:,0,irxn)
  1982)       enddo
  1983)     enddo
  1984) 
  1985)     if (surface_complexation%nkinsrfcplx > 0 .and. &
  1986)         associated(srfcplx_constraint)) then
  1987)     ! compute surface complex conc. at new time step (5.1-30) 
  1988)       rt_auxvar%kinsrfcplx_conc(:,1) = srfcplx_constraint%constraint_conc
  1989)       do ikinrxn = 1, surface_complexation%nkinsrfcplxrxn
  1990)         irxn = surface_complexation%kinsrfcplxrxn_to_srfcplxrxn(ikinrxn)
  1991)         isite = surface_complexation%srfcplxrxn_to_surf(irxn)
  1992)         rt_auxvar%kinsrfcplx_free_site_conc(isite) = surface_complexation%srfcplxrxn_site_density(isite)
  1993)         ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
  1994)         do k = 1, ncplx ! ncplx in rxn
  1995)           icplx = surface_complexation%srfcplxrxn_to_complex(k,irxn)
  1996)           rt_auxvar%kinsrfcplx_free_site_conc(isite) = &
  1997)             rt_auxvar%kinsrfcplx_free_site_conc(isite) - &
  1998)             rt_auxvar%kinsrfcplx_conc(icplx,ikinrxn)
  1999)         enddo
  2000)       enddo
  2001)       do ikinrxn = 1, surface_complexation%nkinsrfcplxrxn
  2002)         irxn = surface_complexation%kinsrfcplxrxn_to_srfcplxrxn(ikinrxn)
  2003)         isite = surface_complexation%srfcplxrxn_to_surf(irxn)
  2004)         if (rt_auxvar%kinsrfcplx_free_site_conc(isite) < 0.d0) then
  2005)           option%io_buffer = 'Free site concentration for site ' // &
  2006)             trim(surface_complexation%srfcplxrxn_site_names(isite)) // &
  2007)             ' is less than zero.'
  2008)           call printErrMsgByRank(option)
  2009)         endif
  2010)       enddo
  2011)       srfcplx_constraint%basis_free_site_conc = &
  2012)         rt_auxvar%kinsrfcplx_free_site_conc
  2013)     endif
  2014)   endif
  2015)   
  2016)   ! do not scale by molal_to_molar since it could be 1.d0 if MOLAL flag set
  2017)   aq_species_constraint%basis_molarity = rt_auxvar%pri_molal* &
  2018)                                  global_auxvar%den_kg(option%liquid_phase)/ &
  2019)                                  1000.d0
  2020) 
  2021) #if 0
  2022)   call RCalculateCompression(global_auxvar,rt_auxvar,reaction,option)
  2023) #endif
  2024) 
  2025) ! this is performed above
  2026) !  if (associated(colloid_constraint%colloids)) then                        
  2027) !    colloid_constraint%colloids%basis_conc_mob = rt_auxvar%colloid%conc_mob* &
  2028) !                           global_auxvar%den_kg(option%liquid_phase)/1000.d0
  2029) !    colloid_constraint%colloids%basis_conc_imb = rt_auxvar%colloid%conc_imb* &
  2030) !                           global_auxvar%den_kg(option%liquid_phase)/1000.d0
  2031) !  endif
  2032)     
  2033) !  write(option%io_buffer,111) trim(constraint_name),num_iterations
  2034) !  call printMsg(option)
  2035) !111 format(' Equilibrate Constraint: ',a30,i4)
  2036) 
  2037) end subroutine ReactionEquilibrateConstraint
  2038) 
  2039) ! ************************************************************************** !
  2040) 
  2041) subroutine ReactionPrintConstraint(constraint_coupler,reaction,option)
  2042)   ! 
  2043)   ! Prints a constraint associated with reactive
  2044)   ! transport
  2045)   ! 
  2046)   ! Author: Glenn Hammond
  2047)   ! Date: 10/28/08
  2048)   ! 
  2049) 
  2050)   use Option_module
  2051)   use Input_Aux_module
  2052)   use String_module
  2053)   use Transport_Constraint_module
  2054) 
  2055)   implicit none
  2056)   
  2057)   type(option_type) :: option
  2058)   type(tran_constraint_coupler_type) :: constraint_coupler
  2059)   type(reaction_type), pointer :: reaction
  2060)   
  2061)   type(reactive_transport_auxvar_type), pointer :: rt_auxvar
  2062)   type(global_auxvar_type), pointer :: global_auxvar
  2063)   type(aq_species_constraint_type), pointer :: aq_species_constraint
  2064)   type(mineral_constraint_type), pointer :: mineral_constraint
  2065)   type(surface_complexation_type), pointer :: surface_complexation
  2066)   type(mineral_type), pointer :: mineral_reaction
  2067)   character(len=MAXSTRINGLENGTH) :: string
  2068)   PetscInt :: i, icomp, irxn, j, jj, ncomp, ncplx, ieqrxn
  2069)   PetscInt :: icplx, icplx2
  2070)   PetscInt :: imnrl,igas
  2071)   PetscInt :: eqcplxsort(reaction%neqcplx+1)
  2072)   PetscInt :: eqcplxid(reaction%neqcplx+1)
  2073)   PetscInt :: eqminsort(reaction%mineral%nmnrl)
  2074)   PetscInt, allocatable :: eqsrfcplxsort(:)
  2075)   PetscBool :: finished, found
  2076)   PetscReal :: conc, conc2
  2077)   PetscReal :: lnQK(reaction%mineral%nmnrl), QK(reaction%mineral%nmnrl)
  2078)   PetscReal :: lnQKgas(reaction%ngas), QKgas(reaction%ngas)
  2079)   PetscReal :: charge_balance, ionic_strength
  2080)   PetscReal :: percent(reaction%neqcplx+1)
  2081)   PetscReal :: totj, retardation, kd, ph
  2082)   PetscInt :: comp_id, jcomp
  2083)   PetscInt :: icount
  2084)   PetscInt :: iphase, ifo2
  2085)   PetscReal :: bulk_vol_to_fluid_vol, molar_to_molal, molal_to_molar
  2086)   PetscReal :: sum_molality, sum_mass, mole_fraction_h2o, mass_fraction_h2o, &
  2087)                mass_fraction_co2, mole_fraction_co2
  2088)   PetscReal :: ehfac,eh,pe,tk
  2089)   PetscReal :: affinity
  2090) 
  2091)   aq_species_constraint => constraint_coupler%aqueous_species
  2092)   mineral_constraint => constraint_coupler%minerals
  2093)   
  2094)   iphase = 1
  2095) 
  2096)   90 format(2x,76('-'))
  2097)   91 format(a)
  2098) 
  2099)   write(option%fid_out,'(/,''  Constraint: '',a)') &
  2100)     trim(constraint_coupler%constraint_name)
  2101) 
  2102)   rt_auxvar => constraint_coupler%rt_auxvar
  2103)   global_auxvar => constraint_coupler%global_auxvar
  2104)   surface_complexation => reaction%surface_complexation
  2105)   mineral_reaction => reaction%mineral
  2106) 
  2107)   select case(option%iflowmode)
  2108)     case(FLASH2_MODE,MPH_MODE,IMS_MODE,MIS_MODE)
  2109)     case(NULL_MODE)
  2110)       global_auxvar%den_kg(iphase) = option%reference_water_density
  2111)       global_auxvar%temp = option%reference_temperature
  2112)       global_auxvar%sat(iphase) = option%reference_saturation
  2113)     case(RICHARDS_MODE)
  2114)       global_auxvar%temp = option%reference_temperature
  2115)   end select
  2116)         
  2117) !  global_auxvar%den_kg(iphase) = option%reference_water_density
  2118) !  global_auxvar%temp = option%reference_temperature
  2119) !  global_auxvar%sat(iphase) = option%reference_saturation
  2120)   bulk_vol_to_fluid_vol = option%reference_porosity* &
  2121)                           global_auxvar%sat(iphase)*1000.d0
  2122) 
  2123) ! compute mole and mass fractions of H2O
  2124)   if (reaction%use_full_geochemistry) then
  2125)     sum_molality = 0.d0
  2126)     do icomp = 1, reaction%naqcomp
  2127)       if (icomp /= reaction%species_idx%h2o_aq_id) then
  2128)         sum_molality = sum_molality + rt_auxvar%pri_molal(icomp)
  2129)       endif
  2130)     enddo
  2131)     if (reaction%neqcplx > 0) then    
  2132)       do i = 1, reaction%neqcplx
  2133)         sum_molality = sum_molality + rt_auxvar%sec_molal(i)
  2134)       enddo
  2135)     endif
  2136)     mole_fraction_h2o = 1.d0/(1.d0+FMWH2O*sum_molality*1.d-3)
  2137) 
  2138)     sum_mass = 0.d0
  2139)     do icomp = 1, reaction%naqcomp
  2140)       if (icomp /= reaction%species_idx%h2o_aq_id) then
  2141)         sum_mass = sum_mass + &
  2142)           reaction%primary_spec_molar_wt(icomp)*rt_auxvar%pri_molal(icomp)
  2143)       endif
  2144)     enddo
  2145)     if (reaction%neqcplx > 0) then    
  2146)       do i = 1, reaction%neqcplx
  2147)         sum_mass = sum_mass + reaction%eqcplx_molar_wt(i)*rt_auxvar%sec_molal(i)
  2148)       enddo
  2149)     endif
  2150)     mass_fraction_h2o = 1.d0/(1.d0 + sum_mass*1.d-3)
  2151)   endif
  2152)   
  2153)   molal_to_molar = global_auxvar%den_kg(iphase)/1000.d0
  2154)   molar_to_molal = 1.d0/molal_to_molar
  2155)     
  2156)   if (.not.reaction%use_full_geochemistry) then
  2157)     100 format(/,'  species       molality')  
  2158)     write(option%fid_out,100)
  2159)     101 format(2x,a12,es12.4)
  2160)     do icomp = 1, reaction%naqcomp
  2161)       write(option%fid_out,101) reaction%primary_species_names(icomp), &
  2162)                                 rt_auxvar%pri_molal(icomp)
  2163)     enddo
  2164)   else
  2165) 
  2166)     ! CO2-specific
  2167)     if (.not.option%use_isothermal .and. &
  2168)         (option%iflowmode == MPH_MODE .or. &
  2169)          option%iflowmode == FLASH2_MODE)) then
  2170)       call RUpdateTempDependentCoefs(global_auxvar,reaction,PETSC_TRUE,option)
  2171)       if (associated(reaction%eqgas_logKcoef)) then
  2172)         do i = 1, reaction%naqcomp
  2173)           if (aq_species_constraint%constraint_type(i) == &
  2174)               CONSTRAINT_SUPERCRIT_CO2) then
  2175)             igas = aq_species_constraint%constraint_spec_id(i)
  2176)             if (abs(reaction%species_idx%co2_gas_id) == igas) then
  2177)               option%io_buffer = 'Adding "scco2_eq_logK" to ' // &
  2178)                 'global_auxvar_type solely so you can set reaction%' // &
  2179)                 '%eqgas_logK(igas) within ReactionPrintConstraint is not ' // &
  2180)                 'acceptable.  Find another way! - Regards, Glenn'
  2181)               call printErrMsg(option)
  2182) !geh              reaction%eqgas_logK(igas) = global_auxvar%scco2_eq_logK
  2183)             endif
  2184)           endif
  2185)         enddo
  2186)       endif
  2187)     endif
  2188) 
  2189) 200 format('')
  2190) 201 format(a20,i5)
  2191) 202 format(a20,f10.2)
  2192) 203 format(a20,f8.4)
  2193) 204 format(a20,es12.4)
  2194) 
  2195)     write(option%fid_out,90)
  2196)     write(option%fid_out,201) '      iterations: ', &
  2197)       constraint_coupler%num_iterations
  2198) 
  2199)     if (associated(reaction%species_idx)) then
  2200) !    output pH
  2201)       if (reaction%species_idx%h_ion_id > 0) then
  2202)         ph = &
  2203)           -log10(rt_auxvar%pri_molal(reaction%species_idx%h_ion_id)* &
  2204)                  rt_auxvar%pri_act_coef(reaction%species_idx%h_ion_id))
  2205)       else if (reaction%species_idx%h_ion_id < 0) then
  2206)         ph = &
  2207)           -log10(rt_auxvar%sec_molal(abs(reaction%species_idx%h_ion_id))* &
  2208)                  rt_auxvar%sec_act_coef(abs(reaction%species_idx%h_ion_id)))
  2209)       endif
  2210)       if (reaction%species_idx%h_ion_id > 0 .or. reaction%species_idx%h_ion_id < 0) &
  2211)       write(option%fid_out,203) '              pH: ',ph
  2212) 
  2213) !    output Eh and pe
  2214)       if (reaction%species_idx%o2_gas_id > 0 .and. (reaction%species_idx%h_ion_id > 0 &
  2215)           .or. reaction%species_idx%h_ion_id < 0)) then
  2216) 
  2217)         ifo2 = reaction%species_idx%o2_gas_id
  2218)       
  2219)       ! compute gas partial pressure
  2220)         lnQKgas(ifo2) = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
  2221)       
  2222)       ! activity of water
  2223)         if (reaction%eqgash2oid(ifo2) > 0) then
  2224)           lnQKgas(ifo2) = lnQKgas(ifo2) + reaction%eqgash2ostoich(ifo2)*rt_auxvar%ln_act_h2o
  2225)         endif
  2226)         do jcomp = 1, reaction%eqgasspecid(0,ifo2)
  2227)           comp_id = reaction%eqgasspecid(jcomp,ifo2)
  2228)           lnQKgas(ifo2) = lnQKgas(ifo2) + reaction%eqgasstoich(jcomp,ifo2)* &
  2229)                       log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
  2230)         enddo
  2231) 
  2232)         tk = global_auxvar%temp+273.15d0
  2233)         ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
  2234)         eh = ehfac*(-4.d0*ph+lnQKgas(ifo2)*LN_TO_LOG+logKeh(tk))/4.d0
  2235)         pe = eh/ehfac
  2236) 
  2237) !       pe = (-4.d0*ph+lnQKgas(ifo2)*LN_TO_LOG+logKeh(tk))/4.d0
  2238) !       eh = pe*ehfac
  2239)         write(option%fid_out,203) '              pe: ',pe
  2240)         write(option%fid_out,203) '              Eh: ',eh
  2241)       endif
  2242)     endif
  2243)     
  2244)     ionic_strength = 0.d0
  2245)     charge_balance = 0.d0
  2246)     do icomp = 1, reaction%naqcomp      
  2247)       charge_balance = charge_balance + rt_auxvar%total(icomp,1)* &
  2248)                                         reaction%primary_spec_Z(icomp)
  2249)       ionic_strength = ionic_strength + rt_auxvar%pri_molal(icomp)* &
  2250)         reaction%primary_spec_Z(icomp)*reaction%primary_spec_Z(icomp)
  2251)     enddo
  2252)     
  2253)     if (reaction%neqcplx > 0) then    
  2254)       do i = 1, reaction%neqcplx
  2255)         ionic_strength = ionic_strength + rt_auxvar%sec_molal(i)* &
  2256)                                           reaction%eqcplx_Z(i)* &
  2257)                                           reaction%eqcplx_Z(i)
  2258)       enddo
  2259)     endif
  2260)     ionic_strength = 0.5d0 * ionic_strength
  2261)     
  2262)     write(option%fid_out,'(a20,es12.4,a8)') '  ionic strength: ', &
  2263)       ionic_strength,' [mol/L]'
  2264)     write(option%fid_out,204) '  charge balance: ', charge_balance
  2265)     
  2266)     write(option%fid_out,'(a20,1pe12.4,a5)') '        pressure: ', &
  2267)       global_auxvar%pres(1),' [Pa]'
  2268)     write(option%fid_out,'(a20,f8.2,a4)') '     temperature: ', &
  2269)       global_auxvar%temp,' [C]'
  2270)     write(option%fid_out,'(a20,f8.2,a9)') '     density H2O: ', &
  2271)       global_auxvar%den_kg(1),' [kg/m^3]'
  2272)     write(option%fid_out,'(a20,1p2e12.4,a9)') 'ln / activity H2O: ', &
  2273)       rt_auxvar%ln_act_h2o,exp(rt_auxvar%ln_act_h2o),' [---]'
  2274)     write(option%fid_out,'(a20,1pe12.4,a9)') 'mole fraction H2O: ', &
  2275)       mole_fraction_h2o,' [---]'
  2276)     write(option%fid_out,'(a20,1pe12.4,a9)') 'mass fraction H2O: ', &
  2277)       mass_fraction_h2o,' [---]'
  2278) 
  2279)     ! CO2-specific
  2280)     if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
  2281)       if (global_auxvar%den_kg(2) > 0.d0) then
  2282)         write(option%fid_out,'(a20,f8.2,a9)') '     density CO2: ', &
  2283)           global_auxvar%den_kg(2),' [kg/m^3]'
  2284)         write(option%fid_out,'(a20,es12.4,a9)') '            xphi: ', &
  2285)           global_auxvar%fugacoeff(1)
  2286) 
  2287)         if (reaction%species_idx%co2_aq_id /= 0) then
  2288)           icomp = reaction%species_idx%co2_aq_id
  2289)           mass_fraction_co2 = reaction%primary_spec_molar_wt(icomp)*rt_auxvar%pri_molal(icomp)* &
  2290)             mass_fraction_h2o*1.d-3
  2291)           mole_fraction_co2 = rt_auxvar%pri_molal(icomp)*FMWH2O*mole_fraction_h2o*1.e-3
  2292)           write(option%fid_out,'(a20,es12.4,a9)') 'mole fraction CO2: ', &
  2293)             mole_fraction_co2
  2294)           write(option%fid_out,'(a20,es12.4,a9)') 'mass fraction CO2: ', &
  2295)             mass_fraction_co2
  2296)         endif
  2297)       endif
  2298)     endif
  2299)     ! end CO2-specific
  2300) 
  2301)     write(option%fid_out,90)
  2302) 
  2303)     102 format(/,'  primary               free        total')  
  2304)     103 format('  species               molal       molal       act coef     constraint')  
  2305)     write(option%fid_out,102)
  2306)     write(option%fid_out,103)
  2307)     write(option%fid_out,90)
  2308)   
  2309)     104 format(2x,a20,es12.4,es12.4,es12.4,4x,a)
  2310)     do icomp = 1, reaction%naqcomp
  2311)       select case(aq_species_constraint%constraint_type(icomp))
  2312)         case(CONSTRAINT_NULL,CONSTRAINT_TOTAL)
  2313)           string = 'total aq'
  2314)         case(CONSTRAINT_TOTAL_SORB)
  2315)           string = 'total sorb'
  2316)         case(CONSTRAINT_FREE)
  2317)           string = 'free'
  2318)         case(CONSTRAINT_CHARGE_BAL)
  2319)           string = 'chrg'
  2320)         case(CONSTRAINT_LOG)
  2321)           string = 'log'
  2322)         case(CONSTRAINT_PH)
  2323)           string = 'pH'
  2324)         case(CONSTRAINT_MINERAL,CONSTRAINT_GAS)
  2325)           string = aq_species_constraint%constraint_aux_string(icomp)
  2326)         case(CONSTRAINT_SUPERCRIT_CO2)
  2327)           string = 'SC ' // aq_species_constraint%constraint_aux_string(icomp)
  2328)       end select
  2329)       write(option%fid_out,104) reaction%primary_species_names(icomp), &
  2330)                                 rt_auxvar%pri_molal(icomp), &
  2331)                                 rt_auxvar%total(icomp,1)*molar_to_molal, &
  2332)                                 rt_auxvar%pri_act_coef(icomp), &
  2333)                                 trim(string)
  2334)     enddo 
  2335)   endif 
  2336)       
  2337)   if (reaction%neqcplx > 0) then    
  2338)     ! sort complex concentrations from largest to smallest
  2339)     do i = 1, reaction%neqcplx
  2340)       eqcplxsort(i) = i
  2341)     enddo
  2342)     do
  2343)       finished = PETSC_TRUE
  2344)       do i = 1, reaction%neqcplx-1
  2345)         icplx = eqcplxsort(i)
  2346)         icplx2 = eqcplxsort(i+1)
  2347)         if (rt_auxvar%sec_molal(icplx) < &
  2348)             rt_auxvar%sec_molal(icplx2)) then
  2349)           eqcplxsort(i) = icplx2
  2350)           eqcplxsort(i+1) = icplx
  2351)           finished = PETSC_FALSE
  2352)         endif
  2353)       enddo
  2354)       if (finished) exit
  2355)     enddo
  2356)             
  2357)     110 format(/,'  complex               molality    act coef        logK')  
  2358)     write(option%fid_out,110)
  2359)     write(option%fid_out,90)
  2360)     111 format(2x,a20,es12.4,es12.4,2x,es12.4)
  2361)     do i = 1, reaction%neqcplx ! for each secondary species
  2362)       icplx = eqcplxsort(i)
  2363)       write(option%fid_out,111) reaction%secondary_species_names(icplx), &
  2364)                                 rt_auxvar%sec_molal(icplx), &
  2365)                                 rt_auxvar%sec_act_coef(icplx), &
  2366)                                 reaction%eqcplx_logK(icplx)
  2367)     enddo 
  2368) 
  2369)     !print speciation precentages
  2370)     write(option%fid_out,92)
  2371)     92 format(/)
  2372)     134 format(2x,'complex species       percent   molality')
  2373)     135 format(2x,'primary species: ',a20,2x,' total conc: ',1pe12.4)
  2374)     136 format(2x,a20,2x,f6.2,2x,1pe12.4,1p2e12.4)
  2375)     do icomp = 1, reaction%naqcomp
  2376)     
  2377)       eqcplxsort = 0
  2378)       eqcplxid = 0
  2379)       percent = 0.d0
  2380)       totj = 0.d0
  2381)       
  2382)       icount = 0
  2383)       do icplx = 1, reaction%neqcplx
  2384)         found = PETSC_FALSE
  2385)         do i = 1, reaction%eqcplxspecid(0,icplx)
  2386)           if (reaction%eqcplxspecid(i,icplx) == icomp) then
  2387)             icount = icount + 1
  2388)             found = PETSC_TRUE
  2389)             exit
  2390)           endif
  2391)         enddo
  2392)         if (found) then
  2393)           eqcplxid(icount) = icplx
  2394)           percent(icount) = dabs(rt_auxvar%sec_molal(icplx)* &
  2395)                                  reaction%eqcplxstoich(i,icplx))
  2396)           totj = totj + percent(icount)
  2397)         endif
  2398)       enddo
  2399)       icount = icount + 1
  2400)       eqcplxid(icount) = -icomp
  2401)       percent(icount) = rt_auxvar%pri_molal(icomp)
  2402)       totj = totj + percent(icount)
  2403)       percent = percent / totj
  2404)       
  2405)       eqcplxsort = 0
  2406)       do i = 1, icount
  2407)         eqcplxsort(i) = i
  2408)       enddo
  2409)       
  2410)       do
  2411)         finished = PETSC_TRUE
  2412)         do i = 1, icount-1
  2413)           icplx = eqcplxsort(i)
  2414)           icplx2 = eqcplxsort(i+1)
  2415)           if (percent(abs(icplx)) < percent(abs(icplx2))) then
  2416)             eqcplxsort(i) = icplx2
  2417)             eqcplxsort(i+1) = icplx
  2418)             finished = PETSC_FALSE
  2419)           endif
  2420)         enddo
  2421)         if (finished) exit
  2422)       enddo
  2423) 
  2424)       write(option%fid_out,90)
  2425)       write(option%fid_out,135) reaction%primary_species_names(icomp), &
  2426)                                 rt_auxvar%total(icomp,iphase)
  2427)       write(option%fid_out,134)
  2428)       write(option%fid_out,90)
  2429)       do i = 1, icount
  2430)         j = eqcplxsort(i)
  2431)         if (percent(j) < 0.0001d0) cycle
  2432)         icplx = eqcplxid(j)
  2433)         if (icplx < 0) then
  2434)           icplx = abs(icplx)
  2435)           write(option%fid_out,136) reaction%primary_species_names(icplx), &
  2436)                                     percent(j)*100.d0, &
  2437)                                     rt_auxvar%pri_molal(icplx)
  2438)         else
  2439)           write(option%fid_out,136) reaction%secondary_species_names(icplx), &
  2440)                                     percent(j)*100.d0, &
  2441)                                     rt_auxvar%sec_molal(icplx)
  2442)         endif
  2443)       enddo
  2444)     enddo
  2445) 
  2446)   endif 
  2447)           
  2448)   if (surface_complexation%nsrfcplxrxn > 0 .and. &
  2449)       surface_complexation%neqsrfcplxrxn /= &
  2450)       surface_complexation%nsrfcplxrxn) then
  2451)     string = 'WARNING: Only equilibrium surface complexes are printed to ' // &
  2452)              'this file!'
  2453)     write(option%fid_out,'(/,2x,a,/)') trim(string)
  2454)   endif
  2455) 
  2456)   if (surface_complexation%neqsrfcplxrxn > 0) then
  2457)     ! sort surface complex concentrations from largest to smallest
  2458)     ! note that we include free site concentrations; their ids negated
  2459)     allocate(eqsrfcplxsort(surface_complexation%neqsrfcplx + &
  2460)                            surface_complexation%neqsrfcplxrxn))
  2461)     do i = 1, surface_complexation%neqsrfcplx
  2462)       eqsrfcplxsort(i) = i
  2463)     enddo
  2464)     do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
  2465)       irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
  2466)       eqsrfcplxsort(surface_complexation%neqsrfcplx+ieqrxn) = -irxn
  2467)     enddo
  2468)     do
  2469)       finished = PETSC_TRUE
  2470)       do i = 1, size(eqsrfcplxsort)-1
  2471)         icplx = eqsrfcplxsort(i)
  2472)         icplx2 = eqsrfcplxsort(i+1)
  2473)         if (icplx > 0) then
  2474)           conc = rt_auxvar%eqsrfcplx_conc(icplx)
  2475)         else
  2476)           conc = rt_auxvar%srfcplxrxn_free_site_conc(-icplx)
  2477)         endif
  2478)         if (icplx2 > 0) then
  2479)           conc2 = rt_auxvar%eqsrfcplx_conc(icplx2)
  2480)         else
  2481)           conc2 = rt_auxvar%srfcplxrxn_free_site_conc(-icplx2)
  2482)         endif
  2483)         if (conc < conc2) then
  2484)           eqsrfcplxsort(i) = icplx2
  2485)           eqsrfcplxsort(i+1) = icplx
  2486)           finished = PETSC_FALSE
  2487)         endif
  2488)       enddo
  2489)       if (finished) exit
  2490)     enddo
  2491)             
  2492)     write(option%fid_out, &
  2493)     '(//,''  NOTE: Only equilibrium surface complexation is considered below'')')
  2494)     write(option%fid_out,120)
  2495)     write(option%fid_out,90)
  2496)     do i = 1, size(eqsrfcplxsort)
  2497)       icplx = eqsrfcplxsort(i)
  2498)       if (icplx > 0) then
  2499)         write(option%fid_out,121) surface_complexation%srfcplx_names(icplx), &
  2500)                                   rt_auxvar%eqsrfcplx_conc(icplx), &
  2501)                                   surface_complexation%srfcplx_logK(icplx)
  2502)       else
  2503)         write(option%fid_out,122) surface_complexation%srfcplxrxn_site_names(-icplx), &
  2504)                                   rt_auxvar%srfcplxrxn_free_site_conc(-icplx)
  2505)       endif
  2506)     enddo
  2507)     deallocate(eqsrfcplxsort)
  2508) 
  2509)     120 format(/,'  surf complex          mol/m^3 blk logK')  
  2510)     121 format(2x,a20,es12.4,es12.4)
  2511)     122 format(2x,a20,es12.4,'  free site')
  2512) 
  2513) #if 0    
  2514)     write(option%fid_out,120)
  2515)     write(option%fid_out,90)
  2516)     do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
  2517)       irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
  2518)       write(option%fid_out,122) surface_complexation%srfcplxrxn_site_names(irxn), &
  2519)                                 rt_auxvar%srfcplxrxn_free_site_conc(irxn)
  2520)       ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
  2521)       do i = 1, ncplx
  2522)         icplx = surface_complexation%srfcplxrxn_to_complex(i,irxn)
  2523)         write(option%fid_out,121) surface_complexation%srfcplx_names(icplx), &
  2524)                                   rt_auxvar%eqsrfcplx_conc(icplx), &
  2525)                                   surface_complexation%srfcplx_logK(icplx)
  2526)       enddo
  2527)     enddo
  2528) #endif    
  2529) 
  2530)   ! retardation
  2531)     if (surface_complexation%neqsrfcplxrxn > 0) then
  2532)       write(option%fid_out,123)
  2533)       write(option%fid_out,90)
  2534)       do j = 1, reaction%naqcomp
  2535)         retardation = 1.d0
  2536)         do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
  2537)           irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
  2538)           ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
  2539)           do i = 1, ncplx
  2540)             icplx = surface_complexation%srfcplxrxn_to_complex(i,irxn)
  2541)             ncomp = surface_complexation%srfcplxspecid(0,icplx)
  2542)             do jj = 1, ncomp
  2543)               jcomp = surface_complexation%srfcplxspecid(jj,icplx)
  2544)               if (j == jcomp) then
  2545)                 if (rt_auxvar%total(j,iphase) /= 0.d0) &
  2546)                 retardation = retardation + &
  2547)                               surface_complexation%srfcplxstoich(jj,icplx)* &
  2548)                               rt_auxvar%eqsrfcplx_conc(icplx)/ &
  2549)                               bulk_vol_to_fluid_vol/ &
  2550)                               rt_auxvar%total(j,iphase)
  2551)                 exit
  2552)               endif
  2553)             enddo
  2554)           enddo
  2555)         enddo
  2556)         write(option%fid_out,124) reaction%primary_species_names(j),retardation
  2557)       enddo
  2558)       123 format(/,'  primary species  retardation')  
  2559)       124 format(2x,a12,4x,1pe12.4)
  2560) 
  2561) #ifdef DOUBLE_LAYER
  2562)       call ReactionDoubleLayer (constraint_coupler,reaction,option)
  2563) #endif
  2564) 
  2565)     endif
  2566)   
  2567)   endif ! surface_complexation%nsrfcplxrxn > 0
  2568) 
  2569)   ! Ion Exchange
  2570)   if (reaction%neqionxrxn > 0) then
  2571)     write(option%fid_out,125)
  2572)     do irxn = 1, reaction%neqionxrxn
  2573)       write(option%fid_out,90)
  2574)       write(option%fid_out,126) reaction%eqionx_rxn_CEC(irxn)
  2575)       write(option%fid_out,127)
  2576)       write(option%fid_out,90)
  2577)       ncomp = reaction%eqionx_rxn_cationid(0,irxn)
  2578)       do i = 1, ncomp
  2579)         icomp = reaction%eqionx_rxn_cationid(i,irxn)
  2580)         kd = rt_auxvar%eqionx_conc(i,irxn)/rt_auxvar%total(icomp,iphase) & 
  2581)                       /bulk_vol_to_fluid_vol
  2582)         write(option%fid_out,128) reaction%primary_species_names(icomp), &
  2583)           reaction%eqionx_rxn_k(i,irxn), & 
  2584)           rt_auxvar%eqionx_conc(i,irxn), &
  2585)           kd
  2586)       enddo
  2587)     enddo
  2588)     125 format(/,2x,'ion-exchange reactions')
  2589)     126 format(2x,'CEC = ',1pe12.4)
  2590)     127 format(2x,'cation    selectivity coef.   sorbed conc.     Kd',&
  2591)                /,30x,'[mol/m^3]')
  2592)     128 format(2x,a8,2x,1pe12.4,4x,1pe12.4,4x,1pe12.4,4x,1pe12.4)
  2593)   endif
  2594)   
  2595) ! total retardation from ion exchange and equilibrium surface complexation
  2596)   if (reaction%neqsorb > 0) then
  2597)     write(option%fid_out,1128)
  2598)     write(option%fid_out,90)
  2599)     do jcomp = 1, reaction%naqcomp
  2600)       if (abs(rt_auxvar%total(jcomp,iphase)) > 0.d0) &
  2601)       retardation = 1.d0 + rt_auxvar%total_sorb_eq(jcomp)/bulk_vol_to_fluid_vol &
  2602)         /rt_auxvar%total(jcomp,iphase)
  2603)       totj = rt_auxvar%total(jcomp,iphase)+rt_auxvar%total_sorb_eq(jcomp)/bulk_vol_to_fluid_vol
  2604)       write(option%fid_out,129) reaction%primary_species_names(jcomp), &
  2605)         totj,retardation
  2606)     enddo
  2607)    1128 format(/,2x,'primary species     total(aq+sorbed)    total retardation', &
  2608)                /,25x,'[mol/L]',15x,'1+Kd')
  2609)     129 format(2x,a12,8x,1pe12.4,8x,1pe12.4)
  2610)   endif
  2611)   
  2612)   if (mineral_reaction%nmnrl > 0) then
  2613)   
  2614)     130 format(/,'  mineral                             log SI       Affinity     log K', &
  2615)            /,51x,'[kJ/mol]')
  2616)     131 format(2x,a30,2x,2f12.4,2x,1pe12.4)
  2617) 
  2618)     do imnrl = 1, mineral_reaction%nmnrl
  2619)       ! compute saturation
  2620)       lnQK(imnrl) = -mineral_reaction%mnrl_logK(imnrl)*LOG_TO_LN
  2621)       if (mineral_reaction%mnrlh2oid(imnrl) > 0) then
  2622)         lnQK(imnrl) = lnQK(imnrl) + mineral_reaction%mnrlh2ostoich(imnrl)*rt_auxvar%ln_act_h2o
  2623)       endif
  2624)       do jcomp = 1, mineral_reaction%mnrlspecid(0,imnrl)
  2625)         comp_id = mineral_reaction%mnrlspecid(jcomp,imnrl)
  2626)         lnQK(imnrl) = lnQK(imnrl) + mineral_reaction%mnrlstoich(jcomp,imnrl)* &
  2627)                       log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
  2628)       enddo
  2629)       QK(imnrl) = exp(lnQK(imnrl))    
  2630)     enddo
  2631) 
  2632)     ! sort mineral saturation indices from largest to smallest
  2633)     do i = 1, mineral_reaction%nmnrl
  2634)       eqminsort(i) = i
  2635)     enddo
  2636)     do
  2637)       finished = PETSC_TRUE
  2638)       do i = 1, mineral_reaction%nmnrl-1
  2639)         icplx = eqminsort(i)
  2640)         icplx2 = eqminsort(i+1)
  2641)         if (QK(icplx) < QK(icplx2)) then
  2642)           eqminsort(i) = icplx2
  2643)           eqminsort(i+1) = icplx
  2644)           finished = PETSC_FALSE
  2645)         endif
  2646)       enddo
  2647)       if (finished) exit
  2648)     enddo
  2649) 
  2650)     write(option%fid_out,130)
  2651)     write(option%fid_out,90)
  2652)   
  2653)     do imnrl = 1, mineral_reaction%nmnrl
  2654)       i = eqminsort(imnrl)
  2655)       affinity = -1.d0*IDEAL_GAS_CONSTANT*(global_auxvar%temp+273.15d0)*lnQK(i)
  2656)       write(option%fid_out,131) mineral_reaction%mineral_names(i), &
  2657)                                 lnQK(i)*LN_TO_LOG, affinity, &
  2658)                                 mineral_reaction%mnrl_logK(i)
  2659)     enddo
  2660)   endif
  2661)     
  2662)   if (reaction%ngas > 0) then
  2663)     
  2664)     132 format(/,'  gas        log part. press.  part. press. [bars]      log K')
  2665)     133 format(2x,a10,2x,1pe12.4,6x,1pe12.4,8x,1pe12.4)
  2666)     
  2667)     write(option%fid_out,132)
  2668)     write(option%fid_out,90)
  2669)     
  2670)     do igas = 1, reaction%ngas
  2671)       
  2672)       ! compute gas partial pressure
  2673)       lnQKgas(igas) = -reaction%eqgas_logK(igas)*LOG_TO_LN
  2674)       
  2675)       ! divide K by RT
  2676)       !lnQKgas = lnQKgas - log((auxvar%temp+273.15d0)*IDEAL_GAS_CONSTANT)
  2677)       
  2678)       ! activity of water
  2679)       if (reaction%eqgash2oid(igas) > 0) then
  2680)         lnQKgas(igas) = lnQKgas(igas) + reaction%eqgash2ostoich(igas)*rt_auxvar%ln_act_h2o
  2681)       endif
  2682) 
  2683)       do jcomp = 1, reaction%eqgasspecid(0,igas)
  2684)         comp_id = reaction%eqgasspecid(jcomp,igas)
  2685)         lnQKgas(igas) = lnQKgas(igas) + reaction%eqgasstoich(jcomp,igas)* &
  2686)                       log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
  2687)       enddo
  2688)       
  2689)       QKgas(igas) = exp(lnQKgas(igas))
  2690)           
  2691)       write(option%fid_out,133) reaction%gas_species_names(igas),lnQKgas(igas)*LN_TO_LOG, &
  2692)       QKgas(igas),reaction%eqgas_logK(igas)
  2693)     enddo
  2694)   endif
  2695) 
  2696) #ifdef AMANZI_BGD
  2697)   ! output constraints for amanzi cfg formatted input
  2698)   if (OptionPrintToFile(option)) then
  2699)     string = trim(option%global_prefix) // '-' // &
  2700)              trim(constraint_coupler%constraint_name) // '.txt'
  2701)     open(unit=86,file=trim(string))
  2702) 
  2703)     write(86,'("# pflotran constraint preprocessing :")')
  2704)     !call date_and_time(date=word,time=word2)
  2705)     ! prints garbage? need to clear memory?
  2706)     !write(86,'("#        date : ",a,"   ",a)') trim(word), trim(word2)
  2707)     write(86,'("#       input : ",a)') trim(option%input_filename)
  2708)     write(86,'(/,"# Constraint: ",a)') &
  2709)          trim(constraint_coupler%constraint_name)
  2710) 
  2711)     write(86,'(/,"[total]")')
  2712)     do icomp = 1, reaction%naqcomp
  2713)       write(86,'(a," = ",1es13.6)') trim(reaction%primary_species_names(icomp)), &
  2714)                                 rt_auxvar%pri_molal(icomp)
  2715)     enddo
  2716) 
  2717)     write(86,'(/,"[free_ion]")')
  2718)     do icomp = 1, reaction%naqcomp
  2719)       write(86,'(a," = ",1es13.6)') trim(reaction%primary_species_names(icomp)), &
  2720)                                 rt_auxvar%total(icomp,1)*molar_to_molal
  2721)     enddo
  2722) 
  2723)     write(86,'(/,"[minerals]")')
  2724)     do imnrl = 1, mineral_reaction%nkinmnrl
  2725)       write(86,'(a," = ",f6.3)') trim(mineral_reaction%kinmnrl_names(imnrl)), &
  2726)                                 mineral_reaction%mnrl_volfrac(imnrl)
  2727)     enddo
  2728) 
  2729)     if (associated(rt_auxvar%total_sorb_eq)) then
  2730)       write(86,'(/,"[total_sorbed]")')
  2731)       do icomp = 1, reaction%naqcomp
  2732)         write(86,'(a," = ",1es13.6)') trim(reaction%primary_species_names(icomp)), &
  2733)                                   rt_auxvar%total_sorb_eq(icomp)
  2734)       enddo
  2735)     endif
  2736) 
  2737)     write(86,'(/,"[ion_exchange]")')
  2738)     do icomp = 1, reaction%neqionxrxn
  2739)       write(86, '("X- = ",1es13.6)') reaction%eqionx_rxn_CEC(icomp)
  2740)     enddo
  2741)     close(86)
  2742)   endif
  2743) #endif
  2744) ! end AMANZI_BGD
  2745) 
  2746) end subroutine ReactionPrintConstraint
  2747) 
  2748) ! ************************************************************************** !
  2749) 
  2750) subroutine ReactionDoubleLayer(constraint_coupler,reaction,option)
  2751)   ! 
  2752)   ! Calculates double layer potential, surface charge, and
  2753)   ! sorbed surface complex concentrations
  2754)   ! 
  2755)   ! Author: Peter C. Lichtner
  2756)   ! Date: ???
  2757)   ! 
  2758) 
  2759)   use Option_module
  2760)   use Input_Aux_module
  2761)   use String_module
  2762)   use Transport_Constraint_module
  2763) 
  2764)   implicit none
  2765)   
  2766)   type(option_type) :: option
  2767)   type(tran_constraint_coupler_type) :: constraint_coupler
  2768)   type(reaction_type), pointer :: reaction
  2769) 
  2770)   type(reactive_transport_auxvar_type), pointer :: rt_auxvar
  2771)   type(global_auxvar_type), pointer :: global_auxvar
  2772)   type(aq_species_constraint_type), pointer :: aq_species_constraint
  2773)   type(mineral_constraint_type), pointer :: mineral_constraint
  2774)   type(surface_complexation_type), pointer :: surface_complexation
  2775)   type(mineral_type), pointer :: mineral_reaction
  2776) 
  2777)   PetscReal, parameter :: tk = 273.15d0
  2778)   PetscReal, parameter :: epsilon = 78.5d0
  2779)   PetscReal, parameter :: epsilon0 = 8.854187817d-12
  2780)   PetscReal, parameter :: faraday = 96485.d0
  2781)   
  2782)   PetscReal :: fac, boltzmann, dbl_charge, surface_charge, ionic_strength, &
  2783)                charge_balance, potential, tempk, debye_length, &
  2784)                srfchrg_capacitance_model, capacitance
  2785)                
  2786)   PetscReal :: ln_conc(reaction%naqcomp)
  2787)   PetscReal :: ln_act(reaction%naqcomp)
  2788)   PetscReal :: srfcplx_conc(reaction%surface_complexation%neqsrfcplx)
  2789) 
  2790)   PetscReal :: free_site_conc
  2791)   PetscReal :: ln_free_site
  2792)   PetscReal :: lnQK, tempreal, tempreal1, tempreal2, total
  2793) 
  2794)   PetscInt :: iphase
  2795)   PetscInt :: i, j, icomp, icplx, irxn, ncomp, ncplx
  2796) 
  2797)   PetscReal :: site_density(2)
  2798)   PetscReal :: mobile_fraction
  2799)   PetscInt :: num_types_of_sites
  2800)   PetscInt :: isite
  2801) 
  2802)   PetscBool :: one_more
  2803) 
  2804) #if 1
  2805)     surface_complexation => reaction%surface_complexation
  2806)     rt_auxvar => constraint_coupler%rt_auxvar
  2807)     global_auxvar => constraint_coupler%global_auxvar
  2808) 
  2809)     iphase = 1
  2810)     global_auxvar%temp = option%reference_temperature
  2811)     tempk = tk + global_auxvar%temp
  2812)     
  2813)     potential = 0.1d0 ! initial guess
  2814)     boltzmann = exp(-faraday*potential/(IDEAL_GAS_CONSTANT*tempk))
  2815)         
  2816)     fac = sqrt(epsilon*epsilon0*IDEAL_GAS_CONSTANT*tempk)
  2817) 
  2818)     ionic_strength = 0.d0
  2819)     charge_balance = 0.d0
  2820)     dbl_charge = 0.d0
  2821)     do icomp = 1, reaction%naqcomp      
  2822)       charge_balance = charge_balance + reaction%primary_spec_Z(icomp)* &
  2823)                        rt_auxvar%total(icomp,1)
  2824)                                         
  2825)       ionic_strength = ionic_strength + reaction%primary_spec_Z(icomp)**2* &
  2826)                        rt_auxvar%pri_molal(icomp)
  2827)       dbl_charge = dbl_charge + rt_auxvar%pri_molal(icomp)* &
  2828)                    (boltzmann**reaction%primary_spec_Z(icomp) - 1.d0)
  2829)     enddo
  2830) 
  2831)     if (reaction%neqcplx > 0) then    
  2832)       do i = 1, reaction%neqcplx
  2833)         ionic_strength = ionic_strength + reaction%eqcplx_Z(i)**2* &
  2834)                          rt_auxvar%sec_molal(i)
  2835)         dbl_charge = dbl_charge + rt_auxvar%sec_molal(i)* &
  2836)                      (boltzmann**reaction%eqcplx_Z(i) - 1.d0)
  2837)       enddo
  2838)     endif
  2839)     ionic_strength = 0.5d0*ionic_strength
  2840)     if (dbl_charge > 0.d0) then
  2841)       dbl_charge = fac*sqrt(2.d0*dbl_charge)
  2842)     else
  2843)       print *,'neg. dbl_charge: ',dbl_charge
  2844)       dbl_charge = fac*sqrt(2.d0*(-dbl_charge))
  2845)     endif
  2846) 
  2847)     srfchrg_capacitance_model = faraday* &
  2848)       sqrt(2.d0*epsilon*epsilon0*ionic_strength*1.d3/(IDEAL_GAS_CONSTANT*tempk))
  2849) 
  2850)     surface_charge = 0.d0
  2851)     do irxn = 1, surface_complexation%neqsrfcplxrxn
  2852)       ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
  2853)       do i = 1, ncplx
  2854)         icplx = surface_complexation%srfcplxrxn_to_complex(i,irxn)
  2855)         surface_charge = surface_charge + surface_complexation%srfcplx_Z(icplx)* &
  2856)                          rt_auxvar%eqsrfcplx_conc(icplx)
  2857)       enddo
  2858)     enddo
  2859)     surface_charge = faraday*surface_charge
  2860) 
  2861)     debye_length = sqrt(fac/(2.d0*ionic_strength*1.d3))/faraday
  2862)     capacitance = sqrt(2.d0*epsilon*epsilon0*ionic_strength*1.d3/ &
  2863)                     (IDEAL_GAS_CONSTANT*tempk)) * faraday
  2864)     
  2865)     print *,'========================='
  2866)     print *,'dbl: debye_length = ',debye_length
  2867)     print *,'surface charge = ',dbl_charge,surface_charge, &
  2868)       srfchrg_capacitance_model
  2869)     print *,'ionic strength = ',ionic_strength
  2870)     print *,'chrg bal. = ',charge_balance,' Tk = ',tempk,' Boltz. = ',boltzmann
  2871)     print *,'srfcmplx: ',rt_auxvar%eqsrfcplx_conc
  2872)     print *,'capacitance: ',capacitance
  2873)     print *,'========================='
  2874) 
  2875) !   compute surface complex concentrations  
  2876)     ln_conc = log(rt_auxvar%pri_molal)
  2877)     ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
  2878) 
  2879)   do irxn = 1, surface_complexation%neqsrfcplxrxn
  2880)   
  2881)     ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
  2882)     
  2883)     free_site_conc = rt_auxvar%srfcplxrxn_free_site_conc( &
  2884)                        surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(irxn))
  2885) 
  2886)     site_density(1) = surface_complexation%srfcplxrxn_site_density(irxn)
  2887)     num_types_of_sites = 1
  2888)     
  2889)     do isite = 1, num_types_of_sites
  2890)       ! isite == 1 - immobile (colloids, minerals, etc.)
  2891)       ! isite == 2 - mobile (colloids)
  2892)     
  2893)       if (site_density(isite) < 1.d-40) cycle
  2894)     
  2895)       ! get a pointer to the first complex (there will always be at least 1)
  2896)       ! in order to grab free site conc
  2897)       one_more = PETSC_FALSE
  2898)       do
  2899)         total = free_site_conc
  2900)         ln_free_site = log(free_site_conc)
  2901)         
  2902) !       call srfcmplx(irxn,icplx,lnQK,reaction%eqsrfcplx_logK,reaction%eqsrfcplx_Z,potential, &
  2903) !               tempk,ln_act,rt_auxvar%ln_act_h2o,ln_free_site,srfcplx_conc)
  2904) 
  2905) #if 0
  2906)         do j = 1, ncplx
  2907)           icplx = surface_complexation%srfcplxrxn_to_complex(j,irxn)
  2908)           
  2909)           ! compute ion activity product
  2910)           lnQK = -reaction%eqsrfcplx_logK(icplx)*LOG_TO_LN &
  2911)                  + reaction%eqsrfcplx_Z(icplx)*faraday*potential &
  2912)                  /(IDEAL_GAS_CONSTANT*tempk)/LOG_TO_LN
  2913) 
  2914)           ! activity of water
  2915)           if (surface_complexation%eqsrfcplxh2oid(icplx) > 0) then
  2916)             lnQK = lnQK + surface_complexation%eqsrfcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
  2917)           endif
  2918) 
  2919)           lnQK = lnQK + surface_complexation%eqsrfcplx_free_site_stoich(icplx)* &
  2920)                         ln_free_site
  2921)         
  2922)           ncomp = surface_complexation%srfcplxspecid(0,icplx)
  2923)           do i = 1, ncomp
  2924)             icomp = surface_complexation%srfcplxspecid(i,icplx)
  2925)             lnQK = lnQK + surface_complexation%eqsrfcplxstoich(i,icplx)*ln_act(icomp)
  2926)           enddo
  2927)           srfcplx_conc(icplx) = exp(lnQK)
  2928)           
  2929)           total = total + surface_complexation%eqsrfcplx_free_site_stoich(icplx)*srfcplx_conc(icplx)
  2930)           
  2931)         enddo
  2932) #endif
  2933)         if (one_more) exit
  2934)         
  2935)         total = total / free_site_conc
  2936)         free_site_conc = site_density(isite) / total  
  2937)           
  2938)         one_more = PETSC_TRUE 
  2939) 
  2940)       enddo ! generic do
  2941)     enddo
  2942)   enddo
  2943) #endif  
  2944)   print *,'exit srfcmplx1: ',srfcplx_conc
  2945) 
  2946) end subroutine ReactionDoubleLayer
  2947) 
  2948) #if 0
  2949) 
  2950) ! ************************************************************************** !
  2951) 
  2952) subroutine srfcmplx(irxn,icplx,lnQK,logK,Z,potential,tempk, &
  2953)                 ln_act,ln_act_h2o,ln_free_site,srfcplx_conc)
  2954) 
  2955) implicit none
  2956) 
  2957)   PetscReal, parameter :: tk = 273.15d0
  2958)   PetscReal, parameter :: faraday = 96485.d0
  2959)   
  2960)   PetscReal :: fac, boltzmann, dbl_charge, surface_charge, ionic_strength, &
  2961)                charge_balance, potential, tempk, debye_length, &
  2962)                srfchrg_capacitance_model
  2963)                
  2964)   PetscReal :: ln_conc(reaction%naqcomp)
  2965)   PetscReal :: ln_act(reaction%naqcomp)
  2966)   PetscReal :: srfcplx_conc(reaction%neqsrfcplx)
  2967) 
  2968)   PetscReal :: free_site_conc
  2969)   PetscReal :: ln_free_site, ln_act_h2o
  2970)   PetscReal :: lnQK, tempreal, tempreal1, tempreal2, total
  2971) 
  2972)   PetscInt :: i, j, icomp, icplx, irxn, ncomp, ncplx
  2973) 
  2974)         do j = 1, ncplx
  2975)           icplx = reaction%srfcplxrxn_to_complex(j,irxn)
  2976)           ! compute secondary species concentration
  2977)           lnQK = -logK(icplx)*LOG_TO_LN &
  2978)                  + Z(icplx)*faraday*potential &
  2979)                  /(IDEAL_GAS_CONSTANT*tempk)/LOG_TO_LN
  2980) 
  2981)           ! activity of water
  2982)           if (reaction%eqsrfcplxh2oid(icplx) > 0) then
  2983)             lnQK = lnQK + reaction%eqsrfcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
  2984)           endif
  2985) 
  2986)           lnQK = lnQK + reaction%eqsrfcplx_free_site_stoich(icplx)* &
  2987)                         ln_free_site
  2988)         
  2989)           ncomp = reaction%srfcplxspecid(0,icplx)
  2990)           do i = 1, ncomp
  2991)             icomp = reaction%srfcplxspecid(i,icplx)
  2992)             lnQK = lnQK + reaction%eqsrfcplxstoich(i,icplx)*ln_act(icomp)
  2993)           enddo
  2994)           srfcplx_conc(icplx) = exp(lnQK)
  2995)         enddo
  2996) end subroutine srfcmplx
  2997) #endif
  2998) 
  2999) ! ************************************************************************** !
  3000) 
  3001) subroutine ReactionReadOutput(reaction,input,option)
  3002)   ! 
  3003)   ! Reads species to be printed in output
  3004)   ! 
  3005)   ! Author: Glenn Hammond
  3006)   ! Date: 01/24/09
  3007)   ! 
  3008) 
  3009)   use Input_Aux_module
  3010)   use String_module  
  3011)   use Option_module
  3012)   use Variables_module, only : PRIMARY_MOLALITY, PRIMARY_MOLARITY, &
  3013)                                TOTAL_MOLALITY, TOTAL_MOLARITY  
  3014)   implicit none
  3015)   
  3016)   type(reaction_type) :: reaction
  3017)   type(input_type), pointer :: input
  3018)   type(option_type) :: option
  3019)   
  3020)   character(len=MAXSTRINGLENGTH) :: string
  3021)   character(len=MAXWORDLENGTH) :: word
  3022)   character(len=MAXWORDLENGTH) :: name
  3023)   PetscBool :: found
  3024)   PetscInt :: temp_int
  3025) 
  3026)   type(aq_species_type), pointer :: cur_aq_spec
  3027)   type(gas_species_type), pointer :: cur_gas_spec
  3028)   type(mineral_rxn_type), pointer :: cur_mineral
  3029)   type(immobile_species_type), pointer :: cur_immobile
  3030)   type(surface_complex_type), pointer :: cur_srfcplx
  3031)   type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
  3032)   
  3033)   nullify(cur_aq_spec)
  3034)   nullify(cur_gas_spec)
  3035)   nullify(cur_mineral)
  3036)   nullify(cur_srfcplx)
  3037)   nullify(cur_srfcplx_rxn)
  3038)   
  3039)   input%ierr = 0
  3040)   do
  3041)   
  3042)     call InputReadPflotranString(input,option)
  3043)     if (InputError(input)) exit
  3044)     if (InputCheckExit(input,option)) exit
  3045) 
  3046)     call InputReadWord(input,option,name,PETSC_TRUE)  
  3047)     call InputErrorMsg(input,option,'keyword','CHEMISTRY,OUTPUT,SPECIES_NAME')
  3048)     
  3049)     word = name
  3050)     call StringToUpper(word)
  3051)     select case(word)
  3052)       case('OFF')
  3053)         reaction%print_all_species = PETSC_FALSE
  3054)         reaction%print_all_primary_species = PETSC_FALSE
  3055)         reaction%print_all_secondary_species = PETSC_FALSE
  3056)         reaction%print_all_gas_species = PETSC_FALSE
  3057)         reaction%mineral%print_all = PETSC_FALSE
  3058)         reaction%print_pH = PETSC_FALSE
  3059)         reaction%print_Eh = PETSC_FALSE
  3060)         reaction%print_pe = PETSC_FALSE
  3061)         reaction%print_O2 = PETSC_FALSE
  3062)         reaction%print_kd = PETSC_FALSE
  3063)         reaction%print_total_sorb = PETSC_FALSE
  3064)         reaction%print_total_sorb_mobile = PETSC_FALSE
  3065)         reaction%print_colloid = PETSC_FALSE
  3066)         reaction%print_act_coefs = PETSC_FALSE
  3067)         reaction%print_total_component = PETSC_FALSE
  3068)         reaction%print_free_ion = PETSC_FALSE
  3069)       case('ALL')
  3070)         reaction%print_all_species = PETSC_TRUE
  3071)         reaction%print_all_primary_species = PETSC_TRUE
  3072)  !       reaction%print_all_secondary_species = PETSC_TRUE
  3073)  !       reaction%print_all_gas_species = PETSC_TRUE
  3074)         reaction%mineral%print_all = PETSC_TRUE
  3075)         reaction%immobile%print_all = PETSC_TRUE
  3076) !        reaction%print_pH = PETSC_TRUE
  3077)       case('PRIMARY_SPECIES')
  3078)         reaction%print_all_primary_species = PETSC_TRUE
  3079)         reaction%print_pH = PETSC_TRUE
  3080)       case('SECONDARY_SPECIES')
  3081)         reaction%print_all_secondary_species = PETSC_TRUE
  3082)       case('GASES')
  3083)         reaction%print_all_gas_species = PETSC_TRUE
  3084)       case('MINERALS')
  3085)         reaction%mineral%print_all = PETSC_TRUE
  3086)       case('MINERAL_SATURATION_INDEX')
  3087)         reaction%mineral%print_saturation_index = PETSC_TRUE
  3088)       case('IMMOBILE')
  3089)         reaction%immobile%print_all = PETSC_TRUE
  3090)       case('PH')
  3091)         reaction%print_pH = PETSC_TRUE
  3092)       case('EH')
  3093)         reaction%print_Eh = PETSC_TRUE
  3094)       case('PE')
  3095)         reaction%print_pe = PETSC_TRUE
  3096)       case('O2')
  3097)         reaction%print_O2 = PETSC_TRUE
  3098)       case('KD')
  3099)         reaction%print_kd = PETSC_TRUE
  3100)       case('COLLOIDS')
  3101)         reaction%print_colloid = PETSC_TRUE
  3102)       case('TOTAL')
  3103)         reaction%print_total_component = PETSC_TRUE
  3104)       case('TOTAL_SORBED')
  3105)         reaction%print_total_sorb = PETSC_TRUE
  3106)       case('TOTAL_BULK')
  3107)         reaction%print_total_bulk = PETSC_TRUE
  3108)       case('TOTAL_SORBED_MOBILE')
  3109)         reaction%print_total_sorb_mobile = PETSC_TRUE
  3110)       case('FREE_ION')
  3111)         reaction%print_free_ion = PETSC_TRUE
  3112)       case('ACTIVITY_COEFFICIENTS')
  3113)         reaction%print_act_coefs = PETSC_TRUE
  3114)       case('MOLARITY')
  3115)         reaction%print_free_conc_type = PRIMARY_MOLARITY
  3116)         reaction%print_tot_conc_type = TOTAL_MOLARITY
  3117)       case('MOLALITY')
  3118)         reaction%print_free_conc_type = PRIMARY_MOLALITY
  3119)         reaction%print_tot_conc_type = TOTAL_MOLALITY
  3120)       case('AGE')
  3121)         reaction%print_age = PETSC_TRUE
  3122)       case ('SITE_DENSITY')
  3123)         call InputReadWord(input,option,name,PETSC_TRUE)  
  3124)         call InputErrorMsg(input,option,'Site Name', &
  3125)                            'CHEMISTRY,OUTPUT,SITE DENSITY')
  3126)         cur_srfcplx_rxn => reaction%surface_complexation%rxn_list
  3127)         do
  3128)           if (.not.associated(cur_srfcplx_rxn)) exit
  3129)           if (StringCompare(name,cur_srfcplx_rxn%free_site_name,MAXWORDLENGTH)) then
  3130)             cur_srfcplx_rxn%site_density_print_me = PETSC_TRUE
  3131)             found = PETSC_TRUE
  3132)             exit
  3133)           endif
  3134)           cur_srfcplx_rxn => cur_srfcplx_rxn%next
  3135)         enddo
  3136)       case default        
  3137)         found = PETSC_FALSE
  3138)         ! primary aqueous species
  3139)         if (.not.found) then
  3140)           cur_aq_spec => reaction%primary_species_list
  3141)           do
  3142)             if (.not.associated(cur_aq_spec)) exit
  3143)             if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
  3144)               cur_aq_spec%print_me = PETSC_TRUE
  3145)               found = PETSC_TRUE
  3146)               exit
  3147)             endif
  3148)             cur_aq_spec => cur_aq_spec%next
  3149)           enddo
  3150)         endif
  3151)         ! secondary aqueous complex
  3152)         if (.not.found) then
  3153)           cur_aq_spec => reaction%secondary_species_list
  3154)           do
  3155)             if (.not.associated(cur_aq_spec)) exit
  3156)             if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
  3157)               cur_aq_spec%print_me = PETSC_TRUE
  3158)               found = PETSC_TRUE
  3159)               exit
  3160)             endif
  3161)             cur_aq_spec => cur_aq_spec%next
  3162)           enddo  
  3163)         endif
  3164)         ! gas
  3165)         if (.not.found) then
  3166)           cur_gas_spec => reaction%gas_species_list
  3167)           do
  3168)             if (.not.associated(cur_gas_spec)) exit
  3169)             if (StringCompare(name,cur_gas_spec%name,MAXWORDLENGTH)) then
  3170)               cur_gas_spec%print_me = PETSC_TRUE
  3171)               found = PETSC_TRUE
  3172)               exit
  3173)             endif
  3174)             cur_gas_spec => cur_gas_spec%next
  3175)           enddo  
  3176)         endif
  3177)         ! minerals
  3178)         if (.not.found) then
  3179)           cur_mineral => reaction%mineral%mineral_list
  3180)           do
  3181)             if (.not.associated(cur_mineral)) exit
  3182)             if (StringCompare(name,cur_mineral%name,MAXWORDLENGTH)) then
  3183)               cur_mineral%print_me = PETSC_TRUE
  3184)               found = PETSC_TRUE
  3185)               exit
  3186)             endif
  3187)             cur_mineral => cur_mineral%next
  3188)           enddo
  3189)         endif
  3190)         ! immobile
  3191)         if (.not.found) then
  3192)           cur_immobile => reaction%immobile%list
  3193)           do  
  3194)             if (.not.associated(cur_immobile)) exit
  3195)             if (StringCompare(name,cur_immobile%name,MAXWORDLENGTH)) then
  3196)               cur_immobile%print_me = PETSC_TRUE
  3197)               found = PETSC_TRUE
  3198)               exit
  3199)             endif
  3200)             cur_immobile => cur_immobile%next
  3201)           enddo
  3202)         endif 
  3203)         ! surface complexation reaction
  3204)         if (.not.found) then
  3205)           cur_srfcplx_rxn => reaction%surface_complexation%rxn_list
  3206)           do
  3207)             if (.not.associated(cur_srfcplx_rxn)) exit
  3208)             if (StringCompare(name,cur_srfcplx_rxn%free_site_name, &
  3209)                               MAXWORDLENGTH)) then
  3210)               cur_srfcplx_rxn%free_site_print_me = PETSC_TRUE
  3211)               found = PETSC_TRUE
  3212)               exit
  3213)             endif
  3214)             cur_srfcplx_rxn => cur_srfcplx_rxn%next
  3215)           enddo
  3216)         endif
  3217)         ! surface complex
  3218)         if (.not.found) then
  3219)           cur_srfcplx => reaction%surface_complexation%complex_list
  3220)           do  
  3221)             if (.not.associated(cur_srfcplx)) exit
  3222)             if (StringCompare(name,cur_srfcplx%name,MAXWORDLENGTH)) then
  3223)               cur_srfcplx%print_me = PETSC_TRUE
  3224)               found = PETSC_TRUE
  3225)               exit
  3226)             endif
  3227)             cur_srfcplx => cur_srfcplx%next
  3228)           enddo
  3229)         endif
  3230)         if (.not.found) then
  3231)           option%io_buffer = 'CHEMISTRY,OUTPUT species name: '//trim(name)// &
  3232)                              ' not found among chemical species'
  3233)           call printErrMsg(option)
  3234)         endif
  3235)     end select
  3236) 
  3237)   enddo
  3238) 
  3239)   ! check to ensure that the user has listed FREE_ION or TOTAL is a primary
  3240)   ! species is listed for output
  3241)   found = PETSC_FALSE
  3242)   cur_aq_spec => reaction%primary_species_list
  3243)   do
  3244)     if (.not.associated(cur_aq_spec)) exit
  3245)     if (cur_aq_spec%print_me) then
  3246)       found = PETSC_TRUE
  3247)       exit
  3248)     endif
  3249)     cur_aq_spec => cur_aq_spec%next
  3250)   enddo
  3251) 
  3252)   if ((found .or. reaction%print_all_primary_species .or. &
  3253)        reaction%print_all_species) .and. &
  3254)       .not.(reaction%print_total_component .or. &
  3255)             reaction%print_free_ion)) then
  3256)     option%io_buffer = 'FREE_ION or TOTAL must be specified to print a ' // &
  3257)       'primary species.'
  3258)     call printErrMsg(option)
  3259)   endif
  3260) 
  3261) end subroutine ReactionReadOutput
  3262) 
  3263) ! ************************************************************************** !
  3264) 
  3265) subroutine RJumpStartKineticSorption(rt_auxvar,global_auxvar, &
  3266)                                      material_auxvar,reaction,option)
  3267)   ! 
  3268)   ! Calculates the concentrations of species sorbing
  3269)   ! through kinetic sorption processes based
  3270)   ! on equilibrium with the aqueous phase.
  3271)   ! 
  3272)   ! Author: Glenn Hammond
  3273)   ! Date: 08/05/09
  3274)   ! 
  3275) 
  3276)   use Option_module
  3277)   
  3278)   implicit none
  3279)   
  3280)   type(reaction_type), pointer :: reaction
  3281)   type(reactive_transport_auxvar_type) :: rt_auxvar 
  3282)   type(global_auxvar_type) :: global_auxvar
  3283)   class(material_auxvar_type) :: material_auxvar
  3284)   type(option_type) :: option
  3285) 
  3286)   PetscInt :: irate
  3287)   
  3288)   ! WARNING: below assumes site concentration multiplicative factor
  3289)   allocate(rt_auxvar%dtotal_sorb_eq(reaction%naqcomp,reaction%naqcomp))
  3290)   !geh: if jumpstarting, we need to zero the sorbed total as 
  3291)   !     RTotalSorbEqSurfCplx() will add but not initialize
  3292)   call RZeroSorb(rt_auxvar)
  3293)   call RTotalSorbEqSurfCplx(rt_auxvar,global_auxvar,material_auxvar, &
  3294)                             reaction,option)
  3295)   option%io_buffer = 'RJumpStartKineticSorption needs to be fixed'
  3296)   call printErrMsg(option)
  3297) #if 0  
  3298)   !TODO(geh): sort this out
  3299)   do irate = 1, reaction%kinmr_nrate
  3300)     rt_auxvar%kinmr_total_sorb(:,irate) = reaction%kinmr_frac(irate) * &
  3301)                                           rt_auxvar%total_sorb_eq
  3302)   enddo
  3303) #endif  
  3304)   deallocate(rt_auxvar%dtotal_sorb_eq)
  3305)   nullify(rt_auxvar%dtotal_sorb_eq)
  3306) 
  3307) end subroutine RJumpStartKineticSorption
  3308) 
  3309) ! ************************************************************************** !
  3310) 
  3311) subroutine RReact(rt_auxvar,global_auxvar,material_auxvar,tran_xx_p, &
  3312)                   num_iterations_,reaction,option)
  3313)   ! 
  3314)   ! Solves reaction portion of operator splitting using Newton-Raphson
  3315)   ! 
  3316)   ! Author: Glenn Hammond
  3317)   ! Date: 05/04/10
  3318)   ! 
  3319) 
  3320)   use Option_module
  3321)   
  3322)   implicit none
  3323)   
  3324)   type(reaction_type), pointer :: reaction
  3325)   type(reactive_transport_auxvar_type) :: rt_auxvar 
  3326)   type(global_auxvar_type) :: global_auxvar
  3327)   class(material_auxvar_type) :: material_auxvar
  3328)   PetscReal :: tran_xx_p(reaction%ncomp)
  3329)   type(option_type) :: option
  3330)   PetscInt :: num_iterations_
  3331)   PetscReal :: sign_(reaction%ncomp)
  3332)   
  3333)   PetscReal :: residual(reaction%ncomp)
  3334)   PetscReal :: res(reaction%ncomp)
  3335)   PetscReal :: J(reaction%ncomp,reaction%ncomp)
  3336)   PetscReal :: one_over_dt
  3337)   PetscReal :: prev_solution(reaction%ncomp)
  3338)   PetscReal :: new_solution(reaction%ncomp)
  3339)   PetscReal :: update(reaction%ncomp)
  3340)   PetscReal :: maximum_relative_change
  3341)   PetscReal :: accumulation_coef
  3342)   PetscReal :: fixed_accum(reaction%ncomp)
  3343)   PetscInt :: num_iterations
  3344)   PetscInt :: icomp
  3345)   PetscInt :: immobile_start, immobile_end
  3346)   PetscReal :: ratio, min_ratio
  3347)   PetscReal :: scale
  3348)   
  3349)   PetscInt, parameter :: iphase = 1
  3350) 
  3351)   one_over_dt = 1.d0/option%tran_dt
  3352)   num_iterations = 0
  3353) 
  3354)   ! calculate fixed portion of accumulation term
  3355)   ! fixed_accum is overwritten in RTAccumulation
  3356)   ! Since RTAccumulation uses rt_auxvar%total, we must overwrite the 
  3357)   ! rt_auxvar total variables
  3358)   ! aqueous
  3359)   rt_auxvar%total(:,iphase) = tran_xx_p(1:reaction%naqcomp)
  3360)   
  3361)   if (reaction%ncoll > 0) then
  3362)     option%io_buffer = 'Colloids not set up for operator split mode.'
  3363)     call printErrMsg(option)
  3364)   endif
  3365) 
  3366) ! skip chemistry if species nonreacting 
  3367) #if 1  
  3368)   if (.not.reaction%use_full_geochemistry) then
  3369)     rt_auxvar%pri_molal(:) = tran_xx_p(1:reaction%naqcomp) / &
  3370)                              global_auxvar%den_kg(iphase)*1.d3
  3371)     return
  3372)   endif
  3373) #endif  
  3374)   
  3375)   ! update immobile concentrations
  3376)   if (reaction%nimcomp > 0) then
  3377)     immobile_start = reaction%offset_immobile + 1
  3378)     immobile_end = reaction%offset_immobile + reaction%nimcomp
  3379)     rt_auxvar%immobile(1:reaction%nimcomp)  = &
  3380)       tran_xx_p(immobile_start:immobile_end)
  3381)   endif
  3382)   
  3383)   if (.not.option%use_isothermal) then
  3384)     call RUpdateTempDependentCoefs(global_auxvar,reaction,PETSC_FALSE,option)
  3385)   endif
  3386) 
  3387)   ! still need code to overwrite other phases
  3388)   call RTAccumulation(rt_auxvar,global_auxvar,material_auxvar,reaction, &
  3389)                       option,fixed_accum)
  3390)   if (reaction%neqsorb > 0) then
  3391)     call RAccumulationSorb(rt_auxvar,global_auxvar,material_auxvar,reaction, &
  3392)                            option,fixed_accum)  
  3393)   endif
  3394) 
  3395)   ! now update activity coefficients
  3396)   if (reaction%act_coef_update_frequency /= ACT_COEF_FREQUENCY_OFF) then
  3397)     call RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
  3398)   endif
  3399)   
  3400)   do
  3401)   
  3402)     num_iterations = num_iterations + 1
  3403) 
  3404)     if (reaction%act_coef_update_frequency == &
  3405)         ACT_COEF_FREQUENCY_NEWTON_ITER) then
  3406)       call RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
  3407)     endif
  3408)     call RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction, &
  3409)                          option)
  3410)     
  3411)     ! Accumulation
  3412)     ! residual is overwritten in RTAccumulation()
  3413)     call RTAccumulation(rt_auxvar,global_auxvar,material_auxvar,reaction, &
  3414)                         option,residual)
  3415)     residual = residual-fixed_accum
  3416) 
  3417)     ! J is overwritten in RTAccumulationDerivative()
  3418)     call RTAccumulationDerivative(rt_auxvar,global_auxvar,material_auxvar, &
  3419)                                   reaction,option,J)
  3420) 
  3421)     if (reaction%neqsorb > 0) then
  3422)       call RAccumulationSorb(rt_auxvar,global_auxvar,material_auxvar,reaction, &
  3423)                              option,residual)
  3424)       call RAccumulationSorbDerivative(rt_auxvar,global_auxvar,material_auxvar, &
  3425)                                        reaction,option,J)
  3426)     endif
  3427) 
  3428)                          ! derivative
  3429)     call RReaction(residual,J,PETSC_TRUE,rt_auxvar,global_auxvar, &
  3430)                    material_auxvar,reaction,option)
  3431)     
  3432)     if (maxval(abs(residual)) < reaction%max_residual_tolerance) exit
  3433) 
  3434)     call RSolve(residual,J,rt_auxvar%pri_molal,update,reaction%ncomp, &
  3435)                 reaction%use_log_formulation)
  3436)     
  3437)     prev_solution(1:reaction%naqcomp) = rt_auxvar%pri_molal(1:reaction%naqcomp)
  3438)     if (reaction%nimcomp > 0) then
  3439)       prev_solution(immobile_start:immobile_end) = &
  3440)         rt_auxvar%immobile(1:reaction%nimcomp)
  3441)     endif
  3442) 
  3443)     if (reaction%use_log_formulation) then
  3444)       update = dsign(1.d0,update)*min(dabs(update),reaction%max_dlnC)
  3445)       new_solution = prev_solution*exp(-update)    
  3446)     else ! linear upage
  3447)       ! ensure non-negative concentration
  3448)       min_ratio = 1.d20 ! large number
  3449)       do icomp = 1, reaction%ncomp
  3450)         if (prev_solution(icomp) <= update(icomp)) then
  3451)           ratio = abs(prev_solution(icomp)/update(icomp))
  3452)           if (ratio < min_ratio) min_ratio = ratio
  3453)         endif
  3454)       enddo
  3455)       if (min_ratio < 1.d0) then
  3456)         ! scale by 0.99 to make the update slightly smaller than the min_ratio
  3457)         update = update*min_ratio*0.99d0
  3458)       endif
  3459)       new_solution = prev_solution - update
  3460)     endif
  3461) 
  3462)     maximum_relative_change = maxval(abs((new_solution-prev_solution)/ &
  3463)                                          prev_solution))
  3464)     
  3465)     if (maximum_relative_change < reaction%max_relative_change_tolerance) exit
  3466) 
  3467)     if (num_iterations > 50) then
  3468)       scale = 1.d0
  3469)       if (num_iterations > 50) then
  3470)         scale = 0.1d0
  3471)       else if (num_iterations > 100) then
  3472)         scale = 0.01d0
  3473)       else if (num_iterations > 150) then
  3474)         scale = 0.001d0
  3475)       else if (num_iterations > 500) then
  3476)         print *, 'Maximum iterations in RReact: stop: ',num_iterations
  3477)         print *, 'Maximum iterations in RReact: residual: ',residual
  3478)         print *, 'Maximum iterations in RReact: new solution: ',new_solution
  3479)         stop
  3480)       endif
  3481)       if (scale < 0.99d0) then
  3482)         ! apply scaling
  3483)         new_solution = scale*(new_solution-prev_solution(:))+prev_solution(:)
  3484)       endif
  3485)     endif
  3486)     
  3487)     rt_auxvar%pri_molal(1:reaction%naqcomp) = new_solution(1:reaction%naqcomp)
  3488)     if (reaction%nimcomp > 0) then
  3489)       rt_auxvar%immobile(1:reaction%nimcomp) = &
  3490)         new_solution(immobile_start:immobile_end)
  3491)     endif    
  3492)   
  3493)   enddo
  3494) 
  3495)   ! one last update
  3496)   call RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
  3497) 
  3498)   num_iterations_ = num_iterations
  3499)   
  3500) end subroutine RReact
  3501) 
  3502) ! ************************************************************************** !
  3503) 
  3504) subroutine RReaction(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3505)                      material_auxvar,reaction,option)
  3506)   ! 
  3507)   ! Computes reactions
  3508)   ! 
  3509)   ! Author: Glenn Hammond
  3510)   ! Date: 09/30/08
  3511)   ! 
  3512) 
  3513)   use Option_module
  3514)   use CLM_Rxn_module, only : RCLMRxn, clmrxn_list 
  3515)  
  3516)   implicit none
  3517)   
  3518)   type(reaction_type), pointer :: reaction
  3519)   type(reactive_transport_auxvar_type) :: rt_auxvar 
  3520)   type(global_auxvar_type) :: global_auxvar
  3521)   class(material_auxvar_type) :: material_auxvar
  3522)   type(option_type) :: option
  3523)   PetscBool :: derivative
  3524)   PetscReal :: Res(reaction%ncomp)
  3525)   PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
  3526) 
  3527)   if (reaction%mineral%nkinmnrl > 0) then
  3528)     call RKineticMineral(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3529)                          material_auxvar,reaction,option)
  3530)   endif
  3531)   
  3532)   if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
  3533)     call RMultiRateSorption(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3534)                             material_auxvar,reaction,option)
  3535)   endif
  3536)   
  3537)   if (reaction%surface_complexation%nkinsrfcplxrxn > 0) then
  3538)     call RKineticSurfCplx(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3539)                           material_auxvar,reaction,option)
  3540)   endif
  3541)   
  3542)   if (reaction%nradiodecay_rxn > 0) then
  3543)     call RRadioactiveDecay(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3544)                            material_auxvar,reaction,option)
  3545)   endif
  3546)   
  3547)   if (reaction%ngeneral_rxn > 0) then
  3548)     call RGeneral(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3549)                   material_auxvar,reaction,option)
  3550)   endif
  3551)   
  3552)   if (reaction%microbial%nrxn > 0) then
  3553)     call RMicrobial(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3554)                     material_auxvar,reaction,option)
  3555)   endif
  3556)   
  3557)   if (reaction%immobile%ndecay_rxn > 0) then
  3558)     call RImmobileDecay(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3559)                         material_auxvar,reaction,option)
  3560)   endif
  3561)   
  3562)   if (associated(rxn_sandbox_list)) then
  3563)     call RSandbox(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3564)                   material_auxvar,reaction,option)
  3565)   endif
  3566)   
  3567)   ! add new reactions here and in RReactionDerivative
  3568)   if (associated(clmrxn_list)) then
  3569)     call RCLMRxn(Res,Jac,derivative,rt_auxvar,global_auxvar, &
  3570)                   material_auxvar,reaction,option)
  3571)   endif
  3572) 
  3573) end subroutine RReaction
  3574) 
  3575) ! ************************************************************************** !
  3576) 
  3577) subroutine RReactionDerivative(Res,Jac,rt_auxvar,global_auxvar, &
  3578)                                material_auxvar,reaction,option)
  3579)   ! 
  3580)   ! RReaction: Computes reactions
  3581)   ! 
  3582)   ! Author: Glenn Hammond
  3583)   ! Date: 09/30/08
  3584)   ! 
  3585) 
  3586)   use Option_module
  3587)   
  3588)   implicit none
  3589)   
  3590)   type(reaction_type), pointer :: reaction
  3591)   type(reactive_transport_auxvar_type) :: rt_auxvar 
  3592)   type(reactive_transport_auxvar_type) :: rt_auxvar_pert
  3593)   type(global_auxvar_type) :: global_auxvar
  3594)   class(material_auxvar_type) :: material_auxvar
  3595)   type(option_type) :: option
  3596)   PetscReal :: Res(reaction%ncomp)
  3597)   PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
  3598)    
  3599)   PetscReal :: Res_orig(reaction%ncomp)
  3600)   PetscReal :: Res_pert(reaction%ncomp)
  3601)   PetscInt :: icomp, jcomp, joffset
  3602)   PetscReal :: Jac_dummy(reaction%ncomp,reaction%ncomp)
  3603)   PetscReal :: pert
  3604)   PetscBool :: compute_derivative
  3605) 
  3606)   ! add new reactions in the 3 locations below
  3607) 
  3608)   if (.not.option%transport%numerical_derivatives) then ! analytical derivative
  3609)     compute_derivative = PETSC_TRUE
  3610)     call RReaction(Res,Jac,compute_derivative,rt_auxvar, &
  3611)                    global_auxvar,material_auxvar,reaction,option)  
  3612) 
  3613)     ! add only in RReaction
  3614) 
  3615)   else ! numerical derivative
  3616)     compute_derivative = PETSC_FALSE
  3617)     Res_orig = 0.d0
  3618)     option%iflag = 0 ! be sure not to allocate mass_balance array
  3619)     call RTAuxVarInit(rt_auxvar_pert,reaction,option)
  3620)     call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
  3621) 
  3622)     call RReaction(Res_orig,Jac_dummy,compute_derivative,rt_auxvar, &
  3623)                    global_auxvar,material_auxvar,reaction,option)     
  3624) 
  3625)     ! aqueous species
  3626)     do jcomp = 1, reaction%naqcomp
  3627)       Res_pert = 0.d0
  3628)       call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
  3629)       pert = rt_auxvar_pert%pri_molal(jcomp)*perturbation_tolerance
  3630)       rt_auxvar_pert%pri_molal(jcomp) = rt_auxvar_pert%pri_molal(jcomp) + pert
  3631)       
  3632)       call RTotal(rt_auxvar_pert,global_auxvar,reaction,option)
  3633)       if (reaction%neqsorb > 0) then
  3634)         call RTotalSorb(rt_auxvar_pert,global_auxvar,material_auxvar, &
  3635)                         reaction,option)
  3636)       endif
  3637)       call RReaction(Res_pert,Jac_dummy,compute_derivative,rt_auxvar_pert, &
  3638)                      global_auxvar,material_auxvar,reaction,option)    
  3639) 
  3640)       do icomp = 1, reaction%ncomp
  3641)         Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
  3642)                            (Res_pert(icomp)-Res_orig(icomp))/pert
  3643)       enddo
  3644)     enddo
  3645)     ! immobile species
  3646)     do jcomp = 1, reaction%nimcomp
  3647)       Res_pert = 0.d0
  3648)       call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
  3649)       ! leave pri_molal, total, total sorbed as is; just copy
  3650)       pert = rt_auxvar_pert%immobile(jcomp)*perturbation_tolerance
  3651)       rt_auxvar_pert%immobile(jcomp) = rt_auxvar_pert%immobile(jcomp) + pert
  3652)       call RReaction(Res_pert,Jac_dummy,compute_derivative,rt_auxvar_pert, &
  3653)                      global_auxvar,material_auxvar,reaction,option)    
  3654) 
  3655)       ! j is the index in the residual vector and Jacobian
  3656)       joffset = reaction%offset_immobile + jcomp
  3657)       do icomp = 1, reaction%ncomp
  3658)         Jac(icomp,joffset) = Jac(icomp,joffset) + &
  3659)                            (Res_pert(icomp)-Res_orig(icomp))/pert
  3660)       enddo
  3661)     enddo
  3662)     
  3663)     ! zero small derivatives
  3664)     do icomp = 1, reaction%ncomp
  3665)       do jcomp = 1, reaction%ncomp
  3666)         if (dabs(Jac(icomp,jcomp)) < 1.d-40)  Jac(icomp,jcomp) = 0.d0
  3667)       enddo
  3668)     enddo
  3669)     call RTAuxVarStrip(rt_auxvar_pert)
  3670)   endif
  3671) 
  3672) end subroutine RReactionDerivative
  3673) 
  3674) ! ************************************************************************** !
  3675) 
  3676) subroutine CO2AqActCoeff(rt_auxvar,global_auxvar,reaction,option)
  3677)   ! 
  3678)   ! Computes activity coefficients of aqueous CO2
  3679)   ! 
  3680)   ! Author: Chuan Lu
  3681)   ! Date: 07/13/09
  3682)   ! 
  3683)     
  3684)   use Option_module
  3685)   use co2eos_module
  3686) 
  3687)   implicit none
  3688) 
  3689)   type(reactive_transport_auxvar_type) :: rt_auxvar
  3690)   type(global_auxvar_type) :: global_auxvar
  3691)   type(reaction_type) :: reaction
  3692)   type(option_type) :: option
  3693)    
  3694)   PetscReal :: m_na, m_cl, tc, co2aqact, lngamco2, henry, xphico2, pco2
  3695)   PetscReal :: sat_pressure
  3696)   PetscErrorCode :: ierr 
  3697) 
  3698) ! print *,'CO2AqActCoeff: ', global_auxvar%pres(:)
  3699) 
  3700)   tc = global_auxvar%temp
  3701)   pco2 = global_auxvar%pres(2)
  3702)   sat_pressure =0D0
  3703) 
  3704)   m_na = option%m_nacl; m_cl = m_na
  3705)   if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
  3706)      m_na = rt_auxvar%pri_molal(reaction%species_idx%na_ion_id)
  3707)      m_cl = rt_auxvar%pri_molal(reaction%species_idx%cl_ion_id)
  3708)   endif
  3709) 
  3710)   call Henry_duan_sun(tc,pco2*1D-5,henry,lngamco2, &
  3711)          m_na,m_cl,co2aqact)
  3712)   
  3713)   if (reaction%species_idx%co2_aq_id /= 0) then
  3714)     rt_auxvar%pri_act_coef(reaction%species_idx%co2_aq_id) = co2aqact
  3715)   else
  3716)     co2aqact = 1.d0
  3717)   endif
  3718)  ! print *, 'CO2AqActCoeff', tc, pco2, m_na,m_cl, sat_pressure,co2aqact
  3719) end subroutine CO2AqActCoeff
  3720) 
  3721) ! ************************************************************************** !
  3722) 
  3723) function RSumMoles(rt_auxvar,reaction,option)
  3724)   ! 
  3725)   ! Sums the total moles of primary and secondary aqueous species
  3726)   ! 
  3727)   ! Author: Glenn Hammond
  3728)   ! Date: 12/01/14
  3729)   ! 
  3730) 
  3731)   use Option_module
  3732)   
  3733)   implicit none
  3734) 
  3735)   type(reactive_transport_auxvar_type) :: rt_auxvar
  3736)   type(reaction_type) :: reaction
  3737)   type(option_type) :: option
  3738)   PetscReal :: RSumMoles
  3739) 
  3740)   PetscInt :: i
  3741)   
  3742)   RSumMoles = 0.d0
  3743)   do i = 1, reaction%naqcomp
  3744)     RSumMoles = RSumMoles + rt_auxvar%pri_molal(i)
  3745)   enddo
  3746)   
  3747)   do i = 1, reaction%neqcplx
  3748)     RSumMoles = RSumMoles + rt_auxvar%sec_molal(i)
  3749)   enddo
  3750)   
  3751) end function RSumMoles
  3752) 
  3753) ! ************************************************************************** !
  3754) 
  3755) function RCO2MoleFraction(rt_auxvar,global_auxvar,reaction,option)
  3756)   ! 
  3757)   ! Sums the total moles of primary and secondary aqueous species
  3758)   ! 
  3759)   ! Author: Glenn Hammond
  3760)   ! Date: 12/01/14
  3761)   ! 
  3762) 
  3763)   use Option_module
  3764)   
  3765)   implicit none
  3766) 
  3767)   type(reactive_transport_auxvar_type) :: rt_auxvar
  3768)   type(global_auxvar_type) :: global_auxvar
  3769)   type(reaction_type) :: reaction
  3770)   type(option_type) :: option
  3771)   PetscReal :: RCO2MoleFraction
  3772) 
  3773)   PetscInt :: i
  3774)   PetscInt :: icplx
  3775)   PetscInt :: ico2
  3776)   PetscReal :: sum_co2, sum_mol
  3777)   
  3778)   ico2 = reaction%species_idx%co2_aq_id
  3779) 
  3780)   if (ico2 == 0) then
  3781)     option%io_buffer = 'CO2 is not set in RCO2MoleFraction().'
  3782)     call printErrMsg(option)
  3783)   endif
  3784)   
  3785)   sum_co2 = rt_auxvar%pri_molal(ico2)
  3786)   sum_mol = RSumMoles(rt_auxvar,reaction,option)
  3787)   ! sum_co2 and sum_mol are both in units mol/kg water
  3788)   ! FMWH2O is in units g/mol
  3789)   ! therefore, scale by 1.d-3 to convert from mol/kg water - g water/mol water
  3790)   ! to mol/mol water -- kg water / 1000g water
  3791)   RCO2MoleFraction = sum_co2 * FMWH2O * 1.d-3 / &
  3792)                      (1.d0 + FMWH2O * sum_mol * 1.d-3)
  3793)   
  3794) end function RCO2MoleFraction
  3795) 
  3796) ! ************************************************************************** !
  3797) 
  3798) subroutine RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
  3799)   ! 
  3800)   ! Computes the ionic strength and activity coefficients
  3801)   ! 
  3802)   ! Author: Glenn Hammond
  3803)   ! Date: 09/30/08
  3804)   ! 
  3805) 
  3806)   use Option_module
  3807)   
  3808)   implicit none
  3809) 
  3810)   type(reactive_transport_auxvar_type) :: rt_auxvar
  3811)   type(global_auxvar_type) :: global_auxvar
  3812)   type(reaction_type) :: reaction
  3813)   type(option_type) :: option
  3814)   
  3815)   PetscInt :: icplx, icomp, it, j, jcomp, ncomp
  3816)   PetscReal :: I, sqrt_I, II, sqrt_II, f, fpri, didi, dcdi, den, dgamdi, &
  3817)     lnQK, sum, sum_pri_molal, sum_sec_molal
  3818)   PetscReal :: sum_molality
  3819)   PetscReal :: ln_conc(reaction%naqcomp)
  3820)   PetscReal :: ln_act(reaction%naqcomp)
  3821)   PetscReal :: NaN
  3822) 
  3823)   if (reaction%use_activity_h2o) then
  3824)     sum_pri_molal = 0.d0
  3825)     do j = 1, reaction%naqcomp
  3826)       if (j /= reaction%species_idx%h2o_aq_id) then
  3827)         sum_pri_molal = sum_pri_molal + rt_auxvar%pri_molal(j)
  3828)       endif
  3829)     enddo
  3830)   endif
  3831) 
  3832)   if (reaction%act_coef_update_algorithm == ACT_COEF_ALGORITHM_NEWTON) then
  3833) 
  3834)     ln_conc = log(rt_auxvar%pri_molal)
  3835)     ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
  3836)   
  3837)   ! compute primary species contribution to ionic strength
  3838)     fpri = 0.d0
  3839)     sum_molality = 0.d0
  3840)     do j = 1, reaction%naqcomp
  3841)       fpri = fpri + rt_auxvar%pri_molal(j)*reaction%primary_spec_Z(j)* &
  3842)                                          reaction%primary_spec_Z(j)
  3843)     enddo
  3844)   
  3845)     it = 0
  3846)     II = 0
  3847)     do
  3848)       it = it + 1
  3849)       
  3850)       if (it > 50) then
  3851)         write(option%io_buffer,*) &
  3852)           ' too many iterations in computing activity coefficients-stop',it,f,I, &
  3853)           ' setting all activity coefficients to NaNs to crash the code.'
  3854)         call printErrMsgNoStopByRank(option)
  3855)         NaN = 0.d0
  3856)         NaN = 1.d0/NaN
  3857)         NaN = 0.d0*NaN
  3858)         rt_auxvar%pri_molal = NaN
  3859)         rt_auxvar%pri_act_coef = NaN
  3860)         rt_auxvar%sec_act_coef = NaN
  3861)       endif
  3862)     
  3863)   ! add secondary species contribution to ionic strength
  3864)       I = fpri
  3865)       do icplx = 1, reaction%neqcplx ! for each secondary species
  3866)         I = I + rt_auxvar%sec_molal(icplx)*reaction%eqcplx_Z(icplx)* &
  3867)                                          reaction%eqcplx_Z(icplx)
  3868)       enddo
  3869)       I = 0.5d0*I
  3870)       f = I
  3871)     
  3872)       if (abs(I-II) < 1.d-6*I) exit
  3873)     
  3874)       if (reaction%neqcplx > 0) then
  3875)         didi = 0.d0
  3876)         sqrt_I = sqrt(I)
  3877)         do icplx = 1, reaction%neqcplx
  3878)           if (abs(reaction%eqcplx_Z(icplx)) > 0.d0) then
  3879)             sum = 0.5d0*reaction%debyeA*reaction%eqcplx_Z(icplx)* &
  3880)             reaction%eqcplx_Z(icplx) &
  3881)             /(sqrt_I*(1.d0+reaction%debyeB*reaction%eqcplx_a0(icplx)*sqrt_I)**2) &
  3882)             -reaction%debyeBdot
  3883)             ncomp = reaction%eqcplxspecid(0,icplx)
  3884)             do jcomp = 1, ncomp
  3885)               j = reaction%eqcplxspecid(jcomp,icplx)
  3886)               if (abs(reaction%primary_spec_Z(j)) > 0.d0) then
  3887)                 dgamdi = -0.5d0*reaction%debyeA*reaction%primary_spec_Z(j)**2/(sqrt_I* &
  3888)                 (1.d0+reaction%debyeB*reaction%primary_spec_a0(j)*sqrt_I)**2)+ &
  3889)                 reaction%debyeBdot 
  3890)                 sum = sum + reaction%eqcplxstoich(jcomp,icplx)*dgamdi
  3891)               endif
  3892)             enddo
  3893)             dcdi = rt_auxvar%sec_molal(icplx)*LOG_TO_LN*sum
  3894)             didi = didi+0.5d0*reaction%eqcplx_Z(icplx)*reaction%eqcplx_Z(icplx)*dcdi
  3895)           endif
  3896)         enddo
  3897)         den = 1.d0-didi
  3898)         if (abs(den) > 0.d0) then
  3899)           II = (f-I*didi)/den
  3900)         else
  3901)           II = f
  3902)         endif
  3903)       else
  3904)         II = f
  3905)       endif
  3906)     
  3907)       if (II < 0.d0) then
  3908)         write(option%io_buffer,*) 'ionic strength negative! it =',it, &
  3909)           ' I= ',I,II,den,didi,dcdi,sum
  3910)         call printErrMsgByRank(option)        
  3911)       endif
  3912)     
  3913)   ! compute activity coefficients
  3914)   ! primary species
  3915)       I = II
  3916)       sqrt_I = sqrt(I)
  3917)       do icomp = 1, reaction%naqcomp
  3918)         if (abs(reaction%primary_spec_Z(icomp)) > 0.d0) then
  3919)           rt_auxvar%pri_act_coef(icomp) = exp((-reaction%primary_spec_Z(icomp)* &
  3920)                                         reaction%primary_spec_Z(icomp)* &
  3921)                                         sqrt_I*reaction%debyeA/ &
  3922)                                         (1.d0+reaction%primary_spec_a0(icomp)* &
  3923)                                         reaction%debyeB*sqrt_I)+ &
  3924)                                         reaction%debyeBdot*I)* &
  3925)                                         LOG_TO_LN)
  3926)         else
  3927)           rt_auxvar%pri_act_coef(icomp) = 1.d0
  3928)         endif
  3929)       enddo
  3930)                 
  3931)   ! secondary species
  3932)       sum_sec_molal = 0.d0
  3933)       do icplx = 1, reaction%neqcplx
  3934)         if (abs(reaction%eqcplx_Z(icplx)) > 0.d0) then
  3935)           rt_auxvar%sec_act_coef(icplx) = exp((-reaction%eqcplx_Z(icplx)* &
  3936)                                         reaction%eqcplx_Z(icplx)* &
  3937)                                         sqrt_I*reaction%debyeA/ &
  3938)                                         (1.d0+reaction%eqcplx_a0(icplx)* &
  3939)                                         reaction%debyeB*sqrt_I)+ &
  3940)                                         reaction%debyeBdot*I)* &
  3941)                                         LOG_TO_LN)
  3942)         else
  3943)           rt_auxvar%sec_act_coef(icplx) = 1.d0
  3944)         endif
  3945)     
  3946)     ! compute secondary species concentration
  3947)         lnQK = -reaction%eqcplx_logK(icplx)*LOG_TO_LN
  3948) 
  3949)     ! activity of water
  3950)         if (reaction%eqcplxh2oid(icplx) > 0) then
  3951)           lnQK = lnQK + reaction%eqcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
  3952)         endif
  3953) 
  3954)         ncomp = reaction%eqcplxspecid(0,icplx)
  3955)         do jcomp = 1, ncomp
  3956)           icomp = reaction%eqcplxspecid(jcomp,icplx)
  3957)           lnQK = lnQK + reaction%eqcplxstoich(jcomp,icplx)*ln_act(icomp)
  3958)         enddo
  3959)         rt_auxvar%sec_molal(icplx) = exp(lnQK)/rt_auxvar%sec_act_coef(icplx)
  3960)         sum_sec_molal = sum_sec_molal + rt_auxvar%sec_molal(icplx)
  3961)       
  3962)       enddo
  3963)       
  3964)       if (reaction%use_activity_h2o) then
  3965)         rt_auxvar%ln_act_h2o = 1.d0-0.017d0*(sum_pri_molal+sum_sec_molal)
  3966)         if (rt_auxvar%ln_act_h2o > 0.d0) then
  3967)           rt_auxvar%ln_act_h2o = log(rt_auxvar%ln_act_h2o)
  3968)         else
  3969)           rt_auxvar%ln_act_h2o = 0.d0
  3970)           write(option%io_buffer,*) 'activity of H2O negative! ln act H2O =', &
  3971)             rt_auxvar%ln_act_h2o
  3972)           call printMsg(option)
  3973)         endif
  3974)       endif
  3975) 
  3976)     enddo
  3977)   
  3978)   else
  3979)   
  3980)   ! compute ionic strength
  3981)   ! primary species
  3982)     I = 0.d0
  3983)     do icomp = 1, reaction%naqcomp
  3984)       I = I + rt_auxvar%pri_molal(icomp)*reaction%primary_spec_Z(icomp)* &
  3985)                                        reaction%primary_spec_Z(icomp)
  3986)     enddo
  3987)   
  3988)   ! secondary species
  3989)     do icplx = 1, reaction%neqcplx ! for each secondary species
  3990)       I = I + rt_auxvar%sec_molal(icplx)*reaction%eqcplx_Z(icplx)* &
  3991)                                        reaction%eqcplx_Z(icplx)
  3992)     enddo
  3993)     I = 0.5d0*I
  3994)     sqrt_I = sqrt(I)
  3995)   
  3996)   ! compute activity coefficients
  3997)   ! primary species
  3998)     do icomp = 1, reaction%naqcomp
  3999)       if (abs(reaction%primary_spec_Z(icomp)) > 1.d-10) then
  4000)         rt_auxvar%pri_act_coef(icomp) = exp((-reaction%primary_spec_Z(icomp)* &
  4001)                                       reaction%primary_spec_Z(icomp)* &
  4002)                                       sqrt_I*reaction%debyeA/ &
  4003)                                       (1.d0+reaction%primary_spec_a0(icomp)* &
  4004)                                       reaction%debyeB*sqrt_I)+ &
  4005)                                       reaction%debyeBdot*I)* &
  4006)                                       LOG_TO_LN)
  4007)       else
  4008)         rt_auxvar%pri_act_coef(icomp) = 1.d0
  4009)       endif
  4010)     enddo
  4011)                 
  4012)   ! secondary species
  4013)     sum_sec_molal = 0.d0
  4014)     do icplx = 1, reaction%neqcplx
  4015)       if (dabs(reaction%eqcplx_Z(icplx)) > 1.d-10) then
  4016)         rt_auxvar%sec_act_coef(icplx) = exp((-reaction%eqcplx_Z(icplx)* &
  4017)                                       reaction%eqcplx_Z(icplx)* &
  4018)                                       sqrt_I*reaction%debyeA/ &
  4019)                                       (1.d0+reaction%eqcplx_a0(icplx)* &
  4020)                                       reaction%debyeB*sqrt_I)+ &
  4021)                                       reaction%debyeBdot*I)* &
  4022)                                       LOG_TO_LN)
  4023)       else
  4024)         rt_auxvar%sec_act_coef(icplx) = 1.d0
  4025)       endif
  4026)       sum_sec_molal = sum_sec_molal + rt_auxvar%sec_molal(icplx)
  4027)     enddo
  4028)     
  4029)     if (reaction%use_activity_h2o) then
  4030)       rt_auxvar%ln_act_h2o = 1.d0-0.017d0*(sum_pri_molal+sum_sec_molal)
  4031)       if (rt_auxvar%ln_act_h2o > 0.d0) then
  4032)         rt_auxvar%ln_act_h2o = log(rt_auxvar%ln_act_h2o)
  4033)       else
  4034)         rt_auxvar%ln_act_h2o = 0.d0
  4035)       endif
  4036)     endif
  4037)   endif
  4038)   
  4039) end subroutine RActivityCoefficients
  4040) 
  4041) ! ************************************************************************** !
  4042) 
  4043) subroutine RTotal(rt_auxvar,global_auxvar,reaction,option)
  4044)   ! 
  4045)   ! Computes the total component concentrations and derivative with
  4046)   ! respect to free-ion
  4047)   ! 
  4048)   ! Author: Glenn Hammond
  4049)   ! Date: 08/28/08
  4050)   ! 
  4051) 
  4052)   use Option_module
  4053) 
  4054)   ! CO2-specific
  4055)   use co2eos_module, only: Henry_duan_sun
  4056)   use EOS_Water_module
  4057)   
  4058)   implicit none
  4059)   
  4060)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4061)   type(global_auxvar_type) :: global_auxvar
  4062)   type(reaction_type) :: reaction
  4063)   type(option_type) :: option
  4064)   
  4065)   PetscInt :: i, j, icplx, icomp, jcomp, iphase, ncomp, ieqgas
  4066)   PetscErrorCode :: ierr
  4067)   PetscReal :: ln_conc(reaction%naqcomp)
  4068)   PetscReal :: ln_act(reaction%naqcomp)
  4069)   PetscReal :: lnQK, tempreal
  4070)   PetscReal :: den_kg_per_L, xmass
  4071)   PetscReal :: pressure, temperature, xphico2, muco2, den, m_na, m_cl
  4072)   
  4073)   ! CO2-specific
  4074)   PetscReal :: dg,dddt,dddp,fg,dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,&
  4075)                yco2,pco2,sat_pressure,lngamco2
  4076)   rt_auxvar%total = 0.d0 !debugging 
  4077)   
  4078)   iphase = 1           
  4079) !  den_kg_per_L = global_auxvar%den_kg(iphase)*1.d-3              
  4080)   xmass = 1.d0
  4081)   if (associated(global_auxvar%xmass)) xmass = global_auxvar%xmass(iphase)
  4082)   den_kg_per_L = global_auxvar%den_kg(iphase)*xmass*1.d-3
  4083) 
  4084)   ln_conc = log(rt_auxvar%pri_molal)
  4085)   ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
  4086)   rt_auxvar%total(:,iphase) = rt_auxvar%pri_molal(:)
  4087)   
  4088)   ! initialize derivatives
  4089)   rt_auxvar%aqueous%dtotal = 0.d0
  4090)   do icomp = 1, reaction%naqcomp
  4091)     rt_auxvar%aqueous%dtotal(icomp,icomp,iphase) = 1.d0
  4092)   enddo
  4093)    
  4094)   do icplx = 1, reaction%neqcplx ! for each secondary species
  4095)     ! compute secondary species concentration
  4096)     lnQK = -reaction%eqcplx_logK(icplx)*LOG_TO_LN
  4097) 
  4098)     ! activity of water
  4099)     if (reaction%eqcplxh2oid(icplx) > 0) then
  4100)       lnQK = lnQK + reaction%eqcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
  4101)     endif
  4102) 
  4103)     ncomp = reaction%eqcplxspecid(0,icplx)
  4104)     do i = 1, ncomp
  4105)       icomp = reaction%eqcplxspecid(i,icplx)
  4106)       lnQK = lnQK + reaction%eqcplxstoich(i,icplx)*ln_act(icomp)
  4107)     enddo
  4108)     rt_auxvar%sec_molal(icplx) = exp(lnQK)/rt_auxvar%sec_act_coef(icplx)
  4109)   
  4110)     ! add contribution to primary totals
  4111)     ! units of total = mol/L
  4112)     do i = 1, ncomp
  4113)       icomp = reaction%eqcplxspecid(i,icplx)
  4114)       rt_auxvar%total(icomp,iphase) = rt_auxvar%total(icomp,iphase) + &
  4115)                                       reaction%eqcplxstoich(i,icplx)* &
  4116)                                       rt_auxvar%sec_molal(icplx)
  4117)     enddo
  4118)     
  4119)     ! add contribution to derivatives of total with respect to free
  4120)     ! bear in mind that the water density portion is scaled below
  4121)     do j = 1, ncomp
  4122)       jcomp = reaction%eqcplxspecid(j,icplx)
  4123)       tempreal = reaction%eqcplxstoich(j,icplx)*exp(lnQK-ln_conc(jcomp))/ &
  4124)                                                  rt_auxvar%sec_act_coef(icplx)
  4125)       do i = 1, ncomp
  4126)         icomp = reaction%eqcplxspecid(i,icplx)
  4127)         rt_auxvar%aqueous%dtotal(icomp,jcomp,iphase) = &
  4128)           rt_auxvar%aqueous%dtotal(icomp,jcomp,iphase) + &
  4129)           reaction%eqcplxstoich(i,icplx)*tempreal
  4130)       enddo
  4131)     enddo
  4132)   enddo
  4133) 
  4134)   ! convert molality -> molarity
  4135)   ! unit of total = mol/L water
  4136)   rt_auxvar%total(:,iphase) = rt_auxvar%total(:,iphase)*den_kg_per_L
  4137)   
  4138)   ! units of dtotal = kg water/L water
  4139)   rt_auxvar%aqueous%dtotal = rt_auxvar%aqueous%dtotal*den_kg_per_L
  4140) 
  4141)   if (option%iflowmode == G_MODE) return
  4142) 
  4143) ! *********** Add SC phase and gas contributions ***********************  
  4144)   ! CO2-specific
  4145) 
  4146)   iphase = 2
  4147) 
  4148)   if (iphase > option%nphase) return 
  4149)   rt_auxvar%total(:,iphase) = 0.D0
  4150)   rt_auxvar%aqueous%dtotal(:,:,iphase) = 0.D0
  4151) 
  4152) !  den_kg_per_L = global_auxvar%den_kg(iphase)*1.d-3     
  4153) 
  4154)   if (global_auxvar%sat(iphase) > 1.D-20) then
  4155)     do ieqgas = 1, reaction%ngas ! all gas phase species are secondary
  4156) 
  4157)       pressure = global_auxvar%pres(2)
  4158)       temperature = global_auxvar%temp
  4159)       xphico2 = global_auxvar%fugacoeff(1)
  4160)       den = global_auxvar%den(2)
  4161)  
  4162)       call EOSWaterSaturationPressure(temperature, sat_pressure, ierr)
  4163)       pco2 = pressure - sat_pressure
  4164) !     call co2_span_wagner(pressure*1.D-6,temperature+273.15D0,dg,dddt,dddp,fg, &
  4165) !              dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,option%itable)
  4166) !
  4167) !            fg = fg*1D6
  4168) !            xphico2 = fg / pco2
  4169) !            global_auxvar%fugacoeff(1) = xphico2
  4170) 
  4171) 
  4172)       if (abs(reaction%species_idx%co2_gas_id) == ieqgas ) then
  4173) 
  4174)         if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
  4175)           m_na = rt_auxvar%pri_molal(reaction%species_idx%na_ion_id)
  4176)           m_cl = rt_auxvar%pri_molal(reaction%species_idx%cl_ion_id)
  4177)           call Henry_duan_sun(temperature,pressure*1D-5,muco2, &
  4178)                 lngamco2,m_na,m_cl)
  4179)         else
  4180)           call Henry_duan_sun(temperature,pressure*1D-5,muco2, &
  4181)                 lngamco2,option%m_nacl,option%m_nacl)
  4182)         endif
  4183)         !lnQk = - log(muco2) 
  4184)         lnQk = - log(muco2)-lngamco2
  4185)            
  4186)       else   
  4187)         lngamco2 = 0.d0
  4188)         lnQK = -reaction%eqgas_logK(ieqgas)*LOG_TO_LN
  4189)       endif 
  4190)           
  4191)       if (reaction%eqgash2oid(ieqgas) > 0) then
  4192)         lnQK = lnQK + reaction%eqgash2ostoich(ieqgas)*rt_auxvar%ln_act_h2o
  4193)       endif
  4194)    
  4195)    ! contribute to %total          
  4196)    !     do i = 1, ncomp
  4197)    ! removed loop over species, suppose only one primary species is related
  4198)       icomp = reaction%eqgasspecid(1,ieqgas)
  4199)       pressure = pressure * 1.D-5
  4200)         
  4201) !     rt_auxvar%gas_molar(ieqgas) = &
  4202) !         exp(lnQK+lngamco2)*rt_auxvar%pri_molal(icomp) &
  4203) !         /(IDEAL_GAS_CONSTANT*1.d-2*(temperature+273.15D0)*xphico2)
  4204) 
  4205) !     This form includes factor Z in pV = ZRT for nonideal gas
  4206)       rt_auxvar%gas_molar(ieqgas) = &
  4207)           exp(lnQK)*rt_auxvar%pri_act_coef(icomp)*rt_auxvar%pri_molal(icomp)* &
  4208)           den/pressure/xphico2
  4209) 
  4210)       rt_auxvar%total(icomp,iphase) = rt_auxvar%total(icomp,iphase) + &
  4211)           reaction%eqgasstoich(1,ieqgas)* &
  4212)           rt_auxvar%gas_molar(ieqgas)
  4213) 
  4214) !       print *,'RTotal: ',icomp,ieqgas,pressure, temperature, xphico2, &
  4215) !         global_auxvar%sat(iphase),rt_auxvar%gas_molar(ieqgas), &
  4216) !         rt_auxvar%pri_act_coef(icomp)*exp(lnQK)*rt_auxvar%pri_molal(icomp) &
  4217) !         /pressure/xphico2*den
  4218) 
  4219) 
  4220)    ! contribute to %dtotal
  4221)    !      tempreal = exp(lnQK+lngamco2)/pressure/xphico2*den
  4222) !     tempreal = rt_auxvar%pri_act_coef(icomp)*exp(lnQK) &
  4223) !         /pressure/xphico2*den
  4224)       tempreal = rt_auxvar%gas_molar(ieqgas)/rt_auxvar%pri_molal(icomp)
  4225)       rt_auxvar%aqueous%dtotal(icomp,icomp,iphase) = &
  4226)           rt_auxvar%aqueous%dtotal(icomp,icomp,iphase) + &
  4227)           reaction%eqgasstoich(1,ieqgas)*tempreal
  4228)     enddo
  4229)   ! rt_auxvar%total(:,iphase) = rt_auxvar%total(:,iphase)!*den_kg_per_L
  4230)   ! units of dtotal = kg water/L water
  4231)   ! rt_auxvar%dtotal(:, :,iphase) = rt_auxvar%dtotal(:,:,iphase)!*den_kg_per_L
  4232)   endif
  4233)   
  4234) end subroutine RTotal
  4235) 
  4236) ! ************************************************************************** !
  4237) 
  4238) subroutine RZeroSorb(rt_auxvar)
  4239)   ! 
  4240)   ! Zeros out arrays associated with sorption
  4241)   ! 
  4242)   ! Author: Glenn Hammond
  4243)   ! Date: 03/20/12
  4244)   ! 
  4245) 
  4246)   implicit none
  4247)   
  4248)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4249)   
  4250)   if (associated(rt_auxvar%total_sorb_eq)) rt_auxvar%total_sorb_eq = 0.d0
  4251)   if (associated(rt_auxvar%dtotal_sorb_eq)) rt_auxvar%dtotal_sorb_eq = 0.d0
  4252)   if (associated(rt_auxvar%eqsrfcplx_conc)) rt_auxvar%eqsrfcplx_conc = 0.d0
  4253)   
  4254) end subroutine RZeroSorb
  4255) 
  4256) ! ************************************************************************** !
  4257) 
  4258) subroutine RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
  4259)   ! 
  4260)   ! Computes the total sorbed component concentrations and
  4261)   ! derivative with respect to free-ion
  4262)   ! 
  4263)   ! Author: Glenn Hammond
  4264)   ! Date: 10/22/08
  4265)   ! 
  4266) 
  4267)   use Option_module
  4268)   
  4269)   implicit none
  4270)   
  4271)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4272)   type(global_auxvar_type) :: global_auxvar
  4273)   class(material_auxvar_type) :: material_auxvar
  4274)   type(reaction_type) :: reaction
  4275)   type(option_type) :: option
  4276)   
  4277)   call RZeroSorb(rt_auxvar)
  4278)   
  4279)   if (reaction%surface_complexation%neqsrfcplxrxn > 0) then
  4280)     call RTotalSorbEqSurfCplx(rt_auxvar,global_auxvar,material_auxvar, &
  4281)                               reaction,option)
  4282)   endif
  4283)   
  4284)   if (reaction%neqionxrxn > 0) then
  4285)     call RTotalSorbEqIonx(rt_auxvar,global_auxvar,reaction,option)
  4286)   endif
  4287)   
  4288)   if (reaction%neqkdrxn > 0) then
  4289)     call RTotalSorbKD(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
  4290)   endif
  4291)   
  4292) end subroutine RTotalSorb
  4293) 
  4294) ! ************************************************************************** !
  4295) 
  4296) subroutine RTotalSorbKD(rt_auxvar,global_auxvar,material_auxvar,reaction, &
  4297)                         option)
  4298)   ! 
  4299)   ! Computes the total sorbed component concentrations and
  4300)   ! derivative with respect to free-ion for the linear
  4301)   ! K_D model
  4302)   ! 
  4303)   ! Author: Glenn Hammond
  4304)   ! Date: 09/30/2010
  4305)   ! 
  4306) 
  4307)   use Option_module
  4308) 
  4309)   implicit none
  4310) 
  4311)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4312)   type(global_auxvar_type) :: global_auxvar
  4313)   class(material_auxvar_type) :: material_auxvar
  4314)   type(reaction_type) :: reaction
  4315)   type(option_type) :: option
  4316)   
  4317)   PetscInt :: irxn
  4318)   PetscInt :: icomp
  4319)   PetscReal :: res
  4320)   PetscReal :: dres_dc
  4321)   PetscReal :: molality
  4322)   PetscReal :: tempreal
  4323)   PetscReal :: one_over_n
  4324)   PetscReal :: molality_one_over_n
  4325)   PetscReal :: kd_kgw_m3b  
  4326)   PetscReal :: temp
  4327) 
  4328)   PetscInt, parameter :: iphase = 1
  4329) 
  4330)   do irxn = 1, reaction%neqkdrxn
  4331)     icomp = reaction%eqkdspecid(irxn)
  4332)     molality = rt_auxvar%pri_molal(icomp)
  4333)     if (reaction%eqkdmineral(irxn) > 0) then
  4334)       ! NOTE: mineral volume fraction here is solely a scaling factor.  It has 
  4335)       ! nothing to do with the soil volume; that is calculated through as a 
  4336)       ! function of porosity.
  4337)       temp = reaction%eqkddistcoef(irxn)
  4338)       temp = global_auxvar%den_kg(iphase)
  4339)       temp = (1.d0-material_auxvar%porosity)
  4340)       temp = material_auxvar%soil_particle_density
  4341)       temp = (rt_auxvar%mnrl_volfrac(reaction%eqkdmineral(irxn)))
  4342)       kd_kgw_m3b = reaction%eqkddistcoef(irxn) * & !KD units [mL water/g soil]
  4343)                    global_auxvar%den_kg(iphase) * &
  4344)                    (1.d0-material_auxvar%porosity) * &
  4345)                    material_auxvar%soil_particle_density * &
  4346)                    1.d-3 * & ! convert mL water/g soil to m^3 water/kg soil
  4347)                    (rt_auxvar%mnrl_volfrac(reaction%eqkdmineral(irxn)))
  4348)     else
  4349)       kd_kgw_m3b = reaction%eqkddistcoef(irxn)
  4350)     endif
  4351)     select case(reaction%eqkdtype(irxn))
  4352)       case(SORPTION_LINEAR)
  4353)         ! Csorb = Kd*Caq
  4354)         res = kd_kgw_m3b*molality
  4355)         dres_dc = kd_kgw_m3b
  4356)       case(SORPTION_LANGMUIR)
  4357)         ! Csorb = K*Caq*b/(1+K*Caq)
  4358)         tempreal = kd_kgw_m3b*molality
  4359)         res = tempreal*reaction%eqkdlangmuirb(irxn) / (1.d0 + tempreal)
  4360)         dres_dc = res/molality - &
  4361)                   res / (1.d0 + tempreal) * tempreal / molality
  4362)       case(SORPTION_FREUNDLICH)
  4363)         ! Csorb = Kd*Caq**(1/n)
  4364)         one_over_n = 1.d0/reaction%eqkdfreundlichn(irxn)
  4365)         molality_one_over_n = molality**one_over_n
  4366)         res = kd_kgw_m3b*molality**one_over_n
  4367)         dres_dc = res/molality*one_over_n
  4368)       case default
  4369)         res = 0.d0
  4370)         dres_dc = 0.d0
  4371)     end select
  4372)     rt_auxvar%total_sorb_eq(icomp) = rt_auxvar%total_sorb_eq(icomp) + res
  4373)     rt_auxvar%dtotal_sorb_eq(icomp,icomp) = &
  4374)       rt_auxvar%dtotal_sorb_eq(icomp,icomp) + dres_dc 
  4375)   enddo
  4376) 
  4377) end subroutine RTotalSorbKD
  4378) 
  4379) ! ************************************************************************** !
  4380) 
  4381) subroutine RTotalSorbEqIonx(rt_auxvar,global_auxvar,reaction,option)
  4382)   ! 
  4383)   ! Computes the total sorbed component concentrations and
  4384)   ! derivative with respect to free-ion for equilibrium ion
  4385)   ! exchange
  4386)   ! 
  4387)   ! Author: Glenn Hammond
  4388)   ! Date: 10/22/08; 05/26/09
  4389)   ! 
  4390) 
  4391)   use Option_module
  4392)   
  4393)   implicit none
  4394)   
  4395)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4396)   type(global_auxvar_type) :: global_auxvar
  4397)   type(reaction_type) :: reaction
  4398)   type(option_type) :: option
  4399)   
  4400)   PetscInt :: i, j, k, icplx, icomp, jcomp, iphase, ncomp, ncplx
  4401)   PetscReal :: ln_conc(reaction%naqcomp)
  4402)   PetscReal :: ln_act(reaction%naqcomp)
  4403)   PetscReal :: tempreal, tempreal1, tempreal2, total
  4404)   PetscInt :: irxn
  4405)   PetscReal, parameter :: tol = 1.d-12
  4406)   PetscBool :: one_more
  4407)   PetscReal :: res
  4408)     
  4409)   PetscReal :: omega
  4410)   PetscReal :: ref_cation_X, ref_cation_conc, ref_cation_Z, ref_cation_k, &
  4411)                ref_cation_quotient
  4412)   PetscReal :: cation_X(reaction%naqcomp)
  4413)   PetscReal :: dres_dref_cation_X, dref_cation_X
  4414)   PetscReal :: sumZX, sumkm
  4415)     
  4416)   PetscReal :: total_pert, ref_cation_X_pert, pert
  4417)   PetscReal :: ref_cation_quotient_pert, dres_dref_cation_X_pert
  4418) 
  4419)   PetscReal :: KDj, dres_dKDj, delta_KDj
  4420)   PetscInt :: it
  4421) 
  4422)   ln_conc = log(rt_auxvar%pri_molal)
  4423)   ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
  4424)     
  4425)   ! Ion Exchange
  4426)   if (associated(rt_auxvar%eqionx_conc)) rt_auxvar%eqionx_conc = 0.d0
  4427)   do irxn = 1, reaction%neqionxrxn
  4428) 
  4429)     ncomp = reaction%eqionx_rxn_cationid(0,irxn)
  4430) 
  4431)     ! for now we assume that omega is equal to CEC.
  4432)     if (reaction%eqionx_rxn_to_surf(irxn) > 0) then
  4433)       ! if tied to a mineral vol frac
  4434)       omega = max(reaction%eqionx_rxn_CEC(irxn)* &
  4435)                   rt_auxvar%mnrl_volfrac(reaction%eqionx_rxn_to_surf(irxn)), &
  4436)                   1.d-40)
  4437)     else
  4438)       omega = reaction%eqionx_rxn_CEC(irxn)
  4439)     endif
  4440) 
  4441)     if (reaction%eqionx_rxn_Z_flag(irxn)) then ! Zi /= Zj for any i,j
  4442) 
  4443)       icomp = reaction%eqionx_rxn_cationid(1,irxn)
  4444)       ref_cation_conc = rt_auxvar%pri_molal(icomp)*rt_auxvar%pri_act_coef(icomp)
  4445)       ref_cation_Z = reaction%primary_spec_Z(icomp)
  4446)       ref_cation_k = reaction%eqionx_rxn_k(1,irxn)
  4447)       ref_cation_X = ref_cation_Z* &
  4448)                      rt_auxvar%eqionx_ref_cation_sorbed_conc(irxn)/omega
  4449) 
  4450)       one_more = PETSC_FALSE
  4451)       cation_X = 0.d0
  4452)       KDj = ref_cation_X /(ref_cation_k*ref_cation_conc)
  4453)       it = 0
  4454) !geh: Change from 0 to 1 to run new implementation.
  4455) #if 1
  4456)       do
  4457)         it = it + 1
  4458)         if (it > 20000) then
  4459)           option%io_buffer = 'Too many Newton iterations in ion exchange.'
  4460)           call printErrMsgByRank(option)
  4461)         endif
  4462)         ref_cation_X = KDj*(ref_cation_k*ref_cation_conc)
  4463)         cation_X(1) = ref_cation_X
  4464)         total = ref_cation_X
  4465)         dres_dKDj = 0.d0
  4466)         do j = 2, ncomp
  4467)           icomp = reaction%eqionx_rxn_cationid(j,irxn)
  4468)           cation_X(j) = reaction%eqionx_rxn_k(j,irxn)* &
  4469)                         rt_auxvar%pri_molal(icomp)* &
  4470)                         rt_auxvar%pri_act_coef(icomp)* &
  4471)                         KDj**(reaction%primary_spec_Z(icomp)/ref_cation_Z)
  4472)           total = total + cation_X(j)
  4473)           dres_dKDj = dres_dKDj + cation_X(j)/KDj* &
  4474)                                   reaction%primary_spec_Z(icomp)
  4475)         enddo
  4476)         dres_dKDj = dres_dKDj/ref_cation_Z + (ref_cation_k*ref_cation_conc)
  4477)         res = 1.d0 - total
  4478) 
  4479)         if (one_more) exit
  4480) 
  4481)         ! no need to negate since res is subtracted above.
  4482)         delta_KDj = res/dres_dKDj
  4483)         KDj = KDj + delta_KDj
  4484)         KDj = max(KDj,1.d-40) ! prevent from going negative
  4485)         if (dabs(delta_KDj/KDj) < tol) then
  4486)           one_more = PETSC_TRUE
  4487)         endif
  4488)       enddo
  4489) #else 
  4490)       do
  4491)         if (ref_cation_X <= 0.d0) ref_cation_X = 1.d-8
  4492)         cation_X(1) = ref_cation_X
  4493)         ref_cation_quotient = ref_cation_X/(ref_cation_k*ref_cation_conc)
  4494)         total = ref_cation_X
  4495) 
  4496)         do j = 2, ncomp
  4497)           icomp = reaction%eqionx_rxn_cationid(j,irxn)
  4498)           cation_X(j) = rt_auxvar%pri_molal(icomp)* &
  4499)                         rt_auxvar%pri_act_coef(icomp)* &
  4500)                         reaction%eqionx_rxn_k(j,irxn)* &
  4501)                         ref_cation_quotient** &
  4502)                         (reaction%primary_spec_Z(icomp)/ref_cation_Z)
  4503)           total = total + cation_X(j)
  4504)         enddo
  4505)         
  4506)         if (one_more) exit
  4507)         
  4508)         res = 1.d0-total
  4509)           
  4510)         dres_dref_cation_X = 1.d0
  4511) 
  4512) #if 0
  4513)   ! test derivative
  4514)         pert = 1.d-6 * ref_cation_X
  4515)         ref_cation_X_pert = ref_cation_X + pert
  4516)         ref_cation_quotient_pert = ref_cation_X_pert/ &
  4517)         (ref_cation_k*ref_cation_conc)
  4518)         total_pert = ref_cation_X_pert
  4519) 
  4520)           do j = 2, ncomp
  4521)             icomp = reaction%eqionx_rxn_cationid(j,irxn)
  4522)             total_pert = total_pert + &
  4523)                          rt_auxvar%pri_molal(icomp)* &
  4524)                          rt_auxvar%pri_act_coef(icomp)* &
  4525)                          reaction%eqionx_rxn_k(j,irxn)* &
  4526)                          ref_cation_quotient_pert** &
  4527)                          (reaction%primary_spec_Z(icomp)/ref_cation_Z)
  4528)           enddo
  4529)         dres_dref_cation_X_pert = (1.d0-total_pert-res)/pert
  4530)   ! test
  4531) #endif
  4532) 
  4533)         do j = 2, ncomp
  4534)           icomp = reaction%eqionx_rxn_cationid(j,irxn)
  4535)           dres_dref_cation_X = dres_dref_cation_X + &
  4536)             (reaction%primary_spec_Z(icomp)/ref_cation_Z)* &
  4537)             cation_X(j)/ref_cation_X
  4538)         enddo
  4539) 
  4540)         dref_cation_X = res / (-dres_dref_cation_X)
  4541) !        dref_cation_X = res / dres_dref_cation_X_pert
  4542)         ref_cation_X = ref_cation_X - dref_cation_X
  4543)       
  4544)         if (dabs(dref_cation_X/ref_cation_X) < tol) then
  4545)           one_more = PETSC_TRUE
  4546)         endif
  4547)       
  4548)       enddo
  4549) #endif
  4550) 
  4551)       rt_auxvar%eqionx_ref_cation_sorbed_conc(irxn) = ref_cation_X*omega/ &
  4552)                                                       ref_cation_Z
  4553) 
  4554)     else ! Zi == Zj for all i,j
  4555)         
  4556)       sumkm = 0.d0
  4557)       cation_X = 0.d0
  4558)       
  4559)       do j = 1, ncomp  
  4560)         icomp = reaction%eqionx_rxn_cationid(j,irxn)
  4561)         cation_X(j) = rt_auxvar%pri_molal(icomp)* &
  4562)                       rt_auxvar%pri_act_coef(icomp)* &
  4563)                       reaction%eqionx_rxn_k(j,irxn)
  4564)         sumkm = sumkm + cation_X(j)
  4565)       enddo
  4566)           
  4567)       cation_X = cation_X / sumkm
  4568) 
  4569)     endif
  4570)                 
  4571)     ! sum up charges
  4572)     sumZX = 0.d0
  4573)     do i = 1, ncomp
  4574)       icomp = reaction%eqionx_rxn_cationid(i,irxn)
  4575)       sumZX = sumZX + reaction%primary_spec_Z(icomp)*cation_X(i)
  4576)     enddo
  4577) 
  4578)     ! compute totals based on sorbed ions
  4579)     do i = 1, ncomp
  4580)       icomp = reaction%eqionx_rxn_cationid(i,irxn)
  4581)       tempreal1 = cation_X(i)*omega/reaction%primary_spec_Z(icomp)
  4582)       ! residual function entry
  4583)       
  4584)       rt_auxvar%eqionx_conc(i,irxn) = rt_auxvar%eqionx_conc(i,irxn) + tempreal1
  4585) 
  4586)       rt_auxvar%total_sorb_eq(icomp) = rt_auxvar%total_sorb_eq(icomp) + &
  4587)                                        tempreal1
  4588) 
  4589)       tempreal2 = reaction%primary_spec_Z(icomp)/sumZX
  4590)       do j = 1, ncomp
  4591)         jcomp = reaction%eqionx_rxn_cationid(j,irxn)
  4592)         if (i == j) then
  4593)           rt_auxvar%dtotal_sorb_eq(icomp,jcomp) = &
  4594)             rt_auxvar%dtotal_sorb_eq(icomp,jcomp) + &
  4595)             tempreal1*(1.d0-(tempreal2*cation_X(j)))/ &
  4596)             rt_auxvar%pri_molal(jcomp)
  4597)         else
  4598)           rt_auxvar%dtotal_sorb_eq(icomp,jcomp) = &
  4599)             rt_auxvar%dtotal_sorb_eq(icomp,jcomp) + &
  4600)             (-tempreal1)*tempreal2*cation_X(j)/ &
  4601)             rt_auxvar%pri_molal(jcomp)
  4602)         endif
  4603)       enddo
  4604)     enddo    
  4605) 
  4606)   enddo
  4607)   
  4608)   ! units of total_sorb = mol/m^3
  4609)   ! units of dtotal_sorb = kg water/m^3 bulk
  4610)   
  4611) end subroutine RTotalSorbEqIonx
  4612) 
  4613) ! ************************************************************************** !
  4614) 
  4615) subroutine RAccumulationSorb(rt_auxvar,global_auxvar,material_auxvar, &
  4616)                              reaction,option,Res)
  4617)   ! 
  4618)   ! Computes non-aqueous portion of the accumulation term in
  4619)   ! residual function
  4620)   ! 
  4621)   ! Author: Glenn Hammond
  4622)   ! Date: 05/26/09
  4623)   ! 
  4624) 
  4625)   use Option_module
  4626) 
  4627)   implicit none
  4628)   
  4629)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4630)   type(global_auxvar_type) :: global_auxvar
  4631)   class(material_auxvar_type) :: material_auxvar
  4632)   type(option_type) :: option
  4633)   type(reaction_type) :: reaction
  4634)   PetscReal :: Res(reaction%ncomp)
  4635)   
  4636)   PetscReal :: v_t
  4637)   
  4638)   ! units = (mol solute/m^3 bulk)*(m^3 bulk)/(sec) = mol/sec
  4639)   ! all residual entries should be in mol/sec
  4640)   v_t = material_auxvar%volume/option%tran_dt
  4641)   Res(1:reaction%naqcomp) = Res(1:reaction%naqcomp) + &
  4642)     rt_auxvar%total_sorb_eq(:)*v_t
  4643) 
  4644) end subroutine RAccumulationSorb
  4645) 
  4646) ! ************************************************************************** !
  4647) 
  4648) subroutine RAccumulationSorbDerivative(rt_auxvar,global_auxvar, &
  4649)                                        material_auxvar,reaction,option,J)
  4650)   ! 
  4651)   ! Computes derivative of non-aqueous portion of
  4652)   ! the accumulation term in residual function
  4653)   ! 
  4654)   ! Author: Glenn Hammond
  4655)   ! Date: 05/26/09
  4656)   ! 
  4657) 
  4658)   use Option_module
  4659) 
  4660)   implicit none
  4661)   
  4662)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4663)   type(global_auxvar_type) :: global_auxvar
  4664)   class(material_auxvar_type) :: material_auxvar
  4665)   type(option_type) :: option
  4666)   type(reaction_type) :: reaction
  4667)   PetscReal :: J(reaction%ncomp,reaction%ncomp)
  4668)   
  4669)   PetscInt :: icomp
  4670)   PetscReal :: v_t
  4671)   
  4672)   ! units = (kg water/m^3 bulk)*(m^3 bulk)/(sec) = kg water/sec
  4673)   ! all Jacobian entries should be in kg water/sec
  4674)   v_t = material_auxvar%volume/option%tran_dt
  4675)   J(1:reaction%naqcomp,1:reaction%naqcomp) = &
  4676)     J(1:reaction%naqcomp,1:reaction%naqcomp) + &
  4677)     rt_auxvar%dtotal_sorb_eq(:,:)*v_t
  4678) 
  4679) end subroutine RAccumulationSorbDerivative
  4680) 
  4681) ! ************************************************************************** !
  4682) 
  4683) subroutine RRadioactiveDecay(Res,Jac,compute_derivative,rt_auxvar, &
  4684)                              global_auxvar,material_auxvar,reaction,option)
  4685)   ! 
  4686)   ! Computes radioactive decay with a single reactant
  4687)   ! (considering both the aqueous and sorbed phases) with
  4688)   ! the possibility of multiple daughter products
  4689)   ! 
  4690)   ! Author: Glenn Hammond
  4691)   ! Date: 09/08/10, 01/07/13
  4692)   ! 
  4693) 
  4694)   use Option_module
  4695)   
  4696)   implicit none
  4697)   
  4698)   type(option_type) :: option
  4699)   type(reaction_type) :: reaction
  4700)   PetscBool :: compute_derivative
  4701)   PetscReal :: Res(reaction%ncomp)
  4702)   PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
  4703)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4704)   type(global_auxvar_type) :: global_auxvar
  4705)   class(material_auxvar_type) :: material_auxvar
  4706)   
  4707)   PetscInt :: i, icomp, jcomp, irxn, ncomp
  4708)   PetscReal :: tempreal, L_water, sum, rate
  4709) 
  4710)   PetscInt, parameter :: iphase = 1
  4711) 
  4712)   L_water = material_auxvar%porosity*global_auxvar%sat(iphase)* &
  4713)             material_auxvar%volume*1.d3 ! L water
  4714) 
  4715)   do irxn = 1, reaction%nradiodecay_rxn ! for each reaction
  4716)     
  4717)     ! units(kf): 1/sec
  4718)     
  4719)     ! we assume only one chemical component involved in decay reaction
  4720)     icomp = reaction%radiodecayforwardspecid(irxn)
  4721) 
  4722)     ! sum total moles of component in aqueous and sorbed phases
  4723)     sum = rt_auxvar%total(icomp,iphase)*L_water
  4724)     if (associated(rt_auxvar%total_sorb_eq)) then
  4725)       sum = sum + rt_auxvar%total_sorb_eq(icomp)*material_auxvar%volume
  4726)     endif
  4727)     
  4728)     rate = sum*reaction%radiodecay_kf(irxn)
  4729)     
  4730)     ! units(Res): mol/sec
  4731)     ncomp = reaction%radiodecayspecid(0,irxn)
  4732)     do i = 1, ncomp
  4733)       icomp = reaction%radiodecayspecid(i,irxn)
  4734)       ! units = mol/sec
  4735)       Res(icomp) = Res(icomp) - reaction%radiodecaystoich(i,irxn)*rate
  4736)     enddo    
  4737) 
  4738)     if (.not. compute_derivative) cycle   
  4739) 
  4740)     tempreal = -1.d0*reaction%radiodecay_kf(irxn)
  4741)     jcomp = reaction%radiodecayforwardspecid(irxn)
  4742)     if (associated(rt_auxvar%dtotal_sorb_eq)) then
  4743)       do i = 1, ncomp
  4744)         icomp = reaction%radiodecayspecid(i,irxn)
  4745)         ! units = (mol/sec)*(kg water/mol) = kg water/sec
  4746)         Jac(icomp,1:reaction%naqcomp) = Jac(icomp,1:reaction%naqcomp) + &
  4747)           tempreal * &
  4748)           reaction%radiodecaystoich(i,irxn) * &
  4749)           (rt_auxvar%aqueous%dtotal(jcomp,1:reaction%naqcomp,iphase)*L_water + &
  4750)            rt_auxvar%dtotal_sorb_eq(jcomp,1:reaction%naqcomp)* &
  4751)            material_auxvar%volume)
  4752)       enddo
  4753)     else ! no sorption
  4754)       do i = 1, ncomp
  4755)         icomp = reaction%radiodecayspecid(i,irxn)
  4756)         ! units = (mol/sec)*(kg water/mol) = kg water/sec
  4757)         Jac(icomp,1:reaction%naqcomp) = Jac(icomp,1:reaction%naqcomp) + &
  4758)           tempreal * &
  4759)           reaction%radiodecaystoich(i,irxn) * &
  4760)           rt_auxvar%aqueous%dtotal(jcomp,1:reaction%naqcomp,iphase)*L_water
  4761)       enddo
  4762)     endif
  4763)     
  4764)   enddo  ! loop over reactions
  4765)     
  4766) end subroutine RRadioactiveDecay
  4767) 
  4768) ! ************************************************************************** !
  4769) 
  4770) subroutine RGeneral(Res,Jac,compute_derivative,rt_auxvar,global_auxvar, &
  4771)                     material_auxvar,reaction,option)
  4772)   ! 
  4773)   ! Computes the general reaction rates
  4774)   ! 
  4775)   ! Author: Glenn Hammond
  4776)   ! Date: 09/08/10
  4777)   ! 
  4778) 
  4779)   use Option_module
  4780)   
  4781)   implicit none
  4782)   
  4783)   type(option_type) :: option
  4784)   type(reaction_type) :: reaction
  4785)   PetscBool :: compute_derivative
  4786)   PetscReal :: Res(reaction%ncomp)
  4787)   PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
  4788)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4789)   type(global_auxvar_type) :: global_auxvar
  4790)   class(material_auxvar_type) :: material_auxvar
  4791)   
  4792)   PetscReal :: ln_conc(reaction%naqcomp)
  4793)   PetscReal :: ln_act(reaction%naqcomp)
  4794)   
  4795)   PetscInt :: i, j, icomp, jcomp, irxn, ncomp
  4796)   PetscReal :: tempreal
  4797)   PetscReal :: kf, kr
  4798)   PetscReal :: Qkf, lnQkf
  4799)   PetscReal :: Qkr, lnQkr
  4800)   PetscReal :: por_den_sat_vol
  4801) 
  4802)   PetscInt, parameter :: iphase = 1
  4803) 
  4804)   ln_conc = log(rt_auxvar%pri_molal)
  4805)   ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
  4806) 
  4807)   do irxn = 1, reaction%ngeneral_rxn ! for each mineral
  4808)     
  4809)     ! units
  4810)     ! for nth-order reaction
  4811)     ! kf/kr = kg^(n-1)/mol^(n-1)-sec
  4812)     ! thus for a 1st-order reaction, kf units = 1/sec
  4813)     
  4814)     kf = reaction%general_kf(irxn)
  4815)     kr = reaction%general_kr(irxn)
  4816) 
  4817)     if (kf > 0.d0) then
  4818)       ! compute ion activity product
  4819)       lnQkf = log(kf)
  4820) 
  4821)   ! currently not accommodating activity of water
  4822)       ! activity of water
  4823)   !    if (reaction%kinmnrlh2oid(irxn) > 0) then
  4824)   !      lnQkf = lnQkf + reaction%generalh2ostoich(irxn)*rt_auxvar%ln_act_h2o
  4825)   !    endif
  4826) 
  4827)       ncomp = reaction%generalforwardspecid(0,irxn)
  4828)       do i = 1, ncomp
  4829)         icomp = reaction%generalforwardspecid(i,irxn)
  4830)         lnQkf = lnQkf + reaction%generalforwardstoich(i,irxn)*ln_act(icomp)
  4831)       enddo
  4832)       Qkf = exp(lnQkf)
  4833)     else
  4834)       Qkf = 0.d0
  4835)     endif
  4836)     
  4837)     if (kr > 0.d0) then
  4838)       lnQkr = log(kr)
  4839) 
  4840)   ! currently not accommodating activity of water
  4841)       ! activity of water
  4842)   !    if (reaction%kinmnrlh2oid(irxn) > 0) then
  4843)   !      lnQkr = lnQkr + reaction%generalh2ostoich(irxn)*rt_auxvar%ln_act_h2o
  4844)   !    endif
  4845) 
  4846)       ncomp = reaction%generalbackwardspecid(0,irxn)
  4847)       do i = 1, ncomp
  4848)         icomp = reaction%generalbackwardspecid(i,irxn)
  4849)         lnQkr = lnQkr + reaction%generalbackwardstoich(i,irxn)*ln_act(icomp)
  4850)       enddo
  4851)       Qkr = exp(lnQkr)
  4852)     else
  4853)       Qkr = 0.d0
  4854)     endif
  4855) 
  4856)     ! Qkf/Qkr units are now mol/kg(water)-sec
  4857) 
  4858)     por_den_sat_vol = material_auxvar%porosity*global_auxvar%den_kg(iphase)* &
  4859)                       global_auxvar%sat(iphase)* &
  4860)                       material_auxvar%volume
  4861) 
  4862)     ncomp = reaction%generalspecid(0,irxn)
  4863)     do i = 1, ncomp
  4864)       icomp = reaction%generalspecid(i,irxn)
  4865)       ! units = mol/sec
  4866)       Res(icomp) = Res(icomp) - reaction%generalstoich(i,irxn)*(Qkf-Qkr)* &
  4867)                                 por_den_sat_vol
  4868)     enddo 
  4869) 
  4870)     if (.not. compute_derivative) cycle   
  4871) 
  4872)     ! calculate derivatives of rate with respect to free
  4873)     ! units = mol/sec
  4874) 
  4875)     if (kf > 0.d0) then
  4876)       ! derivatives with respect to primary species in forward reaction
  4877)       do j = 1, reaction%generalforwardspecid(0,irxn)
  4878)         jcomp = reaction%generalforwardspecid(j,irxn)
  4879)         tempreal = -1.d0*reaction%generalforwardstoich(j,irxn)*exp(lnQkf-ln_conc(jcomp))* &
  4880)                    por_den_sat_vol
  4881)         do i = 1, reaction%generalspecid(0,irxn)
  4882)           icomp = reaction%generalspecid(i,irxn)
  4883)           ! units = (mol/sec)*(kg water/mol) = kg water/sec
  4884)           Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
  4885)                              reaction%generalstoich(i,irxn)*tempreal
  4886)         enddo
  4887)       enddo
  4888)     endif
  4889)     
  4890)     if (kr > 0.d0) then
  4891)       ! derivatives with respect to primary species in forward reaction
  4892)       do j = 1, reaction%generalbackwardspecid(0,irxn)
  4893)         jcomp = reaction%generalbackwardspecid(j,irxn)
  4894)         tempreal = reaction%generalbackwardstoich(j,irxn)*exp(lnQkr-ln_conc(jcomp))* &
  4895)                    por_den_sat_vol
  4896)         do i = 1, reaction%generalspecid(0,irxn)
  4897)           icomp = reaction%generalspecid(i,irxn)
  4898)           ! units = (mol/sec)*(kg water/mol) = kg water/sec
  4899)           Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
  4900)                              reaction%generalstoich(i,irxn)*tempreal
  4901)         enddo
  4902)       enddo
  4903)     endif
  4904) 
  4905)   enddo  ! loop over reactions
  4906)     
  4907) end subroutine RGeneral
  4908) 
  4909) ! ************************************************************************** !
  4910) 
  4911) subroutine RSolve(Res,Jac,conc,update,ncomp,use_log_formulation)
  4912)   ! 
  4913)   ! Computes the kinetic mineral precipitation/dissolution
  4914)   ! rates
  4915)   ! 
  4916)   ! Author: Glenn Hammond
  4917)   ! Date: 09/04/08
  4918)   ! 
  4919) 
  4920)   use Utility_module
  4921)   
  4922)   implicit none
  4923) 
  4924)   PetscInt :: ncomp
  4925)   PetscReal :: Res(ncomp)
  4926)   PetscReal :: Jac(ncomp,ncomp)
  4927)   PetscReal :: update(ncomp)
  4928)   PetscReal :: conc(ncomp)
  4929)   PetscBool :: use_log_formulation
  4930)   
  4931)   PetscInt :: indices(ncomp)
  4932)   PetscReal :: rhs(ncomp)
  4933)   PetscInt :: icomp
  4934)   PetscReal :: norm
  4935) 
  4936)   ! scale Jacobian
  4937)   do icomp = 1, ncomp
  4938)     norm = max(1.d0,maxval(abs(Jac(icomp,:))))
  4939)     norm = 1.d0/norm
  4940)     rhs(icomp) = Res(icomp)*norm
  4941)     Jac(icomp,:) = Jac(icomp,:)*norm
  4942)   enddo
  4943)     
  4944)   if (use_log_formulation) then
  4945)     ! for derivatives with respect to ln conc
  4946)     do icomp = 1, ncomp
  4947)       Jac(:,icomp) = Jac(:,icomp)*conc(icomp)
  4948)     enddo
  4949)   endif
  4950) 
  4951)   call ludcmp(Jac,ncomp,indices,icomp)
  4952)   call lubksb(Jac,ncomp,indices,rhs)
  4953)   
  4954)   update = rhs
  4955) 
  4956) end subroutine RSolve
  4957) 
  4958) ! ************************************************************************** !
  4959) 
  4960) subroutine ReactionComputeKd(icomp,retardation,rt_auxvar,global_auxvar, &
  4961)                              material_auxvar,reaction,option)
  4962)   ! 
  4963)   ! RComputeKd: Computes the Kd for a given chemical component
  4964)   ! 
  4965)   ! Author: Glenn Hammond
  4966)   ! Date: 05/14/09
  4967)   ! 
  4968) 
  4969)   use Option_module
  4970)   
  4971)   implicit none
  4972)   
  4973)   PetscInt :: icomp
  4974)   PetscReal :: retardation
  4975)   type(reactive_transport_auxvar_type) :: rt_auxvar
  4976)   type(global_auxvar_type) :: global_auxvar
  4977)   class(material_auxvar_type) :: material_auxvar
  4978)   type(reaction_type) :: reaction
  4979)   type(option_type) :: option
  4980)   
  4981)   PetscReal :: bulk_vol_to_fluid_vol
  4982)   PetscInt :: i, j, jcomp, irxn, icplx, irate
  4983)   PetscInt, parameter :: iphase = 1
  4984) 
  4985)   retardation = 0.d0
  4986)   if (reaction%nsorb == 0) return
  4987)   
  4988)   bulk_vol_to_fluid_vol = material_auxvar%porosity* &
  4989)                           global_auxvar%sat(iphase)*1000.d0
  4990) 
  4991)   if (associated(rt_auxvar%total_sorb_eq)) then
  4992)     retardation = rt_auxvar%total_sorb_eq(icomp)
  4993)   endif
  4994)   do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
  4995)     do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
  4996)       retardation = retardation + &
  4997)         rt_auxvar%kinmr_total_sorb(icomp,irate,irxn)
  4998)     enddo
  4999)   enddo
  5000) 
  5001)   if (dabs(rt_auxvar%total(icomp,iphase)) > 1.d-40) &
  5002)     retardation = retardation/bulk_vol_to_fluid_vol/ &
  5003)       rt_auxvar%total(icomp,iphase)
  5004) 
  5005) end subroutine ReactionComputeKd
  5006) 
  5007) ! ************************************************************************** !
  5008) 
  5009) subroutine RAge(rt_auxvar,global_auxvar,material_auxvar,option,reaction,Res)
  5010)   ! 
  5011)   ! Computes the ages of the groundwater
  5012)   ! 
  5013)   ! Author: Glenn Hammond
  5014)   ! Date: 02/22/10
  5015)   ! 
  5016) 
  5017)   use Option_module
  5018) 
  5019)   implicit none
  5020) 
  5021)   type(reactive_transport_auxvar_type) :: rt_auxvar
  5022)   type(global_auxvar_type) :: global_auxvar 
  5023)   class(material_auxvar_type) :: material_auxvar
  5024)   type(option_type) :: option
  5025)   type(reaction_type) :: reaction
  5026)   PetscReal :: Res(reaction%ncomp)
  5027)   PetscInt, parameter :: iphase = 1
  5028)   
  5029)   Res(:) = 0.d0
  5030)   if (reaction%calculate_water_age) then
  5031)     Res(reaction%species_idx%water_age_id) = material_auxvar%porosity* &
  5032)                                              global_auxvar%sat(iphase)* &
  5033)                                              1000.d0 * material_auxvar%volume
  5034)   endif
  5035)   if (reaction%calculate_tracer_age) then
  5036)     Res(reaction%species_idx%tracer_age_id) = &
  5037)       -rt_auxvar%total(reaction%species_idx%tracer_aq_id,iphase)* &
  5038)       material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
  5039)       material_auxvar%volume
  5040)   endif
  5041) end subroutine RAge
  5042) 
  5043) ! ************************************************************************** !
  5044) 
  5045) subroutine RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction, &
  5046)                            option)
  5047)   ! 
  5048)   ! Computes secondary variables for each grid cell
  5049)   ! 
  5050)   ! Author: Glenn Hammond
  5051)   ! Date: 08/28/08
  5052)   ! 
  5053) 
  5054)   use Option_module
  5055) 
  5056)   implicit none
  5057)   
  5058)   type(option_type) :: option
  5059)   type(reaction_type) :: reaction
  5060)   type(reactive_transport_auxvar_type) :: rt_auxvar
  5061)   type(global_auxvar_type) :: global_auxvar
  5062)   class(material_auxvar_type) :: material_auxvar
  5063)   
  5064) #if 0  
  5065)   PetscReal :: Res_orig(reaction%ncomp)
  5066)   PetscReal :: Res_pert(reaction%ncomp)
  5067)   PetscInt :: icomp, jcomp
  5068)   PetscReal :: dtotal(reaction%naqcomp,reaction%naqcomp)
  5069)   PetscReal :: dtotalsorb(reaction%naqcomp,reaction%naqcomp)
  5070)   PetscReal :: pert
  5071)   type(reactive_transport_auxvar_type) :: rt_auxvar_pert
  5072) #endif
  5073) 
  5074)   !already set  rt_auxvar%pri_molal = x
  5075)   call RTotal(rt_auxvar,global_auxvar,reaction,option)
  5076)   if (reaction%neqsorb > 0) then
  5077)     call RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
  5078)   endif
  5079) 
  5080) #if 0
  5081) ! numerical check
  5082)   Res_orig = 0.d0
  5083)   dtotal = 0.d0
  5084)   dtotalsorb = 0.d0
  5085)   option%iflag = 0 ! be sure not to allocate mass_balance array
  5086)   call RTAuxVarInit(rt_auxvar_pert,reaction,option)
  5087)   do jcomp = 1, reaction%naqcomp
  5088)     Res_pert = 0.d0
  5089)     call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
  5090)     if (reaction%neqcplx > 0) then
  5091)       rt_auxvar%sec_molal = 0.d0
  5092)     endif
  5093)     if (reaction%ngas > 0) then
  5094)       rt_auxvar%gas_molar = 0.d0
  5095)     endif
  5096)     if (reaction%neqsrfcplxrxn > 0) then
  5097)       rt_auxvar_pert%eqsrfcplx_free_site_conc = 1.d-9
  5098)       rt_auxvar_pert%srfcplx_conc = 0.d0
  5099)     endif
  5100)     if (reaction%neqionxrxn > 0) then
  5101)       rt_auxvar%eqionx_ref_cation_sorbed_conc = 1.d-9
  5102)     endif
  5103)     pert = rt_auxvar_pert%pri_molal(jcomp)*perturbation_tolerance
  5104)     rt_auxvar_pert%pri_molal(jcomp) = rt_auxvar_pert%pri_molal(jcomp) + pert
  5105)     
  5106)     call RTotal(rt_auxvar_pert,global_auxvar,reaction,option)
  5107)     dtotal(:,jcomp) = (rt_auxvar_pert%total(:,1) - rt_auxvar%total(:,1))/pert
  5108)     if (reaction%neqsorb > 0) then
  5109)       call RTotalSorb(rt_auxvar_pert,global_auxvar,reaction,option)
  5110)       dtotalsorb(:,jcomp) = (rt_auxvar_pert%total_sorb_eq(:) - &
  5111)                              rt_auxvar%total_sorb_eq(:))/pert
  5112)     endif
  5113)   enddo
  5114)   do icomp = 1, reaction%naqcomp
  5115)     do jcomp = 1, reaction%naqcomp
  5116)       if (dabs(dtotal(icomp,jcomp)) < 1.d-16) dtotal(icomp,jcomp) = 0.d0
  5117)       if (reaction%neqsorb > 0) then
  5118)         if (dabs(dtotalsorb(icomp,jcomp)) < 1.d-16) dtotalsorb(icomp,jcomp) = 0.d0
  5119)       endif
  5120)     enddo
  5121)   enddo
  5122)   rt_auxvar%aqueous%dtotal(:,:,1) = dtotal
  5123)   if (reaction%neqsorb > 0) rt_auxvar%dtotal_sorb_eq = dtotalsorb
  5124)   call RTAuxVarDestroy(rt_auxvar_pert)
  5125) #endif
  5126)   
  5127) end subroutine RTAuxVarCompute
  5128) 
  5129) ! ************************************************************************** !
  5130) 
  5131) subroutine RTAccumulation(rt_auxvar,global_auxvar,material_auxvar, &
  5132)                           reaction,option,Res)
  5133)   ! 
  5134)   ! Computes aqueous portion of the accumulation term in
  5135)   ! residual function
  5136)   ! 
  5137)   ! Author: Glenn Hammond
  5138)   ! Date: 02/15/08
  5139)   ! 
  5140) 
  5141)   use Option_module
  5142) 
  5143)   implicit none
  5144)   
  5145)   type(reactive_transport_auxvar_type) :: rt_auxvar
  5146)   type(global_auxvar_type) :: global_auxvar
  5147)   class(material_auxvar_type) :: material_auxvar
  5148)   type(option_type) :: option
  5149)   type(reaction_type) :: reaction
  5150)   PetscReal :: Res(reaction%ncomp)
  5151)   
  5152)   PetscInt :: iphase
  5153)   PetscInt :: istart, iend
  5154)   PetscInt :: idof
  5155)   PetscInt :: iimob
  5156)   PetscInt :: icoll
  5157)   PetscInt :: icollcomp
  5158)   PetscInt :: iaqcomp
  5159)   PetscInt :: iimb
  5160)   PetscReal :: psv_t
  5161)   PetscReal :: v_t
  5162)   
  5163)   iphase = 1
  5164)   Res = 0.d0
  5165)   
  5166)   ! units = (mol solute/L water)*(m^3 por/m^3 bulk)*(m^3 water/m^3 por)*
  5167)   !         (m^3 bulk)*(1000L water/m^3 water)/(sec) = mol/sec
  5168)   ! 1000.d0 converts vol from m^3 -> L
  5169)   ! all residual entries should be in mol/sec
  5170)   psv_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
  5171)           material_auxvar%volume / option%tran_dt  
  5172)   istart = 1
  5173)   iend = reaction%naqcomp
  5174)   Res(istart:iend) = psv_t*rt_auxvar%total(:,iphase) 
  5175) 
  5176)   if (reaction%nimcomp > 0) then
  5177)     do iimob = 1, reaction%nimcomp
  5178)       idof = reaction%offset_immobile + iimob
  5179)       Res(idof) = Res(idof) + rt_auxvar%immobile(iimob)* &
  5180)                               material_auxvar%volume/option%tran_dt 
  5181)     enddo
  5182)   endif
  5183)   if (reaction%ncoll > 0) then
  5184)     do icoll = 1, reaction%ncoll
  5185)       idof = reaction%offset_colloid + icoll
  5186)       Res(idof) = psv_t*rt_auxvar%colloid%conc_mob(icoll)
  5187)     enddo
  5188)   endif
  5189)   if (reaction%ncollcomp > 0) then
  5190)     do icollcomp = 1, reaction%ncollcomp
  5191)       iaqcomp = reaction%coll_spec_to_pri_spec(icollcomp)
  5192)       Res(iaqcomp) = Res(iaqcomp) + &
  5193)         psv_t*rt_auxvar%colloid%total_eq_mob(icollcomp)
  5194)     enddo
  5195)   endif
  5196) 
  5197)   ! CO2-specific
  5198)   if (option%iflowmode == G_MODE) return
  5199) ! Add in multiphase, clu 12/29/08
  5200)   do 
  5201)     iphase = iphase + 1
  5202)     if (iphase > option%nphase) exit
  5203) 
  5204) ! super critical CO2 phase
  5205)     if (iphase == 2) then
  5206)       psv_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
  5207)               material_auxvar%volume / option%tran_dt 
  5208)       Res(istart:iend) = Res(istart:iend) + psv_t*rt_auxvar%total(:,iphase) 
  5209)       ! should sum over gas component only need more implementations
  5210)     endif 
  5211) ! add code for other phases here
  5212)   enddo
  5213)   
  5214) end subroutine RTAccumulation
  5215) 
  5216) ! ************************************************************************** !
  5217) 
  5218) subroutine RTAccumulationDerivative(rt_auxvar,global_auxvar, &
  5219)                                     material_auxvar, &
  5220)                                     reaction,option,J)
  5221)   ! 
  5222)   ! Computes derivative of aqueous portion of the
  5223)   ! accumulation term in residual function
  5224)   ! 
  5225)   ! Author: Glenn Hammond
  5226)   ! Date: 02/15/08
  5227)   ! 
  5228) 
  5229)   use Option_module
  5230) 
  5231)   implicit none
  5232)   
  5233)   type(reactive_transport_auxvar_type) :: rt_auxvar
  5234)   type(global_auxvar_type) :: global_auxvar  
  5235)   class(material_auxvar_type) :: material_auxvar
  5236)   type(option_type) :: option
  5237)   type(reaction_type) :: reaction
  5238)   PetscReal :: J(reaction%ncomp,reaction%ncomp)
  5239)   
  5240)   PetscInt :: icomp, iphase
  5241)   PetscInt :: istart, iendaq
  5242)   PetscInt :: idof
  5243)   PetscInt :: icoll
  5244)   PetscInt :: iimob
  5245)   PetscReal :: psvd_t, v_t
  5246) 
  5247)   iphase = 1
  5248)   istart = 1
  5249)   iendaq = reaction%naqcomp 
  5250)   ! units = (m^3 por/m^3 bulk)*(m^3 water/m^3 por)*(m^3 bulk)/(sec)
  5251)   !         *(kg water/L water)*(1000L water/m^3 water) = kg water/sec
  5252)   ! all Jacobian entries should be in kg water/sec
  5253)   J = 0.d0
  5254)   if (associated(rt_auxvar%aqueous%dtotal)) then ! units of dtotal = kg water/L water
  5255)     psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
  5256)              material_auxvar%volume/option%tran_dt
  5257)     J(istart:iendaq,istart:iendaq) = rt_auxvar%aqueous%dtotal(:,:,iphase)*psvd_t
  5258)   else
  5259)     psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)* &
  5260)              global_auxvar%den_kg(iphase)*material_auxvar%volume/ &
  5261)              option%tran_dt ! units of den = kg water/m^3 water
  5262)     do icomp=istart,iendaq
  5263)       J(icomp,icomp) = psvd_t
  5264)     enddo
  5265)   endif
  5266) 
  5267)   if (reaction%nimcomp > 0) then
  5268)     do iimob = 1, reaction%nimcomp
  5269)       idof = reaction%offset_immobile + iimob
  5270)       J(idof,idof) = material_auxvar%volume/option%tran_dt
  5271)     enddo
  5272)   endif
  5273)   if (reaction%ncoll > 0) then
  5274)     do icoll = 1, reaction%ncoll
  5275)       idof = reaction%offset_colloid + icoll
  5276)       ! shouldn't have to sum a this point
  5277)       J(idof,idof) = psvd_t
  5278)     enddo
  5279)   endif
  5280)   if (reaction%ncollcomp > 0) then
  5281)     ! dRj_dCj - mobile
  5282)     J(istart:iendaq,istart:iendaq) = J(istart:iendaq,istart:iendaq) + &
  5283)       rt_auxvar%colloid%dRj_dCj%dtotal(:,:,1)*psvd_t
  5284)     ! need the below
  5285)     ! dRj_dSic
  5286)     ! dRic_dCj                                 
  5287)   endif
  5288) 
  5289)   ! CO2-specific
  5290)   if (option%iflowmode == G_MODE) return
  5291) ! Add in multiphase, clu 12/29/08
  5292)   do
  5293)     iphase = iphase +1 
  5294)     if (iphase > option%nphase) exit
  5295) ! super critical CO2 phase
  5296)     if (iphase == 2) then
  5297)       if (associated(rt_auxvar%aqueous%dtotal)) then
  5298)         psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
  5299)                  material_auxvar%volume/option%tran_dt  
  5300)         J(istart:iendaq,istart:iendaq) = J(istart:iendaq,istart:iendaq) + &
  5301)           rt_auxvar%aqueous%dtotal(:,:,iphase)*psvd_t
  5302)       else
  5303)         psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)* &
  5304)                  global_auxvar%den_kg(iphase)*material_auxvar%volume/ &
  5305)                  option%tran_dt ! units of den = kg water/m^3 water
  5306)         do icomp=istart,iendaq
  5307)           J(icomp,icomp) = J(icomp,icomp) + psvd_t
  5308)         enddo
  5309)       endif   
  5310)     endif
  5311)   enddo
  5312) 
  5313) end subroutine RTAccumulationDerivative
  5314) 
  5315) ! ************************************************************************** !
  5316) 
  5317) subroutine RCalculateCompression(global_auxvar,rt_auxvar,material_auxvar, &
  5318)                                  reaction,option)
  5319)   ! 
  5320)   ! Calculates the compression for the Jacobian block
  5321)   ! 
  5322)   ! Author: Glenn Hammond
  5323)   ! Date: 07/12/10
  5324)   ! 
  5325) 
  5326)   use Option_module
  5327) 
  5328)   implicit none
  5329)   
  5330)   type(reaction_type), pointer :: reaction
  5331)   type(option_type) :: option
  5332) 
  5333)   PetscInt :: dfill(reaction%ncomp,reaction%ncomp)
  5334)   PetscInt :: ofill(reaction%ncomp,reaction%ncomp)
  5335)   PetscReal :: J(reaction%ncomp,reaction%ncomp)
  5336)   PetscReal :: residual(reaction%ncomp)
  5337)   type(reactive_transport_auxvar_type) :: rt_auxvar
  5338)   type(global_auxvar_type) :: global_auxvar
  5339)   class(material_auxvar_type) :: material_auxvar
  5340)   
  5341)   PetscInt :: i, jj
  5342)   PetscReal :: vol = 1.d0
  5343)   PetscReal :: por = 0.25d0
  5344)   PetscReal :: sum
  5345)   
  5346)   dfill = 0
  5347)   ofill = 0
  5348)   J = 0.d0
  5349)   residual = 0.d0
  5350) 
  5351)   call RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
  5352)   call RTAccumulationDerivative(rt_auxvar,global_auxvar, &
  5353)                                 material_auxvar,reaction,option,J)
  5354)     
  5355)   do jj = 1, reaction%ncomp
  5356)     do i = 1, reaction%ncomp
  5357)       if (dabs(J(i,jj)) > 1.d-20) ofill(i,jj) = 1
  5358)     enddo
  5359)   enddo
  5360) 
  5361)   if (reaction%neqsorb > 0) then
  5362)     call RAccumulationSorbDerivative(rt_auxvar,global_auxvar, &
  5363)                                      material_auxvar, &
  5364)                                      reaction,option,J)
  5365)   endif
  5366) 
  5367)   call RReaction(residual,J,PETSC_TRUE,rt_auxvar,global_auxvar, &
  5368)                  material_auxvar,reaction,option)
  5369)  
  5370)   do jj = 1, reaction%ncomp
  5371)     do i = 1, reaction%ncomp
  5372)       if (dabs(J(i,jj)) > 1.d-20) dfill(i,jj) = 1
  5373)     enddo
  5374)   enddo
  5375) 
  5376)   sum = 0.d0
  5377)   do jj = 1, reaction%ncomp
  5378)     do i = 1, reaction%ncomp
  5379)       if (dfill(i,jj) == 1) sum = sum + 1.d0
  5380)     enddo
  5381)   enddo
  5382)   write(option%io_buffer,'(''Diagonal Fill (%): '',f6.2)') &
  5383)     sum / (reaction%ncomp*reaction%ncomp) * 100.d0
  5384)   call printMsg(option)
  5385)  
  5386)  
  5387)   sum = 0.d0
  5388)   do jj = 1, reaction%ncomp
  5389)     do i = 1, reaction%ncomp
  5390)       if (ofill(i,jj) == 1) sum = sum + 1.d0
  5391)     enddo
  5392)   enddo
  5393)   write(option%io_buffer,'(''Off-Diagonal Fill (%): '',f6.2)') &
  5394)     sum / (reaction%ncomp*reaction%ncomp) * 100.d0
  5395)   call printMsg(option)
  5396) 
  5397) end subroutine RCalculateCompression
  5398) 
  5399) ! ************************************************************************** !
  5400) 
  5401) subroutine RUpdateKineticState(rt_auxvar,global_auxvar,material_auxvar, &
  5402)                                reaction,option)
  5403)   ! 
  5404)   ! Updates state variables such as mineral vol frac,
  5405)   ! etc.
  5406)   ! 
  5407)   ! Author: Glenn Hammond
  5408)   ! Date: 01/24/13
  5409)   ! 
  5410) 
  5411)   use Option_module
  5412) 
  5413)   implicit none
  5414)   
  5415)   type(reactive_transport_auxvar_type) :: rt_auxvar
  5416)   type(global_auxvar_type) :: global_auxvar  
  5417)   class(material_auxvar_type) :: material_auxvar
  5418)   type(reaction_type) :: reaction
  5419)   type(option_type) :: option
  5420)   
  5421)   PetscInt :: imnrl, iaqspec, ncomp, icomp
  5422)   PetscInt :: k, irate, irxn, icplx, ncplx, ikinrxn
  5423)   PetscReal :: kdt, one_plus_kdt, k_over_one_plus_kdt
  5424)   PetscReal :: delta_volfrac
  5425)   PetscReal :: res(reaction%ncomp)
  5426)   PetscReal :: jac(reaction%ncomp,reaction%ncomp)
  5427)     
  5428)   ! update mineral volume fractions
  5429)   if (reaction%mineral%nkinmnrl > 0) then
  5430)   
  5431)     ! Updates the mineral rates, res is not needed
  5432)     call RKineticMineral(res,jac,PETSC_FALSE,rt_auxvar,global_auxvar, &
  5433)                          material_auxvar,reaction,option)  
  5434)                     
  5435)     do imnrl = 1, reaction%mineral%nkinmnrl
  5436)       ! rate = mol/m^3/sec
  5437)       ! dvolfrac = m^3 mnrl/m^3 bulk = rate (mol mnrl/m^3 bulk/sec) *
  5438)       !                                mol_vol (m^3 mnrl/mol mnrl)
  5439)       delta_volfrac = rt_auxvar%mnrl_rate(imnrl)* &
  5440)                       reaction%mineral%kinmnrl_molar_vol(imnrl)* &
  5441)                       option%tran_dt
  5442)       rt_auxvar%mnrl_volfrac(imnrl) = rt_auxvar%mnrl_volfrac(imnrl) + &
  5443)                                       delta_volfrac
  5444)       if (rt_auxvar%mnrl_volfrac(imnrl) < 0.d0) &
  5445)         rt_auxvar%mnrl_volfrac(imnrl) = 0.d0
  5446) 
  5447)       ! CO2-specific
  5448)       if (option%iflowmode == MPH_MODE .or. &
  5449)           option%iflowmode == FLASH2_MODE) then
  5450)         ncomp = reaction%mineral%kinmnrlspecid(0,imnrl)
  5451)         do iaqspec = 1, ncomp  
  5452)           icomp = reaction%mineral%kinmnrlspecid(iaqspec,imnrl)
  5453)           if (icomp == reaction%species_idx%co2_aq_id) then
  5454)             global_auxvar%reaction_rate(2) &
  5455)               = global_auxvar%reaction_rate(2) & 
  5456)               + rt_auxvar%mnrl_rate(imnrl)*option%tran_dt &
  5457)               * reaction%mineral%kinmnrlstoich(iaqspec,imnrl) /option%flow_dt
  5458)             cycle
  5459)           endif
  5460)         enddo
  5461) 
  5462) !       water rate
  5463)         if (reaction%mineral%kinmnrlh2ostoich(imnrl) /= 0) then
  5464)           global_auxvar%reaction_rate(1) &
  5465)             = global_auxvar%reaction_rate(1) &
  5466)             + rt_auxvar%mnrl_rate(imnrl)*option%tran_dt &
  5467)             * reaction%mineral%kinmnrlh2ostoich(imnrl) /option%flow_dt
  5468)         endif
  5469)       endif
  5470)     enddo
  5471)   endif
  5472) 
  5473)   ! update multirate sorption concentrations 
  5474) ! WARNING: below assumes site concentration multiplicative factor
  5475)   if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then 
  5476)     do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
  5477)       do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
  5478)         kdt = reaction%surface_complexation%kinmr_rate(irate,irxn) * &
  5479)               option%tran_dt 
  5480)         one_plus_kdt = 1.d0 + kdt 
  5481)         k_over_one_plus_kdt = &
  5482)           reaction%surface_complexation%kinmr_rate(irate,irxn)/one_plus_kdt
  5483)         rt_auxvar%kinmr_total_sorb(:,irate,irxn) = & 
  5484)           (rt_auxvar%kinmr_total_sorb(:,irate,irxn) + & 
  5485)           kdt * reaction%surface_complexation%kinmr_frac(irate,irxn) * &
  5486)           rt_auxvar%kinmr_total_sorb(:,0,irxn))/one_plus_kdt
  5487)       enddo
  5488)     enddo
  5489)   endif
  5490) 
  5491)   ! update kinetic sorption concentrations
  5492)   if (reaction%surface_complexation%nkinsrfcplxrxn > 0) then
  5493)     do ikinrxn = 1, reaction%surface_complexation%nkinsrfcplxrxn
  5494)       irxn = reaction%surface_complexation%&
  5495)                 kinsrfcplxrxn_to_srfcplxrxn(ikinrxn)
  5496)       ncplx = reaction%surface_complexation%srfcplxrxn_to_complex(0,irxn)
  5497)       do k = 1, ncplx ! ncplx in rxn
  5498)         icplx = reaction%surface_complexation%srfcplxrxn_to_complex(k,irxn)
  5499)         rt_auxvar%kinsrfcplx_conc(icplx,ikinrxn) = &
  5500)           rt_auxvar%kinsrfcplx_conc_kp1(icplx,ikinrxn)
  5501)       enddo
  5502)     enddo
  5503)   endif  
  5504) 
  5505) end subroutine RUpdateKineticState
  5506) 
  5507) ! ************************************************************************** !
  5508) 
  5509) subroutine RUpdateTempDependentCoefs(global_auxvar,reaction, &
  5510)                                      update_mnrl,option)
  5511)   ! 
  5512)   ! Updates temperature dependent coefficients for
  5513)   ! anisothermal simulations
  5514)   ! 
  5515)   ! Author: Glenn Hammond
  5516)   ! Date: 01/25/13
  5517)   ! 
  5518) 
  5519)   use Option_module
  5520) 
  5521)   implicit none
  5522)   
  5523)   type(global_auxvar_type) :: global_auxvar  
  5524)   type(reaction_type) :: reaction
  5525)   PetscBool :: update_mnrl
  5526)   type(option_type) :: option
  5527)   
  5528)   PetscReal :: temp
  5529)   PetscReal :: pres
  5530)   
  5531)   PetscInt, parameter :: iphase = 1
  5532)   
  5533)   if (.not.reaction%use_geothermal_hpt)then
  5534)     temp = global_auxvar%temp
  5535)     pres = 0.d0
  5536)     if (associated(reaction%eqcplx_logKcoef)) then
  5537)       call ReactionInterpolateLogK(reaction%eqcplx_logKcoef, &
  5538)                                     reaction%eqcplx_logK, &
  5539)                                     temp, &
  5540)                                     reaction%neqcplx)
  5541)     endif
  5542)     if (associated(reaction%eqgas_logKcoef)) then
  5543)       call ReactionInterpolateLogK(reaction%eqgas_logKcoef, &
  5544)                                     reaction%eqgas_logK, &
  5545)                                     temp, &
  5546)                                     reaction%ngas)
  5547)     endif
  5548)     call MineralUpdateTempDepCoefs(temp,pres,reaction%mineral, &
  5549)                                    reaction%use_geothermal_hpt, &
  5550)                                    update_mnrl, &
  5551)                                    option)
  5552)     if (associated(reaction%surface_complexation%srfcplx_logKcoef)) then
  5553)       call ReactionInterpolateLogK(reaction%surface_complexation% &
  5554)                                       srfcplx_logKcoef, &
  5555)                                 reaction%surface_complexation%srfcplx_logK, &
  5556)                                 temp, &
  5557)                                 reaction%surface_complexation%nsrfcplx)      
  5558)     endif
  5559)   else ! high pressure and temperature
  5560)     temp = global_auxvar%temp
  5561)     pres = global_auxvar%pres(iphase)
  5562)     if (associated(reaction%eqcplx_logKcoef)) then
  5563)       call ReactionInterpolateLogK_hpt(reaction%eqcplx_logKcoef, &
  5564)                                        reaction%eqcplx_logK, &
  5565)                                        temp, &
  5566)                                        pres, &
  5567)                                        reaction%neqcplx)
  5568)     endif
  5569)     if (associated(reaction%eqgas_logKcoef)) then
  5570)       call ReactionInterpolateLogK_hpt(reaction%eqgas_logKcoef, &
  5571)                                        reaction%eqgas_logK, &
  5572)                                        temp, &
  5573)                                        pres, &
  5574)                                        reaction%ngas)
  5575)     endif   
  5576)     call MineralUpdateTempDepCoefs(temp,pres,reaction%mineral, &
  5577)                                    reaction%use_geothermal_hpt, &
  5578)                                    update_mnrl, &
  5579)                                    option)    
  5580)     if (associated(reaction%surface_complexation%srfcplx_logKcoef)) then
  5581)       option%io_buffer = 'Temperature dependent surface complexation ' // &
  5582)         'coefficients not yet function for high pressure/temperature.'
  5583)       call printMsg(option)   
  5584)     endif
  5585)   endif 
  5586)   
  5587) end subroutine RUpdateTempDependentCoefs
  5588) 
  5589) ! ************************************************************************** !
  5590) 
  5591) subroutine RTPrintAuxVar(rt_auxvar,reaction,option)
  5592)   ! 
  5593)   ! PrintRTAuxVar: Prints data from RTAuxVar object
  5594)   ! 
  5595)   ! Author: Glenn Hammond
  5596)   ! Date: 05/18/2011
  5597)   ! 
  5598) 
  5599)   use Option_module
  5600) 
  5601)   implicit none
  5602)   
  5603)   type(reactive_transport_auxvar_type) :: rt_auxvar
  5604)   type(reaction_type) :: reaction
  5605)   type(option_type) :: option
  5606) 
  5607)   character(len=MAXSTRINGLENGTH) :: string
  5608)   PetscInt :: i
  5609)   
  5610)   10 format(a20,':',10es19.11)
  5611)   20 format(a20,':',a20)
  5612)   30 format(/)
  5613) 
  5614)   if (OptionPrintToScreen(option)) write(*,30)
  5615)   if (OptionPrintToFile(option)) write(option%fid_out,30)
  5616) 
  5617)   if (OptionPrintToScreen(option)) &
  5618)     write(*,20) 'Primary', 'free molal., total molar., act. coef.'
  5619)   if (OptionPrintToFile(option)) &
  5620)     write(option%fid_out,20) 'Primary', 'free molal., total molar., act. coef.'
  5621)   do i = 1, reaction%naqcomp  
  5622)     if (OptionPrintToScreen(option)) &
  5623)       write(*,10) reaction%primary_species_names(i), &
  5624)         rt_auxvar%pri_molal(i), &
  5625)         rt_auxvar%total(i,1), &
  5626)         rt_auxvar%pri_act_coef(i)
  5627)     if (OptionPrintToFile(option)) &
  5628)       write(option%fid_out,10) reaction%primary_species_names(i), &
  5629)         rt_auxvar%pri_molal(i), &
  5630)         rt_auxvar%total(i,1), &
  5631)         rt_auxvar%pri_act_coef(i)
  5632)   enddo
  5633)   if (OptionPrintToScreen(option)) write(*,30)
  5634)   if (OptionPrintToFile(option)) write(option%fid_out,30)
  5635) 
  5636)   if (reaction%neqcplx > 0) then
  5637)     if (OptionPrintToScreen(option)) &
  5638)       write(*,20) 'Secondary Complex', 'molal., act. coef.'
  5639)     if (OptionPrintToFile(option)) &
  5640)       write(option%fid_out,20) 'Secondary Complex', 'molal., act. coef.'
  5641)     do i = 1, reaction%neqcplx  
  5642)       if (OptionPrintToScreen(option)) &
  5643)         write(*,10) reaction%secondary_species_names(i), &
  5644)           rt_auxvar%sec_molal(i), &
  5645)           rt_auxvar%sec_act_coef(i)
  5646)       if (OptionPrintToFile(option)) &
  5647)         write(option%fid_out,10) reaction%secondary_species_names(i), &
  5648)           rt_auxvar%sec_molal(i), &
  5649)           rt_auxvar%sec_act_coef(i)
  5650)     enddo
  5651)     if (OptionPrintToScreen(option)) write(*,30)
  5652)     if (OptionPrintToFile(option)) write(option%fid_out,30)
  5653)   endif
  5654) 
  5655)   if (reaction%neqsorb > 0) then  
  5656)     if (OptionPrintToScreen(option)) &
  5657)       write(*,20) 'Total Sorbed EQ', 'mol/m^3'
  5658)     if (OptionPrintToFile(option)) &
  5659)       write(option%fid_out,20) 'Total Sorbed EQ', 'mol/m^3'
  5660)     do i = 1, reaction%naqcomp  
  5661)       if (OptionPrintToScreen(option)) &
  5662)         write(*,10) reaction%primary_species_names(i), rt_auxvar%total_sorb_eq(i)
  5663)       if (OptionPrintToFile(option)) &
  5664)         write(option%fid_out,10) reaction%primary_species_names(i), &
  5665)           rt_auxvar%total_sorb_eq(i)
  5666)     enddo
  5667)     if (OptionPrintToScreen(option)) write(*,30)
  5668)     if (OptionPrintToFile(option)) write(option%fid_out,30)
  5669)   endif    
  5670) 
  5671) #if 0  
  5672)   if (reaction%surface_complexation%neqsrfcplx > 0) then
  5673)     if (OptionPrintToScreen(option)) &
  5674)       write(*,20) 'EQ Surface Complex Conc.', 'mol/m^3'
  5675)     if (OptionPrintToFile(option)) &
  5676)       write(option%fid_out,20) 'EQ Surface Complex Conc.', 'mol/m^3'
  5677)     do i = 1, reaction%surface_complexation%neqsrfcplx
  5678)       if (OptionPrintToScreen(option)) &
  5679)         write(*,10) reaction%eqsrfcplx_names(i), rt_auxvar%eqsrfcplx_conc(i)
  5680)       if (OptionPrintToFile(option)) &
  5681)         write(option%fid_out,10) reaction%eqsrfcplx_names(i), &
  5682)           rt_auxvar%eqsrfcplx_conc(i)
  5683)     enddo
  5684)     if (OptionPrintToScreen(option)) write(*,30)
  5685)     if (OptionPrintToFile(option)) write(option%fid_out,30)
  5686)   endif
  5687) #endif  
  5688) 
  5689)   if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
  5690)   endif
  5691) 
  5692)   if (reaction%surface_complexation%nkinsrfcplxrxn > 0) then
  5693)   endif
  5694)   
  5695)   if (reaction%neqionxrxn > 0) then
  5696)   endif
  5697)   
  5698)   if (reaction%mineral%nkinmnrl > 0) then
  5699)     if (OptionPrintToScreen(option)) &
  5700)       write(*,20) 'Kinetic Minerals', 'vol frac, area, rate'
  5701)     if (OptionPrintToFile(option)) &
  5702)       write(option%fid_out,20) 'Kinetic Minerals', 'vol frac, area, rate'
  5703)     do i = 1, reaction%mineral%nkinmnrl
  5704)       if (OptionPrintToScreen(option)) &
  5705)         write(*,10) reaction%mineral%kinmnrl_names(i), &
  5706)           rt_auxvar%mnrl_volfrac(i), &
  5707)           rt_auxvar%mnrl_area(i), &
  5708)           rt_auxvar%mnrl_rate(i)
  5709) 
  5710)       if (OptionPrintToFile(option)) &
  5711)         write(option%fid_out,10) reaction%mineral%kinmnrl_names(i), &
  5712)           rt_auxvar%mnrl_volfrac(i), &
  5713)           rt_auxvar%mnrl_area(i), &
  5714)           rt_auxvar%mnrl_rate(i)
  5715)     enddo
  5716)     if (OptionPrintToScreen(option)) write(*,30)
  5717)     if (OptionPrintToFile(option)) write(option%fid_out,30)
  5718)   endif
  5719) 
  5720) end subroutine RTPrintAuxVar
  5721) 
  5722) end module Reaction_module

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