530 & ( im,ix,levs,lsoil,lsm,ntrac,ncld,ntoz,ntcw,ntke,
559 & hice,fice,tisfc,tsea,tprcp,cv,cvb,cvt,
570 & dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl,
579 & gt0,gq0,gu0,gv0,t2m,q2m,u10m,v10m,
597 use machine
, only : kind_phys
600 &, rhc_max, dxmin, dxinv, pa2mb, rlapse
601 use module_nst_water_prop
, only: get_dtzm_2d
602 use cs_conv
, only : cs_convr
620 integer,
intent(in) :: ix, im, levs, lsoil, lsm, ntrac, &
621 & ncld, ntiw, ntlnc, ntinc,
630 integer,
intent(in) :: nlons(im), ncw(2)
631 integer,
intent(in) :: nstf_name(5)
632 integer,
intent(in) :: imfshalcnv, imfdeepcnv
634 logical,
intent(in) :: ras, pre_rad, ldiag3d, flipv, &
635 & old_monin, cnvgwd, aero_in,
643 real(kind=kind_phys) :: adjtrc(ntrac)
645 real(kind=kind_phys),
dimension(im),
intent(in) :: &
646 & sinlat, coslat, pgr, dpshc, xlon, xlat,
655 real(kind=kind_phys),
dimension(ix,levs),
intent(in) :: &
656 & ugrs, vgrs, tgrs, vvel, prsl, prslk, phil, swh, swhc, hlw, hlwc
659 real(kind=kind_phys),
intent(in) :: hlwd(ix,levs,6)
661 real(kind=kind_phys),
intent(inout) :: qgrs(ix,levs,ntrac)
663 real(kind=kind_phys),
dimension(ix,levs+1),
intent(in) :: &
666 real(kind=kind_phys),
intent(in) :: hprime(ix,nmtvr), &
667 & prdoz(ix,ko3,pl_coeff), rann(ix,nrcm), poz(ko3),
670 real(kind=kind_phys),
intent(in) :: dtp, dtf, fhour, solhr, &
671 & slag, sdec, cdec, ctei_rm(2), clstp,
677 real(kind=kind_phys),
dimension(im),
intent(inout) :: &
678 & hice, fice, tisfc, tsea, tprcp, cv, cvb, cvt,
685 real(kind=kind_phys),
dimension(im),
optional,
intent(inout) :: &
687 & dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl,
693 & xt, xs, xu, xv, xz, zm, xtts, xzts, d_conv, ifd, dt_cool,
694 & qrain, tref, z_c, c_0, c_d, w_0, w_d
697 real(kind=kind_phys),
dimension(ix,lsoil),
intent(inout) :: &
700 real(kind=kind_phys),
dimension(ix,levs),
intent(inout) :: &
701 & upd_mf, dwn_mf, det_mf, dqdt_v, cnvqc_v
704 real(kind=kind_phys),
intent(inout) :: &
705 & phy_f3d(ix,levs,ntot3d), phy_f2d(ix,ntot2d),
709 real(kind=kind_phys),
intent(inout) :: &
711 real(kind=kind_phys),
dimension(ntrac-ncld+2) :: fscav, fswtr
714 real(kind=kind_phys),
dimension(im),
intent(out) :: &
715 & t2m, q2m, u10m, v10m, zlvl, psurf, hpbl,
721 real(kind=kind_phys),
dimension(im),
optional,
intent(out) :: &
722 & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl,
731 real(kind=kind_phys),
dimension(ix,levs),
intent(out) :: &
734 real(kind=kind_phys),
dimension(ix,levs,ntrac),
intent(out) :: &
740 real(kind=kind_phys),
dimension(im) :: ccwfac, garea, &
741 & dlength, xncw, cumabs, qmax, cice, zice, tice,
743 & gflx, rain1, raincs,
750 & fm10, fh2, tsurf, tx1, tx2, ctei_r, flgmin_l,
758 real(kind=kind_phys),
dimension(im) :: ocalnirbm_cpl, &
759 & ocalnirdf_cpl,ocalvisbm_cpl,ocalvisdf_cpl
767 real(kind=kind_phys),
dimension(ix,levs) :: del, dtdtr
768 real(kind=kind_phys),
dimension(im,levs-1) :: dkt
770 real(kind=kind_phys),
dimension(im,levs) :: rhc, dtdt, &
771 & dudt, dvdt, gwdcu, gwdcv, dtdtc, dmdt,
773 & qr_col, fc_ice, rainp, ud_mf, dd_mf, dt_mf, prnum
776 real(kind=kind_phys),
dimension(im,lsoil) :: smsoil, stsoil, &
777 & ai, bi, cci, rhsmc, zsoil, slsoil
779 real(kind=kind_phys) :: zsea1,zsea2
780 real(kind=kind_phys),
dimension(im) :: dtzm
782 real(kind=kind_phys) :: rhbbot, rhbtop, rhpbl, frain, f_rain, &
783 & f_ice, qi, qw, qr, wc, tem, tem1, tem2, sume, sumr, sumq,
785 real(kind=kind_phys),
parameter :: albdf=0.06
792 real(kind=kind_phys),
allocatable :: clw(:,:,:), qpl(:,:),qpi(:,:)
793 &, ncpl(:,:), ncpi(:,:)
795 integer,
dimension(im) :: kbot, ktop, kcnv, soiltyp, vegtype, &
796 & kpbl, slopetyp, kinver, lmh, levshc, islmsk
798 integer :: i, nvdiff, kk, ic, k, n, ipr, lv, k1, iter, levshcm, &
799 & tracers, trc_shft, tottracer, num2, num3
802 logical,
dimension(im) :: flag_iter, flag_guess, invrsn &
805 real(kind=kind_phys),
dimension(im) :: dtsfc_cice, &
806 & dqsfc_cice, dusfc_cice, dvsfc_cice, ulwsfc_cice, tisfc_cice,
809 integer,
dimension(im) :: islmsk_cice
810 logical,
dimension(im) :: flag_cice
812 logical :: lprnt, revap
814 real(kind=kind_phys),
allocatable :: cnvc(:,:),cnvw(:,:)
815 real(kind=kind_phys) eng0, eng1, dtshoc
819 real(kind=kind_phys),
parameter :: wcbmax1=2.5, wcbmax2=1.5
821 real(kind=kind_phys) wcbmax(im)
823 real(kind=kind_phys) tf, tcr, tcrf
825 parameter(tf=258.16, tcr=273.16, tcrf=1.0/(tcr-tf))
828 real(kind=kind_phys),
allocatable,
dimension(:,:) :: qlcn, qicn
829 &, w_upi,cf_upi, cnv_mfd, cnv_prc3, cnv_dqldt,clcn,
830 & cnv_fice,cnv_ndrop,cnv_nice
831 real(kind=kind_phys),
allocatable,
dimension(:) :: cn_prc,cn_snr
905 if(nint(slmsk(i)) == 1)
then
919 if (ntoz < ntcw)
then
920 trc_shft = ntcw + ncld - 1
924 elseif (ntoz > 0)
then
930 tracers = ntrac - trc_shft
932 if (ntoz > 0) tottracer = tottracer + 1
934 if (ntke > 0) ntk = ntke - trc_shft + 3
943 allocate ( clw(ix,levs,tottracer+2) )
945 allocate (qpl(im,levs), qpi(im,levs)
946 &, ncpl(im,levs), ncpi(im,levs))
955 if (.not. ras .or. .not. cscnv)
then
956 allocate ( cnvc(ix,levs), cnvw(ix,levs))
961 allocate (qlcn(im,levs), qicn(im,levs), w_upi(im,levs)
962 &, cf_upi(im,levs), cnv_mfd(im,levs),cnv_prc3(im,levs)
963 &, cnv_dqldt(im,levs), clcn(im,levs), cnv_fice(im,levs)
964 &, cnv_ndrop(im,levs), cnv_nice(im,levs))
965 allocate(cn_prc(im), cn_snr(im))
967 allocate (qlcn(1,1), qicn(1,1), w_upi(1,1)
968 &, cf_upi(1,1), cnv_mfd(1,1),cnv_prc3(1,1)
969 &, cnv_dqldt(1,1), clcn(1,1), cnv_fice(1,1)
970 &, cnv_ndrop(1,1), cnv_nice(1,1))
981 if (abs(1.0-adjtrc(n)) > 1.0e-7)
then
984 qgrs(i,k,n) = qgrs(i,k,n) * adjtrc(n)
991 call get_prs(im,ix,levs,ntrac,tgrs,qgrs,
1016 sigmaf(i) = max( vfrac(i),0.01 )
1018 if (lsm == 0) sigmaf(i) = 0.5 + vfrac(i) * 0.5
1020 islmsk(i) = nint(slmsk(i))
1022 if (islmsk(i) == 2)
then
1028 if (ivegsrc == 1)
then
1030 elseif(ivegsrc == 2)
then
1035 soiltyp(i) = int( stype(i)+0.5 )
1036 vegtype(i) = int( vtype(i)+0.5 )
1037 slopetyp(i) = int( slope(i)+0.5 )
1045 islmsk_cice(i) = nint(slimskin_cpl(i))
1046 flag_cice(i) = (islmsk_cice(i) == 4)
1048 ulwsfc_cice(i) = ulwsfcin_cpl(i)
1049 dusfc_cice(i) = dusfcin_cpl(i)
1050 dvsfc_cice(i) = dvsfcin_cpl(i)
1051 dtsfc_cice(i) = dtsfcin_cpl(i)
1052 dqsfc_cice(i) = dqsfcin_cpl(i)
1053 tisfc_cice(i) = tisfc(i)
1054 tsea_cice(i) = tsea(i)
1055 fice_cice(i) = fice(i)
1056 hice_cice(i) = hice(i)
1059 work1(i) = (log(coslat(i) / (nlons(i)*latr)) - dxmin) * dxinv
1060 work1(i) = max(0.0, min(1.0,work1(i)))
1061 work2(i) = 1.0 - work1(i)
1063 work3(i) = prsik(i,1) / prslk(i,1)
1066 garea(i) = tem1 * tem2
1067 dlength(i) = sqrt( tem1*tem1+tem2*tem2 )
1068 cldf(i) = cgwf(1)*work1(i) + cgwf(2)*work2(i)
1069 wcbmax(i) = wcbmax1*work1(i) + wcbmax2*work2(i)
1081 smsoil(i,k) = smc(i,k)
1082 stsoil(i,k) = stc(i,k)
1083 slsoil(i,k) = slc(i,k)
1125 call dcyc2t3_pre_rad
1127 & ( solhr,slag,sdec,cdec,sinlat,coslat,
1136 & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw,xmu,xcosz,
1145 & ( solhr,slag,sdec,cdec,sinlat,coslat,
1154 & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw,xmu,xcosz,
1164 dtdtr(i,k) = dtdtr(i,k) + dtdtc(i,k)*dtf
1198 gabsbdlw(i) = sfcemis(i) * adjsfcdlw(i)
1213 if ( xcosz(i) >= czmin )
then
1214 tem1 = adjsfcdsw(i) / xcosz(i)
1216 if ( tem1 >= 120.0 )
then
1217 suntim(i) = suntim(i) + dtf
1225 dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf
1227 if (flag_cice(i)) adjsfculw(i) = ulwsfc_cice(i)
1229 ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf
1230 psmean(i) = psmean(i) + pgr(i)*dtf
1237 dt3dt(i,k,1) = dt3dt(i,k,1) + hlwd(i,k,1)*dtf
1238 dt3dt(i,k,2) = dt3dt(i,k,2) + hlwd(i,k,2)*dtf
1239 dt3dt(i,k,3) = dt3dt(i,k,3) + hlwd(i,k,3)*dtf
1240 dt3dt(i,k,4) = dt3dt(i,k,4) + hlwd(i,k,4)*dtf
1241 dt3dt(i,k,5) = dt3dt(i,k,5) + hlwd(i,k,5)*dtf
1242 dt3dt(i,k,6) = dt3dt(i,k,6) + hlwd(i,k,6)*dtf
1248 dt3dt(i,k,1) = dt3dt(i,k,1) + hlw(i,k)*dtf
1249 dt3dt(i,k,2) = dt3dt(i,k,2) + swh(i,k)*dtf*xmu(i)
1268 if (((imfshalcnv == 0 .and. shal_cnv) .or. old_monin)
1271 ctei_rml(i) = ctei_rm(1)*work1(i) + ctei_rm(2)*work2(i)
1275 if (prsi(i,1)-prsi(i,k+1) < 0.35*prsi(i,1)
1277 tem = (tgrs(i,k+1)-tgrs(i,k)) / (prsl(i,k)-prsl(i,k+1))
1279 if ((tem > 0.00010 .and. tx1(i) < 0.0) .or.
1280 & (tem-abs(tx1(i)) > 0.0 .and. tx2(i) < 0.0))
then
1283 if (qgrs(i,k,1) > qgrs(i,k+1,1))
then
1284 tem1 = tgrs(i,k+1) + hocp*max(qgrs(i,k+1,1),qmin)
1285 tem2 = tgrs(i,k) + hocp*max(qgrs(i,k,1),qmin)
1287 tem1 = tem1 / prslk(i,k+1) - tem2 / prslk(i,k)
1290 ctei_r(i) = (1.0/hocp)*tem1/(qgrs(i,k+1,1)-qgrs(i,k,1)
1296 if ( ctei_rml(i) > ctei_r(i) )
then
1328 flag_guess(i) = .false.
1329 flag_iter(i) = .true.
1342 zlvl(i) = phil(i,1) /
con_g
1354 call sfc_diff(im,pgr,ugrs,vgrs,tgrs,qgrs,zlvl,
1369 if (iter == 1 .and. wind(i) < 2.0)
then
1370 flag_guess(i) = .true.
1374 if ( nstf_name(1) > 0 )
then
1377 if ( islmsk(i) == 0 )
then
1378 tem = (oro(i)-oro_uf(i)) * rlapse
1379 tseal(i) = tsea(i) + tem
1380 tsurf(i) = tsurf(i) + tem
1397 & tseal,tsurf,xt,xs,xu,xv,xz,zm,xtts,xzts,dt_cool,
1400 & qss, gflx, cmm, chh, evap, hflx, ep1d)
1407 if ( islmsk(i) == 0 )
then
1408 tsurf(i) = tsurf(i) - (oro(i)-oro_uf(i)) * rlapse
1414 if ( nstf_name(1) > 1 )
then
1415 zsea1 = 0.001*
real(nstf_name(4))
1416 zsea2 = 0.001*
real(nstf_name(5))
1417 call get_dtzm_2d(xt,xz,dt_cool,z_c,slmsk,
1418 & zsea1,zsea2,im,1,dtzm)
1420 if ( islmsk(i) == 0 )
then
1421 tsea(i) = max(271.2,tref(i) + dtzm(i))
1422 & -(oro(i)-oro_uf(i))*rlapse
1436 & ( im,pgr,ugrs,vgrs,tgrs,qgrs,tsea,cd,cdq,
1439 & qss,cmm,chh,gflx,evap,hflx,ep1d
1459 & ( im,lsoil,pgr,ugrs,vgrs,tgrs,qgrs,soiltyp,vegtype,sigmaf,
1465 & weasd,snwdph,tsea,tprcp,srflag,smsoil,stsoil,slsoil,
1468 & sncovr,qss,gflx,drain,evap,hflx,ep1d,runof,
1480 & ( im,lsoil,pgr,ugrs,vgrs,tgrs,qgrs,smsoil,soiltyp,
1484 & phy_f2d(1,num_p2d),flag_iter,flag_guess,
1486 & weasd,tsea,tprcp,srflag,stsoil,canopy,tsurf,
1488 & qss,snowmt,gflx,zsoil,rhscnpy,rhsmc,
1503 if (flag_cice(i))
then
1504 islmsk(i) = islmsk_cice(i)
1511 & ( im,lsoil,pgr,ugrs,vgrs,tgrs,qgrs,dtf,
1517 & zice,cice,tice,weasd,tsea,tprcp,stsoil,ep1d,
1519 & snwdph,qss,snowmt,gflx,cmm,chh,evap,hflx
1524 if (flag_cice(i))
then
1525 islmsk(i) = nint(slmsk(i))
1531 & ( im,ugrs,vgrs,tgrs,qgrs,cd,cdq,prsl(1,1),work3,
1535 & qss,cmm,chh,evap,hflx
1542 flag_iter(i) = .false.
1543 flag_guess(i) = .false.
1545 if(islmsk(i) == 1 .and. iter == 1)
then
1546 if (wind(i) < 2.0) flag_iter(i) = .true.
1547 elseif (islmsk(i) == 0 .and. iter == 1
1549 if (wind(i) < 2.0) flag_iter(i) = .true.
1557 dlwsfci(i) = adjsfcdlw(i)
1558 ulwsfci(i) = adjsfculw(i)
1559 uswsfci(i) = adjsfcdsw(i) - adjsfcnsw(i)
1560 dswsfci(i) = adjsfcdsw(i)
1571 if (weasd(i) > 0.0) sncovr(i) = 1.0
1577 call sfc_diag(im,pgr,ugrs,vgrs,tgrs,qgrs,
1582 phy_f2d(i,num_p2d) = 0.0
1587 dlwsfci_cpl(i) = adjsfcdlw(i)
1588 dswsfci_cpl(i) = adjsfcdsw(i)
1589 dlwsfc_cpl(i) = dlwsfc_cpl(i) + adjsfcdlw(i)*dtf
1590 dswsfc_cpl(i) = dswsfc_cpl(i) + adjsfcdsw(i)*dtf
1591 dnirbmi_cpl(i) = adjnirbmd(i)
1592 dnirdfi_cpl(i) = adjnirdfd(i)
1593 dvisbmi_cpl(i) = adjvisbmd(i)
1594 dvisdfi_cpl(i) = adjvisdfd(i)
1595 dnirbm_cpl(i) = dnirbm_cpl(i) + adjnirbmd(i)*dtf
1596 dnirdf_cpl(i) = dnirdf_cpl(i) + adjnirdfd(i)*dtf
1597 dvisbm_cpl(i) = dvisbm_cpl(i) + adjvisbmd(i)*dtf
1598 dvisdf_cpl(i) = dvisdf_cpl(i) + adjvisdfd(i)*dtf
1599 nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw(i)
1600 nlwsfc_cpl(i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf
1601 t2mi_cpl(i) = t2m(i)
1602 q2mi_cpl(i) = q2m(i)
1603 u10mi_cpl(i) = u10m(i)
1604 v10mi_cpl(i) = v10m(i)
1605 tseai_cpl(i) = tsea(i)
1606 psurfi_cpl(i) = pgr(i)
1613 if (islmsk(i) /= 1)
then
1615 xcosz_loc = max( 0.0, min( 1.0, xcosz(i) ))
1616 ocalnirdf_cpl(i) = 0.06
1617 ocalnirbm_cpl(i) = max(albdf, 0.026/(xcosz_loc**1.7+0.065)
1628 nnirbmi_cpl(i) = adjnirbmd(i) - adjnirbmu(i)
1629 nnirdfi_cpl(i) = adjnirdfd(i) - adjnirdfu(i)
1630 nvisbmi_cpl(i) = adjvisbmd(i) - adjvisbmu(i)
1631 nvisdfi_cpl(i) = adjvisdfd(i) - adjvisdfu(i)
1633 nswsfci_cpl(i) = nnirbmi_cpl(i) + nnirdfi_cpl(i)
1645 gflux(i) = gflux(i) + gflx(i) * dtf
1646 evbsa(i) = evbsa(i) + evbs(i) * dtf
1647 evcwa(i) = evcwa(i) + evcw(i) * dtf
1648 transa(i) = transa(i) + trans(i) * dtf
1649 sbsnoa(i) = sbsnoa(i) + sbsno(i) * dtf
1650 snowca(i) = snowca(i) + snowc(i) * dtf
1651 snohfa(i) = snohfa(i) + snohf(i) * dtf
1652 ep(i) = ep(i) + ep1d(i) * dtf
1654 tmpmax(i) = max(tmpmax(i),t2m(i))
1655 tmpmin(i) = min(tmpmin(i),t2m(i))
1657 spfhmax(i) = max(spfhmax(i),q2m(i))
1658 spfhmin(i) = min(spfhmin(i),q2m(i))
1689 call moninshoc(ix,im,levs,ntrac,ntcw,dvdt,dudt,dtdt,dqdt,
1701 call moninedmf(ix,im,levs,nvdiff,ntcw,dvdt,dudt,dtdt,dqdt,
1709 elseif (.not. old_monin)
then
1711 call moninq(ix,im,levs,nvdiff,ntcw,dvdt,dudt,dtdt,dqdt,
1722 call moninp1(ix,im,levs,nvdiff,dvdt,dudt,dtdt,dqdt,
1730 call moninp(ix,im,levs,nvdiff,dvdt,dudt,dtdt,dqdt,
1743 if (flag_cice(i))
then
1744 cice(i) = fice_cice(i)
1745 tsea(i) = tsea_cice(i)
1746 dusfc1(i) = dusfc_cice(i)
1747 dvsfc1(i) = dvsfc_cice(i)
1748 dqsfc1(i) = dqsfc_cice(i)
1749 dtsfc1(i) = dtsfc_cice(i)
1766 dusfc_cpl(i) = dusfc_cpl(i) + dusfc1(i)*dtf
1767 dvsfc_cpl(i) = dvsfc_cpl(i) + dvsfc1(i)*dtf
1768 dtsfc_cpl(i) = dtsfc_cpl(i) + dtsfc1(i)*dtf
1769 dqsfc_cpl(i) = dqsfc_cpl(i) + dqsfc1(i)*dtf
1770 dusfci_cpl(i) = dusfc1(i)
1771 dvsfci_cpl(i) = dvsfc1(i)
1772 dtsfci_cpl(i) = dtsfc1(i)
1773 dqsfci_cpl(i) = dqsfc1(i)
1779 dusfc(i) = dusfc(i) + dusfc1(i)*dtf
1780 dvsfc(i) = dvsfc(i) + dvsfc1(i)*dtf
1781 dtsfc(i) = dtsfc(i) + dtsfc1(i)*dtf
1782 dqsfc(i) = dqsfc(i) + dqsfc1(i)*dtf
1783 dusfci(i) = dusfc1(i)
1784 dvsfci(i) = dvsfc1(i)
1785 dtsfci(i) = dtsfc1(i)
1786 dqsfci(i) = dqsfc1(i)
1798 dt3dt(i,k,3) = dt3dt(i,k,3) + dtdt(i,k)*dtf
1804 tem = dtdt(i,k) - (hlw(i,k)+swh(i,k)*xmu(i))
1805 dt3dt(i,k,3) = dt3dt(i,k,3) + tem*dtf
1811 du3dt(i,k,1) = du3dt(i,k,1) + dudt(i,k) * dtf
1812 du3dt(i,k,2) = du3dt(i,k,2) - dudt(i,k) * dtf
1813 dv3dt(i,k,1) = dv3dt(i,k,1) + dvdt(i,k) * dtf
1814 dv3dt(i,k,2) = dv3dt(i,k,2) - dvdt(i,k) * dtf
1827 tem = dqdt(i,k,1) * dtf
1828 dq3dt(i,k,1) = dq3dt(i,k,1) + tem
1835 dq3dt(i,k,5) = dq3dt(i,k,5) + dqdt(i,k,ntoz) * dtf
1847 if (nmtvr == 14)
then
1854 oa4(i,k) = hprime(i,k+2)
1855 clx(i,k) = hprime(i,k+6)
1859 theta(i) = hprime(i,11)
1860 gamma(i) = hprime(i,12)
1861 sigma(i) = hprime(i,13)
1862 elvmax(i) = hprime(i,14)
1865 elseif (nmtvr == 10)
then
1872 oa4(i,k) = hprime(i,k+2)
1873 clx(i,k) = hprime(i,k+6)
1877 elseif (nmtvr == 6)
then
1884 oa4(i,k) = hprime(i,k+2)
1891 oc = 0 ; oa4 = 0 ; clx = 0 ; theta = 0 ; gamma = 0 ; sigma = 0
1897 call gwdps(im, ix, im, levs, dvdt, dudt, dtdt,
1910 dugwd(i) = dugwd(i) + dusfcg(i)*dtf
1911 dvgwd(i) = dvgwd(i) + dvsfcg(i)*dtf
1920 du3dt(i,k,2) = du3dt(i,k,2) + dudt(i,k) * dtf
1921 dv3dt(i,k,2) = dv3dt(i,k,2) + dvdt(i,k) * dtf
1922 dt3dt(i,k,2) = dt3dt(i,k,2) + dtdt(i,k) * dtf
1929 if( .not. lsidea .and. ral_ts > 0.0)
then
1933 call rayleigh_damp(im, ix, im, levs, dvdt, dudt, dtdt, ugrs,
1934 & vgrs, dtp,
con_cp, levr, pgr, prsl,
1945 gt0(i,k) = tgrs(i,k) + dtdt(i,k) * dtp
1946 gu0(i,k) = ugrs(i,k) + dudt(i,k) * dtp
1947 gv0(i,k) = vgrs(i,k) + dvdt(i,k) * dtp
1954 gq0(i,k,n) = qgrs(i,k,n) + dqdt(i,k,n) * dtp
1961 call ideaca_up(prsi,gt0,ix,im,levs+1)
1986 if (ntoz > 0 .and. ntrac >= ntoz)
then
1988 if (pl_coeff > 4)
then
1990 call ozphys_2015(ix,im,levs,ko3,dtp,gq0(1,1,ntoz),gq0(1,1,ntoz)
1995 call ozphys(ix,im,levs,ko3,dtp,gq0(1,1,ntoz),gq0(1,1,ntoz)
2005 call h2ophys(ix,im,levs,levh2o,dtp,gq0(1,1,1),gq0(1,1,1)
2006 &, h2o_pres,prsl,h2opl,h2o_coeff,ldiag3d
2007 &, dq3dt(1,1,1), me)
2042 dtdt(i,k) = gt0(i,k)
2044 dudt(i,k) = gu0(i,k)
2045 dvdt(i,k) = gv0(i,k)
2049 elseif (cnvgwd)
then
2053 dtdt(i,k) = gt0(i,k)
2059 if (ldiag3d .or. lgocart)
then
2062 dqdt(i,k,1) = gq0(i,k,1)
2067 call get_phi(im,ix,levs,ntrac,gt0,gq0,
2083 if (.not. ras .or. .not. cscnv)
then
2096 if (ras .or. cscnv)
then
2097 if (tottracer > 0)
then
2102 clw(i,k,3) = gq0(i,k,ntoz)
2106 if (tracers > 0)
then
2110 clw(i,k,3+n) = gq0(i,k,n+trc_shft)
2119 clw(i,k,2+n) = gq0(i,k,n+trc_shft)
2140 tem = rhbbot - (rhbbot-rhbtop) * (1.0-prslk(i,k))
2141 tem = rhc_max * work1(i) + tem * work2(i)
2142 rhc(i,k) = max(0.0, min(1.0,tem))
2149 clw(i,k,1) = gq0(i,k,ntiw)
2150 clw(i,k,2) = gq0(i,k,ntcw)
2155 if (num_p3d == 3)
then
2165 f_ice = max(0.0, min(1.0, phy_f3d(i,k,1)))
2166 f_rain = max(0.0, min(1.0, phy_f3d(i,k,2)))
2209 elseif (num_p3d == 4)
then
2212 psautco_l(i) = psautco(1)*work1(i) + psautco(2)*work2(i)
2213 prautco_l(i) = prautco(1)*work1(i) + prautco(2)*work2(i)
2217 clw(i,k,1) = gq0(i,k,ntcw)
2227 psautco_l(i) = psautco(1)*work1(i) + psautco(2)*work2(i)
2228 prautco_l(i) = prautco(1)*work1(i) + prautco(2)*work2(i)
2240 if (do_shoc .and. .not. shocaftcnv)
then
2243 skip_macro = do_shoc
2246 clw(i,k,1) = gq0(i,k,ntiw)
2247 clw(i,k,2) = gq0(i,k,ntcw)
2248 ncpl(i,k) = gq0(i,k,ntlnc)
2249 ncpi(i,k) = gq0(i,k,ntinc)
2252 elseif (num_p3d == 4)
then
2260 clw(i,k,2) = gq0(i,k,ntcw) - tem
2279 call shoc(ix, im, 1, levs, levs+1, dtp, me, lat,
2287 if (ntlnc > 0 .and. ntinc > 0 .and. ncld >=2)
then
2290 gq0(i,k,ntlnc) = ncpl(i,k)
2291 gq0(i,k,ntinc) = ncpi(i,k)
2322 if (.not. ras .and. .not. cscnv)
then
2324 if (imfdeepcnv == 1)
then
2325 call sascnvn(im,ix,levs,jcap,dtp,del,prsl,pgr,phil,
2329 elseif (imfdeepcnv == 2)
then
2330 call mfdeepcnv(im,ix,levs,dtp,del,prsl,pgr,phil,
2335 elseif (imfdeepcnv == 0)
then
2336 call sascnv(im,ix,levs,jcap,dtp,del,prsl,pgr,phil,
2350 & ix ,im ,levs , tottracer+3 ,
2351 & gt0 ,gq0 ,rain1 , clw ,
2355 & ud_mf ,dd_mf ,dt_mf ,
2356 & gu0 ,gv0 ,fscav, fswtr,
2358 & phy_fctd, me, wcbmax )
2361 rain1(i) = rain1(i) * (dtp*0.001)
2366 if (ccwf(1) >= 0.0 .or. ccwf(2) >= 0 )
then
2368 ccwfac(i) = ccwf(1)*work1(i) + ccwf(2)*work2(i)
2369 dlqfac(i) = dlqf(1)*work1(i) + dlqf(2)*work2(i)
2384 call rascnv(im, ix, levs, dtp, dtf, rann
2404 upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * frain
2405 dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * frain
2406 det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * frain
2407 cnvqc_v(i,k) = cnvqc_v(i,k) + (clw(i,k,1)+clw(i,k,2)-
2415 if (tottracer > 0)
then
2419 gq0(i,k,ntoz) = clw(i,k,3)
2423 if (tracers > 0)
then
2427 gq0(i,k,n+trc_shft) = clw(i,k,3+n)
2436 gq0(i,k,n+trc_shft) = clw(i,k,2+n)
2445 rainc(i) = frain * rain1(i)
2451 cldwrk(i) = cldwrk(i) + cld1d(i) * dtf
2452 cnvprcp(i) = cnvprcp(i) + rainc(i)
2458 dt3dt(i,k,4) = dt3dt(i,k,4) + (gt0(i,k)-dtdt(i,k)) * frain
2459 dq3dt(i,k,2) = dq3dt(i,k,2) + (gq0(i,k,1)-dqdt(i,k,1))
2478 dqdt_v(i,k) = (gq0(i,k,1)-dqdt(i,k,1)) * frain
2479 upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * frain
2480 dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * frain
2481 det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * frain
2482 cnvqc_v(i,k) = cnvqc_v(i,k) + (clw(i,k,1)+clw(i,k,2))
2488 if(npdf3d == 3 .and. num_p3d == 4)
then
2493 phy_f3d(i,k,num2) = cnvw(i,k)
2494 phy_f3d(i,k,num3) = cnvc(i,k)
2497 else if(npdf3d == 0 .and. ncnvcld3d == 1)
then
2501 phy_f3d(i,k,num2) = cnvw(i,k)
2531 if (k >= kbot(i) .and. k <= ktop(i))
then
2534 cumabs(i) = cumabs(i) + (gt0(i,k)-dtdt(i,k)) * del(i,k)
2535 work3(i) = work3(i) + del(i,k)
2540 if (work3(i) > 0.0) cumabs(i) = cumabs(i) / (dtp*work3(i))
2608 call gwdc(im, ix, im, levs, lat, ugrs, vgrs, tgrs, qgrs,
2639 dugwd(i) = dugwd(i) + dusfcg(i)*dtf
2640 dvgwd(i) = dvgwd(i) + dvsfcg(i)*dtf
2646 du3dt(i,k,4) = du3dt(i,k,4) + gwdcu(i,k) * dtf
2647 dv3dt(i,k,4) = dv3dt(i,k,4) + gwdcv(i,k) * dtf
2659 eng0 = 0.5*(gu0(i,k)*gu0(i,k)+gv0(i,k)*gv0(i,k))
2660 gu0(i,k) = gu0(i,k) + gwdcu(i,k) * dtp
2661 gv0(i,k) = gv0(i,k) + gwdcv(i,k) * dtp
2662 eng1 = 0.5*(gu0(i,k)*gu0(i,k)+gv0(i,k)*gv0(i,k))
2663 gt0(i,k) = gt0(i,k) + (eng0-eng1)/(dtp*
con_cp)
2694 dtdt(i,k) = gt0(i,k)
2699 if (ldiag3d .or. lgocart)
then
2702 dqdt(i,k,1) = gq0(i,k,1)
2710 if (.not. do_shoc)
then
2714 if (imfshalcnv == 1)
then
2716 call shalcnv(im,ix,levs,jcap,dtp,del,prsl,pgr,phil,
2722 if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3 )
then
2725 phy_f3d(i,k,num2) = cnvw(i,k)
2726 phy_f3d(i,k,num3) = cnvc(i,k)
2731 else if(npdf3d == 0 .and. ncnvcld3d == 1)
then
2735 phy_f3d(i,k,num2) = cnvw(i,k)
2740 raincs(i) = frain * rain1(i)
2741 rainc(i) = rainc(i) + raincs(i)
2745 cnvprcp(i) = cnvprcp(i) + raincs(i)
2749 elseif (imfshalcnv == 2)
then
2750 call mfshalcnv(im,ix,levs,dtp,del,prsl,pgr,phil,
2755 if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3 )
then
2758 phy_f3d(i,k,num2) = cnvw(i,k)
2759 phy_f3d(i,k,num3) = cnvc(i,k)
2764 else if(npdf3d == 0 .and. ncnvcld3d == 1)
then
2768 phy_f3d(i,k,num2) = cnvw(i,k)
2773 raincs(i) = frain * rain1(i)
2774 rainc(i) = rainc(i) + raincs(i)
2778 cnvprcp(i) = cnvprcp(i) + raincs(i)
2782 elseif (imfshalcnv == 0)
then
2789 if (prsi(i,1)-prsi(i,k) <= dpshc(i)) levshc(i) = k
2794 levshcm = max(levshcm, levshc(i))
2801 call shalcv(im,ix,levshcm,dtp,del,prsi,prsl,prslk,kcnv,
2805 call shalcvt3(im,ix,levshcm,dtp,del,prsi,prsl,prslk,
2818 tem = (gq0(i,k,1)-dqdt(i,k,1)) * frain
2819 dqdt_v(i,k) = dqdt_v(i,k) + tem
2826 dt3dt(i,k,5) = dt3dt(i,k,5) + (gt0(i,k)-dtdt(i,k))
2828 dq3dt(i,k,3) = dq3dt(i,k,3) + (gq0(i,k,1)-dqdt(i,k,1))
2839 if (clw(i,k,2) <= -999.0) clw(i,k,2) = 0.0
2850 elseif (shocaftcnv)
then
2852 skip_macro = do_shoc
2857 ncpl(i,k) = gq0(i,k,ntlnc)
2858 ncpi(i,k) = gq0(i,k,ntinc)
2897 call shoc(ix, im, 1, levs, levs+1, dtp, me, lat,
2905 if (ntlnc > 0 .and. ntinc > 0 .and. ncld >=2)
then
2908 gq0(i,k,ntlnc) = ncpl(i,k)
2909 gq0(i,k,ntinc) = ncpi(i,k)
2940 gq0(i,k,ntiw) = clw(i,k,1)
2941 gq0(i,k,ntcw) = clw(i,k,2)
2945 elseif (num_p3d == 3)
then
2957 gq0(i,k,ntcw) = qi + qw + qr_col(i,k)
2959 if (qi <= epsq)
then
2962 phy_f3d(i,k,1) = qi/gq0(i,k,ntcw)
2965 if (qr_col(i,k) <= epsq)
then
2968 phy_f3d(i,k,2) = qr_col(i,k) / (qw+qr_col(i,k))
2974 elseif (num_p3d == 4)
then
2978 gq0(i,k,ntcw) = clw(i,k,1) + clw(i,k,2)
2988 clw(i,k,1) = clw(i,k,1) + clw(i,k,2)
2996 call cnvc90(clstp, im, ix, rainc, kbot, ktop, levs, prsi,
3023 call mstcnv(im,ix,levs,dtp,gt0,gq0,prsl,del,prslk,rain1
3024 &, gq0(1,1,ntcw), rhc, lprnt,ipr)
3032 rainc(i) = rainc(i) + frain * rain1(i)
3036 cnvprcp(i) = cnvprcp(i) + rain1(i) * frain
3053 dt3dt(i,k,4) = dt3dt(i,k,4) + (gt0(i,k)-dtdt(i,k))
3055 dq3dt(i,k,2) = dq3dt(i,k,2) + (gq0(i,k,1)-dqdt(i,k,1))
3065 dtdt(i,k) = gt0(i,k)
3066 dqdt(i,k,1) = gq0(i,k,1)
3094 dqdt_v(i,k) = dqdt_v(i,k) / dtf
3104 call lrgscl(ix,im,levs,dtp,gt0,gq0,prsl,del,prslk,rain1,clw)
3106 elseif (ncld == 1)
then
3108 if (num_p3d == 3)
then
3111 xncw(i) = ncw(1) * work1(i) + ncw(2) * work2(i)
3112 flgmin_l(i) = flgmin(1)* work1(i) + flgmin(2) * work2(i)
3115 if (kdt == 1 .and. abs(xlon(1)) < 0.0001)
then
3116 write(0,*)
' xncw=',xncw(1),
' rhc=',rhc(1,1),
' work1='
3117 ' work2=',work2(1),
' flgmin=',flgmin_l(1)
3118 ' lon=',xlon(1) * 57.29578,
' lat=',lat,
' me=',me
3128 elseif (num_p3d == 4)
then
3130 if (npdf3d /= 3)
then
3140 call precpd_shoc(im, ix, levs, dtp, del, prsl,
3147 call gscond(im, ix, levs, dtp, dtf, prsl, pgr,
3153 call precpd(im, ix, levs, dtp, del, prsl,
3167 call gscondp(im, ix, levs, dtp, dtf, prsl, pgr,
3174 call precpdp(im, ix, levs, dtp, del, prsl, pgr,
3186 elseif (ncld == 2)
then
3195 clw(i,k,1) = gq0(i,k,ntiw)
3196 clw(i,k,2) = gq0(i,k,ntcw)
3197 phy_f3d(i,k,1) = phy_f3d(i,k,ntot3d-2)
3203 clw(i,k,1) = gq0(i,k,ntiw)
3204 clw(i,k,2) = gq0(i,k,ntcw)
3205 phy_f3d(i,k,1) = min(1.0, phy_f3d(i,k,1)+cnvc(i,k))
3215 call m_micro_driver(im, ix, levs, flipv, dtp,
3216 & prsl, prsi, prslk, prsik,
3217 & vvel, clw(1,1,2), qlcn, clw(1,1,1),qicn,
3218 & hlw, swh, w_upi, cf_upi,
3219 & frland, hpbl, cnv_mfd, cnv_prc3,
3220 & cnv_dqldt, clcn, gu0, gv0,
3221 & dusfc, dvsfc, dusfc1, dvsfc1,
3222 & dusfc1, dvsfc1, cnv_fice,
3223 & cnv_ndrop, cnv_nice, gq0(1,1,1),
3224 & gq0(1,1,ntcw), gq0(1,1,ntiw), gt0,
3225 & rain1, sr, gq0(1,1,ntlnc),
3226 & gq0(1,1,ntinc), phy_f3d(1,1,1), kbot,
3227 & aero_in, skip_macro, cn_prc, cn_snr,
3238 rain(i) = rainc(i) + frain * rain1(i)
3244 call calpreciptype(kdt,nrcm,im,ix,levs,levs+1,rann,
3245 & xlat,xlon,gt0,gq0,prsl,prsi,rain,
3246 & phii,num_p3d,tsea,sr,phy_f3d(1,1,i),
3247 & domr,domzr,domip,doms)
3261 if(doms(i) >0.0 .or. domip(i)>0.0)
then
3271 totprcp(i) = totprcp(i) + rain(i)
3278 dt3dt(i,k,6) = dt3dt(i,k,6) + (gt0(i,k)-dtdt(i,k)) * frain
3279 dq3dt(i,k,4) = dq3dt(i,k,4) + (gq0(i,k,1)-dqdt(i,k,1))
3294 if (prsl(i,k) > p850 .and. prsl(i,k+1) <= p850)
then
3295 t850(i) = gt0(i,k) - (prsl(i,k)-p850)
3305 tprcp(i) = max(0.0, rain(i))
3309 tprcp(i) = max(0.0, rain(i) )
3312 if (t850(i) <= 273.16)
then
3322 if (t850(i) > 273.16)
then
3323 rain_cpl(i) = rain_cpl(i) + rain(i)
3325 snow_cpl(i) = snow_cpl(i) + rain(i)
3337 if (t850(i) <= 273.16 .and. islmsk(i) /= 0)
then
3338 weasd(i) = weasd(i) + 1.e3*rain(i)
3342 call progt2(im,lsoil,rhscnpy,rhsmc,ai,bi,cci,smsoil,
3350 if (islmsk(i) == 1)
then
3351 slsoil(i,k) = smsoil(i,k)
3362 call sfc_diag(im,pgr,gu0,gv0,gt0,gq0,
3368 tmpmax(i) = max(tmpmax(i),t2m(i))
3369 tmpmin(i) = min(tmpmin(i),t2m(i))
3371 spfhmax(i) = max(spfhmax(i),q2m(i))
3372 spfhmin(i) = min(spfhmin(i),q2m(i))
3383 runoff(i) = runoff(i) + (drain(i)+runof(i)) * tem
3384 srunoff(i) = srunoff(i) + runof(i) * tem
3391 if (islmsk(i) == 2)
then
3406 smc(i,k) = smsoil(i,k)
3407 stc(i,k) = stsoil(i,k)
3408 slc(i,k) = slsoil(i,k)
3426 do ic = ntcw, ntcw+ncld-1
3428 work1(i) = work1(i) + gq0(i,k,ic)
3434 pwat(i) = pwat(i) + del(i,k)*(gq0(i,k,1)+work1(i))
3435 rqtk(i) = rqtk(i) + del(i,k)*(gq0(i,k,1)-qgrs(i,k,1))
3440 pwat(i) = pwat(i) * (1.0/
con_g)
3451 deallocate (qpl, qpi, ncpl, ncpi)
3453 if (.not. ras .or. .not. cscnv)
then
3454 deallocate (cnvc, cnvw)
3463 deallocate (qlcn, qicn, w_upi
3464 &, cf_upi, cnv_mfd, cnv_prc3
3465 &, cnv_dqldt, clcn, cnv_fice
3466 &, cnv_ndrop, cnv_nice)
real(kind=kind_phys), parameter con_pi
pi
real(kind=kind_phys), parameter con_g
gravity ( )
subroutine gwdc(im, ix, iy, km, lat, u1, v1, t1, q1, pmid1, pint1, dpmid1, qmax, ktop, kbot, kcnv, cldf, grav, cp, rd, fv, dlength, lprnt, ipr, fhour, utgwc, vtgwc, tauctx, taucty)
subroutine precpd(im, ix, km, dt, del, prsl, q, cwm, t, rn, sr , rainp, u00k, psautco, prautco, evpco, wminco , lprnt, jpr)
subroutine gwdps(IM, IX, IY, KM, A, B, C, U1, V1, T1, Q1, KPBL, PRSI, DEL, PRSL, PRSLK, PHII, PHIL, DELTIM, KDT, HPRIME, OC, OA4, CLX4, THETA, SIGMA, GAMMA, ELVMAX, DUSFC, DVSFC, G, CP, RD, RV, IMX, nmtvr, cdmbgwd, me, lprnt, ipr)
real(kind=kind_phys), parameter con_rv
gas constant H2O ( )
real(kind=kind_phys), parameter con_hfus
lat heat H2O fusion ( )
subroutine sascnvn(im, ix, km, jcap, delt, delp, prslp, psp, phil, ql, q1, t1, u1, v1, cldwrk, rn, kbot, ktop, kcnv, islimsk, dot, ncloud, ud_mf, dd_mf, dt_mf, cnvw, cnvc)
This subroutine contains the entirety of the SAS deep convection scheme.
real(kind=kind_phys), parameter con_cp
spec heat air at p ( )
real(kind=kind_phys), parameter con_hvap
lat heat H2O cond ( )
subroutine moninedmf(ix, im, km, ntrac, ntcw, dv, du, tau, rtg, u1, v1, t1, q1, swh, hlw, xmu, psk, rbsoil, zorl, u10m, v10m, fm, fh, tsea, qss, heat, evap, stress, spd1, kpbl, prsi, del, prsl, prslk, phii, phil, delt, dspheat, dusfc, dvsfc, dtsfc, dqsfc, hpbl, hgamt, hgamq, dkt, kinver, xkzm_m, xkzm_h, xkzm_s, lprnt, ipr)
This subroutine contains all of logic for the Hybrid EDMF PBL scheme except for the calculation of th...
subroutine gbphys
Parameter descriptions include intent, name, description, and size.
subroutine shalcnv(im, ix, km, jcap, delt, delp, prslp, psp, phil, ql, q1, t1, u1, v1, rn, kbot, ktop, kcnv, islimsk, dot, ncloud, hpbl, heat, evap, ud_mf, dt_mf, cnvw, cnvc)
This subroutine contains the entirety of the SAS shallow convection scheme.
real(kind=kind_phys), parameter con_rd
gas constant air ( )
real(kind=kind_phys), parameter con_rerth
radius of earth (m)
subroutine gscond(im, ix, km, dt, dtf, prsl, ps, q, cwm, t , tp, qp, psp, tp1, qp1, psp1, u, lprnt, ipr)