!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! 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 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! ! RFo: IMPORTANT: Comments must ALWAYS stand BEFORE the code to be processed ! ! This is just the working copy of UserRateLaws.f90 which is actually used. ! It is copied from GASPASE_PREPROC/mechanisms/UserRateLaws.f90 to kpp/util/UserRateLaws.f90 ! each time when run_kpp4palm.ksh is run. !~~~> Arrhenius KPP_REAL 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, fixed TEMP=20 deg C !~~~> Note: The argument B0 has a changed sign when compared to ARR ! !~~~> Simplified Arrhenius, with two arguments ! RFo: same as above, but with TEMP in parameter list and _dp ! KPP_REAL (kind=dp) FUNCTION ARR2( A0, B0 ) ! REAL (kind=dp) A0,B0 ! ARR2 = A0 * EXP( B0 / 20.0_dp ) ! END FUNCTION ARR2 REAL(kind=dp) FUNCTION ARR2( a0, b0, temp ) REAL(kind=dp) :: temp REAL(kind=dp) :: a0,b0 ARR2 = a0 * EXP( -b0 / temp ) END FUNCTION ARR2 KPP_REAL 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 KPP_REAL 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 KPP_REAL 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 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~