1 2! KGEN-generated Fortran source file 3! 4! Filename : micro_mg_utils.F90 5! Generated at: 2015-03-31 09:44:40 6! KGEN version: 0.4.5 7 8 9 10 MODULE micro_mg_utils 11 !-------------------------------------------------------------------------- 12 ! 13 ! This module contains process rates and utility functions used by the MG 14 ! microphysics. 15 ! 16 ! Original MG authors: Andrew Gettelman, Hugh Morrison 17 ! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan 18 ! 19 ! Separated from MG 1.5 by B. Eaton. 20 ! Separated module switched to MG 2.0 and further changes by S. Santos. 21 ! 22 ! for questions contact Hugh Morrison, Andrew Gettelman 23 ! e-mail: morrison@ucar.edu, andrew@ucar.edu 24 ! 25 !-------------------------------------------------------------------------- 26 ! 27 ! List of required external functions that must be supplied: 28 ! gamma --> standard mathematical gamma function (if gamma is an 29 ! intrinsic, define HAVE_GAMMA_INTRINSICS) 30 ! 31 !-------------------------------------------------------------------------- 32 ! 33 ! Constants that must be specified in the "init" method (module variables): 34 ! 35 ! kind kind of reals (to verify correct linkage only) - 36 ! gravit acceleration due to gravity m s-2 37 ! rair dry air gas constant for air J kg-1 K-1 38 ! rh2o gas constant for water vapor J kg-1 K-1 39 ! cpair specific heat at constant pressure for dry air J kg-1 K-1 40 ! tmelt temperature of melting point for water K 41 ! latvap latent heat of vaporization J kg-1 42 ! latice latent heat of fusion J kg-1 43 ! 44 !-------------------------------------------------------------------------- 45 USE shr_spfn_mod, ONLY: gamma => shr_spfn_gamma 46 IMPLICIT NONE 47 PRIVATE 48 PUBLIC size_dist_param_liq, rising_factorial, size_dist_param_basic, kk2000_liq_autoconversion, ice_autoconversion, & 49 immersion_freezing, contact_freezing, snow_self_aggregation, accrete_cloud_water_snow, secondary_ice_production, & 50 accrete_rain_snow, heterogeneous_rain_freezing, accrete_cloud_water_rain, self_collection_rain, accrete_cloud_ice_snow, & 51 evaporate_sublimate_precip, bergeron_process_snow, ice_deposition_sublimation, avg_diameter 52 ! 8 byte real and integer 53 INTEGER, parameter, public :: r8 = selected_real_kind(12) 54 INTEGER, parameter, public :: i8 = selected_int_kind(18) 55 PUBLIC mghydrometeorprops 56 TYPE mghydrometeorprops 57 ! Density (kg/m^3) 58 REAL(KIND=r8) :: rho 59 ! Information for size calculations. 60 ! Basic calculation of mean size is: 61 ! lambda = (shape_coef*nic/qic)^(1/eff_dim) 62 ! Then lambda is constrained by bounds. 63 REAL(KIND=r8) :: eff_dim 64 REAL(KIND=r8) :: shape_coef 65 REAL(KIND=r8) :: lambda_bounds(2) 66 ! Minimum average particle mass (kg). 67 ! Limit is applied at the beginning of the size distribution calculations. 68 REAL(KIND=r8) :: min_mean_mass 69 END TYPE mghydrometeorprops 70 71 TYPE(mghydrometeorprops), public :: mg_liq_props 72 TYPE(mghydrometeorprops), public :: mg_ice_props 73 TYPE(mghydrometeorprops), public :: mg_rain_props 74 TYPE(mghydrometeorprops), public :: mg_snow_props 75 !================================================= 76 ! Public module parameters (mostly for MG itself) 77 !================================================= 78 ! Pi to 20 digits; more than enough to reach the limit of double precision. 79 REAL(KIND=r8), parameter, public :: pi = 3.14159265358979323846_r8 80 ! "One minus small number": number near unity for round-off issues. 81 REAL(KIND=r8), parameter, public :: omsm = 1._r8 - 1.e-5_r8 82 ! Smallest mixing ratio considered in microphysics. 83 REAL(KIND=r8), parameter, public :: qsmall = 1.e-18_r8 84 ! minimum allowed cloud fraction 85 REAL(KIND=r8), parameter, public :: mincld = 0.0001_r8 86 REAL(KIND=r8), parameter, public :: rhosn = 250._r8 ! bulk density snow 87 REAL(KIND=r8), parameter, public :: rhoi = 500._r8 ! bulk density ice 88 REAL(KIND=r8), parameter, public :: rhow = 1000._r8 ! bulk density liquid 89 REAL(KIND=r8), parameter, public :: rhows = 917._r8 ! bulk density water solid 90 ! fall speed parameters, V = aD^b (V is in m/s) 91 ! droplets 92 REAL(KIND=r8), parameter, public :: bc = 2._r8 93 ! snow 94 REAL(KIND=r8), parameter, public :: as = 11.72_r8 95 REAL(KIND=r8), parameter, public :: bs = 0.41_r8 96 ! cloud ice 97 REAL(KIND=r8), parameter, public :: ai = 700._r8 98 REAL(KIND=r8), parameter, public :: bi = 1._r8 99 ! rain 100 REAL(KIND=r8), parameter, public :: ar = 841.99667_r8 101 REAL(KIND=r8), parameter, public :: br = 0.8_r8 102 ! mass of new crystal due to aerosol freezing and growth (kg) 103 REAL(KIND=r8), parameter, public :: mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)**3 104 !================================================= 105 ! Private module parameters 106 !================================================= 107 ! Signaling NaN bit pattern that represents a limiter that's turned off. 108 INTEGER(KIND=i8), parameter :: limiter_off = int(z'7FF1111111111111', i8) 109 ! alternate threshold used for some in-cloud mmr 110 REAL(KIND=r8), parameter :: icsmall = 1.e-8_r8 111 ! particle mass-diameter relationship 112 ! currently we assume spherical particles for cloud ice/snow 113 ! m = cD^d 114 ! exponent 115 ! Bounds for mean diameter for different constituents. 116 ! Minimum average mass of particles. 117 ! ventilation parameters 118 ! for snow 119 REAL(KIND=r8), parameter :: f1s = 0.86_r8 120 REAL(KIND=r8), parameter :: f2s = 0.28_r8 121 ! for rain 122 REAL(KIND=r8), parameter :: f1r = 0.78_r8 123 REAL(KIND=r8), parameter :: f2r = 0.308_r8 124 ! collection efficiencies 125 ! aggregation of cloud ice and snow 126 REAL(KIND=r8), parameter :: eii = 0.5_r8 127 ! immersion freezing parameters, bigg 1953 128 REAL(KIND=r8), parameter :: bimm = 100._r8 129 REAL(KIND=r8), parameter :: aimm = 0.66_r8 130 ! Mass of each raindrop created from autoconversion. 131 REAL(KIND=r8), parameter :: droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3 132 !========================================================= 133 ! Constants set in initialization 134 !========================================================= 135 ! Set using arguments to micro_mg_init 136 REAL(KIND=r8) :: rv ! water vapor gas constant 137 REAL(KIND=r8) :: cpp ! specific heat of dry air 138 REAL(KIND=r8) :: tmelt ! freezing point of water (K) 139 ! latent heats of: 140 REAL(KIND=r8) :: xxlv ! vaporization 141 ! freezing 142 REAL(KIND=r8) :: xxls ! sublimation 143 ! additional constants to help speed up code 144 REAL(KIND=r8) :: gamma_bs_plus3 145 REAL(KIND=r8) :: gamma_half_br_plus5 146 REAL(KIND=r8) :: gamma_half_bs_plus5 147 !========================================================= 148 ! Utilities that are cheaper if the compiler knows that 149 ! some argument is an integer. 150 !========================================================= 151 152 INTERFACE rising_factorial 153 MODULE PROCEDURE rising_factorial_r8 154 MODULE PROCEDURE rising_factorial_integer 155 END INTERFACE rising_factorial 156 157 INTERFACE var_coef 158 MODULE PROCEDURE var_coef_r8 159 MODULE PROCEDURE var_coef_integer 160 END INTERFACE var_coef 161 !========================================================================== 162 PUBLIC kgen_read_externs_micro_mg_utils 163 164 ! read interface 165 PUBLIC kgen_read 166 INTERFACE kgen_read 167 MODULE PROCEDURE kgen_read_mghydrometeorprops 168 END INTERFACE kgen_read 169 170 CONTAINS 171 172 ! write subroutines 173 174 ! module extern variables 175 176 SUBROUTINE kgen_read_externs_micro_mg_utils(kgen_unit) 177 INTEGER, INTENT(IN) :: kgen_unit 178 READ(UNIT=kgen_unit) rv 179 READ(UNIT=kgen_unit) cpp 180 READ(UNIT=kgen_unit) tmelt 181 READ(UNIT=kgen_unit) xxlv 182 READ(UNIT=kgen_unit) xxls 183 READ(UNIT=kgen_unit) gamma_bs_plus3 184 READ(UNIT=kgen_unit) gamma_half_br_plus5 185 READ(UNIT=kgen_unit) gamma_half_bs_plus5 186 CALL kgen_read_mghydrometeorprops(mg_liq_props, kgen_unit) 187 CALL kgen_read_mghydrometeorprops(mg_ice_props, kgen_unit) 188 CALL kgen_read_mghydrometeorprops(mg_rain_props, kgen_unit) 189 CALL kgen_read_mghydrometeorprops(mg_snow_props, kgen_unit) 190 END SUBROUTINE kgen_read_externs_micro_mg_utils 191 192 SUBROUTINE kgen_read_mghydrometeorprops(var, kgen_unit, printvar) 193 INTEGER, INTENT(IN) :: kgen_unit 194 CHARACTER(*), INTENT(IN), OPTIONAL :: printvar 195 TYPE(mghydrometeorprops), INTENT(out) :: var 196 READ(UNIT=kgen_unit) var%rho 197 IF ( PRESENT(printvar) ) THEN 198 print *, "** " // printvar // "%rho **", var%rho 199 END IF 200 READ(UNIT=kgen_unit) var%eff_dim 201 IF ( PRESENT(printvar) ) THEN 202 print *, "** " // printvar // "%eff_dim **", var%eff_dim 203 END IF 204 READ(UNIT=kgen_unit) var%shape_coef 205 IF ( PRESENT(printvar) ) THEN 206 print *, "** " // printvar // "%shape_coef **", var%shape_coef 207 END IF 208 READ(UNIT=kgen_unit) var%lambda_bounds 209 IF ( PRESENT(printvar) ) THEN 210 print *, "** " // printvar // "%lambda_bounds **", var%lambda_bounds 211 END IF 212 READ(UNIT=kgen_unit) var%min_mean_mass 213 IF ( PRESENT(printvar) ) THEN 214 print *, "** " // printvar // "%min_mean_mass **", var%min_mean_mass 215 END IF 216 END SUBROUTINE 217 !========================================================================== 218 ! Initialize module variables. 219 ! 220 ! "kind" serves no purpose here except to check for unlikely linking 221 ! issues; always pass in the kind for a double precision real. 222 ! 223 ! "errstring" is the only output; it is blank if there is no error, or set 224 ! to a message if there is an error. 225 ! 226 ! Check the list at the top of this module for descriptions of all other 227 ! arguments. 228 229 ! Constructor for a constituent property object. 230 231 !======================================================================== 232 !FORMULAS 233 !======================================================================== 234 ! Use gamma function to implement rising factorial extended to the reals. 235 236 pure FUNCTION rising_factorial_r8(x, n) RESULT ( res ) 237 REAL(KIND=r8), intent(in) :: x 238 REAL(KIND=r8), intent(in) :: n 239 REAL(KIND=r8) :: res 240 res = gamma(x+n)/gamma(x) 241 END FUNCTION rising_factorial_r8 242 ! Rising factorial can be performed much cheaper if n is a small integer. 243 244 pure FUNCTION rising_factorial_integer(x, n) RESULT ( res ) 245 REAL(KIND=r8), intent(in) :: x 246 INTEGER, intent(in) :: n 247 REAL(KIND=r8) :: res 248 INTEGER :: i 249 REAL(KIND=r8) :: factor 250 res = 1._r8 251 factor = x 252 DO i = 1, n 253 res = res * factor 254 factor = factor + 1._r8 255 END DO 256 END FUNCTION rising_factorial_integer 257 ! Calculate correction due to latent heat for evaporation/sublimation 258 259 elemental FUNCTION calc_ab(t, qv, xxl) RESULT ( ab ) 260 REAL(KIND=r8), intent(in) :: t ! Temperature 261 REAL(KIND=r8), intent(in) :: qv ! Saturation vapor pressure 262 REAL(KIND=r8), intent(in) :: xxl ! Latent heat 263 REAL(KIND=r8) :: ab 264 REAL(KIND=r8) :: dqsdt 265 dqsdt = xxl*qv / (rv * t**2) 266 ab = 1._r8 + dqsdt*xxl/cpp 267 END FUNCTION calc_ab 268 ! get cloud droplet size distribution parameters 269 270 elemental SUBROUTINE size_dist_param_liq(props, qcic, ncic, rho, pgam, lamc) 271 TYPE(mghydrometeorprops), intent(in) :: props 272 REAL(KIND=r8), intent(in) :: qcic 273 REAL(KIND=r8), intent(inout) :: ncic 274 REAL(KIND=r8), intent(in) :: rho 275 REAL(KIND=r8), intent(out) :: pgam 276 REAL(KIND=r8), intent(out) :: lamc 277 TYPE(mghydrometeorprops) :: props_loc 278 IF (qcic > qsmall) THEN 279 ! Local copy of properties that can be modified. 280 ! (Elemental routines that operate on arrays can't modify scalar 281 ! arguments.) 282 props_loc = props 283 ! Get pgam from fit to observations of martin et al. 1994 284 pgam = 0.0005714_r8*1.e-6_r8*ncic*rho + 0.2714_r8 285 pgam = 1._r8/(pgam**2) - 1._r8 286 pgam = max(pgam, 2._r8) 287 ! Set coefficient for use in size_dist_param_basic. 288 ! The 3D case is so common and optimizable that we specialize it: 289 IF (props_loc%eff_dim == 3._r8) THEN 290 props_loc%shape_coef = pi / 6._r8 * props_loc%rho * rising_factorial(pgam+1._r8, 3) 291 ELSE 292 props_loc%shape_coef = pi / 6._r8 * props_loc%rho * rising_factorial(pgam+1._r8, & 293 props_loc%eff_dim) 294 END IF 295 ! Limit to between 2 and 50 microns mean size. 296 props_loc%lambda_bounds = (pgam+1._r8)*1._r8/[50.e-6_r8, 2.e-6_r8] 297 CALL size_dist_param_basic(props_loc, qcic, ncic, lamc) 298 ELSE 299 ! pgam not calculated in this case, so set it to a value likely to 300 ! cause an error if it is accidentally used 301 ! (gamma function undefined for negative integers) 302 pgam = -100._r8 303 lamc = 0._r8 304 END IF 305 END SUBROUTINE size_dist_param_liq 306 ! Basic routine for getting size distribution parameters. 307 308 elemental SUBROUTINE size_dist_param_basic(props, qic, nic, lam, n0) 309 TYPE(mghydrometeorprops), intent(in) :: props 310 REAL(KIND=r8), intent(in) :: qic 311 REAL(KIND=r8), intent(inout) :: nic 312 REAL(KIND=r8), intent(out) :: lam 313 REAL(KIND=r8), intent(out), optional :: n0 314 IF (qic > qsmall) THEN 315 ! add upper limit to in-cloud number concentration to prevent 316 ! numerical error 317 IF (limiter_is_on(props%min_mean_mass)) THEN 318 nic = min(nic, qic / props%min_mean_mass) 319 END IF 320 ! lambda = (c n/q)^(1/d) 321 lam = (props%shape_coef * nic/qic)**(1._r8/props%eff_dim) 322 ! check for slope 323 ! adjust vars 324 IF (lam < props%lambda_bounds(1)) THEN 325 lam = props%lambda_bounds(1) 326 nic = lam**(props%eff_dim) * qic/props%shape_coef 327 ELSE IF (lam > props%lambda_bounds(2)) THEN 328 lam = props%lambda_bounds(2) 329 nic = lam**(props%eff_dim) * qic/props%shape_coef 330 END IF 331 ELSE 332 lam = 0._r8 333 END IF 334 IF (present(n0)) n0 = nic * lam 335 END SUBROUTINE size_dist_param_basic 336 337 elemental real(r8) FUNCTION avg_diameter(q, n, rho_air, rho_sub) 338 ! Finds the average diameter of particles given their density, and 339 ! mass/number concentrations in the air. 340 ! Assumes that diameter follows an exponential distribution. 341 REAL(KIND=r8), intent(in) :: q ! mass mixing ratio 342 REAL(KIND=r8), intent(in) :: n ! number concentration (per volume) 343 REAL(KIND=r8), intent(in) :: rho_air ! local density of the air 344 REAL(KIND=r8), intent(in) :: rho_sub ! density of the particle substance 345 avg_diameter = (pi * rho_sub * n/(q*rho_air))**(-1._r8/3._r8) 346 END FUNCTION avg_diameter 347 348 elemental FUNCTION var_coef_r8(relvar, a) RESULT ( res ) 349 ! Finds a coefficient for process rates based on the relative variance 350 ! of cloud water. 351 REAL(KIND=r8), intent(in) :: relvar 352 REAL(KIND=r8), intent(in) :: a 353 REAL(KIND=r8) :: res 354 res = rising_factorial(relvar, a) / relvar**a 355 END FUNCTION var_coef_r8 356 357 elemental FUNCTION var_coef_integer(relvar, a) RESULT ( res ) 358 ! Finds a coefficient for process rates based on the relative variance 359 ! of cloud water. 360 REAL(KIND=r8), intent(in) :: relvar 361 INTEGER, intent(in) :: a 362 REAL(KIND=r8) :: res 363 res = rising_factorial(relvar, a) / relvar**a 364 END FUNCTION var_coef_integer 365 !======================================================================== 366 !MICROPHYSICAL PROCESS CALCULATIONS 367 !======================================================================== 368 !======================================================================== 369 ! Initial ice deposition and sublimation loop. 370 ! Run before the main loop 371 ! This subroutine written by Peter Caldwell 372 373 elemental SUBROUTINE ice_deposition_sublimation(t, qv, qi, ni, icldm, rho, dv, qvl, qvi, berg, vap_dep, ice_sublim) 374 !INPUT VARS: 375 !=============================================== 376 REAL(KIND=r8), intent(in) :: t 377 REAL(KIND=r8), intent(in) :: qv 378 REAL(KIND=r8), intent(in) :: qi 379 REAL(KIND=r8), intent(in) :: ni 380 REAL(KIND=r8), intent(in) :: icldm 381 REAL(KIND=r8), intent(in) :: rho 382 REAL(KIND=r8), intent(in) :: dv 383 REAL(KIND=r8), intent(in) :: qvl 384 REAL(KIND=r8), intent(in) :: qvi 385 !OUTPUT VARS: 386 !=============================================== 387 REAL(KIND=r8), intent(out) :: vap_dep !ice deposition (cell-ave value) 388 REAL(KIND=r8), intent(out) :: ice_sublim !ice sublimation (cell-ave value) 389 REAL(KIND=r8), intent(out) :: berg !bergeron enhancement (cell-ave value) 390 !INTERNAL VARS: 391 !=============================================== 392 REAL(KIND=r8) :: ab 393 REAL(KIND=r8) :: epsi 394 REAL(KIND=r8) :: qiic 395 REAL(KIND=r8) :: niic 396 REAL(KIND=r8) :: lami 397 REAL(KIND=r8) :: n0i 398 IF (qi>=qsmall) THEN 399 !GET IN-CLOUD qi, ni 400 !=============================================== 401 qiic = qi/icldm 402 niic = ni/icldm 403 !Compute linearized condensational heating correction 404 ab = calc_ab(t, qvi, xxls) 405 !Get slope and intercept of gamma distn for ice. 406 CALL size_dist_param_basic(mg_ice_props, qiic, niic, lami, n0i) 407 !Get depletion timescale=1/eps 408 epsi = 2._r8*pi*n0i*rho*dv/(lami*lami) 409 !Compute deposition/sublimation 410 vap_dep = epsi/ab*(qv - qvi) 411 !Make this a grid-averaged quantity 412 vap_dep = vap_dep*icldm 413 !Split into deposition or sublimation. 414 IF (t < tmelt .and. vap_dep>0._r8) THEN 415 ice_sublim = 0._r8 416 ELSE 417 ! make ice_sublim negative for consistency with other evap/sub processes 418 ice_sublim = min(vap_dep,0._r8) 419 vap_dep = 0._r8 420 END IF 421 !sublimation occurs @ any T. Not so for berg. 422 IF (t < tmelt) THEN 423 !Compute bergeron rate assuming cloud for whole step. 424 berg = max(epsi/ab*(qvl - qvi), 0._r8) 425 ELSE !T>frz 426 berg = 0._r8 427 END IF !T<frz 428 ELSE !where qi<qsmall 429 berg = 0._r8 430 vap_dep = 0._r8 431 ice_sublim = 0._r8 432 END IF !qi>qsmall 433 END SUBROUTINE ice_deposition_sublimation 434 !======================================================================== 435 ! autoconversion of cloud liquid water to rain 436 ! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc 437 ! minimum qc of 1 x 10^-8 prevents floating point error 438 439 elemental SUBROUTINE kk2000_liq_autoconversion(microp_uniform, qcic, ncic, rho, relvar, prc, nprc, nprc1) 440 LOGICAL, intent(in) :: microp_uniform 441 REAL(KIND=r8), intent(in) :: qcic 442 REAL(KIND=r8), intent(in) :: ncic 443 REAL(KIND=r8), intent(in) :: rho 444 REAL(KIND=r8), intent(in) :: relvar 445 REAL(KIND=r8), intent(out) :: prc 446 REAL(KIND=r8), intent(out) :: nprc 447 REAL(KIND=r8), intent(out) :: nprc1 448 REAL(KIND=r8) :: prc_coef 449 ! Take variance into account, or use uniform value. 450 IF (.not. microp_uniform) THEN 451 prc_coef = var_coef(relvar, 2.47_r8) 452 ELSE 453 prc_coef = 1._r8 454 END IF 455 IF (qcic >= icsmall) THEN 456 ! nprc is increase in rain number conc due to autoconversion 457 ! nprc1 is decrease in cloud droplet conc due to autoconversion 458 ! assume exponential sub-grid distribution of qc, resulting in additional 459 ! factor related to qcvar below 460 ! switch for sub-columns, don't include sub-grid qc 461 prc = prc_coef * 1350._r8 * qcic**2.47_r8 * (ncic*1.e-6_r8*rho)**(-1.79_r8) 462 nprc = prc * (1._r8/droplet_mass_25um) 463 nprc1 = prc*ncic/qcic 464 ELSE 465 prc = 0._r8 466 nprc = 0._r8 467 nprc1 = 0._r8 468 END IF 469 END SUBROUTINE kk2000_liq_autoconversion 470 !======================================================================== 471 ! Autoconversion of cloud ice to snow 472 ! similar to Ferrier (1994) 473 474 elemental SUBROUTINE ice_autoconversion(t, qiic, lami, n0i, dcs, prci, nprci) 475 REAL(KIND=r8), intent(in) :: t 476 REAL(KIND=r8), intent(in) :: qiic 477 REAL(KIND=r8), intent(in) :: lami 478 REAL(KIND=r8), intent(in) :: n0i 479 REAL(KIND=r8), intent(in) :: dcs 480 REAL(KIND=r8), intent(out) :: prci 481 REAL(KIND=r8), intent(out) :: nprci 482 ! Assume autoconversion timescale of 180 seconds. 483 REAL(KIND=r8), parameter :: ac_time = 180._r8 484 ! Average mass of an ice particle. 485 REAL(KIND=r8) :: m_ip 486 ! Ratio of autoconversion diameter to average diameter. 487 REAL(KIND=r8) :: d_rat 488 IF (t <= tmelt .and. qiic >= qsmall) THEN 489 d_rat = lami*dcs 490 ! Rate of ice particle conversion (number). 491 nprci = n0i/(lami*ac_time)*exp(-d_rat) 492 m_ip = (rhoi*pi/6._r8) / lami**3 493 ! Rate of mass conversion. 494 ! Note that this is: 495 ! m n (d^3 + 3 d^2 + 6 d + 6) 496 prci = m_ip * nprci * (((d_rat + 3._r8)*d_rat + 6._r8)*d_rat + 6._r8) 497 ELSE 498 prci = 0._r8 499 nprci = 0._r8 500 END IF 501 END SUBROUTINE ice_autoconversion 502 ! immersion freezing (Bigg, 1953) 503 !=================================== 504 505 elemental SUBROUTINE immersion_freezing(microp_uniform, t, pgam, lamc, qcic, ncic, relvar, mnuccc, nnuccc) 506 LOGICAL, intent(in) :: microp_uniform 507 ! Temperature 508 REAL(KIND=r8), intent(in) :: t 509 ! Cloud droplet size distribution parameters 510 REAL(KIND=r8), intent(in) :: pgam 511 REAL(KIND=r8), intent(in) :: lamc 512 ! MMR and number concentration of in-cloud liquid water 513 REAL(KIND=r8), intent(in) :: qcic 514 REAL(KIND=r8), intent(in) :: ncic 515 ! Relative variance of cloud water 516 REAL(KIND=r8), intent(in) :: relvar 517 ! Output tendencies 518 REAL(KIND=r8), intent(out) :: mnuccc ! MMR 519 REAL(KIND=r8), intent(out) :: nnuccc ! Number 520 ! Coefficients that will be omitted for sub-columns 521 REAL(KIND=r8) :: dum 522 IF (.not. microp_uniform) THEN 523 dum = var_coef(relvar, 2) 524 ELSE 525 dum = 1._r8 526 END IF 527 IF (qcic >= qsmall .and. t < 269.15_r8) THEN 528 nnuccc = pi/6._r8*ncic*rising_factorial(pgam+1._r8, 3)* bimm*(exp(aimm*(tmelt - t))-1._r8)/lamc**3 529 mnuccc = dum * nnuccc * pi/6._r8*rhow* rising_factorial(pgam+4._r8, 3)/lamc**3 530 ELSE 531 mnuccc = 0._r8 532 nnuccc = 0._r8 533 END IF ! qcic > qsmall and t < 4 deg C 534 END SUBROUTINE immersion_freezing 535 ! contact freezing (-40<T<-3 C) (Young, 1974) with hooks into simulated dust 536 !=================================================================== 537 ! dust size and number in multiple bins are read in from companion routine 538 539 pure SUBROUTINE contact_freezing(microp_uniform, t, p, rndst, nacon, pgam, lamc, qcic, ncic, relvar, mnucct, nnucct) 540 LOGICAL, intent(in) :: microp_uniform 541 REAL(KIND=r8), intent(in) :: t(:) ! Temperature 542 REAL(KIND=r8), intent(in) :: p(:) ! Pressure 543 REAL(KIND=r8), intent(in) :: rndst(:,:) ! Radius (for multiple dust bins) 544 REAL(KIND=r8), intent(in) :: nacon(:,:) ! Number (for multiple dust bins) 545 ! Size distribution parameters for cloud droplets 546 REAL(KIND=r8), intent(in) :: pgam(:) 547 REAL(KIND=r8), intent(in) :: lamc(:) 548 ! MMR and number concentration of in-cloud liquid water 549 REAL(KIND=r8), intent(in) :: qcic(:) 550 REAL(KIND=r8), intent(in) :: ncic(:) 551 ! Relative cloud water variance 552 REAL(KIND=r8), intent(in) :: relvar(:) 553 ! Output tendencies 554 REAL(KIND=r8), intent(out) :: mnucct(:) ! MMR 555 REAL(KIND=r8), intent(out) :: nnucct(:) ! Number 556 REAL(KIND=r8) :: tcnt ! scaled relative temperature 557 REAL(KIND=r8) :: viscosity ! temperature-specific viscosity (kg/m/s) 558 REAL(KIND=r8) :: mfp ! temperature-specific mean free path (m) 559 ! Dimension these according to number of dust bins, inferred from rndst size 560 REAL(KIND=r8) :: nslip(size(rndst,2)) ! slip correction factors 561 REAL(KIND=r8) :: ndfaer(size(rndst,2)) ! aerosol diffusivities (m^2/sec) 562 ! Coefficients not used for subcolumns 563 REAL(KIND=r8) :: dum 564 REAL(KIND=r8) :: dum1 565 ! Common factor between mass and number. 566 REAL(KIND=r8) :: contact_factor 567 INTEGER :: i 568 DO i = 1,size(t) 569 IF (qcic(i) >= qsmall .and. t(i) < 269.15_r8) THEN 570 IF (.not. microp_uniform) THEN 571 dum = var_coef(relvar(i), 4._r8/3._r8) 572 dum1 = var_coef(relvar(i), 1._r8/3._r8) 573 ELSE 574 dum = 1._r8 575 dum1 = 1._r8 576 END IF 577 tcnt = (270.16_r8-t(i))**1.3_r8 578 viscosity = 1.8e-5_r8*(t(i)/298.0_r8)**0.85_r8 ! Viscosity (kg/m/s) 579 mfp = 2.0_r8*viscosity/ (p(i)*sqrt( 8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i)) )) ! Mean free path (m) 580 ! Note that these two are vectors. 581 nslip = 1.0_r8+(mfp/rndst(i,:))*(1.257_r8+(0.4_r8*exp(-(1.1_r8*rndst(i,:)/mfp)))) ! Slip correction factor 582 ndfaer = 1.381e-23_r8*t(i)*nslip/(6._r8*pi*viscosity*rndst(i,:)) ! aerosol diffusivity (m2/s) 583 contact_factor = dot_product(ndfaer,nacon(i,:)*tcnt) * pi * ncic(i) * (pgam(i) + 1._r8) / lamc(i) 584 mnucct(i) = dum * contact_factor * pi/3._r8*rhow*rising_factorial(pgam(i)+2._r8, 3)/lamc(i)**3 585 nnucct(i) = dum1 * 2._r8 * contact_factor 586 ELSE 587 mnucct(i) = 0._r8 588 nnucct(i) = 0._r8 589 END IF ! qcic > qsmall and t < 4 deg C 590 END DO 591 END SUBROUTINE contact_freezing 592 ! snow self-aggregation from passarelli, 1978, used by reisner, 1998 593 !=================================================================== 594 ! this is hard-wired for bs = 0.4 for now 595 ! ignore self-collection of cloud ice 596 597 elemental SUBROUTINE snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg) 598 REAL(KIND=r8), intent(in) :: t ! Temperature 599 REAL(KIND=r8), intent(in) :: rho ! Density 600 REAL(KIND=r8), intent(in) :: asn ! fall speed parameter for snow 601 REAL(KIND=r8), intent(in) :: rhosn ! density of snow 602 ! In-cloud snow 603 REAL(KIND=r8), intent(in) :: qsic ! MMR 604 REAL(KIND=r8), intent(in) :: nsic ! Number 605 ! Output number tendency 606 REAL(KIND=r8), intent(out) :: nsagg 607 IF (qsic >= qsmall .and. t <= tmelt) THEN 608 nsagg = -1108._r8*eii/(4._r8*720._r8*rhosn)*asn*qsic*nsic*rho* ((qsic/nsic)*(1._r8/(rhosn*pi)))**((& 609 bs-1._r8)/3._r8) 610 ELSE 611 nsagg = 0._r8 612 END IF 613 END SUBROUTINE snow_self_aggregation 614 ! accretion of cloud droplets onto snow/graupel 615 !=================================================================== 616 ! here use continuous collection equation with 617 ! simple gravitational collection kernel 618 ! ignore collisions between droplets/cloud ice 619 ! since minimum size ice particle for accretion is 50 - 150 micron 620 621 elemental SUBROUTINE accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, pgam, lamc, lams, n0s, psacws, & 622 npsacws) 623 REAL(KIND=r8), intent(in) :: t ! Temperature 624 REAL(KIND=r8), intent(in) :: rho ! Density 625 REAL(KIND=r8), intent(in) :: asn ! Fallspeed parameter (snow) 626 REAL(KIND=r8), intent(in) :: uns ! Current fallspeed (snow) 627 REAL(KIND=r8), intent(in) :: mu ! Viscosity 628 ! In-cloud liquid water 629 REAL(KIND=r8), intent(in) :: qcic ! MMR 630 REAL(KIND=r8), intent(in) :: ncic ! Number 631 ! In-cloud snow 632 REAL(KIND=r8), intent(in) :: qsic ! MMR 633 ! Cloud droplet size parameters 634 REAL(KIND=r8), intent(in) :: pgam 635 REAL(KIND=r8), intent(in) :: lamc 636 ! Snow size parameters 637 REAL(KIND=r8), intent(in) :: lams 638 REAL(KIND=r8), intent(in) :: n0s 639 ! Output tendencies 640 REAL(KIND=r8), intent(out) :: psacws ! Mass mixing ratio 641 REAL(KIND=r8), intent(out) :: npsacws ! Number concentration 642 REAL(KIND=r8) :: dc0 ! Provisional mean droplet size 643 REAL(KIND=r8) :: dum 644 REAL(KIND=r8) :: eci ! collection efficiency for riming of snow by droplets 645 ! Fraction of cloud droplets accreted per second 646 REAL(KIND=r8) :: accrete_rate 647 ! ignore collision of snow with droplets above freezing 648 IF (qsic >= qsmall .and. t <= tmelt .and. qcic >= qsmall) THEN 649 ! put in size dependent collection efficiency 650 ! mean diameter of snow is area-weighted, since 651 ! accretion is function of crystal geometric area 652 ! collection efficiency is approximation based on stoke's law (Thompson et al. 2004) 653 dc0 = (pgam+1._r8)/lamc 654 dum = dc0*dc0*uns*rhow*lams/(9._r8*mu) 655 eci = dum*dum/((dum+0.4_r8)*(dum+0.4_r8)) 656 eci = max(eci,0._r8) 657 eci = min(eci,1._r8) 658 ! no impact of sub-grid distribution of qc since psacws 659 ! is linear in qc 660 accrete_rate = pi/4._r8*asn*rho*n0s*eci*gamma_bs_plus3 / lams**(bs+3._r8) 661 psacws = accrete_rate*qcic 662 npsacws = accrete_rate*ncic 663 ELSE 664 psacws = 0._r8 665 npsacws = 0._r8 666 END IF 667 END SUBROUTINE accrete_cloud_water_snow 668 ! add secondary ice production due to accretion of droplets by snow 669 !=================================================================== 670 ! (Hallet-Mossop process) (from Cotton et al., 1986) 671 672 elemental SUBROUTINE secondary_ice_production(t, psacws, msacwi, nsacwi) 673 REAL(KIND=r8), intent(in) :: t ! Temperature 674 ! Accretion of cloud water to snow tendencies 675 REAL(KIND=r8), intent(inout) :: psacws ! MMR 676 ! Output (ice) tendencies 677 REAL(KIND=r8), intent(out) :: msacwi ! MMR 678 REAL(KIND=r8), intent(out) :: nsacwi ! Number 679 IF ((t < 270.16_r8) .and. (t >= 268.16_r8)) THEN 680 nsacwi = 3.5e8_r8*(270.16_r8-t)/2.0_r8*psacws 681 ELSE IF ((t < 268.16_r8) .and. (t >= 265.16_r8)) THEN 682 nsacwi = 3.5e8_r8*(t-265.16_r8)/3.0_r8*psacws 683 ELSE 684 nsacwi = 0.0_r8 685 END IF 686 msacwi = min(nsacwi*mi0, psacws) 687 psacws = psacws - msacwi 688 END SUBROUTINE secondary_ice_production 689 ! accretion of rain water by snow 690 !=================================================================== 691 ! formula from ikawa and saito, 1991, used by reisner et al., 1998 692 693 elemental SUBROUTINE accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, lamr, n0r, lams, n0s, pracs, npracs) 694 REAL(KIND=r8), intent(in) :: t ! Temperature 695 REAL(KIND=r8), intent(in) :: rho ! Density 696 ! Fallspeeds 697 ! mass-weighted 698 REAL(KIND=r8), intent(in) :: umr ! rain 699 REAL(KIND=r8), intent(in) :: ums ! snow 700 ! number-weighted 701 REAL(KIND=r8), intent(in) :: unr ! rain 702 REAL(KIND=r8), intent(in) :: uns ! snow 703 ! In cloud MMRs 704 REAL(KIND=r8), intent(in) :: qric ! rain 705 REAL(KIND=r8), intent(in) :: qsic ! snow 706 ! Size distribution parameters 707 ! rain 708 REAL(KIND=r8), intent(in) :: lamr 709 REAL(KIND=r8), intent(in) :: n0r 710 ! snow 711 REAL(KIND=r8), intent(in) :: lams 712 REAL(KIND=r8), intent(in) :: n0s 713 ! Output tendencies 714 REAL(KIND=r8), intent(out) :: pracs ! MMR 715 REAL(KIND=r8), intent(out) :: npracs ! Number 716 ! Collection efficiency for accretion of rain by snow 717 REAL(KIND=r8), parameter :: ecr = 1.0_r8 718 ! Ratio of average snow diameter to average rain diameter. 719 REAL(KIND=r8) :: d_rat 720 ! Common factor between mass and number expressions 721 REAL(KIND=r8) :: common_factor 722 IF (qric >= icsmall .and. qsic >= icsmall .and. t <= tmelt) THEN 723 common_factor = pi*ecr*rho*n0r*n0s/(lamr**3 * lams) 724 d_rat = lamr/lams 725 pracs = common_factor*pi*rhow* sqrt((1.2_r8*umr-0.95_r8*ums)**2 + 0.08_r8*ums*umr) / lamr**3 * & 726 ((0.5_r8*d_rat + 2._r8)*d_rat + 5._r8) 727 npracs = common_factor*0.5_r8* sqrt(1.7_r8*(unr-uns)**2 + 0.3_r8*unr*uns) * ((d_rat + 1._r8)& 728 *d_rat + 1._r8) 729 ELSE 730 pracs = 0._r8 731 npracs = 0._r8 732 END IF 733 END SUBROUTINE accrete_rain_snow 734 ! heterogeneous freezing of rain drops 735 !=================================================================== 736 ! follows from Bigg (1953) 737 738 elemental SUBROUTINE heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr) 739 REAL(KIND=r8), intent(in) :: t ! Temperature 740 ! In-cloud rain 741 REAL(KIND=r8), intent(in) :: qric ! MMR 742 REAL(KIND=r8), intent(in) :: nric ! Number 743 REAL(KIND=r8), intent(in) :: lamr ! size parameter 744 ! Output tendencies 745 REAL(KIND=r8), intent(out) :: mnuccr ! MMR 746 REAL(KIND=r8), intent(out) :: nnuccr ! Number 747 IF (t < 269.15_r8 .and. qric >= qsmall) THEN 748 nnuccr = pi*nric*bimm* (exp(aimm*(tmelt - t))-1._r8)/lamr**3 749 mnuccr = nnuccr * 20._r8*pi*rhow/lamr**3 750 ELSE 751 mnuccr = 0._r8 752 nnuccr = 0._r8 753 END IF 754 END SUBROUTINE heterogeneous_rain_freezing 755 ! accretion of cloud liquid water by rain 756 !=================================================================== 757 ! formula from Khrouditnov and Kogan (2000) 758 ! gravitational collection kernel, droplet fall speed neglected 759 760 elemental SUBROUTINE accrete_cloud_water_rain(microp_uniform, qric, qcic, ncic, relvar, accre_enhan, pra, npra) 761 LOGICAL, intent(in) :: microp_uniform 762 ! In-cloud rain 763 REAL(KIND=r8), intent(in) :: qric ! MMR 764 ! Cloud droplets 765 REAL(KIND=r8), intent(in) :: qcic ! MMR 766 REAL(KIND=r8), intent(in) :: ncic ! Number 767 ! SGS variability 768 REAL(KIND=r8), intent(in) :: relvar 769 REAL(KIND=r8), intent(in) :: accre_enhan 770 ! Output tendencies 771 REAL(KIND=r8), intent(out) :: pra ! MMR 772 REAL(KIND=r8), intent(out) :: npra ! Number 773 ! Coefficient that varies for subcolumns 774 REAL(KIND=r8) :: pra_coef 775 IF (.not. microp_uniform) THEN 776 pra_coef = accre_enhan * var_coef(relvar, 1.15_r8) 777 ELSE 778 pra_coef = 1._r8 779 END IF 780 IF (qric >= qsmall .and. qcic >= qsmall) THEN 781 ! include sub-grid distribution of cloud water 782 pra = pra_coef * 67._r8*(qcic*qric)**1.15_r8 783 npra = pra*ncic/qcic 784 ELSE 785 pra = 0._r8 786 npra = 0._r8 787 END IF 788 END SUBROUTINE accrete_cloud_water_rain 789 ! Self-collection of rain drops 790 !=================================================================== 791 ! from Beheng(1994) 792 793 elemental SUBROUTINE self_collection_rain(rho, qric, nric, nragg) 794 REAL(KIND=r8), intent(in) :: rho ! Air density 795 ! Rain 796 REAL(KIND=r8), intent(in) :: qric ! MMR 797 REAL(KIND=r8), intent(in) :: nric ! Number 798 ! Output number tendency 799 REAL(KIND=r8), intent(out) :: nragg 800 IF (qric >= qsmall) THEN 801 nragg = -8._r8*nric*qric*rho 802 ELSE 803 nragg = 0._r8 804 END IF 805 END SUBROUTINE self_collection_rain 806 ! Accretion of cloud ice by snow 807 !=================================================================== 808 ! For this calculation, it is assumed that the Vs >> Vi 809 ! and Ds >> Di for continuous collection 810 811 elemental SUBROUTINE accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, lams, n0s, prai, nprai) 812 REAL(KIND=r8), intent(in) :: t ! Temperature 813 REAL(KIND=r8), intent(in) :: rho ! Density 814 REAL(KIND=r8), intent(in) :: asn ! Snow fallspeed parameter 815 ! Cloud ice 816 REAL(KIND=r8), intent(in) :: qiic ! MMR 817 REAL(KIND=r8), intent(in) :: niic ! Number 818 REAL(KIND=r8), intent(in) :: qsic ! Snow MMR 819 ! Snow size parameters 820 REAL(KIND=r8), intent(in) :: lams 821 REAL(KIND=r8), intent(in) :: n0s 822 ! Output tendencies 823 REAL(KIND=r8), intent(out) :: prai ! MMR 824 REAL(KIND=r8), intent(out) :: nprai ! Number 825 ! Fraction of cloud ice particles accreted per second 826 REAL(KIND=r8) :: accrete_rate 827 IF (qsic >= qsmall .and. qiic >= qsmall .and. t <= tmelt) THEN 828 accrete_rate = pi/4._r8 * eii * asn * rho * n0s * gamma_bs_plus3/ lams**(bs+3._r8) 829 prai = accrete_rate * qiic 830 nprai = accrete_rate * niic 831 ELSE 832 prai = 0._r8 833 nprai = 0._r8 834 END IF 835 END SUBROUTINE accrete_cloud_ice_snow 836 ! calculate evaporation/sublimation of rain and snow 837 !=================================================================== 838 ! note: evaporation/sublimation occurs only in cloud-free portion of grid cell 839 ! in-cloud condensation/deposition of rain and snow is neglected 840 ! except for transfer of cloud water to snow through bergeron process 841 842 elemental SUBROUTINE evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, precip_frac, arn, asn, qcic, qiic,& 843 qric, qsic, lamr, n0r, lams, n0s, pre, prds) 844 REAL(KIND=r8), intent(in) :: t ! temperature 845 REAL(KIND=r8), intent(in) :: rho ! air density 846 REAL(KIND=r8), intent(in) :: dv ! water vapor diffusivity 847 REAL(KIND=r8), intent(in) :: mu ! viscosity 848 REAL(KIND=r8), intent(in) :: sc ! schmidt number 849 REAL(KIND=r8), intent(in) :: q ! humidity 850 REAL(KIND=r8), intent(in) :: qvl ! saturation humidity (water) 851 REAL(KIND=r8), intent(in) :: qvi ! saturation humidity (ice) 852 REAL(KIND=r8), intent(in) :: lcldm ! liquid cloud fraction 853 REAL(KIND=r8), intent(in) :: precip_frac ! precipitation fraction (maximum overlap) 854 ! fallspeed parameters 855 REAL(KIND=r8), intent(in) :: arn ! rain 856 REAL(KIND=r8), intent(in) :: asn ! snow 857 ! In-cloud MMRs 858 REAL(KIND=r8), intent(in) :: qcic ! cloud liquid 859 REAL(KIND=r8), intent(in) :: qiic ! cloud ice 860 REAL(KIND=r8), intent(in) :: qric ! rain 861 REAL(KIND=r8), intent(in) :: qsic ! snow 862 ! Size parameters 863 ! rain 864 REAL(KIND=r8), intent(in) :: lamr 865 REAL(KIND=r8), intent(in) :: n0r 866 ! snow 867 REAL(KIND=r8), intent(in) :: lams 868 REAL(KIND=r8), intent(in) :: n0s 869 ! Output tendencies 870 REAL(KIND=r8), intent(out) :: pre 871 REAL(KIND=r8), intent(out) :: prds 872 REAL(KIND=r8) :: qclr ! water vapor mixing ratio in clear air 873 REAL(KIND=r8) :: ab ! correction to account for latent heat 874 REAL(KIND=r8) :: eps ! 1/ sat relaxation timescale 875 REAL(KIND=r8) :: dum 876 ! set temporary cloud fraction to zero if cloud water + ice is very small 877 ! this will ensure that evaporation/sublimation of precip occurs over 878 ! entire grid cell, since min cloud fraction is specified otherwise 879 IF (qcic+qiic < 1.e-6_r8) THEN 880 dum = 0._r8 881 ELSE 882 dum = lcldm 883 END IF 884 ! only calculate if there is some precip fraction > cloud fraction 885 IF (precip_frac > dum) THEN 886 ! calculate q for out-of-cloud region 887 qclr = (q-dum*qvl)/(1._r8-dum) 888 ! evaporation of rain 889 IF (qric >= qsmall) THEN 890 ab = calc_ab(t, qvl, xxlv) 891 eps = 2._r8*pi*n0r*rho*dv* (f1r/(lamr*lamr)+ f2r*(arn*rho/mu)**0.5_r8* & 892 sc**(1._r8/3._r8)*gamma_half_br_plus5/ (lamr**(5._r8/2._r8+br/2._r8))) 893 pre = eps*(qclr-qvl)/ab 894 ! only evaporate in out-of-cloud region 895 ! and distribute across precip_frac 896 pre = min(pre*(precip_frac-dum),0._r8) 897 pre = pre/precip_frac 898 ELSE 899 pre = 0._r8 900 END IF 901 ! sublimation of snow 902 IF (qsic >= qsmall) THEN 903 ab = calc_ab(t, qvi, xxls) 904 eps = 2._r8*pi*n0s*rho*dv* (f1s/(lams*lams)+ f2s*(asn*rho/mu)**0.5_r8* & 905 sc**(1._r8/3._r8)*gamma_half_bs_plus5/ (lams**(5._r8/2._r8+bs/2._r8))) 906 prds = eps*(qclr-qvi)/ab 907 ! only sublimate in out-of-cloud region and distribute over precip_frac 908 prds = min(prds*(precip_frac-dum),0._r8) 909 prds = prds/precip_frac 910 ELSE 911 prds = 0._r8 912 END IF 913 ELSE 914 prds = 0._r8 915 pre = 0._r8 916 END IF 917 END SUBROUTINE evaporate_sublimate_precip 918 ! bergeron process - evaporation of droplets and deposition onto snow 919 !=================================================================== 920 921 elemental SUBROUTINE bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, qcic, qsic, lams, n0s, bergs) 922 REAL(KIND=r8), intent(in) :: t ! temperature 923 REAL(KIND=r8), intent(in) :: rho ! air density 924 REAL(KIND=r8), intent(in) :: dv ! water vapor diffusivity 925 REAL(KIND=r8), intent(in) :: mu ! viscosity 926 REAL(KIND=r8), intent(in) :: sc ! schmidt number 927 REAL(KIND=r8), intent(in) :: qvl ! saturation humidity (water) 928 REAL(KIND=r8), intent(in) :: qvi ! saturation humidity (ice) 929 ! fallspeed parameter for snow 930 REAL(KIND=r8), intent(in) :: asn 931 ! In-cloud MMRs 932 REAL(KIND=r8), intent(in) :: qcic ! cloud liquid 933 REAL(KIND=r8), intent(in) :: qsic ! snow 934 ! Size parameters for snow 935 REAL(KIND=r8), intent(in) :: lams 936 REAL(KIND=r8), intent(in) :: n0s 937 ! Output tendencies 938 REAL(KIND=r8), intent(out) :: bergs 939 REAL(KIND=r8) :: ab ! correction to account for latent heat 940 REAL(KIND=r8) :: eps ! 1/ sat relaxation timescale 941 IF (qsic >= qsmall.and. qcic >= qsmall .and. t < tmelt) THEN 942 ab = calc_ab(t, qvi, xxls) 943 eps = 2._r8*pi*n0s*rho*dv* (f1s/(lams*lams)+ f2s*(asn*rho/mu)**0.5_r8* sc**(& 944 1._r8/3._r8)*gamma_half_bs_plus5/ (lams**(5._r8/2._r8+bs/2._r8))) 945 bergs = eps*(qvl-qvi)/ab 946 ELSE 947 bergs = 0._r8 948 END IF 949 END SUBROUTINE bergeron_process_snow 950 !======================================================================== 951 !UTILITIES 952 !======================================================================== 953 954 955 pure FUNCTION limiter_is_on(lim) 956 REAL(KIND=r8), intent(in) :: lim 957 LOGICAL :: limiter_is_on 958 limiter_is_on = transfer(lim, limiter_off) /= limiter_off 959 END FUNCTION limiter_is_on 960 END MODULE micro_mg_utils 961