! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! 
! The Reaction Rates File
! 
! Generated by KPP-2.2 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                 : cbm5_Rates.f90
! Time                 : Wed Jan 13 12:13:24 2010
! Working directory    : /gpfs/projects/bsc32/bsc32771/UMO/UMO-Chem/chemistry/KPP/kpp-2.2.1.December2006/models/CBM5
! Equation file        : cbm5.kpp
! Output root filename : cbm5
! 
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



MODULE cbm5_Rates

  USE cbm5_Parameters
  USE cbm5_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) 
!MONARCH
!      REAL A1, C1, A2, C2
      REAL*8 A1, C1, A2, C2
!MONARCH
      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


! End INLINED Rate Law Functions

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

  SUBROUTINE Update_SUN()
      !USE cbm5_Parameters
      !USE cbm5_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 :
! 
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!MONARCH
!SUBROUTINE Update_RCONST ( )
SUBROUTINE Update_RCONSTCB5 ( )
!MONARCH


! Begin INLINED RCONST


! End INLINED RCONST
!MONARCH INCLUSION OF PHOTOLYSIS RATES
  RCONST(1) = J_NO2 !(8.89E-3*SUN)
  RCONST(2) = (ARR(6.E-34,0.,-2.4))
  RCONST(3) = (ARR2(3.E-12,-1500.))
  RCONST(4) = (ARR2(5.6E-12,180.))
  RCONST(5) = (FALL(2.5E-31,0.,-1.8,2.2E-11,0.,-0.7,0.6))
  RCONST(6) = (FALL(9.0E-32,0.,-1.5,3.0E-11,0.,0.,0.6))
  RCONST(7) = (ARR2(1.2E-13,-2450.0))
  RCONST(8) = J_O33P !(3.556E-04*SUN)
  RCONST(9) = J_O31D !(2.489E-05*SUN)
  RCONST(10) = (ARR2(2.1E-11,102.0))
! RCONST(11) = constant rate coefficient
  RCONST(12) = (ARR2(1.7E-12,-940.0))
  RCONST(13) = (ARR2(1.0E-14,-490.0))
  RCONST(14) = J_NO3O  !corrected 20100125    J_NO3O2 !(8.89E-3*SUN)
  RCONST(15) = J_NO3O2  !corrected 20100125     J_NO3O  !(8.89E-3*SUN)
  RCONST(16) = (ARR2(1.5E-11,170.0))
  RCONST(17) = (ARR2(4.5E-14,-1260.0))
  RCONST(18) = (FALL(2.0E-30,0.,-4.4,1.4E-12,0.,-0.7,0.6))
! RCONST(19) = constant rate coefficient
! RCONST(20) = constant rate coefficient
  RCONST(21) = (FALL(1.0E-3,11000.,-3.5,9.7E14,11080.,0.1,0.45))
  RCONST(22) = (ARR2(3.3E-39,530.0))
! RCONST(23) = constant rate coefficient
  RCONST(24) = (FALL(7.0E-31,0.,-2.6,3.6E-11,0.,-0.1,0.6))
  RCONST(25) = J_HNO2 !(1.511e-03*SUN)
  RCONST(26) = (ARR2(1.8E-11,-390.))
! RCONST(27) = constant rate coefficient
  RCONST(28) = (FALL(2.E-30,0.,-3.0,2.5E-11,0.,0.,0.6))
  RCONST(29) = (EP2(2.4E-14,-460.,2.7E-17,-2199.,6.5E-34,-1335.))
  RCONST(30) = (ARR2(3.5E-12,250.0))
  RCONST(31) = (FALL(1.8E-31,0.,-3.2,4.7E-12,0.,0.,0.6))
  RCONST(32) = (FALL(4.1E-5,10650.,0.,4.8E15,11170.,0.,0.6))
  RCONST(33) = (ARR2(1.3E-12,380.))
!MONARCH
!  RCONST(34) = (EP3(2.3E-13,-600.,1.7E-33,-1000.))
!  RCONST(35) = (EP3(3.22E-34,-2800.,2.38E-54,-3200.))
  RCONST(34) = (EP3(2.3d-13,-600.d0,1.7d-33,-1000.d0))
  RCONST(35) = (EP3(3.22d-34,-2800.d0,2.38d-54,-3200.d0))
!MONARCH
  RCONST(36) = J_H2O2 !(6.312E-06*SUN)
  RCONST(37) = (ARR2(2.9E-12,-160.0))
