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