PartMC 2.1.3
coag_kernel_sedi.F90
Go to the documentation of this file.
00001 ! Copyright (C) 2005-2010 Nicole Riemer and Matthew West
00002 ! Copyright (C) Andreas Bott
00003 ! Licensed under the GNU General Public License version 2 or (at your
00004 ! option) any later version. See the file COPYING for details.
00005 
00006 !> \file
00007 !> The pmc_coag_kernel_sedi module.
00008 !!
00009 !! Contains code based on \c coad1d.f by Andreas Bott
00010 !!     - http://www.meteo.uni-bonn.de/mitarbeiter/ABott/
00011 !!     - Released under the GPL to Nicole Riemer (personal communication)
00012 !!     - A. Bott, A flux method for the numerical solution of the
00013 !!       stochastic collection equation, J. Atmos. Sci. 55, 2284-2293,
00014 !!       1998.
00015 
00016 !> Gravitational sedimentation coagulation kernel.
00017 module pmc_coag_kernel_sedi
00018 
00019   use pmc_env_state
00020   use pmc_constants
00021   use pmc_aero_data
00022   use pmc_aero_particle
00023   
00024 contains
00025   
00026 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00027 
00028   !> Sedimentation coagulation kernel.
00029   subroutine kernel_sedi(aero_particle_1, aero_particle_2, &
00030        aero_data, env_state, k)
00031 
00032     !> First particle.
00033     type(aero_particle_t), intent(in) :: aero_particle_1
00034     !> Second particle.
00035     type(aero_particle_t), intent(in) :: aero_particle_2
00036     !> Aerosol data.
00037     type(aero_data_t), intent(in) :: aero_data
00038     !> Environment state.
00039     type(env_state_t), intent(in) :: env_state
00040     !> Kernel \c k(a,b) (m^3/s).
00041     real(kind=dp), intent(out) :: k
00042 
00043     call kernel_sedi_max(aero_particle_volume(aero_particle_1), &
00044          aero_particle_volume(aero_particle_2), aero_data, env_state, k)
00045 
00046   end subroutine kernel_sedi
00047   
00048 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00049 
00050   !> Sedimentation coagulation kernel.
00051   subroutine kernel_sedi_max(v1, v2, aero_data, env_state, k_max)
00052 
00053     !> Volume of first particle (m^3).
00054     real(kind=dp), intent(in) :: v1
00055     !> Volume of second particle (m^3).
00056     real(kind=dp), intent(in) :: v2
00057     !> Aerosol data.
00058     type(aero_data_t), intent(in) :: aero_data
00059     !> Environment state.
00060     type(env_state_t), intent(in) :: env_state
00061     !> Maximum kernel \c k(a,b) (m^3/s).
00062     real(kind=dp), intent(out) :: k_max
00063     
00064     real(kind=dp) constant, onethird
00065     real(kind=dp) r1, r2, winf1, winf2, ec
00066     
00067     constant = 3d0 / (4d0 * const%pi)
00068     onethird  = 1d0/3d0
00069     r1 = (constant*v1)**onethird ! m
00070     r2 = (constant*v2)**onethird ! m
00071     call fall_g(r1, winf1) ! winf1 in m/s
00072     call fall_g(r2, winf2) ! winf2 in m/s
00073     call effic(r1 * 1d6, r2 * 1d6, ec) ! ec is dimensionless
00074     k_max = ec * const%pi * (r1 + r2)**2 * abs(winf1 - winf2) 
00075 
00076   end subroutine kernel_sedi_max
00077   
00078 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00079 
00080   !> Finds the terminal velocity of a particle based on its size.
00081   subroutine fall_g(r, w_inf)
00082     
00083     !> Particle radius (m).
00084     real(kind=dp), intent(in) :: r
00085     !> Terminal velocity (m/s).
00086     real(kind=dp), intent(out) :: w_inf
00087     
00088     ! terminal velocity of falling drops
00089     real(kind=dp) eta, xlamb, rhow, rhoa, grav, cunh, t0, sigma
00090     real(kind=dp) stok, stb, phy, py, rr, x, y, xrey, bond
00091     integer i
00092     real(kind=dp) b(7),c(6)
00093     data b /-0.318657d1,0.992696d0,-0.153193d-2,-0.987059d-3, &
00094          -0.578878d-3,0.855176d-4,-0.327815d-5/
00095     data c /-0.500015d1,0.523778d1,-0.204914d1,0.475294d0, &
00096          -0.542819d-1,0.238449d-2/
00097     
00098     eta = 1.818d-4
00099     xlamb = 6.62d-6
00100     rhow = 1d0
00101     rhoa = 1.225d-3
00102     grav = 980.665d0
00103     cunh = 1.257d0 * xlamb
00104     t0 = 273.15d0
00105     sigma = 76.1d0 - 0.155d0 * (293.15d0 - t0)
00106     stok = 2d0 * grav * (rhow - rhoa) / (9d0 * eta)
00107     stb = 32d0 * rhoa * (rhow - rhoa) * grav / (3d0 * eta * eta)
00108     phy = sigma * sigma * sigma * rhoa * rhoa  &
00109          / (eta**4 * grav * (rhow - rhoa))
00110     py = phy**(1d0/6d0)
00111     
00112     ! rr: radius in cm-units
00113     rr = r * 1d2
00114     
00115     if (rr .le. 1d-3) then
00116        w_inf = stok * (rr * rr + cunh * rr)
00117     elseif (rr .gt. 1d-3 .and. rr .le. 5.35d-2) then
00118        x = log(stb * rr * rr * rr)
00119        y = 0d0
00120        do i = 1,7
00121           y = y + b(i) * (x**(i - 1))
00122        end do
00123        xrey = (1d0 + cunh/rr) * exp(y)
00124        w_inf = xrey * eta / (2d0 * rhoa * rr)
00125     elseif (rr .gt. 5.35d-2) then
00126        bond = grav * (rhow - rhoa) * rr**2 / sigma
00127        if (rr .gt. 0.35d0) then
00128           bond = grav * (rhow - rhoa) * 0.35d0**2 / sigma
00129        end if
00130        x = log(16d0 * bond * py / 3d0)
00131        y = 0d0
00132        do i = 1,6
00133           y = y + c(i) * (x**(i - 1))
00134        end do
00135        xrey = py * exp(y)
00136        w_inf = xrey * eta / (2d0 * rhoa * rr)
00137        if (rr .gt. 0.35d0) then
00138           w_inf = xrey * eta / (2d0 * rhoa * 0.35d0)
00139        end if
00140     end if
00141     w_inf = w_inf / 100d0
00142     
00143   end subroutine fall_g
00144   
00145 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00146 
00147   !> Coagulation efficiency.
00148   !!
00149   !! Determines the chance that two particles will actually coagulate,
00150   !! given that they approach close enough to do so.
00151   subroutine effic(r1, r2, ec)
00152 
00153     !> Radius of first particle (um).
00154     real(kind=dp), intent(in) :: r1
00155     !> Radius of second particle (um).
00156     real(kind=dp), intent(in) :: r2
00157     !> Collision efficiency (dimensionless).
00158     real(kind=dp), intent(out) :: ec
00159     
00160     real(kind=dp) r_small, r_big, rq, p, q, ek
00161     integer k, ir, kk, iq
00162     ! collision efficiencies of hall kernel
00163     real(kind=dp) rat(21),r0(15),ecoll(15,21)
00164     data r0 /6.0d0,8.0d0,10.0d0,15.0d0,20.0d0,25.0d0,30.0d0,40.0d0 &
00165          ,50.0d0,60.0d0,70.0d0,100.0d0,150.0d0,200.0d0,300.0d0/
00166     data rat /0.0d0,0.05d0,0.1d0,0.15d0,0.2d0,0.25d0,0.3d0,0.35d0 &
00167          ,0.4d0,0.45d0,0.5d0,0.55d0,0.6d0,0.65d0,0.7d0,0.75d0,0.8d0 &
00168          ,0.85d0,0.9d0,0.95d0,1.0d0/
00169     ! two-dimensional linear interpolation of the collision efficiency
00170     data ecoll /0.001d0,0.001d0,0.001d0,0.001d0,0.001d0,0.001d0 &
00171          ,0.001d0,0.001d0,0.001d0,0.001d0 ,0.001d0,0.001d0,0.001d0 &
00172          ,0.001d0,0.001d0,0.003d0,0.003d0,0.003d0,0.004d0,0.005d0 &
00173          ,0.005d0,0.005d0,0.010d0,0.100d0,0.050d0,0.200d0,0.500d0 &
00174          ,0.770d0,0.870d0,0.970d0 ,0.007d0,0.007d0,0.007d0,0.008d0 &
00175          ,0.009d0,0.010d0,0.010d0,0.070d0,0.400d0,0.430d0 ,0.580d0 &
00176          ,0.790d0,0.930d0,0.960d0,1.000d0,0.009d0,0.009d0,0.009d0 &
00177          ,0.012d0,0.015d0 ,0.010d0,0.020d0,0.280d0,0.600d0,0.640d0 &
00178          ,0.750d0,0.910d0,0.970d0,0.980d0,1.000d0 ,0.014d0,0.014d0 &
00179          ,0.014d0,0.015d0,0.016d0,0.030d0,0.060d0,0.500d0,0.700d0 &
00180          ,0.770d0 ,0.840d0,0.950d0,0.970d0,1.000d0,1.000d0,0.017d0 &
00181          ,0.017d0,0.017d0,0.020d0,0.022d0 ,0.060d0,0.100d0,0.620d0 &
00182          ,0.780d0,0.840d0,0.880d0,0.950d0,1.000d0,1.000d0,1.000d0 &
00183          ,0.030d0,0.030d0,0.024d0,0.022d0,0.032d0,0.062d0,0.200d0 &
00184          ,0.680d0,0.830d0,0.870d0 ,0.900d0,0.950d0,1.000d0,1.000d0 &
00185          ,1.000d0,0.025d0,0.025d0,0.025d0,0.036d0,0.043d0 ,0.130d0 &
00186          ,0.270d0,0.740d0,0.860d0,0.890d0,0.920d0,1.000d0,1.000d0 &
00187          ,1.000d0,1.000d0 ,0.027d0,0.027d0,0.027d0,0.040d0,0.052d0 &
00188          ,0.200d0,0.400d0,0.780d0,0.880d0,0.900d0 ,0.940d0,1.000d0 &
00189          ,1.000d0,1.000d0,1.000d0,0.030d0,0.030d0,0.030d0,0.047d0 &
00190          ,0.064d0 ,0.250d0,0.500d0,0.800d0,0.900d0,0.910d0,0.950d0 &
00191          ,1.000d0,1.000d0,1.000d0,1.000d0 ,0.040d0,0.040d0,0.033d0 &
00192          ,0.037d0,0.068d0,0.240d0,0.550d0,0.800d0,0.900d0,0.910d0 &
00193          ,0.950d0,1.000d0,1.000d0,1.000d0,1.000d0,0.035d0,0.035d0 &
00194          ,0.035d0,0.055d0,0.079d0 ,0.290d0,0.580d0,0.800d0,0.900d0 &
00195          ,0.910d0,0.950d0,1.000d0,1.000d0,1.000d0,1.000d0 ,0.037d0 &
00196          ,0.037d0,0.037d0,0.062d0,0.082d0,0.290d0,0.590d0,0.780d0 &
00197          ,0.900d0,0.910d0 ,0.950d0,1.000d0,1.000d0,1.000d0,1.000d0 &
00198          ,0.037d0,0.037d0,0.037d0,0.060d0,0.080d0 ,0.290d0,0.580d0 &
00199          ,0.770d0,0.890d0,0.910d0,0.950d0,1.000d0,1.000d0,1.000d0 &
00200          ,1.000d0 ,0.037d0,0.037d0,0.037d0,0.041d0,0.075d0,0.250d0 &
00201          ,0.540d0,0.760d0,0.880d0,0.920d0 ,0.950d0,1.000d0,1.000d0 &
00202          ,1.000d0,1.000d0,0.037d0,0.037d0,0.037d0,0.052d0,0.067d0 &
00203          ,0.250d0,0.510d0,0.770d0,0.880d0,0.930d0,0.970d0,1.000d0 &
00204          ,1.000d0,1.000d0,1.000d0 ,0.037d0,0.037d0,0.037d0,0.047d0 &
00205          ,0.057d0,0.250d0,0.490d0,0.770d0,0.890d0,0.950d0 ,1.000d0 &
00206          ,1.000d0,1.000d0,1.000d0,1.000d0,0.036d0,0.036d0,0.036d0 &
00207          ,0.042d0,0.048d0 ,0.230d0,0.470d0,0.780d0,0.920d0,1.000d0 &
00208          ,1.020d0,1.020d0,1.020d0,1.020d0,1.020d0 ,0.040d0,0.040d0 &
00209          ,0.035d0,0.033d0,0.040d0,0.112d0,0.450d0,0.790d0,1.010d0 &
00210          ,1.030d0 ,1.040d0,1.040d0,1.040d0,1.040d0,1.040d0,0.033d0 &
00211          ,0.033d0,0.033d0,0.033d0,0.033d0 ,0.119d0,0.470d0,0.950d0 &
00212          ,1.300d0,1.700d0,2.300d0,2.300d0,2.300d0,2.300d0,2.300d0 &
00213          ,0.027d0,0.027d0,0.027d0,0.027d0,0.027d0,0.125d0,0.520d0 &
00214          ,1.400d0,2.300d0,3.000d0 ,4.000d0,4.000d0,4.000d0,4.000d0 &
00215          ,4.000d0/
00216     
00217     r_small = min(r1, r2)
00218     r_big = max(r1, r2)
00219     rq = r_small / r_big
00220     
00221     ir = 1
00222     do k = 1, 15
00223        if (r_big .gt. r0(k)) then
00224           ir = k + 1
00225        end if
00226     end do
00227     
00228     iq = 1
00229     do kk = 1,21
00230        if (rq .gt. rat(kk)) then
00231           iq = kk + 1
00232        end if
00233     end do
00234     
00235     if (ir .lt. 16) then
00236        if (ir .ge. 2) then
00237           p = (r_big - r0(ir - 1)) / (r0(ir) - r0(ir - 1))
00238           q = (rq - rat(iq - 1)) / (rat(iq) - rat(iq - 1))
00239           ec = (1d0 - p) * (1d0 - q) * ecoll(ir - 1, iq - 1) &
00240                + p * (1d0 - q) * ecoll(ir, iq - 1) &
00241                + q * (1d0 - p) * ecoll(ir - 1, iq) &
00242                + p * q * ecoll(ir, iq)
00243        else
00244           q = (rq - rat(iq - 1)) / (rat(iq) - rat(iq - 1))
00245           ec = (1d0 - q) * ecoll(1, iq - 1) + q * ecoll(1, iq)
00246        end if
00247     else
00248        q = (rq - rat(iq - 1)) / (rat(iq) - rat(iq - 1))
00249        ek = (1d0 - q) * ecoll(15, iq - 1) + q * ecoll(15, iq)
00250        ec = min(ek, 1d0)
00251     end if
00252     
00253     if (ec .lt. 1d-20) stop 99
00254     
00255   end subroutine effic
00256   
00257 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00258 
00259 end module pmc_coag_kernel_sedi