ERF
Energy Research and Forecasting: An Atmospheric Modeling Code
Functions/Subroutines | Variables
mp_wdm6 Module Reference

Functions/Subroutines

subroutine wdm6 (th, q, qc, qr, qi, qs, qg, nn, nc, nr, den, pii, p, delz, delt, g, cpd, cpv, ccn0, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, cliq, cice, psat, xland, rain, rainncv, snow, snowncv, sr, refl_10cm, diagflag, do_radar_ref, graupel, graupelncv, itimestep, has_reqc, has_reqi, has_reqs, re_cloud, re_ice, re_snow, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
 
subroutine wdm62d (t, q, qci, qrs, ncr, den, p, delz, delt, g, cpd, cpv, ccn0, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, cliq, cice, psat, lat, slmsk, rain, rainncv, sr, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte, snow, snowncv, graupel, graupelncv, microphysics_debug, diag_i_dbg, diag_j_dbg, rainonly, snowonly)
 
real(kind=kind_phys) function rgmma (x)
 
real(kind=kind_phys) function fpvs (t, ice, rd, rv, cvap, cliq, cice, hvap, hsub, psat, t0c)
 
subroutine wdm6init (den0, denr, dens, cl, cpv, ccn0, hail_opt, allowed_to_read)
 
subroutine slope_wdm6 (qrs, ncr, den, denfac, t, rslope, rslopeb, rslope2, rslope3, vt, vtn, its, ite, kts, kte)
 
subroutine slope_rain (qrs, ncr, den, denfac, t, rslope, rslopeb, rslope2, rslope3, vt, vtn, its, ite, kts, kte)
 
subroutine slope_snow (qrs, den, denfac, t, rslope, rslopeb, rslope2, rslope3, vt, its, ite, kts, kte)
 
subroutine slope_graup (qrs, den, denfac, t, rslope, rslopeb, rslope2, rslope3, vt, its, ite, kts, kte)
 
subroutine nislfv_rain_plmr (im, km, denl, denfacl, tkl, dzl, wwl, rql, rnl, precip, dt, id, iter, rid)
 
subroutine nislfv_rain_plm6 (im, km, denl, denfacl, tkl, dzl, wwl, rql, rql2, precip1, precip2, dt, id, iter)
 
subroutine refl10cm_wdm6 (qv1d, qr1d, nr1d, qs1d, qg1d, t1d, p1d, dBZ, kts, kte, ii, jj)
 
subroutine effectrad_wdm6 (t, qc, nc, qi, qs, rho, qmin, t0c, re_qc, re_qi, re_qs, kts, kte, ii, jj)
 
subroutine, public mp_wdm6_init (den0, denr, dens, cl, cpv, ccn0, hail_opt, errmsg, errflg)
 
subroutine, public mp_wdm6_run (t, q, qc, qi, qr, qs, qg, nn, nc, nr, den, p, delz, delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, cliq, cice, psat, ccn0, xland, rain, rainncv, sr, snow, snowncv, graupel, graupelncv, rainonly, snowonly, its, ite, kts, kte, microphysics_debug, diag_i_dbg, diag_j_dbg, diag_k_raw_base, errmsg, errflg)
 

Variables

integer, parameter kind_phys = c_double
 
real(kind=kind_phys), parameter, private dtcldcr = 120.
 
real(kind=kind_phys), parameter, private n0r = 8.e6
 
real(kind=kind_phys), parameter, private n0s = 2.e6
 
real(kind=kind_phys), parameter, private n0smax = 1.e11
 
real(kind=kind_phys), parameter, private dens = 100.0
 
real(kind=kind_phys), parameter, private alpha = .12
 
real(kind=kind_phys), parameter, private avtr = 841.9
 
real(kind=kind_phys), parameter, private bvtr = 0.8
 
real(kind=kind_phys), parameter, private avts = 11.72
 
real(kind=kind_phys), parameter, private bvts = .41
 
real(kind=kind_phys), parameter, private lamdacmax = 5.e5
 
real(kind=kind_phys), parameter, private lamdacmin = 2.e4
 
real(kind=kind_phys), parameter, private lamdarmax = 5.e4
 
real(kind=kind_phys), parameter, private lamdarmin = 2.e3
 
real(kind=kind_phys), parameter, private lamdasmax = 1.e5
 
real(kind=kind_phys), parameter, private r0 = .8e-5
 
real(kind=kind_phys), parameter, private peaut = .55
 
real(kind=kind_phys), parameter, private xncr = 3.e8
 
real(kind=kind_phys), parameter, private xncr0 = 5.e7
 
real(kind=kind_phys), parameter, private xncr1 = 5.e8
 
real(kind=kind_phys), parameter, private xmyu = 1.718e-5
 
real(kind=kind_phys), parameter, private dicon = 11.9
 
real(kind=kind_phys), parameter, private dimax = 500.e-6
 
real(kind=kind_phys), parameter, private pfrz1 = 100.
 
real(kind=kind_phys), parameter, private pfrz2 = 0.66
 
real(kind=kind_phys), parameter, private qcrmin = 1.e-9
 
real(kind=kind_phys), parameter, private ncmin = 1.e1
 
real(kind=kind_phys), parameter, private nrmin = 1.e-2
 
real(kind=kind_phys), parameter, private eacrc = 1.0
 
real(kind=kind_phys), parameter, private qs0 = 6.e-4
 
real(kind=kind_phys), parameter, private satmax = 1.0048
 
real(kind=kind_phys), parameter, private actk = 0.6
 
real(kind=kind_phys), parameter, private actr = 1.5
 
real(kind=kind_phys), parameter, private ncrk1 = 3.03e3
 
real(kind=kind_phys), parameter, private ncrk2 = 2.59e15
 
real(kind=kind_phys), parameter, private di100 = 1.e-4
 
real(kind=kind_phys), parameter, private di600 = 6.e-4
 
real(kind=kind_phys), parameter, private di2000 = 2000.e-6
 
real(kind=kind_phys), parameter, private di82 = 82.e-6
 
real(kind=kind_phys), parameter, private di15 = 15.e-6
 
real(kind=kind_phys), save qc0
 
real(kind=kind_phys), save qc1
 
real(kind=kind_phys), save qck1
 
real(kind=kind_phys), save pidnc
 
real(kind=kind_phys), save bvtr1
 
real(kind=kind_phys), save bvtr2
 
real(kind=kind_phys), save bvtr3
 
real(kind=kind_phys), save bvtr4
 
real(kind=kind_phys), save bvtr5
 
real(kind=kind_phys), save bvtr6
 
real(kind=kind_phys), save bvtr7
 
real(kind=kind_phys), save bvtr2o5
 
real(kind=kind_phys), save bvtr3o5
 
real(kind=kind_phys), save g1pbr
 
real(kind=kind_phys), save g2pbr
 
real(kind=kind_phys), save g3pbr
 
real(kind=kind_phys), save g4pbr
 
real(kind=kind_phys), save g5pbr
 
real(kind=kind_phys), save g6pbr
 
real(kind=kind_phys), save g7pbr
 
real(kind=kind_phys), save g5pbro2
 
real(kind=kind_phys), save g7pbro2
 
real(kind=kind_phys), save pi
 
real(kind=kind_phys), save pvtr
 
real(kind=kind_phys), save pvtrn
 
real(kind=kind_phys), save eacrr
 
real(kind=kind_phys), save pacrr
 
real(kind=kind_phys), save pidn0r
 
real(kind=kind_phys), save pidnr
 
real(kind=kind_phys), save precr1
 
real(kind=kind_phys), save precr2
 
real(kind=kind_phys), save xmmax
 
real(kind=kind_phys), save roqimax
 
real(kind=kind_phys), save bvts1
 
real(kind=kind_phys), save bvts2
 
real(kind=kind_phys), save bvts3
 
real(kind=kind_phys), save bvts4
 
real(kind=kind_phys), save g1pbs
 
real(kind=kind_phys), save g3pbs
 
real(kind=kind_phys), save g4pbs
 
real(kind=kind_phys), save g5pbso2
 
real(kind=kind_phys), save pvts
 
real(kind=kind_phys), save pacrs
 
real(kind=kind_phys), save precs1
 
real(kind=kind_phys), save precs2
 
real(kind=kind_phys), save pidn0s
 
real(kind=kind_phys), save xlv1
 
real(kind=kind_phys), save pacrc
 
real(kind=kind_phys), save bvtg1
 
real(kind=kind_phys), save bvtg2
 
real(kind=kind_phys), save bvtg3
 
real(kind=kind_phys), save bvtg4
 
real(kind=kind_phys), save g1pbg
 
real(kind=kind_phys), save g3pbg
 
real(kind=kind_phys), save g4pbg
 
real(kind=kind_phys), save g5pbgo2
 
real(kind=kind_phys), save pvtg
 
real(kind=kind_phys), save pacrg
 
real(kind=kind_phys), save precg1
 
real(kind=kind_phys), save precg2
 
real(kind=kind_phys), save pidn0g
 
real(kind=kind_phys), save n0g
 
real(kind=kind_phys), save avtg
 
real(kind=kind_phys), save bvtg
 
real(kind=kind_phys), save deng
 
real(kind=kind_phys), save lamdagmax
 
real(kind=kind_phys), save rslopecmax
 
real(kind=kind_phys), save rslopec2max
 
real(kind=kind_phys), save rslopec3max
 
real(kind=kind_phys), save rslopermax
 
real(kind=kind_phys), save rslopesmax
 
real(kind=kind_phys), save rslopegmax
 
real(kind=kind_phys), save rsloperbmax
 
real(kind=kind_phys), save rslopesbmax
 
real(kind=kind_phys), save rslopegbmax
 
real(kind=kind_phys), save rsloper2max
 
real(kind=kind_phys), save rslopes2max
 
real(kind=kind_phys), save rslopeg2max
 
real(kind=kind_phys), save rsloper3max
 
real(kind=kind_phys), save rslopes3max
 
real(kind=kind_phys), save rslopeg3max
 

Function/Subroutine Documentation

◆ effectrad_wdm6()

subroutine mp_wdm6::effectrad_wdm6 ( real(kind=kind_phys), dimension( kts:kte ), intent(in)  t,
real(kind=kind_phys), dimension( kts:kte ), intent(in)  qc,
real(kind=kind_phys), dimension( kts:kte ), intent(in)  nc,
real(kind=kind_phys), dimension( kts:kte ), intent(in)  qi,
real(kind=kind_phys), dimension( kts:kte ), intent(in)  qs,
real(kind=kind_phys), dimension( kts:kte ), intent(in)  rho,
real(kind=kind_phys), intent(in)  qmin,
real(kind=kind_phys), intent(in)  t0c,
real(kind=kind_phys), dimension( kts:kte ), intent(inout)  re_qc,
real(kind=kind_phys), dimension( kts:kte ), intent(inout)  re_qi,
real(kind=kind_phys), dimension( kts:kte ), intent(inout)  re_qs,
integer, intent(in)  kts,
integer, intent(in)  kte,
integer, intent(in)  ii,
integer, intent(in)  jj 
)
private
3284 
3285 
3286 
3287 
3288 
3289 
3290 
3291 
3292 
3293 
3294  implicit none
3295 
3296 
3297  integer, intent(in) :: kts, kte, ii, jj
3298  real(kind=kind_phys), intent(in) :: qmin
3299  real(kind=kind_phys), intent(in) :: t0c
3300  real(kind=kind_phys), dimension( kts:kte ), intent(in):: t
3301  real(kind=kind_phys), dimension( kts:kte ), intent(in):: qc
3302  real(kind=kind_phys), dimension( kts:kte ), intent(in):: nc
3303  real(kind=kind_phys), dimension( kts:kte ), intent(in):: qi
3304  real(kind=kind_phys), dimension( kts:kte ), intent(in):: qs
3305  real(kind=kind_phys), dimension( kts:kte ), intent(in):: rho
3306  real(kind=kind_phys), dimension( kts:kte ), intent(inout):: re_qc
3307  real(kind=kind_phys), dimension( kts:kte ), intent(inout):: re_qi
3308  real(kind=kind_phys), dimension( kts:kte ), intent(inout):: re_qs
3309 
3310  integer:: i,k
3311  integer :: inu_c
3312  real(kind=kind_phys), dimension( kts:kte ):: ni
3313  real(kind=kind_phys), dimension( kts:kte ):: rqc
3314  real(kind=kind_phys), dimension( kts:kte ):: rnc
3315  real(kind=kind_phys), dimension( kts:kte ):: rqi
3316  real(kind=kind_phys), dimension( kts:kte ):: rni
3317  real(kind=kind_phys), dimension( kts:kte ):: rqs
3318  real(kind=kind_phys) :: cdm2
3319  real(kind=kind_phys) :: temp
3320  real(kind=kind_phys) :: supcol, n0sfac, lamdas
3321  real(kind=kind_phys) :: diai
3322  real(kind=kind_phys) :: lamc
3323  logical :: has_qc, has_qi, has_qs
3324 
3325  real(kind=kind_phys), parameter :: r1 = 1.e-12
3326  real(kind=kind_phys), parameter :: r2 = 1.e-6
3327  real(kind=kind_phys), parameter :: pi = 3.1415926536
3328  real(kind=kind_phys), parameter :: bm_r = 3.0
3329  real(kind=kind_phys), parameter :: obmr = 1.0/bm_r
3330  real(kind=kind_phys), parameter :: cdm = 5./3.
3331 
3332  has_qc = .false.
3333  has_qi = .false.
3334  has_qs = .false.
3335 
3336  cdm2 = rgmma(cdm)
3337 
3338  do k=kts,kte
3339 
3340  rqc(k) = max(r1, qc(k)*rho(k))
3341  rnc(k) = max(r2, nc(k)*rho(k))
3342  if (rqc(k).gt.r1 .and. rnc(k).gt.r2) has_qc = .true.
3343 
3344  rqi(k) = max(r1, qi(k)*rho(k))
3345  temp = (rho(k)*max(qi(k),qmin))
3346  temp = sqrt(sqrt(temp*temp*temp))
3347  ni(k) = min(max(5.38e7*temp,1.e3),1.e6)
3348  rni(k)= max(r2, ni(k)*rho(k))
3349  if (rqi(k).gt.r1 .and. rni(k).gt.r2) has_qi = .true.
3350 
3351  rqs(k) = max(r1, qs(k)*rho(k))
3352  if (rqs(k).gt.r1) has_qs = .true.
3353  enddo
3354 
3355  if (has_qc) then
3356  do k=kts,kte
3357  if (rqc(k).le.r1 .or. rnc(k).le.r2) cycle
3358  lamc = 2.*cdm2*(pidnc*nc(k)/rqc(k))**obmr
3359  re_qc(k) = max(2.51e-6,min(sngl(1.0d0/lamc),50.e-6))
3360  enddo
3361  endif
3362 
3363  if (has_qi) then
3364  do k=kts,kte
3365  if (rqi(k).le.r1 .or. rni(k).le.r2) cycle
3366  diai = 11.9*sqrt(rqi(k)/ni(k))
3367  re_qi(k) = max(10.01e-6,min(0.75*0.163*diai,125.e-6))
3368  enddo
3369  endif
3370 
3371  if (has_qs) then
3372  do k=kts,kte
3373  if (rqs(k).le.r1) cycle
3374  supcol = t0c-t(k)
3375  n0sfac = max(min(exp(alpha*supcol),n0smax/n0s),1.)
3376  lamdas = sqrt(sqrt(pidn0s*n0sfac/rqs(k)))
3377  re_qs(k) = max(25.e-6,min(0.5*(1./lamdas),999.e-6))
3378  enddo
3379  endif
3380 

Referenced by wdm6().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ fpvs()

real(kind=kind_phys) function mp_wdm6::fpvs ( real(kind=kind_phys)  t,
integer  ice,
real(kind=kind_phys)  rd,
real(kind=kind_phys)  rv,
real(kind=kind_phys)  cvap,
real(kind=kind_phys)  cliq,
real(kind=kind_phys)  cice,
real(kind=kind_phys)  hvap,
real(kind=kind_phys)  hsub,
real(kind=kind_phys)  psat,
real(kind=kind_phys)  t0c 
)
private
2209 
2210  implicit none
2211 
2212  REAL(kind=kind_phys) t,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c,dldt,xa,xb,dldti, &
2213  xai,xbi,ttp,tr
2214  INTEGER ice
2215 
2216  ttp=t0c+0.01_kind_phys
2217  dldt=cvap-cliq
2218  xa=-dldt/rv
2219  xb=xa+hvap/(rv*ttp)
2220  dldti=cvap-cice
2221  xai=-dldti/rv
2222  xbi=xai+hsub/(rv*ttp)
2223  tr=ttp/t
2224  if(t.lt.ttp .and. ice.eq.1) then
2225  fpvs=psat*(tr**xai)*exp(xbi*(1._kind_phys-tr))
2226  else
2227  fpvs=psat*(tr**xa)*exp(xb*(1._kind_phys-tr))
2228  endif
2229 

◆ mp_wdm6_init()

subroutine, public mp_wdm6::mp_wdm6_init ( real(kind=kind_phys), intent(in)  den0,
real(kind=kind_phys), intent(in)  denr,
real(kind=kind_phys), intent(in)  dens,
real(kind=kind_phys), intent(in)  cl,
real(kind=kind_phys), intent(in)  cpv,
real(kind=kind_phys), intent(in)  ccn0,
integer, intent(in)  hail_opt,
character(len=*), intent(out)  errmsg,
integer, intent(out)  errflg 
)
3389  implicit none
3390  real(kind=kind_phys), intent(in) :: den0, denr, dens, cl, cpv, ccn0
3391  integer, intent(in) :: hail_opt
3392  character(len=*), intent(out) :: errmsg
3393  integer, intent(out) :: errflg
3394  logical :: allowed_to_read
3395 
3396  allowed_to_read = .true.
3397  call wdm6init(den0, denr, dens, cl, cpv, ccn0, hail_opt, allowed_to_read)
3398 
3399  errmsg = ''
3400  errflg = 0

Referenced by wdm6_isohelper::mp_wdm6_init_c().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ mp_wdm6_run()

subroutine, public mp_wdm6::mp_wdm6_run ( real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  t,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  q,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  qc,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  qi,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  qr,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  qs,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  qg,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  nn,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  nc,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(inout)  nr,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(in)  den,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(in)  p,
real(kind=kind_phys), dimension(its:ite, kts:kte), intent(in)  delz,
real(kind=kind_phys), intent(in)  delt,
real(kind=kind_phys), intent(in)  g,
real(kind=kind_phys), intent(in)  cpd,
real(kind=kind_phys), intent(in)  cpv,
real(kind=kind_phys), intent(in)  rd,
real(kind=kind_phys), intent(in)  rv,
real(kind=kind_phys), intent(in)  t0c,
real(kind=kind_phys), intent(in)  ep1,
real(kind=kind_phys), intent(in)  ep2,
real(kind=kind_phys), intent(in)  qmin,
real(kind=kind_phys), intent(in)  xls,
real(kind=kind_phys), intent(in)  xlv0,
real(kind=kind_phys), intent(in)  xlf0,
real(kind=kind_phys), intent(in)  den0,
real(kind=kind_phys), intent(in)  denr,
real(kind=kind_phys), intent(in)  cliq,
real(kind=kind_phys), intent(in)  cice,
real(kind=kind_phys), intent(in)  psat,
real(kind=kind_phys), intent(in)  ccn0,
real(kind=kind_phys), dimension(its:ite), intent(in)  xland,
real(kind=kind_phys), dimension(its:ite), intent(inout)  rain,
real(kind=kind_phys), dimension(its:ite), intent(inout)  rainncv,
real(kind=kind_phys), dimension(its:ite), intent(inout)  sr,
real(kind=kind_phys), dimension(its:ite), intent(inout)  snow,
real(kind=kind_phys), dimension(its:ite), intent(inout)  snowncv,
real(kind=kind_phys), dimension(its:ite), intent(inout)  graupel,
real(kind=kind_phys), dimension(its:ite), intent(inout)  graupelncv,
real(kind=kind_phys), dimension(its:ite), intent(inout)  rainonly,
real(kind=kind_phys), dimension(its:ite), intent(inout)  snowonly,
integer, intent(in)  its,
integer, intent(in)  ite,
integer, intent(in)  kts,
integer, intent(in)  kte,
integer, intent(in)  microphysics_debug,
integer, intent(in)  diag_i_dbg,
integer, intent(in)  diag_j_dbg,
integer, intent(in)  diag_k_raw_base,
character(len=*), intent(out)  errmsg,
integer, intent(out)  errflg 
)
3412  implicit none
3413 
3414  ! Input dimensions
3415  integer, intent(in) :: its, ite, kts, kte
3416  integer, intent(in) :: microphysics_debug, diag_i_dbg, diag_j_dbg, diag_k_raw_base
3417 
3418  ! Thermodynamic fields (inout)
3419  real(kind=kind_phys), intent(inout), dimension(its:ite, kts:kte) :: t, q, qc, qi, qr, qs, qg
3420  real(kind=kind_phys), intent(inout), dimension(its:ite, kts:kte) :: nn, nc, nr
3421 
3422  ! Input fields
3423  real(kind=kind_phys), intent(in), dimension(its:ite, kts:kte) :: den, p, delz
3424  real(kind=kind_phys), intent(in), dimension(its:ite) :: xland
3425 
3426  ! Scalar constants
3427  real(kind=kind_phys), intent(in) :: delt, g, cpd, cpv, rd, rv, t0c
3428  real(kind=kind_phys), intent(in) :: ep1, ep2, qmin, xls, xlv0, xlf0
3429  real(kind=kind_phys), intent(in) :: den0, denr, cliq, cice, psat, ccn0
3430 
3431  ! Output precipitation
3432  real(kind=kind_phys), intent(inout), dimension(its:ite) :: rain, rainncv, sr
3433  real(kind=kind_phys), intent(inout), dimension(its:ite) :: snow, snowncv, graupel, graupelncv
3434  real(kind=kind_phys), intent(inout), dimension(its:ite) :: rainonly, snowonly
3435 
3436  ! Error handling
3437  character(len=*), intent(out) :: errmsg
3438  integer, intent(out) :: errflg
3439 
3440  ! Local variables for calling wdm62D
3441  real(kind=kind_phys), dimension(its:ite, kts:kte, 2) :: qci_tmp ! qc, qi
3442  real(kind=kind_phys), dimension(its:ite, kts:kte, 3) :: qrs_tmp ! qr, qs, qg
3443  real(kind=kind_phys), dimension(its:ite, kts:kte, 3) :: ncr_tmp ! nn, nc, nr (reordered)
3444  integer :: ids, ide, jds, jde, kds, kde
3445  integer :: ims, ime, jms, jme, kms, kme
3446  integer :: jts, jte
3447  integer :: i, k
3448 
3449  ! Set dimensions (2D slice, so j dimension is 1)
3450  ids = its
3451  ide = ite
3452  jds = 1
3453  jde = 1
3454  kds = kts
3455  kde = kte
3456 
3457  ims = its
3458  ime = ite
3459  jms = 1
3460  jme = 1
3461  kms = kts
3462  kme = kte
3463 
3464  jts = 1
3465  jte = 1
3466 
3467  ! Pack arrays into WDM6 format
3468  do k = kts, kte
3469  do i = its, ite
3470  qci_tmp(i,k,1) = qc(i,k)
3471  qci_tmp(i,k,2) = qi(i,k)
3472  qrs_tmp(i,k,1) = qr(i,k)
3473  qrs_tmp(i,k,2) = qs(i,k)
3474  qrs_tmp(i,k,3) = qg(i,k)
3475  ! WDM6 expects: ncr(i,k,1)=nn, ncr(i,k,2)=nc, ncr(i,k,3)=nr
3476  ncr_tmp(i,k,1) = nn(i,k)
3477  ncr_tmp(i,k,2) = nc(i,k)
3478  ncr_tmp(i,k,3) = nr(i,k)
3479  end do
3480  end do
3481 
3482  ! xland is passed straight through to wdm62D's slmsk dummy. Do NOT
3483  ! rescale it here. wdm62D's only use of slmsk is the maritime/continental
3484  ! selection at :628-633,
3485  ! if(slmsk(i).eq.2) then ; qcr(i,:) = qc0 ; else ; qcr(i,:) = qc1
3486  ! which tests against the WRF xland encoding (1=land, 2=water), and the
3487  ! upstream wdm6 driver at :255 supplies it unconverted as xland(ims,j).
3488  ! An earlier version of this wrapper mapped xland to a 1=land/0=water
3489  ! slmsk, which made .eq.2 unreachable and forced the continental qc1
3490  ! everywhere, including over water. Nothing in wdm62D reads slmsk except
3491  ! that test, so there is no other convention to satisfy.
3492 
3493  ! Call wdm62D
3494  call wdm62d(t, q, qci_tmp, qrs_tmp, ncr_tmp, den, p, delz, &
3495  delt, g, cpd, cpv, ccn0, rd, rv, t0c, &
3496  ep1, ep2, qmin, &
3497  xls, xlv0, xlf0, den0, denr, &
3498  cliq, cice, psat, &
3499  diag_j_dbg, &
3500  xland, &
3501  rain, rainncv, &
3502  sr, &
3503  ids, ide, jds, jde, kds, kde, &
3504  ims, ime, jms, jme, kms, kme, &
3505  its, ite, jts, jte, kts, kte, &
3506  snow, snowncv, &
3507  graupel, graupelncv, &
3508  microphysics_debug, diag_i_dbg, diag_j_dbg, &
3509  rainonly=rainonly, snowonly=snowonly)
3510 
3511  ! Unpack arrays from WDM6 format
3512  do k = kts, kte
3513  do i = its, ite
3514  qc(i,k) = qci_tmp(i,k,1)
3515  qi(i,k) = qci_tmp(i,k,2)
3516  qr(i,k) = qrs_tmp(i,k,1)
3517  qs(i,k) = qrs_tmp(i,k,2)
3518  qg(i,k) = qrs_tmp(i,k,3)
3519  nn(i,k) = ncr_tmp(i,k,1)
3520  nc(i,k) = ncr_tmp(i,k,2)
3521  nr(i,k) = ncr_tmp(i,k,3)
3522  end do
3523  end do
3524 
3525  errmsg = ''
3526  errflg = 0

Referenced by wdm6_isohelper::mp_wdm6_run_c().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ nislfv_rain_plm6()

subroutine mp_wdm6::nislfv_rain_plm6 ( integer  im,
integer  km,
real(kind=kind_phys), dimension(im,km)  denl,
real(kind=kind_phys), dimension(im,km)  denfacl,
real(kind=kind_phys), dimension(im,km)  tkl,
real(kind=kind_phys), dimension(im,km)  dzl,
real(kind=kind_phys), dimension(im,km)  wwl,
real(kind=kind_phys), dimension(im,km)  rql,
real(kind=kind_phys), dimension(im,km)  rql2,
real(kind=kind_phys), dimension(im)  precip1,
real(kind=kind_phys), dimension(im)  precip2,
real(kind=kind_phys)  dt,
integer  id,
integer  iter 
)
private
2835 
2836 
2837 
2838 
2839 
2840 
2841 
2842 
2843 
2844 
2845 
2846 
2847 
2848 
2849 
2850 
2851 
2852 
2853 
2854 
2855 
2856  implicit none
2857  integer im,km,id
2858  real(kind=kind_phys) dt
2859  real(kind=kind_phys) dzl(im,km),wwl(im,km),rql(im,km),rql2(im,km),precip(im),precip1(im),precip2(im)
2860  real(kind=kind_phys) denl(im,km),denfacl(im,km),tkl(im,km)
2861 
2862  integer i,k,n,m,kk,kb,kt,iter,ist
2863  real(kind=kind_phys) tl,tl2,qql,dql,qqd
2864  real(kind=kind_phys) th,th2,qqh,dqh
2865  real(kind=kind_phys) zsum,qsum,dim,dip,c1,con1,fa1,fa2
2866  real(kind=kind_phys) allold, allnew, zz, dzamin, cflmax, decfl
2867  real(kind=kind_phys) dz(km), ww(km), qq(km), qq2(km), wd(km), wa(km), wa2(km), was(km)
2868  real(kind=kind_phys) den(km), denfac(km), tk(km)
2869  real(kind=kind_phys) wi(km+1), zi(km+1), za(km+1)
2870  real(kind=kind_phys) qn(km), qr(km),qr2(km),tmp(km),tmp1(km),tmp2(km),tmp3(km)
2871  real(kind=kind_phys) dza(km+1), qa(km+1), qa2(km+1),qmi(km+1), qpi(km+1)
2872 
2873  precip(:) = 0.0
2874  precip1(:) = 0.0
2875  precip2(:) = 0.0
2876 
2877  i_loop : do i=1,im
2878 
2879  dz(:) = dzl(i,:)
2880  qq(:) = rql(i,:)
2881  qq2(:) = rql2(i,:)
2882  ww(:) = wwl(i,:)
2883  den(:) = denl(i,:)
2884  denfac(:) = denfacl(i,:)
2885  tk(:) = tkl(i,:)
2886 
2887  allold = 0.0
2888  do k=1,km
2889  allold = allold + qq(k) + qq2(k)
2890  enddo
2891  if(allold.le.0.0) then
2892  cycle i_loop
2893  endif
2894 
2895 
2896  zi(1)=0.0
2897  do k=1,km
2898  zi(k+1) = zi(k)+dz(k)
2899  enddo
2900 
2901 
2902  wd(:) = ww(:)
2903  n=1
2904  100 continue
2905 
2906 
2907  wi(1) = ww(1)
2908  wi(km+1) = ww(km)
2909  do k=2,km
2910  wi(k) = (ww(k)*dz(k-1)+ww(k-1)*dz(k))/(dz(k-1)+dz(k))
2911  enddo
2912 
2913  fa1 = 9./16.
2914  fa2 = 1./16.
2915  wi(1) = ww(1)
2916  wi(2) = 0.5*(ww(2)+ww(1))
2917  do k=3,km-1
2918  wi(k) = fa1*(ww(k)+ww(k-1))-fa2*(ww(k+1)+ww(k-2))
2919  enddo
2920  wi(km) = 0.5*(ww(km)+ww(km-1))
2921  wi(km+1) = ww(km)
2922 
2923 
2924  do k=2,km
2925  if( ww(k).eq.0.0 ) wi(k)=ww(k-1)
2926  enddo
2927 
2928 
2929  con1 = 0.05
2930  do k=km,1,-1
2931  decfl = (wi(k+1)-wi(k))*dt/dz(k)
2932  if( decfl .gt. con1 ) then
2933  wi(k) = wi(k+1) - con1*dz(k)/dt
2934  endif
2935  enddo
2936 
2937  do k=1,km+1
2938  za(k) = zi(k) - wi(k)*dt
2939  enddo
2940 
2941  do k=1,km
2942  dza(k) = za(k+1)-za(k)
2943  enddo
2944  dza(km+1) = zi(km+1) - za(km+1)
2945 
2946 
2947  do k=1,km
2948  qa(k) = qq(k)*dz(k)/dza(k)
2949  qa2(k) = qq2(k)*dz(k)/dza(k)
2950  qr(k) = qa(k)/den(k)
2951  qr2(k) = qa2(k)/den(k)
2952  enddo
2953  qa(km+1) = 0.0
2954  qa2(km+1) = 0.0
2955 
2956 
2957 
2958 
2959  if( n.le.iter ) then
2960  call slope_snow(qr,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa,1,1,1,km)
2961  call slope_graup(qr2,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa2,1,1,1,km)
2962  do k = 1, km
2963  tmp(k) = max((qr(k)+qr2(k)), 1.e-15)
2964  IF ( tmp(k) .gt. 1.e-15 ) THEN
2965  wa(k) = (wa(k)*qr(k) + wa2(k)*qr2(k))/tmp(k)
2966  ELSE
2967  wa(k) = 0.
2968  ENDIF
2969  enddo
2970  if( n.ge.2 ) wa(1:km)=0.5*(wa(1:km)+was(1:km))
2971  do k=1,km
2972 
2973 
2974 
2975 
2976 
2977  ww(k) = 0.5* ( wd(k)+wa(k) )
2978  enddo
2979  was(:) = wa(:)
2980  n=n+1
2981  go to 100
2982  endif
2983  ist_loop : do ist = 1, 2
2984  if (ist.eq.2) then
2985  qa(:) = qa2(:)
2986  endif
2987 
2988  precip(i) = 0.
2989 
2990 
2991  do k=2,km
2992  dip=(qa(k+1)-qa(k))/(dza(k+1)+dza(k))
2993  dim=(qa(k)-qa(k-1))/(dza(k-1)+dza(k))
2994  if( dip*dim.le.0.0 ) then
2995  qmi(k)=qa(k)
2996  qpi(k)=qa(k)
2997  else
2998  qpi(k)=qa(k)+0.5*(dip+dim)*dza(k)
2999  qmi(k)=2.0*qa(k)-qpi(k)
3000  if( qpi(k).lt.0.0 .or. qmi(k).lt.0.0 ) then
3001  qpi(k) = qa(k)
3002  qmi(k) = qa(k)
3003  endif
3004  endif
3005  enddo
3006  qpi(1)=qa(1)
3007  qmi(1)=qa(1)
3008  qmi(km+1)=qa(km+1)
3009  qpi(km+1)=qa(km+1)
3010 
3011 
3012  qn = 0.0
3013  kb=1
3014  kt=1
3015  intp : do k=1,km
3016  kb=max(kb-1,1)
3017  kt=max(kt-1,1)
3018 
3019  if( zi(k).ge.za(km+1) ) then
3020  exit intp
3021  else
3022  find_kb : do kk=kb,km
3023  if( zi(k).le.za(kk+1) ) then
3024  kb = kk
3025  exit find_kb
3026  else
3027  cycle find_kb
3028  endif
3029  enddo find_kb
3030  find_kt : do kk=kt,km
3031  if( zi(k+1).le.za(kk) ) then
3032  kt = kk
3033  exit find_kt
3034  else
3035  cycle find_kt
3036  endif
3037  enddo find_kt
3038  kt = kt - 1
3039 
3040  if( kt.eq.kb ) then
3041  tl=(zi(k)-za(kb))/dza(kb)
3042  th=(zi(k+1)-za(kb))/dza(kb)
3043  tl2=tl*tl
3044  th2=th*th
3045  qqd=0.5*(qpi(kb)-qmi(kb))
3046  qqh=qqd*th2+qmi(kb)*th
3047  qql=qqd*tl2+qmi(kb)*tl
3048  qn(k) = (qqh-qql)/(th-tl)
3049  else if( kt.gt.kb ) then
3050  tl=(zi(k)-za(kb))/dza(kb)
3051  tl2=tl*tl
3052  qqd=0.5*(qpi(kb)-qmi(kb))
3053  qql=qqd*tl2+qmi(kb)*tl
3054  dql = qa(kb)-qql
3055  zsum = (1.-tl)*dza(kb)
3056  qsum = dql*dza(kb)
3057  if( kt-kb.gt.1 ) then
3058  do m=kb+1,kt-1
3059  zsum = zsum + dza(m)
3060  qsum = qsum + qa(m) * dza(m)
3061  enddo
3062  endif
3063  th=(zi(k+1)-za(kt))/dza(kt)
3064  th2=th*th
3065  qqd=0.5*(qpi(kt)-qmi(kt))
3066  dqh=qqd*th2+qmi(kt)*th
3067  zsum = zsum + th*dza(kt)
3068  qsum = qsum + dqh*dza(kt)
3069  qn(k) = qsum/zsum
3070  endif
3071  cycle intp
3072  endif
3073 
3074  enddo intp
3075 
3076 
3077  sum_precip: do k=1,km
3078  if( za(k).lt.0.0 .and. za(k+1).lt.0.0 ) then
3079  precip(i) = precip(i) + qa(k)*dza(k)
3080  cycle sum_precip
3081  else if ( za(k).lt.0.0 .and. za(k+1).ge.0.0 ) then
3082  precip(i) = precip(i) + qa(k)*(0.0-za(k))
3083  exit sum_precip
3084  endif
3085  exit sum_precip
3086  enddo sum_precip
3087 
3088 
3089  if(ist.eq.1) then
3090  rql(i,:) = qn(:)
3091  precip1(i) = precip(i)
3092  else
3093  rql2(i,:) = qn(:)
3094  precip2(i) = precip(i)
3095  endif
3096  enddo ist_loop
3097 
3098 
3099  enddo i_loop
3100 

Referenced by wdm62d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ nislfv_rain_plmr()

subroutine mp_wdm6::nislfv_rain_plmr ( integer  im,
integer  km,
real(kind=kind_phys), dimension(im,km)  denl,
real(kind=kind_phys), dimension(im,km)  denfacl,
real(kind=kind_phys), dimension(im,km)  tkl,
real(kind=kind_phys), dimension(im,km)  dzl,
real(kind=kind_phys), dimension(im,km)  wwl,
real(kind=kind_phys), dimension(im,km)  rql,
real(kind=kind_phys), dimension(im,km)  rnl,
real(kind=kind_phys), dimension(im)  precip,
real(kind=kind_phys)  dt,
integer  id,
integer  iter,
integer  rid 
)
private
2586 
2587 
2588 
2589 
2590 
2591 
2592 
2593 
2594 
2595 
2596 
2597 
2598 
2599 
2600 
2601 
2602 
2603 
2604 
2605 
2606 
2607 
2608  implicit none
2609  integer im,km,id
2610  real(kind=kind_phys) dt
2611  real(kind=kind_phys) dzl(im,km),wwl(im,km),rql(im,km),rnl(im,km),precip(im)
2612  real(kind=kind_phys) denl(im,km),denfacl(im,km),tkl(im,km)
2613 
2614  integer i,k,n,m,kk,kb,kt,iter,rid
2615  real(kind=kind_phys) tl,tl2,qql,dql,qqd
2616  real(kind=kind_phys) th,th2,qqh,dqh
2617  real(kind=kind_phys) zsum,qsum,dim,dip,c1,con1,fa1,fa2
2618  real(kind=kind_phys) allold, allnew, zz, dzamin, cflmax, decfl
2619  real(kind=kind_phys) dz(km), ww(km), qq(km), nr(km), wd(km), wa(km), wa2(km), was(km)
2620  real(kind=kind_phys) den(km), denfac(km), tk(km)
2621  real(kind=kind_phys) wi(km+1), zi(km+1), za(km+1)
2622  real(kind=kind_phys) qn(km), qr(km),tmp(km),tmp1(km),tmp2(km),tmp3(km)
2623  real(kind=kind_phys) dza(km+1), qa(km+1), qmi(km+1), qpi(km+1)
2624 
2625  precip(:) = 0.0
2626 
2627  i_loop : do i=1,im
2628 
2629  dz(:) = dzl(i,:)
2630  qq(:) = rql(i,:)
2631  nr(:) = rnl(i,:)
2632  if(rid .eq. 1) nr(:) = rnl(i,:)/denl(i,:)
2633  ww(:) = wwl(i,:)
2634  den(:) = denl(i,:)
2635  denfac(:) = denfacl(i,:)
2636  tk(:) = tkl(i,:)
2637 
2638  allold = 0.0
2639  do k=1,km
2640  allold = allold + qq(k)
2641  enddo
2642  if(allold.le.0.0) then
2643  cycle i_loop
2644  endif
2645 
2646 
2647  zi(1)=0.0
2648  do k=1,km
2649  zi(k+1) = zi(k)+dz(k)
2650  enddo
2651 
2652 
2653  wd(:) = ww(:)
2654  n=1
2655  100 continue
2656 
2657 
2658  wi(1) = ww(1)
2659  wi(km+1) = ww(km)
2660  do k=2,km
2661  wi(k) = (ww(k)*dz(k-1)+ww(k-1)*dz(k))/(dz(k-1)+dz(k))
2662  enddo
2663 
2664  fa1 = 9./16.
2665  fa2 = 1./16.
2666  wi(1) = ww(1)
2667  wi(2) = 0.5*(ww(2)+ww(1))
2668  do k=3,km-1
2669  wi(k) = fa1*(ww(k)+ww(k-1))-fa2*(ww(k+1)+ww(k-2))
2670  enddo
2671  wi(km) = 0.5*(ww(km)+ww(km-1))
2672  wi(km+1) = ww(km)
2673 
2674 
2675  do k=2,km
2676  if( ww(k).eq.0.0 ) wi(k)=ww(k-1)
2677  enddo
2678 
2679 
2680  con1 = 0.05
2681  do k=km,1,-1
2682  decfl = (wi(k+1)-wi(k))*dt/dz(k)
2683  if( decfl .gt. con1 ) then
2684  wi(k) = wi(k+1) - con1*dz(k)/dt
2685  endif
2686  enddo
2687 
2688  do k=1,km+1
2689  za(k) = zi(k) - wi(k)*dt
2690  enddo
2691 
2692  do k=1,km
2693  dza(k) = za(k+1)-za(k)
2694  enddo
2695  dza(km+1) = zi(km+1) - za(km+1)
2696 
2697 
2698  do k=1,km
2699  qa(k) = qq(k)*dz(k)/dza(k)
2700  qr(k) = qa(k)/den(k)
2701  if(rid .eq. 1) qr(k) = qa(k)
2702  enddo
2703  qa(km+1) = 0.0
2704 
2705 
2706 
2707 
2708  if( n.le.iter ) then
2709  if(rid.eq.1) then
2710  call slope_rain(nr,qr,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa,wa2,1,1,1,km)
2711  else
2712  call slope_rain(qr,nr,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa,wa2,1,1,1,km)
2713  endif
2714  if(rid.eq.1) wa(:) = wa2(:)
2715  if( n.ge.2 ) wa(1:km)=0.5*(wa(1:km)+was(1:km))
2716  do k=1,km
2717 
2718 
2719 
2720 
2721  ww(k) = 0.5* ( wd(k)+wa(k) )
2722  enddo
2723  was(:) = wa(:)
2724  n=n+1
2725  go to 100
2726  endif
2727 
2728 
2729  do k=2,km
2730  dip=(qa(k+1)-qa(k))/(dza(k+1)+dza(k))
2731  dim=(qa(k)-qa(k-1))/(dza(k-1)+dza(k))
2732  if( dip*dim.le.0.0 ) then
2733  qmi(k)=qa(k)
2734  qpi(k)=qa(k)
2735  else
2736  qpi(k)=qa(k)+0.5*(dip+dim)*dza(k)
2737  qmi(k)=2.0*qa(k)-qpi(k)
2738  if( qpi(k).lt.0.0 .or. qmi(k).lt.0.0 ) then
2739  qpi(k) = qa(k)
2740  qmi(k) = qa(k)
2741  endif
2742  endif
2743  enddo
2744  qpi(1)=qa(1)
2745  qmi(1)=qa(1)
2746  qmi(km+1)=qa(km+1)
2747  qpi(km+1)=qa(km+1)
2748 
2749 
2750  qn = 0.0
2751  kb=1
2752  kt=1
2753  intp : do k=1,km
2754  kb=max(kb-1,1)
2755  kt=max(kt-1,1)
2756 
2757  if( zi(k).ge.za(km+1) ) then
2758  exit intp
2759  else
2760  find_kb : do kk=kb,km
2761  if( zi(k).le.za(kk+1) ) then
2762  kb = kk
2763  exit find_kb
2764  else
2765  cycle find_kb
2766  endif
2767  enddo find_kb
2768  find_kt : do kk=kt,km
2769  if( zi(k+1).le.za(kk) ) then
2770  kt = kk
2771  exit find_kt
2772  else
2773  cycle find_kt
2774  endif
2775  enddo find_kt
2776  kt = kt - 1
2777 
2778  if( kt.eq.kb ) then
2779  tl=(zi(k)-za(kb))/dza(kb)
2780  th=(zi(k+1)-za(kb))/dza(kb)
2781  tl2=tl*tl
2782  th2=th*th
2783  qqd=0.5*(qpi(kb)-qmi(kb))
2784  qqh=qqd*th2+qmi(kb)*th
2785  qql=qqd*tl2+qmi(kb)*tl
2786  qn(k) = (qqh-qql)/(th-tl)
2787  else if( kt.gt.kb ) then
2788  tl=(zi(k)-za(kb))/dza(kb)
2789  tl2=tl*tl
2790  qqd=0.5*(qpi(kb)-qmi(kb))
2791  qql=qqd*tl2+qmi(kb)*tl
2792  dql = qa(kb)-qql
2793  zsum = (1.-tl)*dza(kb)
2794  qsum = dql*dza(kb)
2795  if( kt-kb.gt.1 ) then
2796  do m=kb+1,kt-1
2797  zsum = zsum + dza(m)
2798  qsum = qsum + qa(m) * dza(m)
2799  enddo
2800  endif
2801  th=(zi(k+1)-za(kt))/dza(kt)
2802  th2=th*th
2803  qqd=0.5*(qpi(kt)-qmi(kt))
2804  dqh=qqd*th2+qmi(kt)*th
2805  zsum = zsum + th*dza(kt)
2806  qsum = qsum + dqh*dza(kt)
2807  qn(k) = qsum/zsum
2808  endif
2809  cycle intp
2810  endif
2811 
2812  enddo intp
2813 
2814 
2815  sum_precip: do k=1,km
2816  if( za(k).lt.0.0 .and. za(k+1).lt.0.0 ) then
2817  precip(i) = precip(i) + qa(k)*dza(k)
2818  cycle sum_precip
2819  else if ( za(k).lt.0.0 .and. za(k+1).ge.0.0 ) then
2820  precip(i) = precip(i) + qa(k)*(0.0-za(k))
2821  exit sum_precip
2822  endif
2823  exit sum_precip
2824  enddo sum_precip
2825 
2826 
2827  rql(i,:) = qn(:)
2828 
2829 
2830  enddo i_loop
2831 

Referenced by wdm62d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ refl10cm_wdm6()

subroutine mp_wdm6::refl10cm_wdm6 ( real(kind=kind_phys), dimension(kts:kte), intent(in)  qv1d,
real(kind=kind_phys), dimension(kts:kte), intent(in)  qr1d,
real(kind=kind_phys), dimension(kts:kte), intent(in)  nr1d,
real(kind=kind_phys), dimension(kts:kte), intent(in)  qs1d,
real(kind=kind_phys), dimension(kts:kte), intent(in)  qg1d,
real(kind=kind_phys), dimension(kts:kte), intent(in)  t1d,
real(kind=kind_phys), dimension(kts:kte), intent(in)  p1d,
real(kind=kind_phys), dimension(kts:kte), intent(inout)  dBZ,
integer, intent(in)  kts,
integer, intent(in)  kte,
integer, intent(in)  ii,
integer, intent(in)  jj 
)
private
3106 
3107  IMPLICIT NONE
3108 
3109 
3110  INTEGER, INTENT(IN):: kts, kte, ii, jj
3111  REAL(kind=kind_phys), DIMENSION(kts:kte), INTENT(IN):: &
3112  qv1d, qr1d, nr1d, qs1d, qg1d, t1d, p1d
3113  REAL(kind=kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: dbz
3114 
3115 
3116  REAL(kind=kind_phys), DIMENSION(kts:kte):: temp, pres, qv, rho
3117  REAL(kind=kind_phys), DIMENSION(kts:kte):: rr, nr, rs, rg
3118  REAL:: temp_C
3119 
3120  DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilams, ilamg
3121  DOUBLE PRECISION, DIMENSION(kts:kte):: N0_r, N0_s, N0_g
3122  DOUBLE PRECISION:: lamr, lams, lamg
3123  LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg
3124 
3125  REAL(kind=kind_phys), DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel
3126  DOUBLE PRECISION:: fmelt_s, fmelt_g
3127 
3128  INTEGER:: i, k, k_0, kbot, n
3129  LOGICAL:: melti
3130 
3131  DOUBLE PRECISION:: cback, x, eta, f_d
3132  REAL(kind=kind_phys), PARAMETER:: r=287.
3133 
3134 
3135 
3136  do k = kts, kte
3137  dbz(k) = -35.0
3138  enddo
3139 
3140 
3141 
3142 
3143  do k = kts, kte
3144  temp(k) = t1d(k)
3145  temp_c = min(-0.001, temp(k)-273.15)
3146  qv(k) = max(1.e-10, qv1d(k))
3147  pres(k) = p1d(k)
3148  rho(k) = 0.622*pres(k)/(r*temp(k)*(qv(k)+0.622))
3149 
3150  if (qr1d(k) .gt. 1.e-9) then
3151  rr(k) = qr1d(k)*rho(k)
3152  nr(k) = nr1d(k)*rho(k)
3153  lamr = (xam_r*xcrg(3)*xorg2*nr(k)/rr(k))**xobmr
3154  ilamr(k) = 1./lamr
3155  n0_r(k) = nr(k)*xorg2*lamr**xcre(2)
3156  l_qr(k) = .true.
3157  else
3158  rr(k) = 1.e-12
3159  nr(k) = 1.e-12
3160  l_qr(k) = .false.
3161  endif
3162 
3163  if (qs1d(k) .gt. 1.e-9) then
3164  rs(k) = qs1d(k)*rho(k)
3165  n0_s(k) = min(n0smax, n0s*exp(-alpha*temp_c))
3166  lams = (xam_s*xcsg(3)*n0_s(k)/rs(k))**(1./xcse(1))
3167  ilams(k) = 1./lams
3168  l_qs(k) = .true.
3169  else
3170  rs(k) = 1.e-12
3171  l_qs(k) = .false.
3172  endif
3173 
3174  if (qg1d(k) .gt. 1.e-9) then
3175  rg(k) = qg1d(k)*rho(k)
3176  n0_g(k) = n0g
3177  lamg = (xam_g*xcgg(3)*n0_g(k)/rg(k))**(1./xcge(1))
3178  ilamg(k) = 1./lamg
3179  l_qg(k) = .true.
3180  else
3181  rg(k) = 1.e-12
3182  l_qg(k) = .false.
3183  endif
3184  enddo
3185 
3186 
3187 
3188 
3189  melti = .false.
3190  k_0 = kts
3191  do k = kte-1, kts, -1
3192  if ( (temp(k).gt.273.15) .and. l_qr(k) &
3193  .and. (l_qs(k+1).or.l_qg(k+1)) ) then
3194  k_0 = max(k+1, k_0)
3195  melti=.true.
3196  goto 195
3197  endif
3198  enddo
3199  195 continue
3200 
3201 
3202 
3203 
3204 
3205 
3206 
3207  do k = kts, kte
3208  ze_rain(k) = 1.e-22
3209  ze_snow(k) = 1.e-22
3210  ze_graupel(k) = 1.e-22
3211  if (l_qr(k)) ze_rain(k) = n0_r(k)*xcrg(4)*ilamr(k)**xcre(4)
3212  if (l_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/pi)*(6.0/pi) &
3213  * (xam_s/900.0)*(xam_s/900.0) &
3214  * n0_s(k)*xcsg(4)*ilams(k)**xcse(4)
3215  if (l_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/pi)*(6.0/pi) &
3216  * (xam_g/900.0)*(xam_g/900.0) &
3217  * n0_g(k)*xcgg(4)*ilamg(k)**xcge(4)
3218  enddo
3219 
3220 
3221 
3222 
3223 
3224 
3225 
3226 
3227 
3228 
3229  if (melti .and. k_0.ge.kts+1) then
3230  do k = k_0-1, kts, -1
3231 
3232 
3233  if (l_qs(k) .and. l_qs(k_0) ) then
3234  fmelt_s = max(0.005d0, min(1.0d0-rs(k)/rs(k_0), 0.99d0))
3235  eta = 0.d0
3236  lams = 1./ilams(k)
3237  do n = 1, nrbins
3238  x = xam_s * xxds(n)**xbm_s
3239  call rayleigh_soak_wetgraupel (x,dble(xocms),dble(xobms), &
3240  fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, &
3241  cback, mixingrulestring_s, matrixstring_s, &
3242  inclusionstring_s, hoststring_s, &
3243  hostmatrixstring_s, hostinclusionstring_s)
3244  f_d = n0_s(k)*xxds(n)**xmu_s * dexp(-lams*xxds(n))
3245  eta = eta + f_d * cback * simpson(n) * xdts(n)
3246  enddo
3247  ze_snow(k) = sngl(lamda4 / (pi5 * k_w) * eta)
3248  endif
3249 
3250 
3251 
3252 
3253  if (l_qg(k) .and. l_qg(k_0) ) then
3254  fmelt_g = max(0.005d0, min(1.0d0-rg(k)/rg(k_0), 0.99d0))
3255  eta = 0.d0
3256  lamg = 1./ilamg(k)
3257  do n = 1, nrbins
3258  x = xam_g * xxdg(n)**xbm_g
3259  call rayleigh_soak_wetgraupel (x,dble(xocmg),dble(xobmg), &
3260  fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, &
3261  cback, mixingrulestring_g, matrixstring_g, &
3262  inclusionstring_g, hoststring_g, &
3263  hostmatrixstring_g, hostinclusionstring_g)
3264  f_d = n0_g(k)*xxdg(n)**xmu_g * dexp(-lamg*xxdg(n))
3265  eta = eta + f_d * cback * simpson(n) * xdtg(n)
3266  enddo
3267  ze_graupel(k) = sngl(lamda4 / (pi5 * k_w) * eta)
3268  endif
3269 
3270  enddo
3271  endif
3272 
3273  do k = kte, kts, -1
3274  dbz(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18)
3275  enddo
3276 
3277 

Referenced by wdm6().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ rgmma()

real(kind=kind_phys) function mp_wdm6::rgmma ( real(kind=kind_phys)  x)
private
2185 
2186  implicit none
2187 
2188 
2189 
2190  real(kind=kind_phys), parameter :: euler = 0.577215664901532_kind_phys
2191  real(kind=kind_phys) :: x, y
2192  integer :: i
2193 
2194  if(x.eq.1._kind_phys) then
2195  rgmma=0._kind_phys
2196  else
2197  rgmma = x*exp(euler*x)
2198  do i = 1,10000
2199  y = real(i, kind=kind_phys)
2200  rgmma = rgmma*(1.000_kind_phys+x/y)*exp(-x/y)
2201  enddo
2202  rgmma = 1._kind_phys/rgmma
2203  endif
2204 

Referenced by effectrad_wdm6(), WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), wdm6init(), wsm6_nislfv_rain_plm6_scratch(), and wsm6_nislfv_rain_plm_scratch().

Here is the caller graph for this function:

◆ slope_graup()

subroutine mp_wdm6::slope_graup ( real(kind=kind_phys), dimension( its:ite , kts:kte)  qrs,
real(kind=kind_phys), dimension( its:ite , kts:kte)  den,
real(kind=kind_phys), dimension( its:ite , kts:kte)  denfac,
real(kind=kind_phys), dimension( its:ite , kts:kte)  t,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslopeb,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope2,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope3,
real(kind=kind_phys), dimension( its:ite , kts:kte)  vt,
integer  its,
integer  ite,
integer  kts,
integer  kte 
)
private
2540  IMPLICIT NONE
2541  INTEGER :: its,ite, jts,jte, kts,kte
2542  real(kind=kind_phys), DIMENSION( its:ite , kts:kte) :: &
2543  qrs, &
2544  rslope, &
2545  rslopeb, &
2546  rslope2, &
2547  rslope3, &
2548  vt, &
2549  den, &
2550  denfac, &
2551  t
2552  real(kind=kind_phys), PARAMETER :: t0c = 273.15
2553  real(kind=kind_phys), DIMENSION( its:ite , kts:kte ) :: &
2554  n0sfac
2555  real(kind=kind_phys) :: lamdag, x, y, z, supcol
2556  integer :: i, j, k
2557 
2558 
2559 
2560  lamdag(x,y)= sqrt(sqrt(pidn0g/(x*y)))
2561 
2562  do k = kts, kte
2563  do i = its, ite
2564 
2565 
2566 
2567  if(qrs(i,k).le.qcrmin)then
2568  rslope(i,k) = rslopegmax
2569  rslopeb(i,k) = rslopegbmax
2570  rslope2(i,k) = rslopeg2max
2571  rslope3(i,k) = rslopeg3max
2572  else
2573  rslope(i,k) = 1./lamdag(qrs(i,k),den(i,k))
2574  rslopeb(i,k) = rslope(i,k)**bvtg
2575  rslope2(i,k) = rslope(i,k)*rslope(i,k)
2576  rslope3(i,k) = rslope2(i,k)*rslope(i,k)
2577  endif
2578  vt(i,k) = pvtg*rslopeb(i,k)*denfac(i,k)
2579  if(qrs(i,k).le.0.0) vt(i,k) = 0.0
2580  enddo
2581  enddo

Referenced by nislfv_rain_plm6().

Here is the caller graph for this function:

◆ slope_rain()

subroutine mp_wdm6::slope_rain ( real(kind=kind_phys), dimension( its:ite , kts:kte)  qrs,
real(kind=kind_phys), dimension( its:ite , kts:kte)  ncr,
real(kind=kind_phys), dimension( its:ite , kts:kte)  den,
real(kind=kind_phys), dimension( its:ite , kts:kte)  denfac,
real(kind=kind_phys), dimension( its:ite , kts:kte)  t,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslopeb,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope2,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope3,
real(kind=kind_phys), dimension( its:ite , kts:kte)  vt,
real(kind=kind_phys), dimension( its:ite , kts:kte)  vtn,
integer  its,
integer  ite,
integer  kts,
integer  kte 
)
private
2445  IMPLICIT NONE
2446  INTEGER :: its,ite, jts,jte, kts,kte
2447  real(kind=kind_phys), DIMENSION( its:ite , kts:kte) :: &
2448  qrs, &
2449  ncr, &
2450  rslope, &
2451  rslopeb, &
2452  rslope2, &
2453  rslope3, &
2454  vt, &
2455  vtn, &
2456  den, &
2457  denfac, &
2458  t
2459  real(kind=kind_phys), PARAMETER :: t0c = 273.15
2460  real(kind=kind_phys), DIMENSION( its:ite , kts:kte ) :: &
2461  n0sfac
2462  real(kind=kind_phys) :: lamdar, x, y, z, supcol
2463  integer :: i, j, k
2464 
2465 
2466 
2467  lamdar(x,y,z)= exp(log(((pidnr*z)/(x*y)))*((.33333333)))
2468 
2469  do k = kts, kte
2470  do i = its, ite
2471  if(qrs(i,k).le.qcrmin .or. ncr(i,k).le.nrmin) then
2472  rslope(i,k) = rslopermax
2473  rslopeb(i,k) = rsloperbmax
2474  rslope2(i,k) = rsloper2max
2475  rslope3(i,k) = rsloper3max
2476  else
2477  rslope(i,k) = min(1./lamdar(qrs(i,k),den(i,k),ncr(i,k)),1.e-3)
2478  rslopeb(i,k) = rslope(i,k)**bvtr
2479  rslope2(i,k) = rslope(i,k)*rslope(i,k)
2480  rslope3(i,k) = rslope2(i,k)*rslope(i,k)
2481  endif
2482  vt(i,k) = pvtr*rslopeb(i,k)*denfac(i,k)
2483  vtn(i,k) = pvtrn*rslopeb(i,k)*denfac(i,k)
2484  if(qrs(i,k).le.0.0) vt(i,k) = 0.0
2485  if(ncr(i,k).le.0.0) vtn(i,k) = 0.0
2486  enddo
2487  enddo

Referenced by nislfv_rain_plmr(), and wdm62d().

Here is the caller graph for this function:

◆ slope_snow()

subroutine mp_wdm6::slope_snow ( real(kind=kind_phys), dimension( its:ite , kts:kte)  qrs,
real(kind=kind_phys), dimension( its:ite , kts:kte)  den,
real(kind=kind_phys), dimension( its:ite , kts:kte)  denfac,
real(kind=kind_phys), dimension( its:ite , kts:kte)  t,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslopeb,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope2,
real(kind=kind_phys), dimension( its:ite , kts:kte)  rslope3,
real(kind=kind_phys), dimension( its:ite , kts:kte)  vt,
integer  its,
integer  ite,
integer  kts,
integer  kte 
)
private
2492  IMPLICIT NONE
2493  INTEGER :: its,ite, jts,jte, kts,kte
2494  real(kind=kind_phys), DIMENSION( its:ite , kts:kte) :: &
2495  qrs, &
2496  rslope, &
2497  rslopeb, &
2498  rslope2, &
2499  rslope3, &
2500  vt, &
2501  den, &
2502  denfac, &
2503  t
2504  real(kind=kind_phys), PARAMETER :: t0c = 273.15
2505  real(kind=kind_phys), DIMENSION( its:ite , kts:kte ) :: &
2506  n0sfac
2507  real(kind=kind_phys) :: lamdas, x, y, z, supcol
2508  integer :: i, j, k
2509 
2510 
2511 
2512  lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y)))
2513 
2514  do k = kts, kte
2515  do i = its, ite
2516  supcol = t0c-t(i,k)
2517 
2518 
2519 
2520  n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
2521  if(qrs(i,k).le.qcrmin)then
2522  rslope(i,k) = rslopesmax
2523  rslopeb(i,k) = rslopesbmax
2524  rslope2(i,k) = rslopes2max
2525  rslope3(i,k) = rslopes3max
2526  else
2527  rslope(i,k) = 1./lamdas(qrs(i,k),den(i,k),n0sfac(i,k))
2528  rslopeb(i,k) = rslope(i,k)**bvts
2529  rslope2(i,k) = rslope(i,k)*rslope(i,k)
2530  rslope3(i,k) = rslope2(i,k)*rslope(i,k)
2531  endif
2532  vt(i,k) = pvts*rslopeb(i,k)*denfac(i,k)
2533  if(qrs(i,k).le.0.0) vt(i,k) = 0.0
2534  enddo
2535  enddo

