reaction_database_hpt.F90       coverage:  0.00 %func     0.00 %block


     1) module Reaction_Database_hpt_module
     2) 
     3)   use Reaction_module
     4)   use Reaction_Aux_module
     5)   use Reaction_Database_module
     6)   use Reaction_Database_Aux_module
     7)   use Reaction_Surface_Complexation_Aux_module
     8)   use Reaction_Mineral_Aux_module
     9) 
    10)   use PFLOTRAN_Constants_module
    11) 
    12)   implicit none
    13)   
    14)   private
    15)   
    16) #include "petsc/finclude/petscsys.h"
    17) 
    18)   public :: DatabaseRead_hpt, BasisInit_hpt
    19)             
    20) contains
    21) 
    22) ! ************************************************************************** !
    23) 
    24) subroutine DatabaseRead_hpt(reaction,option)
    25)   ! 
    26)   ! Collects parameters from geochemical database
    27)   ! 
    28)   ! Author: ???
    29)   ! Date: ???
    30)   ! 
    31) 
    32)   use Option_module
    33)   use Input_Aux_module
    34)   use String_module
    35)   
    36)   implicit none
    37)   
    38)   type(reaction_type) :: reaction
    39)   type(option_type) :: option
    40)   
    41)   type(aq_species_type), pointer :: cur_aq_spec, cur_aq_spec2
    42)   type(gas_species_type), pointer :: cur_gas_spec, cur_gas_spec2
    43)   type(mineral_rxn_type), pointer :: cur_mineral, cur_mineral2
    44)   type(colloid_type), pointer :: cur_colloid
    45)   type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
    46)   type(surface_complex_type), pointer :: cur_srfcplx, cur_srfcplx2
    47)   
    48)   character(len=MAXSTRINGLENGTH) :: string
    49)   character(len=MAXWORDLENGTH) :: name
    50)   character(len=MAXWORDLENGTH) :: null_name
    51)   
    52)   PetscBool :: flag, found
    53)   PetscInt :: ispec, itemp, i
    54)   PetscReal :: stoich
    55)   PetscReal :: temp_real
    56)   type(input_type), pointer :: input
    57)   PetscInt :: iostat
    58)   PetscInt :: num_nulls
    59) !TODO(geh)
    60) #if 0  
    61)   ! negate ids for use as flags
    62)   cur_aq_spec => reaction%primary_species_list
    63)   do
    64)     if (.not.associated(cur_aq_spec)) exit
    65)     cur_aq_spec%id = -abs(cur_aq_spec%id)
    66)     cur_aq_spec => cur_aq_spec%next
    67)   enddo
    68)   cur_aq_spec => reaction%secondary_species_list
    69)   do
    70)     if (.not.associated(cur_aq_spec)) exit
    71)     cur_aq_spec%id = -abs(cur_aq_spec%id)
    72)     cur_aq_spec => cur_aq_spec%next
    73)   enddo  
    74)   cur_gas_spec => reaction%gas_species_list
    75)   do
    76)     if (.not.associated(cur_gas_spec)) exit
    77)     cur_gas_spec%id = -abs(cur_gas_spec%id)
    78)     cur_gas_spec => cur_gas_spec%next
    79)   enddo  
    80)   cur_mineral => reaction%mineral_list
    81)   do
    82)     if (.not.associated(cur_mineral)) exit
    83)     cur_mineral%id = -abs(cur_mineral%id)
    84)     cur_mineral => cur_mineral%next
    85)   enddo
    86)   cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
    87)   do
    88)     if (.not.associated(cur_srfcplx_rxn)) exit
    89)     cur_srfcplx => cur_srfcplx_rxn%complex_list
    90)     do  
    91)       if (.not.associated(cur_srfcplx)) exit
    92)       cur_srfcplx%id = -abs(cur_srfcplx%id)
    93)       cur_srfcplx => cur_srfcplx%next
    94)     enddo
    95)     cur_srfcplx_rxn => cur_srfcplx_rxn%next
    96)   enddo  
    97)   
    98)   if (len_trim(reaction%database_filename) < 2) then
    99)     option%io_buffer = 'Database filename not included in input deck.'
   100)     call printErrMsg(option)
   101)   endif
   102)   input => InputCreate(IUNIT_TEMP,reaction%database_filename,option)
   103) 
   104)   ! read temperatures
   105)   call InputReadPflotranString(input,option)
   106)   ! remove comment
   107)   call InputReadQuotedWord(input,option,name,PETSC_TRUE)
   108)   call InputReadInt(input,option,reaction%num_dbase_parameters)
   109)   call InputErrorMsg(input,option,'Number of database parameters','DATABASE')  
   110)  ! allocate(reaction%dbase_temperatures(reaction%num_dbase_temperatures))
   111)  ! reaction%dbase_temperatures = 0.d0  
   112) !  do itemp = 1, reaction%num_dbase_temperatures
   113) !    call InputReadDouble(input,option,reaction%dbase_temperatures(itemp))
   114) !    call InputErrorMsg(input,option,'Database temperatures','DATABASE')            
   115) !  enddo
   116) 
   117)   num_nulls = 0
   118)   null_name = 'null'
   119)   do ! loop over every entry in the database
   120)     call InputReadPflotranString(input,option)
   121)     call InputReadStringErrorMsg(input,option,'DATABASE')
   122) 
   123)     call InputReadQuotedWord(input,option,name,PETSC_TRUE)
   124)     ! 'null's mark the end of a section in the database.  We count these 
   125)     ! to determine which species we are reading.
   126)     ! --
   127)     ! primary species
   128)     ! null
   129)     ! aq complexes
   130)     ! null
   131)     ! gases
   132)     ! null
   133)     ! minerals
   134)     ! null
   135)     ! surface complexes
   136)     ! null
   137)     ! --
   138)     
   139)     if (StringCompare(name,null_name,MAXWORDLENGTH)) then
   140)       num_nulls = num_nulls + 1
   141)       if (num_nulls >= 5) exit
   142)       cycle
   143)     endif
   144)     
   145)     select case(num_nulls)
   146)       case(0,1) ! primary and secondary aq species and colloids
   147)         cur_aq_spec => reaction%primary_species_list
   148)         found = PETSC_FALSE
   149)         do
   150)           if (found .or. .not.associated(cur_aq_spec)) exit
   151)           if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
   152)             found = PETSC_TRUE
   153)             ! change negative id to positive, indicating it was found in database
   154)             cur_aq_spec%id = abs(cur_aq_spec%id)
   155)             exit
   156)           endif
   157)           cur_aq_spec => cur_aq_spec%next
   158)         enddo
   159)         if (.not.found) cur_aq_spec => reaction%secondary_species_list
   160)         do
   161)           if (found .or. .not.associated(cur_aq_spec)) exit
   162)           if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
   163)             found = PETSC_TRUE          
   164)           ! change negative id to positive, indicating it was found in database
   165)             cur_aq_spec%id = abs(cur_aq_spec%id)
   166)             exit
   167)           endif
   168)           cur_aq_spec => cur_aq_spec%next
   169)         enddo
   170)         ! check if a colloid
   171)         if (.not.found) cur_colloid => reaction%colloid_list
   172)         do
   173)           if (found .or. .not.associated(cur_colloid)) exit
   174)           if (StringCompare(name,cur_colloid%name,MAXWORDLENGTH)) then
   175)             found = PETSC_TRUE          
   176)           ! change negative id to positive, indicating it was found in database
   177)             cur_colloid%id = abs(cur_colloid%id)
   178) 
   179)             ! skip the Debye-Huckel ion size parameter (a0)
   180)             call InputReadDouble(input,option,temp_real)
   181)             call InputErrorMsg(input,option,'Colloid skip a0','DATABASE')            
   182)             ! skipo the valence
   183)             call InputReadDouble(input,option,temp_real)
   184)             call InputErrorMsg(input,option,'Colloid skip Z','DATABASE')            
   185)             ! read the molar weight
   186)             call InputReadDouble(input,option,cur_colloid%molar_weight)
   187)             call InputErrorMsg(input,option,'Colloid molar weight','DATABASE')
   188)             
   189)             cycle ! avoid the aqueous species parameters below
   190)           endif
   191)           cur_colloid => cur_colloid%next
   192)         enddo
   193)         
   194)         if (.not.found) cycle ! go to next line in database
   195)         
   196)         if (num_nulls > 0) then ! secondary species in database
   197)           ! create aqueous equilibrium reaction
   198)           if (.not.associated(cur_aq_spec%dbaserxn)) &
   199)             cur_aq_spec%dbaserxn => DatabaseRxnCreate()
   200)           ! read the number of primary species in secondary rxn
   201)           call InputReadInt(input,option,cur_aq_spec%dbaserxn%nspec)
   202)           call InputErrorMsg(input,option,'Number of species in aqueous complex', &
   203)                           'DATABASE')  
   204)           ! allocate arrays for rxn
   205)           allocate(cur_aq_spec%dbaserxn%spec_name(cur_aq_spec%dbaserxn%nspec))
   206)           cur_aq_spec%dbaserxn%spec_name = ''
   207)           allocate(cur_aq_spec%dbaserxn%stoich(cur_aq_spec%dbaserxn%nspec))
   208)           cur_aq_spec%dbaserxn%stoich = 0.d0
   209)           allocate(cur_aq_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
   210)           cur_aq_spec%dbaserxn%logKCoeff_hpt = 0.d0
   211)           ! read in species and stoichiometries
   212)           do ispec = 1, cur_aq_spec%dbaserxn%nspec
   213)             call InputReadDouble(input,option,cur_aq_spec%dbaserxn%stoich(ispec))
   214)             call InputErrorMsg(input,option,'EQRXN species stoichiometry','DATABASE')            
   215)             call InputReadQuotedWord(input,option,cur_aq_spec%dbaserxn%spec_name(ispec),PETSC_TRUE)
   216)             call InputErrorMsg(input,option,'EQRXN species name','DATABASE')            
   217)           enddo
   218)           do itemp = 1, reaction%num_dbase_parameters
   219)             call InputReadDouble(input,option,cur_aq_spec%dbaserxn%logKCoeff_hpt(itemp))
   220)             call InputErrorMsg(input,option,'EQRXN logKs Coeff','DATABASE')            
   221)           enddo
   222)         endif
   223)         ! read the Debye-Huckel ion size parameter (a0)
   224)         call InputReadDouble(input,option,cur_aq_spec%a0)
   225)         call InputErrorMsg(input,option,'AQ Species a0','DATABASE')            
   226)         ! read the valence
   227)         call InputReadDouble(input,option,cur_aq_spec%Z)
   228)         call InputErrorMsg(input,option,'AQ Species Z','DATABASE')            
   229)         ! read the molar weight
   230)         call InputReadDouble(input,option,cur_aq_spec%molar_weight)
   231)         call InputErrorMsg(input,option,'AQ Species molar weight','DATABASE')
   232)         
   233)                     
   234)       case(2) ! gas species
   235)         cur_gas_spec => reaction%gas_species_list
   236)         if (.not.associated(cur_gas_spec)) cycle
   237)         found = PETSC_FALSE
   238)         do
   239)           if (found .or. .not.associated(cur_gas_spec)) exit
   240)           if (StringCompare(name,cur_gas_spec%name,MAXWORDLENGTH)) then
   241)             found = PETSC_TRUE          
   242)           ! change negative id to positive, indicating it was found in database
   243)             cur_gas_spec%id = abs(cur_gas_spec%id)
   244)             exit
   245)           endif
   246)           cur_gas_spec => cur_gas_spec%next
   247)         enddo
   248)         
   249)         if (.not.found) cycle ! go to next line in database
   250)         
   251)         ! read the molar volume
   252)         call InputReadDouble(input,option,cur_gas_spec%molar_volume)
   253)         call InputErrorMsg(input,option,'GAS molar volume','DATABASE')
   254)         ! convert from cm^3/mol to m^3/mol
   255)         cur_gas_spec%molar_volume = cur_gas_spec%molar_volume*1.d-6
   256)         ! create aqueous equilibrium reaction
   257)         if (.not.associated(cur_gas_spec%dbaserxn)) &
   258)           cur_gas_spec%dbaserxn => DatabaseRxnCreate()
   259)         ! read the number of aqueous species in secondary rxn
   260)         call InputReadInt(input,option,cur_gas_spec%dbaserxn%nspec)
   261)         call InputErrorMsg(input,option,'Number of species in gas reaction', &
   262)                         'DATABASE')  
   263)         ! allocate arrays for rxn
   264)         allocate(cur_gas_spec%dbaserxn%spec_name(cur_gas_spec%dbaserxn%nspec))
   265)         cur_gas_spec%dbaserxn%spec_name = ''
   266)         allocate(cur_gas_spec%dbaserxn%stoich(cur_gas_spec%dbaserxn%nspec))
   267)         cur_gas_spec%dbaserxn%stoich = 0.d0
   268)         allocate(cur_gas_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
   269)         cur_gas_spec%dbaserxn%logKCoeff_hpt = 0.d0
   270)         ! read in species and stoichiometries
   271)         do ispec = 1, cur_gas_spec%dbaserxn%nspec
   272)           call InputReadDouble(input,option,cur_gas_spec%dbaserxn%stoich(ispec))
   273)           call InputErrorMsg(input,option,'GAS species stoichiometry','DATABASE')            
   274)           call InputReadQuotedWord(input,option,cur_gas_spec%dbaserxn%spec_name(ispec),PETSC_TRUE)
   275)           call InputErrorMsg(input,option,'GAS species name','DATABASE')            
   276)         enddo
   277)         do itemp = 1, reaction%num_dbase_parameters
   278)           call InputReadDouble(input,option,cur_gas_spec%dbaserxn%logKCoeff_hpt(itemp))
   279)           call InputErrorMsg(input,option,'GAS logKs Coeff','DATABASE')            
   280)         enddo
   281)         ! read the molar weight
   282)         call InputReadDouble(input,option,cur_gas_spec%molar_weight)
   283)         call InputErrorMsg(input,option,'GAS molar weight','DATABASE')     
   284)         
   285)                
   286)       case(3) ! minerals
   287)         cur_mineral => reaction%mineral_list
   288)         if (.not.associated(cur_mineral)) cycle
   289)         found = PETSC_FALSE
   290)         do
   291)           if (found .or. .not.associated(cur_mineral)) exit
   292)           if (StringCompare(name,cur_mineral%name,MAXWORDLENGTH)) then
   293)             found = PETSC_TRUE          
   294)           ! change negative id to positive, indicating it was found in database
   295)             cur_mineral%id = abs(cur_mineral%id)
   296)             exit
   297)           endif
   298)           cur_mineral => cur_mineral%next
   299)         enddo
   300)         
   301)         if (.not.found) cycle ! go to next line in database
   302)         
   303)         ! read the molar volume
   304)         call InputReadDouble(input,option,cur_mineral%molar_volume)
   305)         call InputErrorMsg(input,option,'MINERAL molar volume','DATABASE')            
   306)         ! convert from cm^3/mol to m^3/mol
   307)         cur_mineral%molar_volume = cur_mineral%molar_volume*1.d-6
   308)         ! create mineral reaction
   309)         if (.not.associated(cur_mineral%tstrxn)) then
   310)           cur_mineral%tstrxn => TransitionStateTheoryRxnCreate()
   311)         endif
   312)         ! read the number of aqueous species in mineral rxn
   313)         cur_mineral%dbaserxn => DatabaseRxnCreate()
   314)         call InputReadInt(input,option,cur_mineral%dbaserxn%nspec)
   315)         call InputErrorMsg(input,option,'Number of species in mineral reaction', &
   316)                         'DATABASE')  
   317)         ! allocate arrays for rxn
   318)         allocate(cur_mineral%dbaserxn%spec_name(cur_mineral%dbaserxn%nspec))
   319)         cur_mineral%dbaserxn%spec_name = ''
   320)         allocate(cur_mineral%dbaserxn%stoich(cur_mineral%dbaserxn%nspec))
   321)         cur_mineral%dbaserxn%stoich = 0.d0
   322)         allocate(cur_mineral%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
   323)         cur_mineral%dbaserxn%logKCoeff_hpt = 0.d0
   324)         ! read in species and stoichiometries
   325)         do ispec = 1, cur_mineral%dbaserxn%nspec
   326)           call InputReadDouble(input,option,cur_mineral%dbaserxn%stoich(ispec))
   327)           call InputErrorMsg(input,option,'MINERAL species stoichiometry','DATABASE')            
   328)           call InputReadQuotedWord(input,option,cur_mineral%dbaserxn% &
   329)                                    spec_name(ispec),PETSC_TRUE)
   330)           call InputErrorMsg(input,option,'MINERAL species name','DATABASE')            
   331)         enddo
   332)         do itemp = 1, reaction%num_dbase_parameters
   333)           call InputReadDouble(input,option,cur_mineral%dbaserxn%logKCoeff_hpt(itemp))
   334)           call InputErrorMsg(input,option,'MINERAL logKs','DATABASE')            
   335)         enddo
   336)         ! read the molar weight
   337)         call InputReadDouble(input,option,cur_mineral%molar_weight)
   338)         call InputErrorMsg(input,option,'MINERAL molar weight','DATABASE')            
   339)         
   340)         
   341)       case(4) ! surface complexes
   342)         cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
   343)         found = PETSC_FALSE
   344)         do
   345)           if (.not.associated(cur_srfcplx_rxn)) exit
   346)           cur_srfcplx => cur_srfcplx_rxn%complex_list
   347)           do
   348)             if (.not.associated(cur_srfcplx)) exit
   349)             if (StringCompare(name,cur_srfcplx%name,MAXWORDLENGTH)) then
   350)               found = PETSC_TRUE          
   351)             ! change negative id to positive, indicating it was found in database
   352)               cur_srfcplx%id = abs(cur_srfcplx%id)
   353)               exit
   354)             endif
   355)             cur_srfcplx => cur_srfcplx%next
   356)           enddo
   357)           if (found) exit
   358)           cur_srfcplx_rxn => cur_srfcplx_rxn%next
   359)         enddo
   360)         
   361)         if (.not.found) cycle ! go to next line in database
   362) 
   363)         if (.not.associated(cur_srfcplx%dbaserxn)) &
   364)           cur_srfcplx%dbaserxn => DatabaseRxnCreate()
   365)             
   366)         ! read the number of aqueous species in surface complexation rxn
   367)         call InputReadInt(input,option,cur_srfcplx%dbaserxn%nspec)
   368)         call InputErrorMsg(input,option,'Number of species in surface complexation reaction', &
   369)                         'DATABASE')  
   370)         ! decrement number of species since free site will not be included
   371)         cur_srfcplx%dbaserxn%nspec = cur_srfcplx%dbaserxn%nspec - 1
   372)         ! allocate arrays for rxn
   373)         allocate(cur_srfcplx%dbaserxn%spec_name(cur_srfcplx%dbaserxn%nspec))
   374)         cur_srfcplx%dbaserxn%spec_name = ''
   375)         allocate(cur_srfcplx%dbaserxn%stoich(cur_srfcplx%dbaserxn%nspec))
   376)         cur_srfcplx%dbaserxn%stoich = 0.d0
   377)         allocate(cur_srfcplx%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
   378)         cur_srfcplx%dbaserxn%logKCoeff_hpt = 0.d0
   379)         ! read in species and stoichiometries
   380)         ispec = 0
   381)         found = PETSC_FALSE
   382)         do i = 1, cur_srfcplx%dbaserxn%nspec+1 ! recall that nspec was decremented above
   383)           call InputReadDouble(input,option,stoich)
   384)           call InputErrorMsg(input,option,'SURFACE COMPLEX species stoichiometry','DATABASE')            
   385)           call InputReadQuotedWord(input,option,name,PETSC_TRUE)
   386)           call InputErrorMsg(input,option,'SURFACE COMPLEX species name','DATABASE')            
   387)           if (StringCompare(name,cur_srfcplx_rxn%free_site_name,MAXWORDLENGTH)) then
   388)             found = PETSC_TRUE
   389)             cur_srfcplx%free_site_stoich = stoich
   390)           else
   391)             ispec = ispec + 1
   392)             cur_srfcplx%dbaserxn%stoich(ispec) = stoich
   393)             cur_srfcplx%dbaserxn%spec_name(ispec) = name
   394)           endif
   395)         enddo
   396)         if (.not.found) then
   397)           option%io_buffer = 'Free site name: ' // &
   398)                              trim(cur_srfcplx_rxn%free_site_name) // &
   399)                              ' not found in surface complex:' // &
   400)                              trim(cur_srfcplx%name)
   401)           call printErrMsg(option)
   402)         endif
   403)         do itemp = 1, reaction%num_dbase_parameters
   404)           call InputReadDouble(input,option,cur_srfcplx%dbaserxn%logKCoeff_hpt(itemp))
   405)           call InputErrorMsg(input,option,'SURFACE COMPLEX logKs','DATABASE')            
   406)         enddo
   407)         ! read the valence
   408)         call InputReadDouble(input,option,cur_srfcplx%Z)
   409)         call InputErrorMsg(input,option,'Surface Complex Z','DATABASE')            
   410) 
   411)       
   412)     end select
   413)     
   414)   enddo
   415)   
   416)   ! check for duplicate species
   417)   flag = PETSC_FALSE
   418)  
   419)   ! aqueous primary species
   420)   cur_aq_spec => reaction%primary_species_list
   421)   do
   422)     if (.not.associated(cur_aq_spec)) exit
   423)     
   424)     ! aqueous primary species
   425)     cur_aq_spec2 => cur_aq_spec%next
   426)     do
   427)       if (.not.associated(cur_aq_spec2)) exit
   428)       if (cur_aq_spec%id /= cur_aq_spec2%id .and. &
   429)           StringCompare(cur_aq_spec%name, &
   430)                           cur_aq_spec2%name,MAXWORDLENGTH)) then
   431)         flag = PETSC_TRUE
   432)         option%io_buffer = &
   433)                  'Aqueous primary species (' // trim(cur_aq_spec%name) // &
   434)                  ') duplicated in input file.'
   435)         call printMsg(option)                          
   436)       endif
   437)       cur_aq_spec2 => cur_aq_spec2%next
   438)     enddo
   439) 
   440)     cur_aq_spec2 => reaction%secondary_species_list
   441)     do
   442)       if (.not.associated(cur_aq_spec2)) exit
   443)       if (StringCompare(cur_aq_spec%name, &
   444)                           cur_aq_spec2%name,MAXWORDLENGTH)) then
   445)         flag = PETSC_TRUE
   446)         option%io_buffer = 'Aqueous primary species (' // &
   447)                            trim(cur_aq_spec%name) // &
   448)                            ') duplicated as secondary species in input file.'
   449)         call printMsg(option)                          
   450)       endif
   451)       cur_aq_spec2 => cur_aq_spec2%next
   452)     enddo
   453) 
   454)     cur_gas_spec2 => reaction%gas_species_list
   455)     do
   456)       if (.not.associated(cur_gas_spec2)) exit
   457)       if (StringCompare(cur_aq_spec%name, &
   458)                           cur_gas_spec2%name,MAXWORDLENGTH)) then
   459)         flag = PETSC_TRUE
   460)         option%io_buffer = 'Aqueous primary species (' // &
   461)                            trim(cur_aq_spec%name) // &
   462)                            ') duplicated as gas species in input file.'
   463)         call printMsg(option)                          
   464)       endif
   465)       cur_gas_spec2 => cur_gas_spec2%next
   466)     enddo
   467)     cur_aq_spec => cur_aq_spec%next  
   468)   enddo
   469)   
   470)   ! aqueous secondary species
   471)   cur_aq_spec => reaction%secondary_species_list
   472)   do
   473)     if (.not.associated(cur_aq_spec)) exit
   474)     
   475)     ! already checked against primary
   476)     ! aqueous secondary species
   477)     cur_aq_spec2 => cur_aq_spec%next
   478)     do
   479)       if (.not.associated(cur_aq_spec2)) exit
   480)       if (cur_aq_spec%id /= cur_aq_spec2%id .and. &
   481)           StringCompare(cur_aq_spec%name, &
   482)                           cur_aq_spec2%name,MAXWORDLENGTH)) then
   483)         flag = PETSC_TRUE
   484)         option%io_buffer = 'Aqueous secondary species (' // &
   485)                            trim(cur_aq_spec%name) // &
   486)                            ') duplicated in input file.'
   487)         call printMsg(option)                          
   488)       endif
   489)       cur_aq_spec2 => cur_aq_spec2%next
   490)     enddo
   491) 
   492)     cur_gas_spec2 => reaction%gas_species_list
   493)     do
   494)       if (.not.associated(cur_gas_spec2)) exit
   495)       if (StringCompare(cur_aq_spec%name, &
   496)                           cur_gas_spec2%name,MAXWORDLENGTH)) then
   497)         flag = PETSC_TRUE
   498)         option%io_buffer = 'Aqueous secondary species (' // &
   499)                            trim(cur_aq_spec%name) // &
   500)                            ') duplicated as gas species in input file.'
   501)         call printMsg(option)                          
   502)       endif
   503)       cur_gas_spec2 => cur_gas_spec2%next
   504)     enddo
   505)     cur_aq_spec => cur_aq_spec%next  
   506)   enddo
   507)   
   508)   ! gas species
   509)   cur_gas_spec => reaction%gas_species_list
   510)   do
   511)     if (.not.associated(cur_aq_spec)) exit
   512)     
   513)     ! already checked against primary
   514)     ! already checked against secondary
   515)     ! gas species
   516)     cur_gas_spec2 => cur_gas_spec%next
   517)     do
   518)       if (.not.associated(cur_gas_spec2)) exit
   519)       if (cur_gas_spec%id /= cur_gas_spec2%id .and. &
   520)           StringCompare(cur_aq_spec%name, &
   521)                           cur_gas_spec2%name,MAXWORDLENGTH)) then
   522)         flag = PETSC_TRUE
   523)         option%io_buffer = 'Gas species (' // &
   524)                            trim(cur_aq_spec%name) // &
   525)                            ') duplicated in input file.'
   526)         call printMsg(option)                          
   527)       endif
   528)       cur_gas_spec2 => cur_gas_spec2%next
   529)     enddo
   530)     cur_aq_spec => cur_aq_spec%next  
   531)   enddo
   532)   
   533)   ! minerals
   534)   cur_mineral => reaction%mineral_list
   535)   do
   536)     if (.not.associated(cur_mineral)) exit
   537)     cur_mineral2 => cur_mineral%next
   538)     do
   539)       if (.not.associated(cur_mineral2)) exit
   540)       if (cur_mineral%id /= cur_mineral2%id .and. &
   541)           StringCompare(cur_mineral%name, &
   542)                           cur_mineral2%name,MAXWORDLENGTH)) then
   543)         flag = PETSC_TRUE
   544)         option%io_buffer = 'Mineral (' // &
   545)                            trim(cur_mineral%name) // &
   546)                            ') duplicated in input file.'
   547)         call printMsg(option)                          
   548)       endif
   549)       cur_mineral2 => cur_mineral2%next
   550)     enddo
   551)     cur_mineral => cur_mineral%next
   552)   enddo
   553)   
   554)   ! surface complexes
   555)   cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
   556)   do
   557)     if (.not.associated(cur_srfcplx_rxn)) exit
   558)     cur_srfcplx => cur_srfcplx_rxn%complex_list
   559)     do
   560)       if (.not.associated(cur_srfcplx)) exit
   561)       cur_srfcplx2 => cur_srfcplx%next
   562)       do
   563)         if (.not.associated(cur_srfcplx2)) exit
   564)         if (cur_srfcplx%id /= cur_srfcplx2%id .and. &
   565)             StringCompare(cur_srfcplx%name, &
   566)                             cur_srfcplx2%name,MAXWORDLENGTH)) then
   567)           flag = PETSC_TRUE
   568)           option%io_buffer = 'Surface complex (' // &
   569)                              trim(cur_srfcplx2%name) // &
   570)                       ') duplicated in input file surface complex reaction.'
   571)           call printMsg(option)                          
   572)         endif
   573)         cur_srfcplx2 => cur_srfcplx2%next
   574)       enddo
   575)       cur_srfcplx => cur_srfcplx%next
   576)     enddo
   577)     cur_srfcplx_rxn => cur_srfcplx_rxn%next
   578)   enddo  
   579)   
   580)   if (flag) call printErrMsg(option,'Species duplicated in input file.')
   581) 
   582)   ! check that all species, etc. were read
   583)   flag = PETSC_FALSE
   584)   cur_aq_spec => reaction%primary_species_list
   585)   do
   586)     if (.not.associated(cur_aq_spec)) exit
   587)     if (cur_aq_spec%id < 0) then
   588)       flag = PETSC_TRUE
   589)       option%io_buffer = 'Aqueous primary species (' // &
   590)                trim(cur_aq_spec%name) // &
   591)                ') not found in database.'
   592)       call printMsg(option)
   593)     endif
   594)     cur_aq_spec => cur_aq_spec%next
   595)   enddo
   596)   cur_aq_spec => reaction%secondary_species_list
   597)   do
   598)     if (.not.associated(cur_aq_spec)) exit
   599)     if (cur_aq_spec%id < 0) then
   600)       flag = PETSC_TRUE
   601)       option%io_buffer = &
   602)                'Aqueous secondary species (' // trim(cur_aq_spec%name) // &
   603)                ') not found in database.'
   604)       call printMsg(option)
   605)     endif
   606)     cur_aq_spec => cur_aq_spec%next
   607)   enddo  
   608)   cur_gas_spec => reaction%gas_species_list
   609)   do
   610)     if (.not.associated(cur_gas_spec)) exit
   611)     if (cur_gas_spec%id < 0) then
   612)       flag = PETSC_TRUE
   613)       option%io_buffer = 'Gas species (' // trim(cur_gas_spec%name) // &
   614)                          ') not found in database.'
   615)       call printMsg(option)
   616)     endif
   617)     cur_gas_spec => cur_gas_spec%next
   618)   enddo  
   619)   cur_mineral => reaction%mineral_list
   620)   do
   621)     if (.not.associated(cur_mineral)) exit
   622)     if (cur_mineral%id < 0) then
   623)       flag = PETSC_TRUE
   624)       option%io_buffer = 'Mineral (' // trim(cur_mineral%name) // &
   625)                ') not found in database.'
   626)       call printMsg(option)
   627)     endif
   628)     cur_mineral => cur_mineral%next
   629)   enddo
   630)   cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
   631)   do
   632)     if (.not.associated(cur_srfcplx_rxn)) exit
   633)     cur_srfcplx => cur_srfcplx_rxn%complex_list
   634)     do
   635)       if (.not.associated(cur_srfcplx)) exit
   636)       if (cur_srfcplx%id < 0) then
   637)         flag = PETSC_TRUE
   638)         option%io_buffer = 'Surface species (' // trim(cur_srfcplx%name) // &
   639)                  ') not found in database.'
   640)         call printMsg(option)
   641)       endif
   642)       cur_srfcplx => cur_srfcplx%next
   643)     enddo  
   644)     cur_srfcplx_rxn => cur_srfcplx_rxn%next
   645)   enddo 
   646)     
   647)   if (flag) call printErrMsg(option,'Species not found in database.')
   648) 
   649)   call InputDestroy(input)
   650) !TODO(geh)
   651) #endif
   652) end subroutine DatabaseRead_hpt
   653) 
   654) ! ************************************************************************** !
   655) 
   656) subroutine BasisInit_hpt(reaction,option)
   657)   ! 
   658)   ! Initializes the basis for geochemistry
   659)   ! 
   660)   ! Author: ???
   661)   ! Date: ???
   662)   ! 
   663) 
   664)   use Option_module
   665)   use String_module
   666)   use Utility_module
   667)   use Input_Aux_module
   668) 
   669)   implicit none
   670)   
   671)   type(reaction_type) :: reaction
   672)   type(option_type) :: option
   673)   
   674)   type(aq_species_type), pointer :: cur_aq_spec
   675)   type(aq_species_type), pointer :: cur_pri_aq_spec
   676)   type(aq_species_type), pointer :: cur_sec_aq_spec
   677)   type(gas_species_type), pointer :: cur_gas_spec
   678)   type(mineral_rxn_type), pointer :: cur_mineral
   679)   type(aq_species_type), pointer :: cur_sec_aq_spec1
   680)   type(aq_species_type), pointer :: cur_sec_aq_spec2
   681)   type(gas_species_type), pointer :: cur_gas_spec1
   682)   type(gas_species_type), pointer :: cur_gas_spec2
   683)   type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
   684)   type(surface_complex_type), pointer :: cur_srfcplx
   685)   type(surface_complex_type), pointer :: cur_srfcplx2
   686)   type(ion_exchange_rxn_type), pointer :: cur_ionx_rxn
   687)   type(ion_exchange_cation_type), pointer :: cur_cation
   688)   type(general_rxn_type), pointer :: cur_general_rxn
   689)   type(kd_rxn_type), pointer :: cur_kd_rxn
   690)   type(colloid_type), pointer :: cur_colloid
   691)   type(database_rxn_type), pointer :: dbaserxn
   692)   type(transition_state_rxn_type), pointer :: tstrxn
   693)   type(transition_state_prefactor_type), pointer :: cur_prefactor
   694)   type(ts_prefactor_species_type), pointer :: cur_prefactor_species
   695) 
   696)   character(len=MAXWORDLENGTH), allocatable :: old_basis_names(:)
   697)   character(len=MAXWORDLENGTH), allocatable :: new_basis_names(:)
   698) 
   699)   character(len=MAXWORDLENGTH), parameter :: h2oname = 'H2O'
   700)   character(len=MAXWORDLENGTH) :: word, word2
   701)   character(len=MAXSTRINGLENGTH) :: string, string2
   702)   
   703)   PetscInt, parameter :: h2o_id = 1
   704) 
   705)   PetscReal :: logK(reaction%num_dbase_temperatures)
   706)   PetscReal, allocatable :: transformation(:,:), old_basis(:,:), new_basis(:,:)
   707)   PetscReal, allocatable :: stoich_new(:), stoich_prev(:), logKCoeffvector(:,:)
   708)   PetscInt, allocatable :: indices(:)
   709)   
   710)   PetscReal, allocatable :: pri_matrix(:,:), sec_matrix(:,:)
   711)   PetscReal, allocatable :: sec_matrix_inverse(:,:)
   712)   PetscReal, allocatable :: stoich_matrix(:,:)
   713)   PetscReal, allocatable :: unit_vector(:)
   714)   character(len=MAXWORDLENGTH), allocatable :: pri_names(:)
   715)   character(len=MAXWORDLENGTH), allocatable :: sec_names(:)
   716)   character(len=MAXWORDLENGTH), allocatable :: gas_names(:)
   717)   PetscReal, allocatable :: logKCoeffvector_swapped(:,:)
   718)   PetscBool, allocatable :: flags(:)
   719)   PetscBool :: negative_flag
   720)   PetscReal :: value
   721)   
   722)   PetscInt :: ispec, itemp
   723)   PetscInt :: spec_id
   724)   PetscInt :: ncomp_h2o, ncomp_secondary
   725)   PetscInt :: icount_old, icount_new, icount, icount2
   726)   PetscInt :: i, j, irow, icol
   727)   PetscInt :: icomp, icplx, irxn
   728)   PetscInt :: ipri_spec, isec_spec, imnrl, igas_spec, ikinmnrl, icoll
   729)   PetscInt :: i_old, i_new
   730)   PetscInt :: isrfcplx
   731)   PetscInt :: ication
   732)   PetscInt :: idum
   733)   PetscReal :: temp_high, temp_low
   734)   PetscInt :: itemp_high, itemp_low
   735)   PetscInt :: species_count, max_species_count
   736)   PetscInt :: forward_count, max_forward_count
   737)   PetscInt :: backward_count, max_backward_count
   738)   PetscInt :: midpoint
   739)   PetscInt :: max_num_prefactors, max_num_prefactor_species
   740)   
   741)   PetscBool :: compute_new_basis
   742)   PetscBool :: found
   743)   PetscErrorCode :: ierr
   744) !TODO(geh)
   745) #if 0
   746) ! get database temperature based on REFERENCE_TEMPERATURE
   747)   if (option%reference_temperature <= 0.01d0) then
   748)     reaction%debyeA = 0.4939d0 
   749)     reaction%debyeB = 0.3253d0 
   750)     reaction%debyeBdot = 0.0374d0
   751)   else if (option%reference_temperature > 0.d0 .and. &
   752)            option%reference_temperature <= 25.d0) then
   753)     temp_low = 0.d0
   754)     temp_high = 25.d0
   755)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   756)                      0.5114d0,0.4939d0,reaction%debyeA)
   757)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   758)                      0.3288d0,0.3253d0,reaction%debyeB)
   759)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   760)                      0.0410d0,0.0374d0,reaction%debyeBdot)
   761)   else if (option%reference_temperature > 25.d0 .and. &
   762)            option%reference_temperature <= 60.d0) then
   763)     temp_low = 25.d0
   764)     temp_high = 60.d0
   765)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   766)                      0.5465d0,0.5114d0,reaction%debyeA)
   767)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   768)                      0.3346d0,0.3288d0,reaction%debyeB)
   769)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   770)                      0.0440d0,0.0410d0,reaction%debyeBdot)
   771)   else if (option%reference_temperature > 60.d0 .and. &
   772)            option%reference_temperature <= 100.d0) then
   773)     temp_low = 60.d0
   774)     temp_high = 100.d0
   775)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   776)                      0.5995d0,0.5465d0,reaction%debyeA)
   777)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   778)                      0.3421d0,0.3346d0,reaction%debyeB)
   779)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   780)                      0.0460d0,0.0440d0,reaction%debyeBdot)
   781)   else if (option%reference_temperature > 100.d0 .and. &
   782)            option%reference_temperature <= 150.d0) then
   783)     temp_low = 100.d0
   784)     temp_high = 150.d0
   785)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   786)                      0.6855d0,0.5995d0,reaction%debyeA)
   787)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   788)                      0.3525d0,0.3421d0,reaction%debyeB)
   789)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   790)                      0.0470d0,0.0460d0,reaction%debyeBdot)
   791)   else if (option%reference_temperature > 150.d0 .and. &
   792)            option%reference_temperature <= 200.d0) then
   793)     temp_low = 150.d0
   794)     temp_high = 200.d0
   795)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   796)                      0.7994d0,0.6855d0,reaction%debyeA)
   797)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   798)                      0.3639d0,0.3525d0,reaction%debyeB)
   799)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   800)                      0.0470d0,0.0470d0,reaction%debyeBdot)
   801)   else if (option%reference_temperature > 200.d0 .and. &
   802)            option%reference_temperature <= 250.d0) then
   803)     temp_low = 200.d0
   804)     temp_high = 250.d0
   805)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   806)                      0.9593d0,0.7994d0,reaction%debyeA)
   807)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   808)                      0.3766d0,0.3639d0,reaction%debyeB)
   809)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   810)                      0.0340d0,0.0470d0,reaction%debyeBdot)
   811)   else if (option%reference_temperature > 250.d0 .and. &
   812)            option%reference_temperature <= 300.d0) then
   813)     temp_low = 250.d0
   814)     temp_high = 300.d0
   815)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   816)                      1.2180d0,0.9593d0,reaction%debyeA)
   817)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   818)                      0.3925d0,0.3766d0,reaction%debyeB)
   819)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   820)                      0.0000d0,0.0340d0,reaction%debyeBdot)
   821)   else if (option%reference_temperature > 300.d0 .and. &
   822)            option%reference_temperature <= 350.d0) then
   823)     temp_low = 300.d0
   824)     temp_high = 350.d0
   825)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   826)                      1.2180d0,1.2180d0,reaction%debyeA)
   827)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   828)                      0.3925d0,0.3925d0,reaction%debyeB)
   829)     call Interpolate(temp_high,temp_low,option%reference_temperature, &
   830)                      0.0000d0,0.0000d0,reaction%debyeBdot)
   831)   else if (option%reference_temperature > 350.d0) then
   832)     reaction%debyeA = 1.2180d0 
   833)     reaction%debyeB = 0.3925d0 
   834)     reaction%debyeBdot = 0.0000d0
   835)   endif
   836)   
   837)   if (.not.reaction%act_coef_use_bdot) then
   838)     reaction%debyeBdot = 0.d0
   839)   endif
   840) 
   841)   if (option%reference_temperature <= reaction%dbase_temperatures(1)) then
   842)     itemp_low = 1
   843)     itemp_high = 1
   844)     temp_low = reaction%dbase_temperatures(itemp_low)
   845)     temp_high = reaction%dbase_temperatures(itemp_high)
   846)   else if (option%reference_temperature > &
   847)            reaction%dbase_temperatures(reaction%num_dbase_temperatures)) then
   848)     itemp_low = reaction%num_dbase_temperatures
   849)     itemp_high = reaction%num_dbase_temperatures
   850)     temp_low = reaction%dbase_temperatures(itemp_low)
   851)     temp_high = reaction%dbase_temperatures(itemp_high)
   852)   else
   853)     do itemp = 1, reaction%num_dbase_temperatures-1
   854)       itemp_low = itemp
   855)       itemp_high = itemp+1
   856)       temp_low = reaction%dbase_temperatures(itemp_low)
   857)       temp_high = reaction%dbase_temperatures(itemp_high)
   858)       if (option%reference_temperature > temp_low .and. &
   859)           option%reference_temperature <= temp_high) then
   860)         exit
   861)       endif
   862)     enddo
   863)   endif
   864) 
   865)   ! # of components sorbed to colloids
   866)   reaction%naqcomp = GetPrimarySpeciesCount(reaction)
   867)   reaction%ncoll = GetColloidCount(reaction)
   868)   reaction%neqcplx = GetSecondarySpeciesCount(reaction)
   869)   reaction%ngas = GetGasCount(reaction)
   870) 
   871)   reaction%ncollcomp = reaction%naqcomp ! set to naqcomp for now, will be adjusted later
   872)   reaction%offset_aqueous = 0
   873)   reaction%offset_colloid = reaction%offset_aqueous + reaction%naqcomp
   874)   reaction%offset_collcomp = reaction%offset_colloid + reaction%ncoll
   875) 
   876)   ! account for H2O in the basis by adding 1
   877)   ncomp_h2o = reaction%naqcomp+1
   878)   
   879)   allocate(old_basis_names(ncomp_h2o+reaction%neqcplx))
   880)   allocate(new_basis_names(ncomp_h2o))
   881)   old_basis_names = ''
   882)   new_basis_names = ''
   883)   
   884)   call BasisPrint(reaction,'Initial Basis',option)
   885)   
   886)   !--------------------------------------------
   887) 
   888)   ! for now, remove equilibrium reactions from any primary species that are
   889)   ! flagged as "redox"
   890)   cur_aq_spec => reaction%primary_species_list
   891)   do
   892)     if (.not.associated(cur_aq_spec)) exit
   893)     if (cur_aq_spec%is_redox .and. associated(cur_aq_spec%dbaserxn)) then
   894)       call DatabaseRxnDestroy(cur_aq_spec%dbaserxn)
   895)     endif
   896)     cur_aq_spec => cur_aq_spec%next
   897)   enddo
   898) 
   899)   ncomp_secondary = reaction%neqcplx+reaction%ngas
   900)   
   901)   ! check to ensure that the number of secondary aqueous and gas species
   902)   ! (i.e. those with a reaction defined from the database) is equal to the 
   903)   ! number of reactions read from the database.  If not, send an error 
   904)   ! message.  
   905)   
   906)   icount = 0
   907)   cur_pri_aq_spec => reaction%primary_species_list
   908)   do
   909)     if (.not.associated(cur_pri_aq_spec)) exit
   910)     if (associated(cur_pri_aq_spec%dbaserxn)) then
   911)       icount = icount + 1
   912)     endif
   913)     cur_pri_aq_spec => cur_pri_aq_spec%next
   914)   enddo
   915) 
   916)   cur_sec_aq_spec => reaction%secondary_species_list
   917)   do
   918)     if (.not.associated(cur_sec_aq_spec)) exit
   919)     if (associated(cur_sec_aq_spec%dbaserxn)) then
   920)       icount = icount + 1
   921)     endif
   922)     cur_sec_aq_spec => cur_sec_aq_spec%next
   923)   enddo
   924) 
   925)   cur_gas_spec => reaction%gas_species_list
   926)   do
   927)     if (.not.associated(cur_gas_spec)) exit
   928)     if (associated(cur_gas_spec%dbaserxn)) then
   929)       icount = icount + 1
   930)     endif
   931)     cur_gas_spec => cur_gas_spec%next
   932)   enddo
   933)   
   934)   if (icount /= ncomp_secondary) then
   935)     if (icount < ncomp_secondary) then
   936)       option%io_buffer = 'Too few reactions read from database for ' // & 
   937)         'number of secondary species defined.'
   938)     else
   939)       option%io_buffer = 'Too many reactions read from database for ' // & 
   940)         'number of secondary species defined.  Perhaps REDOX ' // &
   941)         'SPECIES need to be defined?'
   942)     endif
   943)     call printErrMsg(option)
   944)   endif
   945)   
   946)   allocate(pri_matrix(ncomp_secondary,ncomp_h2o))
   947)   pri_matrix = 0.d0
   948)   allocate(pri_names(ncomp_h2o))
   949)   pri_names = ''
   950)   allocate(sec_matrix(ncomp_secondary,ncomp_secondary))
   951)   sec_matrix = 0.d0
   952)   allocate(sec_names(reaction%neqcplx))
   953)   sec_names = ''
   954)   allocate(gas_names(reaction%ngas))
   955)   gas_names = ''
   956)   
   957)   allocate(logKCoeffvector(reaction%num_dbase_parameters,ncomp_secondary))
   958)   logKCoeffvector = 0.d0
   959)   
   960)   ! fill in names
   961)   icount = 1
   962)   pri_names(icount) = h2oname
   963)   cur_aq_spec => reaction%primary_species_list
   964)   do
   965)     if (.not.associated(cur_aq_spec)) exit
   966)     icount = icount + 1
   967)     pri_names(icount) = cur_aq_spec%name
   968)     cur_aq_spec => cur_aq_spec%next
   969)   enddo
   970)   icount = 0
   971)   cur_aq_spec => reaction%secondary_species_list
   972)   do
   973)     if (.not.associated(cur_aq_spec)) exit
   974)     icount = icount + 1
   975)     sec_names(icount) = cur_aq_spec%name
   976)     cur_aq_spec => cur_aq_spec%next
   977)   enddo
   978)   icount= 0
   979)   cur_gas_spec => reaction%gas_species_list
   980)   do
   981)     if (.not.associated(cur_gas_spec)) exit
   982)     icount = icount + 1
   983)     gas_names(icount) = cur_gas_spec%name
   984)     cur_gas_spec => cur_gas_spec%next
   985)   enddo
   986)   
   987)   ! fill in matrices
   988)   icount = 0
   989)   cur_pri_aq_spec => reaction%primary_species_list
   990)   do
   991)     if (.not.associated(cur_pri_aq_spec)) exit
   992)     if (associated(cur_pri_aq_spec%dbaserxn)) then
   993)       icount = icount + 1
   994)       logKCoeffvector(:,icount) = cur_pri_aq_spec%dbaserxn%logK
   995)       i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
   996)                             cur_pri_aq_spec%name, &
   997)                             cur_pri_aq_spec%name, &
   998)                             pri_names,sec_names,gas_names)
   999)       if (i < 0) then
  1000)         option%io_buffer = 'Primary species ' // &
  1001)                  trim(cur_pri_aq_spec%name) // &
  1002)                  ' found in secondary or gas list.'
  1003)         call printErrMsg(option)
  1004)       endif
  1005)       pri_matrix(icount,i) = -1.d0
  1006)       do ispec=1,cur_pri_aq_spec%dbaserxn%nspec
  1007)         i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
  1008)                               cur_pri_aq_spec%name, &
  1009)                               cur_pri_aq_spec%dbaserxn%spec_name(ispec), &
  1010)                               pri_names,sec_names,gas_names)
  1011)         if (i > 0) then
  1012)           pri_matrix(icount,i) = cur_pri_aq_spec%dbaserxn%stoich(ispec)
  1013)         else
  1014)           sec_matrix(icount,-i) = cur_pri_aq_spec%dbaserxn%stoich(ispec)
  1015)         endif
  1016)       enddo
  1017)     endif
  1018)     cur_pri_aq_spec => cur_pri_aq_spec%next
  1019)   enddo
  1020) 
  1021)   cur_sec_aq_spec => reaction%secondary_species_list
  1022)   do
  1023)     if (.not.associated(cur_sec_aq_spec)) exit
  1024)     if (associated(cur_sec_aq_spec%dbaserxn)) then
  1025)       icount = icount + 1
  1026)       logKCoeffvector(:,icount) = cur_sec_aq_spec%dbaserxn%logKCoeff_hpt
  1027)       i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
  1028)                             cur_sec_aq_spec%name, &
  1029)                             cur_sec_aq_spec%name, &
  1030)                             pri_names,sec_names,gas_names)
  1031)       if (i > 0) then
  1032)         option%io_buffer = 'Secondary aqueous species ' // &
  1033)                  trim(cur_sec_aq_spec%name) // &
  1034)                  ' found in primary species list.'
  1035)         call printErrMsg(option)
  1036)       endif
  1037)       sec_matrix(icount,-i) = -1.d0
  1038)       do ispec=1,cur_sec_aq_spec%dbaserxn%nspec
  1039)         i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
  1040)                               cur_sec_aq_spec%name, &
  1041)                               cur_sec_aq_spec%dbaserxn%spec_name(ispec), &
  1042)                               pri_names,sec_names,gas_names)
  1043)         if (i > 0) then
  1044)           pri_matrix(icount,i) = cur_sec_aq_spec%dbaserxn%stoich(ispec)
  1045)         else
  1046)           sec_matrix(icount,-i) = cur_sec_aq_spec%dbaserxn%stoich(ispec)
  1047)         endif
  1048)       enddo
  1049)     endif
  1050)     cur_sec_aq_spec => cur_sec_aq_spec%next
  1051)   enddo
  1052) 
  1053)   cur_gas_spec => reaction%gas_species_list
  1054)   do
  1055)     if (.not.associated(cur_gas_spec)) exit
  1056)     if (associated(cur_gas_spec%dbaserxn)) then
  1057)       icount = icount + 1
  1058)       logKCoeffvector(:,icount) = cur_gas_spec%dbaserxn%logKCoeff_hpt
  1059)       i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
  1060)                             cur_gas_spec%name, &
  1061)                             cur_gas_spec%name, &
  1062)                             pri_names,sec_names,gas_names)
  1063)       if (i > 0) then
  1064)         option%io_buffer = 'Gas species ' // &
  1065)                  trim(cur_gas_spec%name) // &
  1066)                  ' found in primary species list.'
  1067)         call printErrMsg(option)
  1068)       endif
  1069)       sec_matrix(icount,-i) = -1.d0
  1070)       do ispec=1,cur_gas_spec%dbaserxn%nspec
  1071)         i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
  1072)                               cur_gas_spec%name, &
  1073)                               cur_gas_spec%dbaserxn%spec_name(ispec), &
  1074)                               pri_names,sec_names,gas_names)
  1075)         if (i > 0) then
  1076)           pri_matrix(icount,i) = cur_gas_spec%dbaserxn%stoich(ispec)
  1077)         else
  1078)           sec_matrix(icount,-i) = cur_gas_spec%dbaserxn%stoich(ispec)
  1079)         endif
  1080)       enddo
  1081)     endif
  1082)     cur_gas_spec => cur_gas_spec%next
  1083)   enddo
  1084) 
  1085)   allocate(indices(ncomp_secondary))
  1086)   indices = 0
  1087)   allocate(unit_vector(ncomp_secondary))
  1088)   unit_vector = 0.d0
  1089)   allocate(sec_matrix_inverse(ncomp_secondary,ncomp_secondary))
  1090)   sec_matrix_inverse = 0.d0
  1091)  
  1092)   call ludcmp(sec_matrix,ncomp_secondary,indices,idum)
  1093)   do ispec = 1, ncomp_secondary
  1094)     unit_vector = 0.d0
  1095)     unit_vector(ispec) = 1.d0
  1096)     call lubksb(sec_matrix,ncomp_secondary,indices,unit_vector)
  1097)     sec_matrix_inverse(:,ispec) = unit_vector(:)
  1098)   enddo
  1099) 
  1100)   ! invert the secondary species matrix
  1101)   allocate(stoich_matrix(ncomp_secondary,ncomp_h2o))
  1102)   stoich_matrix = 0.d0
  1103)   do j = 1, ncomp_h2o
  1104)     do i = 1, ncomp_secondary
  1105)       do ispec = 1, ncomp_secondary
  1106)         stoich_matrix(i,j) = stoich_matrix(i,j) + &
  1107)           sec_matrix_inverse(i,ispec)*pri_matrix(ispec,j)
  1108)       enddo
  1109)     enddo
  1110)   enddo
  1111)   stoich_matrix = -1.d0*stoich_matrix
  1112) 
  1113)   allocate(logKCoeffvector_swapped(reaction%num_dbase_parameters,ncomp_secondary))
  1114)   logKCoeffvector_swapped = 0.d0
  1115)   
  1116)   do j = 1, ncomp_secondary
  1117)     do i = 1, reaction%num_dbase_parameters
  1118)       logKCoeffvector_swapped(i,j) = logKCoeffvector_swapped(i,j) - &
  1119)         dot_product(sec_matrix_inverse(j,1:ncomp_secondary), &
  1120)                     logKCoeffvector(i,1:ncomp_secondary))
  1121)     enddo
  1122)   enddo
  1123)     
  1124)   deallocate(pri_matrix)
  1125)   deallocate(sec_matrix)
  1126)   deallocate(indices)
  1127)   deallocate(unit_vector)
  1128)   deallocate(sec_matrix_inverse)
  1129)   deallocate(logKCoeffvector_swapped)
  1130)   
  1131)   cur_pri_aq_spec => reaction%primary_species_list
  1132)   do
  1133)     if (.not.associated(cur_pri_aq_spec)) exit
  1134)     if (associated(cur_pri_aq_spec%dbaserxn)) then
  1135)       call DatabaseRxnDestroy(cur_pri_aq_spec%dbaserxn)
  1136)     endif
  1137)     cur_pri_aq_spec => cur_pri_aq_spec%next
  1138)   enddo
  1139) 
  1140)   icount = 0
  1141)   cur_sec_aq_spec => reaction%secondary_species_list
  1142)   do
  1143)     if (.not.associated(cur_sec_aq_spec)) exit
  1144)     icount = icount + 1
  1145)     ! destory old reaction
  1146)     call DatabaseRxnDestroy(cur_sec_aq_spec%dbaserxn)
  1147)     ! allocate new
  1148)     cur_sec_aq_spec%dbaserxn => DatabaseRxnCreate()
  1149) 
  1150)     ! count # of species in reaction
  1151)     icount2 = 0
  1152)     do icol = 1, ncomp_h2o
  1153)       if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
  1154)         cur_sec_aq_spec%dbaserxn%nspec = cur_sec_aq_spec%dbaserxn%nspec + 1
  1155)       endif
  1156)     enddo
  1157)     
  1158)     allocate(cur_sec_aq_spec%dbaserxn%stoich(cur_sec_aq_spec%dbaserxn%nspec))
  1159)     cur_sec_aq_spec%dbaserxn%stoich = 0.d0
  1160)     allocate(cur_sec_aq_spec%dbaserxn%spec_name(cur_sec_aq_spec%dbaserxn%nspec))
  1161)     cur_sec_aq_spec%dbaserxn%spec_name = ''
  1162)     allocate(cur_sec_aq_spec%dbaserxn%spec_ids(cur_sec_aq_spec%dbaserxn%nspec))
  1163)     cur_sec_aq_spec%dbaserxn%spec_ids = 0
  1164)     allocate(cur_sec_aq_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
  1165)     cur_sec_aq_spec%dbaserxn%logKCoeff_hpt = 0.d0
  1166) 
  1167)     ispec = 0
  1168)     do icol = 1, ncomp_h2o
  1169)       if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
  1170)         ispec = ispec + 1
  1171)         cur_sec_aq_spec%dbaserxn%spec_name(ispec) = pri_names(icol)
  1172)         cur_sec_aq_spec%dbaserxn%stoich(ispec) = stoich_matrix(icount,icol)
  1173)         cur_sec_aq_spec%dbaserxn%spec_ids(ispec) = icol
  1174)       endif
  1175)     enddo
  1176) 
  1177)     cur_sec_aq_spec%dbaserxn%logKCoeff_hpt = logKCoeffvector_swapped(:,icount)
  1178) 
  1179)     cur_sec_aq_spec => cur_sec_aq_spec%next
  1180)   enddo
  1181) 
  1182)   cur_gas_spec => reaction%gas_species_list
  1183)   do
  1184)     if (.not.associated(cur_gas_spec)) exit
  1185)     icount = icount + 1
  1186)     ! destory old reaction
  1187)     call DatabaseRxnDestroy(cur_gas_spec%dbaserxn)
  1188)     ! allocate new
  1189)     cur_gas_spec%dbaserxn => DatabaseRxnCreate()
  1190) 
  1191)     ! count # of species in reaction
  1192)     icount2 = 0
  1193)     do icol = 1, ncomp_h2o
  1194)       if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
  1195)         cur_gas_spec%dbaserxn%nspec = cur_gas_spec%dbaserxn%nspec + 1
  1196)       endif
  1197)     enddo
  1198)     
  1199)     allocate(cur_gas_spec%dbaserxn%stoich(cur_gas_spec%dbaserxn%nspec))
  1200)     cur_gas_spec%dbaserxn%stoich = 0.d0
  1201)     allocate(cur_gas_spec%dbaserxn%spec_name(cur_gas_spec%dbaserxn%nspec))
  1202)     cur_gas_spec%dbaserxn%spec_name = ''
  1203)     allocate(cur_gas_spec%dbaserxn%spec_ids(cur_gas_spec%dbaserxn%nspec))
  1204)     cur_gas_spec%dbaserxn%spec_ids = 0
  1205)     allocate(cur_gas_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
  1206)     cur_gas_spec%dbaserxn%logKCoeff_hpt = 0.d0
  1207) 
  1208)     ispec = 0
  1209)     do icol = 1, ncomp_h2o
  1210)       if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
  1211)         ispec = ispec + 1
  1212)         cur_gas_spec%dbaserxn%spec_name(ispec) = pri_names(icol)
  1213)         cur_gas_spec%dbaserxn%stoich(ispec) = stoich_matrix(icount,icol)
  1214)         cur_gas_spec%dbaserxn%spec_ids(ispec) = icol
  1215)       endif
  1216)     enddo
  1217) 
  1218)     cur_gas_spec%dbaserxn%logKCoeff_hpt = logKCoeffvector_swapped(:,icount)
  1219) 
  1220)     cur_gas_spec => cur_gas_spec%next
  1221)   enddo
  1222) 
  1223)   new_basis_names = pri_names
  1224) 
  1225)   deallocate(stoich_matrix)
  1226)   deallocate(logKCoeffvector_swapped)
  1227) 
  1228)   deallocate(pri_names)
  1229)   deallocate(sec_names)
  1230)   deallocate(gas_names)
  1231) 
  1232)   nullify(cur_sec_aq_spec)
  1233)   nullify(cur_gas_spec)
  1234)   nullify(cur_mineral)
  1235)   nullify(cur_srfcplx_rxn)
  1236)   nullify(cur_srfcplx)
  1237)     
  1238)   ! first off, lets remove all the secondary gases from all other reactions
  1239)   cur_gas_spec => reaction%gas_species_list
  1240)   do
  1241)     if (.not.associated(cur_gas_spec)) exit
  1242)     
  1243)     ! gases in mineral reactions
  1244)     cur_mineral => reaction%mineral_list
  1245)     do
  1246)       if (.not.associated(cur_mineral)) exit
  1247)       
  1248)       if (associated(cur_mineral%tstrxn)) then
  1249)         ispec = 1
  1250)         do
  1251)           if (ispec > cur_mineral%dbaserxn%nspec) exit
  1252)           if (StringCompare(cur_gas_spec%name, &
  1253)                               cur_mineral%dbaserxn%spec_name(ispec), &
  1254)                               MAXWORDLENGTH)) then
  1255)             call BasisSubSpeciesInMineralRxn_hpt(cur_gas_spec%name, &
  1256)                                                  cur_gas_spec%dbaserxn, &
  1257)                                                  cur_mineral%dbaserxn)
  1258)             ispec = 0
  1259)           endif
  1260)           ispec = ispec + 1
  1261)         enddo
  1262)       endif
  1263)       cur_mineral => cur_mineral%next
  1264)     enddo
  1265)     nullify(cur_mineral)
  1266) 
  1267)     ! gases in surface complex reactions
  1268)     cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
  1269)     do
  1270)       if (.not.associated(cur_srfcplx_rxn)) exit
  1271)       cur_srfcplx2 => cur_srfcplx_rxn%complex_list
  1272)       do
  1273)         if (.not.associated(cur_srfcplx2)) exit
  1274)         
  1275)         if (associated(cur_srfcplx2%dbaserxn)) then
  1276)           ispec = 1
  1277)           do
  1278)             if (ispec > cur_srfcplx2%dbaserxn%nspec) exit
  1279)             if (StringCompare(cur_gas_spec%name, &
  1280)                                 cur_srfcplx2%dbaserxn%spec_name(ispec), &
  1281)                                 MAXWORDLENGTH)) then
  1282)               call BasisSubSpecInGasOrSecRxn_hpt(cur_gas_spec%name, &
  1283)                                                 cur_gas_spec%dbaserxn, &
  1284)                                                 cur_srfcplx2%dbaserxn)
  1285)               ispec = 0
  1286)             endif
  1287)             ispec = ispec + 1
  1288)           enddo
  1289)         endif
  1290)         cur_srfcplx2 => cur_srfcplx2%next
  1291)       enddo
  1292)       nullify(cur_srfcplx2)
  1293)       cur_srfcplx_rxn => cur_srfcplx_rxn%next
  1294)     enddo
  1295)     nullify(cur_srfcplx_rxn)
  1296) 
  1297)     cur_gas_spec => cur_gas_spec%next
  1298)   enddo
  1299) 
  1300)   nullify(cur_sec_aq_spec)
  1301)   nullify(cur_gas_spec)
  1302)   nullify(cur_mineral)
  1303)   nullify(cur_srfcplx_rxn)
  1304)   nullify(cur_srfcplx)
  1305) 
  1306)   ! secondary aqueous species
  1307)   cur_sec_aq_spec => reaction%secondary_species_list
  1308)   do
  1309) 
  1310)     if (.not.associated(cur_sec_aq_spec)) exit
  1311)     
  1312)     ! secondary aqueous species in mineral reactions
  1313)     cur_mineral => reaction%mineral_list
  1314)     do
  1315)       if (.not.associated(cur_mineral)) exit
  1316)       
  1317)       if (associated(cur_mineral%tstrxn)) then
  1318)         ispec = 1
  1319)         do
  1320)           if (ispec > cur_mineral%dbaserxn%nspec) exit
  1321)           if (StringCompare(cur_sec_aq_spec%name, &
  1322)                               cur_mineral%dbaserxn%spec_name(ispec), &
  1323)                               MAXWORDLENGTH)) then
  1324)             call BasisSubSpeciesInMineralRxn_hpt(cur_sec_aq_spec%name, &
  1325)                                                  cur_sec_aq_spec%dbaserxn, &
  1326)                                                  cur_mineral%dbaserxn)
  1327)             ispec = 0
  1328)           endif
  1329)           ispec = ispec + 1
  1330)         enddo
  1331)       endif
  1332)       cur_mineral => cur_mineral%next
  1333)     enddo
  1334) 
  1335)     ! secondary aqueous species in surface complex reactions
  1336)     cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
  1337)     do
  1338)       if (.not.associated(cur_srfcplx_rxn)) exit
  1339)       cur_srfcplx2 => cur_srfcplx_rxn%complex_list
  1340)       do
  1341)         if (.not.associated(cur_srfcplx2)) exit
  1342)         
  1343)         if (associated(cur_srfcplx2%dbaserxn)) then
  1344)           ispec = 1
  1345)           do
  1346)             if (ispec > cur_srfcplx2%dbaserxn%nspec) exit
  1347)             if (StringCompare(cur_sec_aq_spec%name, &
  1348)                                 cur_srfcplx2%dbaserxn%spec_name(ispec), &
  1349)                                 MAXWORDLENGTH)) then
  1350)               call BasisSubSpecInGasOrSecRxn_hpt(cur_sec_aq_spec%name, &
  1351)                                                  cur_sec_aq_spec%dbaserxn, &
  1352)                                                  cur_srfcplx2%dbaserxn)
  1353)               ispec = 0
  1354)             endif
  1355)             ispec = ispec + 1
  1356)           enddo
  1357)         endif
  1358)         cur_srfcplx2 => cur_srfcplx2%next
  1359)       enddo
  1360)       nullify(cur_srfcplx2)
  1361)       cur_srfcplx_rxn => cur_srfcplx_rxn%next
  1362)     enddo
  1363)     nullify(cur_srfcplx_rxn)    
  1364)     
  1365)     cur_sec_aq_spec => cur_sec_aq_spec%next
  1366)   enddo
  1367)   
  1368)   nullify(cur_sec_aq_spec)
  1369)   nullify(cur_gas_spec)
  1370)   nullify(cur_mineral)
  1371)   nullify(cur_srfcplx_rxn)
  1372)   nullify(cur_srfcplx)
  1373) 
  1374)   ! substitute new basis into mineral and surface complexation rxns,
  1375)   ! if necessary
  1376)   cur_mineral => reaction%mineral_list
  1377)   do
  1378)     if (.not.associated(cur_mineral)) exit
  1379)     if (.not.associated(cur_mineral%dbaserxn%spec_ids)) then
  1380)       allocate(cur_mineral%dbaserxn%spec_ids(cur_mineral%dbaserxn%nspec))
  1381)       cur_mineral%dbaserxn%spec_ids = 0
  1382)     endif
  1383) 	
  1384)     call BasisAlignSpeciesInRxn(ncomp_h2o,new_basis_names, &
  1385)                                 cur_mineral%dbaserxn%nspec, &
  1386)                                 cur_mineral%dbaserxn%spec_name, &
  1387)                                 cur_mineral%dbaserxn%stoich, &
  1388)                                 cur_mineral%dbaserxn%spec_ids, &
  1389)                                 cur_mineral%name,option)     
  1390)     cur_mineral => cur_mineral%next
  1391)   enddo  
  1392) 
  1393)   cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
  1394)   do
  1395)     if (.not.associated(cur_srfcplx_rxn)) exit
  1396)     cur_srfcplx => cur_srfcplx_rxn%complex_list
  1397)     do
  1398)       if (.not.associated(cur_srfcplx)) exit
  1399)       if (.not.associated(cur_srfcplx%dbaserxn%spec_ids)) then
  1400)         allocate(cur_srfcplx%dbaserxn%spec_ids(cur_srfcplx%dbaserxn%nspec))
  1401)         cur_srfcplx%dbaserxn%spec_ids = 0
  1402)       endif
  1403)       call BasisAlignSpeciesInRxn(ncomp_h2o,new_basis_names, &
  1404)                                   cur_srfcplx%dbaserxn%nspec, &
  1405)                                   cur_srfcplx%dbaserxn%spec_name, &
  1406)                                   cur_srfcplx%dbaserxn%stoich, &
  1407)                                   cur_srfcplx%dbaserxn%spec_ids, &
  1408)                                   cur_srfcplx%name,option) 
  1409)       cur_srfcplx => cur_srfcplx%next
  1410)     enddo
  1411)     nullify(cur_srfcplx)
  1412)     cur_srfcplx_rxn => cur_srfcplx_rxn%next
  1413)   enddo
  1414)   nullify(cur_srfcplx_rxn)  
  1415) 
  1416)   ! fill reaction arrays, swapping if necessary
  1417)   if (associated(reaction%primary_species_names)) &
  1418)     deallocate(reaction%primary_species_names)
  1419) 
  1420)   allocate(reaction%primary_species_names(reaction%naqcomp))
  1421)   reaction%primary_species_names = ''
  1422) 
  1423)   allocate(reaction%primary_species_print(reaction%naqcomp))
  1424)   reaction%primary_species_print = PETSC_FALSE
  1425) 
  1426)   allocate(reaction%primary_spec_Z(reaction%naqcomp))
  1427)   reaction%primary_spec_Z = 0.d0
  1428) 
  1429)   allocate(reaction%primary_spec_molar_wt(reaction%naqcomp))
  1430)   reaction%primary_spec_molar_wt = 0.d0
  1431) 
  1432)   allocate(reaction%primary_spec_a0(reaction%naqcomp))
  1433)   reaction%primary_spec_a0 = 0.d0
  1434) 
  1435)   allocate(reaction%kd_print(reaction%naqcomp))
  1436)   reaction%kd_print = PETSC_FALSE
  1437)   if (reaction%nsorb > 0) then
  1438)     allocate(reaction%total_sorb_print(reaction%naqcomp))
  1439)     reaction%total_sorb_print = PETSC_FALSE
  1440)   endif
  1441)   
  1442)     ! pack in reaction arrays
  1443)   cur_pri_aq_spec => reaction%primary_species_list
  1444)   ispec = 1
  1445)   do
  1446)     if (.not.associated(cur_pri_aq_spec)) exit
  1447)     reaction%primary_species_names(ispec) = cur_pri_aq_spec%name
  1448)     reaction%primary_spec_Z(ispec) = cur_pri_aq_spec%Z
  1449)     reaction%primary_spec_molar_wt(ispec) = cur_pri_aq_spec%molar_weight
  1450)     reaction%primary_spec_a0(ispec) = cur_pri_aq_spec%a0
  1451)     reaction%primary_species_print(ispec) = cur_pri_aq_spec%print_me .or. &
  1452)                                             reaction%print_all_primary_species
  1453)     reaction%kd_print(ispec) = (cur_pri_aq_spec%print_me .or. &
  1454)                                 reaction%print_all_primary_species) .and. &
  1455)                                 reaction%print_kd
  1456)     if (reaction%nsorb > 0) then
  1457)       reaction%total_sorb_print(ispec) = (cur_pri_aq_spec%print_me .or. &
  1458)                                   reaction%print_all_primary_species) .and. &
  1459)                                   reaction%print_total_sorb
  1460)     endif
  1461)     ispec = ispec + 1
  1462)     cur_pri_aq_spec => cur_pri_aq_spec%next
  1463)   enddo
  1464)   nullify(cur_pri_aq_spec)
  1465)   ispec = -1 ! to catch bugs
  1466)   
  1467)   ! secondary aqueous complexes
  1468)   reaction%neqcplx = GetSecondarySpeciesCount(reaction)
  1469)   
  1470)   if (reaction%neqcplx > 0) then
  1471)     allocate(reaction%secondary_species_names(reaction%neqcplx))
  1472)     reaction%secondary_species_names = ''
  1473) 
  1474)     allocate(reaction%secondary_species_print(reaction%neqcplx))
  1475)     reaction%secondary_species_print = PETSC_FALSE
  1476) 
  1477)     allocate(reaction%eqcplx_basis_names(reaction%naqcomp,reaction%neqcplx))
  1478)     reaction%eqcplx_basis_names = ''
  1479) 
  1480)     allocate(reaction%eqcplxspecid(0:reaction%naqcomp,reaction%neqcplx))
  1481)     reaction%eqcplxspecid = 0
  1482) 
  1483)     allocate(reaction%eqcplxstoich(0:reaction%naqcomp,reaction%neqcplx))
  1484)     reaction%eqcplxstoich = 0.d0
  1485) 
  1486)     allocate(reaction%eqcplxh2oid(reaction%neqcplx))
  1487)     reaction%eqcplxh2oid = 0
  1488) 
  1489)     allocate(reaction%eqcplxh2ostoich(reaction%neqcplx))
  1490)     reaction%eqcplxh2ostoich = 0.d0
  1491) 
  1492)     allocate(reaction%eqcplx_logK(reaction%neqcplx))
  1493)     reaction%eqcplx_logK = 0.d0
  1494) 
  1495)     allocate(reaction%eqcplx_logKcoef(reaction%num_dbase_parameters,reaction%neqcplx))
  1496)     reaction%eqcplx_logKcoef = 0.d0
  1497) 
  1498)     allocate(reaction%eqcplx_Z(reaction%neqcplx))
  1499)     reaction%eqcplx_Z = 0.d0
  1500) 
  1501)     allocate(reaction%eqcplx_molar_wt(reaction%neqcplx))
  1502)     reaction%eqcplx_molar_wt = 0.d0
  1503) 
  1504)     allocate(reaction%eqcplx_a0(reaction%neqcplx))
  1505)     reaction%eqcplx_a0 = 0.d0
  1506) 
  1507)     ! pack in reaction arrays
  1508)     cur_sec_aq_spec => reaction%secondary_species_list
  1509)     isec_spec = 1
  1510)     do
  1511)       if (.not.associated(cur_sec_aq_spec)) exit
  1512) 
  1513)       reaction%secondary_species_names(isec_spec) = &
  1514)         cur_sec_aq_spec%name
  1515)       reaction%secondary_species_print(isec_spec) = cur_sec_aq_spec%print_me .or. &
  1516)                                             reaction%print_all_secondary_species
  1517)       ispec = 0
  1518)       do i = 1, cur_sec_aq_spec%dbaserxn%nspec
  1519)       
  1520) !       print *,'database: ',i,cur_sec_aq_spec%dbaserxn%spec_name(i)
  1521)         
  1522)         if (cur_sec_aq_spec%dbaserxn%spec_ids(i) /= h2o_id) then
  1523)           ispec = ispec + 1
  1524)           spec_id = cur_sec_aq_spec%dbaserxn%spec_ids(i)
  1525)           if (spec_id > h2o_id) spec_id = spec_id - 1
  1526)           reaction%eqcplxspecid(ispec,isec_spec) = spec_id
  1527)           reaction%eqcplx_basis_names(ispec,isec_spec) = &
  1528)             cur_sec_aq_spec%dbaserxn%spec_name(i)
  1529)           reaction%eqcplxstoich(ispec,isec_spec) = cur_sec_aq_spec%dbaserxn%stoich(i)
  1530)             
  1531)         else ! fill in h2o id and stoich
  1532)           reaction%eqcplxh2oid(isec_spec) = h2o_id
  1533)           reaction%eqcplxh2ostoich(isec_spec) = cur_sec_aq_spec%dbaserxn%stoich(i)
  1534)         endif
  1535)       enddo
  1536)       reaction%eqcplxspecid(0,isec_spec) = ispec
  1537) !#if 0
  1538) !     TODO(Peter): fix argument list
  1539)       call ReactionInitializeLogK_hpt(reaction%eqcplx_logKcoef(:,isec_spec), &
  1540)                                       reaction%eqcplx_logK(isec_spec), &
  1541)                                       option,reaction)
  1542) !#endif
  1543)       reaction%eqcplx_Z(isec_spec) = cur_sec_aq_spec%Z
  1544)       reaction%eqcplx_molar_wt(isec_spec) = cur_sec_aq_spec%molar_weight
  1545)       reaction%eqcplx_a0(isec_spec) = cur_sec_aq_spec%a0
  1546)   
  1547)       isec_spec = isec_spec + 1
  1548)       cur_sec_aq_spec => cur_sec_aq_spec%next
  1549)     enddo
  1550) 
  1551)   endif
  1552)   nullify(cur_sec_aq_spec)
  1553)   isec_spec = -1 ! to catch bugs
  1554) 
  1555)   ! gas complexes
  1556)   reaction%ngas = GetGasCount(reaction)
  1557)   
  1558)   if (reaction%ngas > 0) then
  1559)     allocate(reaction%gas_species_names(reaction%ngas))
  1560)     reaction%gas_species_names = ''
  1561)     allocate(reaction%gas_species_print(reaction%ngas))
  1562)     reaction%gas_species_print = PETSC_FALSE
  1563)     allocate(reaction%eqgasspecid(0:reaction%naqcomp,reaction%ngas))
  1564)     reaction%eqgasspecid = 0
  1565)     allocate(reaction%eqgasstoich(0:reaction%naqcomp,reaction%ngas))
  1566)     reaction%eqgasstoich = 0.d0
  1567)     allocate(reaction%eqgash2oid(reaction%ngas))
  1568)     reaction%eqgash2oid = 0
  1569)     allocate(reaction%eqgash2ostoich(reaction%ngas))
  1570)     reaction%eqgash2ostoich = 0.d0
  1571)     allocate(reaction%eqgas_logK(reaction%ngas))
  1572)     reaction%eqgas_logK = 0.d0
  1573)     allocate(reaction%eqgas_logKcoef(reaction%num_dbase_parameters, &
  1574)                                      reaction%ngas))
  1575)     reaction%eqgas_logKcoef = 0.d0
  1576) 
  1577)     ! pack in reaction arrays
  1578)     cur_gas_spec => reaction%gas_species_list
  1579)     igas_spec = 1
  1580)     do
  1581)       if (.not.associated(cur_gas_spec)) exit
  1582) 
  1583)       reaction%gas_species_names(igas_spec) = cur_gas_spec%name
  1584)       reaction%gas_species_print(igas_spec) = cur_gas_spec%print_me .or. &
  1585)                                               reaction%print_all_gas_species
  1586)       ispec = 0
  1587)       do i = 1, cur_gas_spec%dbaserxn%nspec
  1588)         if (cur_gas_spec%dbaserxn%spec_ids(i) /= h2o_id) then
  1589)           ispec = ispec + 1
  1590)           spec_id = cur_gas_spec%dbaserxn%spec_ids(i)
  1591)           if (spec_id > h2o_id) spec_id = spec_id - 1
  1592)           reaction%eqgasspecid(ispec,igas_spec) = spec_id
  1593)           reaction%eqgasstoich(ispec,igas_spec) = &
  1594)             cur_gas_spec%dbaserxn%stoich(i)
  1595)             
  1596)         else ! fill in h2o id and stoich
  1597)           reaction%eqgash2oid(igas_spec) = h2o_id
  1598)           reaction%eqgash2ostoich(igas_spec) = &
  1599)             cur_gas_spec%dbaserxn%stoich(i)
  1600)         endif
  1601)       enddo
  1602)       reaction%eqgasspecid(0,igas_spec) = ispec
  1603) !#if 0      
  1604) !     TODO(Peter): fix argument list
  1605)       call ReactionInitializeLogK_hpt(reaction%eqgas_logKcoef(:,igas_spec), &
  1606)                                    reaction%eqgas_logK(igas_spec), &
  1607)                                   option,reaction)
  1608) !#endif  
  1609)       igas_spec = igas_spec + 1
  1610)       cur_gas_spec => cur_gas_spec%next
  1611)     enddo
  1612) 
  1613)   endif
  1614)   nullify(cur_gas_spec)
  1615)   igas_spec = -1 ! to catch bugs
  1616) 
  1617)   ! minerals
  1618)   ! Count the number of kinetic mineral reactions, max number of prefactors in a
  1619)   !   tst reaction, and the maximum number or species in a prefactor
  1620)   reaction%nkinmnrl = 0
  1621)   max_num_prefactors = 0
  1622)   max_num_prefactor_species = 0
  1623)   cur_mineral => reaction%mineral_list
  1624)   !
  1625)   do
  1626)     if (.not.associated(cur_mineral)) exit
  1627)     if (cur_mineral%itype == MINERAL_KINETIC .and. &
  1628)         associated(cur_mineral%tstrxn)) then
  1629)       ! increment number of kinetic minerals
  1630)       reaction%nkinmnrl = reaction%nkinmnrl + 1
  1631)       cur_prefactor => cur_mineral%tstrxn%prefactor
  1632)       ! zero number of prefactors
  1633)       i = 0
  1634)       do
  1635)         if (.not.associated(cur_prefactor)) exit
  1636)         i = i + 1
  1637)         cur_prefactor_species => cur_prefactor%species
  1638)         ! zero number of prefactor species
  1639)         j = 0
  1640)         do
  1641)           if (.not.associated(cur_prefactor_species)) exit
  1642)           j = j + 1
  1643)           cur_prefactor_species => cur_prefactor_species%next
  1644)         enddo
  1645)         if (j > max_num_prefactor_species) max_num_prefactor_species = j
  1646)         cur_prefactor => cur_prefactor%next
  1647)       enddo
  1648)       if (i > max_num_prefactors) max_num_prefactors = i
  1649)     endif
  1650)     cur_mineral => cur_mineral%next
  1651)   enddo
  1652) 
  1653)   if (reaction%nmnrl > 0) then
  1654)     allocate(reaction%mineral_names(reaction%nmnrl))
  1655)     reaction%mineral_names = ''
  1656)     allocate(reaction%mnrlspecid(0:reaction%naqcomp,reaction%nmnrl))
  1657)     reaction%mnrlspecid = 0
  1658)     allocate(reaction%mnrlstoich(reaction%naqcomp,reaction%nmnrl))
  1659)     reaction%mnrlstoich = 0.d0
  1660)     allocate(reaction%mnrlh2oid(reaction%nmnrl))
  1661)     reaction%mnrlh2oid = 0
  1662)     allocate(reaction%mnrlh2ostoich(reaction%nmnrl))
  1663)     reaction%mnrlh2ostoich = 0.d0
  1664)     allocate(reaction%mnrl_logK(reaction%nmnrl))
  1665)     reaction%mnrl_logK = 0.d0
  1666)     allocate(reaction%mnrl_print(reaction%nmnrl))
  1667)     reaction%mnrl_print = PETSC_FALSE
  1668) 
  1669)     allocate(reaction%mnrl_logKcoef(reaction%num_dbase_parameters, &
  1670)                                     reaction%nmnrl))
  1671)     reaction%mnrl_logKcoef = 0.d0
  1672) 
  1673)     if (reaction%nkinmnrl > 0) then
  1674)       allocate(reaction%kinmnrl_names(reaction%nkinmnrl))
  1675)       reaction%kinmnrl_names = ''
  1676)       allocate(reaction%kinmnrl_print(reaction%nkinmnrl))
  1677)       reaction%kinmnrl_print = PETSC_FALSE
  1678)       allocate(reaction%kinmnrlspecid(0:reaction%naqcomp,reaction%nkinmnrl))
  1679)       reaction%kinmnrlspecid = 0
  1680)       allocate(reaction%kinmnrlstoich(reaction%naqcomp,reaction%nkinmnrl))
  1681)       reaction%kinmnrlstoich = 0.d0
  1682)       allocate(reaction%kinmnrlh2oid(reaction%nkinmnrl))
  1683)       reaction%kinmnrlh2oid = 0
  1684)       allocate(reaction%kinmnrlh2ostoich(reaction%nkinmnrl))
  1685)       reaction%kinmnrlh2ostoich = 0.d0
  1686)       allocate(reaction%kinmnrl_logK(reaction%nkinmnrl))
  1687)       reaction%kinmnrl_logK = 0.d0
  1688) 
  1689)       allocate(reaction%kinmnrl_logKcoef(reaction%num_dbase_parameters, &
  1690)                                          reaction%nkinmnrl))
  1691)       reaction%kinmnrl_logKcoef = 0.d0
  1692) 
  1693)       ! TST Rxn variables
  1694)       allocate(reaction%kinmnrl_affinity_threshold(reaction%nkinmnrl))
  1695)       reaction%kinmnrl_affinity_threshold = 0.d0
  1696)       allocate(reaction%kinmnrl_rate_limiter(reaction%nkinmnrl))
  1697)       reaction%kinmnrl_rate_limiter = 0.d0
  1698)       allocate(reaction%kinmnrl_irreversible(reaction%nkinmnrl))
  1699)       reaction%kinmnrl_irreversible = 0
  1700)       allocate(reaction%kinmnrl_rate_constant(reaction%nkinmnrl))
  1701)       reaction%kinmnrl_rate_constant = 0.d0
  1702)       allocate(reaction%kinmnrl_activation_energy(reaction%nkinmnrl))
  1703)       reaction%kinmnrl_activation_energy = 0.d0
  1704)       allocate(reaction%kinmnrl_molar_vol(reaction%nkinmnrl))
  1705)       reaction%kinmnrl_molar_vol = 0.d0
  1706)       allocate(reaction%kinmnrl_molar_wt(reaction%nkinmnrl))
  1707)       reaction%kinmnrl_molar_wt = 0.d0
  1708) 
  1709)       allocate(reaction%kinmnrl_num_prefactors(reaction%nkinmnrl))
  1710)       reaction%kinmnrl_num_prefactors = 0
  1711)       if (max_num_prefactors > 0) then
  1712)         allocate(reaction%kinmnrl_pref_rate(max_num_prefactors,reaction%nkinmnrl))
  1713)         reaction%kinmnrl_pref_rate = 0.d0
  1714)         allocate(reaction%kinmnrl_pref_activation_energy(max_num_prefactors, &
  1715)                                                          reaction%nkinmnrl))
  1716)         reaction%kinmnrl_pref_activation_energy = 0.d0
  1717)         allocate(reaction%kinmnrl_prefactor_id(0:max_num_prefactor_species, &
  1718)                                              max_num_prefactors,reaction%nkinmnrl))
  1719)         reaction%kinmnrl_prefactor_id = 0
  1720)         allocate(reaction%kinmnrl_pref_alpha(max_num_prefactor_species, &
  1721)                                              max_num_prefactors,reaction%nkinmnrl))
  1722)         reaction%kinmnrl_pref_alpha = 0.d0
  1723)         allocate(reaction%kinmnrl_pref_beta(max_num_prefactor_species, &
  1724)                                              max_num_prefactors,reaction%nkinmnrl))
  1725)         reaction%kinmnrl_pref_beta = 0.d0
  1726)         allocate(reaction%kinmnrl_pref_atten_coef(max_num_prefactor_species, &
  1727)                                              max_num_prefactors,reaction%nkinmnrl))
  1728)         reaction%kinmnrl_pref_atten_coef = 0.d0
  1729)       endif
  1730)     endif
  1731)     
  1732)     cur_mineral => reaction%mineral_list
  1733)     imnrl = 1
  1734)     ikinmnrl = 1
  1735)     do
  1736)       if (.not.associated(cur_mineral)) exit
  1737) 
  1738)       reaction%mineral_names(imnrl) = cur_mineral%name
  1739)       ispec = 0
  1740)       do i = 1, cur_mineral%dbaserxn%nspec
  1741)         if (cur_mineral%dbaserxn%spec_ids(i) /= h2o_id) then
  1742)           ispec = ispec + 1
  1743)           spec_id = cur_mineral%dbaserxn%spec_ids(i)
  1744)           if (spec_id > h2o_id) spec_id = spec_id - 1
  1745)           reaction%mnrlspecid(ispec,imnrl) = spec_id
  1746)           reaction%mnrlstoich(ispec,imnrl) = &
  1747)             cur_mineral%dbaserxn%stoich(i)
  1748)             
  1749)         else ! fill in h2o id and stoich
  1750)           reaction%mnrlh2oid(imnrl) = h2o_id
  1751)           reaction%mnrlh2ostoich(imnrl) = &
  1752)             cur_mineral%dbaserxn%stoich(i)
  1753)         endif
  1754)       enddo
  1755)       reaction%mnrlspecid(0,imnrl) = ispec
  1756) 
  1757)       call ReactionInitializeLogK_hpt(reaction%mnrl_logKcoef(:,imnrl), &
  1758)                                   reaction%mnrl_logK(imnrl), &
  1759)                                   option,reaction)
  1760) 
  1761)       ! geh - for now, the user must specify they want each individual
  1762)       !       mineral printed for non-kinetic reactions (e.g. for SI).
  1763)       reaction%mnrl_print(imnrl) = cur_mineral%print_me
  1764)       if (cur_mineral%itype == MINERAL_KINETIC) then
  1765)         reaction%kinmnrl_names(ikinmnrl) = reaction%mineral_names(imnrl)
  1766)         reaction%kinmnrl_print(ikinmnrl) = cur_mineral%print_me .or. &
  1767)                                            reaction%mineral%print_all
  1768)         reaction%kinmnrlspecid(:,ikinmnrl) = reaction%mnrlspecid(:,imnrl)
  1769)         reaction%kinmnrlstoich(:,ikinmnrl) = reaction%mnrlstoich(:,imnrl)
  1770)         reaction%kinmnrlh2oid(ikinmnrl) = reaction%mnrlh2oid(imnrl)
  1771)         reaction%kinmnrlh2ostoich(ikinmnrl) = reaction%mnrlh2ostoich(imnrl)
  1772) 
  1773)         call ReactionInitializeLogK_hpt(reaction%kinmnrl_logKcoef(:,ikinmnrl), &
  1774)                                         reaction%kinmnrl_logK(ikinmnrl), &
  1775)                                         option,reaction)
  1776) 
  1777)         tstrxn => cur_mineral%tstrxn
  1778)         if (associated(tstrxn)) then
  1779)           ! loop over transition state theory reactions/prefactors
  1780)           cur_prefactor => cur_mineral%tstrxn%prefactor
  1781)           i = 0
  1782)           do
  1783)             if (.not.associated(cur_prefactor)) exit
  1784)             ! ith prefactor
  1785)             i = i + 1
  1786) 
  1787)             reaction%kinmnrl_pref_rate(i,ikinmnrl) = cur_prefactor%rate
  1788)             reaction%kinmnrl_pref_activation_energy(i,ikinmnrl) = &
  1789)               cur_prefactor%activation_energy
  1790) 
  1791)             cur_prefactor_species => cur_prefactor%species
  1792)             j = 0
  1793)             do
  1794)               if (.not.associated(cur_prefactor_species)) exit
  1795)               ! jth prefactor species
  1796)               j = j + 1
  1797)               ! find the prefactor species
  1798)               do ispec = 1, reaction%naqcomp
  1799)                 if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  1800)                                             cur_prefactor_species%name)) then
  1801)                   cur_prefactor_species%id = ispec
  1802)                   exit
  1803)                 endif
  1804)               enddo
  1805)               if (cur_prefactor_species%id == 0) then ! not found
  1806)                 ! negative prefactor_species_id denotes a secondary species
  1807)                 do ispec = 1, reaction%neqcplx
  1808)                   if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
  1809)                                               cur_prefactor_species%name)) then
  1810)                     cur_prefactor_species%id = -ispec
  1811)                     exit
  1812)                   endif
  1813)                 enddo
  1814)               endif
  1815)               if (cur_prefactor_species%id == 0) then
  1816)                 option%io_buffer = 'Kinetic mineral prefactor species "' // &
  1817)                   trim(cur_prefactor_species%name) // &
  1818)                   '" not found among primary or secondary species.'
  1819)                 call printErrMsg(option)
  1820)               endif
  1821)               reaction%kinmnrl_prefactor_id(j,i,ikinmnrl) = cur_prefactor_species%id
  1822)               reaction%kinmnrl_pref_alpha(j,i,ikinmnrl) = cur_prefactor_species%alpha
  1823)               reaction%kinmnrl_pref_beta(j,i,ikinmnrl) = cur_prefactor_species%beta
  1824)               reaction%kinmnrl_pref_atten_coef(j,i,ikinmnrl) = &
  1825)                 cur_prefactor_species%attenuation_coef
  1826)               cur_prefactor_species => cur_prefactor_species%next
  1827)             enddo
  1828)             ! store the number of species
  1829)             reaction%kinmnrl_prefactor_id(0,i,ikinmnrl) = j
  1830)             cur_prefactor => cur_prefactor%next
  1831)           enddo
  1832)           reaction%kinmnrl_num_prefactors(ikinmnrl) = i
  1833) 
  1834)           reaction%kinmnrl_affinity_threshold(ikinmnrl) = &
  1835)             tstrxn%affinity_threshold
  1836)           reaction%kinmnrl_rate_limiter(ikinmnrl) = tstrxn%rate_limiter
  1837)           reaction%kinmnrl_irreversible(ikinmnrl) = tstrxn%irreversible
  1838)           if (reaction%kinmnrl_num_prefactors(ikinmnrl) == 0) then
  1839)             ! no prefactors, rates stored in upper level
  1840)             reaction%kinmnrl_rate_constant(ikinmnrl) = tstrxn%rate
  1841)             reaction%kinmnrl_activation_energy(ikinmnrl) = &
  1842)               tstrxn%activation_energy
  1843)           endif
  1844)         endif ! associated(tstrxn)
  1845) 
  1846)         reaction%kinmnrl_molar_vol(ikinmnrl) = cur_mineral%molar_volume
  1847)         reaction%kinmnrl_molar_wt(ikinmnrl) = cur_mineral%molar_weight
  1848)         ikinmnrl = ikinmnrl + 1
  1849)       endif
  1850) 
  1851)       cur_mineral => cur_mineral%next
  1852)       imnrl = imnrl + 1
  1853)     enddo
  1854)   endif
  1855)   
  1856)   ! colloids
  1857)   reaction%ncoll = GetColloidCount(reaction)
  1858) 
  1859)   if (reaction%ncoll > 0) then
  1860)     allocate(reaction%colloid_names(reaction%ncoll))
  1861)     allocate(reaction%colloid_mobile_fraction(reaction%ncoll))
  1862)     allocate(reaction%colloid_print(reaction%ncoll))
  1863)     reaction%colloid_names = ''
  1864)     reaction%colloid_mobile_fraction = 0.d0
  1865)     reaction%colloid_print = PETSC_FALSE
  1866) 
  1867)     cur_colloid => reaction%colloid_list
  1868)     icoll = 1
  1869)     do
  1870)       if (.not.associated(cur_colloid)) exit
  1871) 
  1872)       reaction%colloid_names(icoll) = cur_colloid%name
  1873)       reaction%colloid_mobile_fraction(icoll) = cur_colloid%mobile_fraction
  1874)       reaction%colloid_print(icoll) = cur_colloid%print_me .or. &
  1875)                                       reaction%print_all_species
  1876)       cur_colloid => cur_colloid%next
  1877)       icoll = icoll + 1
  1878)     enddo
  1879)   endif
  1880)   
  1881)   ! use flags to determine whether a primary aqueous species is included
  1882)   ! in the list of colloid species
  1883)   allocate(flags(reaction%naqcomp))
  1884)   flags = PETSC_FALSE
  1885) 
  1886)   if (reaction%neqsrfcplx > 0) then
  1887)   
  1888)     ! determine max # complexes for a given site
  1889)     icount = 0
  1890)     cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
  1891)     do
  1892)       if (.not.associated(cur_srfcplx_rxn)) exit
  1893)       if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_EQUILIBRIUM .or. &
  1894)           cur_srfcplx_rxn%itype == SRFCMPLX_RXN_MULTIRATE_KINETIC) then
  1895)         isrfcplx = 0
  1896)         cur_srfcplx => cur_srfcplx_rxn%complex_list
  1897)         do
  1898)           if (.not.associated(cur_srfcplx)) exit
  1899)           isrfcplx = isrfcplx + 1
  1900)           cur_srfcplx => cur_srfcplx%next
  1901)         enddo
  1902)         if (isrfcplx > icount) icount = isrfcplx
  1903)       endif
  1904)       cur_srfcplx_rxn => cur_srfcplx_rxn%next
  1905)     enddo
  1906)     nullify(cur_srfcplx_rxn)  
  1907) 
  1908)     allocate(reaction%eqsrfcplx_rxn_to_surf(reaction%neqsrfcplxrxn))
  1909)     reaction%eqsrfcplx_rxn_to_surf = 0
  1910)     
  1911)     allocate(reaction%eqsrfcplx_rxn_surf_type(reaction%neqsrfcplxrxn))
  1912)     reaction%eqsrfcplx_rxn_surf_type = 0
  1913)     
  1914)     allocate(reaction%srfcplxrxn_to_complex(0:icount, &
  1915)                                                  reaction%neqsrfcplxrxn))
  1916)     reaction%srfcplxrxn_to_complex = 0
  1917)     
  1918)     allocate(reaction%eqsrfcplx_site_names(reaction%neqsrfcplxrxn))
  1919)     reaction%eqsrfcplx_site_names = ''
  1920)     
  1921)     allocate(reaction%eqsrfcplx_site_print(reaction%neqsrfcplxrxn))
  1922)     reaction%eqsrfcplx_site_print = PETSC_FALSE
  1923)     
  1924)     allocate(reaction%eqsrfcplx_site_density_print(reaction%neqsrfcplxrxn))
  1925)     reaction%eqsrfcplx_site_density_print = PETSC_FALSE
  1926)     
  1927)     allocate(reaction%eqsrfcplx_rxn_site_density(reaction%neqsrfcplxrxn))
  1928)     reaction%eqsrfcplx_rxn_site_density = 0.d0
  1929)     
  1930)     allocate(reaction%eqsrfcplx_rxn_stoich_flag(reaction%neqsrfcplxrxn))
  1931)     reaction%eqsrfcplx_rxn_stoich_flag = PETSC_FALSE
  1932)     
  1933)     allocate(reaction%eqsrfcplx_names(reaction%neqsrfcplx))
  1934)     reaction%eqsrfcplx_names = ''
  1935)     
  1936)     allocate(reaction%eqsrfcplx_print(reaction%neqsrfcplx))
  1937)     reaction%eqsrfcplx_print = PETSC_FALSE
  1938)     
  1939)     allocate(reaction%srfcplxspecid(0:reaction%naqcomp,reaction%neqsrfcplx))
  1940)     reaction%srfcplxspecid = 0
  1941)     
  1942)     allocate(reaction%eqsrfcplxstoich(reaction%naqcomp,reaction%neqsrfcplx))
  1943)     reaction%eqsrfcplxstoich = 0.d0
  1944)     
  1945)     allocate(reaction%eqsrfcplxh2oid(reaction%neqsrfcplx))
  1946)     reaction%eqsrfcplxh2oid = 0
  1947)     
  1948)     allocate(reaction%eqsrfcplxh2ostoich(reaction%neqsrfcplx))
  1949)     reaction%eqsrfcplxh2ostoich = 0.d0
  1950)     
  1951)     allocate(reaction%eqsrfcplx_free_site_id(reaction%neqsrfcplx))
  1952)     reaction%eqsrfcplx_free_site_id = 0
  1953)     
  1954)     allocate(reaction%eqsrfcplx_free_site_stoich(reaction%neqsrfcplx))
  1955)     reaction%eqsrfcplx_free_site_stoich = 0.d0
  1956)     
  1957) !    allocate(reaction%eqsrfcplx_mineral_id(reaction%neqsrfcplx))
  1958) !    reaction%eqsrfcplx_mineral_id = 0
  1959)     
  1960)     allocate(reaction%eqsrfcplx_logK(reaction%neqsrfcplx))
  1961)     reaction%eqsrfcplx_logK = 0.d0
  1962)     
  1963)     allocate(reaction%eqsrfcplx_logKcoef(reaction%num_dbase_parameters, &
  1964)                                            reaction%neqsrfcplx))
  1965)     reaction%eqsrfcplx_logKcoef = 0.d0
  1966) 
  1967)     allocate(reaction%eqsrfcplx_Z(reaction%neqsrfcplx))
  1968)     reaction%eqsrfcplx_Z = 0.d0
  1969) 
  1970)     isrfcplx = 0
  1971)     irxn = 0
  1972)     cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
  1973)     do
  1974)       if (.not.associated(cur_srfcplx_rxn)) exit
  1975)       
  1976)       if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_EQUILIBRIUM .or. &
  1977)           cur_srfcplx_rxn%itype == SRFCMPLX_RXN_MULTIRATE_KINETIC) then
  1978) 
  1979)         irxn = irxn + 1
  1980)         reaction%eqsrfcplx_site_names(irxn) = cur_srfcplx_rxn%free_site_name
  1981)         reaction%eqsrfcplx_site_print(irxn) = cur_srfcplx_rxn%free_site_print_me .or. &
  1982)                                               reaction%print_all_species
  1983)         reaction%eqsrfcplx_site_density_print(irxn) = &
  1984)                                               cur_srfcplx_rxn%site_density_print_me .or. &
  1985)                                               reaction%print_all_species
  1986)         surface_complexation%srfcplxrxn_surf_type(irxn) = &
  1987)           cur_srfcplx_rxn%surface_itype
  1988)         select case(cur_srfcplx_rxn%surface_itype)
  1989)           case(ROCK_SURFACE)
  1990)             ! nothing to do here as the linkage to rick density is already set
  1991)           case(MINERAL_SURFACE)
  1992)             surface_complexation%srfcplxrxn_to_surf(irxn) = &
  1993)               GetKineticMineralIDFromName(reaction%mineral, &
  1994)                                           cur_srfcplx_rxn%surface_name)
  1995)             if (surface_complexation%srfcplxrxn_to_surf(irxn) < 0) then
  1996)               option%io_buffer = 'Mineral ' // &
  1997)                                   trim(cur_srfcplx_rxn%surface_name) // &
  1998)                                   ' listed in surface complexation ' // &
  1999)                                   'reaction not found in kinetic mineral list'
  2000)               call printErrMsg(option)
  2001)             endif
  2002)           case(COLLOID_SURFACE)
  2003)             surface_complexation%srfcplxrxn_to_surf(irxn) = &
  2004)               GetColloidIDFromName(reaction,cur_srfcplx_rxn%surface_name)
  2005)             if (surface_complexation%srfcplxrxn_to_surf(irxn) < 0) then
  2006)               option%io_buffer = 'Colloid ' // &
  2007)                                   trim(cur_srfcplx_rxn%surface_name) // &
  2008)                                   ' listed in surface complexation ' // &
  2009)                                   'reaction not found in colloid list'
  2010)               call printErrMsg(option)
  2011)             endif
  2012)             ! loop over primary species associated with colloid sorption and
  2013)             ! add to colloid species list, if not already listed
  2014)             cur_srfcplx_in_rxn => cur_srfcplx_rxn%complex_list
  2015)             do
  2016)               if (.not.associated(cur_srfcplx_in_rxn)) exit
  2017)               ! cur_srfcplx2%ptr is a pointer to complex in master list
  2018)               cur_srfcplx => cur_srfcplx_in_rxn%ptr 
  2019)               do i = 1, cur_srfcplx%dbaserxn%nspec
  2020)                 if (cur_srfcplx%dbaserxn%spec_ids(i) == h2o_id) cycle
  2021)                 spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
  2022)                 if (spec_id > h2o_id) spec_id = spec_id - 1              
  2023)                 colloid_species_flag(spec_id) = PETSC_TRUE
  2024)               enddo
  2025)               nullify(cur_srfcplx)
  2026)               cur_srfcplx_in_rxn => cur_srfcplx_in_rxn%next
  2027)             enddo
  2028)           case(NULL_SURFACE)
  2029)             write(word,*) cur_srfcplx_rxn%id
  2030)             option%io_buffer = 'No mineral or colloid name specified ' // &
  2031)               'for equilibrium surface complexation reaction:' // &
  2032)               trim(adjustl(word))
  2033)             call printWrnMsg(option)
  2034)         end select
  2035)         reaction%eqsrfcplx_rxn_site_density(irxn) = cur_srfcplx_rxn%site_density
  2036)               
  2037)         cur_srfcplx => cur_srfcplx_rxn%complex_list
  2038)         do
  2039)           if (.not.associated(cur_srfcplx)) exit
  2040)           
  2041)           isrfcplx = isrfcplx + 1
  2042)           
  2043)           ! set up integer pointers from site to complexes
  2044)           ! increment count for site
  2045)           reaction%srfcplxrxn_to_complex(0,irxn) = &
  2046)             reaction%srfcplxrxn_to_complex(0,irxn) + 1
  2047)           reaction%srfcplxrxn_to_complex( &
  2048)             reaction%srfcplxrxn_to_complex(0,irxn),irxn) = isrfcplx 
  2049)           
  2050)           reaction%eqsrfcplx_names(isrfcplx) = cur_srfcplx%name
  2051)           reaction%eqsrfcplx_print(isrfcplx) = cur_srfcplx%print_me .or. &
  2052)                                               reaction%print_all_species
  2053)           reaction%eqsrfcplx_free_site_id(isrfcplx) = &
  2054)             cur_srfcplx_rxn%free_site_id
  2055)           reaction%eqsrfcplx_free_site_stoich(isrfcplx) =  &
  2056)             cur_srfcplx%free_site_stoich
  2057)             
  2058)           if (cur_srfcplx%free_site_stoich > 1.d0) then
  2059)             reaction%eqsrfcplx_rxn_stoich_flag(irxn) = PETSC_TRUE
  2060)           endif
  2061)    
  2062)           ispec = 0
  2063)           do i = 1, cur_srfcplx%dbaserxn%nspec
  2064)             if (cur_srfcplx%dbaserxn%spec_ids(i) /= h2o_id) then
  2065)               ispec = ispec + 1
  2066)               spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
  2067)               if (spec_id > h2o_id) spec_id = spec_id - 1
  2068)               reaction%srfcplxspecid(ispec,isrfcplx) = spec_id
  2069)               reaction%eqsrfcplxstoich(ispec,isrfcplx) = &
  2070)                 cur_srfcplx%dbaserxn%stoich(i)
  2071)               
  2072)             else ! fill in h2o id and stoich
  2073)               reaction%eqsrfcplxh2oid(isrfcplx) = h2o_id
  2074)               reaction%eqsrfcplxh2ostoich(isrfcplx) = &
  2075)                 cur_srfcplx%dbaserxn%stoich(i)
  2076)             endif
  2077)           enddo
  2078)           reaction%srfcplxspecid(0,isrfcplx) = ispec
  2079)           call ReactionInitializeLogK_hpt(reaction%eqsrfcplx_logKcoef(:,isrfcplx), &
  2080)                                           reaction%eqsrfcplx_logK(isrfcplx), &
  2081)                                           option,reaction)
  2082) 
  2083)           reaction%eqsrfcplx_Z(isrfcplx) = cur_srfcplx%Z
  2084) 
  2085)           cur_srfcplx => cur_srfcplx%next
  2086)         enddo
  2087)         nullify(cur_srfcplx)
  2088)         
  2089)       endif
  2090)       cur_srfcplx_rxn => cur_srfcplx_rxn%next
  2091)     enddo
  2092)     nullify(cur_srfcplx_rxn)  
  2093)   
  2094)   endif
  2095)   
  2096)   if (reaction%nkinsrfcplxrxn > 0) then
  2097)   
  2098)     ! determine max # complexes for a given site
  2099)     icount = 0
  2100)     cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
  2101)     do
  2102)       if (.not.associated(cur_srfcplx_rxn)) exit
  2103)       if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_KINETIC) then
  2104)         isrfcplx = 0
  2105)         cur_srfcplx => cur_srfcplx_rxn%complex_list
  2106)         do
  2107)           if (.not.associated(cur_srfcplx)) exit
  2108)           isrfcplx = isrfcplx + 1
  2109)           cur_srfcplx => cur_srfcplx%next
  2110)         enddo
  2111)         if (isrfcplx > icount) icount = isrfcplx
  2112)       endif
  2113)       cur_srfcplx_rxn => cur_srfcplx_rxn%next
  2114)     enddo
  2115)     nullify(cur_srfcplx_rxn) 
  2116)     allocate(reaction%kinsrfcplx_rxn_to_complex(0:icount, &
  2117)                                                  reaction%nkinsrfcplxrxn))
  2118)     reaction%kinsrfcplx_rxn_to_complex = 0
  2119)     
  2120)     allocate(reaction%kinsrfcplx_rxn_to_site(reaction%nkinsrfcplxrxn))
  2121)     reaction%kinsrfcplx_rxn_to_site = 0
  2122)     
  2123)     allocate(reaction%kinsrfcplx_rxn_to_surf(reaction%nkinsrfcplxrxn))
  2124)     reaction%kinsrfcplx_rxn_to_surf = 0
  2125)     
  2126)     allocate(reaction%kinsrfcplx_rxn_surf_type(reaction%nkinsrfcplxrxn))
  2127)     reaction%kinsrfcplx_rxn_surf_type = 0
  2128)     
  2129)     allocate(reaction%kinsrfcplx_site_names(reaction%nkinsrfcplxrxn))
  2130)     reaction%kinsrfcplx_site_names = ''
  2131)     
  2132)     allocate(reaction%kinsrfcplx_site_print(reaction%nkinsrfcplxrxn))
  2133)     reaction%kinsrfcplx_site_print = PETSC_FALSE
  2134)     
  2135)     allocate(reaction%kinsrfcplx_rxn_site_density(reaction%nkinsrfcplxrxn))
  2136)     reaction%kinsrfcplx_rxn_site_density = 0.d0
  2137)     
  2138)     allocate(reaction%kinsrfcplx_rxn_stoich_flag(reaction%nkinsrfcplxrxn))
  2139)     reaction%kinsrfcplx_rxn_stoich_flag = PETSC_FALSE
  2140)     
  2141)     allocate(reaction%kinsrfcplx_names(reaction%nkinsrfcplx))
  2142)     reaction%kinsrfcplx_names = ''
  2143)     
  2144)     allocate(reaction%kinsrfcplx_print(reaction%nkinsrfcplx))
  2145)     reaction%kinsrfcplx_print = PETSC_FALSE
  2146)     
  2147)     allocate(reaction%kinsrfcplxspecid(0:reaction%naqcomp,reaction%nkinsrfcplx))
  2148)     reaction%kinsrfcplxspecid = 0
  2149)     
  2150)     allocate(reaction%kinsrfcplxstoich(reaction%naqcomp,reaction%nkinsrfcplx))
  2151)     reaction%kinsrfcplxstoich = 0.d0
  2152)     
  2153)     allocate(reaction%kinsrfcplxh2oid(reaction%nkinsrfcplx))
  2154)     reaction%kinsrfcplxh2oid = 0
  2155)     
  2156)     allocate(reaction%kinsrfcplxh2ostoich(reaction%nkinsrfcplx))
  2157)     reaction%kinsrfcplxh2ostoich = 0.d0
  2158)     
  2159)     allocate(reaction%kinsrfcplx_free_site_id(reaction%nkinsrfcplx))
  2160)     reaction%kinsrfcplx_free_site_id = 0
  2161)     
  2162)     allocate(reaction%kinsrfcplx_free_site_stoich(reaction%nkinsrfcplx))
  2163)     reaction%kinsrfcplx_free_site_stoich = 0.d0
  2164)     
  2165)     allocate(reaction%kinsrfcplx_forward_rate(reaction%nkinsrfcplx))
  2166)     reaction%kinsrfcplx_forward_rate = 0.d0
  2167)     
  2168)     allocate(reaction%kinsrfcplx_backward_rate(reaction%nkinsrfcplx))
  2169)     reaction%kinsrfcplx_backward_rate = 0.d0
  2170) 
  2171) !    allocate(reaction%kinsrfcplx_logK(reaction%nkinsrfcplx))
  2172) !    reaction%kinsrfcplx_logK = 0.d0
  2173) !#if TEMP_DEPENDENT_LOGK
  2174) !    allocate(reaction%kinsrfcplx_logKcoef(FIVE_INTEGER,reaction%nkinsrfcplx))
  2175) !    reaction%kinsrfcplx_logKcoef = 0.d0
  2176) !#else
  2177) !    allocate(reaction%kinsrfcplx_logKcoef(reaction%num_dbase_temperatures, &
  2178) !                                           reaction%nkinsrfcplx))
  2179) !    reaction%kinsrfcplx_logKcoef = 0.d0
  2180) !#endif
  2181)     allocate(reaction%kinsrfcplx_Z(reaction%nkinsrfcplx))
  2182)     reaction%kinsrfcplx_Z = 0.d0
  2183) 
  2184)     isrfcplx = 0
  2185)     irxn = 0
  2186)     cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
  2187)     do
  2188)       if (.not.associated(cur_srfcplx_rxn)) exit
  2189)       
  2190)       if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_KINETIC) then
  2191) 
  2192)         irxn = irxn + 1
  2193)         
  2194)         reaction%kinsrfcplx_site_names(irxn) = cur_srfcplx_rxn%free_site_name
  2195)         reaction%kinsrfcplx_site_print(irxn) = cur_srfcplx_rxn%free_site_print_me .or. &
  2196)                                               reaction%print_all_species
  2197)         if (len_trim(cur_srfcplx_rxn%mineral_name) > 1) then
  2198)           reaction%kinsrfcplx_rxn_surf_type(irxn) = MINERAL_SURFACE
  2199)           reaction%kinsrfcplx_rxn_to_surf(irxn) = &
  2200)             GetKineticMineralIDFromName(reaction,cur_srfcplx_rxn%mineral_name)
  2201)           if (reaction%kinsrfcplx_rxn_to_surf(irxn) < 0) then
  2202)             option%io_buffer = 'Mineral ' // trim(cur_srfcplx_rxn%mineral_name) // &
  2203)                                'listed in kinetic surface complexation ' // &
  2204)                                'reaction not found in mineral list'
  2205)             call printErrMsg(option)
  2206)           endif
  2207)         else if (len_trim(cur_srfcplx_rxn%colloid_name) > 1) then
  2208)           reaction%kinsrfcplx_rxn_surf_type(irxn) = COLLOID_SURFACE
  2209)           reaction%kinsrfcplx_rxn_to_surf(irxn) = &
  2210)             GetColloidIDFromName(reaction,cur_srfcplx_rxn%colloid_name)
  2211)           if (reaction%kinsrfcplx_rxn_to_surf(irxn) < 0) then
  2212)             option%io_buffer = 'Colloid ' // trim(cur_srfcplx_rxn%colloid_name) // &
  2213)                                'listed in kinetic surface complexation ' // &
  2214)                                'reaction not found in colloid list'
  2215)             call printErrMsg(option)
  2216)           endif
  2217)           ! loop over primary species associated with colloid sorption and
  2218)           ! add to colloid species list, if not already listed
  2219)           cur_srfcplx => cur_srfcplx_rxn%complex_list
  2220)           do
  2221)             if (.not.associated(cur_srfcplx)) exit
  2222)             do i = 1, cur_srfcplx%dbaserxn%nspec
  2223)               if (cur_srfcplx%dbaserxn%spec_ids(i) == h2o_id) cycle
  2224)               spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
  2225)               if (spec_id > h2o_id) spec_id = spec_id - 1              
  2226)               flags(spec_id) = PETSC_TRUE
  2227)             enddo
  2228)             cur_srfcplx => cur_srfcplx%next
  2229)           enddo
  2230) 
  2231)         else
  2232)           write(word,*) cur_srfcplx_rxn%id
  2233)           write(word,*) cur_srfcplx_rxn%id
  2234)           option%io_buffer = 'No mineral or colloid name specified for ' // &
  2235)             'kinetic surface complexation reaction:' // &
  2236)             trim(adjustl(word))
  2237)           call printWrnMsg(option)
  2238)           reaction%kinsrfcplx_rxn_surf_type(irxn) = NULL_SURFACE          
  2239)         endif
  2240)         reaction%kinsrfcplx_rxn_site_density(irxn) = cur_srfcplx_rxn%site_density
  2241)               
  2242)         cur_srfcplx => cur_srfcplx_rxn%complex_list
  2243)         do
  2244)           if (.not.associated(cur_srfcplx)) exit
  2245)           
  2246)           isrfcplx = isrfcplx + 1
  2247) 
  2248)           reaction%kinsrfcplx_forward_rate(isrfcplx) = cur_srfcplx%forward_rate
  2249)           if (Uninitialized(cur_srfcplx%backward_rate)) then
  2250)             ! backward rate will be calculated based on Kb = Kf * Keq
  2251)             call Interpolate(temp_high,temp_low,option%reference_temperature, &
  2252)                              cur_srfcplx%dbaserxn%logK(itemp_high), &
  2253)                              cur_srfcplx%dbaserxn%logK(itemp_low), &
  2254)                              value)
  2255)             reaction%kinsrfcplx_backward_rate(isrfcplx) = 10.d0**value * &
  2256)                                                           cur_srfcplx%forward_rate
  2257)           else
  2258)             reaction%kinsrfcplx_backward_rate(isrfcplx) = cur_srfcplx%backward_rate
  2259)           endif
  2260)           ! set up integer pointers from site to complexes
  2261)           ! increment count for site
  2262)           reaction%kinsrfcplx_rxn_to_complex(0,irxn) = &
  2263)             reaction%kinsrfcplx_rxn_to_complex(0,irxn) + 1
  2264)           reaction%kinsrfcplx_rxn_to_complex( &
  2265)             reaction%kinsrfcplx_rxn_to_complex(0,irxn),irxn) = isrfcplx 
  2266)           reaction%kinsrfcplx_rxn_to_site(irxn) = cur_srfcplx_rxn%free_site_id
  2267) 
  2268)           
  2269)           reaction%kinsrfcplx_names(isrfcplx) = cur_srfcplx%name
  2270)           reaction%kinsrfcplx_print(isrfcplx) = cur_srfcplx%print_me .or. &
  2271)                                               reaction%print_all_species
  2272)           reaction%kinsrfcplx_free_site_stoich(isrfcplx) =  &
  2273)             cur_srfcplx%free_site_stoich
  2274)             
  2275)           if (cur_srfcplx%free_site_stoich > 1.d0) then
  2276)             reaction%kinsrfcplx_rxn_stoich_flag(irxn) = PETSC_TRUE
  2277)           endif
  2278)    
  2279)           ispec = 0
  2280)           do i = 1, cur_srfcplx%dbaserxn%nspec
  2281)             if (cur_srfcplx%dbaserxn%spec_ids(i) /= h2o_id) then
  2282)               ispec = ispec + 1
  2283)               spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
  2284)               if (spec_id > h2o_id) spec_id = spec_id - 1
  2285)               reaction%kinsrfcplxspecid(ispec,isrfcplx) = spec_id
  2286)               reaction%kinsrfcplxstoich(ispec,isrfcplx) = &
  2287)                 cur_srfcplx%dbaserxn%stoich(i)
  2288)             else ! fill in h2o id and stoich
  2289)               reaction%kinsrfcplxh2oid(isrfcplx) = h2o_id
  2290)               reaction%kinsrfcplxh2ostoich(isrfcplx) = &
  2291)                 cur_srfcplx%dbaserxn%stoich(i)
  2292)             endif
  2293)           enddo
  2294)           reaction%kinsrfcplxspecid(0,isrfcplx) = ispec
  2295) !  Chuan added, for surface complex reaction, the new data base 
  2296)           cur_srfcplx%dbaserxn%logK(:) = cur_srfcplx%dbaserxn%logKCoeff_hpt(:)
  2297) !  #if TEMP_DEPENDENT_LOGK
  2298) !        call ReactionFitLogKCoef(reaction%kinsrfcplx_logKcoef(:,isrfcplx),cur_srfcplx%dbaserxn%logK, &
  2299) !                                 reaction%kinsrfcplx_names(isrfcplx), &
  2300) !                                 option,reaction)
  2301) !        call ReactionInitializeLogK(reaction%kinsrfcplx_logKcoef(:,isrfcplx), &
  2302) !                                    cur_srfcplx%dbaserxn%logK, &
  2303) !                                    reaction%kinsrfcplx_logK(isrfcplx), &
  2304) !                                    option,reaction)
  2305) !  #else
  2306) !          call Interpolate(temp_high,temp_low,option%reference_temperature, &
  2307) !                           cur_srfcplx%dbaserxn%logK(itemp_high), &
  2308) !                           cur_srfcplx%dbaserxn%logK(itemp_low), &
  2309) !                           reaction%kinsrfcplx_logK(isrfcplx))
  2310) !          !reaction%kinsrfcplx_logK(isrfcplx) = cur_srfcplx%dbaserxn%logK(option%itemp_ref)
  2311) !  #endif
  2312)           reaction%kinsrfcplx_Z(isrfcplx) = cur_srfcplx%Z
  2313) 
  2314)           cur_srfcplx => cur_srfcplx%next
  2315)         enddo
  2316)         nullify(cur_srfcplx)
  2317)         
  2318)       endif
  2319)       
  2320)       cur_srfcplx_rxn => cur_srfcplx_rxn%next
  2321)     enddo
  2322)     nullify(cur_srfcplx_rxn)  
  2323)   
  2324)   endif
  2325) 
  2326) 
  2327)   ! allocate colloids species names, mappings, etc.
  2328)   reaction%ncollcomp = 0
  2329)   icount = 0
  2330)   do i = 1, reaction%naqcomp
  2331)     if (flags(i)) then 
  2332)       icount = icount + 1
  2333)     endif
  2334)   enddo
  2335)   if (icount > 0) then
  2336)     allocate(reaction%pri_spec_to_coll_spec(reaction%naqcomp))
  2337)     allocate(reaction%colloid_species_names(icount))
  2338)     allocate(reaction%coll_spec_to_pri_spec(icount))
  2339)     reaction%pri_spec_to_coll_spec = UNINITIALIZED_INTEGER
  2340)     reaction%coll_spec_to_pri_spec = UNINITIALIZED_INTEGER
  2341)     reaction%colloid_species_names = ''
  2342)     reaction%ncollcomp = icount
  2343)     icount = 0
  2344)     do i = 1, reaction%naqcomp
  2345)       if (flags(i)) then
  2346)         icount = icount + 1
  2347)         reaction%colloid_species_names(icount) = &
  2348)           trim(reaction%primary_species_names(i))
  2349)         reaction%coll_spec_to_pri_spec(icount) = i
  2350)         reaction%pri_spec_to_coll_spec(i) = icount
  2351)       endif
  2352)     enddo
  2353)     if (minval(reaction%coll_spec_to_pri_spec) < 1) then
  2354)       option%io_buffer = 'Species colloid surface complexation reaction not' // &
  2355)                          ' recognized among primary species'
  2356)       call printErrMsg(option)
  2357)     endif
  2358)     allocate(reaction%total_sorb_mobile_print(reaction%ncollcomp))
  2359)     reaction%total_sorb_mobile_print = PETSC_FALSE
  2360)     do i = 1, reaction%ncollcomp
  2361)       reaction%total_sorb_mobile_print(i) = &
  2362)         (reaction%primary_species_print(reaction%coll_spec_to_pri_spec(i)) .or. &
  2363)          reaction%print_all_species) .and. &
  2364)         reaction%print_total_sorb_mobile
  2365)     enddo
  2366)   endif
  2367)   deallocate(flags)
  2368) 
  2369)   if (reaction%neqionxrxn > 0) then
  2370) 
  2371)     ! determine max # cations for a given ionx exchange rxn
  2372)     icount = 0
  2373)     cur_ionx_rxn => reaction%ion_exchange_rxn_list
  2374)     do
  2375)       if (.not.associated(cur_ionx_rxn)) exit
  2376)       ication = 0
  2377)       cur_cation => cur_ionx_rxn%cation_list
  2378)       do
  2379)         if (.not.associated(cur_cation)) exit
  2380)         ication = ication + 1
  2381)         cur_cation => cur_cation%next
  2382)       enddo
  2383)       if (ication > icount) icount = ication
  2384)       cur_ionx_rxn => cur_ionx_rxn%next
  2385)     enddo
  2386)     nullify(cur_ionx_rxn)
  2387)     
  2388)     allocate(reaction%eqionx_rxn_cationid(0:icount,reaction%neqionxrxn))
  2389)     reaction%eqionx_rxn_cationid = 0
  2390)     allocate(reaction%eqionx_rxn_Z_flag(reaction%neqionxrxn))
  2391)     reaction%eqionx_rxn_Z_flag = PETSC_FALSE
  2392)     allocate(reaction%eqionx_rxn_cation_X_offset(reaction%neqionxrxn))
  2393)     reaction%eqionx_rxn_cation_X_offset = 0
  2394)     allocate(reaction%eqionx_rxn_CEC(reaction%neqionxrxn))
  2395)     reaction%eqionx_rxn_CEC = 0.d0
  2396)     allocate(reaction%eqionx_rxn_k(icount,reaction%neqionxrxn))
  2397)     reaction%eqionx_rxn_k = 0.d0
  2398) 
  2399)     irxn = 0
  2400)     icount = 0
  2401)     cur_ionx_rxn => reaction%ion_exchange_rxn_list
  2402)     do
  2403)       if (.not.associated(cur_ionx_rxn)) exit
  2404)       irxn = irxn + 1
  2405)       ication = 0
  2406)       reaction%eqionx_rxn_CEC(irxn) = cur_ionx_rxn%CEC
  2407)         ! compute the offset to the first cation in rxn
  2408)       reaction%eqionx_rxn_cation_X_offset(irxn) = icount
  2409)         
  2410)       cur_cation => cur_ionx_rxn%cation_list
  2411)       do
  2412)         if (.not.associated(cur_cation)) exit
  2413)         ication = ication + 1
  2414)         icount = icount + 1
  2415)         reaction%eqionx_rxn_k(ication,irxn) = cur_cation%k
  2416) 
  2417)         found = PETSC_FALSE
  2418)         do i = 1, reaction%naqcomp
  2419)           if (StringCompare(cur_cation%name, &
  2420)                               reaction%primary_species_names(i), &
  2421)                               MAXWORDLENGTH)) then
  2422)             reaction%eqionx_rxn_cationid(ication,irxn) = i
  2423)             found = PETSC_TRUE        
  2424)           endif
  2425)         enddo
  2426)         if (.not.found) then
  2427)           option%io_buffer = 'Cation ' // trim(cur_cation%name) // &
  2428)                    ' in ion exchange reaction' // &
  2429)                    ' not found in swapped basis.'
  2430)           call printErrMsg(option)     
  2431)         endif
  2432)         cur_cation => cur_cation%next
  2433)       enddo
  2434)       reaction%eqionx_rxn_cationid(0,irxn) = ication
  2435)       ! Find any Zi /= Zj for all species i, j
  2436)       found = PETSC_FALSE
  2437)       do i = 1, reaction%eqionx_rxn_cationid(0,irxn)
  2438)         do j = 1, reaction%eqionx_rxn_cationid(0,irxn)
  2439)           if (abs(reaction%primary_spec_Z(reaction%eqionx_rxn_cationid(i,irxn))- &
  2440)                   reaction%primary_spec_Z(reaction%eqionx_rxn_cationid(j,irxn))) > &
  2441)               0.1d0) then
  2442)             found = PETSC_TRUE
  2443)             exit
  2444)           endif
  2445)         enddo
  2446)         if (found) exit
  2447)       enddo
  2448)       reaction%eqionx_rxn_Z_flag(irxn) = found
  2449)       cur_ionx_rxn => cur_ionx_rxn%next
  2450)     enddo
  2451)     nullify(cur_ionx_rxn)
  2452) 
  2453)   endif
  2454)   
  2455)   ! general reaction
  2456)   
  2457)   if (reaction%ngeneral_rxn > 0) then
  2458)   
  2459)     ! process reaction equation into the database format
  2460)     cur_general_rxn => reaction%general_rxn_list
  2461)     do
  2462)       if (.not.associated(cur_general_rxn)) exit
  2463)       
  2464)       ! count # species
  2465)       icount = 0
  2466)       string = cur_general_rxn%reaction
  2467)       do
  2468)         ierr = 0
  2469)         call InputReadWord(string,word,PETSC_TRUE,ierr)
  2470)         if (InputError(ierr)) exit
  2471) 
  2472)         select case(word)
  2473)           case('+')
  2474)           case('-')
  2475)           case('=','<=>','<->')
  2476)           case default
  2477)           ! try reading as double precision
  2478)           string2 = word
  2479)           if (.not.StringStartsWithAlpha(string2)) then
  2480)             ! the word is the stoichiometry value
  2481)           else
  2482)             ! the word is the species name
  2483)             icount = icount + 1
  2484)           endif
  2485)         end select
  2486) 
  2487)       enddo
  2488)       
  2489)       ! load species into database format
  2490)       
  2491)       cur_general_rxn%dbaserxn => DatabaseRxnCreate()
  2492)       
  2493)       dbaserxn => DatabaseRxnCreate()
  2494)       dbaserxn%nspec = icount
  2495)       allocate(dbaserxn%spec_name(icount))
  2496)       dbaserxn%spec_name = ''
  2497)       allocate(dbaserxn%stoich(icount))
  2498)       dbaserxn%stoich = UNINITIALIZED_DOUBLE
  2499)       allocate(dbaserxn%spec_ids(icount))
  2500)       dbaserxn%spec_ids = 0
  2501) 
  2502)       string = cur_general_rxn%reaction
  2503)       icount = 1
  2504)       ! midpoint points to the first product species, as in
  2505)       ! reactant1 + reactant2 <-> product1 + product2
  2506)       midpoint = 0
  2507)       negative_flag = PETSC_FALSE
  2508)       do
  2509)         ierr = 0
  2510)         call InputReadWord(string,word,PETSC_TRUE,ierr)
  2511)         if (InputError(ierr)) exit
  2512) 
  2513)         select case(word)
  2514)           case('+')
  2515)           case('-')
  2516)             ! toggle negative flag
  2517)             if (negative_flag) then
  2518)               negative_flag = PETSC_FALSE
  2519)             else
  2520)               negative_flag = PETSC_TRUE
  2521)             endif
  2522)           case('=','<=>','<->')
  2523)             midpoint = icount
  2524)           case default
  2525)             ! try reading as double precision
  2526)             string2 = word
  2527)             if (.not.StringStartsWithAlpha(string2)) then
  2528)               ! negate if a product
  2529)               call InputReadDouble(string2,option,value,ierr)
  2530)               ! negate if negative stoichiometry
  2531)               if (negative_flag) value = -1.0*value
  2532)               dbaserxn%stoich(icount) = value
  2533)             else
  2534)               dbaserxn%spec_name(icount) = word
  2535)               if (negative_flag .and. &
  2536)                   (dbaserxn%stoich(icount) + 999.d0) < 1.d-10) then
  2537)                 dbaserxn%stoich(icount) = -1.d0
  2538)               endif
  2539) 
  2540)               ! set the primary species id
  2541)               found = PETSC_FALSE
  2542)               do i = 1, reaction%naqcomp
  2543)                 if (StringCompare(word, &
  2544)                                   reaction%primary_species_names(i), &
  2545)                                   MAXWORDLENGTH)) then
  2546)                   dbaserxn%spec_ids(icount) = i
  2547)                   found = PETSC_TRUE
  2548)                   exit      
  2549)                 endif
  2550)               enddo
  2551)               ! check water
  2552)               word2 = 'H2O'
  2553)               if (StringCompareIgnoreCase(word,word2)) then
  2554)                 ! don't increment icount
  2555)                 exit
  2556)               endif              
  2557)               if (.not.found) then
  2558)                 option%io_buffer = 'Species ' // trim(word) // &
  2559)                          ' in general reaction' // &
  2560)                          ' not found among primary species list.'
  2561)                 call printErrMsg(option)     
  2562)               endif
  2563)               icount = icount + 1
  2564)             endif
  2565)             negative_flag = PETSC_FALSE
  2566)         end select
  2567) 
  2568)       enddo
  2569)       
  2570)       ! if no stoichiometry specified, default = 1.
  2571)       do i = 1, dbaserxn%nspec
  2572)         if ((dbaserxn%stoich(i) + 999.d0) < 1.d-10) dbaserxn%stoich(i) = 1.d0
  2573)       enddo
  2574)       ! negate stoichiometries after midpoint
  2575)       do i = midpoint, dbaserxn%nspec
  2576)         dbaserxn%stoich(i) = -1.d0*dbaserxn%stoich(i)
  2577)       enddo
  2578)       ! now negate all stoichiometries to have - for reactants; + for products
  2579)       do i = 1, dbaserxn%nspec
  2580)         dbaserxn%stoich(i) = -1.d0*dbaserxn%stoich(i)
  2581)       enddo
  2582)       ! reorder species ids in ascending order
  2583)       do i = 1, dbaserxn%nspec
  2584)         do j = i+1, dbaserxn%nspec
  2585)           if (dbaserxn%spec_ids(i) > dbaserxn%spec_ids(j)) then
  2586)             ! swap ids
  2587)             idum = dbaserxn%spec_ids(j)
  2588)             dbaserxn%spec_ids(j) = dbaserxn%spec_ids(i)
  2589)             dbaserxn%spec_ids(i) = idum
  2590)             ! swap stoichiometry
  2591)             value = dbaserxn%stoich(j)
  2592)             dbaserxn%stoich(j) = dbaserxn%stoich(i)
  2593)             dbaserxn%stoich(i) = value
  2594)             ! swap names
  2595)             word = dbaserxn%spec_name(j)
  2596)             dbaserxn%spec_name(j) = dbaserxn%spec_name(i)
  2597)             dbaserxn%spec_name(i) = word
  2598)           endif
  2599)         enddo
  2600)       enddo
  2601)       
  2602)       cur_general_rxn%dbaserxn => dbaserxn
  2603)       
  2604)       cur_general_rxn => cur_general_rxn%next
  2605)     enddo
  2606)     nullify(cur_general_rxn)
  2607) 
  2608)     ! determine max # species, forward species and backward species
  2609)     !  for a given general rxn
  2610)     max_species_count = 0
  2611)     max_forward_count = 0
  2612)     max_backward_count = 0
  2613)     cur_general_rxn => reaction%general_rxn_list
  2614)     do
  2615)       if (.not.associated(cur_general_rxn)) exit
  2616) 
  2617)       ! zero count
  2618)       forward_count = 0
  2619)       backward_count = 0   
  2620) 
  2621)       ! max species in reaction
  2622)       species_count = cur_general_rxn%dbaserxn%nspec
  2623) 
  2624)       ! sum forward and reverse species
  2625)       dbaserxn => cur_general_rxn%dbaserxn
  2626)       do i = 1, dbaserxn%nspec
  2627)         if (dbaserxn%stoich(i) < 0.d0) then
  2628)           forward_count = forward_count + 1
  2629)         else if (dbaserxn%stoich(i) > 0.d0) then
  2630)           backward_count = backward_count + 1
  2631)         endif
  2632)       enddo
  2633) 
  2634)       ! calculate maximum
  2635)       if (forward_count > max_forward_count) max_forward_count = forward_count
  2636)       if (backward_count > max_backward_count) max_backward_count = backward_count
  2637)       if (species_count > max_species_count) max_species_count = species_count
  2638) 
  2639)       cur_general_rxn => cur_general_rxn%next
  2640) 
  2641)     enddo
  2642)     nullify(cur_general_rxn)
  2643)     
  2644)     allocate(reaction%generalspecid(0:max_species_count,reaction%ngeneral_rxn))
  2645)     reaction%generalspecid = 0
  2646)     allocate(reaction%generalstoich(max_species_count,reaction%ngeneral_rxn))
  2647)     reaction%generalstoich = 0.d0
  2648)     allocate(reaction%generalforwardspecid(0:max_forward_count,reaction%ngeneral_rxn))
  2649)     reaction%generalforwardspecid = 0
  2650)     allocate(reaction%generalforwardstoich(max_forward_count,reaction%ngeneral_rxn))
  2651)     reaction%generalforwardstoich = 0.d0
  2652)     allocate(reaction%generalbackwardspecid(0:max_backward_count,reaction%ngeneral_rxn))
  2653)     reaction%generalbackwardspecid = 0
  2654)     allocate(reaction%generalbackwardstoich(max_backward_count,reaction%ngeneral_rxn))
  2655)     reaction%generalbackwardstoich = 0.d0
  2656)     allocate(reaction%generalh2oid(reaction%ngeneral_rxn))
  2657)     reaction%generalh2oid = 0
  2658)     allocate(reaction%generalh2ostoich(reaction%ngeneral_rxn))
  2659)     reaction%generalh2ostoich = 0.d0
  2660)     allocate(reaction%general_kf(reaction%ngeneral_rxn))
  2661)     reaction%general_kf = 0.d0
  2662)     allocate(reaction%general_kr(reaction%ngeneral_rxn))    
  2663)     reaction%general_kr = 0.d0
  2664) 
  2665)     ! load the data into the compressed arrays
  2666)     irxn = 0
  2667)     cur_general_rxn => reaction%general_rxn_list
  2668)     do
  2669)       if (.not.associated(cur_general_rxn)) exit
  2670)       
  2671)       dbaserxn => cur_general_rxn%dbaserxn
  2672)       
  2673)       irxn = irxn + 1
  2674)      
  2675)       forward_count = 0
  2676)       backward_count = 0
  2677)       do i = 1, dbaserxn%nspec
  2678)         reaction%generalspecid(i,irxn) = dbaserxn%spec_ids(i)
  2679)         reaction%generalstoich(i,irxn) = dbaserxn%stoich(i)
  2680)         if (dbaserxn%stoich(i) < 0.d0) then
  2681)           forward_count = forward_count + 1
  2682)           reaction%generalforwardspecid(forward_count,irxn) = dbaserxn%spec_ids(i)
  2683)           ! ensure that forward stoich is positive for rate expression
  2684)           reaction%generalforwardstoich(forward_count,irxn) = dabs(dbaserxn%stoich(i))
  2685)         else if (dbaserxn%stoich(i) > 0.d0) then
  2686)           backward_count = backward_count + 1
  2687)           reaction%generalbackwardspecid(backward_count,irxn) = dbaserxn%spec_ids(i)
  2688)           reaction%generalbackwardstoich(backward_count,irxn) = dbaserxn%stoich(i)
  2689)         endif
  2690)       enddo
  2691)       reaction%generalspecid(0,irxn) = dbaserxn%nspec
  2692)       reaction%generalforwardspecid(0,irxn) = forward_count
  2693)       reaction%generalbackwardspecid(0,irxn) = backward_count
  2694)       
  2695)       reaction%general_kf(irxn) = cur_general_rxn%forward_rate
  2696)       reaction%general_kr(irxn) = cur_general_rxn%backward_rate
  2697)       
  2698)       cur_general_rxn => cur_general_rxn%next
  2699)       
  2700)     enddo
  2701)               
  2702)   endif  
  2703)   
  2704)   ! Kd reactions
  2705)   
  2706)   if (reaction%neqkdrxn > 0) then
  2707)   
  2708)     ! allocate arrays
  2709)     allocate(reaction%eqkdspecid(reaction%neqkdrxn))
  2710)     reaction%eqkdspecid = 0
  2711)     allocate(reaction%eqkdtype(reaction%neqkdrxn))
  2712)     reaction%eqkdtype = 0
  2713)     allocate(reaction%eqkddistcoef(reaction%neqkdrxn))
  2714)     reaction%eqkddistcoef = 0.d0
  2715)     allocate(reaction%eqkdlangmuirb(reaction%neqkdrxn))
  2716)     reaction%eqkdlangmuirb = 0.d0
  2717)     allocate(reaction%eqkdfreundlichn(reaction%neqkdrxn))
  2718)     reaction%eqkdfreundlichn = 0.d0
  2719) 
  2720)     cur_kd_rxn => reaction%kd_rxn_list
  2721)     irxn = 0
  2722)     do  
  2723)       if (.not.associated(cur_kd_rxn)) exit
  2724) 
  2725)       irxn = irxn + 1
  2726) 
  2727)       found = PETSC_FALSE
  2728)       do i = 1, reaction%naqcomp
  2729)         if (StringCompare(cur_kd_rxn%species_name, &
  2730)                           reaction%primary_species_names(i), &
  2731)                           MAXWORDLENGTH)) then
  2732)           reaction%eqkdspecid(irxn) = i
  2733)           found = PETSC_TRUE
  2734)           exit      
  2735)         endif
  2736)       enddo
  2737)       if (.not.found) then
  2738)         option%io_buffer = 'Species ' // trim(word) // &
  2739)                  ' in kd reaction' // &
  2740)                  ' not found among primary species list.'
  2741)         call printErrMsg(option)     
  2742)       endif
  2743)       reaction%eqkdtype(irxn) = cur_kd_rxn%itype
  2744)       reaction%eqkddistcoef(irxn) = cur_kd_rxn%Kd
  2745)       reaction%eqkdlangmuirb(irxn) = cur_kd_rxn%Langmuir_b
  2746)       reaction%eqkdfreundlichn(irxn) = cur_kd_rxn%Freundlich_n
  2747)        
  2748)       cur_kd_rxn => cur_kd_rxn%next
  2749)     enddo
  2750)   endif
  2751) 
  2752)   call BasisPrint(reaction,'Final Basis',option)
  2753) 
  2754)   ! locate specific species
  2755)   reaction%species_idx => SpeciesIndexCreate()
  2756)   do ispec = 1, reaction%naqcomp
  2757)     if (reaction%species_idx%h_ion_id == 0) then
  2758)       word = 'H+'
  2759)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2760)                                   word)) then
  2761)         reaction%species_idx%h_ion_id = ispec
  2762)       endif
  2763)     endif
  2764)     if (reaction%species_idx%na_ion_id == 0) then
  2765)       word = 'Na+'
  2766)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2767)                                   word)) then
  2768)         reaction%species_idx%na_ion_id = ispec
  2769)       endif
  2770)     endif
  2771)     if (reaction%species_idx%cl_ion_id == 0) then
  2772)       word = 'Cl-'
  2773)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2774)                                   word)) then
  2775)         reaction%species_idx%cl_ion_id = ispec
  2776)       endif
  2777)     endif
  2778)     if (reaction%species_idx%co2_aq_id == 0) then
  2779)       word = 'CO2(aq)'
  2780)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2781)                                   word)) then
  2782)         reaction%species_idx%co2_aq_id = ispec
  2783)       endif
  2784)     endif
  2785)     if (reaction%species_idx%tracer_aq_id == 0) then
  2786)       word = 'Tracer'
  2787)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2788)                                   word)) then
  2789)         reaction%species_idx%tracer_aq_id = ispec
  2790)       endif
  2791)     endif
  2792)     if (reaction%species_idx%h2o_aq_id == 0) then
  2793)       word = 'H2O'
  2794)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2795)                                   word)) then
  2796)         reaction%species_idx%h2o_aq_id = ispec
  2797)       endif
  2798)     endif
  2799)     if (reaction%species_idx%tracer_age_id == 0) then
  2800)       word = 'Tracer_Age'
  2801)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2802)                                   word)) then
  2803)         reaction%species_idx%tracer_age_id = ispec
  2804)         reaction%calculate_tracer_age = PETSC_TRUE
  2805)       endif
  2806)     endif
  2807)     if (reaction%species_idx%water_age_id == 0) then
  2808)       word = 'Water_Age'
  2809)       if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
  2810)                                   word)) then
  2811)         reaction%species_idx%water_age_id = ispec
  2812)         reaction%calculate_water_age = PETSC_TRUE
  2813)       endif
  2814)     endif
  2815)   enddo
  2816)   
  2817)   do ispec = 1, reaction%neqcplx
  2818)     if (reaction%species_idx%h_ion_id == 0) then
  2819)       word = 'H+'
  2820)       if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
  2821)                                   word)) then
  2822)         reaction%species_idx%h_ion_id = -ispec
  2823)       endif
  2824)     endif
  2825)     if (reaction%species_idx%na_ion_id == 0) then
  2826)       word = 'Na+'
  2827)       if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
  2828)                                   word)) then
  2829)         reaction%species_idx%na_ion_id = -ispec
  2830)       endif
  2831)     endif
  2832)     if (reaction%species_idx%cl_ion_id == 0) then
  2833)       word = 'Cl-'
  2834)       if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
  2835)                                   word)) then
  2836)         reaction%species_idx%cl_ion_id = -ispec
  2837)       endif
  2838)     endif
  2839)     if (reaction%species_idx%co2_aq_id == 0) then
  2840)       word = 'CO2(aq)'
  2841)       if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
  2842)                                   word)) then
  2843)         reaction%species_idx%co2_aq_id = -ispec
  2844)       endif
  2845)     endif
  2846)   enddo
  2847) 
  2848)   do ispec = 1, reaction%ngas
  2849)     if (reaction%species_idx%o2_gas_id == 0) then
  2850)       word = 'O2(g)'
  2851)       if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
  2852)                                   word)) then
  2853)         reaction%species_idx%o2_gas_id = ispec
  2854)       endif
  2855)     endif
  2856)     if (reaction%species_idx%co2_gas_id == 0) then
  2857)       word = 'CO2(g)'
  2858)       if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
  2859)                                   word)) then
  2860)         reaction%species_idx%co2_gas_id = ispec
  2861)       endif
  2862)       word = 'CO2(g)*'
  2863)       if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
  2864)                                   word)) then
  2865)         reaction%species_idx%co2_gas_id = ispec
  2866)       endif
  2867) 
  2868)     endif
  2869) 
  2870)   enddo
  2871)   
  2872) 90 format(80('-'))
  2873) 100 format(/,2x,i4,2x,a)
  2874) 110 format(100(/,14x,3(a20,2x)))
  2875) 
  2876)   if (OptionPrintToFile(option)) then
  2877)     write(option%fid_out,90)
  2878)     write(option%fid_out,100) reaction%naqcomp, 'Primary Species'
  2879)     write(option%fid_out,110) (reaction%primary_species_names(i),i=1,reaction%naqcomp)
  2880)     
  2881)     write(option%fid_out,100) reaction%neqcplx, 'Secondary Complex Species'
  2882)     write(option%fid_out,110) (reaction%secondary_species_names(i),i=1,reaction%neqcplx)
  2883)     
  2884)     write(option%fid_out,100) reaction%ngas, 'Gas Species'
  2885)     write(option%fid_out,110) (reaction%gas_species_names(i),i=1,reaction%ngas)
  2886)     
  2887)     write(option%fid_out,100) reaction%nmnrl, 'Reference Minerals'
  2888)     write(option%fid_out,110) (reaction%mineral_names(i),i=1,reaction%nmnrl)
  2889)     
  2890)     write(option%fid_out,100) reaction%nkinmnrl, 'Kinetic Mineral Reactions'
  2891)     write(option%fid_out,110) (reaction%kinmnrl_names(i),i=1,reaction%nkinmnrl)
  2892)     
  2893)     write(option%fid_out,100) reaction%neqsrfcplxrxn, 'Surface Complexation Reactions'
  2894)     write(option%fid_out,110) (reaction%eqsrfcplx_site_names(i),i=1,reaction%neqsrfcplxrxn)
  2895)     write(option%fid_out,100) reaction%neqsrfcplx, 'Surface Complexes'
  2896)     write(option%fid_out,110) (reaction%eqsrfcplx_names(i),i=1,reaction%neqsrfcplx)
  2897)     
  2898)     write(option%fid_out,100) reaction%neqionxrxn, 'Ion Exchange Reactions'
  2899)     write(option%fid_out,100) reaction%neqionxcation, 'Ion Exchange Cations'
  2900)     write(option%fid_out,90)
  2901)   endif
  2902)   
  2903) #if 0
  2904)   ! output for ASCEM reactions
  2905)   if (OptionPrintToFile(option)) then
  2906)     open(unit=86,file='reaction.dat')
  2907)     write(86,'(10i4)') reaction%naqcomp, reaction%neqcplx, reaction%ngeneral_rxn, & 
  2908)                        reaction%neqsrfcplxrxn, reaction%nkinmnrl
  2909)     do icomp = 1, reaction%naqcomp
  2910)       write(86,'(a12,f6.2,f6.2)') reaction%primary_species_names(icomp), &
  2911)                                   reaction%primary_spec_Z(icomp), &
  2912)                                   reaction%primary_spec_a0(icomp)
  2913)     enddo
  2914)     do icplx = 1, reaction%neqcplx
  2915)       write(86,'(a32,f6.2,f6.2)') reaction%secondary_species_names(icplx), &
  2916)                                   reaction%eqcplx_Z(icplx), &
  2917)                                   reaction%eqcplx_a0(icplx)
  2918)       write(86,'(40i4)') reaction%eqcplxspecid(:,icplx)
  2919)       write(86,'(40f6.2)') reaction%eqcplxstoich(:,icplx)
  2920)       write(86,'(i4)') reaction%eqcplxh2oid(icplx)
  2921)       write(86,'(f6.2)') reaction%eqcplxh2ostoich(icplx)
  2922)       write(86,'(1es13.5)') reaction%eqcplx_logK(icplx)
  2923)     enddo
  2924)     do irxn = 1, reaction%ngeneral_rxn
  2925)       write(86,'(40i4)') reaction%generalspecid(:,irxn)
  2926)       write(86,'(40f6.2)') reaction%generalstoich(:,irxn)
  2927)       write(86,'(40i4)') reaction%generalforwardspecid(:,irxn)
  2928)       write(86,'(40f6.2)') reaction%generalforwardstoich(:,irxn)
  2929)       write(86,'(40i4)') reaction%generalbackwardspecid(:,irxn)
  2930)       write(86,'(40f6.2)') reaction%generalbackwardstoich(:,irxn)
  2931)       write(86,'(f6.2)') reaction%generalh2ostoich(irxn)
  2932)       write(86,'(1es13.5)') reaction%general_kf(irxn)
  2933)       write(86,'(1es13.5)') reaction%general_kr(irxn)
  2934)     enddo
  2935)     do irxn = 1, reaction%neqsrfcplxrxn
  2936)       write(86,'(a32)')reaction%eqsrfcplx_site_names(irxn)
  2937)       write(86,'(1es13.5)') reaction%eqsrfcplx_rxn_site_density(irxn)
  2938)       write(86,'(i4)') reaction%srfcplxrxn_to_complex(0,irxn) ! # complexes
  2939)       do i = 1, reaction%srfcplxrxn_to_complex(0,irxn)
  2940)         icplx = reaction%srfcplxrxn_to_complex(i,irxn)
  2941)         write(86,'(a32,f6.2)') reaction%eqsrfcplx_names(icplx), &
  2942)                                reaction%eqsrfcplx_Z(icplx)
  2943)         write(86,'(40i4)') reaction%srfcplxspecid(:,icplx)
  2944)         write(86,'(40f6.2)') reaction%eqsrfcplxstoich(:,icplx)
  2945)         write(86,'(i4)') reaction%eqsrfcplxh2oid(icplx)
  2946)         write(86,'(f6.2)') reaction%eqsrfcplxh2ostoich(icplx)
  2947)         write(86,'(i4)') reaction%eqsrfcplx_free_site_id(icplx)
  2948)         write(86,'(f6.2)') reaction%eqsrfcplx_free_site_stoich(icplx)
  2949)         write(86,'(1es13.5)') reaction%eqsrfcplx_logK(icplx)
  2950) 
  2951)       enddo
  2952)     enddo
  2953)     do imnrl = 1, reaction%nkinmnrl
  2954)       write(86,'(a32)') reaction%kinmnrl_names(imnrl)
  2955)       write(86,'(40i4)') reaction%kinmnrlspecid(:,imnrl)
  2956)       write(86,'(40f6.2)') reaction%kinmnrlstoich(:,imnrl)
  2957)       write(86,'(i4)') reaction%kinmnrlh2oid(imnrl)
  2958)       write(86,'(f6.2)') reaction%kinmnrlh2ostoich(imnrl)
  2959)       write(86,'(1es13.5)') reaction%kinmnrl_logK(imnrl)
  2960)       write(86,'(1es13.5)') reaction%kinmnrl_molar_vol(imnrl)
  2961)       write(86,'(1es13.5)') reaction%kinmnrl_molar_wt(imnrl)
  2962)       write(86,'(1es13.5)') reaction%kinmnrl_rate_constant(1,imnrl)
  2963)       write(86,'(1es13.5)') 1.d0 ! specific surface area 1 cm^2 / cm^3
  2964)     enddo
  2965)         close(86)
  2966)   endif
  2967) #endif  
  2968)   
  2969)   if (allocated(new_basis)) deallocate(new_basis)
  2970)   if (allocated(old_basis)) deallocate(old_basis)
  2971)   if (allocated(transformation)) deallocate(transformation)
  2972)   if (allocated(stoich_prev)) deallocate(stoich_prev)
  2973)   if (allocated(stoich_new)) deallocate(stoich_new)
  2974)   if (allocated(logKCoeffvector)) deallocate(logKCoeffvector)
  2975)   if (allocated(indices)) deallocate(indices)
  2976) 
  2977)   if (allocated(new_basis_names)) deallocate(new_basis_names)
  2978)   if (allocated(old_basis_names)) deallocate(old_basis_names)
  2979) !TODO(geh)
  2980) #endif  
  2981) end subroutine BasisInit_hpt
  2982) 
  2983) ! ************************************************************************** !
  2984) 
  2985) subroutine BasisSubSpecInGasOrSecRxn_hpt(name1,dbaserxn1,dbaserxn2)
  2986)   ! 
  2987)   ! Swaps out a chemical species in a chemical
  2988)   ! reaction, replacing it with the species in a
  2989)   ! secondary reaction (swaps 1 into 2)
  2990)   ! 
  2991)   ! Author: Glenn Hammond
  2992)   ! Date: 03/02/2012
  2993)   ! 
  2994) 
  2995)   use String_module
  2996) 
  2997)   implicit none
  2998)   
  2999)   character(len=MAXWORDLENGTH) :: name1
  3000)   type(database_rxn_type) :: dbaserxn1
  3001)   type(database_rxn_type) :: dbaserxn2
  3002) 
  3003)   PetscReal :: scale
  3004)   
  3005)   call BasisSubSpeciesInGasOrSecRxn(name1,dbaserxn1,dbaserxn2,scale)
  3006)   dbaserxn2%logKCoeff_hpt = dbaserxn2%logKCoeff_hpt + &
  3007)     scale*dbaserxn1%logKCoeff_hpt
  3008) 
  3009)   end subroutine BasisSubSpecInGasOrSecRxn_hpt
  3010) 
  3011) ! ************************************************************************** !
  3012) 
  3013) subroutine BasisSubSpeciesInMineralRxn_hpt(name,sec_dbaserxn,mnrl_dbaserxn)
  3014)   ! 
  3015)   ! Swaps out a chemical species in a chemical
  3016)   ! reaction, replacing it with the species in a
  3017)   ! secondary reaction (swaps 1 into 2)
  3018)   ! 
  3019)   ! Author: Glenn Hammond
  3020)   ! Date: 03/02/2012
  3021)   ! 
  3022) 
  3023)   use String_module
  3024)   use Reaction_module
  3025)   
  3026)   implicit none
  3027)   
  3028)   character(len=MAXWORDLENGTH) :: name
  3029)   type(database_rxn_type) :: sec_dbaserxn
  3030)   type(database_rxn_type) :: mnrl_dbaserxn
  3031)   
  3032)   PetscReal :: scale
  3033) 
  3034)   call BasisSubSpeciesInMineralRxn(name,sec_dbaserxn,mnrl_dbaserxn,scale)
  3035)   mnrl_dbaserxn%logKCoeff_hpt = mnrl_dbaserxn%logKCoeff_hpt + &
  3036)     scale*sec_dbaserxn%logKCoeff_hpt
  3037) 
  3038) end subroutine BasisSubSpeciesInMineralRxn_hpt
  3039) 
  3040) end module Reaction_Database_hpt_module

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