CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
module_mp_thompson_make_number_concentrations.F90
1
3
6
7 use physcons, only: pi => con_pi
8
9 implicit none
10
11 private
12
14
15! Q_ice is cloud ice mixing ratio, units of kg/m3
16! Q_cloud is cloud water mixing ratio, units of kg/m3
17! Q_rain is rain mixing ratio, units of kg/m3
18! temp is air temperature in Kelvin
19! make_IceNumber is cloud droplet number mixing ratio, units of number per m3
20! make_DropletNumber is rain number mixing ratio, units of number per kg of m3
21! make_RainNumber is rain number mixing ratio, units of number per kg of m3
22! qnwfa is number of water-friendly aerosols in number per kg
23
24!+---+-----------------------------------------------------------------+
25!+---+-----------------------------------------------------------------+
26
27 contains
33 elemental real function make_icenumber (Q_ice, temp)
34
35 !IMPLICIT NONE
36 REAL, PARAMETER:: ice_density = 890.0
37 !REAL, PARAMETER:: PI = 3.1415926536
38 real, intent(in):: q_ice, temp
39 integer idx_rei
40 real corr, reice, deice
41 double precision lambda
42
43!+---+-----------------------------------------------------------------+
44!..Table of lookup values of radiative effective radius of ice crystals
45!.. as a function of Temperature from -94C to 0C. Taken from WRF RRTMG
46!.. radiation code where it is attributed to Jon Egill Kristjansson
47!.. and coauthors.
48!+---+-----------------------------------------------------------------+
49
50 !real retab(95)
51 !data retab / &
52 ! 5.92779, 6.26422, 6.61973, 6.99539, 7.39234, &
53 ! 7.81177, 8.25496, 8.72323, 9.21800, 9.74075, 10.2930, &
54 ! 10.8765, 11.4929, 12.1440, 12.8317, 13.5581, 14.2319, &
55 ! 15.0351, 15.8799, 16.7674, 17.6986, 18.6744, 19.6955, &
56 ! 20.7623, 21.8757, 23.0364, 24.2452, 25.5034, 26.8125, &
57 ! 27.7895, 28.6450, 29.4167, 30.1088, 30.7306, 31.2943, &
58 ! 31.8151, 32.3077, 32.7870, 33.2657, 33.7540, 34.2601, &
59 ! 34.7892, 35.3442, 35.9255, 36.5316, 37.1602, 37.8078, &
60 ! 38.4720, 39.1508, 39.8442, 40.5552, 41.2912, 42.0635, &
61 ! 42.8876, 43.7863, 44.7853, 45.9170, 47.2165, 48.7221, &
62 ! 50.4710, 52.4980, 54.8315, 57.4898, 60.4785, 63.7898, &
63 ! 65.5604, 71.2885, 75.4113, 79.7368, 84.2351, 88.8833, &
64 ! 93.6658, 98.5739, 103.603, 108.752, 114.025, 119.424, &
65 ! 124.954, 130.630, 136.457, 142.446, 148.608, 154.956, &
66 ! 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, &
67 ! 205.728, 214.055, 222.694, 231.661, 240.971, 250.639/
68 real, dimension(95), parameter:: retab = (/ &
69 5.92779, 6.26422, 6.61973, 6.99539, 7.39234, &
70 7.81177, 8.25496, 8.72323, 9.21800, 9.74075, 10.2930, &
71 10.8765, 11.4929, 12.1440, 12.8317, 13.5581, 14.2319, &
72 15.0351, 15.8799, 16.7674, 17.6986, 18.6744, 19.6955, &
73 20.7623, 21.8757, 23.0364, 24.2452, 25.5034, 26.8125, &
74 27.7895, 28.6450, 29.4167, 30.1088, 30.7306, 31.2943, &
75 31.8151, 32.3077, 32.7870, 33.2657, 33.7540, 34.2601, &
76 34.7892, 35.3442, 35.9255, 36.5316, 37.1602, 37.8078, &
77 38.4720, 39.1508, 39.8442, 40.5552, 41.2912, 42.0635, &
78 42.8876, 43.7863, 44.7853, 45.9170, 47.2165, 48.7221, &
79 50.4710, 52.4980, 54.8315, 57.4898, 60.4785, 63.7898, &
80 65.5604, 71.2885, 75.4113, 79.7368, 84.2351, 88.8833, &
81 93.6658, 98.5739, 103.603, 108.752, 114.025, 119.424, &
82 124.954, 130.630, 136.457, 142.446, 148.608, 154.956, &
83 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, &
84 205.728, 214.055, 222.694, 231.661, 240.971, 250.639 /)
85
86 if (q_ice == 0) then
88 return
89 end if
90
91!+---+-----------------------------------------------------------------+
92!..From the model 3D temperature field, subtract 179K for which
93!.. index value of retab as a start. Value of corr is for
94!.. interpolating between neighboring values in the table.
95!+---+-----------------------------------------------------------------+
96
97 idx_rei = int(temp-179.)
98 idx_rei = min(max(idx_rei,1),94)
99 corr = temp - int(temp)
100 reice = retab(idx_rei)*(1.-corr) + retab(idx_rei+1)*corr
101 deice = 2.*reice * 1.e-6
102
103!+---+-----------------------------------------------------------------+
104!..Now we have the final radiative effective size of ice (as function
105!.. of temperature only). This size represents 3rd moment divided by
106!.. second moment of the ice size distribution, so we can compute a
107!.. number concentration from the mean size and mass mixing ratio.
108!.. The mean (radiative effective) diameter is 3./Slope for an inverse
109!.. exponential size distribution. So, starting with slope, work
110!.. backwords to get number concentration.
111!+---+-----------------------------------------------------------------+
112
113 lambda = 3.0 / deice
114 make_icenumber = q_ice * lambda*lambda*lambda / (pi*ice_density)
115
116!+---+-----------------------------------------------------------------+
117!..Example1: Common ice size coming from Thompson scheme is about 30 microns.
118!.. An example ice mixing ratio could be 0.001 g/kg for a temperature of -50C.
119!.. Remember to convert both into MKS units. This gives N_ice=357652 per kg.
120!..Example2: Lower in atmosphere at T=-10C matching ~162 microns in retab,
121!.. and assuming we have 0.1 g/kg mixing ratio, then N_ice=28122 per kg,
122!.. which is 28 crystals per liter of air if the air density is 1.0.
123!+---+-----------------------------------------------------------------+
124
125 return
126 end function make_icenumber
127
128!+---+-----------------------------------------------------------------+
129!+---+-----------------------------------------------------------------+
130
133 elemental real function make_dropletnumber (Q_cloud, qnwfa)
134
135 !IMPLICIT NONE
136
137 real, intent(in):: q_cloud, qnwfa
138
139 !real, parameter:: PI = 3.1415926536
140 real, parameter:: am_r = pi*1000./6.
141 real, dimension(15), parameter:: g_ratio = (/24,60,120,210,336, &
142 & 504,720,990,1320,1716,2184,2730,3360,4080,4896/)
143 double precision:: lambda, qnc
144 real:: q_nwfa, x1, xdc
145 integer:: nu_c
146
147 if (q_cloud == 0) then
149 return
150 end if
151
152!+---+
153
154 q_nwfa = max(99.e6, min(qnwfa,5.e10))
155 nu_c = max(2, min(nint(2.5e10/q_nwfa), 15))
156
157 x1 = max(1., min(q_nwfa*1.e-9, 10.)) - 1.
158 xdc = (30. - x1*20./9.) * 1.e-6
159
160 lambda = (4.0d0 + nu_c) / xdc
161 qnc = q_cloud / g_ratio(nu_c) * lambda*lambda*lambda / am_r
162 make_dropletnumber = sngl(qnc)
163
164 return
165 end function make_dropletnumber
166
167!+---+-----------------------------------------------------------------+
168!+---+-----------------------------------------------------------------+
169
172 elemental real function make_rainnumber (Q_rain, temp)
173
174 IMPLICIT NONE
175
176 real, intent(in):: q_rain, temp
177 double precision:: lambda, n0, qnr
178 !real, parameter:: PI = 3.1415926536
179 real, parameter:: am_r = pi*1000./6.
180
181 if (q_rain == 0) then
183 return
184 end if
185
186 !+---+-----------------------------------------------------------------+
187 !.. Not thrilled with it, but set Y-intercept parameter to Marshal-Palmer value
188 !.. that basically assumes melting snow becomes typical rain. However, for
189 !.. -2C < T < 0C, make linear increase in exponent to attempt to keep
190 !.. supercooled collision-coalescence (warm-rain) similar to drizzle rather
191 !.. than bigger rain drops. While this could also exist at T>0C, it is
192 !.. more difficult to assume it directly from having mass and not number.
193 !+---+-----------------------------------------------------------------+
194
195 n0 = 8.e6
196
197 if (temp .le. 271.15) then
198 n0 = 8.e8
199 elseif (temp .gt. 271.15 .and. temp.lt.273.15) then
200 n0 = 8. * 10**(279.15-temp)
201 endif
202
203 lambda = sqrt(sqrt(n0*am_r*6.0/q_rain))
204 qnr = q_rain / 6.0 * lambda*lambda*lambda / am_r
205 make_rainnumber = sngl(qnr)
206
207 return
208 end function make_rainnumber
209
210!+---+-----------------------------------------------------------------+
211!+---+-----------------------------------------------------------------+
212
elemental real function, public make_icenumber(q_ice, temp)
Table of lookup values of radiative effective radius of ice crystals as a function of Temperature fro...