Referenced by nislfv_rain_plm6().

Here is the caller graph for this function:

◆ slope_wdm6()

subroutine mp_wdm6::slope_wdm6 ( real(kind=kind_phys), dimension( its:ite , kts:kte,3)  qrs,
real(kind=kind_phys), dimension( its:ite , kts:kte)  ncr,
real(kind=kind_phys), dimension( its:ite , kts:kte)  den,
real(kind=kind_phys), dimension( its:ite , kts:kte)  denfac,
real(kind=kind_phys), dimension( its:ite , kts:kte)  t,
real(kind=kind_phys), dimension( its:ite , kts:kte,3)  rslope,
real(kind=kind_phys), dimension( its:ite , kts:kte,3)  rslopeb,
real(kind=kind_phys), dimension( its:ite , kts:kte,3)  rslope2,
real(kind=kind_phys), dimension( its:ite , kts:kte,3)  rslope3,
real(kind=kind_phys), dimension( its:ite , kts:kte,3)  vt,
real(kind=kind_phys), dimension( its:ite , kts:kte)  vtn,
integer  its,
integer  ite,
integer  kts,
integer  kte 
)
private
2362  IMPLICIT NONE
2363  INTEGER :: its,ite, jts,jte, kts,kte
2364  real(kind=kind_phys), DIMENSION( its:ite , kts:kte,3) :: &
2365  qrs, &
2366  rslope, &
2367  rslopeb, &
2368  rslope2, &
2369  rslope3, &
2370  vt
2371  real(kind=kind_phys), DIMENSION( its:ite , kts:kte) :: &
2372  ncr, &
2373  vtn, &
2374  den, &
2375  denfac, &
2376  t
2377  real(kind=kind_phys), PARAMETER :: t0c = 273.15
2378  real(kind=kind_phys), DIMENSION( its:ite , kts:kte ) :: &
2379  n0sfac
2380  real(kind=kind_phys) :: lamdar, lamdas, lamdag, x, y, z, supcol
2381  integer :: i, j, k
2382 
2383 
2384 
2385 
2386 
2387  lamdar(x,y,z)= exp(log(((pidnr*z)/(x*y)))*((.33333333)))
2388  lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y)))
2389  lamdag(x,y)= sqrt(sqrt(pidn0g/(x*y)))
2390 
2391  do k = kts, kte
2392  do i = its, ite
2393  supcol = t0c-t(i,k)
2394 
2395 
2396 
2397  n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
2398  if(qrs(i,k,1).le.qcrmin .or. ncr(i,k).le.nrmin ) then
2399  rslope(i,k,1) = rslopermax
2400  rslopeb(i,k,1) = rsloperbmax
2401  rslope2(i,k,1) = rsloper2max
2402  rslope3(i,k,1) = rsloper3max
2403  else
2404  rslope(i,k,1) = min(1./lamdar(qrs(i,k,1),den(i,k),ncr(i,k)),1.e-3)
2405  rslopeb(i,k,1) = rslope(i,k,1)**bvtr
2406  rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1)
2407  rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1)
2408  endif
2409  if(qrs(i,k,2).le.qcrmin) then
2410  rslope(i,k,2) = rslopesmax
2411  rslopeb(i,k,2) = rslopesbmax
2412  rslope2(i,k,2) = rslopes2max
2413  rslope3(i,k,2) = rslopes3max
2414  else
2415  rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac(i,k))
2416  rslopeb(i,k,2) = rslope(i,k,2)**bvts
2417  rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2)
2418  rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2)
2419  endif
2420  if(qrs(i,k,3).le.qcrmin) then
2421  rslope(i,k,3) = rslopegmax
2422  rslopeb(i,k,3) = rslopegbmax
2423  rslope2(i,k,3) = rslopeg2max
2424  rslope3(i,k,3) = rslopeg3max
2425  else
2426  rslope(i,k,3) = 1./lamdag(qrs(i,k,3),den(i,k))
2427  rslopeb(i,k,3) = rslope(i,k,3)**bvtg
2428  rslope2(i,k,3) = rslope(i,k,3)*rslope(i,k,3)
2429  rslope3(i,k,3) = rslope2(i,k,3)*rslope(i,k,3)
2430  endif
2431  vt(i,k,1) = pvtr*rslopeb(i,k,1)*denfac(i,k)
2432  vt(i,k,2) = pvts*rslopeb(i,k,2)*denfac(i,k)
2433  vt(i,k,3) = pvtg*rslopeb(i,k,3)*denfac(i,k)
2434  vtn(i,k) = pvtrn*rslopeb(i,k,1)*denfac(i,k)
2435  if(qrs(i,k,1).le.0.0) vt(i,k,1) = 0.0
2436  if(qrs(i,k,2).le.0.0) vt(i,k,2) = 0.0
2437  if(qrs(i,k,3).le.0.0) vt(i,k,3) = 0.0
2438  if(ncr(i,k).le.0.0) vtn(i,k) = 0.0
2439  enddo
2440  enddo

