50use machine,
only : r8 => kind_phys
51use machine,
only : i8 => kind_phys
104 real(r8) :: shape_coef
105 real(r8) :: lambda_bounds(2)
108 real(r8) :: min_mean_mass
142real(r8),
parameter,
public :: pi = 3.14159265358979323846_r8
146real(r8),
parameter,
public :: omsm = 1._r8 - 1.e-6_r8
149real(r8),
parameter,
public :: qsmall = 1.e-18_r8
152 real(r8),
parameter,
public :: mincld = 0.000001_r8
156real(r8),
parameter,
public :: rhosn = 250._r8
157real(r8),
parameter,
public :: rhoi = 500._r8
158real(r8),
parameter,
public :: rhow = 1000._r8
159real(r8),
parameter,
public :: rhows = 917._r8
163real(r8),
parameter,
public :: rhog = 500._r8
164real(r8),
parameter,
public :: rhoh = 400._r8
169real(r8),
parameter,
public :: ac = 3.e7_r8
170real(r8),
parameter,
public :: bc = 2._r8
172real(r8),
parameter,
public :: as = 11.72_r8
173real(r8),
parameter,
public :: bs = 0.41_r8
175real(r8),
parameter,
public :: ai = 700._r8
176real(r8),
parameter,
public :: bi = 1._r8
178real(r8),
parameter,
public :: aj = ac*((rhoi/rhows)**(bc/3._r8))*rhows/rhow
179real(r8),
parameter,
public :: bj = bc
181real(r8),
parameter,
public :: ar = 841.99667_r8
182real(r8),
parameter,
public :: br = 0.8_r8
185real(r8),
parameter,
public :: ag = 19.3_r8
186real(r8),
parameter,
public :: bg = 0.37_r8
188real(r8),
parameter,
public :: ah = 114.5_r8
189real(r8),
parameter,
public :: bh = 0.5_r8
195real(r8),
parameter,
public :: mi0 = 4._r8/3._r8*pi*rhoi*(1.e-6_r8)**3
201real(r8),
parameter,
public :: mg0 = 1.6e-10_r8
203real(r8),
parameter,
public :: mmult = 4._r8/3._r8*pi*rhoi*(5.e-6_r8)**3
211integer(i8),
parameter :: limiter_off = int(z
'7FF1111111111111', i8)
214real(r8),
parameter :: icsmall = 1.e-8_r8
220real(r8),
parameter :: dsph = 3._r8
223real(r8),
parameter :: lam_bnd_rain(2) = 1._r8/[500.e-6_r8, 20.e-6_r8]
224real(r8),
parameter :: lam_bnd_snow(2) = 1._r8/[2000.e-6_r8, 10.e-6_r8]
227real(r8),
parameter :: min_mean_mass_liq = 1.e-20_r8
228real(r8),
parameter :: min_mean_mass_ice = 1.e-20_r8
232real(r8),
parameter :: f1s = 0.86_r8
233real(r8),
parameter :: f2s = 0.28_r8
235real(r8),
parameter :: f1r = 0.78_r8
236real(r8),
parameter :: f2r = 0.308_r8
242 real(r8),
parameter :: eii = 0.2_r8
245real(r8),
parameter,
public :: ecid = 0.7_r8
247real(r8),
parameter,
public :: ecr = 1.0_r8
251real(r8),
parameter :: bimm = 100._r8
252real(r8),
parameter :: aimm = 0.66_r8
255real(r8),
parameter :: droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3
256real(r8),
parameter :: droplet_mass_40um = 4._r8/3._r8*pi*rhow*(40.e-6_r8)**3, &
257 droplet_mass_40umi = 1._r8/droplet_mass_40um
276real(r8) :: gamma_bs_plus3
277real(r8) :: gamma_half_br_plus5
278real(r8) :: gamma_half_bs_plus5
280real(r8) :: gamma_2bs_plus2
283real(r8),
parameter :: zero = 0._r8, one = 1._r8, two = 2._r8, three = 3._r8, &
284 four = 4._r8, five = 5._r8, six = 6._r8, pio6 = pi/six, &
285 pio3 = pi/three, half = 0.5_r8, oneo3 = one/three, &
295 module procedure rising_factorial_r8
296 module procedure rising_factorial_integer
322 integer,
intent(in) :: kind
324 real(r8),
intent(in) :: rair
326 real(r8),
intent(in) :: rh2o
327 real(r8),
intent(in) :: cpair
328 real(r8),
intent(in) :: tmelt_in
329 real(r8),
intent(in) :: latvap
330 real(r8),
intent(in) :: latice
331 real(r8),
intent(in) :: dcs
336 real(r8) :: ice_lambda_bounds(2)
357 gamma_bs_plus3 = gamma(three+bs)
358 gamma_half_br_plus5 = gamma((five+br)*half)
359 gamma_half_bs_plus5 = gamma((five+bs)*half)
361 gamma_2bs_plus2 = gamma(bs+bs+two)
371 ice_lambda_bounds = one/[two*dcs, 1.e-6_r8]
374 ice_lambda_bounds, min_mean_mass_ice)
388 real(r8),
intent(in) :: rho, eff_dim
389 real(r8),
intent(in),
optional :: lambda_bounds(2), min_mean_mass
393 res%eff_dim = eff_dim
394 if (
present(lambda_bounds))
then
395 res%lambda_bounds = lambda_bounds
399 if (
present(min_mean_mass))
then
400 res%min_mean_mass = min_mean_mass
405 res%shape_coef = rho * pio6 * gamma(eff_dim+one)
414pure function rising_factorial_r8(x, n)
result(res)
415 real(r8),
intent(in) :: x, n
418 res = gamma(x+n) / gamma(x)
420end function rising_factorial_r8
423pure function rising_factorial_integer(x, n)
result(res)
424 real(r8),
intent(in) :: x
425 integer,
intent(in) :: n
436 factor = factor + one
439end function rising_factorial_integer
442elemental function calc_ab(t, qv, xxl)
result(ab)
443 real(r8),
intent(in) :: t
444 real(r8),
intent(in) :: qv
445 real(r8),
intent(in) :: xxl
451 dqsdt = xxl*qv / (rv*t*t)
452 ab = one + dqsdt*xxl/cpp
460 real(r8),
intent(in) :: qcic
461 real(r8),
intent(inout) :: ncic
462 real(r8),
intent(in) :: rho
464 real(r8),
intent(out) :: pgam
465 real(r8),
intent(out) :: lamc
469 logical,
parameter :: liq_gmao=.true.
471 if (qcic > qsmall)
then
481 pgam = 0.0005714_r8*1.e-6_r8*ncic*rho + 0.2714_r8
483 if ((ncic > 1.0e-3_r8) .and. (qcic > 1.0e-11_r8))
then
484 xs = 0.07_r8*(1000._r8*qcic/ncic) ** (-0.14_r8)
489 xs = max(min(xs, 1.7_r8), 1.1_r8)
491 xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.0_r8)/8.0_r8
495 pgam = one - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic*rho)
498 pgam = one / (pgam*pgam) - one
499 pgam = max(pgam, two)
503 if (props_loc%eff_dim == three)
then
504 props_loc%shape_coef = pio6 * props_loc%rho * &
507 props_loc%shape_coef = pio6 * props_loc%rho * &
512 props_loc%lambda_bounds = (pgam+one) * one/[50.e-6_r8, 2.e-6_r8]
531 integer,
intent(in) :: mgncol
532 real(r8),
dimension(mgncol),
intent(in) :: qcic
533 real(r8),
dimension(mgncol),
intent(inout) :: ncic
534 real(r8),
dimension(mgncol),
intent(in) :: rho
535 real(r8),
dimension(mgncol),
intent(out) :: pgam
536 real(r8),
dimension(mgncol),
intent(out) :: lamc
539 logical,
parameter :: liq_gmao=.true.
543 if (qcic(i) > qsmall)
then
551 pgam(i) = 0.0005714_r8*1.e-6_r8*ncic(i)*rho(i) + 0.2714_r8
552 if ((ncic(i) > 1.0e-3_r8) .and. (qcic(i) > 1.0e-11_r8))
then
553 xs = 0.07_r8*(1000._r8*qcic(i)/ncic(i)) **(-0.14_r8)
558 xs = max(min(xs, 1.7_r8), 1.1_r8)
560 xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.0_r8)/8.0_r8
563 pgam(i) = one - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic(i)*rho(i))
567 pgam(i) = one/(pgam(i)*pgam(i)) - one
568 pgam(i) = max(pgam(i), two)
572 if (qcic(i) > qsmall)
then
576 if (props_loc%eff_dim == three)
then
577 props_loc%shape_coef = pio6 * props_loc%rho * &
580 props_loc%shape_coef = pio6 * props_loc%rho * &
584 props_loc%lambda_bounds(1) = (pgam(i)+one) / 50.e-6_r8
585 props_loc%lambda_bounds(2) = (pgam(i)+one) / 2.e-6_r8
590 if (qcic(i) <= qsmall)
then
605 real(r8),
intent(in) :: qic
606 real(r8),
intent(inout) :: nic
608 real(r8),
intent(out) :: lam
609 real(r8),
intent(out),
optional :: n0
611 if (qic > qsmall)
then
616 nic = min(nic, qic / props%min_mean_mass)
620 lam = (props%shape_coef * nic/qic)**(one/props%eff_dim)
624 if (lam < props%lambda_bounds(1))
then
625 lam = props%lambda_bounds(1)
626 nic = lam**(props%eff_dim) * qic/props%shape_coef
627 else if (lam > props%lambda_bounds(2))
then
628 lam = props%lambda_bounds(2)
629 nic = lam**(props%eff_dim) * qic/props%shape_coef
636 if (
present(n0)) n0 = nic * lam
644 type (mghydrometeorprops),
intent(in) :: props
645 integer,
intent(in) :: mgncol
646 real(r8),
dimension(mgncol),
intent(in) :: qic
647 real(r8),
dimension(mgncol),
intent(inout) :: nic
648 real(r8),
dimension(mgncol),
intent(out) :: lam
649 real(r8),
dimension(mgncol),
intent(out),
optional :: n0
653 if (qic(i) > qsmall)
then
658 nic(i) = min(nic(i), qic(i) / props%min_mean_mass)
662 lam(i) = (props%shape_coef * nic(i)/qic(i))**(one/props%eff_dim)
666 if (lam(i) < props%lambda_bounds(1))
then
667 lam(i) = props%lambda_bounds(1)
668 nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef
669 else if (lam(i) > props%lambda_bounds(2))
then
670 lam(i) = props%lambda_bounds(2)
671 nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef
680 if (
present(n0)) n0 = nic * lam
688 real(r8),
intent(in) :: qic
689 real(r8),
intent(inout) :: nic
691 real(r8),
intent(out) :: lam
692 real(r8):: miu_ice,tx1,tx2, aux
693 real(r8),
intent(out),
optional :: n0
694 logical,
parameter :: ice_sep=.true.
696 if (qic > qsmall)
then
701 nic = min(nic, qic / props%min_mean_mass)
705 lam = (props%shape_coef * nic/qic)**(1._r8/props%eff_dim)
707 miu_ice = max(min(0.008_r8*(lam*0.01)**0.87_r8, 10.0_r8), 0.1_r8)
708 tx1 = 1.0_r8 + miu_ice
709 tx2 = 1.0_r8 / gamma(tx1)
710 aux = (gamma(tx1+3.0_r8)*tx2) ** (1.0_r8/3.0_r8)
717 if (
present(n0)) n0 = nic * lam**tx1*tx2
721 if (lam < props%lambda_bounds(1)*aux)
then
722 lam = props%lambda_bounds(1)
723 nic = lam**(props%eff_dim) * qic/props%shape_coef
724 if (
present(n0)) n0 = nic * lam
725 else if (lam > props%lambda_bounds(2)*aux)
then
726 lam = props%lambda_bounds(2)
727 nic = lam**(props%eff_dim) * qic/props%shape_coef
728 if (
present(n0)) n0 = nic * lam
742 type (mghydrometeorprops),
intent(in) :: props
743 integer,
intent(in) :: mgncol
744 real(r8),
dimension(mgncol),
intent(in) :: qic
745 real(r8),
dimension(mgncol),
intent(inout) :: nic
746 real(r8),
dimension(mgncol),
intent(out) :: lam
747 real(r8),
dimension(mgncol),
intent(out),
optional :: n0
748 real(r8) :: miu_ice,tx1,tx2, aux
750 logical,
parameter :: ice_sep=.true.
753 if (qic(i) > qsmall)
then
758 nic(i) = min(nic(i), qic(i) / props%min_mean_mass)
762 lam(i) = (props%shape_coef * nic(i)/qic(i))**(1._r8/props%eff_dim)
764 miu_ice = max(min(0.008_r8*(lam(i)*0.01)**0.87_r8, 10.0_r8), 0.1_r8)
765 tx1 = 1.0_r8 + miu_ice
766 tx2 = 1.0_r8 / gamma(tx1)
767 aux = (gamma(tx1+3.0_r8)*tx2) ** (1.0_r8/3.0_r8)
774 if (
present(n0)) n0(i) = nic(i) * lam(i)**tx1*tx2
778 if (lam(i) < props%lambda_bounds(1)*aux)
then
779 lam(i) = props%lambda_bounds(1)
780 nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef
781 if (
present(n0)) n0(i) = nic(i) * lam(i)
782 else if (lam(i) > props%lambda_bounds(2)*aux)
then
783 lam(i) = props%lambda_bounds(2)
784 nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef
785 if (
present(n0)) n0(i) = nic(i) * lam(i)
801 real(r8),
intent(in) :: q
802 real(r8),
intent(in) :: n
803 real(r8),
intent(in) :: rho_air
804 real(r8),
intent(in) :: rho_sub
814 real(r8),
intent(in) :: relvar
815 real(r8),
intent(in) :: a
826 real(r8),
intent(in) :: relvar
827 integer,
intent(in) :: a
843 icldm, rho, dv,qvl, qvi, &
844 berg, vap_dep, ice_sublim, mgncol)
848 integer,
intent(in) :: mgncol
849 real(r8),
dimension(mgncol),
intent(in) :: t
850 real(r8),
dimension(mgncol),
intent(in) :: qv
851 real(r8),
dimension(mgncol),
intent(in) :: qi
852 real(r8),
dimension(mgncol),
intent(in) :: ni
853 real(r8),
dimension(mgncol),
intent(in) :: icldm
854 real(r8),
dimension(mgncol),
intent(in) :: rho
855 real(r8),
dimension(mgncol),
intent(in) :: dv
856 real(r8),
dimension(mgncol),
intent(in) :: qvl
857 real(r8),
dimension(mgncol),
intent(in) :: qvi
861 real(r8),
dimension(mgncol),
intent(out) :: vap_dep
862 real(r8),
dimension(mgncol),
intent(out) :: ice_sublim
863 real(r8),
dimension(mgncol),
intent(out) :: berg
877 if (qi(i)>=qsmall)
then
886 ab = calc_ab(t(i), qvi(i), xxls)
891 epsi = twopi*n0i*rho(i)*dv(i)/(lami*lami)
894 vap_dep(i) = epsi/ab*(qv(i) - qvi(i))
897 vap_dep(i) = vap_dep(i)*icldm(i)
900 if (t(i) < tmelt .and. vap_dep(i) > zero)
then
904 ice_sublim(i) = min(vap_dep(i), zero)
909 if (t(i) < tmelt)
then
912 berg(i) = max(epsi/ab*(qvl(i) - qvi(i)), zero)
931 ncic, rho, relvar, prc, nprc, nprc1, mgncol)
933 integer,
intent(in) :: mgncol
934 logical,
intent(in) :: microp_uniform
936 real(r8),
dimension(mgncol),
intent(in) :: qcic
937 real(r8),
dimension(mgncol),
intent(in) :: ncic
938 real(r8),
dimension(mgncol),
intent(in) :: rho
940 real(r8),
dimension(mgncol),
intent(in) :: relvar
942 real(r8),
dimension(mgncol),
intent(out) :: prc
943 real(r8),
dimension(mgncol),
intent(out) :: nprc
944 real(r8),
dimension(mgncol),
intent(out) :: nprc1
946 real(r8),
dimension(mgncol) :: prc_coef
950 if (.not. microp_uniform)
then
951 prc_coef(:) =
var_coef(relvar(:), 2.47_r8)
957 if (qcic(i) >= icsmall)
then
966 prc(i) = prc_coef(i) * &
967 0.01_r8 * 1350._r8 * qcic(i)**2.47_r8 * (ncic(i)*1.e-6_r8*rho(i))**(-1.1_r8)
968 nprc(i) = prc(i) * (one/droplet_mass_25um)
969 nprc1(i) = prc(i)*ncic(i)/qcic(i)
995 integer,
intent(in) :: mgncol
997 real(r8),
dimension(mgncol),
intent (in) :: pgam
998 real(r8),
dimension(mgncol),
intent (in) :: qc
999 real(r8),
dimension(mgncol),
intent (in) :: nc
1000 real(r8),
dimension(mgncol),
intent (in) :: qr
1001 real(r8),
dimension(mgncol),
intent (in) :: rho
1002 real(r8),
dimension(mgncol),
intent (in) :: relvar
1004 real(r8),
dimension(mgncol),
intent (out) :: au
1005 real(r8),
dimension(mgncol),
intent (out) :: nprc1
1006 real(r8),
dimension(mgncol),
intent (out) :: nprc
1011 real(r8),
parameter :: dnu(16) = [0._r8,-0.557_r8,-0.430_r8,-0.307_r8, &
1012 -0.186_r8,-0.067_r8,0.050_r8,0.167_r8,0.282_r8,0.397_r8,0.512_r8, &
1013 0.626_r8,0.739_r8,0.853_r8,0.966_r8,0.966_r8]
1016 real(r8),
parameter :: kc = 9.44e9_r8
1017 real(r8),
parameter :: kr = 5.78e3_r8
1018 real(r8),
parameter :: auf = kc / (20._r8*2.6e-7_r8) * 1000._r8, &
1019 con_nprc1 = two/2.6e-7_r8*1000._r8
1020 real(r8) :: dum, dum1, nu, pra_coef, tx1, tx2, tx3, tx4
1025 pra_coef =
var_coef(relvar(i), 2.47_r8)
1026 if (qc(i) > qsmall)
then
1027 dumi = max(1, min(int(pgam(i)), 15))
1028 nu = dnu(dumi) + (dnu(dumi+1)-dnu(dumi))* (pgam(i)-dumi)
1031 dum = max(one-qc(i)/(qc(i)+qr(i)), zero)
1034 dum1 = 600._r8 * tx1 * tx2 * tx2 * tx2
1038 tx2 = 0.001_r8 * rho(i) * qc(i)
1039 tx3 = tx2 * tx2 / (rho(i)*nc(i)*1.e-6_r8)
1042 au(i) = auf * (nu+two) * (nu+four) * tx2 &
1043 * (one+dum1/(tx3*tx3)) / (tx1*tx1*rho(i))
1052 nprc1(i) = au(i) * con_nprc1
1053 nprc(i) = au(i) * droplet_mass_40umi
1068 au,nprc,nprc1,mgncol)
1072 integer,
intent(in) :: mgncol
1074 real(r8),
dimension(mgncol),
intent (in) :: pgam
1075 real(r8),
dimension(mgncol),
intent (in) :: qc
1076 real(r8),
dimension(mgncol),
intent (in) :: nc
1077 real(r8),
dimension(mgncol),
intent (in) :: qr
1078 real(r8),
dimension(mgncol),
intent (in) :: rho
1079 real(r8),
dimension(mgncol),
intent (in) :: relvar
1081 real(r8),
dimension(mgncol),
intent (out) :: au
1082 real(r8),
dimension(mgncol),
intent (out) :: nprc1
1083 real(r8),
dimension(mgncol),
intent (out) :: nprc
1084 real(r8) :: xs,lw, nw, beta6
1087 real(r8),
parameter :: dcrit = 2.0e-3, miu_disp = 0.8, &
1088 con_nprc1 = two/2.6e-7_r8*1000._r8
1092 if (qc(i) > qsmall)
then
1093 xs = one / (one+pgam(i))
1094 beta6 = (one+three*xs)*(one+four*xs)*(one+five*xs) &
1095 / ((one+xs)*(one+xs+xs))
1096 lw = 1.0e-3_r8 * qc(i) * rho(i)
1097 nw = nc(i) * rho(i) * 1.e-6_r8
1099 xs = min(20.0_r8, 1.03e16_r8*(lw*lw)/(nw*sqrt(nw)))
1100 au(i) = 1.1e10_r8*beta6*lw*lw*lw &
1101 * (one-exp(-(xs**miu_disp))) / nw
1102 au(i) = au(i)*1.0e3_r8/rho(i)
1103 au(i) = au(i) * gamma(two+relvar(i)) &
1104 / (gamma(relvar(i))*(relvar(i)*relvar(i)))
1106 au(i) = au(i) * dcrit
1109 nprc1(i)= au(i) * con_nprc1
1110 nprc(i) = au(i) * droplet_mass_40umi
1131 integer,
intent(in) :: mgncol
1133 real(r8),
dimension(mgncol),
intent (in) :: qc
1134 real(r8),
dimension(mgncol),
intent (in) :: nc
1135 real(r8),
dimension(mgncol),
intent (in) :: qr
1136 real(r8),
dimension(mgncol),
intent (in) :: rho
1137 real(r8),
dimension(mgncol),
intent (in) :: relvar
1140 real(r8),
dimension(mgncol),
intent(out) :: pra
1141 real(r8),
dimension(mgncol),
intent(out) :: npra
1144 real(r8),
parameter :: kc = 9.44e9_r8
1145 real(r8),
parameter :: kr = 5.78e3_r8
1147 real(r8) :: dum, dum1, tx1, tx2
1154 if (qc(i) > qsmall)
then
1155 dum = one - qc(i)/(qc(i)+qr(i))
1156 tx1 = dum / (dum+5.e-4_r8)
1159 pra(i) = kr*rho(i)*0.001_r8*qc(i)*qr(i)*dum1
1161 npra(i) = pra(i) * nc(i) / qc(i)
1182 integer,
intent(in) :: mgncol
1183 real(r8),
dimension(mgncol),
intent(in) :: t
1184 real(r8),
dimension(mgncol),
intent(in) :: qiic
1185 real(r8),
dimension(mgncol),
intent(in) :: lami
1186 real(r8),
dimension(mgncol),
intent(in) :: n0i
1187 real(r8),
intent(in) :: dcs
1188 real(r8),
dimension(mgncol),
intent(in) :: ac_time
1190 real(r8),
dimension(mgncol),
intent(out) :: prci
1191 real(r8),
dimension(mgncol),
intent(out) :: nprci
1202 if (t(i) <= tmelt .and. qiic(i) >= qsmall)
then
1207 nprci(i) = n0i(i)/(lami(i)*ac_time(i))*exp(-d_rat)
1209 m_ip = rhoi * pio6 / (lami(i)*lami(i)*lami(i))
1216 prci(i) = m_ip * nprci(i) * (((d_rat + three)*d_rat + six)*d_rat + six)
1229 dcs, ac_time, prci, nprci, mgncol)
1231 integer,
intent(in) :: mgncol
1232 real(r8),
dimension(mgncol),
intent(in) :: t
1233 real(r8),
dimension(mgncol),
intent(in) :: qiic
1234 real(r8),
dimension(mgncol),
intent(in) :: niic
1235 real(r8),
dimension(mgncol),
intent(in) :: lami
1236 real(r8),
dimension(mgncol),
intent(in) :: n0i
1237 real(r8),
dimension(mgncol),
intent(in) :: ac_time
1238 real(r8),
intent(in) :: dcs
1240 real(r8),
dimension(mgncol),
intent(out) :: prci
1241 real(r8),
dimension(mgncol),
intent(out) :: nprci
1244 real(r8) :: m_ip, tx1, tx2
1247 if (t(i) <= tmelt .and. qiic(i) >= qsmall)
then
1248 m_ip = max(min(0.008_r8*(lami(i)*0.01)**0.87_r8, &
1251 tx2 = one / ac_time(i)
1252 nprci(i) = niic(i)*tx2 * (one -
gamma_incomp(m_ip, tx1))
1253 prci(i) = qiic(i)*tx2 * (one -
gamma_incomp(m_ip+three, tx1))
1266 qcic, ncic, relvar, mnuccc, nnuccc, mgncol)
1268 integer,
intent(in) :: mgncol
1269 logical,
intent(in) :: microp_uniform
1272 real(r8),
dimension(mgncol),
intent(in) :: t
1275 real(r8),
dimension(mgncol),
intent(in) :: pgam
1276 real(r8),
dimension(mgncol),
intent(in) :: lamc
1279 real(r8),
dimension(mgncol),
intent(in) :: qcic
1280 real(r8),
dimension(mgncol),
intent(in) :: ncic
1283 real(r8),
dimension(mgncol),
intent(in) :: relvar
1286 real(r8),
dimension(mgncol),
intent(out) :: mnuccc
1287 real(r8),
dimension(mgncol),
intent(out) :: nnuccc
1290 real(r8),
dimension(mgncol) :: dum
1294 if (.not. microp_uniform)
then
1301 if (qcic(i) >= qsmall .and. t(i) < 269.15_r8)
then
1303 tx1 = one / (lamc(i) * lamc(i) * lamc(i))
1305 bimm*(exp(aimm*(tmelt - t(i)))-one) * tx1
1307 mnuccc(i) = dum(i) * nnuccc(i) * pio6 * rhow * &
1322 pgam, lamc, qcic, ncic, relvar, mnucct, nnucct, mgncol, mdust)
1324 logical,
intent(in) :: microp_uniform
1326 integer,
intent(in) :: mgncol
1327 integer,
intent(in) :: mdust
1329 real(r8),
dimension(mgncol),
intent(in) :: t
1330 real(r8),
dimension(mgncol),
intent(in) :: p
1331 real(r8),
dimension(mgncol, mdust),
intent(in) :: rndst
1332 real(r8),
dimension(mgncol, mdust),
intent(in) :: nacon
1335 real(r8),
dimension(mgncol),
intent(in) :: pgam
1336 real(r8),
dimension(mgncol),
intent(in) :: lamc
1339 real(r8),
dimension(mgncol),
intent(in) :: qcic
1340 real(r8),
dimension(mgncol),
intent(in) :: ncic
1343 real(r8),
dimension(mgncol),
intent(in) :: relvar
1346 real(r8),
dimension(mgncol),
intent(out) :: mnucct
1347 real(r8),
dimension(mgncol),
intent(out) :: nnucct
1350 real(r8) :: viscosity
1354 real(r8) :: nslip(size(rndst,2))
1355 real(r8) :: ndfaer(size(rndst,2))
1358 real(r8) :: dum, dum1, tx1
1361 real(r8) :: contact_factor
1367 if (qcic(i) >= qsmall .and. t(i) < 269.15_r8)
then
1369 if (.not. microp_uniform)
then
1370 dum =
var_coef(relvar(i), four/three)
1377 tcnt=(270.16_r8-t(i))**1.3_r8
1378 viscosity = 1.8e-5_r8*(t(i)/298.0_r8)**0.85_r8
1379 mfp = two*viscosity/ &
1380 (p(i)*sqrt( 8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i)) ))
1383 nslip = one+(mfp/rndst(i,:))*(1.257_r8+(0.4_r8*exp(-(1.1_r8*rndst(i,:)/mfp))))
1385 ndfaer = 1.381e-23_r8*t(i)*nslip/(6._r8*pi*viscosity*rndst(i,:))
1388 contact_factor = dot_product(ndfaer,nacon(i,:)*tcnt) * pi * &
1389 ncic(i) * (pgam(i) + one) * tx1
1391 mnucct(i) = dum * contact_factor * &
1394 nnucct(i) = (dum1+dum1) * contact_factor
1413 integer,
intent(in) :: mgncol
1415 real(r8),
dimension(mgncol),
intent(in) :: t
1416 real(r8),
dimension(mgncol),
intent(in) :: rho
1417 real(r8),
dimension(mgncol),
intent(in) :: asn
1418 real(r8),
intent(in) :: rhosn
1421 real(r8),
dimension(mgncol),
intent(in) :: qsic
1422 real(r8),
dimension(mgncol),
intent(in) :: nsic
1425 real(r8),
dimension(mgncol),
intent(out) :: nsagg
1430 if (qsic(i) >= qsmall .and. t(i) <= tmelt)
then
1431 nsagg(i) = -1108._r8*eii/(four*720._r8*rhosn)*asn(i)*qsic(i)*nsic(i)*rho(i)*&
1432 ((qsic(i)/nsic(i))*(one/(rhosn*pi)))**((bs-one)*oneo3)
1447 pgam, lamc, lams, n0s, psacws, npsacws, mgncol)
1449 integer,
intent(in) :: mgncol
1450 real(r8),
dimension(mgncol),
intent(in) :: t
1451 real(r8),
dimension(mgncol),
intent(in) :: rho
1452 real(r8),
dimension(mgncol),
intent(in) :: asn
1453 real(r8),
dimension(mgncol),
intent(in) :: uns
1454 real(r8),
dimension(mgncol),
intent(in) :: mu
1457 real(r8),
dimension(mgncol),
intent(in) :: qcic
1458 real(r8),
dimension(mgncol),
intent(in) :: ncic
1461 real(r8),
dimension(mgncol),
intent(in) :: qsic
1464 real(r8),
dimension(mgncol),
intent(in) :: pgam
1465 real(r8),
dimension(mgncol),
intent(in) :: lamc
1468 real(r8),
dimension(mgncol),
intent(in) :: lams
1469 real(r8),
dimension(mgncol),
intent(in) :: n0s
1472 real(r8),
dimension(mgncol),
intent(out) :: psacws
1473 real(r8),
dimension(mgncol),
intent(out) :: npsacws
1480 real(r8) :: accrete_rate
1486 if (qsic(i) >= qsmall .and. t(i) <= tmelt .and. qcic(i) >= qsmall)
then
1493 dc0 = (pgam(i)+one)/lamc(i)
1494 dum = dc0*dc0*uns(i)*rhow*lams(i)/(9._r8*mu(i))
1495 eci = dum*dum / ((dum+0.4_r8)*(dum+0.4_r8))
1502 accrete_rate = (pi/four)*asn(i)*rho(i)*n0s(i)*eci*gamma_bs_plus3 / lams(i)**(bs+three)
1503 psacws(i) = accrete_rate*qcic(i)
1504 npsacws(i) = accrete_rate*ncic(i)
1518 integer,
intent(in) :: mgncol
1519 real(r8),
dimension(mgncol),
intent(in) :: t
1522 real(r8),
dimension(mgncol),
intent(inout) :: psacws
1525 real(r8),
dimension(mgncol),
intent(out) :: msacwi
1526 real(r8),
dimension(mgncol),
intent(out) :: nsacwi
1530 if((t(i) < 270.16_r8) .and. (t(i) >= 268.16_r8))
then
1531 nsacwi(i) = 3.5e8_r8*(270.16_r8-t(i))/two*psacws(i)
1532 else if((t(i) < 268.16_r8) .and. (t(i) >= 265.16_r8))
then
1533 nsacwi(i) = 3.5e8_r8*(t(i)-265.16_r8)*oneo3*psacws(i)
1540 msacwi(i) = min(nsacwi(i)*mi0, psacws(i))
1541 psacws(i) = psacws(i) - msacwi(i)
1550 lamr, n0r, lams, n0s, pracs, npracs, mgncol)
1552 integer,
intent(in) :: mgncol
1554 real(r8),
dimension(mgncol),
intent(in) :: t
1555 real(r8),
dimension(mgncol),
intent(in) :: rho
1559 real(r8),
dimension(mgncol),
intent(in) :: umr
1560 real(r8),
dimension(mgncol),
intent(in) :: ums
1562 real(r8),
dimension(mgncol),
intent(in) :: unr
1563 real(r8),
dimension(mgncol),
intent(in) :: uns
1566 real(r8),
dimension(mgncol),
intent(in) :: qric
1567 real(r8),
dimension(mgncol),
intent(in) :: qsic
1571 real(r8),
dimension(mgncol),
intent(in) :: lamr
1572 real(r8),
dimension(mgncol),
intent(in) :: n0r
1574 real(r8),
dimension(mgncol),
intent(in) :: lams
1575 real(r8),
dimension(mgncol),
intent(in) :: n0s
1578 real(r8),
dimension(mgncol),
intent(out) :: pracs
1579 real(r8),
dimension(mgncol),
intent(out) :: npracs
1582 real(r8),
parameter :: ecr = one
1587 real(r8) :: common_factor
1588 real(r8) :: tx1, tx2
1592 if (qric(i) >= icsmall .and. qsic(i) >= icsmall .and. t(i) <= tmelt)
then
1594 tx2 = lamr(i)*lamr(i)*lamr(i)
1596 common_factor = pi*ecr*rho(i)*n0r(i)*n0s(i) / (tx2 * lams(i))
1598 d_rat = lamr(i)/lams(i)
1600 tx1 = 1.2_r8*umr(i)-0.95_r8*ums(i)
1601 pracs(i) = common_factor*pi*rhow* &
1602 sqrt(tx1*tx1 + 0.08_r8*ums(i)*umr(i)) * &
1603 ((half*d_rat + two)*d_rat + five) / tx2
1606 npracs(i) = common_factor*half * &
1607 sqrt(1.7_r8*tx1*tx1 + 0.3_r8*unr(i)*uns(i)) * &
1608 ((d_rat + one)*d_rat + one)
1623 integer,
intent(in) :: mgncol
1624 real(r8),
dimension(mgncol),
intent(in) :: t
1627 real(r8),
dimension(mgncol),
intent(in) :: qric
1628 real(r8),
dimension(mgncol),
intent(in) :: nric
1629 real(r8),
dimension(mgncol),
intent(in) :: lamr
1632 real(r8),
dimension(mgncol),
intent(out) :: mnuccr
1633 real(r8),
dimension(mgncol),
intent(out) :: nnuccr
1639 if (t(i) < 269.15_r8 .and. qric(i) >= qsmall)
then
1640 tx1 = pi / (lamr(i)*lamr(i)*lamr(i))
1641 nnuccr(i) = nric(i)*bimm* (exp(aimm*(tmelt - t(i)))-one) * tx1
1643 mnuccr(i) = nnuccr(i) * 20._r8*rhow * tx1
1657 ncic, relvar, accre_enhan, pra, npra, mgncol)
1659 logical,
intent(in) :: microp_uniform
1660 integer,
intent(in) :: mgncol
1662 real(r8),
dimension(mgncol),
intent(in) :: qric
1665 real(r8),
dimension(mgncol),
intent(in) :: qcic
1666 real(r8),
dimension(mgncol),
intent(in) :: ncic
1669 real(r8),
dimension(mgncol),
intent(in) :: relvar
1670 real(r8),
dimension(mgncol),
intent(in) :: accre_enhan
1673 real(r8),
dimension(mgncol),
intent(out) :: pra
1674 real(r8),
dimension(mgncol),
intent(out) :: npra
1677 real(r8),
dimension(mgncol) :: pra_coef
1681 if (.not. microp_uniform)
then
1682 pra_coef(:) = accre_enhan *
var_coef(relvar(:), 1.15_r8)
1689 if (qric(i) >= qsmall .and. qcic(i) >= qsmall)
then
1692 pra(i) = pra_coef(i) * 67._r8*(qcic(i)*qric(i))**1.15_r8
1694 npra(i) = pra(i)*ncic(i)/qcic(i)
1708 integer,
intent(in) :: mgncol
1709 real(r8),
dimension(mgncol),
intent(in) :: rho
1712 real(r8),
dimension(mgncol),
intent(in) :: qric
1713 real(r8),
dimension(mgncol),
intent(in) :: nric
1716 real(r8),
dimension(mgncol),
intent(out) :: nragg
1721 if (qric(i) >= qsmall)
then
1722 nragg(i) = -8._r8*nric(i)*qric(i)*rho(i)
1735 lams, n0s, prai, nprai, mgncol)
1737 integer,
intent(in) :: mgncol
1738 real(r8),
dimension(mgncol),
intent(in) :: t
1739 real(r8),
dimension(mgncol),
intent(in) :: rho
1741 real(r8),
dimension(mgncol),
intent(in) :: asn
1744 real(r8),
dimension(mgncol),
intent(in) :: qiic
1745 real(r8),
dimension(mgncol),
intent(in) :: niic
1747 real(r8),
dimension(mgncol),
intent(in) :: qsic
1750 real(r8),
dimension(mgncol),
intent(in) :: lams
1751 real(r8),
dimension(mgncol),
intent(in) :: n0s
1754 real(r8),
dimension(mgncol),
intent(out) :: prai
1755 real(r8),
dimension(mgncol),
intent(out) :: nprai
1758 real(r8) :: accrete_rate
1763 if (qsic(i) >= qsmall .and. qiic(i) >= qsmall .and. t(i) <= tmelt)
then
1765 accrete_rate = (pi/four) * eii * asn(i) * rho(i) * n0s(i) * gamma_bs_plus3 &
1766 / lams(i)**(bs+three)
1768 prai(i) = accrete_rate * qiic(i)
1769 nprai(i) = accrete_rate * niic(i)
1785 lcldm, precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, &
1786 pre, prds, am_evp_st, mgncol)
1788 integer,
intent(in) :: mgncol
1790 real(r8),
dimension(mgncol),
intent(in) :: t
1791 real(r8),
dimension(mgncol),
intent(in) :: rho
1792 real(r8),
dimension(mgncol),
intent(in) :: dv
1793 real(r8),
dimension(mgncol),
intent(in) :: mu
1794 real(r8),
dimension(mgncol),
intent(in) :: sc
1795 real(r8),
dimension(mgncol),
intent(in) :: q
1796 real(r8),
dimension(mgncol),
intent(in) :: qvl
1797 real(r8),
dimension(mgncol),
intent(in) :: qvi
1798 real(r8),
dimension(mgncol),
intent(in) :: lcldm
1799 real(r8),
dimension(mgncol),
intent(in) :: precip_frac
1802 real(r8),
dimension(mgncol),
intent(in) :: arn
1803 real(r8),
dimension(mgncol),
intent(in) :: asn
1806 real(r8),
dimension(mgncol),
intent(in) :: qcic
1807 real(r8),
dimension(mgncol),
intent(in) :: qiic
1808 real(r8),
dimension(mgncol),
intent(in) :: qric
1809 real(r8),
dimension(mgncol),
intent(in) :: qsic
1813 real(r8),
dimension(mgncol),
intent(in) :: lamr
1814 real(r8),
dimension(mgncol),
intent(in) :: n0r
1816 real(r8),
dimension(mgncol),
intent(in) :: lams
1817 real(r8),
dimension(mgncol),
intent(in) :: n0s
1820 real(r8),
dimension(mgncol),
intent(out) :: pre
1821 real(r8),
dimension(mgncol),
intent(out) :: prds
1822 real(r8),
dimension(mgncol),
intent(out) :: am_evp_st
1827 real(r8) :: tx1, tx2, tx3
1829 real(r8),
dimension(mgncol) :: dum
1838 if (qcic(i)+qiic(i) < 1.e-6_r8)
then
1847 if (precip_frac(i) > dum(i))
then
1849 if (qric(i) >= qsmall .or. qsic(i) >= qsmall)
then
1850 am_evp_st(i) = precip_frac(i) - dum(i)
1853 qclr = (q(i)-dum(i)*qvl(i)) / (one-dum(i))
1857 if (qric(i) >= qsmall)
then
1859 ab = calc_ab(t(i), qvl(i), xxlv)
1860 eps = two*pi*n0r(i)*rho(i)*dv(i) * &
1861 (f1r/(lamr(i)*lamr(i)) + &
1862 f2r*sqrt(arn(i)*rho(i)/mu(i)) * &
1863 sc(i)**oneo3*gamma_half_br_plus5 &
1864 / (lamr(i)**((five+br)*half)))
1866 pre(i) = eps*(qclr-qvl(i)) / ab
1870 pre(i) = min(pre(i)*am_evp_st(i), zero)
1871 pre(i) = pre(i) / precip_frac(i)
1877 if (qsic(i) >= qsmall)
then
1878 ab = calc_ab(t(i), qvi(i), xxls)
1879 eps = two*pi*n0s(i)*rho(i)*dv(i) * &
1880 ( f1s/(lams(i)*lams(i)) &
1881 + f2s*sqrt(asn(i)*rho(i)/mu(i)) * &
1882 sc(i)**oneo3*gamma_half_bs_plus5 &
1883 / (lams(i)**((five+bs)*half)))
1884 prds(i) = eps*(qclr-qvi(i)) / ab
1887 prds(i) = min(prds(i)*am_evp_st(i), zero)
1888 prds(i) = prds(i) / precip_frac(i)
1908 lcldm, precip_frac, arn, asn, agn, bg, qcic, qiic, qric, qsic, qgic, lamr, n0r, lams, n0s, lamg, n0g, &
1909 pre, prds, prdg, am_evp_st, mgncol)
1911 integer,
intent(in) :: mgncol
1913 real(r8),
dimension(mgncol),
intent(in) :: t
1914 real(r8),
dimension(mgncol),
intent(in) :: rho
1915 real(r8),
dimension(mgncol),
intent(in) :: dv
1916 real(r8),
dimension(mgncol),
intent(in) :: mu
1917 real(r8),
dimension(mgncol),
intent(in) :: sc
1918 real(r8),
dimension(mgncol),
intent(in) :: q
1919 real(r8),
dimension(mgncol),
intent(in) :: qvl
1920 real(r8),
dimension(mgncol),
intent(in) :: qvi
1921 real(r8),
dimension(mgncol),
intent(in) :: lcldm
1922 real(r8),
dimension(mgncol),
intent(in) :: precip_frac
1925 real(r8),
dimension(mgncol),
intent(in) :: arn
1926 real(r8),
dimension(mgncol),
intent(in) :: asn
1928 real(r8),
dimension(mgncol),
intent(in) :: agn
1929 real(r8),
intent(in) :: bg
1933 real(r8),
dimension(mgncol),
intent(in) :: qcic
1934 real(r8),
dimension(mgncol),
intent(in) :: qiic
1935 real(r8),
dimension(mgncol),
intent(in) :: qric
1936 real(r8),
dimension(mgncol),
intent(in) :: qsic
1937 real(r8),
dimension(mgncol),
intent(in) :: qgic
1941 real(r8),
dimension(mgncol),
intent(in) :: lamr
1942 real(r8),
dimension(mgncol),
intent(in) :: n0r
1944 real(r8),
dimension(mgncol),
intent(in) :: lams
1945 real(r8),
dimension(mgncol),
intent(in) :: n0s
1948 real(r8),
dimension(mgncol),
intent(in) :: lamg
1949 real(r8),
dimension(mgncol),
intent(in) :: n0g
1953 real(r8),
dimension(mgncol),
intent(out) :: pre
1954 real(r8),
dimension(mgncol),
intent(out) :: prds
1956 real(r8),
dimension(mgncol),
intent(out) :: prdg
1958 real(r8),
dimension(mgncol),
intent(out) :: am_evp_st
1964 real(r8),
dimension(mgncol) :: dum
1972 if (qcic(i)+qiic(i) < 1.e-6_r8)
then
1981 if (precip_frac(i) > dum(i))
then
1983 if (qric(i) >= qsmall .or. qsic(i) >= qsmall .or. qgic(i) >= qsmall)
then
1984 am_evp_st(i) = precip_frac(i) - dum(i)
1987 qclr = (q(i)-dum(i)*qvl(i)) / (one-dum(i))
1991 if (qric(i) >= qsmall)
then
1993 ab = calc_ab(t(i), qvl(i), xxlv)
1994 eps = twopi*n0r(i)*rho(i)*dv(i)* &
1995 ( f1r/(lamr(i)*lamr(i)) &
1996 + f2r*sqrt(arn(i)*rho(i)/mu(i)) &
1997 * sc(i)**oneo3*gamma_half_br_plus5 &
1998 / (lamr(i)**((five+br)*half)))
2000 pre(i) = eps*(qclr-qvl(i))/ab
2004 pre(i) = min(pre(i)*am_evp_st(i), zero)
2005 pre(i) = pre(i)/precip_frac(i)
2011 if (qsic(i) >= qsmall)
then
2012 ab = calc_ab(t(i), qvi(i), xxls)
2013 eps = twopi*n0s(i)*rho(i)*dv(i)* &
2014 ( f1s/(lams(i)*lams(i)) &
2015 + f2s*sqrt(asn(i)*rho(i)/mu(i)) &
2016 * sc(i)**oneo3*gamma_half_bs_plus5 &
2017 / (lams(i)**((five+bs)*half)))
2018 prds(i) = eps*(qclr-qvi(i))/ab
2021 prds(i) = min(prds(i)*am_evp_st(i), zero)
2022 prds(i) = prds(i)/precip_frac(i)
2029 if (qgic(i) >= qsmall)
then
2030 ab = calc_ab(t(i), qvi(i), xxls)
2032 eps = twopi*n0g(i)*rho(i)*dv(i)* &
2033 ( f1s/(lamg(i)*lamg(i)) &
2034 + f2s*sqrt(agn(i)*rho(i)/mu(i)) &
2035 * sc(i)**oneo3*gamma((five+bg)*half) &
2036 / (lamg(i)**((five+bs)*half)))
2038 prdg(i) = eps*(qclr-qvi(i))/ab
2041 prdg(i) = min(prdg(i)*am_evp_st(i), zero)
2042 prdg(i) = prdg(i)/precip_frac(i)
2061 qcic, qsic, lams, n0s, bergs, mgncol)
2063 integer,
intent(in) :: mgncol
2065 real(r8),
dimension(mgncol),
intent(in) :: t
2066 real(r8),
dimension(mgncol),
intent(in) :: rho
2067 real(r8),
dimension(mgncol),
intent(in) :: dv
2068 real(r8),
dimension(mgncol),
intent(in) :: mu
2069 real(r8),
dimension(mgncol),
intent(in) :: sc
2070 real(r8),
dimension(mgncol),
intent(in) :: qvl
2071 real(r8),
dimension(mgncol),
intent(in) :: qvi
2074 real(r8),
dimension(mgncol),
intent(in) :: asn
2077 real(r8),
dimension(mgncol),
intent(in) :: qcic
2078 real(r8),
dimension(mgncol),
intent(in) :: qsic
2081 real(r8),
dimension(mgncol),
intent(in) :: lams
2082 real(r8),
dimension(mgncol),
intent(in) :: n0s
2085 real(r8),
dimension(mgncol),
intent(out) :: bergs
2093 if (qsic(i) >= qsmall.and. qcic(i) >= qsmall .and. t(i) < tmelt)
then
2094 ab = calc_ab(t(i), qvi(i), xxls)
2095 eps = two*pi*n0s(i)*rho(i)*dv(i) * &
2096 (f1s/(lams(i)*lams(i)) + &
2097 f2s*sqrt(asn(i)*rho(i)/mu(i)) * &
2098 sc(i)**oneo3*gamma_half_bs_plus5 / &
2099 (lams(i)**((five+bs)*half)))
2100 bergs(i) = eps*(qvl(i)-qvi(i)) / ab
2113 integer,
intent(in) :: mgncol
2116 real(r8),
dimension(mgncol),
intent(in) :: qsic
2117 real(r8),
dimension(mgncol),
intent(in) :: qric
2120 real(r8),
dimension(mgncol),
intent(in) :: umr
2121 real(r8),
dimension(mgncol),
intent(in) :: ums
2123 real(r8),
dimension(mgncol),
intent(in) :: rho
2127 real(r8),
dimension(mgncol),
intent(in) :: lamr
2128 real(r8),
dimension(mgncol),
intent(in) :: n0r
2131 real(r8),
dimension(mgncol),
intent(in) :: lams
2132 real(r8),
dimension(mgncol),
intent(in) :: n0s
2134 real(r8),
dimension(mgncol),
intent(out) :: psacr
2136 real(r8) :: cons31, tx1, tx2, tx3, tx4, tx5
2139 cons31 = pi*pi*ecr*rhosn
2143 if (qsic(i) >= 0.1e-3_r8 .and. qric(i) >= 0.1e-3_r8)
then
2144 tx1 = 1.2_r8*umr(i) - 0.95_r8*ums(i)
2145 tx1 = sqrt(tx1*tx1+0.08_r8*ums(i)*umr(i))
2149 tx5 = tx4 * tx4 * tx3
2151 psacr(i) = cons31 * tx1 * rho(i) * n0r(i) * n0s(i) * tx5 &
2152 * (5.0_r8*tx4+tx3*(tx2+tx2+0.5_r8*tx3))
2172 psacwg, npsacwg, mgncol)
2174 integer,
intent(in) :: mgncol
2177 real(r8),
dimension(mgncol),
intent(in) :: qgic
2178 real(r8),
dimension(mgncol),
intent(in) :: qcic
2180 real(r8),
dimension(mgncol),
intent(in) :: ncic
2182 real(r8),
dimension(mgncol),
intent(in) :: rho
2185 real(r8),
dimension(mgncol),
intent(in) :: lamg
2186 real(r8),
dimension(mgncol),
intent(in) :: n0g
2190 real(r8),
intent(in) :: bg
2191 real(r8),
dimension(mgncol),
intent(in) :: agn
2194 real(r8),
dimension(mgncol),
intent(out) :: psacwg
2195 real(r8),
dimension(mgncol),
intent(out) :: npsacwg
2197 real(r8) :: cons, tx1
2200 cons = gamma(bg+three) * pi/four * ecid
2204 if (qgic(i) >= 1.e-8_r8 .and. qcic(i) >= qsmall)
then
2206 tx1 = cons*agn(i)*rho(i)*n0g(i) / lamg(i)**(bg+three)
2208 psacwg(i) = tx1 * qcic(i)
2209 npsacwg(i) = tx1 * ncic(i)
2220subroutine graupel_riming_liquid_snow(psacws,qsic,qcic,nsic,rho,rhosn,rhog,asn,lams,n0s,dtime, &
2221 pgsacw,nscng,mgncol)
2223 integer,
intent(in) :: mgncol
2226 real(r8),
dimension(mgncol),
intent(inout) :: psacws
2228 real(r8),
dimension(mgncol),
intent(in) :: qsic
2229 real(r8),
dimension(mgncol),
intent(in) :: qcic
2230 real(r8),
dimension(mgncol),
intent(in) :: nsic
2232 real(r8),
dimension(mgncol),
intent(in) :: rho
2233 real(r8),
intent(in) :: rhosn
2234 real(r8),
intent(in) :: rhog
2236 real(r8),
dimension(mgncol),
intent(in) :: asn
2239 real(r8),
dimension(mgncol),
intent(in) :: lams
2240 real(r8),
dimension(mgncol),
intent(in) :: n0s
2242 real(r8),
intent(in) :: dtime
2245 real(r8),
dimension(mgncol),
intent(out) :: pgsacw
2246 real(r8),
dimension(mgncol),
intent(out) :: nscng
2257 rhosu = 85000._r8/(ra * tmelt)
2261 cons=4._r8 *2._r8 *3._r8 *rhosu*pi*ecid*ecid*gamma_2bs_plus2/(8._r8*(rhog-rhosn))
2263 if (psacws(i).gt.0._r8 .and. qsic(i).GE.0.1e-3_r8 .AND. qcic(i).GE.0.5e-3_r8)
then
2269 pgsacw(i) = min(psacws(i), cons*dtime*n0s(i)*qcic(i)*qcic(i)* &
2270 asn(i)*asn(i)/ (rho(i)*lams(i)**(bs+bs+two)))
2277 dum= max(rhosn/(rhog-rhosn)*pgsacw(i), zero)
2280 nscng(i) = dum/mg0*rho(i)
2282 nscng(i) = min(nscng(i),nsic(i)/dtime)
2285 psacws(i) = psacws(i) - pgsacw(i)
2298subroutine graupel_collecting_rain(qric,qgic,umg,umr,ung,unr,rho,n0r,lamr,n0g,lamg,&
2299 pracg,npracg,mgncol)
2301 integer,
intent(in) :: mgncol
2304 real(r8),
dimension(mgncol),
intent(in) :: qric
2305 real(r8),
dimension(mgncol),
intent(in) :: qgic
2308 real(r8),
dimension(mgncol),
intent(in) :: umg
2309 real(r8),
dimension(mgncol),
intent(in) :: umr
2312 real(r8),
dimension(mgncol),
intent(in) :: ung
2313 real(r8),
dimension(mgncol),
intent(in) :: unr
2315 real(r8),
dimension(mgncol),
intent(in) :: rho
2318 real(r8),
dimension(mgncol),
intent(in) :: n0r
2319 real(r8),
dimension(mgncol),
intent(in) :: lamr
2322 real(r8),
dimension(mgncol),
intent(in) :: n0g
2323 real(r8),
dimension(mgncol),
intent(in) :: lamg
2327 real(r8),
dimension(mgncol),
intent(out) :: pracg
2328 real(r8),
dimension(mgncol),
intent(out) :: npracg
2337 real(r8) :: dum, tx1, tx2, tx3, tx4, tx5, tx6
2339 cons41 = pi*pi*ecr*rhow
2344 if (qric(i) >= 1.e-8_r8 .and. qgic(i) >= 1.e-8_r8)
then
2347 tx1 = 1.2_r8*umr(i) - 0.95_r8*umg(i)
2348 tx1 = sqrt(tx1*tx1+0.08_r8*umg(i)*umr(i))
2349 tx2 = 1.0_r8 / lamr(i)
2350 tx3 = 1.0_r8 / lamg(i)
2352 tx5 = tx4 * tx4 * tx3
2353 tx6 = rho(i) * n0r(i) * n0g(i)
2356 pracg(i) = cons41 * tx1 * tx6 * tx5 * (5.0*tx4+tx3*(tx2+tx2+0.5*tx3))
2368 dum = pracg(i) / 5.2e-7_r8
2370 tx1 = unr(i) - ung(i)
2371 tx1 = sqrt(1.7_r8 * tx1 * tx1 + 0.3_r8*unr(i)*ung(i))
2374 npracg(i) = cons32 * tx1 * tx6 * tx4 * (tx2*(tx2+tx3)+tx3*tx3)
2385 npracg(i) = npracg(i) - dum
2401 lams,n0r,lamr,dtime,pgracs,ngracs,mgncol)
2403 integer,
intent(in) :: mgncol
2406 real(r8),
dimension(mgncol),
intent(inout) :: pracs
2407 real(r8),
dimension(mgncol),
intent(inout) :: npracs
2408 real(r8),
dimension(mgncol),
intent(inout) :: psacr
2411 real(r8),
dimension(mgncol),
intent(in) :: qsic
2412 real(r8),
dimension(mgncol),
intent(in) :: qric
2414 real(r8),
dimension(mgncol),
intent(in) :: nric
2415 real(r8),
dimension(mgncol),
intent(in) :: nsic
2418 real(r8),
dimension(mgncol),
intent(in) :: n0s
2419 real(r8),
dimension(mgncol),
intent(in) :: lams
2422 real(r8),
dimension(mgncol),
intent(in) :: n0r
2423 real(r8),
dimension(mgncol),
intent(in) :: lamr
2425 real(r8),
intent(in) :: dtime
2428 real(r8),
dimension(mgncol),
intent(out) :: pgracs
2429 real(r8),
dimension(mgncol),
intent(out) :: ngracs
2437 real(r8) :: dum,fmult,tx1,tx2
2439 cons18 = rhosn*rhosn
2446 if (pracs(i) > zero .and. qsic(i) >= 0.1e-3_r8 .and. qric(i) >= 0.1e-3_r8)
then
2450 tx1 = four / lams(i)
2451 tx2 = four / lamr(i)
2452 tx1 = tx1 * tx1 * tx1
2453 tx2 = tx2 * tx2 * tx2
2454 dum = cons18 * tx1 * tx1
2455 dum = one - max(zero, min(one, dum / (dum + cons19 * tx2 * tx2)))
2466 pgracs(i) = dum * pracs(i)
2467 ngracs(i) = dum * npracs(i)
2469 ngracs(i) = min(ngracs(i),nric(i)/dtime)
2470 ngracs(i) = min(ngracs(i),nsic(i)/dtime)
2473 pracs(i) = pracs(i) - pgracs(i)
2474 npracs(i) = npracs(i) - ngracs(i)
2478 psacr(i) = psacr(i) * dum
2493 qmultg,nmultg,qmultrg,nmultrg,mgncol)
2495 integer,
intent(in) :: mgncol
2497 real(r8),
dimension(mgncol),
intent(in) :: t
2500 real(r8),
dimension(mgncol),
intent(in) :: qcic
2501 real(r8),
dimension(mgncol),
intent(in) :: qric
2502 real(r8),
dimension(mgncol),
intent(in) :: qgic
2505 real(r8),
dimension(mgncol),
intent(inout) :: psacwg
2506 real(r8),
dimension(mgncol),
intent(inout) :: pracg
2509 real(r8),
dimension(mgncol),
intent(out) :: qmultg
2510 real(r8),
dimension(mgncol),
intent(out) :: nmultg
2511 real(r8),
dimension(mgncol),
intent(out) :: qmultrg
2512 real(r8),
dimension(mgncol),
intent(out) :: nmultrg
2520 real(r8) :: tm_3,tm_5,tm_8
2522 tm_3 = tmelt - 3._r8
2523 tm_5 = tmelt - 5._r8
2524 tm_8 = tmelt - 8._r8
2536 if (qgic(i) >= 0.1e-3_r8)
then
2537 if (qcic(i) >= 0.5e-3_r8 .or. qric(i) >= 0.1e-3_r8)
then
2538 if (psacwg(i) > zero .or. pracg(i) > zero)
then
2539 if (t(i) < tm_3 .and. t(i) > tm_8)
then
2540 if (t(i) > tm_3)
then
2542 else if (t(i) <= tm_3 .and. t(i) > tm_5)
then
2543 fmult = (tm_3-t(i)) * 0.5
2544 else if (t(i) >= tm_8 .and. t(i) <= tm_5)
then
2545 fmult = (t(i)-tm_8) * (one/three)
2546 else if (t(i) < tm_8)
then
2554 if (psacwg(i) > zero)
then
2555 nmultg(i) = 35.e4_r8*psacwg(i)*fmult*1000._r8
2556 qmultg(i) = nmultg(i)*mmult
2561 qmultg(i) = min(qmultg(i),psacwg(i))
2562 psacwg(i) = psacwg(i) - qmultg(i)
2574 if (pracg(i) > zero)
then
2575 nmultrg(i) = 35.e4*pracg(i)*fmult*1000._r8
2576 qmultrg(i) = nmultrg(i)*mmult
2581 qmultrg(i) = min(qmultrg(i),pracg(i))
2582 pracg(i) = pracg(i) - qmultrg(i)
2700 real(r8),
intent(in) :: lim
2711 REAL(r8),
intent(in) :: muice, x
2712 REAL(r8) :: xog, kg, alfa, auxx
2713 alfa = min(max(muice+1._r8, 1._r8), 20._r8)
2715 xog = log(alfa -0.3068_r8)
2716 kg = 1.44818_r8*(alfa**0.5357_r8)
2717 auxx = max(min(kg*(log(x)-xog), 30._r8), -30._r8)
elemental real(r8) function var_coef_r8(relvar, a)
Finds a coefficient for process rates based on the relative variance of cloud water.
elemental real(r8) function var_coef_integer(relvar, a)
Finds a coefficient for process rates based on the relative variance of cloud water.
subroutine, public ice_autoconversion(t, qiic, lami, n0i, dcs, ac_time, prci, nprci, mgncol)
Autoconversion of cloud ice to snow similar to Ferrier (1994)
subroutine size_dist_param_liq_vect(props, qcic, ncic, rho, pgam, lamc, mgncol)
This subroutine gets cloud droplet size distribution parameters.
subroutine, public graupel_rain_riming_snow(pracs, npracs, psacr, qsic, qric, nric, nsic, n0s, lams, n0r, lamr, dtime, pgracs, ngracs, mgncol)
Rain riming snow to graupel.
subroutine, public liu_liq_autoconversion(pgam, qc, nc, qr, rho, relvar, au, nprc, nprc1, mgncol)
Anning Cheng 10/5/2017 add Liu et al. autoconversion.
subroutine, public bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, qcic, qsic, lams, n0s, bergs, mgncol)
bergeron process - evaporation of droplets and deposition onto snow
subroutine, public graupel_riming_liquid_snow(psacws, qsic, qcic, nsic, rho, rhosn, rhog, asn, lams, n0s, dtime, pgsacw, nscng, mgncol)
Conversion of rimed cloud water onto snow to graupel/hail.
pure logical function limiter_is_on(lim)
subroutine, public secondary_ice_production(t, psacws, msacwi, nsacwi, mgncol)
add secondary ice production due to accretion of droplets by snow
subroutine, public sb2001v2_accre_cld_water_rain(qc, nc, qr, rho, relvar, pra, npra, mgncol)
subroutine, public evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, pre, prds, am_evp_st, mgncol)
calculate evaporation/sublimation of rain and snow
subroutine, public graupel_rime_splintering(t, qcic, qric, qgic, psacwg, pracg, qmultg, nmultg, qmultrg, nmultrg, mgncol)
Rime splintering.
subroutine, public contact_freezing(microp_uniform, t, p, rndst, nacon, pgam, lamc, qcic, ncic, relvar, mnucct, nnucct, mgncol, mdust)
contact freezing (-40<T<-3 C) (Young, 1974) with hooks into simulated dust dust size and number in mu...
subroutine, public kk2000_liq_autoconversion(microp_uniform, qcic, ncic, rho, relvar, prc, nprc, nprc1, mgncol)
autoconversion of cloud liquid water to rain formula from Khrouditnov and Kogan (2000),...
subroutine, public self_collection_rain(rho, qric, nric, nragg, mgncol)
Self-collection of rain drops from Beheng(1994)
subroutine, public graupel_collecting_rain(qric, qgic, umg, umr, ung, unr, rho, n0r, lamr, n0g, lamg, pracg, npracg, mgncol)
CHANGE IN Q,N COLLECTION RAIN BY GRAUPEL.
subroutine, public micro_mg_utils_init(kind, rair, rh2o, cpair, tmelt_in, latvap, latice, dcs)
Initialize module variables.
subroutine, public accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, lams, n0s, prai, nprai, mgncol)
Accretion of cloud ice by snow.
subroutine size_dist_param_basic_vect(props, qic, nic, lam, mgncol, n0)
This subroutine calculates.
subroutine, public ice_deposition_sublimation(t, qv, qi, ni, icldm, rho, dv, qvl, qvi, berg, vap_dep, ice_sublim, mgncol)
Initial ice deposition and sublimation loop. Run before the main loop This subroutine written by Pete...
subroutine, public evaporate_sublimate_precip_graupel(t, rho, dv, mu, sc, q, qvl, qvi, lcldm, precip_frac, arn, asn, agn, bg, qcic, qiic, qric, qsic, qgic, lamr, n0r, lams, n0s, lamg, n0g, pre, prds, prdg, am_evp_st, mgncol)
evaporation/sublimation of rain, snow and graupel
subroutine, public accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, pgam, lamc, lams, n0s, psacws, npsacws, mgncol)
accretion of cloud droplets onto snow/graupel
pure real(r8) function no_limiter()
subroutine, public heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr, mgncol)
heterogeneous freezing of rain drops
subroutine, public graupel_collecting_snow(qsic, qric, umr, ums, rho, lamr, n0r, lams, n0s, psacr, mgncol)
Collection of snow by rain to form graupel.
subroutine, public snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg, mgncol)
snow self-aggregation from passarelli, 1978, used by reisner, 1998
subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0)
This subroutine.
real(r8) function gamma_incomp(muice, x)
real(r8) elemental function, public avg_diameter(q, n, rho_air, rho_sub)
Finds the average diameter of particles given their density, and mass/number concentrations in the ai...
subroutine, public sb2001v2_liq_autoconversion(pgam, qc, nc, qr, rho, relvar, au, nprc, nprc1, mgncol)
This subroutine.
subroutine, public gmao_ice_autoconversion(t, qiic, niic, lami, n0i, dcs, ac_time, prci, nprci, mgncol)
GMAO ice autoconversion.
subroutine, public graupel_collecting_cld_water(qgic, qcic, ncic, rho, n0g, lamg, bg, agn, psacwg, npsacwg, mgncol)
Collection of cloud water by graupel.
elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0)
ice routine for getting size distribution parameters.
elemental subroutine size_dist_param_basic_line(props, qic, nic, lam, n0)
Basic routine for getting size distribution parameters.
subroutine, public accrete_cloud_water_rain(microp_uniform, qric, qcic, ncic, relvar, accre_enhan, pra, npra, mgncol)
accretion of cloud liquid water by rain formula from Khrouditnov and Kogan (2000)
subroutine, public accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, lamr, n0r, lams, n0s, pracs, npracs, mgncol)
accretion of rain water by snow
subroutine, public immersion_freezing(microp_uniform, t, pgam, lamc, qcic, ncic, relvar, mnuccc, nnuccc, mgncol)
immersion freezing (Bigg, 1953)
elemental subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc)
get cloud droplet size distribution parameters
type(mghydrometeorprops) function newmghydrometeorprops(rho, eff_dim, lambda_bounds, min_mean_mass)
Constructor for a constituent property object.