! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! 
! The Reaction Rates File
! 
! Generated by KPP-2.2.1_rs5 symbolic chemistry Kinetics PreProcessor
!       (http://www.cs.vt.edu/~asandu/Software/KPP)
! KPP is distributed under GPL, the general public licence
!       (http://www.gnu.org/copyleft/gpl.html)
! (C) 1995-1997, V. Damian & A. Sandu, CGRER, Univ. Iowa
! (C) 1997-2005, A. Sandu, Michigan Tech, Virginia Tech
!     With important contributions from:
!        M. Damian, Villanova University, USA
!        R. Sander, Max-Planck Institute for Chemistry, Mainz, Germany
! 
! File                 : SUAQ_messy_mecca_kpp_Rates.f90
! Time                 : Tue Jan 23 13:18:01 2018
! Working directory    : /gpfs/projects/bsc32/bsc32771/MN3/NMMB/test/KPP/caaba_3.0gmdd/mecca
! Equation file        : SUAQ_messy_mecca_kpp.kpp
! Output root filename : SUAQ_messy_mecca_kpp
! 
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



MODULE SUAQ_messy_mecca_kpp_Rates

  USE SUAQ_messy_mecca_kpp_Parameters
  USE SUAQ_messy_mecca_kpp_Global
  IMPLICIT NONE

CONTAINS



! Begin Rate Law Functions from KPP_HOME/util/UserRateLaws

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!  User-defined Rate Law functions
!  Note: the default argument type for rate laws, as read from the equations file, is single precision
!        but all the internal calculations are performed in double precision
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

!~~~>  Arrhenius
   REAL(kind=dp) FUNCTION ARR( A0,B0,C0 )
      REAL A0,B0,C0      
      ARR =  DBLE(A0) * EXP(-DBLE(B0)/TEMP) * (TEMP/300.0_dp)**DBLE(C0)
   END FUNCTION ARR        

!~~~> Simplified Arrhenius, with two arguments
!~~~> Note: The argument B0 has a changed sign when compared to ARR
   REAL(kind=dp) FUNCTION ARR2( A0,B0 )
      REAL A0,B0           
      ARR2 =  DBLE(A0) * EXP( DBLE(B0)/TEMP )              
   END FUNCTION ARR2          

   REAL(kind=dp) FUNCTION EP2(A0,C0,A2,C2,A3,C3)
      REAL A0,C0,A2,C2,A3,C3
      REAL(kind=dp) K0,K2,K3            
      K0 = DBLE(A0) * EXP(-DBLE(C0)/TEMP)
      K2 = DBLE(A2) * EXP(-DBLE(C2)/TEMP)
      K3 = DBLE(A3) * EXP(-DBLE(C3)/TEMP)
      K3 = K3*CFACTOR*1.0E6_dp
      EP2 = K0 + K3/(1.0_dp+K3/K2 )
   END FUNCTION EP2

   REAL(kind=dp) FUNCTION EP3(A1,C1,A2,C2) 
      REAL A1, C1, A2, C2
      REAL(kind=dp) K1, K2      
      K1 = DBLE(A1) * EXP(-DBLE(C1)/TEMP)
      K2 = DBLE(A2) * EXP(-DBLE(C2)/TEMP)
      EP3 = K1 + K2*(1.0E6_dp*CFACTOR)
   END FUNCTION EP3 

   REAL(kind=dp) FUNCTION FALL ( A0,B0,C0,A1,B1,C1,CF)
      REAL A0,B0,C0,A1,B1,C1,CF
      REAL(kind=dp) K0, K1     
      K0 = DBLE(A0) * EXP(-DBLE(B0)/TEMP)* (TEMP/300.0_dp)**DBLE(C0)
      K1 = DBLE(A1) * EXP(-DBLE(B1)/TEMP)* (TEMP/300.0_dp)**DBLE(C1)
      K0 = K0*CFACTOR*1.0E6_dp
      K1 = K0/K1
      FALL = (K0/(1.0_dp+K1))*   &
           DBLE(CF)**(1.0_dp/(1.0_dp+(LOG10(K1))**2))
   END FUNCTION FALL

  !---------------------------------------------------------------------------

  ELEMENTAL REAL(kind=dp) FUNCTION k_3rd(temp,cair,k0_300K,n,kinf_300K,m,fc)

    INTRINSIC LOG10

    REAL(kind=dp), INTENT(IN) :: temp      ! temperature [K]
    REAL(kind=dp), INTENT(IN) :: cair      ! air concentration [molecules/cm3]
    REAL, INTENT(IN) :: k0_300K   ! low pressure limit at 300 K
    REAL, INTENT(IN) :: n         ! exponent for low pressure limit
    REAL, INTENT(IN) :: kinf_300K ! high pressure limit at 300 K
    REAL, INTENT(IN) :: m         ! exponent for high pressure limit
    REAL, INTENT(IN) :: fc        ! broadening factor (usually fc=0.6)
    REAL(kind=dp) :: zt_help, k0_T, kinf_T, k_ratio

    zt_help = 300._dp/temp
    k0_T    = k0_300K   * zt_help**(n) * cair ! k_0   at current T
    kinf_T  = kinf_300K * zt_help**(m)        ! k_inf at current T
    k_ratio = k0_T/kinf_T
    k_3rd   = k0_T/(1._dp+k_ratio)*fc**(1._dp/(1._dp+LOG10(k_ratio)**2))

  END FUNCTION k_3rd

  !---------------------------------------------------------------------------

  ELEMENTAL REAL(kind=dp) FUNCTION k_arr (k_298,tdep,temp)
    ! Arrhenius function

    REAL,     INTENT(IN) :: k_298 ! k at T = 298.15K
    REAL,     INTENT(IN) :: tdep  ! temperature dependence
    REAL(kind=dp), INTENT(IN) :: temp  ! temperature

    INTRINSIC EXP

    k_arr = k_298 * EXP(tdep*(1._dp/temp-3.3540E-3_dp)) ! 1/298.15=3.3540e-3

  END FUNCTION k_arr

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!  End of User-defined Rate Law functions
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

! End Rate Law Functions from KPP_HOME/util/UserRateLaws


! Begin INLINED Rate Law Functions


  ELEMENTAL REAL(dp) FUNCTION k_SIV_H2O2 (k_298,tdep,cHp,temp)
    ! special rate function for S(IV) + H2O2
    REAL,     INTENT(IN) :: k_298 ! k at T = 298.15K
    REAL,     INTENT(IN) :: tdep  ! temperature dependence
    REAL(dp), INTENT(IN) :: cHp   ! c(H+)
    REAL(dp), INTENT(IN) :: temp  ! temperature
    INTRINSIC :: EXP
    k_SIV_H2O2 = k_298 * EXP(tdep*(1._dp/temp-3.3540E-3_dp)) &
      * cHp / (cHp+0.1_dp)
  END FUNCTION k_SIV_H2O2
  ELEMENTAL REAL(dp) FUNCTION k_3rd_iupac(temp,cair,k0_300K,n,kinf_300K,m,fc)
    ! IUPAC three body reaction formula (www.iupac-kinetic.ch.cam.ac.uk)
    INTRINSIC :: LOG10
    REAL(dp), INTENT(IN) :: temp      ! temperature [K]
    REAL(dp), INTENT(IN) :: cair      ! air concentration [molecules/cm3]
    REAL,     INTENT(IN) :: k0_300K   ! low pressure limit at 300 K
    REAL,     INTENT(IN) :: n         ! exponent for low pressure limit
    REAL,     INTENT(IN) :: kinf_300K ! high pressure limit at 300 K
    REAL,     INTENT(IN) :: m         ! exponent for high pressure limit
    REAL,     INTENT(IN) :: fc        ! broadening factor (e.g. 0.45 or 0.6...)
    REAL                 :: nu        ! N
    REAL                 :: zt_help, k0_T, kinf_T, k_ratio
    zt_help = 300._dp/temp
    k0_T    = k0_300K   * zt_help**(n) * cair ! k_0   at current T
    kinf_T  = kinf_300K * zt_help**(m)        ! k_inf at current T
    k_ratio = k0_T/kinf_T
    nu      = 0.75-1.27*LOG10(fc)
    k_3rd_iupac = k0_T/(1._dp+k_ratio)* &
      fc**(1._dp/(1._dp+(LOG10(k_ratio)/nu)**2))
  END FUNCTION k_3rd_iupac
  ELEMENTAL REAL(dp) FUNCTION k_limited (k3rd,cHp)
    ! diffusion limitation caps 3rd order rate coefficients
    REAL(dp), INTENT(IN) :: k3rd  ! 3rd order rate coefficient
    REAL(dp), INTENT(IN) :: cHp   ! c(H+)
    REAL(dp), PARAMETER  :: DiffLimit = 1E10 ! diffusion limitation [M-1s-1]
    INTRINSIC :: EXP
    k_limited = 1._dp / ( 1._dp/k3rd + cHp/DiffLimit)
  END FUNCTION k_limited

! End INLINED Rate Law Functions

! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! 
! Update_SUN - update SUN light using TIME
!   Arguments :
! 
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  SUBROUTINE Update_SUN()
      !USE SUAQ_messy_mecca_kpp_Parameters
      !USE SUAQ_messy_mecca_kpp_Global

    IMPLICIT NONE

    REAL(kind=dp) :: SunRise, SunSet
    REAL(kind=dp) :: Thour, Tlocal, Ttmp 
    ! PI - Value of pi
    REAL(kind=dp), PARAMETER :: PI = 3.14159265358979d0
    
    SunRise = 4.5_dp 
    SunSet  = 19.5_dp 
    Thour = TIME/3600.0_dp 
    Tlocal = Thour - (INT(Thour)/24)*24

    IF ((Tlocal>=SunRise).AND.(Tlocal<=SunSet)) THEN
       Ttmp = (2.0*Tlocal-SunRise-SunSet)/(SunSet-SunRise)
       IF (Ttmp.GT.0) THEN
          Ttmp =  Ttmp*Ttmp
       ELSE
          Ttmp = -Ttmp*Ttmp
       END IF
       SUN = ( 1.0_dp + COS(PI*Ttmp) )/2.0_dp 
    ELSE
       SUN = 0.0_dp 
    END IF

 END SUBROUTINE Update_SUN

! End of Update_SUN function
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! 
! Update_RCONST - function to update rate constants
!   Arguments :
! 
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUBROUTINE Update_RCONST ( )




! Begin INLINED RCONST


  USE SUAQ_messy_main_constants_mem ! atm2Pa, N_A, R_gas
  USE SUAQ_messy_cmn_photol_mem     ! IP_MAX, ip_*, jname
  ! end of USE statements
  !
  ! start of executable statements
  ! define some rate constants here if the expressions are too long
  ! for kpp or if they are used more than once
  k_HO2_HO2    = (1.5E-12*EXP(19./temp)+1.7E-33*EXP(1000./temp)*cair)* & ! {1.5+-0.2}
                 (1.+1.4E-21*EXP(2200./temp)*C(ind_H2O))
  k_NO3_NO2    = k_3rd(temp,cair,2.0E-30,4.4,1.4E-12,0.7,0.6)
  k_NO2_HO2    = k_3rd(temp,cair,2.0E-31,3.4,2.9E-12,1.1,0.6)
  k_HNO3_OH    = 2.4E-14*EXP(460./temp) + 1./ &
                 ( 1./(6.5E-34*EXP(1335./temp)*cair) + &
                 1./(2.7E-17*EXP(2199./temp)) )
  k_CH3OOH_OH  = 3.8E-12*EXP(200./temp)
  k_CH3CO3_NO2 = k_3rd(temp,cair,9.7E-29,5.6,9.3E-12,1.5,0.6)
  k_PAN_M      = k_CH3CO3_NO2/9.0E-29*EXP(-14000./temp)
  k_ClO_ClO    = k_3rd_iupac(temp,cair,2.0E-32, &
                 4.0,1.0E-11,0.0,0.45)
  ! JPL: k_ClO_ClO   = k_3rd(temp,cair,1.6E-32,4.5,2.0E-12,2.4,0.6)
  k_BrO_NO2    = k_3rd_iupac(temp,cair,4.7E-31,3.1,1.8E-11,0.0,0.4)
  ! JPL: k_BrO_NO2   = k_3rd(temp,cair,5.2E-31,3.2,6.9E-12,2.9,0.6)
  k_I_NO2      = k_3rd_iupac(temp,cair,3.0E-31,1.0,6.6E-11,0.0,0.63)
  ! for numerical reasons, the expression is multiplied by 1e30/1e30
  k_DMS_OH     = 1.E-9*EXP(5820./temp)*C(ind_O2)/ &
                 (1.E30+5.*EXP(6280./temp)*C(ind_O2))
  G7402a_yield = 0.8/1.1 ! 0.8+-0.2
  ! mz_pj_20080812+
  k_O3s = (1.7E-12*EXP(-940./temp)) * C(ind_OH) &  ! <G2104>
        + (1.E-14*EXP(-490./temp)) * C(ind_HO2) &  ! <G2107>
        + jx(ip_O1D) * 2.2E-10 * C(ind_H2O) &      !
        / ( 3.2E-11*EXP(70./temp)*C(ind_O2)   &
           + 1.8E-11*EXP(110./temp)*C(ind_N2) &
           + 2.2E-10*C(ind_H2O) )
  ! mz_pj_20080812-
  KRO2NO  = 2.54E-12*EXP(360./temp)
  KRO2HO2 = 2.91E-13*EXP(1300./temp)
  KAPHO2  = 4.30E-13*EXP(1040./temp) ! CH3CO3 + HO2
  KAPNO   = 8.10E-12*EXP(270./temp)  ! CH3CO3 + NO
  KRO2NO3 = 2.50E-12
  KNO3AL  = 1.4E-12*EXP(-1900./temp)
  J_IC3H7NO3 = 3.7*jx(ip_PAN)
  J_ACETOL   = 0.65*0.11*jx(ip_CHOH)
  RO2 = 0.
  IF (ind_LISOPACO2>0)  RO2 = RO2 + C(ind_LISOPACO2)
  IF (ind_ISOPBO2>0)    RO2 = RO2 + C(ind_ISOPBO2)
  IF (ind_ISOPDO2>0)    RO2 = RO2 + C(ind_ISOPDO2)
  IF (ind_NISOPO2>0)    RO2 = RO2 + C(ind_NISOPO2)
  IF (ind_LHC4ACCO3>0)  RO2 = RO2 + C(ind_LHC4ACCO3)
  IF (ind_LC578O2>0)    RO2 = RO2 + C(ind_LC578O2)
  IF (ind_C59O2>0)      RO2 = RO2 + C(ind_C59O2)
  IF (ind_LNISO3>0)     RO2 = RO2 + C(ind_LNISO3)
  IF (ind_CH3O2>0)      RO2 = RO2 + C(ind_CH3O2)
  IF (ind_CH3CO3>0)     RO2 = RO2 + C(ind_CH3CO3)
  IF (ind_C2H5O2>0)     RO2 = RO2 + C(ind_C2H5O2)
  IF (ind_HOCH2CO3>0)   RO2 = RO2 + C(ind_HOCH2CO3)
  IF (ind_HYPROPO2>0)   RO2 = RO2 + C(ind_HYPROPO2)
  IF (ind_HCOCO3>0)     RO2 = RO2 + C(ind_HCOCO3)
  IF (ind_CO2H3CO3>0)   RO2 = RO2 + C(ind_CO2H3CO3)
  IF (ind_LHMVKABO2>0)  RO2 = RO2 + C(ind_LHMVKABO2)
  IF (ind_MACO3>0)      RO2 = RO2 + C(ind_MACO3)
  IF (ind_MACRO2>0)     RO2 = RO2 + C(ind_MACRO2)
  IF (ind_LMVKOHABO2>0) RO2 = RO2 + C(ind_LMVKOHABO2)
  IF (ind_PRONO3BO2>0)  RO2 = RO2 + C(ind_PRONO3BO2)
  IF (ind_HOCH2CH2O2>0) RO2 = RO2 + C(ind_HOCH2CH2O2)
  IF (ind_CH3COCH2O2>0) RO2 = RO2 + C(ind_CH3COCH2O2)
  IF (ind_IC3H7O2>0)    RO2 = RO2 + C(ind_IC3H7O2)
  IF (ind_LC4H9O2>0)    RO2 = RO2 + C(ind_LC4H9O2)
  IF (ind_LMEKO2>0)     RO2 = RO2 + C(ind_LMEKO2)

! End INLINED RCONST

  RCONST(1) = (9.6E-12*EXP(-234./temp))
  RCONST(2) = ((1.7E-42*EXP(7810./temp)*cair*0.21)/(1+(5.5E-31*EXP(7460./temp)*cair*0.21)))
  RCONST(3) = (khet_Tr(iht_N2O5))
  RCONST(4) = (xaer(01)*k_arr(1.5E9,-5300.,temp)*cvfac(01))
  RCONST(5) = (xaer(01)*k_arr(3.7E5,-5500.,temp)*cvfac(01))
  RCONST(6) = (xaer(01)*k_SIV_H2O2(5.2E6,-3650.,C(ind_Hp_a01)*cvfac(01),temp)*cvfac(01))
  RCONST(7) = (k_exf(01,ind_O3))
  RCONST(8) = (k_exb(01,ind_O3))
  RCONST(9) = (k_exf(01,ind_H2O2))
  RCONST(10) = (k_exb(01,ind_H2O2))
  RCONST(11) = (k_exf(01,ind_SO2))
  RCONST(12) = (k_exb(01,ind_SO2))
  RCONST(13) = (xaer(01)*testfac_SO2*k_arr(1.7E1,2090.E0,temp))
  RCONST(14) = (xaer(01)*testfac_SO2*1.E3*cvfac(01))
  RCONST(15) = (xaer(01)*testfac_HSO3m*k_arr(6.E-2,1120.E0,temp))
  RCONST(16) = (xaer(01)*testfac_HSO3m*1.E6*cvfac(01))
      
END SUBROUTINE Update_RCONST

! End of Update_RCONST function
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! 
! Update_PHOTO - function to update photolytical rate constants
!   Arguments :
! 
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUBROUTINE Update_PHOTO ( )


   USE SUAQ_messy_mecca_kpp_Global

      
END SUBROUTINE Update_PHOTO

! End of Update_PHOTO function
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



END MODULE SUAQ_messy_mecca_kpp_Rates