Referenced by wdm62d().

Here is the caller graph for this function:

◆ wdm6()

subroutine mp_wdm6::wdm6 ( real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  th,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  q,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  qc,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  qr,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  qi,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  qs,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  qg,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  nn,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  nc,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  nr,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(in)  den,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(in)  pii,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(in)  p,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(in)  delz,
real(kind=kind_phys), intent(in)  delt,
real(kind=kind_phys), intent(in)  g,
real(kind=kind_phys), intent(in)  cpd,
real(kind=kind_phys), intent(in)  cpv,
real(kind=kind_phys), intent(in)  ccn0,
real(kind=kind_phys), intent(in)  rd,
real(kind=kind_phys), intent(in)  rv,
real(kind=kind_phys), intent(in)  t0c,
real(kind=kind_phys), intent(in)  ep1,
real(kind=kind_phys), intent(in)  ep2,
real(kind=kind_phys), intent(in)  qmin,
real(kind=kind_phys), intent(in)  xls,
real(kind=kind_phys), intent(in)  xlv0,
real(kind=kind_phys), intent(in)  xlf0,
real(kind=kind_phys), intent(in)  den0,
real(kind=kind_phys), intent(in)  denr,
real(kind=kind_phys), intent(in)  cliq,
real(kind=kind_phys), intent(in)  cice,
real(kind=kind_phys), intent(in)  psat,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(in)  xland,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(inout)  rain,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(inout)  rainncv,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(inout), optional  snow,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(inout), optional  snowncv,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(inout)  sr,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  refl_10cm,
logical, intent(in), optional  diagflag,
integer, intent(in), optional  do_radar_ref,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(inout), optional  graupel,
real(kind=kind_phys), dimension(ims:ime,jms:jme), intent(inout), optional  graupelncv,
integer, intent(in)  itimestep,
integer, intent(in)  has_reqc,
integer, intent(in)  has_reqi,
integer, intent(in)  has_reqs,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  re_cloud,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  re_ice,
real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout)  re_snow,
integer, intent(in)  ids,
integer, intent(in)  ide,
integer, intent(in)  jds,
integer, intent(in)  jde,
integer, intent(in)  kds,
integer, intent(in)  kde,
integer, intent(in)  ims,
integer, intent(in)  ime,
integer, intent(in)  jms,
integer, intent(in)  jme,
integer, intent(in)  kms,
integer, intent(in)  kme,
integer, intent(in)  its,
integer, intent(in)  ite,
integer, intent(in)  jts,
integer, intent(in)  jte,
integer, intent(in)  kts,
integer, intent(in)  kte 
)
private
141 
142  implicit none
143 
144  integer , intent(in ) :: itimestep
145  integer , intent(in ) :: &
146  ids,ide, jds,jde, kds,kde, &
147  ims,ime, jms,jme, kms,kme, &
148  its,ite, jts,jte, kts,kte
149  real(kind=kind_phys) , intent(in ) :: delt, g, ccn0, &
150  rd, rv, t0c, &
151  cpd, cpv, &
152  den0, qmin, &
153  ep1, ep2, xls, &
154  xlv0, xlf0, &
155  cliq, cice, &
156  psat, denr
157  real(kind=kind_phys), dimension(ims:ime,jms:jme) , intent(in ) :: xland
158  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(in ) :: den
159  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(in ) :: pii
160  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(in ) :: p
161  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(in ) :: delz
162  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: th
163  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: q
164  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: qc
165  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: qi
166  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: qr
167  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: qs
168  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: qg
169  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: nn
170  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: nc
171  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme) , intent(inout) :: nr
172  real(kind=kind_phys), dimension(ims:ime,jms:jme) , intent(inout) :: rain
173  real(kind=kind_phys), dimension(ims:ime,jms:jme) , intent(inout) :: rainncv
174  real(kind=kind_phys), dimension(ims:ime,jms:jme) , intent(inout) :: sr
175  real(kind=kind_phys), dimension(ims:ime,jms:jme), optional, intent(inout) :: snow
176  real(kind=kind_phys), dimension(ims:ime,jms:jme), optional, intent(inout) :: snowncv
177  real(kind=kind_phys), dimension(ims:ime,jms:jme), optional, intent(inout) :: graupel
178  real(kind=kind_phys), dimension(ims:ime,jms:jme), optional, intent(inout) :: graupelncv
179 
180 
181 
182  integer , intent(in ) :: has_reqc
183  integer , intent(in ) :: has_reqi
184  integer , intent(in ) :: has_reqs
185  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: re_cloud
186  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: re_ice
187  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: re_snow
188 
189 
190 
191  real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: refl_10cm
192  logical , optional, intent(in ) :: diagflag
193  integer , optional, intent(in ) :: do_radar_ref
194 
195 
196 
197  real(kind=kind_phys), dimension(its:ite,kts:kte) :: t
198  real(kind=kind_phys), dimension(its:ite,kts:kte,2) :: qci
199  real(kind=kind_phys), dimension(its:ite,kts:kte,3) :: qrs, ncr
200  integer :: i,j,k
201 
202 
203 
204  real(kind=kind_phys), dimension(kts:kte) :: qv1d
205  real(kind=kind_phys), dimension(kts:kte) :: t1d
206  real(kind=kind_phys), dimension(kts:kte) :: p1d
207  real(kind=kind_phys), dimension(kts:kte) :: qr1d
208  real(kind=kind_phys), dimension(kts:kte) :: nr1d
209  real(kind=kind_phys), dimension(kts:kte) :: qs1d
210  real(kind=kind_phys), dimension(kts:kte) :: qg1d
211  real(kind=kind_phys), dimension(kts:kte) :: dbz
212 
213 
214 
215  real(kind=kind_phys), dimension(kts:kte) :: qc1d, nc1d, den1d
216  real(kind=kind_phys), dimension(kts:kte) :: qi1d
217  real(kind=kind_phys), dimension(kts:kte) :: re_qc, re_qi, re_qs
218 
219  if (itimestep .eq. 1) then
220  do j = jms,jme
221  do k = kms,kme
222  do i = ims,ime
223  nn(i,k,j) = ccn0
224  enddo
225  enddo
226  enddo
227  endif
228 
229  do j = jts,jte
230  do k = kts,kte
231  do i = its,ite
232  t(i,k) = th(i,k,j)*pii(i,k,j)
233  qci(i,k,1) = qc(i,k,j)
234  qci(i,k,2) = qi(i,k,j)
235  qrs(i,k,1) = qr(i,k,j)
236  qrs(i,k,2) = qs(i,k,j)
237  qrs(i,k,3) = qg(i,k,j)
238  ncr(i,k,1) = nn(i,k,j)
239  ncr(i,k,2) = nc(i,k,j)
240  ncr(i,k,3) = nr(i,k,j)
241  enddo
242  enddo
243 
244 
245 
246 
247  call wdm62d(t, q(ims,kms,j), qci, qrs, ncr &
248  ,den(ims,kms,j) &
249  ,p(ims,kms,j), delz(ims,kms,j) &
250  ,delt,g, cpd, cpv, ccn0, rd, rv, t0c &
251  ,ep1, ep2, qmin &
252  ,xls, xlv0, xlf0, den0, denr &
253  ,cliq,cice,psat &
254  ,j &
255  ,xland(ims,j) &
256  ,rain(ims,j),rainncv(ims,j) &
257  ,sr(ims,j) &
258  ,ids,ide, jds,jde, kds,kde &
259  ,ims,ime, jms,jme, kms,kme &
260  ,its,ite, jts,jte, kts,kte &
261  ,snow(ims,j),snowncv(ims,j) &
262  ,graupel(ims,j),graupelncv(ims,j) &
263  )
264 
265  do k = kts,kte
266  do i = its,ite
267  th(i,k,j) = t(i,k)/pii(i,k,j)
268  qc(i,k,j) = qci(i,k,1)
269  qi(i,k,j) = qci(i,k,2)
270  qr(i,k,j) = qrs(i,k,1)
271  qs(i,k,j) = qrs(i,k,2)
272  qg(i,k,j) = qrs(i,k,3)
273  nn(i,k,j) = ncr(i,k,1)
274  nc(i,k,j) = ncr(i,k,2)
275  nr(i,k,j) = ncr(i,k,3)
276  enddo
277  enddo
278 
279  if ( present (diagflag) ) then
280  if (diagflag .and. do_radar_ref == 1) then
281  do i = its,ite
282  do k = kts,kte
283  t1d(k) = th(i,k,j)*pii(i,k,j)
284  p1d(k) = p(i,k,j)
285  qv1d(k) = q(i,k,j)
286  qr1d(k) = qr(i,k,j)
287  nr1d(k) = nr(i,k,j)
288  qs1d(k) = qs(i,k,j)
289  qg1d(k) = qg(i,k,j)
290  enddo
291  call refl10cm_wdm6 (qv1d, qr1d, nr1d, qs1d, qg1d, &
292  t1d, p1d, dbz, kts, kte, i, j)
293  do k = kts, kte
294  refl_10cm(i,k,j) = max(-35., dbz(k))
295  enddo
296  enddo
297  endif
298  endif
299 
300 
301 
302  if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then
303  do i = its,ite
304  do k = kts,kte
305  re_qc(k) = re_qc_bg
306  re_qi(k) = re_qi_bg
307  re_qs(k) = re_qs_bg
308 
309  t1d(k) = th(i,k,j)*pii(i,k,j)
310  den1d(k)= den(i,k,j)
311  qc1d(k) = qc(i,k,j)
312  qi1d(k) = qi(i,k,j)
313  qs1d(k) = qs(i,k,j)
314  nc1d(k) = nc(i,k,j)
315  enddo
316 
317  call effectrad_wdm6(t1d, qc1d, nc1d, qi1d, qs1d, den1d, &
318  qmin, t0c, re_qc, re_qi, re_qs, &
319  kts, kte, i, j)
320 
321  do k = kts,kte
322  re_cloud(i,k,j) = max(re_qc_bg, min(re_qc(k), 50.e-6))
323  re_ice(i,k,j) = max(re_qi_bg, min(re_qi(k), 125.e-6))
324  re_snow(i,k,j) = max(re_qs_bg, min(re_qs(k), 999.e-6))
325  enddo
326  enddo
327  endif
328  enddo
329 
Here is the call graph for this function:

