source: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp/util/UserRateLaws.f90 @ 4127

Last change on this file since 4127 was 2696, checked in by kanani, 7 years ago

Merge of branch palm4u into trunk

File size: 4.0 KB
Line 
1!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2!  User-defined Rate Law functions
3!  Note: the default argument type for rate laws, as read from the equations file, is single precision
4!        but all the internal calculations are performed in double precision
5!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
6!
7! RFo: IMPORTANT: Comments must ALWAYS stand BEFORE the code to be processed
8!
9!      This is just the working copy of UserRateLaws.f90 which is actually used.
10!      It is copied from GASPASE_PREPROC/mechanisms/UserRateLaws.f90 to kpp/util/UserRateLaws.f90
11!      each time when run_kpp4palm.ksh is run.
12
13
14!~~~>  Arrhenius
15   KPP_REAL FUNCTION ARR( A0,B0,C0 )
16      REAL A0,B0,C0     
17      ARR =  DBLE(A0) * EXP(-DBLE(B0)/TEMP) * (TEMP/300.0_dp)**DBLE(C0)
18   END FUNCTION ARR       
19
20
21!~~~> Simplified Arrhenius, with two arguments, fixed TEMP=20 deg C
22!~~~> Note: The argument B0 has a changed sign when compared to ARR
23!
24!~~~> Simplified Arrhenius, with two arguments
25! RFo: same as above, but with TEMP in parameter list and _dp
26!  KPP_REAL (kind=dp) FUNCTION ARR2( A0, B0 )
27!     REAL (kind=dp) A0,B0
28!     ARR2 =  A0 * EXP( B0 / 20.0_dp )
29!  END FUNCTION ARR2
30REAL(kind=dp) FUNCTION ARR2( a0, b0, temp )
31    REAL(kind=dp) :: temp
32    REAL(kind=dp) :: a0,b0
33    ARR2 = a0 * EXP( -b0 / temp )
34END FUNCTION ARR2
35
36
37   KPP_REAL FUNCTION EP2(A0,C0,A2,C2,A3,C3)
38      REAL A0,C0,A2,C2,A3,C3
39      REAL(kind=dp) K0,K2,K3           
40      K0 = DBLE(A0) * EXP(-DBLE(C0)/TEMP)
41      K2 = DBLE(A2) * EXP(-DBLE(C2)/TEMP)
42      K3 = DBLE(A3) * EXP(-DBLE(C3)/TEMP)
43      K3 = K3*CFACTOR*1.0E6_dp
44      EP2 = K0 + K3/(1.0_dp+K3/K2 )
45   END FUNCTION EP2
46
47   KPP_REAL FUNCTION EP3(A1,C1,A2,C2) 
48      REAL A1, C1, A2, C2
49      REAL(kind=dp) K1, K2     
50      K1 = DBLE(A1) * EXP(-DBLE(C1)/TEMP)
51      K2 = DBLE(A2) * EXP(-DBLE(C2)/TEMP)
52      EP3 = K1 + K2*(1.0E6_dp*CFACTOR)
53   END FUNCTION EP3 
54
55   KPP_REAL FUNCTION FALL ( A0,B0,C0,A1,B1,C1,CF)
56      REAL A0,B0,C0,A1,B1,C1,CF
57      REAL(kind=dp) K0, K1     
58      K0 = DBLE(A0) * EXP(-DBLE(B0)/TEMP)* (TEMP/300.0_dp)**DBLE(C0)
59      K1 = DBLE(A1) * EXP(-DBLE(B1)/TEMP)* (TEMP/300.0_dp)**DBLE(C1)
60      K0 = K0*CFACTOR*1.0E6_dp
61      K1 = K0/K1
62      FALL = (K0/(1.0_dp+K1))*   &
63           DBLE(CF)**(1.0_dp/(1.0_dp+(LOG10(K1))**2))
64   END FUNCTION FALL
65
66  !---------------------------------------------------------------------------
67
68  ELEMENTAL REAL(kind=dp) FUNCTION k_3rd(temp,cair,k0_300K,n,kinf_300K,m,fc)
69
70    INTRINSIC LOG10
71
72    REAL(kind=dp), INTENT(IN) :: temp      ! temperature [K]
73    REAL(kind=dp), INTENT(IN) :: cair      ! air concentration [molecules/cm3]
74    REAL, INTENT(IN) :: k0_300K   ! low pressure limit at 300 K
75    REAL, INTENT(IN) :: n         ! exponent for low pressure limit
76    REAL, INTENT(IN) :: kinf_300K ! high pressure limit at 300 K
77    REAL, INTENT(IN) :: m         ! exponent for high pressure limit
78    REAL, INTENT(IN) :: fc        ! broadening factor (usually fc=0.6)
79    REAL(kind=dp) :: zt_help, k0_T, kinf_T, k_ratio
80
81    zt_help = 300._dp/temp
82    k0_T    = k0_300K   * zt_help**(n) * cair ! k_0   at current T
83    kinf_T  = kinf_300K * zt_help**(m)        ! k_inf at current T
84    k_ratio = k0_T/kinf_T
85    k_3rd   = k0_T/(1._dp+k_ratio)*fc**(1._dp/(1._dp+LOG10(k_ratio)**2))
86
87  END FUNCTION k_3rd
88
89  !---------------------------------------------------------------------------
90
91  ELEMENTAL REAL(kind=dp) FUNCTION k_arr (k_298,tdep,temp)
92    ! Arrhenius function
93
94    REAL,     INTENT(IN) :: k_298 ! k at T = 298.15K
95    REAL,     INTENT(IN) :: tdep  ! temperature dependence
96    REAL(kind=dp), INTENT(IN) :: temp  ! temperature
97
98    INTRINSIC EXP
99
100    k_arr = k_298 * EXP(tdep*(1._dp/temp-3.3540E-3_dp)) ! 1/298.15=3.3540e-3
101
102  END FUNCTION k_arr
103
104!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
105!  End of User-defined Rate Law functions
106!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Note: See TracBrowser for help on using the repository browser.