! RCONST(38) = constant rate coefficient
  RCONST(39) = (ARR2(5.5E-12,-2000.))
  RCONST(40) = (ARR2(2.2E-11,120.))
  RCONST(41) = (ARR2(4.2E-12,-240.))
  RCONST(42) = (FALL(6.9E-31,0.,-1.,2.6E-11,0.,0.,0.6))
  RCONST(43) = (ARR2(4.8E-11,250.))
  RCONST(44) = (ARR2(3.E-11,200.))
  RCONST(45) = (ARR2(1.4E-12,-2000.))
! RCONST(46) = constant rate coefficient
! RCONST(47) = constant rate coefficient
! RCONST(48) = constant rate coefficient
! RCONST(49) = constant rate coefficient
  RCONST(50) = (ARR2(8.5E-13,-2450.))
  RCONST(51) = J_HNO4 !(SUN)
  RCONST(52) = J_HNO3 !(SUN)
  RCONST(53) = J_N2O5 !(SUN)
  RCONST(54) = (ARR2(2.6E-12,365.))
  RCONST(55) = (ARR2(2.6E-12,365.))
  RCONST(56) = (ARR2(7.5E-13,700.))
  RCONST(57) = (ARR2(7.5E-13,700.))
! RCONST(58) = constant rate coefficient
! RCONST(59) = constant rate coefficient
! RCONST(60) = constant rate coefficient
  RCONST(61) = (ARR2(5.9E-13,-360.))
  RCONST(62) = J_NTR !(SUN)
  RCONST(63) = (ARR2(3.01E-12,190.))
  RCONST(64) = J_COOH !(SUN)
!MONARCH
!  RCONST(65) = (EP3(1.44E-13,0.,3.43E-33,0.))
  RCONST(65) = (EP3(1.44d-13,0.d0,3.43d-33,0.d0))
!MONARCH
  RCONST(66) = (ARR2(2.45E-12,-1775.))
  RCONST(67) = (ARR2(2.8E-12,300.))
  RCONST(68) = (ARR2(4.1E-13,750.))
  RCONST(69) = (ARR2(9.5E-14,390.))
  RCONST(70) = (ARR2(3.8E-12,200.))
  RCONST(71) = J_COOH !(SUN)
  RCONST(72) = (ARR2(7.3E-12,-620.))
! RCONST(73) = constant rate coefficient
  RCONST(74) = J_CH2OR !(SUN)
  RCONST(75) = J_CH2OM !(SUN)
  RCONST(76) = (ARR2(3.4E-11,-1600.))
! RCONST(77) = constant rate coefficient
  RCONST(78) = (ARR2(9.7E-15,625.))
  RCONST(79) = (ARR2(2.4E12,-7000.))
! RCONST(80) = constant rate coefficient
  RCONST(81) = (ARR2(5.6E-15,2300.))
! RCONST(82) = constant rate coefficient
  RCONST(83) = (ARR2(1.8E-11,-1100.))
  RCONST(84) = (ARR2(5.6E-12,270.))
  RCONST(85) = (ARR2(1.4E-12,-1900.))
  RCONST(86) = J_CH3CHO !(SUN)
  RCONST(87) = (ARR2(8.1E-12,270.))
  RCONST(88) = (FALL(2.7E-28,0.,-7.1,1.2E-11,0.,-0.9,0.3))
  RCONST(89) = (FALL(4.9E-3,12100.,0.,5.4E16,13830.,0.,0.3))
  RCONST(90) = J_PAN !(SUN)
  RCONST(91) = (ARR2(4.3E-13,1040.))
  RCONST(92) = (ARR2(2.E-12,500.))
  RCONST(93) = (ARR2(4.4E-13,1070.))
  RCONST(94) = (ARR2(2.9E-12,500.))
  RCONST(95) = (ARR2(4.E-13,200.))
  RCONST(96) = 0.*J_COOH !1*<PACD_CB05> PENDING (0.*SUN)
  RCONST(97) = (ARR2(4.E-13,200.))
  RCONST(98) = (ARR2(1.3E-11,-870.))
  RCONST(99) = (ARR2(5.1E-12,405.))
! RCONST(100) = constant rate coefficient
  RCONST(101) = J_C2CHO !(SUN)
  RCONST(102) = (ARR2(6.7E-12,340.))
  RCONST(103) = (FALL(2.7E-28,0.,-7.1,1.2E-11,0.,-0.9,0.3))
  RCONST(104) = (FALL(4.9E-3,12100.,0.,5.4E16,13830.,0.,0.3))
  RCONST(105) = J_PAN !(SUN)