◆ wdm62d()

subroutine mp_wdm6::wdm62d ( real(kind=kind_phys), dimension(its:ite,kts:kte), intent(inout)  t,
real(kind=kind_phys), dimension(ims:ime,kms:kme), intent(inout)  q,
real(kind=kind_phys), dimension(its:ite,kts:kte,2), intent(inout)  qci,
real(kind=kind_phys), dimension(its:ite,kts:kte,3), intent(inout)  qrs,
real(kind=kind_phys), dimension(its:ite,kts:kte,3), intent(inout)  ncr,
real(kind=kind_phys), dimension(ims:ime,kms:kme), intent(in)  den,
real(kind=kind_phys), dimension(ims:ime,kms:kme), intent(in)  p,
real(kind=kind_phys), dimension(ims:ime,kms:kme), intent(in)  delz,
real(kind=kind_phys), intent(in)  delt,
real(kind=kind_phys), intent(in)  g,
real(kind=kind_phys), intent(in)  cpd,
real(kind=kind_phys), intent(in)  cpv,
real(kind=kind_phys), intent(in)  ccn0,
real(kind=kind_phys), intent(in)  rd,
real(kind=kind_phys), intent(in)  rv,
real(kind=kind_phys), intent(in)  t0c,
real(kind=kind_phys), intent(in)  ep1,
real(kind=kind_phys), intent(in)  ep2,
real(kind=kind_phys), intent(in)  qmin,
real(kind=kind_phys), intent(in)  xls,
real(kind=kind_phys), intent(in)  xlv0,
real(kind=kind_phys), intent(in)  xlf0,
real(kind=kind_phys), intent(in)  den0,
real(kind=kind_phys), intent(in)  denr,
real(kind=kind_phys), intent(in)  cliq,
real(kind=kind_phys), intent(in)  cice,
real(kind=kind_phys), intent(in)  psat,
integer, intent(in)  lat,
real(kind=kind_phys), dimension(ims:ime), intent(in)  slmsk,
real(kind=kind_phys), dimension(ims:ime), intent(inout)  rain,
real(kind=kind_phys), dimension(ims:ime), intent(inout)  rainncv,
real(kind=kind_phys), dimension(ims:ime), intent(inout)  sr,
integer, intent(in)  ids,
integer, intent(in)  ide,
integer, intent(in)  jds,
integer, intent(in)  jde,
integer, intent(in)  kds,
integer, intent(in)  kde,
integer, intent(in)  ims,
integer, intent(in)  ime,
integer, intent(in)  jms,
integer, intent(in)  jme,
integer, intent(in)  kms,
integer, intent(in)  kme,
integer, intent(in)  its,
integer, intent(in)  ite,
integer, intent(in)  jts,
integer, intent(in)  jte,
integer, intent(in)  kts,
integer, intent(in)  kte,
real(kind=kind_phys), dimension(ims:ime), intent(inout), optional  snow,
real(kind=kind_phys), dimension(ims:ime), intent(inout), optional  snowncv,
real(kind=kind_phys), dimension(ims:ime), intent(inout), optional  graupel,
real(kind=kind_phys), dimension(ims:ime), intent(inout), optional  graupelncv,
integer, intent(in), optional  microphysics_debug,
integer, intent(in), optional  diag_i_dbg,
integer, intent(in), optional  diag_j_dbg,
real(kind=kind_phys), dimension(ims:ime), intent(inout), optional  rainonly,
real(kind=kind_phys), dimension(ims:ime), intent(inout), optional  snowonly 
)
private
351 
352  implicit none
353 
354 
355 
356 
357 
358 
359 
360 
361 
362 
363 
364 
365 
366 
367 
368 
369 
370 
371 
372 
373 
374 
375 
376 
377 
378 
379 
380 
381 
382 
383 
384 
385 
386 
387 
388 
389 
390 
391 
392 
393 
394 
395 
396 
397 
398 
399 
400 
401 
402 
403 
404 
405 
406 
407 
408 
409 
410 
411 
412 
413 
414 
415 
416 
417 
418 
419 
420 
421 
422 
423 
424 
425 
426 
427 
428 
429 
430 
431 
432 
433 
434 
435 
436 
437 
438 
439 
440 
441 
442 
443  integer , intent(in ) :: &
444  ids,ide, jds,jde, kds,kde, &
445  ims,ime, jms,jme, kms,kme, &
446  its,ite, jts,jte, kts,kte
447  integer , intent(in ) :: lat
448  integer , optional, intent(in ) :: microphysics_debug, diag_i_dbg, diag_j_dbg
449  real(kind=kind_phys) , intent(in ) :: delt
450  real(kind=kind_phys) , intent(in ) :: g, cpd, cpv, t0c, &
451  den0, rd, rv, &
452  ep1, ep2, qmin, &
453  xls, xlv0, xlf0, &
454  cliq, cice, psat, &
455  denr
456  real(kind=kind_phys) , intent(in ) :: ccn0
457  real(kind=kind_phys), dimension(ims:ime) , intent(in ) :: slmsk
458  real(kind=kind_phys), dimension(ims:ime,kms:kme) , intent(in ) :: p
459  real(kind=kind_phys), dimension(ims:ime,kms:kme) , intent(in ) :: delz
460  real(kind=kind_phys), dimension(ims:ime,kms:kme) , intent(in ) :: den
461  real(kind=kind_phys), dimension(its:ite,kts:kte) , intent(inout) :: t
462  real(kind=kind_phys), dimension(its:ite,kts:kte,2) , intent(inout) :: qci
463  real(kind=kind_phys), dimension(its:ite,kts:kte,3) , intent(inout) :: qrs
464  real(kind=kind_phys), dimension(its:ite,kts:kte,3) , intent(inout) :: ncr
465  real(kind=kind_phys), dimension(ims:ime,kms:kme) , intent(inout) :: q
466  real(kind=kind_phys), dimension(ims:ime) , intent(inout) :: rain
467  real(kind=kind_phys), dimension(ims:ime) , intent(inout) :: rainncv
468  real(kind=kind_phys), dimension(ims:ime) , intent(inout) :: sr
469  real(kind=kind_phys), dimension(ims:ime), optional , intent(inout) :: snow
470  real(kind=kind_phys), dimension(ims:ime), optional , intent(inout) :: snowncv
471  real(kind=kind_phys), dimension(ims:ime), optional , intent(inout) :: graupel
472  real(kind=kind_phys), dimension(ims:ime), optional , intent(inout) :: graupelncv
473  ! ERF: rain alone and snow alone; rain above also holds the snow, cloud ice
474  ! and graupel, and snow the cloud ice
475  real(kind=kind_phys), dimension(ims:ime), optional , intent(inout) :: rainonly
476  real(kind=kind_phys), dimension(ims:ime), optional , intent(inout) :: snowonly
477 
478  ! Local variables for debug parameters with defaults
479  integer :: debug_local, i_dbg_local, j_dbg_local
480 
481  real(kind=kind_phys), dimension(its:ite,kts:kte) :: dend
482  real(kind=kind_phys), dimension(its:ite,kts:kte) :: qcr
483  real(kind=kind_phys), dimension(its:ite,kts:kte,3) :: rh
484  real(kind=kind_phys), dimension(its:ite,kts:kte,3) :: qs
485  real(kind=kind_phys), dimension(its:ite,kts:kte,3) :: rslope, rslope2, rslope3, rslopeb
486  real(kind=kind_phys), dimension(its:ite,kts:kte,3) :: falk, fall
487  real(kind=kind_phys), dimension(its:ite,kts:kte,3) :: work1
488  real(kind=kind_phys), dimension(its:ite,kts:kte,3) :: qrs_tmp
489  real(kind=kind_phys), dimension(its:ite,kts:kte,2) :: avedia
490  real(kind=kind_phys), dimension(its:ite,kts:kte) :: rslopec, rslopec2,rslopec3
491  real(kind=kind_phys), dimension(its:ite,kts:kte) :: workn, falln, falkn
492  real(kind=kind_phys), dimension(its:ite,kts:kte) :: worka, workr
493  real(kind=kind_phys), dimension(its:ite,kts:kte) :: den_tmp, delz_tmp, ncr_tmp
494  real(kind=kind_phys), dimension(its:ite,kts:kte) :: lamdr_tmp
495  real(kind=kind_phys), dimension(its:ite,kts:kte) :: lamdc_tmp
496  real(kind=kind_phys), dimension(its:ite,kts:kte) :: falkc, work1c, work2c, fallc
497  real(kind=kind_phys), dimension(its:ite,kts:kte) :: dqr,dnr
498  real(kind=kind_phys), dimension(its:ite,kts:kte) :: pcact, prevp, psdep, pgdep, praut, &
499  psaut, pgaut, pracw, psacw, pgacw, &
500  pgacr, pgacs, psaci, pgmlt, praci, &
501  piacr, pracs, psacr, pgaci, pseml, &
502  pgeml, paacw, pigen, pidep, pcond, &
503  psmlt, psevp, pgevp
504  real(kind=kind_phys), dimension(its:ite,kts:kte) :: nraut, nracw, ncevp, nccol, nrcol, &
505  nsacw, ngacw, niacr, nsacr, ngacr, &
506  naacw, nseml, ngeml, ncact
507  real(kind=kind_phys), dimension(its:ite,kts:kte) :: xl, cpm, work2, denfac, xni, n0sfac, &
508  qsum
509  real(kind=kind_phys), dimension(its:ite,kts:kte) :: denqrs1, denqrs2, denqrs3
510  real(kind=kind_phys), dimension(its:ite,kts:kte) :: denqr1, denncr3, denqci
511  real(kind=kind_phys), dimension(its:ite) :: delqrs1, delqrs2, delqrs3, delncr3
512  real(kind=kind_phys), dimension(its:ite) :: delqi
513  real(kind=kind_phys), dimension(its:ite) :: tstepsnow, tstepgraup
514  real(kind=kind_phys) :: gfac, sfac
515 
516 
517 
518  integer :: kte_in
519 
520 
521 
522  real(kind=kind_phys), dimension(its:ite) :: tvec1
523  integer, dimension(its:ite) :: mnstep, numndt
524  integer, dimension(its:ite) :: mstep, numdt
525  logical, dimension(its:ite) :: flgcld
526  real(kind=kind_phys) :: temp
527  real(kind=kind_phys) :: vt2ave
528  real(kind=kind_phys) :: holdc, holdci
529  real(kind=kind_phys) :: cpmcal, xlcal, lamdac, diffus, &
530  viscos, xka, venfac, conden, diffac, &
531  x, y, z, a, b, c, d, e, &
532  ndt, qdt, holdrr, holdrs, holdrg, &
533  supcol, supcolt, pvt, coeres, supsat, &
534  dtcld, xmi, eacrs, satdt, qimax, &
535  diameter, xni0, roqi0, &
536  fallsum, fallsum_qsi, fallsum_qg, &
537  vt2i, vt2r, vt2s, vt2g, acrfac, &
538  egs, egi, coecol, &
539  xlwork2, factor, source, value, &
540  nfrzdtr, nfrzdtc, &
541  taucon, lencon, lenconcr, &
542  xlf, pfrzdtc, pfrzdtr, supice, &
543  alpha2, delta2, delta3
544 
545  integer :: i, j, k, mstepmax, &
546  iprt, latd, lond, loop, loops, ifsat, &
547  n, idim, kdim
548 
549 
550 
551  real(kind=kind_phys) :: dldti, xb, xai, tr, xbi, xa, hvap, &
552  cvap, hsub, dldt, ttp
553 
554 
555 
556 
557  cpmcal(x) = cpd*(1.-max(x,qmin))+max(x,qmin)*cpv
558  xlcal(x) = xlv0-xlv1*(x-t0c)
559 
560 
561 
562 
563 
564 
565  lamdac(x,y,z)= exp(log(((pidnc*z)/(x*y)))*((.33333333)))
566 
567 
568 
569 
570  diffus(x,y) = 8.794e-5 * exp(log(x)*(1.81)) / y
571  viscos(x,y) = 1.496e-6 * (x*sqrt(x)) /(x+120.)/y
572  xka(x,y) = 1.414e3*viscos(x,y)*y
573  diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b))
574  venfac(a,b,c) = exp(log((viscos(b,c)/diffus(b,a)))*((.3333333))) &
575  /sqrt(viscos(b,c))*sqrt(sqrt(den0/c))
576  conden(a,b,c,d,e) = (max(b,qmin)-c)/(1.+d*d/(rv*e)*c/(a*a))
577 
578  idim = ite-its+1
579  kdim = kte-kts+1
580 
581  kte_in = kte
582 
583  ! Initialize debug parameters with defaults
584  if (present(microphysics_debug)) then
585  debug_local = microphysics_debug
586  else
587  debug_local = 0
588  endif
589  if (present(diag_i_dbg)) then
590  i_dbg_local = diag_i_dbg
591  else
592  i_dbg_local = its
593  endif
594  if (present(diag_j_dbg)) then
595  j_dbg_local = diag_j_dbg
596  else
597  j_dbg_local = lat
598  endif
599 
600  do k = kts, kte
601  do i = its, ite
602  qci(i,k,1) = max(qci(i,k,1),0.0)
603  qrs(i,k,1) = max(qrs(i,k,1),0.0)
604  qci(i,k,2) = max(qci(i,k,2),0.0)
605  qrs(i,k,2) = max(qrs(i,k,2),0.0)
606  qrs(i,k,3) = max(qrs(i,k,3),0.0)
607  ncr(i,k,1) = min(max(ncr(i,k,1),1.e8),2.e10)
608  ncr(i,k,2) = max(ncr(i,k,2),0.0)
609  ncr(i,k,3) = max(ncr(i,k,3),0.0)
610  enddo
611  enddo
612 
613  do k = kts,kte
614  do i = its,ite
615  dend(i,k) = den(i,k)
616  enddo
617  enddo
618 
619 
620 
621 
622 
623  do k = kts,kte_in
624  do i = its,ite
625  cpm(i,k) = cpmcal(q(i,k))
626  xl(i,k) = xlcal(t(i,k))
627  enddo
628  enddo
629 
630  qcr(:,:) = 0.0
631  do i = its,ite
632  if(slmsk(i).eq.2) then
633  qcr(i,:) = qc0
634  else
635  qcr(i,:) = qc1
636  endif
637  enddo
638 
639  do k = kts,kte
640  do i = its,ite
641  delz_tmp(i,k) = delz(i,k)
642  den_tmp(i,k) = den(i,k)
643  enddo
644  enddo
645 
646 
647 
648  do i = its,ite
649  rainncv(i) = 0.
650  if(present(snowncv) .and. present(snow)) snowncv(i) = 0.
651  if(present (graupelncv) .and. present(graupel)) graupelncv(i) = 0.
652  sr(i) = 0.
653 
654 
655 
656  tstepsnow(i) = 0.
657  tstepgraup(i) = 0.
658  enddo
659 
660 
661 
662  loops = max(nint(delt/dtcldcr),1)
663  dtcld = delt/loops
664  if(delt.le.dtcldcr) dtcld = delt
665 
666  do loop = 1,loops
667 
668 
669 
670  do i = its,ite
671  mstep(i) = 1
672  mnstep(i) = 1
673  flgcld(i) = .true.
674  enddo
675 
676  do k = kts, kte
677  call vrec_d( tvec1(its), den(its,k), ite-its+1)
678  do i = its, ite
679  tvec1(i) = tvec1(i)*den0
680  enddo
681  call vsqrt_d( denfac(its,k), tvec1(its), ite-its+1)
682  enddo
683 
684  ! WDM6-F90 TAG: PRE_G1B
685 
686 
687 
688  hsub = xls
689  hvap = xlv0
690  cvap = cpv
691  ttp = t0c+0.01
692  dldt = cvap-cliq
693  xa = -dldt/rv
694  xb = xa+hvap/(rv*ttp)
695  dldti = cvap-cice
696  xai = -dldti/rv
697  xbi = xai+hsub/(rv*ttp)
698 
699  ! WDM6-F90 TAG: G1CV_SAT_INT0
700 
701  do k = kts,kte_in
702  do i = its,ite
703  tr = ttp/t(i,k)
704  ! WDM6-F90 TAG: G1CV_SAT_INT1
705  qs(i,k,1) = psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
706  qs(i,k,1) = min(qs(i,k,1),0.99*p(i,k))
707  ! WDM6-F90 TAG: G1CV_SAT_INT10
708  qs(i,k,1) = ep2*qs(i,k,1)/(p(i,k)-qs(i,k,1))
709  ! WDM6-F90 TAG: G1CV_SAT_INT11
710  qs(i,k,1) = max(qs(i,k,1),qmin)
711  ! WDM6-F90 TAG: G1CV_SAT_INT12
712  rh(i,k,1) = max(q(i,k)/qs(i,k,1),qmin)
713  ! WDM6-F90 TAG: G1CV_SAT_INT13
714  tr=ttp/t(i,k)
715  ! WDM6-F90 TAG: G1CV_SAT_INT20
716  if(t(i,k).lt.ttp) then
717  ! WDM6-F90 TAG: G1CV_SAT_INT21
718  qs(i,k,2) = psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr))
719  else
720  ! WDM6-F90 TAG: G1CV_SAT_INT21
721  qs(i,k,2) = psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
722  endif
723  qs(i,k,2) = min(qs(i,k,2),0.99*p(i,k))
724  ! WDM6-F90 TAG: G1CV_SAT_INT22
725  qs(i,k,2) = ep2*qs(i,k,2)/(p(i,k)-qs(i,k,2))
726  ! WDM6-F90 TAG: G1CV_SAT_INT23
727  qs(i,k,2) = max(qs(i,k,2),qmin)
728  ! WDM6-F90 TAG: G1CV_SAT_INT24
729  rh(i,k,2) = max(q(i,k)/qs(i,k,2),qmin)
730  ! WDM6-F90 TAG: G1CV_SAT_INT25
731  enddo
732  enddo
733 
734  ! WDM6-F90 TAG: PRE_G1C
735 
736 
737 
738 
739  do k = kts, kte
740  do i = its, ite
741  prevp(i,k) = 0.
742  psdep(i,k) = 0.
743  pgdep(i,k) = 0.
744  praut(i,k) = 0.
745  psaut(i,k) = 0.
746  pgaut(i,k) = 0.
747  pracw(i,k) = 0.
748  praci(i,k) = 0.
749  piacr(i,k) = 0.
750  psaci(i,k) = 0.
751  psacw(i,k) = 0.
752  pracs(i,k) = 0.
753  psacr(i,k) = 0.
754  pgacw(i,k) = 0.
755  paacw(i,k) = 0.
756  pgaci(i,k) = 0.
757  pgacr(i,k) = 0.
758  pgacs(i,k) = 0.
759  pigen(i,k) = 0.
760  pidep(i,k) = 0.
761  pcond(i,k) = 0.
762  psmlt(i,k) = 0.
763  pgmlt(i,k) = 0.
764  pseml(i,k) = 0.
765  pgeml(i,k) = 0.
766  psevp(i,k) = 0.
767  pgevp(i,k) = 0.
768  pcact(i,k) = 0.
769  falk(i,k,1) = 0.
770  falk(i,k,2) = 0.
771  falk(i,k,3) = 0.
772  fall(i,k,1) = 0.
773  fall(i,k,2) = 0.
774  fall(i,k,3) = 0.
775  fallc(i,k) = 0.
776  falkc(i,k) = 0.
777  falln(i,k) =0.
778  falkn(i,k) =0.
779  xni(i,k) = 1.e3
780  nsacw(i,k) = 0.
781  ngacw(i,k) = 0.
782  naacw(i,k) = 0.
783  niacr(i,k) = 0.
784  nsacr(i,k) = 0.
785  ngacr(i,k) = 0.
786  nseml(i,k) = 0.
787  ngeml(i,k) = 0.
788  nracw(i,k) = 0.
789  nccol(i,k) = 0.
790  nrcol(i,k) = 0.
791  ncact(i,k) = 0.
792  nraut(i,k) = 0.
793  ncevp(i,k) = 0.
794  enddo
795  enddo
796 
797  ! WDM6-F90 TAG: PRE_G2
798 
799  do k = kts, kte
800  do i = its, ite
801  if(qci(i,k,1).le.qmin .or. ncr(i,k,2).le.ncmin ) then
802  rslopec(i,k) = rslopecmax
803  rslopec2(i,k) = rslopec2max
804  rslopec3(i,k) = rslopec3max
805  else
806  rslopec(i,k) = 1./lamdac(qci(i,k,1),den(i,k),ncr(i,k,2))
807  rslopec2(i,k) = rslopec(i,k)*rslopec(i,k)
808  rslopec3(i,k) = rslopec2(i,k)*rslopec(i,k)
809  endif
810 
811 
812 
813  temp = (den(i,k)*max(qci(i,k,2),qmin))
814  temp = sqrt(sqrt(temp*temp*temp))
815  xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6)
816  enddo
817  enddo
818 
819  ! WDM6-F90 TAG: PRE_G3
820 
821 
822 
823 
824  ! WDM6-F90 TAG: PRE_G4
825 
826  do k = kts, kte
827  do i = its, ite
828  qrs_tmp(i,k,1) = qrs(i,k,1)
829  qrs_tmp(i,k,2) = qrs(i,k,2)
830  qrs_tmp(i,k,3) = qrs(i,k,3)
831  ncr_tmp(i,k) = ncr(i,k,3)
832  enddo
833  enddo
834  call slope_wdm6(qrs_tmp,ncr_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2, &
835  rslope3,work1,workn,its,ite,kts,kte)
836 
837  ! WDM6-F90 TAG: POST_G4
838 
839  ! WDM6-F90 TAG: PRE_G5A
840 
841 
842 
843  mstepmax = 1
844  numdt = 1
845  do k = kte, kts, -1
846  do i = its, ite
847  work1(i,k,1) = work1(i,k,1)/delz(i,k)
848  workn(i,k) = workn(i,k)/delz(i,k)
849  numdt(i) = max(nint(max(work1(i,k,1),workn(i,k))*dtcld+.5),1)
850  if(numdt(i).ge.mstep(i)) mstep(i) = numdt(i)
851  enddo
852  enddo
853  do i = its, ite
854  if(mstepmax.le.mstep(i)) mstepmax = mstep(i)
855  enddo
856 
857  ! WDM6-F90 TAG: POST_G5A
858 
859  ! WDM6-F90 TAG: PRE_G5B
860 
861  do n = 1, mstepmax
862  k = kte
863  do i = its, ite
864  if(n.le.mstep(i)) then
865  falk(i,k,1) = dend(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
866  falkn(i,k) = ncr(i,k,3)*workn(i,k)/mstep(i)
867  fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
868  falln(i,k) = falln(i,k)+falkn(i,k)
869  qrs(i,k,1) = max(qrs(i,k,1)-falk(i,k,1)*dtcld/dend(i,k),0.)
870  ncr(i,k,3) = max(ncr(i,k,3)-falkn(i,k)*dtcld,0.)
871  endif
872  enddo
873 
874  do k = kte_in-1,kts,-1
875  do i = its,ite
876  if(n.le.mstep(i)) then
877  falk(i,k,1) = dend(i,k)*qrs(i,k,1)*work1(i,k,1)/mstep(i)
878  falkn(i,k) = ncr(i,k,3)*workn(i,k)/mstep(i)
879  fall(i,k,1) = fall(i,k,1)+falk(i,k,1)
880  falln(i,k) = falln(i,k)+falkn(i,k)
881  dqr(i,k) = min(falk(i,k,1)*dtcld/dend(i,k),qrs(i,k,1))
882  dqr(i,k+1) = min(falk(i,k+1,1)*delz(i,k+1)/delz(i,k) &
883  *dtcld/dend(i,k),qrs(i,k+1,1))
884  dnr(i,k) = min(falkn(i,k)*dtcld,ncr(i,k,3))
885  dnr(i,k+1) = min(falkn(i,k+1)*delz(i,k+1)/delz(i,k)*dtcld, &
886  ncr(i,k+1,3))
887  qrs(i,k,1) = max(qrs(i,k,1)-dqr(i,k)+dqr(i,k+1),0.)
888  ncr(i,k,3) = max(ncr(i,k,3)-dnr(i,k)+dnr(i,k+1),0.)
889  endif
890  enddo
891  enddo
892  do k = kts, kte
893  do i = its, ite
894  qrs_tmp(i,k,1) = qrs(i,k,1)
895  ncr_tmp(i,k) = ncr(i,k,3)
896  enddo
897  enddo
898  call slope_rain(qrs_tmp,ncr_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2, &
899  rslope3,work1,workn,its,ite,kts,kte)
900  do k = kte, kts, -1
901  do i = its, ite
902  work1(i,k,1) = work1(i,k,1)/delz(i,k)
903  workn(i,k) = workn(i,k)/delz(i,k)
904  enddo
905  enddo
906  enddo
907 
908  ! WDM6-F90 TAG: POST_G5B
909 
910 
911  ! WDM6-F90 TAG: PRE_G5C
912 
913  do k = kte, kts, -1
914  do i = its, ite
915  qsum(i,k) = max( (qrs(i,k,2)+qrs(i,k,3)), 1.e-15)
916  if(qsum(i,k) .gt. 1.e-15 ) then
917  worka(i,k) = (work1(i,k,2)*qrs(i,k,2) + work1(i,k,3)*qrs(i,k,3)) &
918  /qsum(i,k)
919  else
920  worka(i,k) = 0.
921  endif
922  denqrs2(i,k) = den(i,k)*qrs(i,k,2)
923  denqrs3(i,k) = den(i,k)*qrs(i,k,3)
924  enddo
925  enddo
926  call nislfv_rain_plm6(idim,kdim,den_tmp,denfac,t,delz_tmp,worka, &
927  denqrs2,denqrs3,delqrs2,delqrs3,dtcld,1,1)
928  do k = kts, kte
929  do i = its, ite
930  qrs(i,k,2) = max(denqrs2(i,k)/den(i,k),0.)
931  qrs(i,k,3) = max(denqrs3(i,k)/den(i,k),0.)
932  fall(i,k,2) = denqrs2(i,k)*worka(i,k)/delz(i,k)
933  fall(i,k,3) = denqrs3(i,k)*worka(i,k)/delz(i,k)
934  enddo
935  enddo
936  do i = its, ite
937  fall(i,1,2) = delqrs2(i)/delz(i,1)/dtcld
938  fall(i,1,3) = delqrs3(i)/delz(i,1)/dtcld
939  enddo
940 
941  ! WDM6-F90 TAG: POST_G5C
942 
943  ! WDM6-F90 TAG: PRE_G6
944 
945  do k = kts, kte
946  do i = its, ite
947  qrs_tmp(i,k,1) = qrs(i,k,1)
948  qrs_tmp(i,k,2) = qrs(i,k,2)
949  qrs_tmp(i,k,3) = qrs(i,k,3)
950  ncr_tmp(i,k) = ncr(i,k,3)
951  enddo
952  enddo
953  call slope_wdm6(qrs_tmp,ncr_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2, &
954  rslope3,work1,workn,its,ite,kts,kte)
955 
956  ! WDM6-F90 TAG: POST_G6
957 
958  ! WDM6-F90 TAG: PRE_G7
959 
960  do k = kte, kts, -1
961  do i = its, ite
962  supcol = t0c-t(i,k)
963  n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
964  if(t(i,k).gt.t0c) then
965 
966 
967 
968 
969  xlf = xlf0
970  work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
971  if(qrs(i,k,2).gt.0.) then
972  coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
973  psmlt(i,k) = xka(t(i,k),den(i,k))/xlf*(t0c-t(i,k))*pi/2. &
974  *n0sfac(i,k)*(precs1*rslope2(i,k,2) &
975  +precs2*work2(i,k)*coeres)/den(i,k)
976  psmlt(i,k) = min(max(psmlt(i,k)*dtcld,-qrs(i,k,2)),0.)
977 
978 
979 
980 
981  if(qrs(i,k,2).gt.qcrmin) then
982  sfac = rslope(i,k,2)*n0s*n0sfac(i,k)/qrs(i,k,2)
983  ncr(i,k,3) = ncr(i,k,3) - sfac*psmlt(i,k)
984  endif
985 
986  qrs(i,k,2) = qrs(i,k,2) + psmlt(i,k)
987  qrs(i,k,1) = qrs(i,k,1) - psmlt(i,k)
988  t(i,k) = t(i,k) + xlf/cpm(i,k)*psmlt(i,k)
989  endif
990 
991 
992 
993 
994  if(qrs(i,k,3).gt.0.) then
995  coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3))
996  pgmlt(i,k) = xka(t(i,k),den(i,k))/xlf*(t0c-t(i,k))*(precg1 &
997  *rslope2(i,k,3) + precg2*work2(i,k)*coeres) &
998  /den(i,k)
999  pgmlt(i,k) = min(max(pgmlt(i,k)*dtcld,-qrs(i,k,3)),0.)
1000 
1001 
1002 
1003 
1004  if(qrs(i,k,3).gt.qcrmin) then
1005  gfac = rslope(i,k,3)*n0g/qrs(i,k,3)
1006  ncr(i,k,3) = ncr(i,k,3) - gfac*pgmlt(i,k)
1007  endif
1008 
1009  qrs(i,k,3) = qrs(i,k,3) + pgmlt(i,k)
1010  qrs(i,k,1) = qrs(i,k,1) - pgmlt(i,k)
1011  t(i,k) = t(i,k) + xlf/cpm(i,k)*pgmlt(i,k)
1012  endif
1013  endif
1014  enddo
1015  enddo
1016 
1017  ! WDM6-F90 TAG: POST_G7
1018 
1019  ! WDM6-F90 TAG: PRE_G8
1020 
1021  do k = kte, kts, -1
1022  do i = its, ite
1023  if(qci(i,k,2).le.0.) then
1024  work1c(i,k) = 0.
1025  else
1026  xmi = den(i,k)*qci(i,k,2)/xni(i,k)
1027  diameter = max(min(dicon * sqrt(xmi),dimax), 1.e-25)
1028  work1c(i,k) = 1.49e4*exp(log(diameter)*(1.31))
1029  endif
1030 
1031  ! WDM6-F90 TAG: T2_G8_vice
1032  enddo
1033  enddo
1034 
1035 
1036 
1037  do k = kte, kts, -1
1038  do i = its, ite
1039  denqci(i,k) = den(i,k)*qci(i,k,2)
1040  enddo
1041  enddo
1042  call nislfv_rain_plmr(idim,kdim,den_tmp,denfac,t,delz_tmp,work1c,denqci,denqci, &
1043  delqi,dtcld,1,0,0)
1044  do k = kts, kte
1045  do i = its, ite
1046  qci(i,k,2) = max(denqci(i,k)/den(i,k),0.)
1047  enddo
1048  enddo
1049  do i = its, ite
1050  fallc(i,1) = delqi(i)/delz(i,1)/dtcld
1051  enddo
1052 
1053  ! WDM6-F90 TAG: POST_G8
1054 
1055  ! G9 (PRECIP) is surface-scoped and is deliberately NOT on the all-k
1056  ! contract: the native path stores this group's inputs as box2d surface
1057  ! slabs, so a counterpart tag can only read klo.
1058  ! WDM6-F90 TAG: PRE_G9
1059 
1060  do i = its, ite
1061  fallsum = fall(i,kts,1)+fall(i,kts,2)+fall(i,kts,3)+fallc(i,kts)
1062  fallsum_qsi = fall(i,kts,2)+fallc(i,kts)
1063  fallsum_qg = fall(i,kts,3)
1064  if(fallsum.gt.0.) then
1065  rainncv(i) = fallsum*delz(i,kts)/denr*dtcld*1000. + rainncv(i)
1066  rain(i) = fallsum*delz(i,kts)/denr*dtcld*1000. + rain(i)
1067  endif
1068  If(fallsum_qsi.gt.0.) then
1069  tstepsnow(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + tstepsnow(i)
1070  IF( PRESENT (snowncv) .AND. PRESENT (snow)) THEN
1071  snowncv(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + snowncv(i)
1072  snow(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + snow(i)
1073  ENDIF
1074  ENDIF
1075  IF(fallsum_qg.gt.0.) then
1076  tstepgraup(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000. &
1077  + tstepgraup(i)
1078  IF( PRESENT (graupelncv) .AND. PRESENT (graupel)) THEN
1079  graupelncv(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000. &
1080  + graupelncv(i)
1081  graupel(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000. + graupel(i)
1082  ENDIF
1083  ENDIF
1084  IF ( PRESENT (rainonly)) THEN
1085  rainonly(i) = fall(i,kts,1)*delz(i,kts)/denr*dtcld*1000. + rainonly(i)
1086  ENDIF
1087  IF ( PRESENT (snowonly)) THEN
1088  snowonly(i) = fall(i,kts,2)*delz(i,kts)/denr*dtcld*1000. + snowonly(i)
1089  ENDIF
1090  IF ( PRESENT (snowncv)) THEN
1091  if(fallsum.gt.0.)sr(i)=(snowncv(i) + graupelncv(i))/(rainncv(i)+1.e-12)
1092  ELSE
1093  if(fallsum.gt.0.)sr(i)=(tstepsnow(i) + tstepgraup(i))/(rainncv(i)+1.e-12)
1094  ENDIF
1095  enddo
1096 
1097  ! Every field here is a 1D surface array with no k index, so an all-k loop
1098  ! would emit identical lines. Single-cell by nature; see the PRE_G9 note.
1099  ! WDM6-F90 TAG: POST_G9
1100 
1101  ! WDM6-F90 TAG: PRE_G10A
1102 
1103 
1104 
1105  do k = kts, kte
1106  do i = its, ite
1107  supcol = t0c-t(i,k)
1108  xlf = xls-xl(i,k)
1109  if(supcol.lt.0.) xlf = xlf0
1110  if(supcol.lt.0 .and. qci(i,k,2).gt.0.) then
1111  qci(i,k,1) = qci(i,k,1) + qci(i,k,2)
1112 
1113 
1114 
1115 
1116  if(qci(i,k,2).gt.qmin) then
1117  ncr(i,k,2) = ncr(i,k,2) + xni(i,k)
1118  endif
1119  t(i,k) = t(i,k) - xlf/cpm(i,k)*qci(i,k,2)
1120  qci(i,k,2) = 0.
1121  endif
1122 
1123  ! WDM6-F90 TAG: POST_G10A
1124 
1125  ! WDM6-F90 TAG: PRE_G10B
1126 
1127  if(supcol.gt.40. .and. qci(i,k,1).gt.0.) then
1128  qci(i,k,2) = qci(i,k,2) + qci(i,k,1)
1129 
1130 
1131 
1132 
1133  if(ncr(i,k,2).gt.0.) ncr(i,k,2) = 0.
1134  t(i,k) = t(i,k) + xlf/cpm(i,k)*qci(i,k,1)
1135  qci(i,k,1) = 0.
1136  endif
1137 
1138  ! WDM6-F90 TAG: POST_G10B
1139 
1140  ! WDM6-F90 TAG: PRE_G10C
1141 
1142  if(supcol.gt.0. .and. qci(i,k,1).gt.qmin) then
1143  supcolt=min(supcol,70.)
1144  pfrzdtc = min(pi*pi*pfrz1*(exp(pfrz2*supcolt)-1.)*denr/den(i,k) &
1145  *ncr(i,k,2)*rslopec3(i,k)*rslopec3(i,k)/18.*dtcld &
1146  ,qci(i,k,1))
1147 
1148 
1149 
1150 
1151  if(ncr(i,k,2).gt.ncmin) then
1152  nfrzdtc = min(pi*pfrz1*(exp(pfrz2*supcolt)-1.)*ncr(i,k,2) &
1153  *rslopec3(i,k)/6.*dtcld,ncr(i,k,2))
1154  ncr(i,k,2) = ncr(i,k,2) - nfrzdtc
1155  endif
1156  qci(i,k,2) = qci(i,k,2) + pfrzdtc
1157  t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtc
1158  qci(i,k,1) = qci(i,k,1)-pfrzdtc
1159  endif
1160 
1161  ! WDM6-F90 TAG: POST_G10C
1162 
1163  ! WDM6-F90 TAG: PRE_G10D
1164 
1165  if(supcol.gt.0. .and. qrs(i,k,1).gt.0.) then
1166  supcolt=min(supcol,70.)
1167  pfrzdtr = min(140.*(pi*pi)*pfrz1*ncr(i,k,3)*denr/den(i,k) &
1168  *(exp(pfrz2*supcolt)-1.)*rslope3(i,k,1)*rslope3(i,k,1) &
1169  *dtcld,qrs(i,k,1))
1170 
1171  ! WDM6-F90 TAG: T2_G10D_pgfrz
1172 
1173 
1174 
1175 
1176  if(ncr(i,k,3).gt.nrmin) then
1177  nfrzdtr = min(4.*pi*pfrz1*ncr(i,k,3)*(exp(pfrz2*supcolt)-1.) &
1178  *rslope3(i,k,1)*dtcld, ncr(i,k,3))
1179  ncr(i,k,3) = ncr(i,k,3) - nfrzdtr
1180  endif
1181  qrs(i,k,3) = qrs(i,k,3) + pfrzdtr
1182  t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtr
1183  qrs(i,k,1) = qrs(i,k,1) - pfrzdtr
1184  endif
1185  enddo
1186  enddo
1187 
1188  ! WDM6-F90 TAG: POST_G10D
1189 
1190  ! WDM6-F90 TAG: PRE_G10E
1191 
1192  do k = kts, kte
1193  do i = its, ite
1194  ncr(i,k,2) = max(ncr(i,k,2),0.0)
1195  ncr(i,k,3) = max(ncr(i,k,3),0.0)
1196  enddo
1197  enddo
1198 
1199  ! WDM6-F90 TAG: POST_G10E
1200 
1201  ! WDM6-F90 TAG: PRE_G11
1202 
1203  do k = kts, kte
1204  do i = its, ite
1205  qrs_tmp(i,k,1) = qrs(i,k,1)
1206  qrs_tmp(i,k,2) = qrs(i,k,2)
1207  qrs_tmp(i,k,3) = qrs(i,k,3)
1208  ncr_tmp(i,k) = ncr(i,k,3)
1209  enddo
1210  enddo
1211  call slope_wdm6(qrs_tmp,ncr_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2, &
1212  rslope3,work1,workn,its,ite,kts,kte)
1213  do k = kts, kte
1214  do i = its, ite
1215 
1216 
1217 
1218 
1219  avedia(i,k,2) = rslope(i,k,1)*((24.)**(.3333333))
1220 
1221  if(qci(i,k,1).le.qmin .or. ncr(i,k,2).le.ncmin) then
1222  rslopec(i,k) = rslopecmax
1223  rslopec2(i,k) = rslopec2max
1224  rslopec3(i,k) = rslopec3max
1225  else
1226  rslopec(i,k) = 1./lamdac(qci(i,k,1),den(i,k),ncr(i,k,2))
1227  rslopec2(i,k) = rslopec(i,k)*rslopec(i,k)
1228  rslopec3(i,k) = rslopec2(i,k)*rslopec(i,k)
1229  endif
1230 
1231 
1232 
1233 
1234  avedia(i,k,1) = rslopec(i,k)
1235  enddo
1236  enddo
1237 
1238  ! WDM6-F90 TAG: PRE_G12
1239 
1240  do k = kts, kte
1241  do i = its, ite
1242  ! WDM6-F90 TAG: G11V_DIFFAC_PRE1
1243  work1(i,k,1) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k,1))
1244  ! WDM6-F90 TAG: G11V_DIFFAC_POST1
1245  ! WDM6-F90 TAG: G11V_DIFFAC_PRE2
1246  work1(i,k,2) = diffac(xls,p(i,k),t(i,k),den(i,k),qs(i,k,2))
1247  ! WDM6-F90 TAG: G11V_DIFFAC_POST2
1248  ! WDM6-F90 TAG: G11V_VENFAC_PRE
1249  work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
1250  ! WDM6-F90 TAG: G11V_VENFAC_POST
1251  enddo
1252  enddo
1253 
1254  ! WDM6-F90 TAG: POST_G12
1255 
1256  ! WDM6-F90 TAG: POST_G11
1257 
1258 
1259 
1260 
1261 
1262 
1263  ! WDM6-F90 TAG: PRE_G13A
1264 
1265  do k = kts, kte
1266  do i = its, ite
1267  supsat = max(q(i,k),qmin)-qs(i,k,1)
1268  satdt = supsat/dtcld
1269 
1270 
1271 
1272 
1273  lencon = 2.7e-2*den(i,k)*qci(i,k,1)*(1.e20/16.*rslopec2(i,k) &
1274  *rslopec2(i,k)-0.4)
1275  lenconcr = max(1.2*lencon, qcrmin)
1276  if(qci(i,k,1).gt.qcr(i,k).and.ncr(i,k,2).gt.ncmin) then
1277  praut(i,k) = qck1*qci(i,k,1)**(7./3.)*ncr(i,k,2)**(-1./3.)
1278  praut(i,k) = min(praut(i,k),qci(i,k,1)/dtcld)
1279 
1280 
1281 
1282 
1283  nraut(i,k) = 3.5e9*den(i,k)*praut(i,k)
1284  if(qrs(i,k,1).gt.lenconcr) &
1285  nraut(i,k) = ncr(i,k,3)/qrs(i,k,1)*praut(i,k)
1286  nraut(i,k) = min(nraut(i,k),ncr(i,k,2)/dtcld)
1287  endif
1288 
1289 
1290 
1291 
1292 
1293 
1294  if(qrs(i,k,1).ge.lenconcr) then
1295  if(avedia(i,k,2).ge.di100) then
1296  nracw(i,k) = min(ncrk1*ncr(i,k,2)*ncr(i,k,3)*(rslopec3(i,k) &
1297  + 24.*rslope3(i,k,1)),ncr(i,k,2)/dtcld)
1298  pracw(i,k) = min(pi/6.*(denr/den(i,k))*ncrk1*ncr(i,k,2) &
1299  *ncr(i,k,3)*rslopec3(i,k)*(2.*rslopec3(i,k) &
1300  + 24.*rslope3(i,k,1)),qci(i,k,1)/dtcld)
1301  else
1302  nracw(i,k) = min(ncrk2*ncr(i,k,2)*ncr(i,k,3)*(2.*rslopec3(i,k) &
1303  *rslopec3(i,k)+5040.*rslope3(i,k,1) &
1304  *rslope3(i,k,1)),ncr(i,k,2)/dtcld)
1305  pracw(i,k) = min(pi/6.*(denr/den(i,k))*ncrk2*ncr(i,k,2) &
1306  *ncr(i,k,3)*rslopec3(i,k)*(6.*rslopec3(i,k) &
1307  *rslopec3(i,k)+5040.*rslope3(i,k,1)*rslope3(i,k,1)) &
1308  ,qci(i,k,1)/dtcld)
1309  endif
1310  endif
1311 
1312 
1313 
1314 
1315  if(avedia(i,k,1).ge.di100) then
1316  nccol(i,k) = ncrk1*ncr(i,k,2)*ncr(i,k,2)*rslopec3(i,k)
1317  else
1318  nccol(i,k) = 2.*ncrk2*ncr(i,k,2)*ncr(i,k,2)*rslopec3(i,k) &
1319  *rslopec3(i,k)
1320  endif
1321 
1322 
1323 
1324 
1325  if(qrs(i,k,1).ge.lenconcr) then
1326  if(avedia(i,k,2).lt.di100) then
1327  nrcol(i,k) = 5040.*ncrk2*ncr(i,k,3)*ncr(i,k,3)*rslope3(i,k,1) &
1328  *rslope3(i,k,1)
1329  elseif(avedia(i,k,2).ge.di100 .and. avedia(i,k,2).lt.di600) then
1330  nrcol(i,k) = 24.*ncrk1*ncr(i,k,3)*ncr(i,k,3)*rslope3(i,k,1)
1331  elseif(avedia(i,k,2).ge.di600 .and. avedia(i,k,2).lt.di2000) then
1332  coecol = -2.5e3*(avedia(i,k,2)-di600)
1333  nrcol(i,k) = 24.*exp(coecol)*ncrk1*ncr(i,k,3)*ncr(i,k,3) &
1334  *rslope3(i,k,1)
1335  else
1336  nrcol(i,k) = 0.
1337  endif
1338  endif
1339 
1340 
1341 
1342 
1343  if(qrs(i,k,1).gt.0.) then
1344  coeres = rslope(i,k,1)*sqrt(rslope(i,k,1)*rslopeb(i,k,1))
1345  prevp(i,k) = (rh(i,k,1)-1.)*ncr(i,k,3)*(precr1*rslope(i,k,1) &
1346  + precr2*work2(i,k)*coeres)/work1(i,k,1)
1347  if(prevp(i,k).lt.0.) then
1348  prevp(i,k) = max(prevp(i,k),-qrs(i,k,1)/dtcld)
1349  prevp(i,k) = max(prevp(i,k),satdt/2)
1350 
1351 
1352 
1353 
1354  if(prevp(i,k).eq.-qrs(i,k,1)/dtcld) then
1355  ncr(i,k,1) = ncr(i,k,1)+ncr(i,k,3)
1356  ncr(i,k,3) = 0.
1357  endif
1358  else if(prevp(i,k).eq.0.) then
1359 
1360  ! A zero kinetic rate must not become evaporation
1361  ! through a negative saturation-rate limiter.
1362  prevp(i,k) = 0.
1363  else
1364 
1365  prevp(i,k) = min(prevp(i,k),satdt/2)
1366  endif
1367  endif
1368  enddo
1369  enddo
1370 
1371  ! WDM6-F90 TAG: POST_G13A
1372 
1373 
1374 
1375 
1376 
1377 
1378 
1379  ! WDM6-F90 TAG: PRE_G13B
1380 
1381  do k = kts, kte
1382  do i = its, ite
1383  supcol = t0c-t(i,k)
1384  n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
1385  supsat = max(q(i,k),qmin)-qs(i,k,2)
1386  satdt = supsat/dtcld
1387  ifsat = 0
1388 
1389 
1390 
1391 
1392 
1393  temp = (den(i,k)*max(qci(i,k,2),qmin))
1394  temp = sqrt(sqrt(temp*temp*temp))
1395  xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6)
1396  eacrs = exp(0.07*(-supcol))
1397 
1398  xmi = den(i,k)*qci(i,k,2)/xni(i,k)
1399  diameter = min(dicon * sqrt(xmi),dimax)
1400  vt2i = 1.49e4*diameter**1.31
1401  vt2r=pvtr*rslopeb(i,k,1)*denfac(i,k)
1402  vt2s=pvts*rslopeb(i,k,2)*denfac(i,k)
1403  vt2g=pvtg*rslopeb(i,k,3)*denfac(i,k)
1404  qsum(i,k) = max((qrs(i,k,2)+qrs(i,k,3)),1.e-15)
1405  if(qsum(i,k) .gt. 1.e-15) then
1406  vt2ave=(vt2s*qrs(i,k,2)+vt2g*qrs(i,k,3))/(qsum(i,k))
1407  else
1408  vt2ave=0.
1409  endif
1410  if(supcol.gt.0. .and. qci(i,k,2).gt.qmin) then
1411  if(qrs(i,k,1).gt.qcrmin) then
1412 
1413 
1414 
1415 
1416  acrfac = 6.*rslope2(i,k,1)+4.*diameter*rslope(i,k,1) + diameter**2
1417  praci(i,k) = pi*qci(i,k,2)*ncr(i,k,3)*abs(vt2r-vt2i)*acrfac/4.
1418 
1419  praci(i,k) = praci(i,k)*min(max(0.0,qrs(i,k,1)/qci(i,k,2)),1.)**2
1420  praci(i,k) = min(praci(i,k),qci(i,k,2)/dtcld)
1421 
1422 
1423 
1424 
1425  piacr(i,k) = pi*pi*avtr*ncr(i,k,3)*denr*xni(i,k)*denfac(i,k) &
1426  *g7pbr*rslope3(i,k,1)*rslope2(i,k,1)*rslopeb(i,k,1) &
1427  /24./den(i,k)
1428 
1429  piacr(i,k) = piacr(i,k)*min(max(0.0,qci(i,k,2)/qrs(i,k,1)),1.)**2
1430  piacr(i,k) = min(piacr(i,k),qrs(i,k,1)/dtcld)
1431  endif
1432 
1433 
1434 
1435 
1436  if(ncr(i,k,3).gt.nrmin) then
1437  niacr(i,k) = pi*avtr*ncr(i,k,3)*xni(i,k)*denfac(i,k)*g4pbr &
1438  *rslope2(i,k,1)*rslopeb(i,k,1)/4.
1439 
1440  niacr(i,k) = niacr(i,k)*min(max(0.0,qci(i,k,2)/qrs(i,k,1)),1.)**2
1441  niacr(i,k) = min(niacr(i,k),ncr(i,k,3)/dtcld)
1442  endif
1443 
1444 
1445 
1446 
1447  if(qrs(i,k,2).gt.qcrmin) then
1448  acrfac = 2.*rslope3(i,k,2)+2.*diameter*rslope2(i,k,2) &
1449  + diameter**2*rslope(i,k,2)
1450  psaci(i,k) = pi*qci(i,k,2)*eacrs*n0s*n0sfac(i,k) &
1451  *abs(vt2ave-vt2i)*acrfac/4.
1452  psaci(i,k) = min(psaci(i,k),qci(i,k,2)/dtcld)
1453 
1454  ! WDM6-F90 TAG: T2_G13B_psaci
1455  endif
1456 
1457 
1458 
1459 
1460  if(qrs(i,k,3).gt.qcrmin) then
1461  egi = exp(0.07*(-supcol))
1462  acrfac = 2.*rslope3(i,k,3)+2.*diameter*rslope2(i,k,3) &
1463  + diameter**2*rslope(i,k,3)
1464  pgaci(i,k) = pi*egi*qci(i,k,2)*n0g*abs(vt2ave-vt2i)*acrfac/4.
1465  pgaci(i,k) = min(pgaci(i,k),qci(i,k,2)/dtcld)
1466  endif
1467  endif
1468 
1469 
1470 
1471 
1472  ! WDM6-F90 TAG: POST_G13B
1473 
1474  ! WDM6-F90 TAG: PRE_G13C
1475 
1476  if(qrs(i,k,2).gt.qcrmin .and. qci(i,k,1).gt.qmin) then
1477  psacw(i,k) = min(pacrc*n0sfac(i,k)*rslope3(i,k,2)*rslopeb(i,k,2) &
1478 
1479  *min(max(0.0,qrs(i,k,2)/qci(i,k,1)),1.)**2 &
1480  *qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
1481  endif
1482 
1483 
1484 
1485 
1486  if(qrs(i,k,2).gt.qcrmin .and. ncr(i,k,2).gt.ncmin) then
1487  nsacw(i,k) = min(pacrc*n0sfac(i,k)*rslope3(i,k,2)*rslopeb(i,k,2) &
1488 
1489  *min(max(0.0,qrs(i,k,2)/qci(i,k,1)),1.)**2 &
1490  *ncr(i,k,2)*denfac(i,k),ncr(i,k,2)/dtcld)
1491  endif
1492 
1493 
1494 
1495 
1496  if(qrs(i,k,3).gt.qcrmin .and. qci(i,k,1).gt.qmin) then
1497  pgacw(i,k) = min(pacrg*rslope3(i,k,3)*rslopeb(i,k,3)*qci(i,k,1) &
1498 
1499  *min(max(0.0,qrs(i,k,3)/qci(i,k,1)),1.)**2 &
1500  *denfac(i,k),qci(i,k,1)/dtcld)
1501  endif
1502 
1503 
1504 
1505 
1506  if(qrs(i,k,3).gt.qcrmin .and. ncr(i,k,2).gt.ncmin) then
1507  ngacw(i,k) = min(pacrg*rslope3(i,k,3)*rslopeb(i,k,3)*ncr(i,k,2) &
1508 
1509  *min(max(0.0,qrs(i,k,3)/qci(i,k,1)),1.)**2 &
1510  *denfac(i,k),ncr(i,k,2)/dtcld)
1511  endif
1512 
1513 
1514 
1515 
1516  if(qsum(i,k) .gt. 1.e-15 ) then
1517  paacw(i,k) = (qrs(i,k,2)*psacw(i,k)+qrs(i,k,3)*pgacw(i,k))/(qsum(i,k))
1518 
1519 
1520 
1521 
1522  naacw(i,k) = (qrs(i,k,2)*nsacw(i,k)+qrs(i,k,3)*ngacw(i,k))/(qsum(i,k))
1523  endif
1524 
1525  ! WDM6-F90 TAG: POST_G13C
1526 
1527  ! WDM6-F90 TAG: PRE_G13D
1528 
1529  if(qrs(i,k,2).gt.qcrmin .and. qrs(i,k,1).gt.qcrmin) then
1530  if(supcol.gt.0) then
1531  acrfac = 5.*rslope3(i,k,2)*rslope3(i,k,2) &
1532  + 4.*rslope3(i,k,2)*rslope2(i,k,2)*rslope(i,k,1) &
1533  + 1.5*rslope2(i,k,2)*rslope2(i,k,2)*rslope2(i,k,1)
1534  pracs(i,k) = pi*pi*ncr(i,k,3)*n0s*n0sfac(i,k)*abs(vt2r-vt2ave) &
1535  *(dens/den(i,k))*acrfac
1536 
1537  pracs(i,k) = pracs(i,k)*min(max(0.0,qrs(i,k,1)/qrs(i,k,2)),1.)**2
1538  pracs(i,k) = min(pracs(i,k),qrs(i,k,2)/dtcld)
1539  endif
1540 
1541 
1542 
1543 
1544  acrfac = 30.*rslope3(i,k,1)*rslope2(i,k,1)*rslope(i,k,2) &
1545  +10.*rslope2(i,k,1)*rslope2(i,k,1)*rslope2(i,k,2) &
1546  + 2.*rslope3(i,k,1)*rslope3(i,k,2)
1547  psacr(i,k) = pi*pi*ncr(i,k,3)*n0s*n0sfac(i,k)*abs(vt2ave-vt2r) &
1548  *(denr/den(i,k))*acrfac
1549 
1550  psacr(i,k) = psacr(i,k)*min(max(0.0,qrs(i,k,2)/qrs(i,k,1)),1.)**2
1551  psacr(i,k) = min(psacr(i,k),qrs(i,k,1)/dtcld)
1552  endif
1553  if(qrs(i,k,2).gt.qcrmin .and. ncr(i,k,3).gt.nrmin) then
1554 
1555 
1556 
1557 
1558  acrfac = 1.5*rslope2(i,k,1)*rslope(i,k,2) &
1559  + 1.0*rslope(i,k,1)*rslope2(i,k,2)+.5*rslope3(i,k,2)
1560  nsacr(i,k) = pi*ncr(i,k,3)*n0s*n0sfac(i,k)*abs(vt2ave-vt2r) &
1561  *acrfac
1562 
1563  nsacr(i,k) = nsacr(i,k)*min(max(0.0,qrs(i,k,2)/qrs(i,k,1)),1.)**2
1564  nsacr(i,k) = min(nsacr(i,k),ncr(i,k,3)/dtcld)
1565  endif
1566 
1567 
1568 
1569 
1570  if(qrs(i,k,3).gt.qcrmin .and. qrs(i,k,1).gt.qcrmin) then
1571  acrfac = 30.*rslope3(i,k,1)*rslope2(i,k,1)*rslope(i,k,3) &
1572  +10.*rslope2(i,k,1)*rslope2(i,k,1)*rslope2(i,k,3) &
1573  + 2.*rslope3(i,k,1)*rslope3(i,k,3)
1574  pgacr(i,k) = pi*pi*ncr(i,k,3)*n0g*abs(vt2ave-vt2r)*(denr/den(i,k)) &
1575  *acrfac
1576 
1577  pgacr(i,k) = pgacr(i,k)*min(max(0.0,qrs(i,k,3)/qrs(i,k,1)),1.)**2
1578  pgacr(i,k) = min(pgacr(i,k),qrs(i,k,1)/dtcld)
1579  endif
1580 
1581 
1582 
1583 
1584  if(qrs(i,k,3).gt.qcrmin .and. ncr(i,k,3).gt.nrmin) then
1585  acrfac = 1.5*rslope2(i,k,1)*rslope(i,k,3) &
1586  + 1.0*rslope(i,k,1)*rslope2(i,k,3) + .5*rslope3(i,k,3)
1587  ngacr(i,k) = pi*ncr(i,k,3)*n0g*abs(vt2ave-vt2r)*acrfac
1588 
1589  ngacr(i,k) = ngacr(i,k)*min(max(0.0,qrs(i,k,3)/qrs(i,k,1)),1.)**2
1590  ngacr(i,k) = min(ngacr(i,k),ncr(i,k,3)/dtcld)
1591  endif
1592 
1593 
1594 
1595 
1596 
1597 
1598  if(qrs(i,k,3).gt.qcrmin .and. qrs(i,k,2).gt.qcrmin) then
1599  pgacs(i,k) = 0.
1600  endif
1601  if(supcol.le.0) then
1602  xlf = xlf0
1603 
1604 
1605 
1606 
1607  if(qrs(i,k,2).gt.0.) &
1608  pseml(i,k) = min(max(cliq*supcol*(paacw(i,k)+psacr(i,k)) &
1609  /xlf,-qrs(i,k,2)/dtcld),0.)
1610 
1611 
1612 
1613 
1614  if (qrs(i,k,2).gt.qcrmin) then
1615  sfac = rslope(i,k,2)*n0s*n0sfac(i,k)/qrs(i,k,2)
1616  nseml(i,k) = -sfac*pseml(i,k)
1617  endif
1618 
1619 
1620 
1621 
1622  if(qrs(i,k,3).gt.0.) &
1623  pgeml(i,k) = min(max(cliq*supcol*(paacw(i,k)+pgacr(i,k))/xlf &
1624  ,-qrs(i,k,3)/dtcld),0.)
1625 
1626 
1627 
1628 
1629  if (qrs(i,k,3).gt.qcrmin) then
1630  gfac = rslope(i,k,3)*n0g/qrs(i,k,3)
1631  ngeml(i,k) = -gfac*pgeml(i,k)
1632  endif
1633  endif
1634  ! WDM6-F90 TAG: POST_G13D
1635  ! WDM6-F90 TAG: PRE_G13E
1636  if(supcol.gt.0) then
1637 
1638 
1639 
1640 
1641  if(qci(i,k,2).gt.0. .and. ifsat.ne.1) then
1642  pidep(i,k) = 4.*diameter*xni(i,k)*(rh(i,k,2)-1.)/work1(i,k,2)
1643  supice = satdt-prevp(i,k)
1644  if(pidep(i,k).lt.0.) then
1645  pidep(i,k) = max(max(pidep(i,k),satdt/2),supice)
1646  pidep(i,k) = max(pidep(i,k),-qci(i,k,2)/dtcld)
1647  else
1648  pidep(i,k) = min(min(pidep(i,k),satdt/2),supice)
1649  endif
1650  if(abs(prevp(i,k)+pidep(i,k)).ge.abs(satdt)) ifsat = 1
1651  endif
1652  ! WDM6-F90 TAG: T2_G13E_pidep
1653 
1654 
1655 
1656 
1657  if(qrs(i,k,2).gt.0. .and. ifsat.ne.1) then
1658  coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
1659  psdep(i,k) = (rh(i,k,2)-1.)*n0sfac(i,k)*(precs1*rslope2(i,k,2) &
1660  + precs2*work2(i,k)*coeres)/work1(i,k,2)
1661  supice = satdt-prevp(i,k)-pidep(i,k)
1662  if(psdep(i,k).lt.0.) then
1663  psdep(i,k) = max(psdep(i,k),-qrs(i,k,2)/dtcld)
1664  psdep(i,k) = max(max(psdep(i,k),satdt/2),supice)
1665  else
1666  psdep(i,k) = min(min(psdep(i,k),satdt/2),supice)
1667  endif
1668  if(abs(prevp(i,k)+pidep(i,k)+psdep(i,k)).ge.abs(satdt)) ifsat = 1
1669  ! WDM6-F90 TAG: T2_G13E_psdep
1670  endif
1671 
1672 
1673 
1674 
1675  if(qrs(i,k,3).gt.0. .and. ifsat.ne.1) then
1676  coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3))
1677  pgdep(i,k) = (rh(i,k,2)-1.)*(precg1*rslope2(i,k,3) &
1678  + precg2*work2(i,k)*coeres)/work1(i,k,2)
1679  supice = satdt-prevp(i,k)-pidep(i,k)-psdep(i,k)
1680  if(pgdep(i,k).lt.0.) then
1681  pgdep(i,k) = max(pgdep(i,k),-qrs(i,k,3)/dtcld)
1682  pgdep(i,k) = max(max(pgdep(i,k),satdt/2),supice)
1683  else
1684  pgdep(i,k) = min(min(pgdep(i,k),satdt/2),supice)
1685  endif
1686  if(abs(prevp(i,k)+pidep(i,k)+psdep(i,k)+pgdep(i,k)).ge. &
1687  abs(satdt)) ifsat = 1
1688  endif
1689 
1690 
1691 
1692 
1693  if(supsat.gt.0. .and. ifsat.ne.1) then
1694  supice = satdt-prevp(i,k)-pidep(i,k)-psdep(i,k)-pgdep(i,k)
1695  xni0 = 1.e3*exp(0.1*supcol)
1696  roqi0 = 4.92e-11*xni0**1.33
1697  ! WDM6-F90 TAG: T2_G13E_PIGEN_EXACT
1698  pigen(i,k) = max(0.,(roqi0/den(i,k)-max(qci(i,k,2),0.))/dtcld)
1699  ! WDM6-F90 TAG: T2_G13E_PIGEN_POST
1700  pigen(i,k) = min(min(pigen(i,k),satdt),supice)
1701  endif
1702  ! WDM6-F90 TAG: POST_G13E
1703 
1704 
1705 
1706 
1707 
1708  ! WDM6-F90 TAG: PRE_G13F
1709  if(qci(i,k,2).gt.0.) then
1710  qimax = roqimax/den(i,k)
1711  psaut(i,k) = max(0.,(qci(i,k,2)-qimax)/dtcld)
1712  endif
1713 
1714 
1715 
1716 
1717 
1718  if(qrs(i,k,2).gt.0.) then
1719  alpha2 = 1.e-3*exp(0.09*(-supcol))
1720  pgaut(i,k) = min(max(0.,alpha2*(qrs(i,k,2)-qs0)),qrs(i,k,2)/dtcld)
1721  endif
1722  ! WDM6-F90 TAG: POST_G13F
1723  endif
1724 
1725 
1726 
1727 
1728 
1729  ! WDM6-F90 TAG: PRE_G13G
1730  if(supcol.lt.0.) then
1731  if(qrs(i,k,2).gt.0. .and. rh(i,k,1).lt.1.) then
1732  coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2))
1733  psevp(i,k) = (rh(i,k,1)-1.)*n0sfac(i,k)*(precs1*rslope2(i,k,2) &
1734  +precs2*work2(i,k)*coeres)/work1(i,k,1)
1735  psevp(i,k) = min(max(psevp(i,k),-qrs(i,k,2)/dtcld),0.)
1736  endif
1737 
1738 
1739 
1740 
1741  if(qrs(i,k,3).gt.0. .and. rh(i,k,1).lt.1.) then
1742  coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3))
1743  pgevp(i,k) = (rh(i,k,1)-1.)*(precg1*rslope2(i,k,3) &
1744  + precg2*work2(i,k)*coeres)/work1(i,k,1)
1745  pgevp(i,k) = min(max(pgevp(i,k),-qrs(i,k,3)/dtcld),0.)
1746  endif
1747  endif
1748  ! WDM6-F90 TAG: POST_G13G
1749  enddo
1750  enddo
1751 
1752 
1753 
1754 
1755 
1756 
1757  ! WDM6-F90 TAG: PRE_G14
1758  do k = kts, kte
1759  do i = its, ite
1760 
1761  delta2=0.
1762  delta3=0.
1763  if(qrs(i,k,1).lt.1.e-4 .and. qrs(i,k,2).lt.1.e-4) delta2=1.
1764  if(qrs(i,k,1).lt.1.e-4) delta3=1.
1765  if(t(i,k).le.t0c) then
1766 
1767 
1768 
1769  value = max(qmin,qci(i,k,1))
1770  source = (praut(i,k)+pracw(i,k)+paacw(i,k)+paacw(i,k)) &
1771  *dtcld
1772  if (source.gt.value) then
1773  factor = value/source
1774  praut(i,k) = praut(i,k)*factor
1775  pracw(i,k) = pracw(i,k)*factor
1776  paacw(i,k) = paacw(i,k)*factor
1777  endif
1778 
1779 
1780 
1781  value = max(qmin,qci(i,k,2))
1782  source = (psaut(i,k)-pigen(i,k)-pidep(i,k)+praci(i,k)+psaci(i,k) &
1783  +pgaci(i,k))*dtcld
1784  if (source.gt.value) then
1785  factor = value/source
1786  psaut(i,k) = psaut(i,k)*factor
1787  pigen(i,k) = pigen(i,k)*factor
1788  pidep(i,k) = pidep(i,k)*factor
1789  praci(i,k) = praci(i,k)*factor
1790  psaci(i,k) = psaci(i,k)*factor
1791  pgaci(i,k) = pgaci(i,k)*factor
1792  endif
1793 
1794 
1795 
1796  value = max(qmin,qrs(i,k,1))
1797  source = (-praut(i,k)-prevp(i,k)-pracw(i,k)+piacr(i,k) &
1798  +psacr(i,k)+pgacr(i,k))*dtcld
1799  if (source.gt.value) then
1800  factor = value/source
1801  praut(i,k) = praut(i,k)*factor
1802  prevp(i,k) = prevp(i,k)*factor
1803  pracw(i,k) = pracw(i,k)*factor
1804  piacr(i,k) = piacr(i,k)*factor
1805  psacr(i,k) = psacr(i,k)*factor
1806  pgacr(i,k) = pgacr(i,k)*factor
1807  endif
1808 
1809 
1810 
1811  value = max(qmin,qrs(i,k,2))
1812  source = -(psdep(i,k)+psaut(i,k)-pgaut(i,k)+paacw(i,k) &
1813  +piacr(i,k)*delta3+praci(i,k)*delta3 &
1814  -pracs(i,k)*(1.-delta2)+psacr(i,k)*delta2 &
1815  +psaci(i,k)-pgacs(i,k) )*dtcld
1816  if (source.gt.value) then
1817  factor = value/source
1818  psdep(i,k) = psdep(i,k)*factor
1819  psaut(i,k) = psaut(i,k)*factor
1820  pgaut(i,k) = pgaut(i,k)*factor
1821  paacw(i,k) = paacw(i,k)*factor
1822  piacr(i,k) = piacr(i,k)*factor
1823  praci(i,k) = praci(i,k)*factor
1824  psaci(i,k) = psaci(i,k)*factor
1825  pracs(i,k) = pracs(i,k)*factor
1826  psacr(i,k) = psacr(i,k)*factor
1827  pgacs(i,k) = pgacs(i,k)*factor
1828  endif
1829 
1830 
1831 
1832  value = max(qmin,qrs(i,k,3))
1833  source = -(pgdep(i,k)+pgaut(i,k) &
1834  +piacr(i,k)*(1.-delta3)+praci(i,k)*(1.-delta3) &
1835  +psacr(i,k)*(1.-delta2)+pracs(i,k)*(1.-delta2) &
1836  +pgaci(i,k)+paacw(i,k)+pgacr(i,k)+pgacs(i,k))*dtcld
1837  if (source.gt.value) then
1838  factor = value/source
1839  pgdep(i,k) = pgdep(i,k)*factor
1840  pgaut(i,k) = pgaut(i,k)*factor
1841  piacr(i,k) = piacr(i,k)*factor
1842  praci(i,k) = praci(i,k)*factor
1843  psacr(i,k) = psacr(i,k)*factor
1844  pracs(i,k) = pracs(i,k)*factor
1845  paacw(i,k) = paacw(i,k)*factor
1846  pgaci(i,k) = pgaci(i,k)*factor
1847  pgacr(i,k) = pgacr(i,k)*factor
1848  pgacs(i,k) = pgacs(i,k)*factor
1849  endif
1850 
1851 
1852 
1853  value = max(ncmin,ncr(i,k,2))
1854  source = (nraut(i,k)+nccol(i,k)+nracw(i,k) &
1855  +naacw(i,k)+naacw(i,k))*dtcld
1856  if (source.gt.value) then
1857  factor = value/source
1858  nraut(i,k) = nraut(i,k)*factor
1859  nccol(i,k) = nccol(i,k)*factor
1860  nracw(i,k) = nracw(i,k)*factor
1861  naacw(i,k) = naacw(i,k)*factor
1862  endif
1863 
1864 
1865 
1866  value = max(nrmin,ncr(i,k,3))
1867  source = (-nraut(i,k)+nrcol(i,k)+niacr(i,k)+nsacr(i,k)+ngacr(i,k) &
1868  )*dtcld
1869  if (source.gt.value) then
1870  factor = value/source
1871  nraut(i,k) = nraut(i,k)*factor
1872  nrcol(i,k) = nrcol(i,k)*factor
1873  niacr(i,k) = niacr(i,k)*factor
1874  nsacr(i,k) = nsacr(i,k)*factor
1875  ngacr(i,k) = ngacr(i,k)*factor
1876  endif
1877 
1878  work2(i,k)=-(prevp(i,k)+psdep(i,k)+pgdep(i,k)+pigen(i,k)+pidep(i,k))
1879  ! WDM6-F90 TAG: T2_G14_COLD_VAPOR
1880 
1881  q(i,k) = q(i,k)+work2(i,k)*dtcld
1882  qci(i,k,1) = max(qci(i,k,1)-(praut(i,k)+pracw(i,k) &
1883  +paacw(i,k)+paacw(i,k))*dtcld,0.)
1884  qrs(i,k,1) = max(qrs(i,k,1)+(praut(i,k)+pracw(i,k) &
1885  +prevp(i,k)-piacr(i,k)-pgacr(i,k) &
1886  -psacr(i,k))*dtcld,0.)
1887  qci(i,k,2) = max(qci(i,k,2)-(psaut(i,k)+praci(i,k) &
1888  +psaci(i,k)+pgaci(i,k)-pigen(i,k)-pidep(i,k)) &
1889  *dtcld,0.)
1890  qrs(i,k,2) = max(qrs(i,k,2)+(psdep(i,k)+psaut(i,k)+paacw(i,k) &
1891  -pgaut(i,k)+piacr(i,k)*delta3 &
1892  +praci(i,k)*delta3+psaci(i,k)-pgacs(i,k) &
1893  -pracs(i,k)*(1.-delta2)+psacr(i,k)*delta2) &
1894  *dtcld,0.)
1895  qrs(i,k,3) = max(qrs(i,k,3)+(pgdep(i,k)+pgaut(i,k) &
1896  +piacr(i,k)*(1.-delta3) &
1897  +praci(i,k)*(1.-delta3)+psacr(i,k)*(1.-delta2) &
1898  +pracs(i,k)*(1.-delta2)+pgaci(i,k)+paacw(i,k) &
1899  +pgacr(i,k)+pgacs(i,k))*dtcld,0.)
1900  ncr(i,k,2) = max(ncr(i,k,2)+(-nraut(i,k)-nccol(i,k)-nracw(i,k) &
1901  -naacw(i,k)-naacw(i,k))*dtcld,0.)
1902  ncr(i,k,3) = max(ncr(i,k,3)+(nraut(i,k)-nrcol(i,k)-niacr(i,k) &
1903  -nsacr(i,k)-ngacr(i,k))*dtcld,0.)
1904  xlf = xls-xl(i,k)
1905  xlwork2 = -xls*(psdep(i,k)+pgdep(i,k)+pidep(i,k)+pigen(i,k)) &
1906  -xl(i,k)*prevp(i,k)-xlf*(piacr(i,k)+paacw(i,k) &
1907  +paacw(i,k)+pgacr(i,k)+psacr(i,k))
1908  ! WDM6-F90 TAG: T2_G14_COLD_THERMO
1909  t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
1910  else
1911 
1912 
1913 
1914  value = max(qmin,qci(i,k,1))
1915  source= (praut(i,k)+pracw(i,k)+paacw(i,k)+paacw(i,k)) &
1916  *dtcld
1917  if (source.gt.value) then
1918  factor = value/source
1919  praut(i,k) = praut(i,k)*factor
1920  pracw(i,k) = pracw(i,k)*factor
1921  paacw(i,k) = paacw(i,k)*factor
1922  endif
1923 
1924 
1925 
1926  value = max(qmin,qrs(i,k,1))
1927  source = (-paacw(i,k)-praut(i,k)+pseml(i,k)+pgeml(i,k) &
1928  -pracw(i,k)-paacw(i,k)-prevp(i,k))*dtcld
1929  if (source.gt.value) then
1930  factor = value/source
1931  praut(i,k) = praut(i,k)*factor
1932  prevp(i,k) = prevp(i,k)*factor
1933  pracw(i,k) = pracw(i,k)*factor
1934  paacw(i,k) = paacw(i,k)*factor
1935  pseml(i,k) = pseml(i,k)*factor
1936  pgeml(i,k) = pgeml(i,k)*factor
1937  endif
1938 
1939 
1940 
1941  value = max(qcrmin,qrs(i,k,2))
1942  source=(pgacs(i,k)-pseml(i,k)-psevp(i,k))*dtcld
1943  if (source.gt.value) then
1944  factor = value/source
1945  pgacs(i,k) = pgacs(i,k)*factor
1946  psevp(i,k) = psevp(i,k)*factor
1947  pseml(i,k) = pseml(i,k)*factor
1948  endif
1949 
1950 
1951 
1952  value = max(qcrmin,qrs(i,k,3))
1953  source=-(pgacs(i,k)+pgevp(i,k)+pgeml(i,k))*dtcld
1954  if (source.gt.value) then
1955  factor = value/source
1956  pgacs(i,k) = pgacs(i,k)*factor
1957  pgevp(i,k) = pgevp(i,k)*factor
1958  pgeml(i,k) = pgeml(i,k)*factor
1959  endif
1960 
1961 
1962 
1963  value = max(ncmin,ncr(i,k,2))
1964  source = (+nraut(i,k)+nccol(i,k)+nracw(i,k)+naacw(i,k) &
1965  +naacw(i,k))*dtcld
1966  if (source.gt.value) then
1967  factor = value/source
1968  nraut(i,k) = nraut(i,k)*factor
1969  nccol(i,k) = nccol(i,k)*factor
1970  nracw(i,k) = nracw(i,k)*factor
1971  naacw(i,k) = naacw(i,k)*factor
1972  endif
1973 
1974 
1975 
1976  value = max(nrmin,ncr(i,k,3))
1977  source = (-nraut(i,k)+nrcol(i,k)-nseml(i,k)-ngeml(i,k) &
1978  )*dtcld
1979  if (source.gt.value) then
1980  factor = value/source
1981  nraut(i,k) = nraut(i,k)*factor
1982  nrcol(i,k) = nrcol(i,k)*factor
1983  nseml(i,k) = nseml(i,k)*factor
1984  ngeml(i,k) = ngeml(i,k)*factor
1985  endif
1986 
1987  work2(i,k)=-(prevp(i,k)+psevp(i,k)+pgevp(i,k))
1988 
1989  q(i,k) = q(i,k)+work2(i,k)*dtcld
1990  qci(i,k,1) = max(qci(i,k,1)-(praut(i,k)+pracw(i,k) &
1991  +paacw(i,k)+paacw(i,k))*dtcld,0.)
1992  qrs(i,k,1) = max(qrs(i,k,1)+(praut(i,k)+pracw(i,k) &
1993  +prevp(i,k)+paacw(i,k)+paacw(i,k)-pseml(i,k) &
1994  -pgeml(i,k))*dtcld,0.)
1995  qrs(i,k,2) = max(qrs(i,k,2)+(psevp(i,k)-pgacs(i,k) &
1996  +pseml(i,k))*dtcld,0.)
1997  qrs(i,k,3) = max(qrs(i,k,3)+(pgacs(i,k)+pgevp(i,k) &
1998  +pgeml(i,k))*dtcld,0.)
1999  ncr(i,k,2) = max(ncr(i,k,2)+(-nraut(i,k)-nccol(i,k)-nracw(i,k) &
2000  -naacw(i,k)-naacw(i,k))*dtcld,0.)
2001  ncr(i,k,3) = max(ncr(i,k,3)+(nraut(i,k)-nrcol(i,k)+nseml(i,k) &
2002  +ngeml(i,k))*dtcld,0.)
2003  xlf = xls-xl(i,k)
2004  xlwork2 = -xl(i,k)*(prevp(i,k)+psevp(i,k)+pgevp(i,k)) &
2005  -xlf*(pseml(i,k)+pgeml(i,k))
2006  t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld
2007  endif
2008  enddo
2009  enddo
2010  ! WDM6-F90 TAG: POST_G14
2011  ! WDM6-F90 TAG: T2_G14_POST
2012 
2013 
2014 
2015 
2016  ! WDM6-F90 TAG: PRE_G15
2017  hsub = xls
2018  hvap = xlv0
2019  cvap = cpv
2020  ttp=t0c+0.01
2021  dldt=cvap-cliq
2022  xa=-dldt/rv
2023  xb=xa+hvap/(rv*ttp)
2024  dldti=cvap-cice
2025  xai=-dldti/rv
2026  xbi=xai+hsub/(rv*ttp)
2027  do k = kts, kte
2028  do i = its, ite
2029  tr=ttp/t(i,k)
2030  qs(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
2031  qs(i,k,1) = min(qs(i,k,1),0.99*p(i,k))
2032  qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
2033  qs(i,k,1) = max(qs(i,k,1),qmin)
2034  tr=ttp/t(i,k)
2035  if(t(i,k).lt.ttp) then
2036  qs(i,k,2)=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr))
2037  else
2038  qs(i,k,2)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
2039  endif
2040  qs(i,k,2) = min(qs(i,k,2),0.99*p(i,k))
2041  qs(i,k,2) = ep2 * qs(i,k,2) / (p(i,k) - qs(i,k,2))
2042  qs(i,k,2) = max(qs(i,k,2),qmin)
2043  rh(i,k,1) = max(q(i,k) / qs(i,k,1),qmin)
2044  enddo
2045  enddo
2046  ! WDM6-F90 TAG: POST_G15
2047  ! WDM6-F90 TAG: T2_G15_POST
2048 
2049  ! WDM6-F90 TAG: PRE_G16A
2050 
2051  do k = kts,kte_in
2052  do i = its,ite
2053  qrs_tmp(i,k,1) = qrs(i,k,1)
2054  qrs_tmp(i,k,2) = qrs(i,k,2)
2055  qrs_tmp(i,k,3) = qrs(i,k,3)
2056  ncr_tmp(i,k) = ncr(i,k,3)
2057  enddo
2058  enddo
2059 
2060  call slope_wdm6(qrs_tmp,ncr_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2, &
2061  rslope3,work1,workn,its,ite,kts,kte)
2062  do k = kts, kte
2063  do i = its, ite
2064 
2065 
2066 
2067 
2068  avedia(i,k,2) = rslope(i,k,1)*((24.)**(.3333333))
2069 
2070 
2071 
2072 
2073  if(avedia(i,k,2).le.di82) then
2074  ncr(i,k,2) = ncr(i,k,2)+ncr(i,k,3)
2075  ncr(i,k,3) = 0.
2076 
2077 
2078 
2079 
2080  qci(i,k,1) = qci(i,k,1)+qrs(i,k,1)
2081  qrs(i,k,1) = 0.
2082  endif
2083  enddo
2084  enddo
2085 
2086  ! WDM6-F90 TAG: POST_G16A
2087 
2088  ! WDM6-F90 TAG: PRE_G16B
2089 
2090  do k = kts, kte
2091  do i = its, ite
2092  ! Diagnostic: Print activation details at storm cell
2093  ! WDM6-F90 TAG: T2_G16B_ACT_PRE
2094 
2095  if(rh(i,k,1).gt.1.) then
2096  ! WDM6-F90 TAG: T2_G16B_ACT_EXACT
2097  ncact(i,k) = max(0.,((ncr(i,k,1)+ncr(i,k,2)) &
2098  *min(1.,(rh(i,k,1)/satmax)**actk) - ncr(i,k,2)))/dtcld
2099  ncact(i,k) =min(ncact(i,k),max(ncr(i,k,1),0.)/dtcld)
2100  pcact(i,k) = min(4.*pi*denr*(actr*1.e-6)**3*ncact(i,k)/ &
2101  (3.*den(i,k)),max(q(i,k),0.)/dtcld)
2102  q(i,k) = max(q(i,k)-pcact(i,k)*dtcld,0.)
2103  qci(i,k,1) = max(qci(i,k,1)+pcact(i,k)*dtcld,0.)
2104  ncr(i,k,1) = max(ncr(i,k,1)-ncact(i,k)*dtcld,0.)
2105  ncr(i,k,2) = max(ncr(i,k,2)+ncact(i,k)*dtcld,0.)
2106  t(i,k) = t(i,k)+pcact(i,k)*xl(i,k)/cpm(i,k)*dtcld
2107  ! Diagnostic: Print activation result
2108  ! WDM6-F90 TAG: T2_G16B_ACT_POST
2109  endif
2110 
2111 
2112 
2113 
2114 
2115 
2116  tr=ttp/t(i,k)
2117  qs(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr))
2118  qs(i,k,1) = min(qs(i,k,1),0.99*p(i,k))
2119  qs(i,k,1) = ep2 * qs(i,k,1) / (p(i,k) - qs(i,k,1))
2120  qs(i,k,1) = max(qs(i,k,1),qmin)
2121  work1(i,k,1) = conden(t(i,k),q(i,k),qs(i,k,1),xl(i,k),cpm(i,k))
2122  work2(i,k) = qci(i,k,1)+work1(i,k,1)
2123  pcond(i,k) = min(max(work1(i,k,1)/dtcld,0.),max(q(i,k),0.)/dtcld)
2124  if(qci(i,k,1).gt.0. .and. work1(i,k,1).lt.0.) &
2125  pcond(i,k) = max(work1(i,k,1),-qci(i,k,1))/dtcld
2126 
2127  ! Diagnostic: Print condensation details
2128  ! WDM6-F90 TAG: T2_G16B_COND_POST
2129 
2130  if(pcond(i,k).eq.-qci(i,k,1)/dtcld) then
2131  ! Diagnostic: Cloud evaporation - all droplets returned to CCN
2132  ncr(i,k,1) = ncr(i,k,1)+ncr(i,k,2)
2133 
2134  ncr(i,k,2) = 0.
2135  endif
2136 
2137  q(i,k) = q(i,k)-pcond(i,k)*dtcld
2138  qci(i,k,1) = max(qci(i,k,1)+pcond(i,k)*dtcld,0.)
2139  t(i,k) = t(i,k)+pcond(i,k)*xl(i,k)/cpm(i,k)*dtcld
2140  enddo
2141  enddo
2142 
2143  ! WDM6-F90 TAG: POST_G16B
2144 
2145 
2146 
2147 
2148  ! WDM6-F90 TAG: PRE_G17
2149 
2150  do k = kts, kte
2151  do i = its, ite
2152  if(qci(i,k,1).le.qmin) qci(i,k,1) = 0.0
2153  if(qci(i,k,2).le.qmin) qci(i,k,2) = 0.0
2154  if(qrs(i,k,1).ge.qcrmin .and. ncr(i,k,3) .ge. nrmin) then
2155  lamdr_tmp(i,k) = exp(log(((pidnr*ncr(i,k,3)) &
2156  /(den(i,k)*qrs(i,k,1))))*((.33333333)))
2157  if(lamdr_tmp(i,k) .le. lamdarmin) then
2158  lamdr_tmp(i,k) = lamdarmin
2159  ncr(i,k,3) = den(i,k)*qrs(i,k,1)*lamdr_tmp(i,k)**3/pidnr
2160  elseif(lamdr_tmp(i,k) .ge. lamdarmax) then
2161  lamdr_tmp(i,k) = lamdarmax
2162  ncr(i,k,3) = den(i,k)*qrs(i,k,1)*lamdr_tmp(i,k)**3/pidnr
2163  endif
2164  endif
2165  if(qci(i,k,1).ge.qmin .and. ncr(i,k,2) .ge. ncmin ) then
2166  lamdc_tmp(i,k) = exp(log(((pidnc*ncr(i,k,2)) &
2167  /(den(i,k)*qci(i,k,1))))*((.33333333)))
2168  if(lamdc_tmp(i,k) .le. lamdacmin) then
2169  lamdc_tmp(i,k) = lamdacmin
2170  ncr(i,k,2) = den(i,k)*qci(i,k,1)*lamdc_tmp(i,k)**3/pidnc
2171  elseif(lamdc_tmp(i,k) .ge. lamdacmax) then
2172  lamdc_tmp(i,k) = lamdacmax
2173  ncr(i,k,2) = den(i,k)*qci(i,k,1)*lamdc_tmp(i,k)**3/pidnc
2174  endif
2175  endif
2176  enddo
2177  enddo
2178 
2179  ! WDM6-F90 TAG: POST_G17
2180  enddo
2181 

