PartMC 2.1.2
|
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