PartMC  2.3.0
coag_kernel_sedi.F90
Go to the documentation of this file.
1 ! Copyright (C) 2005-2011 Nicole Riemer and Matthew West
2 ! Copyright (C) Andreas Bott
3 ! Licensed under the GNU General Public License version 2 or (at your
4 ! option) any later version. See the file COPYING for details.
5 
6 !> \file
7 !> The pmc_coag_kernel_sedi module.
8 !!
9 !! Contains code based on \c coad1d.f by Andreas Bott
10 !! - http://www.meteo.uni-bonn.de/mitarbeiter/ABott/
11 !! - Released under the GPL to Nicole Riemer (personal communication)
12 !! - A. Bott, A flux method for the numerical solution of the
13 !! stochastic collection equation, J. Atmos. Sci. 55, 2284-2293,
14 !! 1998.
15 
16 !> Gravitational sedimentation coagulation kernel.
18 
19  use pmc_env_state
20  use pmc_constants
21  use pmc_aero_data
23 
24 contains
25 
26 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
27 
28  !> Sedimentation coagulation kernel.
29  subroutine kernel_sedi(aero_particle_1, aero_particle_2, &
30  aero_data, env_state, k)
31 
32  !> First particle.
33  type(aero_particle_t), intent(in) :: aero_particle_1
34  !> Second particle.
35  type(aero_particle_t), intent(in) :: aero_particle_2
36  !> Aerosol data.
37  type(aero_data_t), intent(in) :: aero_data
38  !> Environment state.
39  type(env_state_t), intent(in) :: env_state
40  !> Kernel \c k(a,b) (m^3/s).
41  real(kind=dp), intent(out) :: k
42 
43  call kernel_sedi_helper(aero_particle_volume(aero_particle_1), &
44  aero_particle_volume(aero_particle_2), k)
45 
46  end subroutine kernel_sedi
47 
48 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
49 
50  !> Minimum and maximum values of the sedimentation coagulation.
51  subroutine kernel_sedi_minmax(v1, v2, aero_data, env_state, k_min, k_max)
52 
53  !> Volume of first particle (m^3).
54  real(kind=dp), intent(in) :: v1
55  !> Volume of second particle (m^3).
56  real(kind=dp), intent(in) :: v2
57  !> Aerosol data.
58  type(aero_data_t), intent(in) :: aero_data
59  !> Environment state.
60  type(env_state_t), intent(in) :: env_state
61  !> Minimum kernel \c k(a,b) (m^3/s).
62  real(kind=dp), intent(out) :: k_min
63  !> Maximum kernel \c k(a,b) (m^3/s).
64  real(kind=dp), intent(out) :: k_max
65 
66  call kernel_sedi_helper(v1, v2, k_min)
67  k_max = k_min
68 
69  end subroutine kernel_sedi_minmax
70 
71 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
72 
73  !> Helper function that does the actual sedimentation kernel computation.
74  !!
75  !! Helper function. Do not call directly. Instead use kernel_sedi().
76  subroutine kernel_sedi_helper(v1, v2, k)
77 
78  !> Volume of first particle (m^3).
79  real(kind=dp), intent(in) :: v1
80  !> Volume of second particle (m^3).
81  real(kind=dp), intent(in) :: v2
82  !> Kernel k(a,b) (m^3/s).
83  real(kind=dp), intent(out) :: k
84 
85  real(kind=dp) r1, r2, winf1, winf2, ec
86 
87  r1 = vol2rad(v1) ! m
88  r2 = vol2rad(v2) ! m
89  call fall_g(r1, winf1) ! winf1 in m/s
90  call fall_g(r2, winf2) ! winf2 in m/s
91  call effic(r1, r2, ec) ! ec is dimensionless
92  k = ec * const%pi * (r1 + r2)**2 * abs(winf1 - winf2)
93 
94  end subroutine kernel_sedi_helper
95 
96 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
97 
98  !> Finds the terminal velocity of a particle based on its size.
99  subroutine fall_g(r, w_inf)
100 
101  !> Particle radius (m).
102  real(kind=dp), intent(in) :: r
103  !> Terminal velocity (m/s).
104  real(kind=dp), intent(out) :: w_inf
105 
106  ! terminal velocity of falling drops
107  real(kind=dp) eta, xlamb, rhow, rhoa, grav, cunh, t0, sigma
108  real(kind=dp) stok, stb, phy, py, rr, x, y, xrey, bond
109  integer i
110  real(kind=dp) b(7),c(6)
111  data b /-0.318657d1,0.992696d0,-0.153193d-2,-0.987059d-3, &
112  -0.578878d-3,0.855176d-4,-0.327815d-5/
113  data c /-0.500015d1,0.523778d1,-0.204914d1,0.475294d0, &
114  -0.542819d-1,0.238449d-2/
115 
116  eta = 1.818d-4
117  xlamb = 6.62d-6
118  rhow = 1d0
119  rhoa = 1.225d-3
120  grav = 980.665d0
121  cunh = 1.257d0 * xlamb
122  t0 = 273.15d0
123  sigma = 76.1d0 - 0.155d0 * (293.15d0 - t0)
124  stok = 2d0 * grav * (rhow - rhoa) / (9d0 * eta)
125  stb = 32d0 * rhoa * (rhow - rhoa) * grav / (3d0 * eta * eta)
126  phy = sigma * sigma * sigma * rhoa * rhoa &
127  / (eta**4 * grav * (rhow - rhoa))
128  py = phy**(1d0/6d0)
129 
130  ! rr: radius in cm-units
131  rr = r * 1d2
132 
133  if (rr .le. 1d-3) then
134  w_inf = stok * (rr * rr + cunh * rr)
135  elseif (rr .gt. 1d-3 .and. rr .le. 5.35d-2) then
136  x = log(stb * rr * rr * rr)
137  y = 0d0
138  do i = 1,7
139  y = y + b(i) * (x**(i - 1))
140  end do
141  xrey = (1d0 + cunh/rr) * exp(y)
142  w_inf = xrey * eta / (2d0 * rhoa * rr)
143  elseif (rr .gt. 5.35d-2) then
144  bond = grav * (rhow - rhoa) * rr**2 / sigma
145  if (rr .gt. 0.35d0) then
146  bond = grav * (rhow - rhoa) * 0.35d0**2 / sigma
147  end if
148  x = log(16d0 * bond * py / 3d0)
149  y = 0d0
150  do i = 1,6
151  y = y + c(i) * (x**(i - 1))
152  end do
153  xrey = py * exp(y)
154  w_inf = xrey * eta / (2d0 * rhoa * rr)
155  if (rr .gt. 0.35d0) then
156  w_inf = xrey * eta / (2d0 * rhoa * 0.35d0)
157  end if
158  end if
159  w_inf = w_inf / 100d0
160 
161  end subroutine fall_g
162 
163 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
164 
165  !> Coagulation efficiency.
166  !!
167  !! Determines the chance that two particles will actually coagulate,
168  !! given that they approach close enough to do so.
169  subroutine effic(r1, r2, ec)
170 
171  !> Radius of first particle (m).
172  real(kind=dp), intent(in) :: r1
173  !> Radius of second particle (m).
174  real(kind=dp), intent(in) :: r2
175  !> Collision efficiency (dimensionless).
176  real(kind=dp), intent(out) :: ec
177 
178  real(kind=dp) :: r_small, r_big, rq, p, q, ek
179  integer :: k, ir, kk, iq
180  ! collision efficiencies of hall kernel
181  real(kind=dp) :: rat(21),r0(15),ecoll(15,21)
182 
183  data r0 /6.0d0,8.0d0,10.0d0,15.0d0,20.0d0,25.0d0,30.0d0,40.0d0 &
184  ,50.0d0,60.0d0,70.0d0,100.0d0,150.0d0,200.0d0,300.0d0/
185  data rat /0.0d0,0.05d0,0.1d0,0.15d0,0.2d0,0.25d0,0.3d0,0.35d0 &
186  ,0.4d0,0.45d0,0.5d0,0.55d0,0.6d0,0.65d0,0.7d0,0.75d0,0.8d0 &
187  ,0.85d0,0.9d0,0.95d0,1.0d0/
188  ! two-dimensional linear interpolation of the collision efficiency
189  data ecoll /0.001d0,0.001d0,0.001d0,0.001d0,0.001d0,0.001d0 &
190  ,0.001d0,0.001d0,0.001d0,0.001d0 ,0.001d0,0.001d0,0.001d0 &
191  ,0.001d0,0.001d0,0.003d0,0.003d0,0.003d0,0.004d0,0.005d0 &
192  ,0.005d0,0.005d0,0.010d0,0.100d0,0.050d0,0.200d0,0.500d0 &
193  ,0.770d0,0.870d0,0.970d0 ,0.007d0,0.007d0,0.007d0,0.008d0 &
194  ,0.009d0,0.010d0,0.010d0,0.070d0,0.400d0,0.430d0 ,0.580d0 &
195  ,0.790d0,0.930d0,0.960d0,1.000d0,0.009d0,0.009d0,0.009d0 &
196  ,0.012d0,0.015d0 ,0.010d0,0.020d0,0.280d0,0.600d0,0.640d0 &
197  ,0.750d0,0.910d0,0.970d0,0.980d0,1.000d0 ,0.014d0,0.014d0 &
198  ,0.014d0,0.015d0,0.016d0,0.030d0,0.060d0,0.500d0,0.700d0 &
199  ,0.770d0 ,0.840d0,0.950d0,0.970d0,1.000d0,1.000d0,0.017d0 &
200  ,0.017d0,0.017d0,0.020d0,0.022d0 ,0.060d0,0.100d0,0.620d0 &
201  ,0.780d0,0.840d0,0.880d0,0.950d0,1.000d0,1.000d0,1.000d0 &
202  ,0.030d0,0.030d0,0.024d0,0.022d0,0.032d0,0.062d0,0.200d0 &
203  ,0.680d0,0.830d0,0.870d0 ,0.900d0,0.950d0,1.000d0,1.000d0 &
204  ,1.000d0,0.025d0,0.025d0,0.025d0,0.036d0,0.043d0 ,0.130d0 &
205  ,0.270d0,0.740d0,0.860d0,0.890d0,0.920d0,1.000d0,1.000d0 &
206  ,1.000d0,1.000d0 ,0.027d0,0.027d0,0.027d0,0.040d0,0.052d0 &
207  ,0.200d0,0.400d0,0.780d0,0.880d0,0.900d0 ,0.940d0,1.000d0 &
208  ,1.000d0,1.000d0,1.000d0,0.030d0,0.030d0,0.030d0,0.047d0 &
209  ,0.064d0 ,0.250d0,0.500d0,0.800d0,0.900d0,0.910d0,0.950d0 &
210  ,1.000d0,1.000d0,1.000d0,1.000d0 ,0.040d0,0.040d0,0.033d0 &
211  ,0.037d0,0.068d0,0.240d0,0.550d0,0.800d0,0.900d0,0.910d0 &
212  ,0.950d0,1.000d0,1.000d0,1.000d0,1.000d0,0.035d0,0.035d0 &
213  ,0.035d0,0.055d0,0.079d0 ,0.290d0,0.580d0,0.800d0,0.900d0 &
214  ,0.910d0,0.950d0,1.000d0,1.000d0,1.000d0,1.000d0 ,0.037d0 &
215  ,0.037d0,0.037d0,0.062d0,0.082d0,0.290d0,0.590d0,0.780d0 &
216  ,0.900d0,0.910d0 ,0.950d0,1.000d0,1.000d0,1.000d0,1.000d0 &
217  ,0.037d0,0.037d0,0.037d0,0.060d0,0.080d0 ,0.290d0,0.580d0 &
218  ,0.770d0,0.890d0,0.910d0,0.950d0,1.000d0,1.000d0,1.000d0 &
219  ,1.000d0 ,0.037d0,0.037d0,0.037d0,0.041d0,0.075d0,0.250d0 &
220  ,0.540d0,0.760d0,0.880d0,0.920d0 ,0.950d0,1.000d0,1.000d0 &
221  ,1.000d0,1.000d0,0.037d0,0.037d0,0.037d0,0.052d0,0.067d0 &
222  ,0.250d0,0.510d0,0.770d0,0.880d0,0.930d0,0.970d0,1.000d0 &
223  ,1.000d0,1.000d0,1.000d0 ,0.037d0,0.037d0,0.037d0,0.047d0 &
224  ,0.057d0,0.250d0,0.490d0,0.770d0,0.890d0,0.950d0 ,1.000d0 &
225  ,1.000d0,1.000d0,1.000d0,1.000d0,0.036d0,0.036d0,0.036d0 &
226  ,0.042d0,0.048d0 ,0.230d0,0.470d0,0.780d0,0.920d0,1.000d0 &
227  ,1.020d0,1.020d0,1.020d0,1.020d0,1.020d0 ,0.040d0,0.040d0 &
228  ,0.035d0,0.033d0,0.040d0,0.112d0,0.450d0,0.790d0,1.010d0 &
229  ,1.030d0 ,1.040d0,1.040d0,1.040d0,1.040d0,1.040d0,0.033d0 &
230  ,0.033d0,0.033d0,0.033d0,0.033d0 ,0.119d0,0.470d0,0.950d0 &
231  ,1.300d0,1.700d0,2.300d0,2.300d0,2.300d0,2.300d0,2.300d0 &
232  ,0.027d0,0.027d0,0.027d0,0.027d0,0.027d0,0.125d0,0.520d0 &
233  ,1.400d0,2.300d0,3.000d0 ,4.000d0,4.000d0,4.000d0,4.000d0 &
234  ,4.000d0/
235 
236  r_small = min(r1 * 1d6, r2 * 1d6) ! um
237  r_big = max(r1 * 1d6, r2 * 1d6) ! um
238  rq = r_small / r_big
239 
240  ir = 1
241  do k = 1, 15
242  if (r_big .gt. r0(k)) then
243  ir = k + 1
244  end if
245  end do
246 
247  iq = 1
248  do kk = 1,21
249  if (rq .gt. rat(kk)) then
250  iq = kk + 1
251  end if
252  end do
253 
254  if (ir .lt. 16) then
255  if (ir .ge. 2) then
256  p = (r_big - r0(ir - 1)) / (r0(ir) - r0(ir - 1))
257  q = (rq - rat(iq - 1)) / (rat(iq) - rat(iq - 1))
258  ec = (1d0 - p) * (1d0 - q) * ecoll(ir - 1, iq - 1) &
259  + p * (1d0 - q) * ecoll(ir, iq - 1) &
260  + q * (1d0 - p) * ecoll(ir - 1, iq) &
261  + p * q * ecoll(ir, iq)
262  else
263  q = (rq - rat(iq - 1)) / (rat(iq) - rat(iq - 1))
264  ec = (1d0 - q) * ecoll(1, iq - 1) + q * ecoll(1, iq)
265  end if
266  else
267  q = (rq - rat(iq - 1)) / (rat(iq) - rat(iq - 1))
268  ek = (1d0 - q) * ecoll(15, iq - 1) + q * ecoll(15, iq)
269  ec = min(ek, 1d0)
270  end if
271 
272  if (ec .lt. 1d-20) stop 99
273 
274  end subroutine effic
275 
276 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
277 
278 end module pmc_coag_kernel_sedi
The aero_data_t structure and associated subroutines.
Definition: aero_data.F90:9
Physical constants.
Definition: constants.F90:9
The aero_particle_t structure and associated subroutines.
The env_state_t structure and associated subroutines.
Definition: env_state.F90:9
subroutine kernel_sedi_helper(v1, v2, k)
Helper function that does the actual sedimentation kernel computation.
Current environment state.
Definition: env_state.F90:26
subroutine effic(r1, r2, ec)
Coagulation efficiency.
Gravitational sedimentation coagulation kernel.
Single aerosol particle data structure.
subroutine fall_g(r, w_inf)
Finds the terminal velocity of a particle based on its size.
subroutine kernel_sedi(aero_particle_1, aero_particle_2, aero_data, env_state, k)
Sedimentation coagulation kernel.
real(kind=dp) elemental function vol2rad(v)
Convert volume (m^3) to radius (m).
Definition: util.F90:238
elemental real(kind=dp) function aero_particle_volume(aero_particle)
Total volume of the particle (m^3).
subroutine kernel_sedi_minmax(v1, v2, aero_data, env_state, k_min, k_max)
Minimum and maximum values of the sedimentation coagulation.
Aerosol material properties and associated data.
Definition: aero_data.F90:40