Referenced by mp_wdm6_run(), and wdm6().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wdm6init()

subroutine mp_wdm6::wdm6init ( real(kind=kind_phys), intent(in)  den0,
real(kind=kind_phys), intent(in)  denr,
real(kind=kind_phys), intent(in)  dens,
real(kind=kind_phys), intent(in)  cl,
real(kind=kind_phys), intent(in)  cpv,
real(kind=kind_phys), intent(in)  ccn0,
integer, intent(in)  hail_opt,
logical, intent(in)  allowed_to_read 
)
private
2233 
2234  IMPLICIT NONE
2235 
2236 
2237  real(kind=kind_phys), INTENT(IN) :: den0,denr,dens,cl,cpv,ccn0
2238  INTEGER, INTENT(IN) :: hail_opt
2239  LOGICAL, INTENT(IN) :: allowed_to_read
2240 
2241 
2242 
2243  IF (hail_opt .eq. 1) THEN
2244  n0g = 4.e4
2245  deng = 700.
2246  avtg = 285.0
2247  bvtg = 0.8
2248  lamdagmax = 2.e4
2249  ELSE
2250  n0g = 4.e6
2251  deng = 500
2252  avtg = 330.0
2253  bvtg = 0.8
2254  lamdagmax = 6.e4
2255  ENDIF
2256 
2257  pi = 4.*atan(1.)
2258  xlv1 = cl-cpv
2259 
2260  qc0 = 4./3.*pi*denr*r0**3.*xncr0/den0
2261  qc1 = 4./3.*pi*denr*r0**3.*xncr1/den0
2262  qck1 = .104*9.8*peaut/(denr)**(1./3.)/xmyu*den0**(4./3.)
2263  pidnc = pi*denr/6.
2264 
2265  bvtr1 = 1.+bvtr
2266  bvtr2 = 2.+bvtr
2267  bvtr3 = 3.+bvtr
2268  bvtr4 = 4.+bvtr
2269  bvtr5 = 5.+bvtr
2270  bvtr6 = 6.+bvtr
2271  bvtr7 = 7.+bvtr
2272  bvtr2o5 = 2.5+.5*bvtr
2273  bvtr3o5 = 3.5+.5*bvtr
2274  g1pbr = rgmma(bvtr1)
2275  g2pbr = rgmma(bvtr2)
2276  g3pbr = rgmma(bvtr3)
2277  g4pbr = rgmma(bvtr4)
2278  g5pbr = rgmma(bvtr5)
2279  g6pbr = rgmma(bvtr6)
2280  g7pbr = rgmma(bvtr7)
2281  g5pbro2 = rgmma(bvtr2o5)
2282  g7pbro2 = rgmma(bvtr3o5)
2283  pvtr = avtr*g5pbr/24.
2284  pvtrn = avtr*g2pbr
2285  eacrr = 1.0
2286  pacrr = pi*n0r*avtr*g3pbr*.25*eacrr
2287  precr1 = 2.*pi*1.56
2288  precr2 = 2.*pi*.31*avtr**.5*g7pbro2
2289  pidn0r = pi*denr*n0r
2290  pidnr = 4.*pi*denr
2291 
2292  xmmax = (dimax/dicon)**2
2293  roqimax = 2.08e22*dimax**8
2294 
2295  bvts1 = 1.+bvts
2296  bvts2 = 2.5+.5*bvts
2297  bvts3 = 3.+bvts
2298  bvts4 = 4.+bvts
2299  g1pbs = rgmma(bvts1)
2300  g3pbs = rgmma(bvts3)
2301  g4pbs = rgmma(bvts4)
2302  g5pbso2 = rgmma(bvts2)
2303  pvts = avts*g4pbs/6.
2304  pacrs = pi*n0s*avts*g3pbs*.25
2305  precs1 = 4.*n0s*.65
2306  precs2 = 4.*n0s*.44*avts**.5*g5pbso2
2307  pidn0s = pi*dens*n0s
2308 
2309  pacrc = pi*n0s*avts*g3pbs*.25*eacrc
2310 
2311  bvtg1 = 1.+bvtg
2312  bvtg2 = 2.5+.5*bvtg
2313  bvtg3 = 3.+bvtg
2314  bvtg4 = 4.+bvtg
2315  g1pbg = rgmma(bvtg1)
2316  g3pbg = rgmma(bvtg3)
2317  g4pbg = rgmma(bvtg4)
2318  g5pbgo2 = rgmma(bvtg2)
2319  pacrg = pi*n0g*avtg*g3pbg*.25
2320  pvtg = avtg*g4pbg/6.
2321  precg1 = 2.*pi*n0g*.78
2322  precg2 = 2.*pi*n0g*.31*avtg**.5*g5pbgo2
2323  pidn0g = pi*deng*n0g
2324 
2325  rslopecmax = 1./lamdacmax
2326  rslopermax = 1./lamdarmax
2327  rslopesmax = 1./lamdasmax
2328  rslopegmax = 1./lamdagmax
2329  rsloperbmax = rslopermax ** bvtr
2330  rslopesbmax = rslopesmax ** bvts
2331  rslopegbmax = rslopegmax ** bvtg
2332  rslopec2max = rslopecmax * rslopecmax
2333  rsloper2max = rslopermax * rslopermax
2334  rslopes2max = rslopesmax * rslopesmax
2335  rslopeg2max = rslopegmax * rslopegmax
2336  rslopec3max = rslopec2max * rslopecmax
2337  rsloper3max = rsloper2max * rslopermax
2338  rslopes3max = rslopes2max * rslopesmax
2339  rslopeg3max = rslopeg2max * rslopegmax
2340 
2341 
2342 
2343 
2344 
2345  xam_r = pi*denr/6.
2346  xbm_r = 3.
2347  xmu_r = 1.
2348  xam_s = pi*dens/6.
2349  xbm_s = 3.
2350  xmu_s = 0.
2351  xam_g = pi*deng/6.
2352  xbm_g = 3.
2353  xmu_g = 0.
2354 
2355  call radar_init
2356 
2357 

