reaction_aux.F90       coverage:  78.26 %func     55.25 %block


     1) module Reaction_Aux_module
     2)   
     3)   use Reaction_Database_Aux_module
     4)   use Reaction_Mineral_Aux_module
     5)   use Reaction_Microbial_Aux_module
     6)   use Reaction_Immobile_Aux_module
     7)   use Reaction_Surface_Complexation_Aux_module
     8)   
     9) #ifdef SOLID_SOLUTION  
    10)   use Reaction_Solid_Soln_Aux_module
    11) #endif
    12) 
    13)   use PFLOTRAN_Constants_module
    14) 
    15)   implicit none
    16)   
    17)   private 
    18) 
    19) #include "petsc/finclude/petscsys.h"
    20) 
    21)   ! activity coefficients
    22)   PetscInt, parameter, public :: ACT_COEF_FREQUENCY_OFF = 0
    23)   PetscInt, parameter, public :: ACT_COEF_FREQUENCY_TIMESTEP = 1
    24)   PetscInt, parameter, public :: ACT_COEF_FREQUENCY_NEWTON_ITER = 2
    25)   PetscInt, parameter, public :: ACT_COEF_ALGORITHM_LAG = 3
    26)   PetscInt, parameter, public :: ACT_COEF_ALGORITHM_NEWTON = 4
    27)   PetscInt, parameter, public :: NO_BDOT = 5
    28) 
    29)   type, public :: species_idx_type
    30)     PetscInt :: h2o_aq_id
    31)     PetscInt :: h_ion_id
    32)     PetscInt :: na_ion_id
    33)     PetscInt :: cl_ion_id
    34)     PetscInt :: co2_aq_id
    35)     PetscInt :: tracer_aq_id
    36)     PetscInt :: co2_gas_id
    37)     PetscInt :: o2_gas_id
    38)     PetscInt :: water_age_id
    39)     PetscInt :: tracer_age_id
    40)   end type species_idx_type
    41)   
    42)   type, public :: aq_species_type
    43)     PetscInt :: id
    44)     character(len=MAXWORDLENGTH) :: name
    45)     PetscReal :: a0
    46)     PetscReal :: molar_weight
    47)     PetscReal :: Z
    48)     PetscBool :: print_me
    49)     PetscBool :: is_redox
    50)     type(database_rxn_type), pointer :: dbaserxn
    51)     type(aq_species_type), pointer :: next
    52)   end type aq_species_type
    53) 
    54)   type, public :: gas_species_type
    55)     PetscInt :: id
    56)     character(len=MAXWORDLENGTH) :: name
    57)     PetscReal :: molar_volume
    58)     PetscReal :: molar_weight
    59)     PetscBool :: print_me
    60)     type(database_rxn_type), pointer :: dbaserxn
    61)     type(gas_species_type), pointer :: next    
    62)   end type gas_species_type
    63) 
    64)   type, public :: colloid_type
    65)     PetscInt :: id
    66)     PetscInt :: itype
    67)     character(len=MAXWORDLENGTH) :: name
    68)     PetscReal :: mobile_fraction
    69)     PetscReal :: forward_rate
    70)     PetscReal :: backward_rate
    71)     PetscReal :: surface_area
    72)     PetscReal :: molar_weight
    73)     PetscBool :: print_me
    74)     type(colloid_type), pointer :: next
    75)   end type colloid_type
    76) 
    77)   type, public :: ion_exchange_rxn_type
    78)     PetscInt :: id
    79)     character(len=MAXWORDLENGTH) :: mineral_name
    80)     type(ion_exchange_cation_type), pointer :: cation_list
    81)     PetscReal :: CEC
    82)     type (ion_exchange_rxn_type), pointer :: next
    83)   end type ion_exchange_rxn_type
    84) 
    85)   type, public :: ion_exchange_cation_type
    86)     character(len=MAXWORDLENGTH) :: name
    87)     PetscReal :: k
    88)     type (ion_exchange_cation_type), pointer :: next
    89)   end type ion_exchange_cation_type
    90) 
    91)   type, public :: kd_rxn_type
    92)     PetscInt :: id
    93)     PetscInt :: itype
    94)     character(len=MAXWORDLENGTH) :: species_name
    95)     character(len=MAXWORDLENGTH) :: kd_mineral_name
    96)     PetscReal :: Kd
    97)     PetscReal :: Langmuir_B
    98)     PetscReal :: Freundlich_n
    99)     type (kd_rxn_type), pointer :: next
   100)   end type kd_rxn_type    
   101) 
   102)   type, public :: radioactive_decay_rxn_type
   103)     PetscInt :: id
   104)     character(len=MAXSTRINGLENGTH) :: reaction
   105)     PetscReal :: rate_constant
   106)     PetscReal :: half_life
   107)     PetscBool :: print_me
   108)     type(database_rxn_type), pointer :: dbaserxn
   109)     type(radioactive_decay_rxn_type), pointer :: next
   110)   end type radioactive_decay_rxn_type
   111) 
   112)   type, public :: general_rxn_type
   113)     PetscInt :: id
   114)     character(len=MAXSTRINGLENGTH) :: reaction
   115)     PetscReal :: forward_rate
   116)     PetscReal :: backward_rate
   117)     PetscBool :: print_me
   118)     type(database_rxn_type), pointer :: dbaserxn
   119)     type(general_rxn_type), pointer :: next
   120)   end type general_rxn_type
   121) 
   122)   type, public :: aq_species_constraint_type
   123)     ! Any changes here must be incorporated within ReactionProcessConstraint()
   124)     ! where constraints are reordered
   125)     character(len=MAXWORDLENGTH), pointer :: names(:)
   126)     PetscReal, pointer :: constraint_conc(:)
   127)     PetscReal, pointer :: basis_molarity(:)
   128)     PetscInt, pointer :: constraint_type(:)
   129)     PetscInt, pointer :: constraint_spec_id(:)
   130)     character(len=MAXWORDLENGTH), pointer :: constraint_aux_string(:)
   131)     PetscBool, pointer :: external_dataset(:)
   132)   end type aq_species_constraint_type
   133) 
   134)   type, public :: guess_constraint_type
   135)     ! Any changes here must be incorporated within ReactionProcessConstraint()
   136)     ! where constraints are reordered
   137)     character(len=MAXWORDLENGTH), pointer :: names(:)
   138)     PetscReal, pointer :: conc(:)
   139)   end type guess_constraint_type
   140) 
   141)   type, public :: colloid_constraint_type
   142)     ! Any changes here must be incorporated within ReactionProcessConstraint()
   143)     ! where constraints are reordered
   144)     character(len=MAXWORDLENGTH), pointer :: names(:)
   145)     PetscReal, pointer :: constraint_conc_mob(:)
   146)     PetscReal, pointer :: constraint_conc_imb(:)
   147)     PetscReal, pointer :: basis_conc_mob(:)
   148)     PetscReal, pointer :: basis_conc_imb(:)
   149)   end type colloid_constraint_type
   150) 
   151)   type, public :: reaction_type
   152)     character(len=MAXSTRINGLENGTH) :: database_filename
   153)     PetscBool :: use_full_geochemistry
   154)     PetscBool :: use_log_formulation ! flag for solving for the change in the log of the concentration
   155)     PetscReal :: truncated_concentration
   156)     PetscBool :: check_update
   157)     PetscBool :: print_all_species
   158)     PetscBool :: print_all_primary_species
   159)     PetscBool :: print_all_secondary_species
   160)     PetscBool :: print_all_gas_species
   161)     PetscBool :: print_pH
   162)     PetscBool :: print_Eh
   163)     PetscBool :: print_pe
   164)     PetscBool :: print_O2
   165)     PetscBool :: print_kd
   166)     PetscBool :: print_total_sorb
   167)     PetscBool :: print_total_sorb_mobile
   168)     PetscBool :: print_colloid
   169)     PetscBool :: print_act_coefs
   170)     PetscBool :: print_total_component
   171)     PetscBool :: print_free_ion
   172)     PetscBool :: print_total_bulk ! total in aq and sorbed phases
   173)     PetscBool :: initialize_with_molality
   174)     PetscBool :: print_age
   175)     PetscBool :: use_geothermal_hpt
   176)     PetscInt :: print_free_conc_type
   177)     PetscInt :: print_tot_conc_type
   178)     PetscInt :: print_secondary_conc_type
   179)     PetscInt :: num_dbase_temperatures
   180)     PetscInt :: num_dbase_parameters
   181)     PetscReal, pointer :: dbase_temperatures(:)
   182)     type(species_idx_type), pointer :: species_idx
   183) 
   184)     type(aq_species_type), pointer :: primary_species_list
   185)     type(aq_species_type), pointer :: secondary_species_list
   186)     type(gas_species_type), pointer :: gas_species_list
   187)     type(colloid_type), pointer :: colloid_list
   188)     type(ion_exchange_rxn_type), pointer :: ion_exchange_rxn_list
   189)     type(general_rxn_type), pointer :: general_rxn_list
   190)     type(radioactive_decay_rxn_type), pointer :: radioactive_decay_rxn_list
   191)     type(kd_rxn_type), pointer :: kd_rxn_list
   192)     type(aq_species_type), pointer :: redox_species_list
   193)     PetscInt :: act_coef_update_frequency
   194)     PetscInt :: act_coef_update_algorithm
   195)     PetscBool :: checkpoint_activity_coefs
   196)     PetscBool :: act_coef_use_bdot
   197)     PetscBool :: use_activity_h2o
   198)     PetscBool :: calculate_water_age
   199)     PetscBool :: calculate_tracer_age
   200)     
   201)     ! new reaction objects
   202)     type(surface_complexation_type), pointer :: surface_complexation
   203)     type(mineral_type), pointer :: mineral
   204)     type(microbial_type), pointer :: microbial
   205)     type(immobile_type), pointer :: immobile
   206)     
   207)     ! secondary continuum reaction objects
   208)     type(kd_rxn_type), pointer :: sec_cont_kd_rxn_list
   209)     
   210) #ifdef SOLID_SOLUTION    
   211)     type(solid_solution_type), pointer :: solid_solution_list
   212) #endif    
   213)     
   214)     ! compressed arrays for efficient computation
   215)     ! primary aqueous complexes
   216)     PetscInt :: ncomp
   217)     PetscInt :: naqcomp
   218)     PetscInt :: ncollcomp
   219)     PetscInt :: nimcomp
   220)     
   221)     ! offsets
   222)     PetscInt :: offset_aqueous
   223)     PetscInt :: offset_colloid
   224)     PetscInt :: offset_collcomp
   225)     PetscInt :: offset_immobile
   226)     
   227)     character(len=MAXWORDLENGTH), pointer :: primary_species_names(:)
   228)     PetscBool, pointer :: primary_species_print(:)
   229)     PetscReal, pointer :: primary_spec_a0(:)
   230)     PetscReal, pointer :: primary_spec_Z(:)
   231)     PetscReal, pointer :: primary_spec_molar_wt(:)
   232)     
   233)     ! aqueous complexes
   234)     PetscInt :: neqcplx
   235)     character(len=MAXWORDLENGTH), pointer :: secondary_species_names(:)
   236)     PetscBool, pointer :: secondary_species_print(:)
   237)     character(len=MAXWORDLENGTH), pointer :: eqcplx_basis_names(:,:)
   238)     PetscBool, pointer :: eqcplx_basis_print(:)
   239)     PetscInt, pointer :: eqcplxspecid(:,:)   ! (0:ncomp in rxn)
   240)     PetscReal, pointer :: eqcplxstoich(:,:)
   241)     PetscInt, pointer :: eqcplxh2oid(:)       ! id of water, if present
   242)     PetscReal, pointer :: eqcplxh2ostoich(:)  ! stoichiometry of water, if present
   243)     PetscReal, pointer :: eqcplx_a0(:)  ! Debye-Huckel constant
   244)     PetscReal, pointer :: eqcplx_Z(:)
   245)     PetscReal, pointer :: eqcplx_molar_wt(:)
   246)     PetscReal, pointer :: eqcplx_logK(:)
   247)     PetscReal, pointer :: eqcplx_logKcoef(:,:)
   248)     ! Debye-Huckel
   249)     PetscReal :: debyeA  ! Debye-Huckel A coefficient
   250)     PetscReal :: debyeB  ! Debye-Huckel B coefficient
   251)     PetscReal :: debyeBdot  ! Debye-Huckel Bdot coefficient
   252)     
   253)     ! gas species
   254)     PetscInt :: ngas
   255)     character(len=MAXWORDLENGTH), pointer :: gas_species_names(:)
   256)     PetscBool, pointer :: gas_species_print(:)
   257)     PetscInt, pointer :: eqgasspecid(:,:)   ! (0:ncomp in rxn)
   258)     PetscReal, pointer :: eqgasstoich(:,:)
   259)     PetscInt, pointer :: eqgash2oid(:)       ! id of water, if present
   260)     PetscReal, pointer :: eqgash2ostoich(:)  ! stoichiometry of water, if present
   261)     PetscReal, pointer :: eqgas_logK(:)
   262)     PetscReal, pointer :: eqgas_logKcoef(:,:)
   263) 
   264)     PetscInt :: nsorb
   265)     PetscInt :: neqsorb
   266)     PetscBool, pointer :: kd_print(:)
   267)     PetscBool, pointer :: total_sorb_print(:)
   268) 
   269)     ! ionx exchange reactions
   270)     PetscInt :: neqionxrxn
   271)     PetscInt :: neqionxcation 
   272)     PetscBool, pointer :: eqionx_rxn_Z_flag(:)
   273)     PetscInt, pointer :: eqionx_rxn_cation_X_offset(:)
   274)     PetscReal, pointer :: eqionx_rxn_CEC(:)
   275)     PetscInt, pointer :: eqionx_rxn_to_surf(:)
   276)     PetscReal, pointer :: eqionx_rxn_k(:,:)
   277)     PetscInt, pointer :: eqionx_rxn_cationid(:,:)
   278) #if 0    
   279)     PetscReal, pointer :: kinionx_rxn_CEC(:)
   280)     PetscReal, pointer :: kinionx_rxn_k(:,:)
   281)     PetscInt, pointer :: kinionx_rxn_cationid(:)
   282) #endif    
   283) 
   284)     ! colloids
   285)     PetscInt :: ncoll
   286)     character(len=MAXWORDLENGTH), pointer :: colloid_names(:)
   287)     character(len=MAXWORDLENGTH), pointer :: colloid_species_names(:)
   288)     PetscReal, pointer :: colloid_mobile_fraction(:)
   289)     PetscInt, pointer :: pri_spec_to_coll_spec(:)
   290)     PetscInt, pointer :: coll_spec_to_pri_spec(:)
   291)     PetscBool, pointer :: total_sorb_mobile_print(:)
   292)     PetscBool, pointer :: colloid_print(:)
   293)     
   294)     ! radioactive decay rxn
   295)     PetscInt :: nradiodecay_rxn
   296)     ! ids and stoichiometries for species involved in reaction
   297)     PetscInt, pointer :: radiodecayspecid(:,:)
   298)     PetscReal, pointer :: radiodecaystoich(:,:)
   299)     ! index of radiodecayspecid for species in forward
   300)     ! reaction equation 
   301)     PetscInt, pointer :: radiodecayforwardspecid(:)
   302)     PetscReal, pointer :: radiodecay_kf(:)
   303) 
   304)     ! general rxn
   305)     PetscInt :: ngeneral_rxn
   306)     ! ids and stoichiometries for species involved in reaction
   307)     PetscInt, pointer :: generalspecid(:,:)
   308)     PetscReal, pointer :: generalstoich(:,:)
   309)     ! index of generalspecid & generalstoich for species in forward
   310)     ! reaction equation 
   311)     PetscInt, pointer :: generalforwardspecid(:,:)
   312)     PetscReal, pointer :: generalforwardstoich(:,:)
   313)     ! index of generalspecid & generalstoich for species in backward
   314)     ! reaction equation 
   315)     PetscInt, pointer :: generalbackwardspecid(:,:)
   316)     PetscReal, pointer :: generalbackwardstoich(:,:)
   317)     PetscInt, pointer :: generalh2oid(:)
   318)     PetscReal, pointer :: generalh2ostoich(:)
   319)     PetscReal, pointer :: general_kf(:)
   320)     PetscReal, pointer :: general_kr(:)  
   321)     
   322)     ! kd rxn
   323)     PetscInt :: neqkdrxn
   324)     PetscInt, pointer :: eqkdspecid(:)
   325)     PetscInt, pointer :: eqkdtype(:)
   326)     PetscInt, pointer :: eqkdmineral(:)
   327)     PetscReal, pointer :: eqkddistcoef(:)
   328)     PetscReal, pointer :: eqkdlangmuirb(:)
   329)     PetscReal, pointer :: eqkdfreundlichn(:)
   330)     
   331)     ! secondary continuum kd rxn
   332)     ! neqkdrxn and eqkdspecid will be the same
   333)     PetscInt, pointer :: sec_cont_eqkdtype(:)
   334)     PetscReal, pointer :: sec_cont_eqkddistcoef(:)
   335)     PetscReal, pointer :: sec_cont_eqkdlangmuirb(:)
   336)     PetscReal, pointer :: sec_cont_eqkdfreundlichn(:)
   337)     
   338)     PetscReal :: max_dlnC
   339)     PetscReal :: max_relative_change_tolerance
   340)     PetscReal :: max_residual_tolerance
   341)     
   342)     PetscBool :: update_permeability
   343)     PetscBool :: update_tortuosity
   344)     PetscBool :: update_porosity
   345)     PetscReal :: minimum_porosity
   346)     PetscBool :: update_mineral_surface_area
   347)     PetscBool :: update_mnrl_surf_with_porosity
   348) 
   349)     PetscBool :: update_armor_mineral_surface
   350)     PetscInt :: update_armor_mineral_surface_flag
   351) 
   352)     PetscBool :: use_sandbox
   353)     
   354)   end type reaction_type
   355) 
   356)   interface GetPrimarySpeciesIDFromName
   357)     module procedure GetPrimarySpeciesIDFromName1
   358)     module procedure GetPrimarySpeciesIDFromName2
   359)   end interface
   360) 
   361)   public :: ReactionCreate, &
   362)             SpeciesIndexCreate, &
   363)             GasSpeciesCreate, &
   364)             GetPrimarySpeciesCount, &
   365)             GetPrimarySpeciesNames, &
   366)             GetPrimarySpeciesIDFromName, &
   367)             GetSecondarySpeciesCount, &
   368)             GetSecondarySpeciesNames, &
   369)             GetGasCount, &
   370)             GetGasNames, &
   371)             GetGasIDFromName, &
   372)             GetColloidCount, &
   373)             GetColloidNames, &
   374)             GetColloidIDFromName, &
   375)             GetImmobileCount, &
   376)             ReactionFitLogKCoef, &
   377)             ReactionInitializeLogK, &
   378)             ReactionInterpolateLogK, &
   379)             ReactionInitializeLogK_hpt, &
   380)             ReactionInterpolateLogK_hpt, &
   381)             TransitionStateTheoryRxnCreate, &
   382)             TransitionStatePrefactorCreate, &
   383)             TSPrefactorSpeciesCreate, &
   384)             TransitionStateTheoryRxnDestroy, &
   385)             AqueousSpeciesCreate, &
   386)             AqueousSpeciesDestroy, &
   387)             AqueousSpeciesConstraintCreate, &
   388)             AqueousSpeciesConstraintDestroy, &
   389)             GuessConstraintCreate, &
   390)             GuessConstraintDestroy, &
   391)             MineralConstraintCreate, &
   392)             MineralConstraintDestroy, &
   393)             RadioactiveDecayRxnCreate, &
   394)             RadioactiveDecayRxnDestroy, &
   395)             GeneralRxnCreate, &
   396)             GeneralRxnDestroy, &
   397)             KDRxnCreate, &
   398)             KDRxnDestroy, &
   399)             ColloidCreate, &
   400)             ColloidDestroy, &
   401)             ColloidConstraintCreate, &
   402)             ColloidConstraintDestroy, &
   403)             IonExchangeRxnCreate, &
   404)             IonExchangeCationCreate, &
   405)             ReactionInputRecord, &
   406)             ReactionDestroy, &
   407)             LogKeh
   408)              
   409) contains
   410) 
   411) ! ************************************************************************** !
   412) 
   413) function ReactionCreate()
   414)   ! 
   415)   ! Allocate and initialize reaction object
   416)   ! 
   417)   ! Author: Glenn Hammond
   418)   ! Date: 05/02/08
   419)   ! 
   420) 
   421)   use Option_module
   422) 
   423)   implicit none
   424)   
   425)   type(reaction_type), pointer :: ReactionCreate
   426)   
   427)   type(reaction_type), pointer :: reaction
   428) 
   429)   allocate(reaction)  
   430) 
   431)   reaction%database_filename = ''
   432)   reaction%num_dbase_temperatures = 0
   433)   nullify(reaction%dbase_temperatures)
   434) 
   435)   reaction%act_coef_use_bdot = PETSC_TRUE
   436)   reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_OFF
   437)   reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_LAG
   438)   reaction%checkpoint_activity_coefs = PETSC_TRUE
   439)   reaction%print_all_species = PETSC_FALSE
   440)   reaction%print_all_primary_species = PETSC_FALSE
   441)   reaction%print_all_secondary_species = PETSC_FALSE
   442)   reaction%print_all_gas_species = PETSC_FALSE
   443)   reaction%print_pH = PETSC_FALSE
   444)   reaction%print_Eh = PETSC_FALSE
   445)   reaction%print_pe = PETSC_FALSE
   446)   reaction%print_O2 = PETSC_FALSE
   447)   reaction%print_kd = PETSC_FALSE
   448)   reaction%print_total_sorb = PETSC_FALSE
   449)   reaction%print_total_sorb_mobile = PETSC_FALSE
   450)   reaction%print_colloid = PETSC_FALSE
   451)   reaction%print_act_coefs = PETSC_FALSE
   452)   reaction%use_log_formulation = PETSC_FALSE
   453)   reaction%truncated_concentration = UNINITIALIZED_DOUBLE
   454)   reaction%check_update = PETSC_TRUE
   455)   reaction%use_full_geochemistry = PETSC_FALSE
   456)   reaction%use_activity_h2o = PETSC_FALSE
   457)   reaction%calculate_tracer_age = PETSC_FALSE
   458)   reaction%calculate_water_age = PETSC_FALSE
   459)   reaction%print_age = PETSC_FALSE
   460)   reaction%print_total_component = PETSC_FALSE
   461)   reaction%print_free_ion = PETSC_FALSE
   462)   reaction%print_total_bulk = PETSC_FALSE
   463)   reaction%use_geothermal_hpt = PETSC_FALSE
   464) 
   465)   reaction%initialize_with_molality = PETSC_FALSE
   466)   reaction%print_free_conc_type = 0
   467)   reaction%print_tot_conc_type = 0
   468)   reaction%print_secondary_conc_type = 0
   469)   
   470)   nullify(reaction%species_idx)
   471) 
   472)   nullify(reaction%primary_species_list)
   473)   nullify(reaction%secondary_species_list)
   474)   nullify(reaction%gas_species_list)
   475)   nullify(reaction%colloid_list)
   476)   nullify(reaction%ion_exchange_rxn_list)
   477)   nullify(reaction%radioactive_decay_rxn_list)
   478)   nullify(reaction%general_rxn_list)
   479)   nullify(reaction%kd_rxn_list)
   480)   nullify(reaction%redox_species_list)
   481)   
   482)   nullify(reaction%sec_cont_kd_rxn_list)
   483)   
   484)   ! new reaction objects
   485)   reaction%surface_complexation => SurfaceComplexationCreate()
   486)   reaction%mineral => MineralCreate()
   487)   reaction%microbial => MicrobialCreate()
   488)   reaction%immobile => ImmobileCreate()
   489) #ifdef SOLID_SOLUTION  
   490)   nullify(reaction%solid_solution_list)
   491) #endif
   492)   
   493)   nullify(reaction%primary_species_names)
   494)   nullify(reaction%secondary_species_names)
   495)   nullify(reaction%eqcplx_basis_names)
   496)   nullify(reaction%gas_species_names)
   497)   nullify(reaction%colloid_names)
   498)   nullify(reaction%colloid_species_names)
   499) 
   500)   nullify(reaction%primary_species_print)
   501)   nullify(reaction%secondary_species_print)
   502)   nullify(reaction%eqcplx_basis_print)
   503)   nullify(reaction%gas_species_print)
   504)   nullify(reaction%kd_print)
   505)   nullify(reaction%total_sorb_print)
   506)   nullify(reaction%total_sorb_mobile_print)
   507)   nullify(reaction%colloid_print)
   508)   
   509)   reaction%ncomp = 0
   510)   reaction%naqcomp = 0
   511)   reaction%ncoll = 0
   512)   reaction%ncollcomp = 0
   513)   reaction%nimcomp = 0
   514)   reaction%offset_aqueous = 0
   515)   reaction%offset_colloid = 0
   516)   reaction%offset_collcomp = 0
   517)   reaction%offset_immobile = 0
   518)   nullify(reaction%primary_spec_a0)
   519)   nullify(reaction%primary_spec_Z)
   520)   nullify(reaction%primary_spec_molar_wt)
   521) 
   522)   reaction%ngas = 0
   523)   nullify(reaction%eqgasspecid)
   524)   nullify(reaction%eqgasstoich)
   525)   nullify(reaction%eqgash2oid)
   526)   nullify(reaction%eqgash2ostoich)
   527)   nullify(reaction%eqgas_logK)
   528)   nullify(reaction%eqgas_logKcoef)
   529)   
   530)   reaction%neqcplx = 0
   531)   nullify(reaction%eqcplxspecid)
   532)   nullify(reaction%eqcplxstoich)
   533)   nullify(reaction%eqcplxh2oid)
   534)   nullify(reaction%eqcplxh2ostoich)
   535)   nullify(reaction%eqcplx_a0)
   536)   nullify(reaction%eqcplx_Z)
   537)   nullify(reaction%eqcplx_molar_wt)
   538)   nullify(reaction%eqcplx_logK)
   539)   nullify(reaction%eqcplx_logKcoef)
   540)   
   541)   reaction%debyeA = 0.5114d0 
   542)   reaction%debyeB = 0.3288d0 
   543)   reaction%debyeBdot = 0.0410d0 
   544) 
   545)   reaction%nsorb = 0
   546)   reaction%neqsorb = 0
   547) 
   548)   reaction%neqionxrxn = 0
   549)   reaction%neqionxcation = 0
   550)   nullify(reaction%eqionx_rxn_Z_flag)
   551)   nullify(reaction%eqionx_rxn_cation_X_offset)
   552)   nullify(reaction%eqionx_rxn_CEC)
   553)   nullify(reaction%eqionx_rxn_to_surf)
   554)   nullify(reaction%eqionx_rxn_k)
   555)   nullify(reaction%eqionx_rxn_cationid)
   556) #if 0  
   557)   nullify(reaction%kinionx_CEC)
   558)   nullify(reaction%kinionx_k)
   559)   nullify(reaction%kinionx_cationid)
   560) #endif
   561) 
   562)   reaction%ncoll = 0
   563)   nullify(reaction%pri_spec_to_coll_spec)
   564)   nullify(reaction%coll_spec_to_pri_spec)
   565)   nullify(reaction%colloid_mobile_fraction)
   566)   
   567)   reaction%ngeneral_rxn = 0
   568)   nullify(reaction%generalspecid)
   569)   nullify(reaction%generalstoich)
   570)   nullify(reaction%generalforwardspecid)
   571)   nullify(reaction%generalforwardstoich)
   572)   nullify(reaction%generalbackwardspecid)
   573)   nullify(reaction%generalbackwardstoich)
   574)   nullify(reaction%generalh2oid)
   575)   nullify(reaction%generalh2ostoich)
   576)   nullify(reaction%general_kf)
   577)   nullify(reaction%general_kr)
   578)   
   579)   reaction%nradiodecay_rxn = 0
   580)   nullify(reaction%radiodecayspecid)
   581)   nullify(reaction%radiodecaystoich)
   582)   nullify(reaction%radiodecayforwardspecid)
   583)   nullify(reaction%radiodecay_kf)
   584) 
   585)   reaction%neqkdrxn = 0
   586)   nullify(reaction%eqkdspecid)
   587)   nullify(reaction%eqkdtype)
   588)   nullify(reaction%eqkdmineral)
   589)   nullify(reaction%eqkddistcoef)
   590)   nullify(reaction%eqkdlangmuirb)
   591)   nullify(reaction%eqkdfreundlichn)
   592)       
   593)   nullify(reaction%sec_cont_eqkdtype)
   594)   nullify(reaction%sec_cont_eqkddistcoef)
   595)   nullify(reaction%sec_cont_eqkdlangmuirb)
   596)   nullify(reaction%sec_cont_eqkdfreundlichn)
   597)        
   598)   reaction%max_dlnC = 5.d0
   599)   reaction%max_relative_change_tolerance = 1.d-6
   600)   reaction%max_residual_tolerance = 1.d-12
   601) 
   602)   reaction%update_permeability = PETSC_FALSE
   603)   reaction%update_tortuosity = PETSC_FALSE
   604)   reaction%update_porosity = PETSC_FALSE
   605)   reaction%minimum_porosity = 0.d0
   606)   reaction%update_mineral_surface_area = PETSC_FALSE
   607)   reaction%update_mnrl_surf_with_porosity = PETSC_FALSE
   608) 
   609)   reaction%update_armor_mineral_surface = PETSC_FALSE
   610)   reaction%update_armor_mineral_surface_flag = 0
   611) 
   612)   reaction%use_sandbox = PETSC_FALSE
   613) 
   614)   ReactionCreate => reaction
   615)   
   616) end function ReactionCreate
   617) 
   618) ! ************************************************************************** !
   619) 
   620) function SpeciesIndexCreate()
   621)   ! 
   622)   ! Allocate and initialize a species index object
   623)   ! 
   624)   ! Author: Peter Lichtner
   625)   ! Date: 01/29/10
   626)   ! 
   627) 
   628)   use Option_module
   629) 
   630)   implicit none
   631)   
   632)   type(species_idx_type), pointer :: SpeciesIndexCreate
   633)   
   634)   type(species_idx_type), pointer :: species_idx
   635) 
   636)   allocate(species_idx) 
   637) 
   638)   species_idx%h2o_aq_id = 0
   639)   species_idx%h_ion_id = 0
   640)   species_idx%na_ion_id = 0
   641)   species_idx%cl_ion_id = 0
   642)   species_idx%co2_aq_id = 0
   643)   species_idx%tracer_aq_id = 0
   644)   species_idx%co2_gas_id = 0
   645)   species_idx%o2_gas_id = 0
   646)   species_idx%tracer_age_id = 0
   647)   species_idx%water_age_id = 0
   648) 
   649)   SpeciesIndexCreate => species_idx
   650)   
   651) end function SpeciesIndexCreate
   652) 
   653) ! ************************************************************************** !
   654) 
   655) function AqueousSpeciesCreate()
   656)   ! 
   657)   ! Allocate and initialize an aqueous species object
   658)   ! 
   659)   ! Author: Glenn Hammond
   660)   ! Date: 05/02/08
   661)   ! 
   662) 
   663)   use Option_module
   664) 
   665)   implicit none
   666)   
   667)   type(aq_species_type), pointer :: AqueousSpeciesCreate
   668)   
   669)   type(aq_species_type), pointer :: species
   670) 
   671)   allocate(species) 
   672)   species%id = 0 
   673)   species%name = ''
   674)   species%a0 = 0.d0
   675)   species%molar_weight = 0.d0
   676)   species%Z = 0.d0
   677)   species%print_me = PETSC_FALSE
   678)   species%is_redox = PETSC_FALSE
   679)   nullify(species%dbaserxn)
   680)   nullify(species%next)
   681) 
   682)   AqueousSpeciesCreate => species
   683)   
   684) end function AqueousSpeciesCreate
   685) 
   686) ! ************************************************************************** !
   687) 
   688) function GasSpeciesCreate()
   689)   ! 
   690)   ! Allocate and initialize a gas species object
   691)   ! 
   692)   ! Author: Glenn Hammond
   693)   ! Date: 05/02/08
   694)   ! 
   695) 
   696)   use Option_module
   697) 
   698)   implicit none
   699)   
   700)   type(gas_species_type), pointer :: GasSpeciesCreate
   701)   
   702)   type(gas_species_type), pointer :: species
   703) 
   704)   allocate(species)  
   705)   species%id = 0
   706)   species%name = ''
   707)   species%molar_volume = 0.d0
   708)   species%molar_weight = 0.d0
   709)   species%print_me = PETSC_FALSE
   710)   nullify(species%dbaserxn)
   711)   nullify(species%next)
   712) 
   713)   GasSpeciesCreate => species
   714)   
   715) end function GasSpeciesCreate
   716) 
   717) ! ************************************************************************** !
   718) 
   719) function ColloidCreate()
   720)   ! 
   721)   ! Allocate and initialize a colloid object
   722)   ! 
   723)   ! Author: Glenn Hammond
   724)   ! Date: 02/24/10
   725)   ! 
   726) 
   727)   use Option_module
   728) 
   729)   implicit none
   730)   
   731)   type(colloid_type), pointer :: ColloidCreate
   732)   
   733)   type(colloid_type), pointer :: colloid
   734) 
   735)   allocate(colloid)  
   736)   colloid%id = 0
   737)   colloid%itype = 0
   738)   colloid%name = ''
   739)   colloid%mobile_fraction = 0.5d0
   740)   colloid%forward_rate = 0.d0
   741)   colloid%backward_rate = 0.d0
   742)   colloid%surface_area = 1.d0
   743)   colloid%molar_weight = 0.d0
   744)   colloid%print_me = PETSC_FALSE
   745)   nullify(colloid%next)
   746)   
   747)   ColloidCreate => colloid
   748)   
   749) end function ColloidCreate
   750) 
   751) ! ************************************************************************** !
   752) 
   753) function IonExchangeRxnCreate()
   754)   ! 
   755)   ! Allocate and initialize an ion exchange reaction
   756)   ! 
   757)   ! Author: Peter Lichtner
   758)   ! Date: 10/24/08
   759)   ! 
   760) 
   761)   implicit none
   762)     
   763)   type(ion_exchange_rxn_type), pointer :: IonExchangeRxnCreate
   764) 
   765)   type(ion_exchange_rxn_type), pointer :: ionxrxn
   766)   
   767)   allocate(ionxrxn)
   768)   ionxrxn%id = 0
   769)   ionxrxn%mineral_name = ''
   770)   ionxrxn%CEC = 0.d0
   771)   nullify(ionxrxn%cation_list)
   772)   nullify(ionxrxn%next)
   773)   
   774)   IonExchangeRxnCreate => ionxrxn
   775)   
   776) end function IonExchangeRxnCreate
   777) 
   778) ! ************************************************************************** !
   779) 
   780) function IonExchangeCationCreate()
   781)   ! 
   782)   ! Allocate and initialize a cation associated with
   783)   ! an ion exchange reaction
   784)   ! 
   785)   ! Author: Peter Lichtner
   786)   ! Date: 10/24/08
   787)   ! 
   788) 
   789)   implicit none
   790)     
   791)   type(ion_exchange_cation_type), pointer :: IonExchangeCationCreate
   792) 
   793)   type(ion_exchange_cation_type), pointer :: cation
   794)   
   795)   allocate(cation)
   796)   cation%name = ''
   797)   cation%k = 0.d0
   798)   nullify(cation%next)
   799)   
   800)   IonExchangeCationCreate => cation
   801)   
   802) end function IonExchangeCationCreate
   803) 
   804) ! ************************************************************************** !
   805) 
   806) function RadioactiveDecayRxnCreate()
   807)   ! 
   808)   ! Allocate and initialize a radioactive decay
   809)   ! reaction
   810)   ! 
   811)   ! Author: Glenn Hammond
   812)   ! Date: 01/07/14
   813)   ! 
   814) 
   815)   implicit none
   816)     
   817)   type(radioactive_decay_rxn_type), pointer :: RadioactiveDecayRxnCreate
   818) 
   819)   type(radioactive_decay_rxn_type), pointer :: rxn
   820)   
   821)   allocate(rxn)
   822)   rxn%id = 0
   823)   rxn%reaction = ''
   824)   rxn%rate_constant = 0.d0
   825)   rxn%half_life = 0.d0
   826)   rxn%print_me = PETSC_FALSE
   827)   nullify(rxn%dbaserxn)
   828)   nullify(rxn%next)
   829)   
   830)   RadioactiveDecayRxnCreate => rxn
   831)   
   832) end function RadioactiveDecayRxnCreate
   833) 
   834) ! ************************************************************************** !
   835) 
   836) function GeneralRxnCreate()
   837)   ! 
   838)   ! Allocate and initialize a general reaction
   839)   ! 
   840)   ! Author: Glenn Hammond
   841)   ! Date: 09/03/10
   842)   ! 
   843) 
   844)   implicit none
   845)     
   846)   type(general_rxn_type), pointer :: GeneralRxnCreate
   847) 
   848)   type(general_rxn_type), pointer :: rxn
   849)   
   850)   allocate(rxn)
   851)   rxn%id = 0
   852)   rxn%reaction = ''
   853)   rxn%forward_rate = 0.d0
   854)   rxn%backward_rate = 0.d0
   855)   rxn%print_me = PETSC_FALSE
   856)   nullify(rxn%dbaserxn)
   857)   nullify(rxn%next)
   858)   
   859)   GeneralRxnCreate => rxn
   860)   
   861) end function GeneralRxnCreate
   862) 
   863) ! ************************************************************************** !
   864) 
   865) function KDRxnCreate()
   866)   ! 
   867)   ! Allocate and initialize a KD sorption reaction
   868)   ! 
   869)   ! Author: Glenn Hammond
   870)   ! Date: 09/32/10
   871)   ! 
   872) 
   873)   implicit none
   874)     
   875)   type(kd_rxn_type), pointer :: KDRxnCreate
   876) 
   877)   type(kd_rxn_type), pointer :: rxn
   878)   
   879)   allocate(rxn)
   880)   rxn%id = 0
   881)   rxn%itype = 0
   882)   rxn%species_name = ''
   883)   rxn%kd_mineral_name = ''
   884)   rxn%Kd = 0.d0
   885)   rxn%Langmuir_B = 0.d0
   886)   rxn%Freundlich_n = 0.d0
   887)   nullify(rxn%next)
   888)   
   889)   KDRxnCreate => rxn
   890)   
   891) end function KDRxnCreate
   892) 
   893) ! ************************************************************************** !
   894) 
   895) function AqueousSpeciesConstraintCreate(reaction,option)
   896)   ! 
   897)   ! Creates an aqueous species constraint
   898)   ! object
   899)   ! 
   900)   ! Author: Glenn Hammond
   901)   ! Date: 10/14/08
   902)   ! 
   903) 
   904)   use Option_module
   905)   
   906)   implicit none
   907)   
   908)   type(reaction_type) :: reaction
   909)   type(option_type) :: option
   910)   type(aq_species_constraint_type), pointer :: AqueousSpeciesConstraintCreate
   911) 
   912)   type(aq_species_constraint_type), pointer :: constraint
   913)   
   914)   allocate(constraint)
   915)   allocate(constraint%names(reaction%naqcomp))
   916)   constraint%names = ''
   917)   allocate(constraint%constraint_conc(reaction%naqcomp))
   918)   constraint%constraint_conc = 0.d0
   919)   allocate(constraint%basis_molarity(reaction%naqcomp))
   920)   constraint%basis_molarity = 0.d0
   921)   allocate(constraint%constraint_spec_id(reaction%naqcomp))
   922)   constraint%constraint_spec_id = 0
   923)   allocate(constraint%constraint_type(reaction%naqcomp))
   924)   constraint%constraint_type = 0
   925)   allocate(constraint%constraint_aux_string(reaction%naqcomp))
   926)   constraint%constraint_aux_string = ''
   927)   allocate(constraint%external_dataset(reaction%naqcomp))
   928)   constraint%external_dataset = PETSC_FALSE
   929) 
   930)   AqueousSpeciesConstraintCreate => constraint
   931) 
   932) end function AqueousSpeciesConstraintCreate
   933) 
   934) ! ************************************************************************** !
   935) 
   936) function GuessConstraintCreate(reaction,option)
   937)   ! 
   938)   ! Creates an aqueous species constraint
   939)   ! object
   940)   ! 
   941)   ! Author: Glenn Hammond
   942)   ! Date: 10/14/08
   943)   ! 
   944) 
   945)   use Option_module
   946)   
   947)   implicit none
   948)   
   949)   type(reaction_type) :: reaction
   950)   type(option_type) :: option
   951)   type(guess_constraint_type), pointer :: GuessConstraintCreate
   952) 
   953)   type(guess_constraint_type), pointer :: constraint
   954)   
   955)   allocate(constraint)
   956)   allocate(constraint%names(reaction%naqcomp))
   957)   constraint%names = ''
   958)   allocate(constraint%conc(reaction%naqcomp))
   959)   constraint%conc = 0.d0
   960) 
   961)   GuessConstraintCreate => constraint
   962) 
   963) end function GuessConstraintCreate
   964) 
   965) ! ************************************************************************** !
   966) 
   967) function ColloidConstraintCreate(reaction,option)
   968)   ! 
   969)   ! Creates a colloid constraint object
   970)   ! 
   971)   ! Author: Glenn Hammond
   972)   ! Date: 03/12/10
   973)   ! 
   974) 
   975)   use Option_module
   976)   
   977)   implicit none
   978)   
   979)   type(reaction_type) :: reaction
   980)   type(option_type) :: option
   981)   type(colloid_constraint_type), pointer :: ColloidConstraintCreate
   982) 
   983)   type(colloid_constraint_type), pointer :: constraint  
   984) 
   985)   allocate(constraint)
   986)   allocate(constraint%names(reaction%ncoll))
   987)   constraint%names = ''
   988)   allocate(constraint%constraint_conc_mob(reaction%ncoll))
   989)   constraint%constraint_conc_mob = 0.d0
   990)   allocate(constraint%constraint_conc_imb(reaction%ncoll))
   991)   constraint%constraint_conc_imb = 0.d0
   992)   allocate(constraint%basis_conc_mob(reaction%ncoll))
   993)   constraint%basis_conc_mob = 0.d0
   994)   allocate(constraint%basis_conc_imb(reaction%ncoll))
   995)   constraint%basis_conc_imb = 0.d0
   996) 
   997)   ColloidConstraintCreate => constraint
   998) 
   999) end function ColloidConstraintCreate
  1000) 
  1001) ! ************************************************************************** !
  1002) 
  1003) function GetPrimarySpeciesNames(reaction)
  1004)   ! 
  1005)   ! Returns the names of primary species in an array
  1006)   ! 
  1007)   ! Author: Glenn Hammond
  1008)   ! Date: 06/02/08
  1009)   ! 
  1010) 
  1011)   implicit none
  1012)   
  1013)   character(len=MAXWORDLENGTH), pointer :: GetPrimarySpeciesNames(:)
  1014)   type(reaction_type) :: reaction
  1015) 
  1016)   PetscInt :: count
  1017)   character(len=MAXWORDLENGTH), pointer :: names(:)
  1018)   type(aq_species_type), pointer :: species
  1019) 
  1020)   count = GetPrimarySpeciesCount(reaction)
  1021)   allocate(names(count))
  1022)   
  1023)   count = 1
  1024)   species => reaction%primary_species_list
  1025)   do
  1026)     if (.not.associated(species)) exit
  1027)     names(count) = species%name
  1028)     count = count + 1
  1029)     species => species%next
  1030)   enddo
  1031) 
  1032)   GetPrimarySpeciesNames => names
  1033)   
  1034) end function GetPrimarySpeciesNames
  1035) 
  1036) ! ************************************************************************** !
  1037) 
  1038) function GetPrimarySpeciesCount(reaction)
  1039)   ! 
  1040)   ! Returns the number of primary species
  1041)   ! 
  1042)   ! Author: Glenn Hammond
  1043)   ! Date: 06/02/08
  1044)   ! 
  1045) 
  1046)   implicit none
  1047)   
  1048)   PetscInt :: GetPrimarySpeciesCount
  1049)   type(reaction_type) :: reaction
  1050) 
  1051)   type(aq_species_type), pointer :: species
  1052) 
  1053)   GetPrimarySpeciesCount = 0
  1054)   species => reaction%primary_species_list
  1055)   do
  1056)     if (.not.associated(species)) exit
  1057)     GetPrimarySpeciesCount = GetPrimarySpeciesCount + 1
  1058)     species => species%next
  1059)   enddo
  1060) 
  1061) end function GetPrimarySpeciesCount
  1062) 
  1063) ! ************************************************************************** !
  1064) 
  1065) function GetPrimarySpeciesIDFromName1(name,reaction,option)
  1066)   ! 
  1067)   ! Returns the id of named primary species
  1068)   ! 
  1069)   ! Author: Glenn Hammond
  1070)   ! Date: 10/30/12
  1071)   ! 
  1072) 
  1073)   use Option_module
  1074)   use String_module
  1075)   
  1076)   implicit none
  1077)   
  1078)   character(len=MAXWORDLENGTH) :: name
  1079)   type(reaction_type) :: reaction
  1080)   type(option_type) :: option
  1081) 
  1082)   PetscInt :: GetPrimarySpeciesIDFromName1
  1083) 
  1084)   GetPrimarySpeciesIDFromName1 = GetPrimarySpeciesIDFromName2(name,reaction, &
  1085)           PETSC_TRUE, option)
  1086) 
  1087) end function GetPrimarySpeciesIDFromName1
  1088) 
  1089) ! ************************************************************************** !
  1090) 
  1091) function GetPrimarySpeciesIDFromName2(name,reaction,return_error,option)
  1092)   ! 
  1093)   ! Returns the id of named primary species
  1094)   ! 
  1095)   ! Author: Glenn Hammond
  1096)   ! Date: 10/30/12
  1097)    
  1098) 
  1099)   use Option_module
  1100)   use String_module
  1101)   
  1102)   implicit none
  1103)   
  1104)   character(len=MAXWORDLENGTH) :: name
  1105)   type(reaction_type) :: reaction
  1106)   type(option_type) :: option
  1107) 
  1108)   PetscInt :: GetPrimarySpeciesIDFromName2
  1109) 
  1110)   type(aq_species_type), pointer :: species
  1111)   PetscInt :: i
  1112)   PetscBool :: return_error
  1113) 
  1114)   GetPrimarySpeciesIDFromName2 = UNINITIALIZED_INTEGER
  1115)   
  1116)   ! if the primary species name list exists
  1117)   if (associated(reaction%primary_species_names)) then
  1118)     do i = 1, size(reaction%primary_species_names)
  1119)       if (StringCompare(name,reaction%primary_species_names(i), &
  1120)                         MAXWORDLENGTH)) then
  1121)         GetPrimarySpeciesIDFromName2 = i
  1122)         exit
  1123)       endif
  1124)     enddo
  1125)   else
  1126)     species => reaction%primary_species_list
  1127)     i = 0
  1128)     do
  1129)       if (.not.associated(species)) exit
  1130)       i = i + 1
  1131)       if (StringCompare(name,species%name,MAXWORDLENGTH)) then
  1132)         GetPrimarySpeciesIDFromName2 = i
  1133)         exit
  1134)       endif
  1135)       species => species%next
  1136)     enddo
  1137)   endif
  1138) 
  1139)   if (return_error .and. GetPrimarySpeciesIDFromName2 <= 0) then
  1140)     option%io_buffer = 'Species "' // trim(name) // &
  1141)       '" not found among primary species in GetPrimarySpeciesIDFromName().'
  1142)     call printErrMsg(option)
  1143)   endif
  1144)   
  1145) end function GetPrimarySpeciesIDFromName2
  1146) 
  1147) ! ************************************************************************** !
  1148) 
  1149) function GetSecondarySpeciesNames(reaction)
  1150)   ! 
  1151)   ! Returns the names of secondary species in an array
  1152)   ! 
  1153)   ! Author: Glenn Hammond
  1154)   ! Date: 06/02/08
  1155)   ! 
  1156) 
  1157)   implicit none
  1158)   
  1159)   character(len=MAXWORDLENGTH), pointer :: GetSecondarySpeciesNames(:)
  1160)   type(reaction_type) :: reaction
  1161) 
  1162)   PetscInt :: count
  1163)   character(len=MAXWORDLENGTH), pointer :: names(:)
  1164)   type(aq_species_type), pointer :: species
  1165) 
  1166)   count = GetSecondarySpeciesCount(reaction)
  1167)   allocate(names(count))
  1168)   
  1169)   count = 1
  1170)   species => reaction%secondary_species_list
  1171)   do
  1172)     if (.not.associated(species)) exit
  1173)     names(count) = species%name
  1174)     count = count + 1
  1175)     species => species%next
  1176)   enddo
  1177) 
  1178)   GetSecondarySpeciesNames => names
  1179)   
  1180) end function GetSecondarySpeciesNames
  1181) 
  1182) ! ************************************************************************** !
  1183) 
  1184) function GetSecondarySpeciesCount(reaction)
  1185)   ! 
  1186)   ! Returns the number of secondary species
  1187)   ! 
  1188)   ! Author: Glenn Hammond
  1189)   ! Date: 06/02/08
  1190)   ! 
  1191) 
  1192)   implicit none
  1193)   
  1194)   PetscInt :: GetSecondarySpeciesCount
  1195)   type(reaction_type) :: reaction
  1196) 
  1197)   type(aq_species_type), pointer :: species
  1198) 
  1199)   GetSecondarySpeciesCount = 0
  1200)   species => reaction%secondary_species_list
  1201)   do
  1202)     if (.not.associated(species)) exit
  1203)     GetSecondarySpeciesCount = GetSecondarySpeciesCount + 1
  1204)     species => species%next
  1205)   enddo
  1206) 
  1207) end function GetSecondarySpeciesCount
  1208) 
  1209) ! ************************************************************************** !
  1210) 
  1211) function GetGasNames(reaction)
  1212)   ! 
  1213)   ! Returns the names of gases in an array
  1214)   ! 
  1215)   ! Author: Glenn Hammond
  1216)   ! Date: 10/21/08
  1217)   ! 
  1218) 
  1219)   implicit none
  1220)   
  1221)   character(len=MAXWORDLENGTH), pointer :: GetGasNames(:)
  1222)   type(reaction_type) :: reaction
  1223) 
  1224)   PetscInt :: count
  1225)   character(len=MAXWORDLENGTH), pointer :: names(:)
  1226)   type(gas_species_type), pointer :: gas
  1227) 
  1228)   count = GetGasCount(reaction)
  1229)   allocate(names(count))
  1230)   
  1231)   count = 1
  1232)   gas => reaction%gas_species_list
  1233)   do
  1234)     if (.not.associated(gas)) exit
  1235)     names(count) = gas%name
  1236)     count = count + 1
  1237)     gas => gas%next
  1238)   enddo
  1239) 
  1240)   GetGasNames => names
  1241)   
  1242) end function GetGasNames
  1243) 
  1244) ! ************************************************************************** !
  1245) 
  1246) function GetGasCount(reaction)
  1247)   ! 
  1248)   ! Returns the number of primary species
  1249)   ! 
  1250)   ! Author: Glenn Hammond
  1251)   ! Date: 06/02/08
  1252)   ! 
  1253) 
  1254)   implicit none
  1255)   
  1256)   PetscInt :: GetGasCount
  1257)   type(reaction_type) :: reaction
  1258) 
  1259)   type(gas_species_type), pointer :: gas
  1260) 
  1261)   GetGasCount = 0
  1262)   gas => reaction%gas_species_list
  1263)   do
  1264)     if (.not.associated(gas)) exit
  1265)     GetGasCount = GetGasCount + 1
  1266)     gas => gas%next
  1267)   enddo
  1268) 
  1269) end function GetGasCount
  1270) 
  1271) ! ************************************************************************** !
  1272) 
  1273) function GetGasIDFromName(reaction,name)
  1274)   ! 
  1275)   ! Returns the id of gas with the corresponding name
  1276)   ! 
  1277)   ! Author: Glenn Hammond
  1278)   ! Date: 09/04/08
  1279)   ! 
  1280) 
  1281)   use String_module
  1282)   
  1283)   implicit none
  1284)   
  1285)   type(reaction_type) :: reaction
  1286)   character(len=MAXWORDLENGTH) :: name
  1287) 
  1288)   PetscInt :: GetGasIDFromName
  1289)   type(gas_species_type), pointer :: gas
  1290) 
  1291)   GetGasIDFromName = -1
  1292)  
  1293)   gas => reaction%gas_species_list
  1294)   do
  1295)     if (.not.associated(gas)) exit
  1296)     if (StringCompare(name,gas%name,MAXWORDLENGTH)) then
  1297)       GetGasIDFromName = gas%id
  1298)       exit
  1299)     endif
  1300)     gas => gas%next
  1301)   enddo
  1302) 
  1303) end function GetGasIDFromName
  1304) 
  1305) ! ************************************************************************** !
  1306) 
  1307) function GetColloidIDFromName(reaction,name)
  1308)   ! 
  1309)   ! Returns the id of colloid with the corresponding name
  1310)   ! 
  1311)   ! Author: Glenn Hammond
  1312)   ! Date: 02/24/10
  1313)   ! 
  1314) 
  1315)   use String_module
  1316)   
  1317)   implicit none
  1318)   
  1319)   type(reaction_type) :: reaction
  1320)   character(len=MAXWORDLENGTH) :: name
  1321) 
  1322)   PetscInt :: GetColloidIDFromName
  1323)   type(colloid_type), pointer :: colloid
  1324) 
  1325)   GetColloidIDFromName = -1
  1326)  
  1327)   colloid => reaction%colloid_list
  1328)   do
  1329)     if (.not.associated(colloid)) exit
  1330)     if (StringCompare(name,colloid%name,MAXWORDLENGTH)) then
  1331)       GetColloidIDFromName = colloid%id
  1332)       exit
  1333)     endif
  1334)     colloid => colloid%next
  1335)   enddo
  1336) 
  1337) end function GetColloidIDFromName
  1338) 
  1339) ! ************************************************************************** !
  1340) 
  1341) function GetColloidNames(reaction)
  1342)   ! 
  1343)   ! Returns the names of colloids in an array
  1344)   ! 
  1345)   ! Author: Glenn Hammond
  1346)   ! Date: 09/04/08
  1347)   ! 
  1348) 
  1349)   implicit none
  1350)   
  1351)   character(len=MAXWORDLENGTH), pointer :: GetColloidNames(:)
  1352)   type(reaction_type) :: reaction
  1353) 
  1354)   PetscInt :: count
  1355)   character(len=MAXWORDLENGTH), pointer :: names(:)
  1356)   type(colloid_type), pointer :: colloid
  1357) 
  1358)   count = GetColloidCount(reaction)
  1359)   allocate(names(count))
  1360)   
  1361)   count = 1
  1362)   colloid => reaction%colloid_list
  1363)   do
  1364)     if (.not.associated(colloid)) exit
  1365)     names(count) = colloid%name
  1366)     count = count + 1
  1367)     colloid => colloid%next
  1368)   enddo
  1369) 
  1370)   GetColloidNames => names
  1371)   
  1372) end function GetColloidNames
  1373) 
  1374) ! ************************************************************************** !
  1375) 
  1376) function GetColloidCount(reaction)
  1377)   ! 
  1378)   ! Returns the number of colloids
  1379)   ! 
  1380)   ! Author: Glenn Hammond
  1381)   ! Date: 02/24/10
  1382)   ! 
  1383) 
  1384)   implicit none
  1385)   
  1386)   PetscInt :: GetColloidCount
  1387)   type(reaction_type) :: reaction
  1388) 
  1389)   type(colloid_type), pointer :: colloid
  1390) 
  1391)   GetColloidCount = 0
  1392)   colloid => reaction%colloid_list
  1393)   do
  1394)     if (.not.associated(colloid)) exit
  1395)     GetColloidCount = GetColloidCount + 1
  1396)     colloid => colloid%next
  1397)   enddo
  1398) 
  1399) end function GetColloidCount
  1400) 
  1401) ! ************************************************************************** !
  1402) 
  1403) function GetImmobileCount(reaction)
  1404)   ! 
  1405)   ! Returns the number of immobile species
  1406)   ! 
  1407)   ! Author: Glenn Hammond
  1408)   ! Date: 01/02/13
  1409)   ! 
  1410) 
  1411)   implicit none
  1412)   
  1413)   PetscInt :: GetImmobileCount
  1414)   type(reaction_type) :: reaction
  1415) 
  1416)   GetImmobileCount = ImmobileGetCount(reaction%immobile)
  1417)   
  1418) end function GetImmobileCount
  1419) 
  1420) ! ************************************************************************** !
  1421) 
  1422) subroutine ReactionFitLogKCoef(coefs,logK,name,option,reaction)
  1423)   ! 
  1424)   ! Least squares fit to log K over database temperature
  1425)   ! range
  1426)   ! 
  1427)   ! Author: P.C. Lichtner
  1428)   ! Date: 02/13/09
  1429)   ! 
  1430) 
  1431)   use Option_module
  1432)   use Utility_module
  1433) 
  1434)   implicit none
  1435)   
  1436)   type(reaction_type) :: reaction
  1437)   PetscReal :: coefs(FIVE_INTEGER)
  1438)   character(len=MAXWORDLENGTH) :: name 
  1439)   PetscReal :: logK(reaction%num_dbase_temperatures)
  1440)   type(option_type) :: option
  1441) 
  1442)   PetscInt :: temp_int(reaction%num_dbase_temperatures), &
  1443)               indx(reaction%num_dbase_temperatures)
  1444)   PetscReal :: a(FIVE_INTEGER,FIVE_INTEGER), &
  1445)                vec(FIVE_INTEGER,reaction%num_dbase_temperatures), temperature_kelvin
  1446) 
  1447)   PetscInt :: i, j, k, iflag
  1448)   
  1449)   ! need to fill in vec with equations for temperatures vs coefs.
  1450)   
  1451)   do i = 1, reaction%num_dbase_temperatures
  1452)     temperature_kelvin = reaction%dbase_temperatures(i) + 273.15d0
  1453)     vec(1,i) = log(temperature_kelvin)
  1454)     vec(2,i) = 1.d0
  1455)     vec(3,i) = temperature_kelvin
  1456)     vec(4,i) = 1.d0/temperature_kelvin
  1457)     vec(5,i) = 1.d0/(temperature_kelvin*temperature_kelvin)
  1458)   enddo
  1459)   
  1460)   iflag = 0
  1461)   do j = 1, FIVE_INTEGER
  1462)     coefs(j) = 0.d0
  1463)     do i = 1, reaction%num_dbase_temperatures
  1464)       if (dabs(logK(i) - 500.) < 1.d-10) then
  1465)         iflag = 1
  1466)         temp_int(i) = ZERO_INTEGER
  1467)       else
  1468)         coefs(j) = coefs(j) + vec(j,i)*logK(i)
  1469)         temp_int(i) = ONE_INTEGER
  1470)       endif
  1471)     enddo
  1472)   enddo
  1473) 
  1474)   if (iflag == 1) then
  1475)     option%io_buffer = 'In ReactionFitLogKCoef: log K = 500 for ' // trim(name)
  1476)     call printWrnMsg(option)
  1477)   endif
  1478) 
  1479)   do j = 1, FIVE_INTEGER
  1480)     do k = j, FIVE_INTEGER
  1481)       a(j,k) = 0.d0
  1482)       do i = 1, reaction%num_dbase_temperatures
  1483)         if (temp_int(i) == 1) then
  1484)           a(j,k) = a(j,k) + vec(j,i)*vec(k,i)
  1485)         endif
  1486)       enddo
  1487)       if (j .ne. k) a(k,j) = a(j,k)
  1488)     enddo
  1489)   enddo
  1490) 
  1491)   call ludcmp(a,FIVE_INTEGER,indx,i)
  1492)   call lubksb(a,FIVE_INTEGER,indx,coefs)
  1493) 
  1494) end subroutine ReactionFitLogKCoef
  1495) 
  1496) ! ************************************************************************** !
  1497) 
  1498) subroutine ReactionInitializeLogK(logKcoef,logKs,logK,option,reaction)
  1499)   ! 
  1500)   ! Least squares fit to log K over database temperature range
  1501)   ! 
  1502)   ! Author: P.C. Lichtner
  1503)   ! Date: 02/13/09
  1504)   ! 
  1505) 
  1506)   use Option_module
  1507) 
  1508)   implicit none
  1509)   
  1510)   type(reaction_type) :: reaction
  1511)   PetscReal :: logKcoef(FIVE_INTEGER)
  1512)   PetscReal :: logKs(reaction%num_dbase_temperatures)
  1513)   PetscReal :: logK, logK_1D_Array(ONE_INTEGER)
  1514)   type(option_type) :: option
  1515)   
  1516)   PetscReal :: coefs(FIVE_INTEGER,ONE_INTEGER)
  1517)   PetscReal :: temperature
  1518)   PetscInt :: itemperature
  1519)   PetscInt :: i
  1520)   
  1521)   ! we always initialize on reference temperature
  1522)   temperature = option%reference_temperature
  1523)   
  1524)   itemperature = 0
  1525)   if (option%use_isothermal) then ! find database temperature if relevant
  1526)     do i = 1, reaction%num_dbase_temperatures
  1527)       if (dabs(option%reference_temperature - &
  1528)                reaction%dbase_temperatures(i)) < 1.d-10) then
  1529)         itemperature = i
  1530)         exit
  1531)       endif
  1532)     enddo
  1533)   endif
  1534)   
  1535)   if (itemperature > 0) then ! use database temperature
  1536)     logK = logKs(itemperature)
  1537)   else                       ! interpolate
  1538)     coefs(:,ONE_INTEGER) = logKcoef(:)
  1539)     call ReactionInterpolateLogK(coefs,logK_1D_Array,temperature,ONE_INTEGER)
  1540)     logK = logK_1D_Array(ONE_INTEGER)
  1541)   endif
  1542) 
  1543) end subroutine ReactionInitializeLogK
  1544) 
  1545) ! ************************************************************************** !
  1546) 
  1547) subroutine ReactionInterpolateLogK(coefs,logKs,temp,n)
  1548)   ! 
  1549)   ! Interpolation log K function: temp - temperature [C]
  1550)   ! b - fit coefficients determined from fit(...)
  1551)   ! 
  1552)   ! Author: P.C. Lichtner
  1553)   ! Date: 02/13/09
  1554)   ! 
  1555) 
  1556)   implicit none
  1557)   
  1558)   PetscInt :: n
  1559)   PetscReal :: coefs(5,n), logKs(n), temp
  1560) 
  1561)   PetscInt :: i
  1562)   PetscReal :: temp_kelvin
  1563)   
  1564)   temp_kelvin = temp + 273.15d0
  1565)   
  1566)   do i = 1, n
  1567)     logKs(i) = coefs(1,i)*log(temp_kelvin) &
  1568)              + coefs(2,i)           &
  1569)              + coefs(3,i)*temp_kelvin      &
  1570)              + coefs(4,i)/temp_kelvin      &
  1571)              + coefs(5,i)/(temp_kelvin*temp_kelvin)
  1572)   enddo
  1573)   
  1574) end subroutine ReactionInterpolateLogK
  1575) 
  1576) ! ************************************************************************** !
  1577) 
  1578) subroutine ReactionInitializeLogK_hpt(logKcoef,logK,option,reaction)
  1579)   ! 
  1580)   ! ReactionInitializeLogK: Least squares fit to log K over database temperature range
  1581)   ! 
  1582)   ! Author: Chuan Lu
  1583)   ! Date: 12/29/11
  1584)   ! 
  1585) 
  1586)   use Option_module
  1587) 
  1588)   implicit none
  1589)   
  1590)   type(reaction_type) :: reaction
  1591)   PetscReal :: logKcoef(17)
  1592)   PetscReal :: logK, logK_1D_Array(ONE_INTEGER)
  1593)   type(option_type) :: option
  1594)   
  1595)   PetscReal :: coefs(17,ONE_INTEGER)
  1596)   PetscReal :: temperature, pressure
  1597)   PetscInt :: itemperature
  1598)   PetscInt :: i
  1599)   
  1600)   ! we always initialize on reference temperature
  1601)   temperature = option%reference_temperature
  1602)   pressure = option%reference_pressure 
  1603)   
  1604)   
  1605)   coefs(:,ONE_INTEGER) = logKcoef(:)
  1606)   call ReactionInterpolateLogK_hpt(coefs,logK_1D_Array,temperature,pressure, &
  1607)                                    ONE_INTEGER)
  1608)   logK = logK_1D_Array(ONE_INTEGER)
  1609) !   print *,'ReactionInitializeLogK_hpt: ', pressure,temperature, logK
  1610) 
  1611) end subroutine ReactionInitializeLogK_hpt
  1612) 
  1613) ! ************************************************************************** !
  1614) 
  1615) subroutine ReactionInterpolateLogK_hpt(coefs,logKs,temp,pres,n)
  1616)   ! 
  1617)   ! ReactionInterpolateLogK: Interpolation log K function: temp - temperature [C]
  1618)   ! b - fit coefficients determined from fit(...)
  1619)   ! 
  1620)   ! Author: P.C. Lichtner
  1621)   ! Date: 02/13/09
  1622)   ! 
  1623) 
  1624)   implicit none
  1625)   
  1626)   PetscInt :: n
  1627)   PetscReal :: coefs(17,n), logKs(n), temp, pres
  1628) 
  1629)   PetscInt :: i
  1630)   PetscReal :: temp_kelvin, tr, pr, logtr
  1631)   
  1632)   temp_kelvin = temp + 273.15d0
  1633)   tr = temp_kelvin/273.15d0
  1634)   pr = pres/1.d7
  1635)   logtr = log(tr)/log(10.d0) 
  1636)   
  1637)   do i = 1, n
  1638)     logKs(i) = coefs(1,i)                 &
  1639)              + coefs(2,i) * tr            &
  1640)              + coefs(3,i) / tr            &
  1641)              + coefs(4,i) * logtr         &
  1642)              + coefs(5,i) * tr * tr       &
  1643)              + coefs(6,i) / tr / tr       &
  1644)              + coefs(7,i) * sqrt(tr)      &
  1645)              + coefs(8,i) * pr            &
  1646)              + coefs(9,i) * pr * tr       &
  1647)              + coefs(10,i) * pr / tr      &
  1648)              + coefs(11,i) * pr * logtr   &
  1649)              + coefs(12,i) / pr           &
  1650)              + coefs(13,i) / pr * tr      &
  1651)              + coefs(14,i) / pr / tr      &
  1652)              + coefs(15,i) * pr * pr      &
  1653)              + coefs(16,i) * pr * pr * tr &
  1654)              + coefs(17,i) * pr * pr / tr 
  1655)   enddo
  1656)  ! print *,'ReactionInterpolateLogK_hpt: ', pres,temp, logKs, coefs
  1657) end subroutine ReactionInterpolateLogK_hpt
  1658) 
  1659) ! ************************************************************************** !
  1660) 
  1661) PetscReal function logkeh(tk)
  1662)   ! 
  1663)   ! Function logkeh: Maier-Kelly fit to equilibrium constant half-cell reaction
  1664)   ! 2 H2O - 4 H+ - 4 e- = O2, to compute Eh and pe.
  1665)   ! 
  1666)   ! Author: Peter Lichtner
  1667)   ! Date: 04/27/13
  1668)   ! 
  1669) 
  1670)   implicit none
  1671) 
  1672)   PetscReal, intent(in) :: tk
  1673) 
  1674)   PetscReal, parameter :: cm1 = 6.745529048112373d0
  1675)   PetscReal, parameter :: c0 = -48.295936593543715d0
  1676)   PetscReal, parameter :: c1 = 0.0005578156078778505d0
  1677)   PetscReal, parameter :: c2 = 27780.749538022003d0
  1678)   PetscReal, parameter :: c3 = 4027.3376948579394d0
  1679) 
  1680)   logkeh = cm1 * log(tk) + c0 + c1 * tk + c2 / tk + c3 / (tk * tk)
  1681) 
  1682) end function logkeh
  1683) 
  1684) ! ************************************************************************** !
  1685) 
  1686) subroutine ReactionInputRecord(rxn)
  1687)   ! 
  1688)   ! Prints ingested chemistry and reactive transport information to the input 
  1689)   ! record file.
  1690)   ! 
  1691)   ! Author: Jenn Frederick
  1692)   ! Date: 04/12/2016
  1693)   ! 
  1694)   use Reaction_Immobile_Aux_module
  1695) 
  1696)   implicit none
  1697) 
  1698)   type(reaction_type), pointer :: rxn
  1699)   
  1700)   type(aq_species_type), pointer :: cur_aq_species
  1701)   type(gas_species_type), pointer :: cur_gas_species
  1702)   type(immobile_species_type), pointer :: cur_imm_species
  1703)   type(radioactive_decay_rxn_type), pointer :: cur_rad_decay_rxn
  1704)   type(kd_rxn_type), pointer :: cur_kd_rxn
  1705)   character(len=MAXWORDLENGTH) :: word1, word2
  1706)   character(len=MAXSTRINGLENGTH) :: string
  1707)   PetscInt :: id = INPUT_RECORD_UNIT
  1708) 
  1709)   write(id,'(a)') ' '
  1710)   write(id,'(a)') '---------------------------------------------------------&
  1711)        &-----------------------'
  1712)   write(id,'(a29)',advance='no') '---------------------------: '
  1713)   write(id,'(a)') 'CHEMISTRY'
  1714)   
  1715)   if (.not.associated(rxn)) return
  1716)   
  1717) ! --------- primary species list ---------------------------------------------
  1718)   if (associated(rxn%primary_species_list)) then
  1719)     write(id,'(a29)',advance='no') 'primary species list: '
  1720)     cur_aq_species => rxn%primary_species_list
  1721)     write(id,'(a)') trim(cur_aq_species%name)
  1722)     cur_aq_species => cur_aq_species%next
  1723)     do
  1724)       if (.not.associated(cur_aq_species)) exit
  1725)       write(id,'(a29)',advance='no') ' '
  1726)       write(id,'(a)') trim(cur_aq_species%name)
  1727)       cur_aq_species => cur_aq_species%next
  1728)     enddo
  1729)     write(id,'(a29)') '---------------------------: '
  1730)   endif
  1731) ! --------- secondary species list -------------------------------------------
  1732)   if (associated(rxn%secondary_species_list)) then
  1733)     write(id,'(a29)',advance='no') 'secondary species list: '
  1734)     cur_aq_species => rxn%secondary_species_list
  1735)     write(id,'(a)') trim(cur_aq_species%name)
  1736)     cur_aq_species => cur_aq_species%next
  1737)     do
  1738)       if (.not.associated(cur_aq_species)) exit
  1739)       write(id,'(a29)',advance='no') ' '
  1740)       write(id,'(a)') trim(cur_aq_species%name)
  1741)       cur_aq_species => cur_aq_species%next
  1742)     enddo
  1743)     write(id,'(a29)') '---------------------------: '
  1744)   endif
  1745) ! --------- gas species list -------------------------------------------------
  1746)   if (associated(rxn%gas_species_list)) then
  1747)     write(id,'(a29)',advance='no') 'gas species list: '
  1748)     cur_gas_species => rxn%gas_species_list
  1749)     write(id,'(a)') trim(cur_gas_species%name)
  1750)     cur_gas_species => cur_gas_species%next
  1751)     do
  1752)       if (.not.associated(cur_gas_species)) exit
  1753)       write(id,'(a29)',advance='no') ' '
  1754)       write(id,'(a)') trim(cur_gas_species%name)
  1755)       cur_gas_species => cur_gas_species%next
  1756)     enddo
  1757)     write(id,'(a29)') '---------------------------: '
  1758)   endif
  1759) ! --------- immobile species list --------------------------------------------
  1760)   if (associated(rxn%immobile%list)) then
  1761)     write(id,'(a29)',advance='no') 'immobile species list: '
  1762)     cur_imm_species => rxn%immobile%list
  1763)     write(id,'(a)') trim(cur_imm_species%name)
  1764)     cur_imm_species => cur_imm_species%next
  1765)     do
  1766)       if (.not.associated(cur_imm_species)) exit
  1767)       write(id,'(a29)',advance='no') ' '
  1768)       write(id,'(a)') trim(cur_imm_species%name)
  1769)       cur_imm_species => cur_imm_species%next
  1770)     enddo
  1771)     write(id,'(a29)') '---------------------------: '
  1772)   endif
  1773)   
  1774) ! --------- radioactive decay reaction list ----------------------------------
  1775)   if (associated(rxn%radioactive_decay_rxn_list)) then
  1776)     cur_rad_decay_rxn => rxn%radioactive_decay_rxn_list
  1777)     do
  1778)       if (.not.associated(cur_rad_decay_rxn)) exit
  1779)       write(id,'(a29)',advance='no') 'radioactive decay reaction: '
  1780)       write(id,'(a)') adjustl(trim(cur_rad_decay_rxn%reaction))  
  1781)       write(id,'(a29)',advance='no') 'decay rate: '
  1782)       write(word1,*) cur_rad_decay_rxn%rate_constant
  1783)       write(id,'(a)') adjustl(trim(word1)) // ' 1/sec'
  1784)       
  1785)       write(id,'(a29)') '---------------------------: '
  1786)       cur_rad_decay_rxn => cur_rad_decay_rxn%next
  1787)     enddo
  1788)   endif
  1789)   
  1790) ! --------- sorption isotherm reaction list ----------------------------------
  1791)   if (associated(rxn%kd_rxn_list)) then
  1792)     cur_kd_rxn => rxn%kd_rxn_list
  1793)     do
  1794)       if (.not.associated(cur_kd_rxn)) exit
  1795)       write(id,'(a29)',advance='no') 'sorption, isotherm reaction: '
  1796)       write(id,'(a)') adjustl(trim(cur_kd_rxn%species_name))  
  1797)       write(id,'(a29)',advance='no') 'type: '
  1798)       select case (cur_kd_rxn%itype)
  1799)         case (SORPTION_LINEAR)
  1800)           write(id,'(a)') 'linear sorption'
  1801)         case (SORPTION_LANGMUIR)
  1802)           write(id,'(a)') 'langmuir sorption'
  1803)           write(id,'(a29)',advance='no') 'langmuir b: '
  1804)           write(word1,*) cur_kd_rxn%Langmuir_B
  1805)           write(id,'(a)') adjustl(trim(word1)) 
  1806)         case (SORPTION_FREUNDLICH)
  1807)           write(id,'(a)') 'freundlich sorption'
  1808)           write(id,'(a29)',advance='no') 'freundlich n: '
  1809)           write(word1,*) cur_kd_rxn%Freundlich_N
  1810)           write(id,'(a)') adjustl(trim(word1))
  1811)       end select
  1812)       if (len_trim(cur_kd_rxn%kd_mineral_name) > 0) then
  1813)         write(id,'(a29)',advance='no') 'Kd mineral name: '
  1814)         write(id,'(a)') adjustl(trim(cur_kd_rxn%kd_mineral_name))
  1815)         word2 = ' L/kg'
  1816)       else
  1817)         word2 = ' kg/m^3'
  1818)       endif
  1819)       write(id,'(a29)',advance='no') 'distribution coeff. / Kd: '
  1820)       write(word1,*) cur_kd_rxn%Kd
  1821)       write(id,'(a)') adjustl(trim(word1)) // adjustl(trim(word2))
  1822)       
  1823)       write(id,'(a29)') '---------------------------: '
  1824)       cur_kd_rxn => cur_kd_rxn%next
  1825)     enddo
  1826)   endif
  1827)   
  1828) end subroutine ReactionInputRecord
  1829) 
  1830) ! ************************************************************************** !
  1831) 
  1832) subroutine SpeciesIndexDestroy(species_idx)
  1833)   ! 
  1834)   ! Deallocates a species index object
  1835)   ! 
  1836)   ! Author: Glenn Hammond
  1837)   ! Date: 01/29/10
  1838)   ! 
  1839) 
  1840)   implicit none
  1841)     
  1842)   type(species_idx_type), pointer :: species_idx
  1843) 
  1844)   if (associated(species_idx)) deallocate(species_idx)  
  1845)   nullify(species_idx)
  1846) 
  1847) end subroutine SpeciesIndexDestroy
  1848) 
  1849) ! ************************************************************************** !
  1850) 
  1851) subroutine AqueousSpeciesDestroy(species)
  1852)   ! 
  1853)   ! Deallocates an aqueous species
  1854)   ! 
  1855)   ! Author: Glenn Hammond
  1856)   ! Date: 05/29/08
  1857)   ! 
  1858) 
  1859)   implicit none
  1860)     
  1861)   type(aq_species_type), pointer :: species
  1862) 
  1863)   if (associated(species%dbaserxn)) call DatabaseRxnDestroy(species%dbaserxn)
  1864)   deallocate(species)  
  1865)   nullify(species)
  1866) 
  1867) end subroutine AqueousSpeciesDestroy
  1868) 
  1869) ! ************************************************************************** !
  1870) 
  1871) subroutine AqueousSpeciesListDestroy(aq_species_list)
  1872)   ! 
  1873)   ! Deallocates an aqueous species
  1874)   ! 
  1875)   ! Author: Glenn Hammond
  1876)   ! Date: 09/03/10
  1877)   ! 
  1878) 
  1879)   implicit none
  1880)     
  1881)   type(aq_species_type), pointer :: aq_species_list  
  1882)     
  1883)   type(aq_species_type), pointer :: species, prev_species
  1884) 
  1885)   species => aq_species_list
  1886)   do
  1887)     if (.not.associated(species)) exit
  1888)     prev_species => species
  1889)     species => species%next
  1890)     call AqueousSpeciesDestroy(prev_species)
  1891)   enddo  
  1892)   nullify(aq_species_list)
  1893) 
  1894) end subroutine AqueousSpeciesListDestroy
  1895) 
  1896) ! ************************************************************************** !
  1897) 
  1898) subroutine GasSpeciesDestroy(species)
  1899)   ! 
  1900)   ! Deallocates a gas species
  1901)   ! 
  1902)   ! Author: Glenn Hammond
  1903)   ! Date: 05/29/08
  1904)   ! 
  1905) 
  1906)   implicit none
  1907)     
  1908)   type(gas_species_type), pointer :: species
  1909) 
  1910)   if (associated(species%dbaserxn)) call DatabaseRxnDestroy(species%dbaserxn)
  1911)   deallocate(species)  
  1912)   nullify(species)
  1913) 
  1914) end subroutine GasSpeciesDestroy
  1915) 
  1916) ! ************************************************************************** !
  1917) 
  1918) subroutine ColloidDestroy(colloid)
  1919)   ! 
  1920)   ! Deallocates a colloid
  1921)   ! 
  1922)   ! Author: Glenn Hammond
  1923)   ! Date: 02/24/10
  1924)   ! 
  1925) 
  1926)   implicit none
  1927)     
  1928)   type(colloid_type), pointer :: colloid
  1929) 
  1930)   deallocate(colloid)  
  1931)   nullify(colloid)
  1932) 
  1933) end subroutine ColloidDestroy
  1934) 
  1935) ! ************************************************************************** !
  1936) 
  1937) subroutine IonExchangeRxnDestroy(ionxrxn)
  1938)   ! 
  1939)   ! Deallocates an ion exchange reaction
  1940)   ! 
  1941)   ! Author: Glenn Hammond
  1942)   ! Date: 10/24/08
  1943)   ! 
  1944) 
  1945)   implicit none
  1946)     
  1947)   type(ion_exchange_rxn_type), pointer :: ionxrxn
  1948)   
  1949)   type(ion_exchange_cation_type), pointer :: cur_cation, prev_cation
  1950) 
  1951)   if (.not.associated(ionxrxn)) return
  1952)   
  1953)   cur_cation => ionxrxn%cation_list
  1954)   do
  1955)     if (.not.associated(cur_cation)) exit
  1956)     prev_cation => cur_cation
  1957)     cur_cation => cur_cation%next
  1958)     deallocate(prev_cation)
  1959)     nullify(prev_cation)
  1960)   enddo
  1961)   
  1962)   nullify(ionxrxn%next)
  1963) 
  1964)   deallocate(ionxrxn)  
  1965)   nullify(ionxrxn)
  1966) 
  1967) end subroutine IonExchangeRxnDestroy
  1968) 
  1969) ! ************************************************************************** !
  1970) 
  1971) subroutine RadioactiveDecayRxnDestroy(rxn)
  1972)   ! 
  1973)   ! Deallocates a general reaction
  1974)   ! 
  1975)   ! Author: Glenn Hammond
  1976)   ! Date: 01/07/14
  1977)   ! 
  1978) 
  1979)   implicit none
  1980)     
  1981)   type(radioactive_decay_rxn_type), pointer :: rxn
  1982) 
  1983)   if (.not.associated(rxn)) return
  1984)   
  1985)   if (associated(rxn%dbaserxn)) &
  1986)     call DatabaseRxnDestroy(rxn%dbaserxn)
  1987)   nullify(rxn%dbaserxn)
  1988)   nullify(rxn%next)
  1989) 
  1990)   deallocate(rxn)  
  1991)   nullify(rxn)
  1992) 
  1993) end subroutine RadioactiveDecayRxnDestroy
  1994) 
  1995) ! ************************************************************************** !
  1996) 
  1997) subroutine GeneralRxnDestroy(rxn)
  1998)   ! 
  1999)   ! Deallocates a general reaction
  2000)   ! 
  2001)   ! Author: Glenn Hammond
  2002)   ! Date: 09/03/10
  2003)   ! 
  2004) 
  2005)   implicit none
  2006)     
  2007)   type(general_rxn_type), pointer :: rxn
  2008) 
  2009)   if (.not.associated(rxn)) return
  2010)   
  2011)   if (associated(rxn%dbaserxn)) &
  2012)     call DatabaseRxnDestroy(rxn%dbaserxn)
  2013)   nullify(rxn%dbaserxn)
  2014)   nullify(rxn%next)
  2015) 
  2016)   deallocate(rxn)  
  2017)   nullify(rxn)
  2018) 
  2019) end subroutine GeneralRxnDestroy
  2020) 
  2021) ! ************************************************************************** !
  2022) 
  2023) subroutine KDRxnDestroy(rxn)
  2024)   ! 
  2025)   ! Deallocates a KD reaction
  2026)   ! 
  2027)   ! Author: Glenn Hammond
  2028)   ! Date: 09/30/10
  2029)   ! 
  2030) 
  2031)   implicit none
  2032)     
  2033)   type(kd_rxn_type), pointer :: rxn
  2034) 
  2035)   if (.not.associated(rxn)) return
  2036)   
  2037)   deallocate(rxn)  
  2038)   nullify(rxn)
  2039) 
  2040) end subroutine KDRxnDestroy
  2041) 
  2042) ! ************************************************************************** !
  2043) 
  2044) subroutine AqueousSpeciesConstraintDestroy(constraint)
  2045)   ! 
  2046)   ! Destroys an aqueous species constraint
  2047)   ! object
  2048)   ! 
  2049)   ! Author: Glenn Hammond
  2050)   ! Date: 10/14/08
  2051)   ! 
  2052) 
  2053)   use Utility_module, only: DeallocateArray
  2054)   
  2055)   implicit none
  2056)   
  2057)   type(aq_species_constraint_type), pointer :: constraint
  2058)   
  2059)   if (.not.associated(constraint)) return
  2060)   
  2061)   call DeallocateArray(constraint%names)
  2062)   call DeallocateArray(constraint%constraint_conc)
  2063)   call DeallocateArray(constraint%basis_molarity)
  2064)   call DeallocateArray(constraint%constraint_type)
  2065)   call DeallocateArray(constraint%constraint_spec_id)
  2066)   call DeallocateArray(constraint%constraint_aux_string)
  2067)   call DeallocateArray(constraint%external_dataset)
  2068) 
  2069)   deallocate(constraint)
  2070)   nullify(constraint)
  2071) 
  2072) end subroutine AqueousSpeciesConstraintDestroy
  2073) 
  2074) ! ************************************************************************** !
  2075) 
  2076) subroutine GuessConstraintDestroy(constraint)
  2077)   ! 
  2078)   ! Destroys an aqueous species constraint
  2079)   ! object
  2080)   ! 
  2081)   ! Author: Glenn Hammond
  2082)   ! Date: 10/14/08
  2083)   ! 
  2084) 
  2085)   use Utility_module, only: DeallocateArray
  2086)   
  2087)   implicit none
  2088)   
  2089)   type(guess_constraint_type), pointer :: constraint
  2090)   
  2091)   if (.not.associated(constraint)) return
  2092)   
  2093)   call DeallocateArray(constraint%names)
  2094)   call DeallocateArray(constraint%conc)
  2095) 
  2096)   deallocate(constraint)
  2097)   nullify(constraint)
  2098) 
  2099) end subroutine GuessConstraintDestroy
  2100) 
  2101) ! ************************************************************************** !
  2102) 
  2103) subroutine ColloidConstraintDestroy(constraint)
  2104)   ! 
  2105)   ! Destroys a colloid constraint object
  2106)   ! 
  2107)   ! Author: Glenn Hammond
  2108)   ! Date: 03/12/10
  2109)   ! 
  2110) 
  2111)   use Utility_module, only: DeallocateArray
  2112) 
  2113)   implicit none
  2114)   
  2115)   type(colloid_constraint_type), pointer :: constraint
  2116)   
  2117)   if (.not.associated(constraint)) return
  2118)   
  2119)   call DeallocateArray(constraint%names)
  2120)   call DeallocateArray(constraint%constraint_conc_mob)
  2121)   call DeallocateArray(constraint%constraint_conc_imb)
  2122)   call DeallocateArray(constraint%basis_conc_mob)
  2123)   call DeallocateArray(constraint%basis_conc_imb)
  2124) 
  2125)   deallocate(constraint)
  2126)   nullify(constraint)
  2127) 
  2128) end subroutine ColloidConstraintDestroy
  2129) 
  2130) ! ************************************************************************** !
  2131) 
  2132) subroutine ReactionDestroy(reaction,option)
  2133)   ! 
  2134)   ! Deallocates a reaction object
  2135)   ! 
  2136)   ! Author: Glenn Hammond
  2137)   ! Date: 05/29/08
  2138)   ! 
  2139) 
  2140)   use Utility_module, only: DeallocateArray
  2141)   use Option_module
  2142)   
  2143)   implicit none
  2144) 
  2145)   type(reaction_type), pointer :: reaction
  2146)   
  2147)   type(aq_species_type), pointer :: aq_species, prev_aq_species
  2148)   type(gas_species_type), pointer :: gas_species, prev_gas_species
  2149)   type(mineral_rxn_type), pointer :: mineral, prev_mineral
  2150)   type(colloid_type), pointer :: colloid, prev_colloid
  2151)   type(ion_exchange_rxn_type), pointer :: ionxrxn, prev_ionxrxn
  2152)   type(surface_complexation_rxn_type), pointer :: srfcplxrxn, prev_srfcplxrxn
  2153)   type(general_rxn_type), pointer :: general_rxn, prev_general_rxn
  2154)   type(radioactive_decay_rxn_type), pointer :: radioactive_decay_rxn, &
  2155)                                                prev_radioactive_decay_rxn
  2156)   type(kd_rxn_type), pointer :: kd_rxn, prev_kd_rxn
  2157)   type(option_type) :: option
  2158) 
  2159)   if (.not.associated(reaction)) return
  2160)   
  2161)   !species index
  2162)   call SpeciesIndexDestroy(reaction%species_idx)
  2163) 
  2164)   ! primary species
  2165)   if (associated(reaction%primary_species_list)) &
  2166)     call AqueousSpeciesListDestroy(reaction%primary_species_list)
  2167)   nullify(reaction%primary_species_list)
  2168) 
  2169)   ! secondary species
  2170)   if (associated(reaction%secondary_species_list)) &
  2171)     call AqueousSpeciesListDestroy(reaction%secondary_species_list)
  2172)   nullify(reaction%secondary_species_list)
  2173) 
  2174)   ! gas species
  2175)   gas_species => reaction%gas_species_list
  2176)   do
  2177)     if (.not.associated(gas_species)) exit
  2178)     prev_gas_species => gas_species
  2179)     gas_species => gas_species%next
  2180)     call GasSpeciesDestroy(prev_gas_species)
  2181)   enddo  
  2182)   nullify(reaction%gas_species_list)
  2183)   
  2184)   ! colloid species
  2185)   colloid => reaction%colloid_list
  2186)   do
  2187)     if (.not.associated(colloid)) exit
  2188)     prev_colloid => colloid
  2189)     colloid => colloid%next
  2190)     call ColloidDestroy(prev_colloid)
  2191)   enddo    
  2192)   nullify(reaction%colloid_list)
  2193)   
  2194)   ! ionx exchange reactions
  2195)   ionxrxn => reaction%ion_exchange_rxn_list
  2196)   do
  2197)     if (.not.associated(ionxrxn)) exit
  2198)     prev_ionxrxn => ionxrxn
  2199)     ionxrxn => ionxrxn%next
  2200)     call IonExchangeRxnDestroy(prev_ionxrxn)
  2201)   enddo    
  2202)   nullify(reaction%ion_exchange_rxn_list)
  2203) 
  2204)   ! radioactive decay reactions
  2205)   radioactive_decay_rxn => reaction%radioactive_decay_rxn_list
  2206)   do
  2207)     if (.not.associated(radioactive_decay_rxn)) exit
  2208)     prev_radioactive_decay_rxn => radioactive_decay_rxn
  2209)     radioactive_decay_rxn => radioactive_decay_rxn%next
  2210)     call RadioactiveDecayRxnDestroy(prev_radioactive_decay_rxn)
  2211)   enddo    
  2212)   nullify(reaction%radioactive_decay_rxn_list)
  2213)   
  2214)   ! general reactions
  2215)   general_rxn => reaction%general_rxn_list
  2216)   do
  2217)     if (.not.associated(general_rxn)) exit
  2218)     prev_general_rxn => general_rxn
  2219)     general_rxn => general_rxn%next
  2220)     call GeneralRxnDestroy(prev_general_rxn)
  2221)   enddo    
  2222)   nullify(reaction%general_rxn_list)
  2223)   
  2224)   ! kd reactions
  2225)   kd_rxn => reaction%kd_rxn_list
  2226)   do
  2227)     if (.not.associated(kd_rxn)) exit
  2228)     prev_kd_rxn => kd_rxn
  2229)     kd_rxn => kd_rxn%next
  2230)     call KDRxnDestroy(prev_kd_rxn)
  2231)   enddo    
  2232)   nullify(reaction%kd_rxn_list)
  2233) 
  2234)   ! kd reactions secondary continuum
  2235)   if (option%use_mc) then
  2236)     kd_rxn => reaction%sec_cont_kd_rxn_list
  2237)     do
  2238)       if (.not.associated(kd_rxn)) exit
  2239)       prev_kd_rxn => kd_rxn
  2240)       kd_rxn => kd_rxn%next
  2241)       call KDRxnDestroy(prev_kd_rxn)
  2242)     enddo
  2243)     nullify(reaction%sec_cont_kd_rxn_list)
  2244)   endif
  2245) 
  2246)   call SurfaceComplexationDestroy(reaction%surface_complexation)
  2247)   call MineralDestroy(reaction%mineral)
  2248)   call MicrobialDestroy(reaction%microbial)
  2249)   call ImmobileDestroy(reaction%immobile)
  2250) #ifdef SOLID_SOLUTION  
  2251)   call SolidSolutionDestroy(reaction%solid_solution_list)
  2252) #endif  
  2253) 
  2254)   if (associated(reaction%dbase_temperatures)) &
  2255)     deallocate(reaction%dbase_temperatures)
  2256)   nullify(reaction%dbase_temperatures)  
  2257)   
  2258)   ! redox species
  2259)   if (associated(reaction%redox_species_list)) &
  2260)     call AqueousSpeciesListDestroy(reaction%redox_species_list)
  2261)   nullify(reaction%redox_species_list)
  2262)   
  2263)   call DeallocateArray(reaction%primary_species_names)
  2264)   call DeallocateArray(reaction%secondary_species_names)
  2265)   call DeallocateArray(reaction%gas_species_names)
  2266)   call DeallocateArray(reaction%eqcplx_basis_names)
  2267)   call DeallocateArray(reaction%colloid_names)
  2268)   call DeallocateArray(reaction%colloid_species_names)  
  2269)   
  2270)   call DeallocateArray(reaction%primary_species_print)
  2271)   call DeallocateArray(reaction%secondary_species_print)
  2272)   call DeallocateArray(reaction%gas_species_print)
  2273)   call DeallocateArray(reaction%eqcplx_basis_print)
  2274)   call DeallocateArray(reaction%kd_print)
  2275)   call DeallocateArray(reaction%total_sorb_print)
  2276)   call DeallocateArray(reaction%total_sorb_mobile_print)
  2277)   call DeallocateArray(reaction%colloid_print)
  2278)   
  2279)   call DeallocateArray(reaction%primary_spec_a0)
  2280)   call DeallocateArray(reaction%primary_spec_Z)
  2281)   call DeallocateArray(reaction%primary_spec_molar_wt)
  2282)   
  2283)   call DeallocateArray(reaction%eqcplxspecid)
  2284)   call DeallocateArray(reaction%eqcplxstoich)
  2285)   call DeallocateArray(reaction%eqcplxh2oid)
  2286)   call DeallocateArray(reaction%eqcplxh2ostoich)
  2287)   call DeallocateArray(reaction%eqcplx_a0)
  2288)   call DeallocateArray(reaction%eqcplx_Z)
  2289)   call DeallocateArray(reaction%eqcplx_molar_wt)
  2290)   call DeallocateArray(reaction%eqcplx_logK)
  2291)   call DeallocateArray(reaction%eqcplx_logKcoef)
  2292)   
  2293)   call DeallocateArray(reaction%eqgasspecid)
  2294)   call DeallocateArray(reaction%eqgasstoich)
  2295)   call DeallocateArray(reaction%eqgash2oid)
  2296)   call DeallocateArray(reaction%eqgash2ostoich)
  2297)   call DeallocateArray(reaction%eqgas_logK)
  2298)   call DeallocateArray(reaction%eqgas_logKcoef)
  2299)   
  2300)   call DeallocateArray(reaction%eqionx_rxn_Z_flag)
  2301)   call DeallocateArray(reaction%eqionx_rxn_cation_X_offset)
  2302)   call DeallocateArray(reaction%eqionx_rxn_to_surf)
  2303)   call DeallocateArray(reaction%eqionx_rxn_CEC)
  2304)   call DeallocateArray(reaction%eqionx_rxn_k)
  2305)   call DeallocateArray(reaction%eqionx_rxn_cationid)
  2306)   
  2307) #if 0  
  2308)   call DeallocateArray(reaction%kinionx_CEC)
  2309)   call DeallocateArray(reaction%kinionx_k)
  2310)   call DeallocateArray(reaction%kinionx_cationid)
  2311) #endif
  2312)   
  2313)   call DeallocateArray(reaction%pri_spec_to_coll_spec)
  2314)   call DeallocateArray(reaction%coll_spec_to_pri_spec)
  2315)   call DeallocateArray(reaction%colloid_mobile_fraction)
  2316)   
  2317)   call DeallocateArray(reaction%radiodecayspecid)
  2318)   call DeallocateArray(reaction%radiodecaystoich)
  2319)   call DeallocateArray(reaction%radiodecayforwardspecid)
  2320)   call DeallocateArray(reaction%radiodecay_kf)
  2321)   
  2322)   call DeallocateArray(reaction%generalspecid)
  2323)   call DeallocateArray(reaction%generalstoich)
  2324)   call DeallocateArray(reaction%generalforwardspecid)
  2325)   call DeallocateArray(reaction%generalforwardstoich)
  2326)   call DeallocateArray(reaction%generalbackwardspecid)
  2327)   call DeallocateArray(reaction%generalbackwardstoich)
  2328)   call DeallocateArray(reaction%generalh2oid)
  2329)   call DeallocateArray(reaction%generalh2ostoich)
  2330)   call DeallocateArray(reaction%general_kf)
  2331)   call DeallocateArray(reaction%general_kr)
  2332)   
  2333)   call DeallocateArray(reaction%eqkdspecid)
  2334)   call DeallocateArray(reaction%eqkdtype)
  2335)   call DeallocateArray(reaction%eqkdmineral)
  2336)   call DeallocateArray(reaction%eqkddistcoef)
  2337)   call DeallocateArray(reaction%eqkdlangmuirb)
  2338)   call DeallocateArray(reaction%eqkdfreundlichn)
  2339)  
  2340)   call DeallocateArray(reaction%sec_cont_eqkdtype)
  2341)   call DeallocateArray(reaction%sec_cont_eqkddistcoef)
  2342)   call DeallocateArray(reaction%sec_cont_eqkdlangmuirb)
  2343)   call DeallocateArray(reaction%sec_cont_eqkdfreundlichn)     
  2344)   
  2345)   deallocate(reaction)
  2346)   nullify(reaction)
  2347) 
  2348) end subroutine ReactionDestroy
  2349) 
  2350) end module Reaction_Aux_module

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