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

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
2198 
2199  implicit none
2200 
2201  REAL(kind=kind_phys) t,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c,dldt,xa,xb,dldti, &
2202  xai,xbi,ttp,tr
2203  INTEGER ice
2204 
2205  ttp=t0c+0.01_kind_phys
2206  dldt=cvap-cliq
2207  xa=-dldt/rv
2208  xb=xa+hvap/(rv*ttp)
2209  dldti=cvap-cice
2210  xai=-dldti/rv
2211  xbi=xai+hsub/(rv*ttp)
2212  tr=ttp/t
2213  if(t.lt.ttp .and. ice.eq.1) then
2214  fpvs=psat*(tr**xai)*exp(xbi*(1._kind_phys-tr))
2215  else
2216  fpvs=psat*(tr**xa)*exp(xb*(1._kind_phys-tr))
2217  endif
2218 

◆ 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 
)
3378  implicit none
3379  real(kind=kind_phys), intent(in) :: den0, denr, dens, cl, cpv, ccn0
3380  integer, intent(in) :: hail_opt
3381  character(len=*), intent(out) :: errmsg
3382  integer, intent(out) :: errflg
3383  logical :: allowed_to_read
3384 
3385  allowed_to_read = .true.
3386  call wdm6init(den0, denr, dens, cl, cpv, ccn0, hail_opt, allowed_to_read)
3387 
3388  errmsg = ''
3389  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,
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 
)
3400  implicit none
3401 
3402  ! Input dimensions
3403  integer, intent(in) :: its, ite, kts, kte
3404  integer, intent(in) :: microphysics_debug, diag_i_dbg, diag_j_dbg, diag_k_raw_base
3405 
3406  ! Thermodynamic fields (inout)
3407  real(kind=kind_phys), intent(inout), dimension(its:ite, kts:kte) :: t, q, qc, qi, qr, qs, qg
3408  real(kind=kind_phys), intent(inout), dimension(its:ite, kts:kte) :: nn, nc, nr
3409 
3410  ! Input fields
3411  real(kind=kind_phys), intent(in), dimension(its:ite, kts:kte) :: den, p, delz
3412  real(kind=kind_phys), intent(in), dimension(its:ite) :: xland
3413 
3414  ! Scalar constants
3415  real(kind=kind_phys), intent(in) :: delt, g, cpd, cpv, rd, rv, t0c
3416  real(kind=kind_phys), intent(in) :: ep1, ep2, qmin, xls, xlv0, xlf0
3417  real(kind=kind_phys), intent(in) :: den0, denr, cliq, cice, psat, ccn0
3418 
3419  ! Output precipitation
3420  real(kind=kind_phys), intent(inout), dimension(its:ite) :: rain, rainncv, sr
3421  real(kind=kind_phys), intent(inout), dimension(its:ite) :: snow, snowncv, graupel, graupelncv
3422 
3423  ! Error handling
3424  character(len=*), intent(out) :: errmsg
3425  integer, intent(out) :: errflg
3426 
3427  ! Local variables for calling wdm62D
3428  real(kind=kind_phys), dimension(its:ite, kts:kte, 2) :: qci_tmp ! qc, qi
3429  real(kind=kind_phys), dimension(its:ite, kts:kte, 3) :: qrs_tmp ! qr, qs, qg
3430  real(kind=kind_phys), dimension(its:ite, kts:kte, 3) :: ncr_tmp ! nn, nc, nr (reordered)
3431  integer :: ids, ide, jds, jde, kds, kde
3432  integer :: ims, ime, jms, jme, kms, kme
3433  integer :: jts, jte
3434  integer :: i, k
3435 
3436  ! Set dimensions (2D slice, so j dimension is 1)
3437  ids = its
3438  ide = ite
3439  jds = 1
3440  jde = 1
3441  kds = kts
3442  kde = kte
3443 
3444  ims = its
3445  ime = ite
3446  jms = 1
3447  jme = 1
3448  kms = kts
3449  kme = kte
3450 
3451  jts = 1
3452  jte = 1
3453 
3454  ! Pack arrays into WDM6 format
3455  do k = kts, kte
3456  do i = its, ite
3457  qci_tmp(i,k,1) = qc(i,k)
3458  qci_tmp(i,k,2) = qi(i,k)
3459  qrs_tmp(i,k,1) = qr(i,k)
3460  qrs_tmp(i,k,2) = qs(i,k)
3461  qrs_tmp(i,k,3) = qg(i,k)
3462  ! WDM6 expects: ncr(i,k,1)=nn, ncr(i,k,2)=nc, ncr(i,k,3)=nr
3463  ncr_tmp(i,k,1) = nn(i,k)
3464  ncr_tmp(i,k,2) = nc(i,k)
3465  ncr_tmp(i,k,3) = nr(i,k)
3466  end do
3467  end do
3468 
3469  ! xland is passed straight through to wdm62D's slmsk dummy. Do NOT
3470  ! rescale it here. wdm62D's only use of slmsk is the maritime/continental
3471  ! selection at :628-633,
3472  ! if(slmsk(i).eq.2) then ; qcr(i,:) = qc0 ; else ; qcr(i,:) = qc1
3473  ! which tests against the WRF xland encoding (1=land, 2=water), and the
3474  ! upstream wdm6 driver at :255 supplies it unconverted as xland(ims,j).
3475  ! An earlier version of this wrapper mapped xland to a 1=land/0=water
3476  ! slmsk, which made .eq.2 unreachable and forced the continental qc1
3477  ! everywhere, including over water. Nothing in wdm62D reads slmsk except
3478  ! that test, so there is no other convention to satisfy.
3479 
3480  ! Call wdm62D
3481  call wdm62d(t, q, qci_tmp, qrs_tmp, ncr_tmp, den, p, delz, &
3482  delt, g, cpd, cpv, ccn0, rd, rv, t0c, &
3483  ep1, ep2, qmin, &
3484  xls, xlv0, xlf0, den0, denr, &
3485  cliq, cice, psat, &
3486  diag_j_dbg, &
3487  xland, &
3488  rain, rainncv, &
3489  sr, &
3490  ids, ide, jds, jde, kds, kde, &
3491  ims, ime, jms, jme, kms, kme, &
3492  its, ite, jts, jte, kts, kte, &
3493  snow, snowncv, &
3494  graupel, graupelncv, &
3495  microphysics_debug, diag_i_dbg, diag_j_dbg)
3496 
3497  ! Unpack arrays from WDM6 format
3498  do k = kts, kte
3499  do i = its, ite
3500  qc(i,k) = qci_tmp(i,k,1)
3501  qi(i,k) = qci_tmp(i,k,2)
3502  qr(i,k) = qrs_tmp(i,k,1)
3503  qs(i,k) = qrs_tmp(i,k,2)
3504  qg(i,k) = qrs_tmp(i,k,3)
3505  nn(i,k) = ncr_tmp(i,k,1)
3506  nc(i,k) = ncr_tmp(i,k,2)
3507  nr(i,k) = ncr_tmp(i,k,3)
3508  end do
3509  end do
3510 
3511  errmsg = ''
3512  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
2824 
2825 
2826 
2827 
2828 
2829 
2830 
2831 
2832 
2833 
2834 
2835 
2836 
2837 
2838 
2839 
2840 
2841 
2842 
2843 
2844 
2845  implicit none
2846  integer im,km,id
2847  real(kind=kind_phys) dt
2848  real(kind=kind_phys) dzl(im,km),wwl(im,km),rql(im,km),rql2(im,km),precip(im),precip1(im),precip2(im)
2849  real(kind=kind_phys) denl(im,km),denfacl(im,km),tkl(im,km)
2850 
2851  integer i,k,n,m,kk,kb,kt,iter,ist
2852  real(kind=kind_phys) tl,tl2,qql,dql,qqd
2853  real(kind=kind_phys) th,th2,qqh,dqh
2854  real(kind=kind_phys) zsum,qsum,dim,dip,c1,con1,fa1,fa2
2855  real(kind=kind_phys) allold, allnew, zz, dzamin, cflmax, decfl
2856  real(kind=kind_phys) dz(km), ww(km), qq(km), qq2(km), wd(km), wa(km), wa2(km), was(km)
2857  real(kind=kind_phys) den(km), denfac(km), tk(km)
2858  real(kind=kind_phys) wi(km+1), zi(km+1), za(km+1)
2859  real(kind=kind_phys) qn(km), qr(km),qr2(km),tmp(km),tmp1(km),tmp2(km),tmp3(km)
2860  real(kind=kind_phys) dza(km+1), qa(km+1), qa2(km+1),qmi(km+1), qpi(km+1)
2861 
2862  precip(:) = 0.0
2863  precip1(:) = 0.0
2864  precip2(:) = 0.0
2865 
2866  i_loop : do i=1,im
2867 
2868  dz(:) = dzl(i,:)
2869  qq(:) = rql(i,:)
2870  qq2(:) = rql2(i,:)
2871  ww(:) = wwl(i,:)
2872  den(:) = denl(i,:)
2873  denfac(:) = denfacl(i,:)
2874  tk(:) = tkl(i,:)
2875 
2876  allold = 0.0
2877  do k=1,km
2878  allold = allold + qq(k) + qq2(k)
2879  enddo
2880  if(allold.le.0.0) then
2881  cycle i_loop
2882  endif
2883 
2884 
2885  zi(1)=0.0
2886  do k=1,km
2887  zi(k+1) = zi(k)+dz(k)
2888  enddo
2889 
2890 
2891  wd(:) = ww(:)
2892  n=1
2893  100 continue
2894 
2895 
2896  wi(1) = ww(1)
2897  wi(km+1) = ww(km)
2898  do k=2,km
2899  wi(k) = (ww(k)*dz(k-1)+ww(k-1)*dz(k))/(dz(k-1)+dz(k))
2900  enddo
2901 
2902  fa1 = 9./16.
2903  fa2 = 1./16.
2904  wi(1) = ww(1)
2905  wi(2) = 0.5*(ww(2)+ww(1))
2906  do k=3,km-1
2907  wi(k) = fa1*(ww(k)+ww(k-1))-fa2*(ww(k+1)+ww(k-2))
2908  enddo
2909  wi(km) = 0.5*(ww(km)+ww(km-1))
2910  wi(km+1) = ww(km)
2911 
2912 
2913  do k=2,km
2914  if( ww(k).eq.0.0 ) wi(k)=ww(k-1)
2915  enddo
2916 
2917 
2918  con1 = 0.05
2919  do k=km,1,-1
2920  decfl = (wi(k+1)-wi(k))*dt/dz(k)
2921  if( decfl .gt. con1 ) then
2922  wi(k) = wi(k+1) - con1*dz(k)/dt
2923  endif
2924  enddo
2925 
2926  do k=1,km+1
2927  za(k) = zi(k) - wi(k)*dt
2928  enddo
2929 
2930  do k=1,km
2931  dza(k) = za(k+1)-za(k)
2932  enddo
2933  dza(km+1) = zi(km+1) - za(km+1)
2934 
2935 
2936  do k=1,km
2937  qa(k) = qq(k)*dz(k)/dza(k)
2938  qa2(k) = qq2(k)*dz(k)/dza(k)
2939  qr(k) = qa(k)/den(k)
2940  qr2(k) = qa2(k)/den(k)
2941  enddo
2942  qa(km+1) = 0.0
2943  qa2(km+1) = 0.0
2944 
2945 
2946 
2947 
2948  if( n.le.iter ) then
2949  call slope_snow(qr,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa,1,1,1,km)
2950  call slope_graup(qr2,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa2,1,1,1,km)
2951  do k = 1, km
2952  tmp(k) = max((qr(k)+qr2(k)), 1.e-15)
2953  IF ( tmp(k) .gt. 1.e-15 ) THEN
2954  wa(k) = (wa(k)*qr(k) + wa2(k)*qr2(k))/tmp(k)
2955  ELSE
2956  wa(k) = 0.
2957  ENDIF
2958  enddo
2959  if( n.ge.2 ) wa(1:km)=0.5*(wa(1:km)+was(1:km))
2960  do k=1,km
2961 
2962 
2963 
2964 
2965 
2966  ww(k) = 0.5* ( wd(k)+wa(k) )
2967  enddo
2968  was(:) = wa(:)
2969  n=n+1
2970  go to 100
2971  endif
2972  ist_loop : do ist = 1, 2
2973  if (ist.eq.2) then
2974  qa(:) = qa2(:)
2975  endif
2976 
2977  precip(i) = 0.
2978 
2979 
2980  do k=2,km
2981  dip=(qa(k+1)-qa(k))/(dza(k+1)+dza(k))
2982  dim=(qa(k)-qa(k-1))/(dza(k-1)+dza(k))
2983  if( dip*dim.le.0.0 ) then
2984  qmi(k)=qa(k)
2985  qpi(k)=qa(k)
2986  else
2987  qpi(k)=qa(k)+0.5*(dip+dim)*dza(k)
2988  qmi(k)=2.0*qa(k)-qpi(k)
2989  if( qpi(k).lt.0.0 .or. qmi(k).lt.0.0 ) then
2990  qpi(k) = qa(k)
2991  qmi(k) = qa(k)
2992  endif
2993  endif
2994  enddo
2995  qpi(1)=qa(1)
2996  qmi(1)=qa(1)
2997  qmi(km+1)=qa(km+1)
2998  qpi(km+1)=qa(km+1)
2999 
3000 
3001  qn = 0.0
3002  kb=1
3003  kt=1
3004  intp : do k=1,km
3005  kb=max(kb-1,1)
3006  kt=max(kt-1,1)
3007 
3008  if( zi(k).ge.za(km+1) ) then
3009  exit intp
3010  else
3011  find_kb : do kk=kb,km
3012  if( zi(k).le.za(kk+1) ) then
3013  kb = kk
3014  exit find_kb
3015  else
3016  cycle find_kb
3017  endif
3018  enddo find_kb
3019  find_kt : do kk=kt,km
3020  if( zi(k+1).le.za(kk) ) then
3021  kt = kk
3022  exit find_kt
3023  else
3024  cycle find_kt
3025  endif
3026  enddo find_kt
3027  kt = kt - 1
3028 
3029  if( kt.eq.kb ) then
3030  tl=(zi(k)-za(kb))/dza(kb)
3031  th=(zi(k+1)-za(kb))/dza(kb)
3032  tl2=tl*tl
3033  th2=th*th
3034  qqd=0.5*(qpi(kb)-qmi(kb))
3035  qqh=qqd*th2+qmi(kb)*th
3036  qql=qqd*tl2+qmi(kb)*tl
3037  qn(k) = (qqh-qql)/(th-tl)
3038  else if( kt.gt.kb ) then
3039  tl=(zi(k)-za(kb))/dza(kb)
3040  tl2=tl*tl
3041  qqd=0.5*(qpi(kb)-qmi(kb))
3042  qql=qqd*tl2+qmi(kb)*tl
3043  dql = qa(kb)-qql
3044  zsum = (1.-tl)*dza(kb)
3045  qsum = dql*dza(kb)
3046  if( kt-kb.gt.1 ) then
3047  do m=kb+1,kt-1
3048  zsum = zsum + dza(m)
3049  qsum = qsum + qa(m) * dza(m)
3050  enddo
3051  endif
3052  th=(zi(k+1)-za(kt))/dza(kt)
3053  th2=th*th
3054  qqd=0.5*(qpi(kt)-qmi(kt))
3055  dqh=qqd*th2+qmi(kt)*th
3056  zsum = zsum + th*dza(kt)
3057  qsum = qsum + dqh*dza(kt)
3058  qn(k) = qsum/zsum
3059  endif
3060  cycle intp
3061  endif
3062 
3063  enddo intp
3064 
3065 
3066  sum_precip: do k=1,km
3067  if( za(k).lt.0.0 .and. za(k+1).lt.0.0 ) then
3068  precip(i) = precip(i) + qa(k)*dza(k)
3069  cycle sum_precip
3070  else if ( za(k).lt.0.0 .and. za(k+1).ge.0.0 ) then
3071  precip(i) = precip(i) + qa(k)*(0.0-za(k))
3072  exit sum_precip
3073  endif
3074  exit sum_precip
3075  enddo sum_precip
3076 
3077 
3078  if(ist.eq.1) then
3079  rql(i,:) = qn(:)
3080  precip1(i) = precip(i)
3081  else
3082  rql2(i,:) = qn(:)
3083  precip2(i) = precip(i)
3084  endif
3085  enddo ist_loop
3086 
3087 
3088  enddo i_loop
3089 

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

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

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
2174 
2175  implicit none
2176 
2177 
2178 
2179  real(kind=kind_phys), parameter :: euler = 0.577215664901532_kind_phys
2180  real(kind=kind_phys) :: x, y
2181  integer :: i
2182 
2183  if(x.eq.1._kind_phys) then
2184  rgmma=0._kind_phys
2185  else
2186  rgmma = x*exp(euler*x)
2187  do i = 1,10000
2188  y = real(i, kind=kind_phys)
2189  rgmma = rgmma*(1.000_kind_phys+x/y)*exp(-x/y)
2190  enddo
2191  rgmma = 1._kind_phys/rgmma
2192  endif
2193 
real
double real
Definition: ERF_OrbCosZenith.H:9

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

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

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::Advance(), 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::Advance(), 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 erf_resolved_wall_flux::apply_face(), compute_max_reflectivity_dbz(), ComputeDiffusivityYSUNew(), NodalReconstruction::conjugateGradient(), effectrad_wdm6(), SurfaceLayer::fill_tsurf_with_sst_and_tsk(), interpolate_1d(), realbdy_compute_interior_ghost_rhs(), refl10cm_wdm6(), slope_snow(), slope_wdm6(), wdm62d(), wdm6_nislfv_rain_plm6_column(), and wrf_moisture_target().

◆ 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::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), slope_rain(), slope_wdm6(), and wdm62d().

◆ pacrc

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

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

◆ pacrg

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

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

◆ pacrr

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

Referenced by WSM6::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), wdm62d(), and wdm6init().

◆ precg2

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

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

◆ precr1

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

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

◆ precr2

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

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

◆ precs1

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

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

◆ precs2

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

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

◆ pvtg

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

Referenced by WSM6::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), WSM6::Advance(), 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::Advance(), 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::Advance(), 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().