Referenced by mp_wdm6_init().

Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ actk

real(kind=kind_phys), parameter, private mp_wdm6::actk = 0.6
private
91  real(kind=kind_phys), parameter, private :: actk = 0.6

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ actr

real(kind=kind_phys), parameter, private mp_wdm6::actr = 1.5
private
92  real(kind=kind_phys), parameter, private :: actr = 1.5

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ alpha

real(kind=kind_phys), parameter, private mp_wdm6::alpha = .12
private
62  real(kind=kind_phys), parameter, private :: alpha = .12

Referenced by effectrad_wdm6(), refl10cm_wdm6(), slope_snow(), slope_wdm6(), and wdm62d().

◆ avtg

real(kind=kind_phys), save mp_wdm6::avtg
private

Referenced by wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ avtr

real(kind=kind_phys), parameter, private mp_wdm6::avtr = 841.9
private
63  real(kind=kind_phys), parameter, private :: avtr = 841.9

Referenced by WSM6::AdvanceColumns(), WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), wdm62d(), and wdm6init().

◆ avts

real(kind=kind_phys), parameter, private mp_wdm6::avts = 11.72
private
65  real(kind=kind_phys), parameter, private :: avts = 11.72

Referenced by WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), and wdm6init().

◆ bvtg

real(kind=kind_phys), save mp_wdm6::bvtg
private

