PartMC  2.3.0
coag_kernel_additive.F90
Go to the documentation of this file.
1 ! Copyright (C) 2005-2012 Nicole Riemer and Matthew West
2 ! Licensed under the GNU General Public License version 2 or (at your
3 ! option) any later version. See the file COPYING for details.
4 
5 !> \file
6 !> The pmc_coag_kernel_additive module.
7 
8 !> Additive coagulation kernel.
10 
11  use pmc_bin_grid
12  use pmc_env_state
13  use pmc_util
14  use pmc_constants
15  use pmc_constants
16  use pmc_aero_binned
17  use pmc_aero_data
18  use pmc_aero_dist
19  use pmc_aero_data
21 
22  !> Scaling coefficient for constant kernel.
23  real(kind=dp), parameter :: beta_1 = 1000d0
24 
25 contains
26 
27 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28 
29  !> Additive coagulation kernel.
30  subroutine kernel_additive(aero_particle_1, aero_particle_2, &
31  aero_data, env_state, k)
32 
33  !> First particle.
34  type(aero_particle_t), intent(in) :: aero_particle_1
35  !> Second particle.
36  type(aero_particle_t), intent(in) :: aero_particle_2
37  !> Aerosol data.
38  type(aero_data_t), intent(in) :: aero_data
39  !> Environment state.
40  type(env_state_t), intent(in) :: env_state
41  !> Coagulation kernel.
42  real(kind=dp), intent(out) :: k
43 
44  k = beta_1 * (aero_particle_volume(aero_particle_1) &
45  + aero_particle_volume(aero_particle_2))
46 
47  end subroutine kernel_additive
48 
49 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
50 
51  !> Minimum and maximum values of the additive kernel.
52  subroutine kernel_additive_minmax(v1, v2, aero_data, env_state, k_min, k_max)
53 
54  !> Volume of first particle.
55  real(kind=dp), intent(in) :: v1
56  !> Volume of second particle.
57  real(kind=dp), intent(in) :: v2
58  !> Aerosol data.
59  type(aero_data_t), intent(in) :: aero_data
60  !> Environment state.
61  type(env_state_t), intent(in) :: env_state
62  !> Coagulation kernel minimum value.
63  real(kind=dp), intent(out) :: k_min
64  !> Coagulation kernel maximum value.
65  real(kind=dp), intent(out) :: k_max
66 
67  k_min = beta_1 * (v1 + v2)
68  k_max = k_min
69 
70  end subroutine kernel_additive_minmax
71 
72 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
73 
74  !> Exact solution with the additive coagulation kernel and
75  !> exponential initial condition.
76  !!
77  !! Given input paramaters \f$R\f$ and \f$N_0\f$ we let the mean
78  !! volume be \f$v_\mu = \frac{4\pi}{3} R^3\f$ and define the
79  !! rescaled times \f$\tau = N_0 v_\mu \beta_1 t\f$ and \f$T = 1 -
80  !! e^{-\tau}\f$, where \f$\beta_1\f$ is the fixed kernel scaling
81  !! parameter. Then the solution is
82  !! \f[
83  !! n(D,t) \ {\rm d}\ln D
84  !! = \frac{\pi}{2} D^3
85  !! \frac{N_0}{v} \frac{1 - T}{\sqrt{T}}
86  !! \exp\left(-(1 + T) \frac{v}{v_\mu}\right)
87  !! I_1\left(2 \frac{v}{v_\mu} \sqrt{T}\right) {\rm d}\ln D
88  !! \f]
89  !! where \f$I_1(x)\f$ is the <a
90  !! href="http://en.wikipedia.org/wiki/Bessel_function">modified
91  !! Bessel function of the first kind</a> and \f$v = \frac{\pi}{6}
92  !! D^3\f$.
93  !!
94  !! For small \f$x\f$ we have \f$I_1(x) \approx \frac{x}{2}\f$, so
95  !! this solution has initial condition
96  !! \f[
97  !! n(D,t) \ {\rm d}\ln D
98  !! = \frac{\pi}{2} D^3 \frac{N_0}{v_\mu}
99  !! \exp\left(-\frac{v}{v_\mu}\right) {\rm d}\ln D
100  !! \f]
101  subroutine soln_additive_exp(bin_grid, aero_data, time, num_conc, &
102  radius_at_mean_vol, env_state, aero_binned)
103 
104  !> Bin grid.
105  type(bin_grid_t), intent(in) :: bin_grid
106  !> Aerosol data.
107  type(aero_data_t), intent(in) :: aero_data
108  !> Current time.
109  real(kind=dp), intent(in) :: time
110  !> Particle number concentration (#/m^3).
111  real(kind=dp), intent(in) :: num_conc
112  !> Mean init radius (m).
113  real(kind=dp), intent(in) :: radius_at_mean_vol
114  !> Environment state.
115  type(env_state_t), intent(in) :: env_state
116  !> Output state.
117  type(aero_binned_t), intent(inout) :: aero_binned
118 
119  real(kind=dp) :: tau, t, rat_v, nn, b, x, mean_vol
120  integer :: k
121 
122  mean_vol = rad2vol(radius_at_mean_vol)
123  if (time .eq. 0d0) then
124  do k = 1,bin_grid%n_bin
125  aero_binned%num_conc(k) = const%pi/2d0 &
126  * (2d0 * bin_grid%centers(k))**3 * num_conc / mean_vol &
127  * exp(-(rad2vol(bin_grid%centers(k)) / mean_vol))
128  end do
129  else
130  tau = num_conc * mean_vol * beta_1 * time
131  t = 1d0 - exp(-tau)
132  do k = 1,bin_grid%n_bin
133  rat_v = rad2vol(bin_grid%centers(k)) / mean_vol
134  x = 2d0 * rat_v * sqrt(t)
135  if (x .lt. 500d0) then
136  call bessi1(x, b)
137  nn = num_conc / rad2vol(bin_grid%centers(k)) &
138  * (1d0 - t) / sqrt(t) * exp(-((1d0 + t) * rat_v)) * b
139  else
140  ! For very large volumes we can use the asymptotic
141  ! approximation I_1(x) \approx e^x / sqrt(2 pi x) and
142  ! simplify the result to avoid the overflow from
143  ! multiplying a huge bessel function result by a very
144  ! tiny exponential.
145  nn = num_conc / rad2vol(bin_grid%centers(k)) &
146  * (1d0 - t) / sqrt(t) &
147  * exp((2d0*sqrt(t) - t - 1d0) * rat_v) &
148  / sqrt(4d0 * const%pi * rat_v * sqrt(t))
149  end if
150  aero_binned%num_conc(k) = const%pi/2d0 &
151  * (2d0 * bin_grid%centers(k))**3 * nn
152  end do
153  end if
154 
155  aero_binned%vol_conc = 0d0
156  do k = 1,bin_grid%n_bin
157  aero_binned%vol_conc(k,1) = rad2vol(bin_grid%centers(k)) &
158  * aero_binned%num_conc(k)
159  end do
160 
161  end subroutine soln_additive_exp
162 
163 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
164 
165  !> Modified Bessel function of the first kind \f$ I_1(x) \f$.
166  subroutine bessi1(x, r)
167 
168  !> Function argument.
169  real(kind=dp), intent(in) :: x
170  !> Function value.
171  real(kind=dp), intent(out) :: r
172 
173  call calci1(x, r, 1 )
174 
175  end subroutine bessi1
176 
177 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
178 
179  !> Calculates modified Bessel functions of the first kind \f$ I_1(x) \f$.
180  subroutine calci1 ( arg, result, jint )
181 
182  !*************************************************************************
183  !
184  !! CALCI1 computes various I1 Bessel functions.
185  !
186  ! Discussion:
187  !
188  ! This routine computes modified Bessel functioons of the first kind
189  ! and order one, I1(X) and EXP(-ABS(X))*I1(X), for real
190  ! arguments X.
191  !
192  ! The main computation evaluates slightly modified forms of
193  ! minimax approximations generated by Blair and Edwards, Chalk
194  ! River (Atomic Energy of Canada Limited) Report AECL-4928,
195  ! October, 1974.
196  !
197  ! Licensing:
198  !
199  ! This code is distributed under the GNU LGPL license.
200  !
201  ! Modified:
202  !
203  ! 03 April 2007
204  !
205  ! Author:
206  !
207  ! Original FORTRAN77 version by William Cody, Laura Stoltz.
208  ! FORTRAN90 version by John Burkardt.
209  !
210  ! Parameters:
211  !
212  ! Input, real ( kind = 8 ) ARG, the argument. If JINT = 1, then
213  ! the argument must be less than XMAX.
214  !
215  ! Output, real ( kind = 8 ) RESULT, the value of the function,
216  ! which depends on the input value of JINT:
217  ! 1, RESULT = I1(x);
218  ! 2, RESULT = exp(-x) * I1(x);
219  !
220  ! Input, integer ( kind = 4 ) JINT, chooses the function to be computed.
221  ! 1, I1(x);
222  ! 2, exp(-x) * I1(x);
223  !
224 
225  real ( kind = 8 ) a
226  real ( kind = 8 ) arg
227  real ( kind = 8 ) b
228  real ( kind = 8 ) exp40
229  real ( kind = 8 ) forty
230  integer ( kind = 4 ) j
231  integer ( kind = 4 ) jint
232  real ( kind = 8 ) one5
233  real ( kind = 8 ) p(15)
234  real ( kind = 8 ) pbar
235  real ( kind = 8 ) pp(8)
236  real ( kind = 8 ) q(5)
237  real ( kind = 8 ) qq(6)
238  real ( kind = 8 ) rec15
239  real ( kind = 8 ) result
240  real ( kind = 8 ) sump
241  real ( kind = 8 ) sumq
242  real ( kind = 8 ) two25
243  real ( kind = 8 ) x
244  real ( kind = 8 ) xinf
245  real ( kind = 8 ) xmax
246  real ( kind = 8 ) xsmall
247  real ( kind = 8 ) xx
248  !
249  ! Mathematical constants
250  !
251  data one5 / 15.0d0 /
252  data exp40 / 2.353852668370199854d17 /
253  data forty / 40.0d0 /
254  data rec15 / 6.6666666666666666666d-2 /
255  data two25 / 225.0d0 /
256  !
257  ! Machine-dependent constants
258  !
259  data xsmall /5.55d-17/
260  data xinf /1.79d308/
261  data xmax /713.987d0/
262  !
263  ! Coefficients for XSMALL <= ABS(ARG) < 15.0
264  !
265  data p/-1.9705291802535139930d-19,-6.5245515583151902910d-16, &
266  -1.1928788903603238754d-12,-1.4831904935994647675d-09, &
267  -1.3466829827635152875d-06,-9.1746443287817501309d-04, &
268  -4.7207090827310162436d-01,-1.8225946631657315931d+02, &
269  -5.1894091982308017540d+04,-1.0588550724769347106d+07, &
270  -1.4828267606612366099d+09,-1.3357437682275493024d+11, &
271  -6.9876779648010090070d+12,-1.7732037840791591320d+14, &
272  -1.4577180278143463643d+15/
273  data q/-4.0076864679904189921d+03, 7.4810580356655069138d+06, &
274  -8.0059518998619764991d+09, 4.8544714258273622913d+12, &
275  -1.3218168307321442305d+15/
276  !
277  ! Coefficients for 15.0 <= ABS(ARG)
278  !
279  data pp/-6.0437159056137600000d-02, 4.5748122901933459000d-01, &
280  -4.2843766903304806403d-01, 9.7356000150886612134d-02, &
281  -3.2457723974465568321d-03,-3.6395264712121795296d-04, &
282  1.6258661867440836395d-05,-3.6347578404608223492d-07/
283  data qq/-3.8806586721556593450d+00, 3.2593714889036996297d+00, &
284  -8.5017476463217924408d-01, 7.4212010813186530069d-02, &
285  -2.2835624489492512649d-03, 3.7510433111922824643d-05/
286  data pbar/3.98437500d-01/
287 
288  x = abs( arg )
289  !
290  ! Return for ABS(ARG) < XSMALL.
291  !
292  if ( x < xsmall ) then
293 
294  result = 0.5d+00 * x
295  !
296  ! XSMALL <= ABS(ARG) < 15.0.
297  !
298  else if ( x < one5 ) then
299 
300  xx = x * x
301  sump = p(1)
302  do j = 2, 15
303  sump = sump * xx + p(j)
304  end do
305  xx = xx - two25
306 
307  sumq = (((( &
308  xx + q(1) ) &
309  * xx + q(2) ) &
310  * xx + q(3) ) &
311  * xx + q(4) ) &
312  * xx + q(5)
313 
314  result = ( sump / sumq ) * x
315 
316  if ( jint == 2 ) then
317  result = result * exp( -x )
318  end if
319 
320  else if ( jint == 1 .and. xmax < x ) then
321 
322  result = xinf
323 
324  else
325  !
326  ! 15.0 <= ABS(ARG).
327  !
328  xx = 1.0d+00 / x - rec15
329 
330  sump = (((((( &
331  pp(1) &
332  * xx + pp(2) ) &
333  * xx + pp(3) ) &
334  * xx + pp(4) ) &
335  * xx + pp(5) ) &
336  * xx + pp(6) ) &
337  * xx + pp(7) ) &
338  * xx + pp(8)
339 
340  sumq = ((((( &
341  xx + qq(1) ) &
342  * xx + qq(2) ) &
343  * xx + qq(3) ) &
344  * xx + qq(4) ) &
345  * xx + qq(5) ) &
346  * xx + qq(6)
347 
348  result = sump / sumq
349 
350  if ( jint /= 1 ) then
351  result = ( result + pbar ) / sqrt( x )
352  else
353  !
354  ! Calculation reformulated to avoid premature overflow.
355  !
356  if ( xmax - one5 < x ) then
357  a = exp( x - forty )
358  b = exp40
359  else
360  a = exp( x )
361  b = 1.0d+00
362  end if
363 
364  result = ( ( result * a + pbar * a ) / sqrt( x ) ) * b
365 
366  end if
367  end if
368 
369  if ( arg < 0.0d+00 ) then
370  result = -result
371  end if
372 
373  return
374 
375  end subroutine calci1
376 
377 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
378 
379 end module pmc_coag_kernel_additive
The aero_data_t structure and associated subroutines.
Definition: aero_data.F90:9
Additive coagulation kernel.
subroutine kernel_additive_minmax(v1, v2, aero_data, env_state, k_min, k_max)
Minimum and maximum values of the additive kernel.
real(kind=dp) elemental function rad2vol(r)
Convert radius (m) to volume (m^3).
Definition: util.F90:274
The aero_dist_t structure and associated subroutines.
Definition: aero_dist.F90:18
subroutine kernel_additive(aero_particle_1, aero_particle_2, aero_data, env_state, k)
Additive coagulation kernel.
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 bessi1(x, r)
Modified Bessel function of the first kind .
Common utility subroutines.
Definition: util.F90:9
Current environment state.
Definition: env_state.F90:26
subroutine calci1(arg, result, jint)
Calculates modified Bessel functions of the first kind .
Single aerosol particle data structure.
1D grid, either logarithmic or linear.
Definition: bin_grid.F90:33
subroutine soln_additive_exp(bin_grid, aero_data, time, num_conc, radius_at_mean_vol, env_state, aero_binned)
Exact solution with the additive coagulation kernel and exponential initial condition.
The bin_grid_t structure and associated subroutines.
Definition: bin_grid.F90:9
The aero_binned_t structure and associated subroutines.
Definition: aero_binned.F90:9
elemental real(kind=dp) function aero_particle_volume(aero_particle)
Total volume of the particle (m^3).
Aerosol material properties and associated data.
Definition: aero_data.F90:40
Aerosol number and volume distributions stored per bin.
Definition: aero_binned.F90:33