! RCONST(106) = constant rate coefficient
  RCONST(107) = (ARR2(4.3E-13,1040.))
  RCONST(108) = (ARR2(2.E-12,500.))
  RCONST(109) = (ARR2(4.4E-13,1070.))
  RCONST(110) = (ARR2(2.9E-12,500.))
  RCONST(111) = (ARR2(2.9E-12,500.))
! RCONST(112) = constant rate coefficient
  RCONST(113) = (ARR2(1E15,-8000.))
! RCONST(114) = constant rate coefficient
! RCONST(115) = constant rate coefficient
  RCONST(116) = (ARR2(1E-11,-280.))
! RCONST(117) = constant rate coefficient
  RCONST(118) = (ARR2(6.5E-15,-1900.))
  RCONST(119) = (ARR2(7.E-13,-2160.))
  RCONST(120) = (ARR2(1.04E-11,-792.))
  RCONST(121) = (FALL(1.0E-28,0.,-0.8,8.8E-12,0.,0.,0.6))
  RCONST(122) = (ARR2(1.2E-14,-2630.))
  RCONST(123) = (ARR2(3.3E-12,-2880.))
! RCONST(124) = constant rate coefficient
  RCONST(125) = (ARR2(1E-11,550.))
  RCONST(126) = (ARR2(8.4E-15,-1100.))
  RCONST(127) = (ARR2(9.6E-13,-270.))
  RCONST(128) = (ARR2(1.8E-12,355.))
! RCONST(129) = constant rate coefficient
! RCONST(130) = constant rate coefficient
! RCONST(131) = constant rate coefficient
! RCONST(132) = constant rate coefficient
! RCONST(133) = constant rate coefficient
! RCONST(134) = constant rate coefficient
  RCONST(135) = 9.*J_CH2OR !(SUN)
! RCONST(136) = constant rate coefficient
  RCONST(137) = (ARR2(5.4E-17,-500.))
  RCONST(138) = (ARR2(1.7E-11,116.))
! RCONST(139) = constant rate coefficient
  RCONST(140) = J_MGLY !(SUN)
! RCONST(141) = constant rate coefficient
  RCONST(142) = (ARR2(2.54E-11,407.6))
  RCONST(143) = (ARR2(7.86E-15,-1912.))
  RCONST(144) = (ARR2(3.03E-12,-448.))
! RCONST(145) = constant rate coefficient
! RCONST(146) = constant rate coefficient
! RCONST(147) = constant rate coefficient
  RCONST(148) = J_ISPD !(SUN)
! RCONST(149) = constant rate coefficient
  RCONST(150) = (ARR2(1.5E-11,449.))
  RCONST(151) = (ARR2(1.2E-15,-821.))
  RCONST(152) = (ARR2(3.7E-12,175.))
  RCONST(153) = (FALL(3.0E-31,0.,-3.3,1.5E-12,0.,0.,0.6))
  RCONST(154) = (ARR2(6.9E-12,-230.))
  RCONST(155) = (ARR2(8.7E-12,-1070.))
! RCONST(156) = constant rate coefficient

!MONARCH      
!END SUBROUTINE Update_RCONST
END SUBROUTINE Update_RCONSTCB5
!MONARCH

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


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

SUBROUTINE Update_PHOTO ( )


   USE cbm5_Global

  RCONST(1) = (8.89E-3*SUN)
  RCONST(8) = (3.556E-04*SUN)
  RCONST(9) = (2.489E-05*SUN)
  RCONST(14) = (8.89E-3*SUN)
  RCONST(15) = (8.89E-3*SUN)
  RCONST(25) = (1.511e-03*SUN)
  RCONST(36) = (6.312E-06*SUN)
  RCONST(51) = (SUN)
  RCONST(52) = (SUN)
  RCONST(53) = (SUN)
  RCONST(62) = (SUN)
  RCONST(64) = (SUN)
  RCONST(71) = (SUN)
  RCONST(74) = (SUN)
  RCONST(75) = (SUN)
  RCONST(86) = (SUN)
  RCONST(90) = (SUN)
  RCONST(96) = (0.*SUN)
  RCONST(101) = (SUN)
  RCONST(105) = (SUN)
  RCONST(135) = (SUN)
  RCONST(140) = (SUN)
  RCONST(148) = (SUN)
      
END SUBROUTINE Update_PHOTO

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



END MODULE cbm5_Rates