Referenced by slope_graup(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ bvtg1

real(kind=kind_phys), save mp_wdm6::bvtg1
private

Referenced by wdm6init().

◆ bvtg2

real(kind=kind_phys), save mp_wdm6::bvtg2
private

Referenced by wdm6init().

◆ bvtg3

real(kind=kind_phys), save mp_wdm6::bvtg3
private

Referenced by wdm6init().

◆ bvtg4

real(kind=kind_phys), save mp_wdm6::bvtg4
private

Referenced by wdm6init().

◆ bvtr

real(kind=kind_phys), parameter, private mp_wdm6::bvtr = 0.8
private
64  real(kind=kind_phys), parameter, private :: bvtr = 0.8

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), slope_rain(), slope_wdm6(), and wdm6init().

◆ bvtr1

real(kind=kind_phys), save mp_wdm6::bvtr1
private

Referenced by wdm6init().

◆ bvtr2

real(kind=kind_phys), save mp_wdm6::bvtr2
private

Referenced by wdm6init().

◆ bvtr2o5

real(kind=kind_phys), save mp_wdm6::bvtr2o5
private

Referenced by wdm6init().

◆ bvtr3

real(kind=kind_phys), save mp_wdm6::bvtr3
private

Referenced by wdm6init().

◆ bvtr3o5

real(kind=kind_phys), save mp_wdm6::bvtr3o5
private

Referenced by wdm6init().

◆ bvtr4

real(kind=kind_phys), save mp_wdm6::bvtr4
private

Referenced by wdm6init().

◆ bvtr5

real(kind=kind_phys), save mp_wdm6::bvtr5
private

Referenced by wdm6init().

◆ bvtr6

real(kind=kind_phys), save mp_wdm6::bvtr6
private

Referenced by wdm6init().

◆ bvtr7

real(kind=kind_phys), save mp_wdm6::bvtr7
private

Referenced by wdm6init().

◆ bvts

real(kind=kind_phys), parameter, private mp_wdm6::bvts = .41
private
66  real(kind=kind_phys), parameter, private :: bvts = .41

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), slope_snow(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), and wdm6init().

◆ bvts1

real(kind=kind_phys), save mp_wdm6::bvts1
private

Referenced by wdm6init().

◆ bvts2

real(kind=kind_phys), save mp_wdm6::bvts2
private

Referenced by wdm6init().

◆ bvts3

real(kind=kind_phys), save mp_wdm6::bvts3
private

Referenced by wdm6init().

◆ bvts4

real(kind=kind_phys), save mp_wdm6::bvts4
private

Referenced by wdm6init().

◆ deng

real(kind=kind_phys), save mp_wdm6::deng
private

Referenced by wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ dens

real(kind=kind_phys), parameter, private mp_wdm6::dens = 100.0
private
61  real(kind=kind_phys), parameter, private :: dens = 100.0

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), ERF::erf_enforce_hse(), ERF::initHSE(), ERF::MakeHorizontalAverages(), mp_wdm6_init(), wdm62d(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ di100

real(kind=kind_phys), parameter, private mp_wdm6::di100 = 1.e-4
private
95  real(kind=kind_phys), parameter, private :: di100 = 1.e-4

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ di15

real(kind=kind_phys), parameter, private mp_wdm6::di15 = 15.e-6
private
99  real(kind=kind_phys), parameter, private :: di15 = 15.e-6

◆ di2000

real(kind=kind_phys), parameter, private mp_wdm6::di2000 = 2000.e-6
private
97  real(kind=kind_phys), parameter, private :: di2000 = 2000.e-6

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ di600

real(kind=kind_phys), parameter, private mp_wdm6::di600 = 6.e-4
private
96  real(kind=kind_phys), parameter, private :: di600 = 6.e-4

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ di82

real(kind=kind_phys), parameter, private mp_wdm6::di82 = 82.e-6
private
98  real(kind=kind_phys), parameter, private :: di82 = 82.e-6

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ dicon

real(kind=kind_phys), parameter, private mp_wdm6::dicon = 11.9
private
81  real(kind=kind_phys), parameter, private :: dicon = 11.9

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), WDM6::initialize_coeffs(), wdm62d(), and wdm6init().

◆ dimax

real(kind=kind_phys), parameter, private mp_wdm6::dimax = 500.e-6
private
82  real(kind=kind_phys), parameter, private :: dimax = 500.e-6

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), wdm62d(), and wdm6init().

◆ dtcldcr

real(kind=kind_phys), parameter, private mp_wdm6::dtcldcr = 120.
private
56  real(kind=kind_phys), parameter, private :: dtcldcr = 120.

Referenced by WSM6::AdvanceColumns(), and wdm62d().

◆ eacrc

real(kind=kind_phys), parameter, private mp_wdm6::eacrc = 1.0
private
88  real(kind=kind_phys), parameter, private :: eacrc = 1.0

Referenced by WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), and wdm6init().

◆ eacrr

real(kind=kind_phys), save mp_wdm6::eacrr
private

Referenced by wdm6init().

◆ g1pbg

real(kind=kind_phys), save mp_wdm6::g1pbg
private

Referenced by wdm6init().

◆ g1pbr

real(kind=kind_phys), save mp_wdm6::g1pbr
private

Referenced by wdm6init().

◆ g1pbs

real(kind=kind_phys), save mp_wdm6::g1pbs
private

Referenced by wdm6init().

◆ g2pbr

real(kind=kind_phys), save mp_wdm6::g2pbr
private

Referenced by wdm6init().

◆ g3pbg

real(kind=kind_phys), save mp_wdm6::g3pbg
private

Referenced by wdm6init().

◆ g3pbr

real(kind=kind_phys), save mp_wdm6::g3pbr
private

Referenced by wdm6init().

◆ g3pbs

real(kind=kind_phys), save mp_wdm6::g3pbs
private

Referenced by wdm6init().

◆ g4pbg

real(kind=kind_phys), save mp_wdm6::g4pbg
private

Referenced by wdm6init().

◆ g4pbr

real(kind=kind_phys), save mp_wdm6::g4pbr
private

Referenced by wdm62d(), and wdm6init().

◆ g4pbs

real(kind=kind_phys), save mp_wdm6::g4pbs
private

Referenced by wdm6init().

◆ g5pbgo2

real(kind=kind_phys), save mp_wdm6::g5pbgo2
private

Referenced by wdm6init().

◆ g5pbr

real(kind=kind_phys), save mp_wdm6::g5pbr
private

Referenced by wdm6init().

◆ g5pbro2

real(kind=kind_phys), save mp_wdm6::g5pbro2
private

Referenced by wdm6init().

◆ g5pbso2

real(kind=kind_phys), save mp_wdm6::g5pbso2
private

Referenced by wdm6init().

◆ g6pbr

real(kind=kind_phys), save mp_wdm6::g6pbr
private

Referenced by WSM6::AdvanceColumns(), and wdm6init().

◆ g7pbr

real(kind=kind_phys), save mp_wdm6::g7pbr
private

Referenced by wdm62d(), and wdm6init().

◆ g7pbro2

real(kind=kind_phys), save mp_wdm6::g7pbro2
private

Referenced by wdm6init().

◆ kind_phys

integer, parameter mp_wdm6::kind_phys = c_double
10  integer, parameter :: kind_phys = c_double

Referenced by rgmma().

◆ lamdacmax

real(kind=kind_phys), parameter, private mp_wdm6::lamdacmax = 5.e5
private
69  real(kind=kind_phys), parameter, private :: lamdacmax = 5.e5

Referenced by WDM6::AdvanceColumns(), WDM6::initialize_coeffs(), wdm62d(), and wdm6init().

◆ lamdacmin

real(kind=kind_phys), parameter, private mp_wdm6::lamdacmin = 2.e4
private
70  real(kind=kind_phys), parameter, private :: lamdacmin = 2.e4

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ lamdagmax

real(kind=kind_phys), save mp_wdm6::lamdagmax
private

Referenced by wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ lamdarmax

real(kind=kind_phys), parameter, private mp_wdm6::lamdarmax = 5.e4
private
71  real(kind=kind_phys), parameter, private :: lamdarmax = 5.e4

Referenced by WDM6::AdvanceColumns(), WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), wdm62d(), and wdm6init().

◆ lamdarmin

real(kind=kind_phys), parameter, private mp_wdm6::lamdarmin = 2.e3
private
72  real(kind=kind_phys), parameter, private :: lamdarmin = 2.e3

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ lamdasmax

real(kind=kind_phys), parameter, private mp_wdm6::lamdasmax = 1.e5
private
73  real(kind=kind_phys), parameter, private :: lamdasmax = 1.e5

Referenced by WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), and wdm6init().

◆ n0g

real(kind=kind_phys), save mp_wdm6::n0g
private

Referenced by refl10cm_wdm6(), wdm62d(), and wdm6init().

◆ n0r

real(kind=kind_phys), parameter, private mp_wdm6::n0r = 8.e6
private
57  real(kind=kind_phys), parameter, private :: n0r = 8.e6

Referenced by wdm6init().

◆ n0s

real(kind=kind_phys), parameter, private mp_wdm6::n0s = 2.e6
private
58  real(kind=kind_phys), parameter, private :: n0s = 2.e6

Referenced by effectrad_wdm6(), refl10cm_wdm6(), slope_snow(), slope_wdm6(), wdm62d(), and wdm6init().

◆ n0smax

real(kind=kind_phys), parameter, private mp_wdm6::n0smax = 1.e11
private
60  real(kind=kind_phys), parameter, private :: n0smax = 1.e11

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), effectrad_wdm6(), refl10cm_wdm6(), slope_snow(), slope_wdm6(), wdm62d(), and wdm6_nislfv_rain_plm6_column().

◆ ncmin

real(kind=kind_phys), parameter, private mp_wdm6::ncmin = 1.e1
private
86  real(kind=kind_phys), parameter, private :: ncmin = 1.e1

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ ncrk1

real(kind=kind_phys), parameter, private mp_wdm6::ncrk1 = 3.03e3
private
93  real(kind=kind_phys), parameter, private :: ncrk1 = 3.03e3

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ ncrk2

real(kind=kind_phys), parameter, private mp_wdm6::ncrk2 = 2.59e15
private
94  real(kind=kind_phys), parameter, private :: ncrk2 = 2.59e15

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ nrmin

real(kind=kind_phys), parameter, private mp_wdm6::nrmin = 1.e-2
private
87  real(kind=kind_phys), parameter, private :: nrmin = 1.e-2

Referenced by WDM6::AdvanceColumns(), slope_rain(), slope_wdm6(), and wdm62d().

◆ pacrc

real(kind=kind_phys), save mp_wdm6::pacrc
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ pacrg

real(kind=kind_phys), save mp_wdm6::pacrg
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ pacrr

real(kind=kind_phys), save mp_wdm6::pacrr
private

Referenced by WSM6::AdvanceColumns(), and wdm6init().

◆ pacrs

real(kind=kind_phys), save mp_wdm6::pacrs
private

Referenced by wdm6init().

◆ peaut

real(kind=kind_phys), parameter, private mp_wdm6::peaut = .55
private
76  real(kind=kind_phys), parameter, private :: peaut = .55

Referenced by WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), and wdm6init().

◆ pfrz1

real(kind=kind_phys), parameter, private mp_wdm6::pfrz1 = 100.
private
83  real(kind=kind_phys), parameter, private :: pfrz1 = 100.

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), and wdm62d().

◆ pfrz2

real(kind=kind_phys), parameter, private mp_wdm6::pfrz2 = 0.66
private
84  real(kind=kind_phys), parameter, private :: pfrz2 = 0.66

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), and wdm62d().

◆ pi

real(kind=kind_phys), save mp_wdm6::pi
private

Referenced by effectrad_wdm6(), refl10cm_wdm6(), wdm62d(), and wdm6init().

◆ pidn0g

real(kind=kind_phys), save mp_wdm6::pidn0g
private

Referenced by slope_graup(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ pidn0r

real(kind=kind_phys), save mp_wdm6::pidn0r
private

Referenced by wdm6init(), and wsm6_nislfv_rain_plm_scratch().

◆ pidn0s

real(kind=kind_phys), save mp_wdm6::pidn0s
private

Referenced by effectrad_wdm6(), slope_snow(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ pidnc

real(kind=kind_phys), save mp_wdm6::pidnc
private

Referenced by effectrad_wdm6(), wdm62d(), and wdm6init().

◆ pidnr

real(kind=kind_phys), save mp_wdm6::pidnr
private

Referenced by slope_rain(), slope_wdm6(), wdm62d(), and wdm6init().

◆ precg1

real(kind=kind_phys), save mp_wdm6::precg1
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ precg2

real(kind=kind_phys), save mp_wdm6::precg2
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ precr1

real(kind=kind_phys), save mp_wdm6::precr1
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ precr2

real(kind=kind_phys), save mp_wdm6::precr2
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ precs1

real(kind=kind_phys), save mp_wdm6::precs1
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ precs2

real(kind=kind_phys), save mp_wdm6::precs2
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ pvtg

real(kind=kind_phys), save mp_wdm6::pvtg
private

Referenced by WSM6::AdvanceColumns(), slope_graup(), slope_wdm6(), wdm62d(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ pvtr

real(kind=kind_phys), save mp_wdm6::pvtr
private

Referenced by WSM6::AdvanceColumns(), slope_rain(), slope_wdm6(), wdm62d(), wdm6init(), and wsm6_nislfv_rain_plm_scratch().

◆ pvtrn

real(kind=kind_phys), save mp_wdm6::pvtrn
private

Referenced by slope_rain(), slope_wdm6(), and wdm6init().

◆ pvts

real(kind=kind_phys), save mp_wdm6::pvts
private

Referenced by WSM6::AdvanceColumns(), slope_snow(), slope_wdm6(), wdm62d(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ qc0

real(kind=kind_phys), save mp_wdm6::qc0
private
100  real(kind=kind_phys), save :: &
101  qc0,qc1,qck1,pidnc,bvtr1,bvtr2,bvtr3,bvtr4,bvtr5, &
102  bvtr6,bvtr7, bvtr2o5,bvtr3o5, &
103  g1pbr,g2pbr,g3pbr,g4pbr,g5pbr,g6pbr,g7pbr, &
104  g5pbro2,g7pbro2,pi, &
105  pvtr,pvtrn,eacrr,pacrr,pidn0r,pidnr, &
106  precr1,precr2,xmmax,roqimax,bvts1,bvts2, &
107  bvts3,bvts4,g1pbs,g3pbs,g4pbs,g5pbso2, &
108  pvts,pacrs,precs1,precs2,pidn0s,xlv1,pacrc, &
109  bvtg1,bvtg2,bvtg3,bvtg4,g1pbg,g3pbg,g4pbg, &
110  g5pbgo2,pvtg,pacrg,precg1,precg2,pidn0g, &
111  n0g,avtg,bvtg,deng,lamdagmax, &
112  rslopecmax,rslopec2max,rslopec3max, &
113  rslopermax,rslopesmax,rslopegmax, &
114  rsloperbmax,rslopesbmax,rslopegbmax, &
115  rsloper2max,rslopes2max,rslopeg2max, &
116  rsloper3max,rslopes3max,rslopeg3max

Referenced by WSM6::AdvanceColumns(), ERF::derive_diag_profiles_stag(), wdm62d(), and wdm6init().

◆ qc1

real(kind=kind_phys), save mp_wdm6::qc1
private

Referenced by ERF::derive_diag_profiles_stag(), wdm62d(), and wdm6init().

◆ qck1

real(kind=kind_phys), save mp_wdm6::qck1
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ qcrmin

real(kind=kind_phys), parameter, private mp_wdm6::qcrmin = 1.e-9
private
85  real(kind=kind_phys), parameter, private :: qcrmin = 1.e-9

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), slope_graup(), slope_rain(), slope_snow(), slope_wdm6(), wdm62d(), and wdm6_nislfv_rain_plm6_column().

◆ qs0

real(kind=kind_phys), parameter, private mp_wdm6::qs0 = 6.e-4
private
89  real(kind=kind_phys), parameter, private :: qs0 = 6.e-4

Referenced by WDM6::AdvanceColumns(), WSM6::AdvanceColumns(), and wdm62d().

◆ r0

real(kind=kind_phys), parameter, private mp_wdm6::r0 = .8e-5
private
75  real(kind=kind_phys), parameter, private :: r0 = .8e-5

Referenced by ERF::advance_dycore(), ApplySpongeZoneBCsForCC(), ApplySpongeZoneBCsForMom(), WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), make_buoyancy(), make_mom_sources(), make_sources(), ParallelFor(), and wdm6init().

◆ roqimax

real(kind=kind_phys), save mp_wdm6::roqimax
private

Referenced by WSM6::AdvanceColumns(), wdm62d(), and wdm6init().

◆ rslopec2max

real(kind=kind_phys), save mp_wdm6::rslopec2max
private

Referenced by wdm62d(), and wdm6init().

◆ rslopec3max

real(kind=kind_phys), save mp_wdm6::rslopec3max
private

Referenced by wdm62d(), and wdm6init().

◆ rslopecmax

real(kind=kind_phys), save mp_wdm6::rslopecmax
private

Referenced by wdm62d(), and wdm6init().

◆ rslopeg2max

real(kind=kind_phys), save mp_wdm6::rslopeg2max
private

Referenced by slope_graup(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ rslopeg3max

real(kind=kind_phys), save mp_wdm6::rslopeg3max
private

Referenced by slope_graup(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ rslopegbmax

real(kind=kind_phys), save mp_wdm6::rslopegbmax
private

Referenced by slope_graup(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ rslopegmax

real(kind=kind_phys), save mp_wdm6::rslopegmax
private

Referenced by slope_graup(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ rsloper2max

real(kind=kind_phys), save mp_wdm6::rsloper2max
private

Referenced by slope_rain(), slope_wdm6(), wdm6init(), and wsm6_nislfv_rain_plm_scratch().

◆ rsloper3max

real(kind=kind_phys), save mp_wdm6::rsloper3max
private

Referenced by slope_rain(), slope_wdm6(), wdm6init(), and wsm6_nislfv_rain_plm_scratch().

◆ rsloperbmax

real(kind=kind_phys), save mp_wdm6::rsloperbmax
private

Referenced by slope_rain(), slope_wdm6(), wdm6init(), and wsm6_nislfv_rain_plm_scratch().

◆ rslopermax

real(kind=kind_phys), save mp_wdm6::rslopermax
private

Referenced by slope_rain(), slope_wdm6(), wdm6init(), and wsm6_nislfv_rain_plm_scratch().

◆ rslopes2max

real(kind=kind_phys), save mp_wdm6::rslopes2max
private

Referenced by slope_snow(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ rslopes3max

real(kind=kind_phys), save mp_wdm6::rslopes3max
private

Referenced by slope_snow(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ rslopesbmax

real(kind=kind_phys), save mp_wdm6::rslopesbmax
private

Referenced by slope_snow(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ rslopesmax

real(kind=kind_phys), save mp_wdm6::rslopesmax
private

Referenced by slope_snow(), slope_wdm6(), wdm6_nislfv_rain_plm6_column(), wdm6init(), and wsm6_nislfv_rain_plm6_scratch().

◆ satmax

real(kind=kind_phys), parameter, private mp_wdm6::satmax = 1.0048
private
90  real(kind=kind_phys), parameter, private :: satmax = 1.0048

Referenced by WDM6::AdvanceColumns(), and wdm62d().

◆ xlv1

real(kind=kind_phys), save mp_wdm6::xlv1
private

Referenced by wdm62d(), and wdm6init().

◆ xmmax

real(kind=kind_phys), save mp_wdm6::xmmax
private

Referenced by wdm6init().

◆ xmyu

real(kind=kind_phys), parameter, private mp_wdm6::xmyu = 1.718e-5
private
80  real(kind=kind_phys), parameter, private :: xmyu = 1.718e-5

Referenced by WDM6::initialize_coeffs(), WSM6::initialize_coeffs(), and wdm6init().

◆ xncr

real(kind=kind_phys), parameter, private mp_wdm6::xncr = 3.e8
private
77  real(kind=kind_phys), parameter, private :: xncr = 3.e8

Referenced by WSM6::initialize_coeffs().

◆ xncr0

real(kind=kind_phys), parameter, private mp_wdm6::xncr0 = 5.e7
private
78  real(kind=kind_phys), parameter, private :: xncr0 = 5.e7

Referenced by WDM6::initialize_coeffs(), and wdm6init().

◆ xncr1

real(kind=kind_phys), parameter, private mp_wdm6::xncr1 = 5.e8
private
79  real(kind=kind_phys), parameter, private :: xncr1 = 5.e8

Referenced by WDM6::initialize_coeffs(), and wdm6init().