diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 9e70fda76..0cb1ac06f 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -68,7 +68,10 @@ end subroutine GFS_SCNV_generic_post_finalize !! \htmlinclude GFS_SCNV_generic_post_run.html !! subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & - frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, errmsg, errflg) + frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, & + shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & + rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & + imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) use machine, only: kind_phys @@ -85,6 +88,19 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw + ! Post code for SAS/SAMF + integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d + logical, intent(in) :: shcnvcw + real(kind=kind_phys), dimension(im), intent(in) :: rain1 + real(kind=kind_phys), dimension(im,levs), intent(in) :: cnvw, cnvc + real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cnvprcp, cnvprcpb + ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. + ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, + ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays + ! as long as these do not get used when not allocated. + real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d + integer, intent(in) :: imfshalcnv, imfshalcnv_sas, imfshalcnv_samf + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -95,6 +111,27 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & errmsg = '' errflg = 0 + if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then + do i=1,im + rainc(i) = rainc(i) + frain * rain1(i) + enddo +! 'cnvw' and 'cnvc' are set to zero before computation starts: + if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3) then + do k=1,levs + do i=1,im + cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) + cnvc_phy_f3d(i,k) = cnvc_phy_f3d(i,k) + cnvc(i,k) + enddo + enddo + elseif (npdf3d == 0 .and. ncnvcld3d == 1) then + do k=1,levs + do i=1,im + cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) + enddo + enddo + endif + endif + if (lssav) then if (ldiag3d) then do k=1,levs diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index a2763e4bb..79f4eab11 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -212,6 +212,134 @@ kind = kind_phys intent = inout optional = F +[shcnvcw] + standard_name = flag_shallow_convective_cloud + long_name = flag for shallow convective cloud + units = + dimensions = () + type = logical + intent = in + optional = F +[rain1] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[npdf3d] + standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds + long_name = number of 3d arrays associated with pdf based clouds/mp + units = count + dimensions = () + type = integer + intent = in + optional = F +[num_p3d] + standard_name = array_dimension_of_3d_arrays_for_microphysics + long_name = number of 3D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnvcld3d] + standard_name = number_of_convective_3d_cloud_fields + long_name = number of convective 3d clouds fields + units = count + dimensions = () + type = integer + intent = in + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep + long_name = convective rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcp] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount + long_name = cumulative convective precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcpb] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket + long_name = cumulative convective precipitation in bucket + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvw_phy_f3d] + standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d + long_name = convective cloud water mixing ratio in the phy_f3d array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc_phy_f3d] + standard_name = convective_cloud_cover_in_phy_f3d + long_name = convective cloud cover in the phy_f3d array + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_sas] + standard_name = flag_for_sas_shallow_convection_scheme + long_name = flag for SAS shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_samf] + standard_name = flag_for_samf_shallow_convection_scheme + long_name = flag for SAMF shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/mfpbltq.f b/physics/mfpbltq.f new file mode 100644 index 000000000..0f4004444 --- /dev/null +++ b/physics/mfpbltq.f @@ -0,0 +1,453 @@ +!>\file mfpbltq.f +!! This file contains the subroutine that calculates mass flux and +!! updraft parcel properties for thermals driven by surface heating +!! for use in the TKE-EDMF PBL scheme (updated version). + +!>\ingroup satmedmfq +!! This subroutine computes mass flux and updraft parcel properties for +!! thermals driven by surface heating. +!!\section mfpbltq_gen GFS mfpblt General Algorithm +!> @{ + subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, + & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, + & gdx,hpbl,kpbl,vpert,buo,xmf, + & tcko,qcko,ucko,vcko,xlamue,a1) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, cp => con_cp + &, rv => con_rv, hvap => con_hvap + &, fv => con_fvirt + &, eps => con_eps, epsm1 => con_epsm1 +! + implicit none +! + integer im, ix, km, kmpbl, ntcw, ntrac1 +! &, me + integer kpbl(im) + logical cnvflg(im) + real(kind=kind_phys) delt + real(kind=kind_phys) q1(ix,km,ntrac1), + & t1(ix,km), u1(ix,km), v1(ix,km), + & plyr(im,km),pix(im,km),thlx(im,km), + & thvx(im,km),zl(im,km), zm(im,km), + & gdx(im), hpbl(im), vpert(im), + & buo(im,km), xmf(im,km), + & tcko(im,km),qcko(im,km,ntrac1), + & ucko(im,km),vcko(im,km), + & xlamue(im,km-1) +! +c local variables and arrays +! + integer i, j, k, n, ndc +! + real(kind=kind_phys) dt2, dz, ce0, cm, + & factor, gocp, + & g, b1, f1, + & bb1, bb2, + & a1, pgcon, + & qmin, qlmin, xmmx, rbint, + & tem, tem1, tem2, + & ptem, ptem1, ptem2 +! + real(kind=kind_phys) elocp, el2orc, qs, es, + & tlu, gamma, qlu, + & thup, thvu, dq +! + real(kind=kind_phys) rbdn(im), rbup(im), xlamuem(im,km-1) + real(kind=kind_phys) delz(im), xlamax(im) +! + real(kind=kind_phys) wu2(im,km), thlu(im,km), + & qtx(im,km), qtu(im,km) +! + real(kind=kind_phys) xlamavg(im), sigma(im), + & scaldfunc(im), sumx(im) +! + logical totflg, flg(im) +! +! physical parameters + parameter(g=grav) + parameter(gocp=g/cp) + parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) + parameter(ce0=0.4,cm=1.0) + parameter(qmin=1.e-8,qlmin=1.e-12) + parameter(pgcon=0.55) + parameter(b1=0.5,f1=0.15) +! +!************************************************************************ +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! + dt2 = delt +! + do k = 1, km + do i=1,im + if (cnvflg(i)) then + buo(i,k) = 0. + wu2(i,k) = 0. + qtx(i,k) = q1(i,k,1) + q1(i,k,ntcw) + endif + enddo + enddo +! +!> - Compute thermal excess +! + do i=1,im + if(cnvflg(i)) then + thlu(i,1)= thlx(i,1) + vpert(i) + qtu(i,1) = qtx(i,1) + buo(i,1) = g * vpert(i) / thvx(i,1) + endif + enddo +! +!> - Compute entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = kpbl(i) / 2 + k = max(k, 1) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(cnvflg(i)) then + if(k < kpbl(i)) then + ptem = 1./(zm(i,k)+delz(i)) + tem = max((hpbl(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamue(i,k) = ce0 * (ptem+ptem1) + else + xlamue(i,k) = xlamax(i) + endif +! + xlamuem(i,k) = cm * xlamue(i,k) + endif + enddo + enddo +! +!> - Compute buoyancy for updraft air parcel +! + do k = 2, kmpbl + do i=1,im + if(cnvflg(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem* + & (thlx(i,k-1)+thlx(i,k)))/factor + qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem* + & (qtx(i,k-1)+qtx(i,k)))/factor +! + tlu = thlu(i,k) / pix(i,k) + es = 0.01 * fpvs(tlu) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtu(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tlu**2) + qlu = dq / (1. + gamma) + qtu(i,k) = qs + qlu + tem1 = 1. + fv * qs - qlu + thup = thlu(i,k) + pix(i,k) * elocp * qlu + thvu = thup * tem1 + else + tem1 = 1. + fv * qtu(i,k) + thvu = thlu(i,k) * tem1 + endif + buo(i,k) = g * (thvu / thvx(i,k) - 1.) +! + endif + enddo + enddo +! +!> - Compute updraft velocity square(wu2, eqn 13 in +!! Han et al.(2019) \cite Han_2019) +! +! tem = 1.-2.*f1 +! bb1 = 2. * b1 / tem +! bb2 = 2. / tem +! from Soares et al. (2004,QJRMS) +! bb1 = 2. +! bb2 = 4. +! +! from Bretherton et al. (2004, MWR) +! bb1 = 4. +! bb2 = 2. +! +! from our tuning + bb1 = 2.0 + bb2 = 4.0 +! + do i = 1, im + if(cnvflg(i)) then + dz = zm(i,1) + tem = 0.5*bb1*xlamue(i,1)*dz + tem1 = bb2 * buo(i,1) * dz + ptem1 = 1. + tem + wu2(i,1) = tem1 / ptem1 + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(cnvflg(i)) then + dz = zm(i,k) - zm(i,k-1) + tem = 0.25*bb1*(xlamue(i,k)+xlamue(i,k-1))*dz + tem1 = bb2 * buo(i,k) * dz + ptem = (1. - tem) * wu2(i,k-1) + ptem1 = 1. + tem + wu2(i,k) = (ptem + tem1) / ptem1 + endif + enddo + enddo +! +!> - Update pbl height as the height where updraft velocity vanishes +! + do i=1,im + flg(i) = .true. + if(cnvflg(i)) then + flg(i) = .false. + rbup(i) = wu2(i,1) + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + rbup(i) = wu2(i,k) + kpbl(i)= k + flg(i) = rbup(i).le.0. + endif + enddo + enddo + do i = 1,im + if(cnvflg(i)) then + k = kpbl(i) + if(rbdn(i) <= 0.) then + rbint = 0. + elseif(rbup(i) >= 0.) then + rbint = 1. + else + rbint = rbdn(i)/(rbdn(i)-rbup(i)) + endif + hpbl(i) = zm(i,k-1) + rbint*(zm(i,k)-zm(i,k-1)) + endif + enddo +! +!> - Update entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = kpbl(i) / 2 + k = max(k, 1) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(cnvflg(i)) then + if(k < kpbl(i)) then + ptem = 1./(zm(i,k)+delz(i)) + tem = max((hpbl(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamue(i,k) = ce0 * (ptem+ptem1) + else + xlamue(i,k) = xlamax(i) + endif +! + xlamuem(i,k) = cm * xlamue(i,k) + endif + enddo + enddo +! +!> - Compute entrainment rate averaged over the whole pbl +! + do i = 1, im + xlamavg(i) = 0. + sumx(i) = 0. + enddo + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + dz = zl(i,k+1) - zl(i,k) + xlamavg(i) = xlamavg(i) + xlamue(i,k) * dz + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + xlamavg(i) = xlamavg(i) / sumx(i) + endif + enddo +! +!> - Updraft mass flux as a function of updraft velocity profile +! + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + xmf(i,k) = a1 * sqrt(wu2(i,k)) + endif + enddo + enddo +! +!> - Compute updraft fraction as a function of mean entrainment rate +!!(Grell and Freitas (2014) \cite grell_and_freitas_2014 +! + do i = 1, im + if(cnvflg(i)) then + tem = 0.2 / xlamavg(i) + tem1 = 3.14 * tem * tem + sigma(i) = tem1 / (gdx(i) * gdx(i)) + sigma(i) = max(sigma(i), 0.001) + sigma(i) = min(sigma(i), 0.999) + endif + enddo +! +!> - Compute scale-aware function based on +!! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 +! + do i = 1, im + if(cnvflg(i)) then + if (sigma(i) > a1) then + scaldfunc(i) = (1.-sigma(i)) * (1.-sigma(i)) + scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0.) + else + scaldfunc(i) = 1.0 + endif + endif + enddo +! +!> - Final scale-aware updraft mass flux +! + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + xmf(i,k) = scaldfunc(i) * xmf(i,k) + dz = zl(i,k+1) - zl(i,k) + xmmx = dz / dt2 + xmf(i,k) = min(xmf(i,k),xmmx) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - Compute updraft property using updated entranment rate +! + do i=1,im + if(cnvflg(i)) then + thlu(i,1)= thlx(i,1) + endif + enddo +! +! do i=1,im +! if(cnvflg(i)) then +! ptem1 = max(qcko(i,1,ntcw), 0.) +! tlu = thlu(i,1) / pix(i,1) +! tcko(i,1) = tlu + elocp * ptem1 +! endif +! enddo +! + do k = 2, kmpbl + do i=1,im + if(cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem* + & (thlx(i,k-1)+thlx(i,k)))/factor + qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem* + & (qtx(i,k-1)+qtx(i,k)))/factor +! + tlu = thlu(i,k) / pix(i,k) + es = 0.01 * fpvs(tlu) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtu(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tlu**2) + qlu = dq / (1. + gamma) + qtu(i,k) = qs + qlu + qcko(i,k,1) = qs + qcko(i,k,ntcw) = qlu + tcko(i,k) = tlu + elocp * qlu + else + qcko(i,k,1) = qtu(i,k) + qcko(i,k,ntcw) = 0. + tcko(i,k) = tlu + endif +! + endif + enddo + enddo +! + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamuem(i,k-1) * dz + factor = 1. + tem + ptem = tem + pgcon + ptem1= tem - pgcon + ucko(i,k) = ((1.-tem)*ucko(i,k-1)+ptem*u1(i,k) + & +ptem1*u1(i,k-1))/factor + vcko(i,k) = ((1.-tem)*vcko(i,k-1)+ptem*v1(i,k) + & +ptem1*v1(i,k-1))/factor + endif + enddo + enddo +! + if(ntcw > 2) then +! + do n = 2, ntcw-1 + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem* + & (q1(i,k,n)+q1(i,k-1,n)))/factor + endif + enddo + enddo + enddo +! + endif +! + ndc = ntrac1 - ntcw +! + if(ndc > 0) then +! + do n = ntcw+1, ntrac1 + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem* + & (q1(i,k,n)+q1(i,k-1,n)))/factor + endif + enddo + enddo + enddo +! + endif +! + return + end +!> @} diff --git a/physics/mfscuq.f b/physics/mfscuq.f new file mode 100644 index 000000000..c6f66b74b --- /dev/null +++ b/physics/mfscuq.f @@ -0,0 +1,550 @@ +!>\file mfscuq.f +!! This file contains the mass flux and downdraft parcel preperties +!! parameterization for stratocumulus-top-driven turbulence (updated version). + +!>\ingroup satmedmfq +!! This subroutine computes mass flux and downdraft parcel properties +!! for stratocumulus-top-driven turbulence. +!! \section mfscuq GFS mfscu General Algorithm +!> @{ + subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, + & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix, + & thlx,thvx,thlvx,gdx,thetae, + & krad,mrad,radmin,buo,xmfd, + & tcdo,qcdo,ucdo,vcdo,xlamde,a1) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, cp => con_cp + &, rv => con_rv, hvap => con_hvap + &, fv => con_fvirt + &, eps => con_eps, epsm1 => con_epsm1 +! + implicit none +! + integer im, ix, km, kmscu, ntcw, ntrac1 +! &, me + integer krad(im), mrad(im) +! + logical cnvflg(im) + real(kind=kind_phys) delt + real(kind=kind_phys) q1(ix,km,ntrac1),t1(ix,km), + & u1(ix,km), v1(ix,km), + & plyr(im,km), pix(im,km), + & thlx(im,km), + & thvx(im,km), thlvx(im,km), + & gdx(im), + & zl(im,km), zm(im,km), + & thetae(im,km), radmin(im), + & buo(im,km), xmfd(im,km), + & tcdo(im,km), qcdo(im,km,ntrac1), + & ucdo(im,km), vcdo(im,km), + & xlamde(im,km-1) +! +! local variables and arrays +! +! + integer i,j,indx, k, n, kk, ndc + integer krad1(im) +! + real(kind=kind_phys) dt2, dz, ce0, cm, + & gocp, factor, g, tau, + & b1, f1, bb1, bb2, + & a1, a2, + & cteit, pgcon, + & qmin, qlmin, + & xmmx, tem, tem1, tem2, + & ptem, ptem1, ptem2 +! + real(kind=kind_phys) elocp, el2orc, qs, es, + & tld, gamma, qld, thdn, + & thvd, dq +! + real(kind=kind_phys) wd2(im,km), thld(im,km), + & qtx(im,km), qtd(im,km), + & thlvd(im), hrad(im), + & xlamdem(im,km-1), ra1(im) + real(kind=kind_phys) delz(im), xlamax(im) +! + real(kind=kind_phys) xlamavg(im), sigma(im), + & scaldfunc(im), sumx(im) +! + logical totflg, flg(im) +! + real(kind=kind_phys) actei, cldtime +! +c physical parameters + parameter(g=grav) + parameter(gocp=g/cp) + parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) + parameter(ce0=0.4,cm=1.0,pgcon=0.55) + parameter(qmin=1.e-8,qlmin=1.e-12) + parameter(b1=0.45,f1=0.15) + parameter(a2=0.5) + parameter(cldtime=500.) + parameter(actei = 0.7) +! parameter(actei = 0.23) +! +!************************************************************************ +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! + dt2 = delt +! + do k = 1, km + do i=1,im + if(cnvflg(i)) then + buo(i,k) = 0. + wd2(i,k) = 0. + qtx(i,k) = q1(i,k,1) + q1(i,k,ntcw) + endif + enddo + enddo +! + do i = 1, im + if(cnvflg(i)) then + hrad(i) = zm(i,krad(i)) + krad1(i) = krad(i)-1 + endif + enddo +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + tem = zm(i,k+1)-zm(i,k) + tem1 = cldtime*radmin(i)/tem + tem1 = max(tem1, -3.0) + thld(i,k)= thlx(i,k) + tem1 + qtd(i,k) = qtx(i,k) + thlvd(i) = thlvx(i,k) + tem1 + buo(i,k) = - g * tem1 / thvx(i,k) + endif + enddo +! +!> - Specify downdraft fraction +! + do i=1,im + if(cnvflg(i)) then + ra1(i) = a1 + endif + enddo +! +!> - If the condition for cloud-top instability is met, +!! increase downdraft fraction +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + tem = thetae(i,k) - thetae(i,k+1) + tem1 = qtx(i,k) - qtx(i,k+1) + if (tem > 0. .and. tem1 > 0.) then + cteit= cp*tem/(hvap*tem1) + if(cteit > actei) then + ra1(i) = a2 + endif + endif + endif + enddo +! +!> - First-guess level of downdraft extension (mrad) +! + do i = 1, im + flg(i) = cnvflg(i) + mrad(i) = krad(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k < krad(i)) then + if(thlvd(i) <= thlvx(i,k)) then + mrad(i) = k + else + flg(i)=.false. + endif + endif + enddo + enddo + do i=1,im + if (cnvflg(i)) then + kk = krad(i)-mrad(i) + if(kk < 1) cnvflg(i)=.false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Compute entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = mrad(i) + (krad(i)-mrad(i)) / 2 + k = max(k, mrad(i)) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmscu + do i=1,im + if(cnvflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + if(mrad(i) == 1) then + ptem = 1./(zm(i,k)+delz(i)) + else + ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i)) + endif + tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamde(i,k) = ce0 * (ptem+ptem1) + else + xlamde(i,k) = xlamax(i) + endif +! + xlamdem(i,k) = cm * xlamde(i,k) + endif + enddo + enddo +! +!> - Compute buoyancy for downdraft air parcel +! + do k = kmscu,1,-1 + do i=1,im + if(cnvflg(i) .and. k < krad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + thld(i,k) = ((1.-tem)*thld(i,k+1)+tem* + & (thlx(i,k)+thlx(i,k+1)))/factor + qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem* + & (qtx(i,k)+qtx(i,k+1)))/factor +! + tld = thld(i,k) / pix(i,k) + es = 0.01 * fpvs(tld) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtd(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tld**2) + qld = dq / (1. + gamma) + qtd(i,k) = qs + qld + tem1 = 1. + fv * qs - qld + thdn = thld(i,k) + pix(i,k) * elocp * qld + thvd = thdn * tem1 + else + tem1 = 1. + fv * qtd(i,k) + thvd = thld(i,k) * tem1 + endif + buo(i,k) = g * (1. - thvd / thvx(i,k)) +! + endif + enddo + enddo +! +!> - Compute downdraft velocity square(wd2) +! +! tem = 1.-2.*f1 +! bb1 = 2. * b1 / tem +! bb2 = 2. / tem +! from Soares et al. (2004,QJRMS) +! bb1 = 2. +! bb2 = 4. +! +! from Bretherton et al. (2004, MWR) +! bb1 = 4. +! bb2 = 2. +! +! from our tuning + bb1 = 2.0 + bb2 = 4.0 +! + do i = 1, im + if(cnvflg(i)) then + k = krad1(i) + dz = zm(i,k+1) - zm(i,k) +! tem = 0.25*bb1*(xlamde(i,k)+xlamde(i,k+1))*dz + tem = 0.5*bb1*xlamde(i,k)*dz + tem1 = bb2 * buo(i,k+1) * dz + ptem1 = 1. + tem + wd2(i,k) = tem1 / ptem1 + endif + enddo + do k = kmscu,1,-1 + do i = 1, im + if(cnvflg(i) .and. k < krad1(i)) then + dz = zm(i,k+1) - zm(i,k) + tem = 0.25*bb1*(xlamde(i,k)+xlamde(i,k+1))*dz + tem1 = bb2 * buo(i,k+1) * dz + ptem = (1. - tem) * wd2(i,k+1) + ptem1 = 1. + tem + wd2(i,k) = (ptem + tem1) / ptem1 + endif + enddo + enddo +c + do i = 1, im + flg(i) = cnvflg(i) + if(flg(i)) mrad(i) = krad(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k < krad(i)) then + if(wd2(i,k) > 0.) then + mrad(i) = k + else + flg(i)=.false. + endif + endif + enddo + enddo +! + do i=1,im + if (cnvflg(i)) then + kk = krad(i)-mrad(i) + if(kk < 1) cnvflg(i)=.false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Update entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = mrad(i) + (krad(i)-mrad(i)) / 2 + k = max(k, mrad(i)) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmscu + do i=1,im + if(cnvflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + if(mrad(i) == 1) then + ptem = 1./(zm(i,k)+delz(i)) + else + ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i)) + endif + tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamde(i,k) = ce0 * (ptem+ptem1) + else + xlamde(i,k) = xlamax(i) + endif +! + xlamdem(i,k) = cm * xlamde(i,k) + endif + enddo + enddo +! +!> - Compute entrainment rate averaged over the whole downdraft layers +! + do i = 1, im + xlamavg(i) = 0. + sumx(i) = 0. + enddo + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + dz = zl(i,k+1) - zl(i,k) + xlamavg(i) = xlamavg(i) + xlamde(i,k) * dz + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + xlamavg(i) = xlamavg(i) / sumx(i) + endif + enddo +! +!> - Compute downdraft mass flux +! + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + xmfd(i,k) = ra1(i) * sqrt(wd2(i,k)) + endif + enddo + enddo +! +!> - Compute downdraft fraction as a function of mean entrainment rate +!! (Grell and Freitas(2014) \cite grell_and_freitas_2014 +! + do i = 1, im + if(cnvflg(i)) then + tem = 0.2 / xlamavg(i) + tem1 = 3.14 * tem * tem + sigma(i) = tem1 / (gdx(i) * gdx(i)) + sigma(i) = max(sigma(i), 0.001) + sigma(i) = min(sigma(i), 0.999) + endif + enddo +! +!> - Compute scale-aware function based on +!! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 +! + do i = 1, im + if(cnvflg(i)) then + if (sigma(i) > ra1(i)) then + scaldfunc(i) = (1.-sigma(i)) * (1.-sigma(i)) + scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0.) + else + scaldfunc(i) = 1.0 + endif + endif + enddo +! +!> - Compute final scale-aware downdraft mass flux +! + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + xmfd(i,k) = scaldfunc(i) * xmfd(i,k) + dz = zl(i,k+1) - zl(i,k) + xmmx = dz / dt2 + xmfd(i,k) = min(xmfd(i,k),xmmx) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - Compute downdraft property using updated entranment rate +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + thld(i,k)= thlx(i,k) + endif + enddo +! +! do i = 1, im +! if(cnvflg(i)) then +! k = krad(i) +! ptem1 = max(qcdo(i,k,ntcw), 0.) +! tld = thld(i,k) / pix(i,k) +! tcdo(i,k) = tld + elocp * ptem1 +! qcdo(i,k,1) = qcdo(i,k,1)+0.2*qcdo(i,k,1) +! qcdo(i,k,ntcw) = qcdo(i,k,ntcw)+0.2*qcdo(i,k,ntcw) +! endif +! enddo +! + do k = kmscu,1,-1 + do i=1,im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + thld(i,k) = ((1.-tem)*thld(i,k+1)+tem* + & (thlx(i,k)+thlx(i,k+1)))/factor + qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem* + & (qtx(i,k)+qtx(i,k+1)))/factor +! + tld = thld(i,k) / pix(i,k) + es = 0.01 * fpvs(tld) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtd(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tld**2) + qld = dq / (1. + gamma) + qtd(i,k) = qs + qld + qcdo(i,k,1) = qs + qcdo(i,k,ntcw) = qld + tcdo(i,k) = tld + elocp * qld + else + qcdo(i,k,1) = qtd(i,k) + qcdo(i,k,ntcw) = 0. + tcdo(i,k) = tld + endif +! + endif + enddo + enddo +! + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamdem(i,k) * dz + factor = 1. + tem + ptem = tem - pgcon + ptem1= tem + pgcon +! + ucdo(i,k) = ((1.-tem)*ucdo(i,k+1)+ptem*u1(i,k+1) + & +ptem1*u1(i,k))/factor + vcdo(i,k) = ((1.-tem)*vcdo(i,k+1)+ptem*v1(i,k+1) + & +ptem1*v1(i,k))/factor + endif + endif + enddo + enddo +! + if(ntcw > 2) then +! + do n = 2, ntcw-1 + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem* + & (q1(i,k,n)+q1(i,k+1,n)))/factor + endif + endif + enddo + enddo + enddo +! + endif +! + ndc = ntrac1 - ntcw +! + if(ndc > 0) then +! + do n = ntcw+1, ntrac1 + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem* + & (q1(i,k,n)+q1(i,k+1,n)))/factor + endif + endif + enddo + enddo + enddo +! + endif +! + return + end +!> @} diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index 51b64adfe..ed80a2f54 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -1811,77 +1811,3 @@ end subroutine samfshalcnv_run !! @} end module samfshalcnv -!> This module contains the CCPP-compliant scale-aware mass-flux shallow convection -!! post interstitial codes. - module samfshalcnv_post - contains - -!! \section arg_table_samfshalcnv_post_run Argument Table -!! \htmlinclude samfshalcnv_post_run.html -!! - subroutine samfshalcnv_post_run (im, levs, lssav, shcnvcw, frain, - & rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, - & rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, - & errmsg, errflg) - - use machine, only: kind_phys - - implicit none -! - integer, intent(in) :: im, levs - integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d - logical, intent(in) :: lssav, shcnvcw - real(kind=kind_phys), intent(in) :: frain - real(kind=kind_phys), dimension(im), intent(in) :: rain1 - real(kind=kind_phys), dimension(im,levs), intent(in) :: cnvw, - & cnvc - - real(kind=kind_phys), dimension(im), intent(inout) :: rainc, - & cnvprcp, cnvprcpb - ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. - ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, - ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays - ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:,:), intent(inout) :: - & cnvw_phy_f3d, cnvc_phy_f3d - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - rainc(i) = rainc(i) + frain * rain1(i) - enddo -! in mfshalcnv, 'cnvw' and 'cnvc' are set to zero before computation starts: - if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3) then - do k=1,levs - do i=1,im - cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) - cnvc_phy_f3d(i,k) = cnvc_phy_f3d(i,k) + cnvc(i,k) - enddo - enddo - elseif (npdf3d == 0 .and. ncnvcld3d == 1) then - do k=1,levs - do i=1,im - cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) - enddo - enddo - endif - end subroutine samfshalcnv_post_run - -!! \section arg_table_sasas_shal_post_init Argument Table -!! - subroutine samfshalcnv_post_init () - end subroutine samfshalcnv_post_init - -!! \section arg_table_sasas_shal_post_finalize Argument Table -!! - subroutine samfshalcnv_post_finalize () - end subroutine samfshalcnv_post_finalize - - end module samfshalcnv_post diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 2dd3be372..5189afd95 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -439,172 +439,3 @@ type = integer intent = out optional = F - -######################################################################## -[ccpp-arg-table] - name = samfshalcnv_post_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[levs] - standard_name = vertical_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[lssav] - standard_name = flag_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[shcnvcw] - standard_name = flag_shallow_convective_cloud - long_name = flag for shallow convective cloud - units = - dimensions = () - type = logical - intent = in - optional = F -[frain] - standard_name = dynamics_to_physics_timestep_ratio - long_name = ratio of dynamics timestep to physics timestep - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[rain1] - standard_name = lwe_thickness_of_shallow_convective_precipitation_amount - long_name = shallow convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[npdf3d] - standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds - long_name = number of 3d arrays associated with pdf based clouds/mp - units = count - dimensions = () - type = integer - intent = in - optional = F -[num_p3d] - standard_name = array_dimension_of_3d_arrays_for_microphysics - long_name = number of 3D arrays needed for microphysics - units = count - dimensions = () - type = integer - intent = in - optional = F -[ncnvcld3d] - standard_name = number_of_convective_3d_cloud_fields - long_name = number of convective 3d clouds fields - units = count - dimensions = () - type = integer - intent = in - optional = F -[cnvc] - standard_name = convective_cloud_cover - long_name = convective cloud cover - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[cnvw] - standard_name = convective_cloud_water_mixing_ratio - long_name = moist convective cloud water mixing ratio - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[rainc] - standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep - long_name = convective rain at this time step - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvprcp] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount - long_name = cumulative convective precipitation - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvprcpb] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket - long_name = cumulative convective precipitation in bucket - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvw_phy_f3d] - standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d - long_name = convective cloud water mixing ratio in the phy_f3d array - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvc_phy_f3d] - standard_name = convective_cloud_cover_in_phy_f3d - long_name = convective cloud cover in the phy_f3d array - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F - -######################################################################## -[ccpp-arg-table] - name = sasas_shal_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = sasas_shal_post_finalize - type = scheme diff --git a/physics/sascnvn.F b/physics/sascnvn.F new file mode 100644 index 000000000..79c1bdc36 --- /dev/null +++ b/physics/sascnvn.F @@ -0,0 +1,2155 @@ +!> \defgroup SAS Simplified Arakawa-Schubert Deep Convection +!! @{ +!! \brief The Simplified Arakawa-Schubert scheme parameterizes the effect of deep convection on the environment (represented by the model state variables) in the following way. First, a simple cloud model is used to determine the change in model state variables due to one entraining/detraining cloud type, per unit cloud-base mass flux. Next, the total change in state variables is retrieved by determining the actual cloud base mass flux using the quasi-equilibrium assumption, whereby convection is assumed to be steady-state. This implies that the generation of the cloud work function (interpreted as entrainment-moderated convective available potential energy (CAPE)) by the large scale dynamics is in balance with the consumption of the cloud work function by the convection. +!! +!! The SAS scheme uses the working concepts put forth in Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 but includes modifications and simplifications from Grell (1993) \cite grell_1993 such as saturated downdrafts and only one cloud type (the deepest possible), rather than a spectrum based on cloud top heights or assumed entrainment rates. The scheme was implemented for the GFS in 1995 by Pan and Wu \cite pan_and_wu_1995, with further modifications discussed in Han and Pan (2011) \cite han_and_pan_2011 , including the calculation of cloud top, a greater CFL-criterion-based maximum cloud base mass flux, updated cloud model entrainment and detrainment, improved convective transport of horizontal momentum, a more general triggering function, and the inclusion of convective overshooting. +!! +!! \section diagram Calling Hierarchy Diagram +!! \image html SAS_Flowchart.png "Diagram depicting how the SAS deep convection scheme is called from the GSM physics time loop" height=2cm +!! \section intraphysics Intraphysics Communication +!! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. + +!> \file sascnvn.F +!! Contains the entire SAS deep convection scheme. + module sascnvn + + implicit none + + private + + public :: sascnvn_init, sascnvn_run, sascnvn_finalize + + contains + +!! +!! \section arg_table_sascnvn_init Argument Table +!! \htmlinclude sascnvn_init.html +!! + subroutine sascnvn_init(imfdeepcnv,imfdeepcnv_sas,errmsg,errflg) +! + integer, intent(in) :: imfdeepcnv, imfdeepcnv_sas + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (imfdeepcnv/=imfdeepcnv_sas) then + write(errmsg,'(*(a))') 'Logic error: sascnvn incompatible with',& + & ' value of imfdeepcnv' + errflg = 1 + return + endif +! + end subroutine sascnvn_init + +! \brief This subroutine is empty since there are no procedures that need to be done to finalize the sascnvn code. +!! +!! \section arg_table_sascnvn_finalize Argument Table +!! + subroutine sascnvn_finalize + end subroutine sascnvn_finalize + +!> \brief This subroutine contains the entirety of the SAS deep convection scheme. +!! +!! As in Grell (1993) \cite grell_1993 , the SAS convective scheme can be described in terms of three types of "controls": static, dynamic, and feedback. The static control component consists of the simple entraining/detraining updraft/downdraft cloud model and is used to determine the cloud properties, convective precipitation, as well as the convective cloud top height. The dynamic control is the determination of the potential energy available for convection to "consume", or how primed the large-scale environment is for convection to occur due to changes by the dyanmics of the host model. The feedback control is the determination of how the parameterized convection changes the large-scale environment (the host model state variables) given the changes to the state variables per unit cloud base mass flux calculated in the static control portion and the deduced cloud base mass flux determined from the dynamic control. +!! +!! \param[in] im number of used points +!! \param[in] ix horizontal dimension +!! \param[in] km vertical layer dimension +!! \param[in] jcap number of spectral wave trancation +!! \param[in] delt physics time step in seconds +!! \param[in] delp pressure difference between level k and k+1 (Pa) +!! \param[in] prslp mean layer presure (Pa) +!! \param[in] psp surface pressure (Pa) +!! \param[in] phil layer geopotential (\f$m^2/s^2\f$) +!! \param[inout] qlc cloud water (kg/kg) +!! \param[inout] qli ice (kg/kg) +!! \param[inout] q1 updated tracers (kg/kg) +!! \param[inout] t1 updated temperature (K) +!! \param[inout] u1 updated zonal wind (\f$m s^{-1}\f$) +!! \param[inout] v1 updated meridional wind (\f$m s^{-1}\f$) +!! \param[out] cldwrk cloud workfunction (\f$m^2/s^2\f$) +!! \param[out] rn convective rain (m) +!! \param[out] kbot index for cloud base +!! \param[out] ktop index for cloud top +!! \param[out] kcnv flag to denote deep convection (0=no, 1=yes) +!! \param[in] islimsk sea/land/ice mask (=0/1/2) +!! \param[in] dot layer mean vertical velocity (Pa/s) +!! \param[in] ncloud number of cloud species +!! \param[out] ud_mf updraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dd_mf downdraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dt_mf ud_mf at cloud top (\f$kg/m^2\f$) +!! \param[out] cnvw convective cloud water (kg/kg) +!! \param[out] cnvc convective cloud cover (unitless) +!! +!! \section general General Algorithm +!! -# Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. +!! -# Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!! -# Perform calculations related to the downdraft of the entraining/detraining cloud model ("static control"). +!! -# Using the updated temperature and moisture profiles that were modified by the convection on a short time-scale, recalculate the total cloud work function to determine the change in the cloud work function due to convection, or the stabilizing effect of the cumulus. +!! -# For the "dynamic control", using a reference cloud work function, estimate the change in cloud work function due to the large-scale dynamics. Following the quasi-equilibrium assumption, calculate the cloud base mass flux required to keep the large-scale convective destabilization in balance with the stabilization effect of the convection. +!! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! \section detailed Detailed Algorithm +!! +!! \section arg_table_sascnvn_run Argument Table +!! \htmlinclude sascnvn_run.html +!! +!! @{ + subroutine sascnvn_run( + & grav,cp,hvap,rv,fv,t0c,rgas,cvap,cliq,eps,epsm1, & + & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & q1,t1,u1,v1,cldwrk,rn,kbot,ktop,kcnv,islimsk, & + & dot,ncloud,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & + & qlcn,qicn,w_upi,cf_upi,cnv_mfd, & + & cnv_dqldt,clcn,cnv_fice,cnv_ndrop,cnv_nice,mp_phys, & + & mp_phys_mg,clam,c0,c1,betal,betas,evfact,evfactl,pgcon, & + & errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & +! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & +! &, cvap => con_cvap, cliq => con_cliq & +! &, eps => con_eps, epsm1 => con_epsm1,rgas => con_rd + implicit none +! +! Interface variables +! + real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & + & rgas, cvap, cliq, eps, epsm1 + integer, intent(in) :: im, ix, km, jcap, ncloud, & + & mp_phys, mp_phys_mg + integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) + integer, intent(in) :: islimsk(:) + real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon + real(kind=kind_phys), intent(in) :: betal, betas, evfact, evfactl + real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & + & prslp(:,:), dot(:,:), & + & phil(:,:) + real(kind=kind_phys), intent(inout) :: & + & qlc(:,:), qli(:,:), & + & q1(:,:), t1(:,:), & + & u1(:,:), v1(:,:), & + & cnvw(:,:), cnvc(:,:) + real(kind=kind_phys), intent(out) :: cldwrk(:), rn(:), & + & ud_mf(:,:), dd_mf(:,:), & + & dt_mf(:,:) + real(kind=kind_phys), intent(inout) :: & + & qlcn(:,:), qicn(:,:), & + & w_upi(:,:), cnv_mfd(:,:), & + & cnv_dqldt(:,:), clcn(:,:), & + & cnv_fice(:,:), cnv_ndrop(:,:),& + & cnv_nice(:,:), cf_upi(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! Local variables +! + integer i, indx, jmn, k, kk, km1 +! integer latd,lond +! + real(kind=kind_phys) cxlamu, xlamde, xlamdd +! +! real(kind=kind_phys) detad + real(kind=kind_phys) adw, aup, aafac, + & beta, + & dellat, delta, + & desdt, dg, + & dh, dhh, dp, + & dq, dqsdp, dqsdt, dt, + & dt2, dtmax, dtmin, dv1h, + & dv1q, dv2h, dv2q, dv1u, + & dv1v, dv2u, dv2v, dv3q, + & dv3h, dv3u, dv3v, + & dz, dz1, e1, edtmax, + & edtmaxl, edtmaxs, el2orc, elocp, + & es, etah, cthk, dthk, + & evef, fact1, + & fact2, factor, fjcap, fkm, + & g, gamma, pprime, + & qlk, qrch, qs, + & rain, rfact, shear, tem1, + & val, val1, + & val2, w1, w1l, w1s, + & w2, w2l, w2s, w3, + & w3l, w3s, w4, w4l, + & w4s, xdby, xpw, xpwd, + & xqrch, mbdt, tem, + & ptem, ptem1 +! + integer kb(im), kbcon(im), kbcon1(im), + & ktcon(im), ktcon1(im), + & jmin(im), lmin(im), kbmax(im), + & kbm(im), kmax(im) +! + real(kind=kind_phys) ps(im), del(ix,km), prsl(ix,km) +! + real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), + & delhbar(im), delq(im), delq2(im), + & delqbar(im), delqev(im), deltbar(im), + & deltv(im), dtconv(im), edt(im), + & edto(im), edtx(im), fld(im), + & hcdo(im,km), hmax(im), hmin(im), + & ucdo(im,km), vcdo(im,km),aa2(im), + & pbcdif(im), pdot(im), po(im,km), + & pwavo(im), pwevo(im), xlamud(im), + & qcdo(im,km), qcond(im), qevap(im), + & rntot(im), vshear(im), xaa0(im), + & xk(im), xlamd(im), + & xmb(im), xmbmax(im), xpwav(im), + & xpwev(im), delubar(im),delvbar(im) +! + real(kind=kind_phys) cincr, cincrmax, cincrmin +! +! physical parameters +! parameter(g=grav) +! parameter(elocp=hvap/cp, +! & el2orc=hvap*hvap/(rv*cp)) +! parameter(c0=.002,c1=.002,delta=fv) +! parameter(delta=fv) +! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) + parameter(cthk=150.,cincrmax=180.,cincrmin=120.,dthk=25.) +! + real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), + & uo(im,km), vo(im,km), qeso(im,km) +! cloud water +! real(kind=kind_phys) tvo(im,km) + real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), tvo(im,km), + & dbyo(im,km), zo(im,km), xlamue(im,km), + & fent1(im,km), fent2(im,km), frh(im,km), + & heo(im,km), heso(im,km), + & qrcd(im,km), dellah(im,km), dellaq(im,km), + & dellau(im,km), dellav(im,km), hcko(im,km), + & ucko(im,km), vcko(im,km), qcko(im,km), + & eta(im,km), etad(im,km), zi(im,km), + & qrcko(im,km), qrcdo(im,km), + & pwo(im,km), pwdo(im,km), + & tx1(im), sumx(im), cnvwt(im,km) +! &, rhbar(im) +! + logical totflg, cnvflg(im), flg(im) +! + real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) +! save pcrit, acritt + data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., + & 350.,300.,250.,200.,150./ + data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, + & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ +! gdas derived acrit +! data acritt/.203,.515,.521,.566,.625,.665,.659,.688, +! & .743,.813,.886,.947,1.138,1.377,1.896/ + real(kind=kind_phys) tf, tcr, tcrf + parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) +! +!----------------------------------------------------------------------- +!************************************************************************ +! replace (derived) constants above with regular variables + g = grav + elocp = hvap/cp + el2orc = hvap*hvap/(rv*cp) + delta = fv + fact1 = (cvap-cliq)/rv + fact2 = hvap/rv-fact1*t0c +!************************************************************************ +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!************************************************************************ +!> ## Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. +!> - Convert input pressure terms to centibar units. +!************************************************************************ +! convert input pa terms to cb terms -- moorthi + ps = psp * 0.001 + prsl = prslp * 0.001 + del = delp * 0.001 +!************************************************************************ +! +! + km1 = km - 1 +!> - Initialize column-integrated and other single-value-per-column variable arrays. +! +! initialize arrays +! + do i=1,im + cnvflg(i) = .true. + rn(i)=0. + kbot(i)=km+1 + ktop(i)=0 + kbcon(i)=km + ktcon(i)=1 + dtconv(i) = 3600. + cldwrk(i) = 0. + pdot(i) = 0. + pbcdif(i)= 0. + lmin(i) = 1 + jmin(i) = 1 + qlko_ktcon(i) = 0. + edt(i) = 0. + edto(i) = 0. + edtx(i) = 0. + acrt(i) = 0. + acrtfct(i) = 1. + aa1(i) = 0. + aa2(i) = 0. + xaa0(i) = 0. + pwavo(i)= 0. + pwevo(i)= 0. + xpwav(i)= 0. + xpwev(i)= 0. + vshear(i) = 0. + enddo +!> - Initialize convective cloud water and cloud cover to zero. + do k = 1, km + do i = 1, im + cnvw(i,k) = 0. + cnvc(i,k) = 0. + enddo + enddo +!> - Initialize updraft, downdraft, detrainment mass fluxes to zero. +! hchuang code change + do k = 1, km + do i = 1, im + ud_mf(i,k) = 0. + dd_mf(i,k) = 0. + dt_mf(i,k) = 0. + if(mp_phys == mp_phys_mg) then + qlcn(i,k) = 0.0 + qicn(i,k) = 0.0 + w_upi(i,k) = 0.0 + cf_upi(i,k) = 0.0 + cnv_mfd(i,k) = 0.0 +! cnv_prc3(i,k) = 0.0 + cnv_dqldt(i,k) = 0.0 + clcn(i,k) = 0.0 + cnv_fice(i,k) = 0.0 + cnv_ndrop(i,k) = 0.0 + cnv_nice(i,k) = 0.0 + end if + enddo + enddo +!> - Initialize the reference cloud work function, define min/max convective adjustment timescales, and tunable parameters. +! + do k = 1, 15 + acrit(k) = acritt(k) * (975. - pcrit(k)) + enddo + dt2 = delt + val = 1200. + dtmin = max(dt2, val ) + val = 3600. + dtmax = max(dt2, val ) +! model tunable parameters are all here + mbdt = 10. + edtmaxl = .3 + edtmaxs = .3 +! clam = .1 + aafac = .1 +! betal = .15 +! betas = .15 +! betal = .05 +! betas = .05 +! evef = 0.07 +! evfact = 0.3 +! evfactl = 0.3 +! + cxlamu = 1.0e-4 + xlamde = 1.0e-4 + xlamdd = 1.0e-4 +! +! pgcon = 0.7 ! gregory et al. (1997, qjrms) +! pgcon = 0.55 ! zhang & wu (2003,jas) + fjcap = (float(jcap) / 126.) ** 2 + val = 1. + fjcap = max(fjcap,val) + fkm = (float(km) / 28.) ** 2 + fkm = max(fkm,val) + w1l = -8.e-3 + w2l = -4.e-2 + w3l = -5.e-3 + w4l = -5.e-4 + w1s = -2.e-4 + w2s = -2.e-3 + w3s = -1.e-3 + w4s = -2.e-5 +!> - Determine maximum indices for the parcel starting point (kbm), LFC (kbmax), and cloud top (kmax). +! +! define top layer for search of the downdraft originating layer +! and the maximum thetae for updraft +! + do i=1,im + kbmax(i) = km + kbm(i) = km + kmax(i) = km + tx1(i) = 1.0 / ps(i) + enddo +! + do k = 1, km + do i=1,im + if (prsl(i,k)*tx1(i) .gt. 0.04) kmax(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.45) kbmax(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.70) kbm(i) = k + 1 + enddo + enddo + do i=1,im + kmax(i) = min(km,kmax(i)) + kbmax(i) = min(kbmax(i),kmax(i)) + kbm(i) = min(kbm(i),kmax(i)) + enddo +! +! hydrostatic height assume zero terr and initially assume +! updraft entrainment rate as an inverse function of height +! +!> - Calculate hydrostatic height at layer centers assuming a flat surface (no terrain) from the geopotential. + do k = 1, km + do i=1,im + zo(i,k) = phil(i,k) / g + enddo + enddo +!> - Calculate interface height and the initial entrainment rate as an inverse function of height. + do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) + enddo + enddo +!> - Convert prsl from centibar to millibar, set normalized mass fluxes to 1, cloud properties to 0, and save model state variables (after advection/turbulence). +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! convert surface pressure to mb from cb +! + do k = 1, km + do i = 1, im + if (k .le. kmax(i)) then + pfld(i,k) = prsl(i,k) * 10.0 + eta(i,k) = 1. + fent1(i,k)= 1. + fent2(i,k)= 1. + frh(i,k) = 0. + hcko(i,k) = 0. + qcko(i,k) = 0. + qrcko(i,k)= 0. + ucko(i,k) = 0. + vcko(i,k) = 0. + etad(i,k) = 1. + hcdo(i,k) = 0. + qcdo(i,k) = 0. + ucdo(i,k) = 0. + vcdo(i,k) = 0. + qrcd(i,k) = 0. + qrcdo(i,k)= 0. + dbyo(i,k) = 0. + pwo(i,k) = 0. + pwdo(i,k) = 0. + dellal(i,k) = 0. + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) +! uo(i,k) = u1(i,k) * rcs(i) +! vo(i,k) = v1(i,k) * rcs(i) + cnvwt(i,k)= 0. + endif + enddo + enddo +! +! column variables +! p is pressure of the layer (mb) +! t is temperature at t-dt (k)..tn +! q is mixing ratio at t-dt (kg/kg)..qn +! to is temperature at t+dt (k)... this is after advection and turbulan +! qo is mixing ratio at t+dt (kg/kg)..q1 +! +!> - Calculate saturation mixing ratio and enforce minimum moisture values. + do k = 1, km + do i=1,im + if (k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +! compute moist static energy +! +!> - Calculate moist static energy (heo) and saturation moist static energy (heso). + do k = 1, km + do i=1,im + if (k .le. kmax(i)) then +! tem = g * zo(i,k) + cp * to(i,k) + tem = phil(i,k) + cp * to(i,k) + heo(i,k) = tem + hvap * qo(i,k) + heso(i,k) = tem + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo + enddo + +!> ## Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +! +! determine level with largest moist static energy +! this is the level where updraft starts +! +!> - Search below index "kbm" for the level of maximum moist static energy. + do i=1,im + hmax(i) = heo(i,1) + kb(i) = 1 + enddo + do k = 2, km + do i=1,im + if (k .le. kbm(i)) then + if(heo(i,k).gt.hmax(i)) then + kb(i) = k + hmax(i) = heo(i,k) + endif + endif + enddo + enddo +!> - Calculate the temperature, water vapor mixing ratio, and pressure at interface levels. +! + do k = 1, km1 + do i=1,im + if (k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo +!> - Recalculate saturation mixing ratio, moist static energy, saturation moist static energy, and horizontal momentum on interface levels. Enforce minimum mixing ratios and calculate \f$(1 - RH)\f$. +! + do k = 1, km1 + do i=1,im + if (k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + frh(i,k) = 1. - min(qo(i,k)/qeso(i,k), 1.) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + uo(i,k) = .5 * (uo(i,k) + uo(i,k+1)) + vo(i,k) = .5 * (vo(i,k) + vo(i,k+1)) + endif + enddo + enddo +! +! look for the level of free convection as cloud base +! +!> - Search below the index "kbmax" for the level of free convection (LFC) where the condition \f$h_b > h^*\f$ is first met, where \f$h_b, h^*\f$ are the state moist static energy at the parcel's starting level and saturation moist static energy, respectively. Set "kbcon" to the index of the LFC. + do i=1,im + flg(i) = .true. + kbcon(i) = kmax(i) + enddo + do k = 1, km1 + do i=1,im + if (flg(i).and.k.le.kbmax(i)) then + if(k.gt.kb(i).and.heo(i,kb(i)).gt.heso(i,k)) then + kbcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +!> - If no LFC, return to the calling routine without modifying state variables. +! + do i=1,im + if(kbcon(i).eq.kmax(i)) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine critical convective inhibition +! as a function of vertical velocity at cloud base. +! +!> - Determine the vertical pressure velocity at the LFC. After Han and Pan (2011) \cite han_and_pan_2011 , determine the maximum pressure thickness between a parcel's starting level and the LFC. If a parcel doesn't reach the LFC within the critical thickness, then the convective inhibition is deemed too great for convection to be triggered, and the subroutine returns to the calling routine without modifying the state variables. + do i=1,im + if(cnvflg(i)) then +! pdot(i) = 10.* dot(i,kbcon(i)) + pdot(i) = 0.01 * dot(i,kbcon(i)) ! now dot is in pa/s + endif + enddo + do i=1,im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif + if(pdot(i).le.w4) then + tem = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + tem = - (pdot(i) + w4) / (w4 - w3) + else + tem = 0. + endif + val1 = -1. + tem = max(tem,val1) + val2 = 1. + tem = min(tem,val2) + tem = 1. - tem + tem1= .5*(cincrmax-cincrmin) + cincr = cincrmax - tem * tem1 + pbcdif(i) = pfld(i,kb(i)) - pfld(i,kbcon(i)) + if(pbcdif(i).gt.cincr) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! assume that updraft entrainment rate above cloud base is +! same as that at cloud base +! +!> - Calculate the entrainment rate according to Han and Pan (2011) \cite han_and_pan_2011 , equation 8, after Bechtold et al. (2008) \cite bechtold_et_al_2008, equation 2 given by: +!! \f[ +!! \epsilon = \epsilon_0F_0 + d_1\left(1-RH\right)F_1 +!! \f] +!! where \f$\epsilon_0\f$ is the cloud base entrainment rate, \f$d_1\f$ is a tunable constant, and \f$F_0=\left(\frac{q_s}{q_{s,b}}\right)^2\f$ and \f$F_1=\left(\frac{q_s}{q_{s,b}}\right)^3\f$ where \f$q_s\f$ and \f$q_{s,b}\f$ are the saturation specific humidities at a given level and cloud base, respectively. The detrainment rate in the cloud is assumed to be equal to the entrainment rate at cloud base. + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.gt.kbcon(i).and.k.lt.kmax(i))) then + xlamue(i,k) = xlamue(i,kbcon(i)) + endif + enddo + enddo +! +! assume the detrainment rate for the updrafts to be same as +! the entrainment rate at cloud base +! +!> - The updraft detrainment rate is set constant and equal to the entrainment rate at cloud base. + do i = 1, im + if(cnvflg(i)) then + xlamud(i) = xlamue(i,kbcon(i)) + endif + enddo +! +! functions rapidly decreasing with height, mimicking a cloud ensemble +! (bechtold et al., 2008) +! + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.gt.kbcon(i).and.k.lt.kmax(i))) then + tem = qeso(i,k)/qeso(i,kbcon(i)) + fent1(i,k) = tem**2 + fent2(i,k) = tem**3 + endif + enddo + enddo +! +! final entrainment rate as the sum of turbulent part and organized entrainment +! depending on the environmental relative humidity +! (bechtold et al., 2008) +! + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.ge.kbcon(i).and.k.lt.kmax(i))) then + tem = cxlamu * frh(i,k) * fent2(i,k) + xlamue(i,k) = xlamue(i,k)*fent1(i,k) + tem + endif + enddo + enddo +! +! determine updraft mass flux for the subcloud layers +! +!> - Calculate the normalized mass flux for subcloud and in-cloud layers according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 1: +!! \f[ +!! \frac{1}{\eta}\frac{\partial \eta}{\partial z} = \lambda_e - \lambda_d +!! \f] +!! where \f$\eta\f$ is the normalized mass flux, \f$\lambda_e\f$ is the entrainment rate and \f$\lambda_d\f$ is the detrainment rate. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.kbcon(i).and.k.ge.kb(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k+1))-xlamud(i) + eta(i,k) = eta(i,k+1) / (1. + ptem * dz) + endif + endif + enddo + enddo +! +! compute mass flux above cloud base +! + do k = 2, km1 + do i = 1, im + if(cnvflg(i))then + if(k.gt.kbcon(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k-1))-xlamud(i) + eta(i,k) = eta(i,k-1) * (1 + ptem * dz) + endif + endif + enddo + enddo +! +! compute updraft cloud properties +! +!> - Set initial cloud properties equal to the state variables at cloud base. + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + ucko(i,indx) = uo(i,indx) + vcko(i,indx) = vo(i,indx) + pwavo(i) = 0. + endif + enddo +! +! cloud property is modified by the entrainment process +! +!> - Calculate the cloud properties as a parcel ascends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . Following Han and Pan (2006) \cite han_and_pan_2006, the convective momentum transport is reduced by the convection-induced pressure gradient force by the constant "pgcon", currently set to 0.55 after Zhang and Wu (2003) \cite zhang_and_wu_2003 . + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + ptem = 0.5 * tem + pgcon + ptem1= 0.5 * tem - pgcon + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + ucko(i,k) = ((1.-tem1)*ucko(i,k-1)+ptem*uo(i,k) + & +ptem1*uo(i,k-1))/factor + vcko(i,k) = ((1.-tem1)*vcko(i,k-1)+ptem*vo(i,k) + & +ptem1*vo(i,k-1))/factor + dbyo(i,k) = hcko(i,k) - heso(i,k) + endif + endif + enddo + enddo +! +! taking account into convection inhibition due to existence of +! dry layers below cloud base +! +!> - With entrainment, recalculate the LFC as the first level where buoyancy is positive. The difference in pressure levels between LFCs calculated with/without entrainment must be less than a threshold (currently 25 hPa). Otherwise, convection is inhibited and the scheme returns to the calling routine without modifying the state variables. This is the subcloud dryness trigger modification discussed in Han and Pan (2011) \cite han_and_pan_2011. + do i=1,im + flg(i) = cnvflg(i) + kbcon1(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kmax(i)) then + if(k.ge.kbcon(i).and.dbyo(i,k).gt.0.) then + kbcon1(i) = k + flg(i) = .false. + endif + endif + enddo + enddo + do i=1,im + if(cnvflg(i)) then + if(kbcon1(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo + do i=1,im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i)) - pfld(i,kbcon1(i)) + if(tem.gt.dthk) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine first guess cloud top as the level of zero buoyancy +! +!> - Calculate the cloud top as the first level where parcel buoyancy becomes negative. If the thickness of the calculated convection is less than a threshold (currently 150 hPa), then convection is inhibited, and the scheme returns to the calling routine. + do i = 1, im + flg(i) = cnvflg(i) + ktcon(i) = 1 + enddo + do k = 2, km1 + do i = 1, im + if (flg(i).and.k .lt. kmax(i)) then + if(k.gt.kbcon1(i).and.dbyo(i,k).lt.0.) then + ktcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! + do i = 1, im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i))-pfld(i,ktcon(i)) + if(tem.lt.cthk) cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! search for downdraft originating level above theta-e minimum +! +!> - To originate the downdraft, search for the level above the minimum in moist static energy. Return to the calling routine without modification if this level is determined to be outside of the convective cloud layers. + do i = 1, im + if(cnvflg(i)) then + hmin(i) = heo(i,kbcon1(i)) + lmin(i) = kbmax(i) + jmin(i) = kbmax(i) + endif + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i) .and. k .le. kbmax(i)) then + if(k.gt.kbcon1(i).and.heo(i,k).lt.hmin(i)) then + lmin(i) = k + 1 + hmin(i) = heo(i,k) + endif + endif + enddo + enddo +! +! make sure that jmin(i) is within the cloud +! + do i = 1, im + if(cnvflg(i)) then + jmin(i) = min(lmin(i),ktcon(i)-1) + jmin(i) = max(jmin(i),kbcon1(i)+1) + if(jmin(i).ge.ktcon(i)) cnvflg(i) = .false. + endif + enddo +! +! specify upper limit of mass flux at cloud base +! +!> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. + do i = 1, im + if(cnvflg(i)) then +! xmbmax(i) = .1 +! + k = kbcon(i) + dp = 1000. * del(i,k) + xmbmax(i) = dp / (g * dt2) +! +! tem = dp / (g * dt2) +! xmbmax(i) = min(tem, xmbmax(i)) + endif + enddo +! +! compute cloud moisture property and precipitation +! +!> - Initialize the cloud moisture at cloud base and set the cloud work function to zero. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = 0. + qcko(i,kb(i)) = qo(i,kb(i)) + qrcko(i,kb(i)) = qo(i,kb(i)) +! rhbar(i) = 0. + endif + enddo +!> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water (dellal). + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +! + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! +! check if there is excess moisture to release latent heat +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + dp = 1000. * del(i,k) + if(ncloud.gt.0..and.k.gt.jmin(i)) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + aa1(i) = aa1(i) - dz * g * qlk + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + pwavo(i) = pwavo(i) + pwo(i,k) +! cnvwt(i,k) = (etah*qlk + pwo(i,k)) * g / dp + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! do i = 1, im +! if(cnvflg(i)) then +! indx = ktcon(i) - kb(i) - 1 +! rhbar(i) = rhbar(i) / float(indx) +! endif +! enddo +! +! calculate cloud work function +! +!> - Calculate the cloud work function according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 4: +!! \f[ +!! A_u=\int_{z_0}^{z_t}\frac{g}{c_pT(z)}\frac{\eta}{1 + \gamma}[h(z)-h^*(z)]dz +!! \f] +!! (discretized according to Grell (1993) \cite grell_1993 equation B.10 using B.2 and B.3 of Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 and assuming \f$\eta=1\f$) where \f$A_u\f$ is the updraft cloud work function, \f$z_0\f$ and \f$z_t\f$ are cloud base and cloud top, respectively, \f$\gamma = \frac{L}{c_p}\left(\frac{\partial \overline{q_s}}{\partial T}\right)_p\f$ and other quantities are previously defined. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.kbcon(i).and.k.lt.ktcon(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + val = 0. + aa1(i)=aa1(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +!> - If the updraft cloud work function is negative, convection does not occur, and the scheme returns to the calling routine. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! estimate the onvective overshooting as the level +! where the [aafac * cloud work function] becomes zero, +! which is the final cloud top +! +!> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. + do i = 1, im + if (cnvflg(i)) then + aa2(i) = aafac * aa1(i) + endif + enddo +! + do i = 1, im + flg(i) = cnvflg(i) + ktcon1(i) = kmax(i) - 1 + enddo + do k = 2, km1 + do i = 1, im + if (flg(i)) then + if(k.ge.ktcon(i).and.k.lt.kmax(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa2(i) = aa2(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + if(aa2(i).lt.0.) then + ktcon1(i) = k + flg(i) = .false. + endif + endif + endif + enddo + enddo +! +! compute cloud moisture property, detraining cloud water +! and precipitation in overshooting layers +! +!> - For the overshooting convection, calculate the moisture content of the entraining/detraining parcel as before. Partition convective cloud water and precipitation and detrain convective cloud water above the mimimum in moist static energy. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.ktcon(i).and.k.lt.ktcon1(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +! + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + dp = 1000. * del(i,k) + if(ncloud.gt.0.) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + pwavo(i) = pwavo(i) + pwo(i,k) +! cnvwt(i,k) = (etah*qlk + pwo(i,k)) * g / dp + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! exchange ktcon with ktcon1 +! +!> - Swap the indices of the convective cloud top (ktcon) and the overshooting convection top (ktcon1) to use the same cloud top level in the calculations of \f$A^+\f$ and \f$A^*\f$. + do i = 1, im + if(cnvflg(i)) then + kk = ktcon(i) + ktcon(i) = ktcon1(i) + ktcon1(i) = kk + endif + enddo +! +! this section is ready for cloud water +! +!> - Separate the total updraft cloud water at cloud top into vapor and condensate. + if(ncloud.gt.0) then +! +! compute liquid and vapor separation at cloud top +! + do i = 1, im + if(cnvflg(i)) then + k = ktcon(i) - 1 + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) + dq = qcko(i,k) - qrch +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + qlko_ktcon(i) = dq + qcko(i,k) = qrch + endif + endif + enddo + endif +! +! if(lat.eq.latd.and.lon.eq.lond.and.cnvflg(i)) then +! print *, ' aa1(i) before dwndrft =', aa1(i) +! endif +! +!------- downdraft calculations +! +!--- compute precipitation efficiency in terms of windshear +! +!> ## Perform calculations related to the downdraft of the entraining/detraining cloud model ("static control"). +!! - First, in order to calculate the downdraft mass flux (as a fraction of the updraft mass flux), calculate the wind shear and precipitation efficiency according to equation 58 in Fritsch and Chappell (1980) \cite fritsch_and_chappell_1980 : +!! \f[ +!! E = 1.591 - 0.639\frac{\Delta V}{\Delta z} + 0.0953\left(\frac{\Delta V}{\Delta z}\right)^2 - 0.00496\left(\frac{\Delta V}{\Delta z}\right)^3 +!! \f] +!! where \f$\Delta V\f$ is the integrated horizontal shear over the cloud depth, \f$\Delta z\f$, (the ratio is converted to units of \f$10^{-3} s^{-1}\f$). The variable "edto" is \f$1-E\f$ and is constrained to the range \f$[0,0.9]\f$. + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 0. + endif + enddo + do k = 2, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + shear= sqrt((uo(i,k)-uo(i,k-1)) ** 2 + & + (vo(i,k)-vo(i,k-1)) ** 2) + vshear(i) = vshear(i) + shear + endif + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 1.e3 * vshear(i) / (zi(i,ktcon(i))-zi(i,kb(i))) + e1=1.591-.639*vshear(i) + & +.0953*(vshear(i)**2)-.00496*(vshear(i)**3) + edt(i)=1.-e1 + val = .9 + edt(i) = min(edt(i),val) + val = .0 + edt(i) = max(edt(i),val) + edto(i)=edt(i) + edtx(i)=edt(i) + endif + enddo +! +! determine detrainment rate between 1 and kbcon +! +!> - Next, calculate the variable detrainment rate between the surface and the LFC according to: +!! \f[ +!! \lambda_d = \frac{1-\beta^{\frac{1}{k_{LFC}}}}{\overline{\Delta z}} +!! \f] +!! \f$\lambda_d\f$ is the detrainment rate, \f$\beta\f$ is a constant currently set to 0.05, \f$k_{LFC}\f$ is the vertical index of the LFC level, and \f$\overline{\Delta z}\f$ is the average vertical grid spacing below the LFC. + do i = 1, im + if(cnvflg(i)) then + sumx(i) = 0. + endif + enddo + do k = 1, km1 + do i = 1, im + if(cnvflg(i).and.k.ge.1.and.k.lt.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + beta = betas + if(islimsk(i) == 1) beta = betal + if(cnvflg(i)) then + dz = (sumx(i)+zi(i,1))/float(kbcon(i)) + tem = 1./float(kbcon(i)) + xlamd(i) = (1.-beta**tem)/dz + endif + enddo +! +! determine downdraft mass flux +! +!> - Calculate the normalized downdraft mass flux from equation 1 of Pan and Wu (1995) \cite pan_and_wu_1995 . Downdraft entrainment and detrainment rates are constants from the downdraft origination to the LFC. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + if(k.lt.jmin(i).and.k.ge.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = xlamdd - xlamde + etad(i,k) = etad(i,k+1) * (1. - ptem * dz) + else if(k.lt.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = xlamd(i) + xlamdd - xlamde + etad(i,k) = etad(i,k+1) * (1. - ptem * dz) + endif + endif + enddo + enddo +! +!--- downdraft moisture properties +! +!> - Set initial cloud downdraft properties equal to the state variables at the downdraft origination level. + do i = 1, im + if(cnvflg(i)) then + jmn = jmin(i) + hcdo(i,jmn) = heo(i,jmn) + qcdo(i,jmn) = qo(i,jmn) + qrcdo(i,jmn)= qo(i,jmn) + ucdo(i,jmn) = uo(i,jmn) + vcdo(i,jmn) = vo(i,jmn) + pwevo(i) = 0. + endif + enddo +!j +!> - Calculate the cloud properties as a parcel descends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + ptem = 0.5 * tem - pgcon + ptem1= 0.5 * tem + pgcon + hcdo(i,k) = ((1.-tem1)*hcdo(i,k+1)+tem*0.5* + & (heo(i,k)+heo(i,k+1)))/factor + ucdo(i,k) = ((1.-tem1)*ucdo(i,k+1)+ptem*uo(i,k+1) + & +ptem1*uo(i,k))/factor + vcdo(i,k) = ((1.-tem1)*vcdo(i,k+1)+ptem*vo(i,k+1) + & +ptem1*vo(i,k))/factor + dbyo(i,k) = hcdo(i,k) - heso(i,k) + endif + enddo + enddo +! +!> - Compute the amount of moisture that is necessary to keep the downdraft saturated. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i).and.k.lt.jmin(i)) then + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrcdo(i,k) = qeso(i,k)+ + & (1./hvap)*(gamma/(1.+gamma))*dbyo(i,k) +! detad = etad(i,k+1) - etad(i,k) +! + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + qcdo(i,k) = ((1.-tem1)*qrcdo(i,k+1)+tem*0.5* + & (qo(i,k)+qo(i,k+1)))/factor +! +! pwdo(i,k) = etad(i,k+1) * qcdo(i,k+1) - +! & etad(i,k) * qrcdo(i,k) +! pwdo(i,k) = pwdo(i,k) - detad * +! & .5 * (qrcdo(i,k) + qrcdo(i,k+1)) +! + pwdo(i,k) = etad(i,k) * (qcdo(i,k) - qrcdo(i,k)) + pwevo(i) = pwevo(i) + pwdo(i,k) + endif + enddo + enddo +! +!--- final downdraft strength dependent on precip +!--- efficiency (edt), normalized condensate (pwav), and +!--- evaporate (pwev) +! +!> - Update the precipitation efficiency (edto) based on the ratio of normalized cloud condensate (pwavo) to normalized cloud evaporate (pwevo). + do i = 1, im + edtmax = edtmaxl + if(islimsk(i) == 0) edtmax = edtmaxs + if(cnvflg(i)) then + if(pwevo(i).lt.0.) then + edto(i) = -edto(i) * pwavo(i) / pwevo(i) + edto(i) = min(edto(i),edtmax) + else + edto(i) = 0. + endif + endif + enddo +! +!--- downdraft cloudwork functions +! +!> - Calculate downdraft cloud work function (\f$A_d\f$) according to equation A.42 (discretized by B.11) in Grell (1993) \cite grell_1993 . Add it to the updraft cloud work function, \f$A_u\f$. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .lt. jmin(i)) then + gamma = el2orc * qeso(i,k) / to(i,k)**2 + dhh=hcdo(i,k) + dt=to(i,k) + dg=gamma + dh=heso(i,k) + dz=-1.*(zo(i,k+1)-zo(i,k)) + aa1(i)=aa1(i)+edto(i)*dz*(g/(cp*dt))*((dhh-dh)/(1.+dg)) + & *(1.+delta*cp*dg*dt/hvap) + val=0. + aa1(i)=aa1(i)+edto(i)* + & dz*g*delta*max(val,(qeso(i,k)-qo(i,k))) + endif + enddo + enddo +!> - Check for negative total cloud work function; if found, return to calling routine without modifying state variables. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) then + cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!--- what would the change be, that a cloud with unit mass +!--- will do to the environment? +! +!> - Calculate the change in moist static energy, moisture mixing ratio, and horizontal winds per unit cloud base mass flux near the surface using equations B.18 and B.19 from Grell (1993) \cite grell_1993, for all layers below cloud top from equations B.14 and B.15, and for the cloud top from B.16 and B.17. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + dellah(i,k) = 0. + dellaq(i,k) = 0. + dellau(i,k) = 0. + dellav(i,k) = 0. + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + dp = 1000. * del(i,1) + dellah(i,1) = edto(i) * etad(i,1) * (hcdo(i,1) + & - heo(i,1)) * g / dp + dellaq(i,1) = edto(i) * etad(i,1) * (qrcdo(i,1) + & - qo(i,1)) * g / dp + dellau(i,1) = edto(i) * etad(i,1) * (ucdo(i,1) + & - uo(i,1)) * g / dp + dellav(i,1) = edto(i) * etad(i,1) * (vcdo(i,1) + & - vo(i,1)) * g / dp + endif + enddo +! +!--- changed due to subsidence and entrainment +! + do k = 2, km1 + do i = 1, im + if (cnvflg(i).and.k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.gt.jmin(i)) adw = 0. + dp = 1000. * del(i,k) + dz = zi(i,k) - zi(i,k-1) +! + dv1h = heo(i,k) + dv2h = .5 * (heo(i,k) + heo(i,k-1)) + dv3h = heo(i,k-1) + dv1q = qo(i,k) + dv2q = .5 * (qo(i,k) + qo(i,k-1)) + dv3q = qo(i,k-1) + dv1u = uo(i,k) + dv2u = .5 * (uo(i,k) + uo(i,k-1)) + dv3u = uo(i,k-1) + dv1v = vo(i,k) + dv2v = .5 * (vo(i,k) + vo(i,k-1)) + dv3v = vo(i,k-1) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) + tem1 = xlamud(i) +! + if(k.le.kbcon(i)) then + ptem = xlamde + ptem1 = xlamd(i)+xlamdd + else + ptem = xlamde + ptem1 = xlamdd + endif +! + dellah(i,k) = dellah(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1h + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3h + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2h*dz + & + aup*tem1*eta(i,k-1)*.5*(hcko(i,k)+hcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(hcdo(i,k)+hcdo(i,k-1))*dz + & ) *g/dp +! + dellaq(i,k) = dellaq(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1q + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3q + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2q*dz + & + aup*tem1*eta(i,k-1)*.5*(qrcko(i,k)+qcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(qrcdo(i,k)+qcdo(i,k-1))*dz + & ) *g/dp +! + dellau(i,k) = dellau(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1u + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3u + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2u*dz + & + aup*tem1*eta(i,k-1)*.5*(ucko(i,k)+ucko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(ucdo(i,k)+ucdo(i,k-1))*dz + & - pgcon*(aup*eta(i,k-1)-adw*edto(i)*etad(i,k))*(dv1u-dv3u) + & ) *g/dp +! + dellav(i,k) = dellav(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1v + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3v + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2v*dz + & + aup*tem1*eta(i,k-1)*.5*(vcko(i,k)+vcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(vcdo(i,k)+vcdo(i,k-1))*dz + & - pgcon*(aup*eta(i,k-1)-adw*edto(i)*etad(i,k))*(dv1v-dv3v) + & ) *g/dp +! + endif + enddo + enddo +! +!------- cloud top +! + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) + dp = 1000. * del(i,indx) + dv1h = heo(i,indx-1) + dellah(i,indx) = eta(i,indx-1) * + & (hcko(i,indx-1) - dv1h) * g / dp + dv1q = qo(i,indx-1) + dellaq(i,indx) = eta(i,indx-1) * + & (qcko(i,indx-1) - dv1q) * g / dp + dv1u = uo(i,indx-1) + dellau(i,indx) = eta(i,indx-1) * + & (ucko(i,indx-1) - dv1u) * g / dp + dv1v = vo(i,indx-1) + dellav(i,indx) = eta(i,indx-1) * + & (vcko(i,indx-1) - dv1v) * g / dp +! +! cloud water +! + dellal(i,indx) = eta(i,indx-1) * + & qlko_ktcon(i) * g / dp + endif + enddo +! +!------- final changed variable per unit mass flux +! +!> - Calculate the change in the temperature and moisture profiles per unit cloud base mass flux. + do k = 1, km + do i = 1, im + if (cnvflg(i).and.k .le. kmax(i)) then + if(k.gt.ktcon(i)) then + qo(i,k) = q1(i,k) + to(i,k) = t1(i,k) + endif + if(k.le.ktcon(i)) then + qo(i,k) = dellaq(i,k) * mbdt + q1(i,k) + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + to(i,k) = dellat * mbdt + t1(i,k) + val = 1.e-10 + qo(i,k) = max(qo(i,k), val ) + endif + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!--- the above changed environment is now used to calulate the +!--- effect the arbitrary cloud (with unit mass flux) +!--- would have on the stability, +!--- which then is used to calculate the real mass flux, +!--- necessary to keep this change in balance with the large-scale +!--- destabilization. +! +!--- environmental conditions again, first heights +! +!> ## Using the updated temperature and moisture profiles that were modified by the convection on a short time-scale, recalculate the total cloud work function to determine the change in the cloud work function due to convection, or the stabilizing effect of the cumulus. +!! - Using notation from Pan and Wu (1995) \cite pan_and_wu_1995, the previously calculated cloud work function is denoted by \f$A^+\f$. Now, it is necessary to use the entraining/detraining cloud model ("static control") to determine the cloud work function of the environment after the stabilization of the arbitrary convective element (per unit cloud base mass flux) has been applied, denoted by \f$A^*\f$. +!! - Recalculate saturation specific humidity. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k)+epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +!--- moist static energy +! +!! - Recalculate moist static energy and saturation moist static energy. + do k = 1, km1 + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo + do k = 1, km1 + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1 * qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + k = kmax(i) + heo(i,k) = g * zo(i,k) + cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = g * zo(i,k) + cp * to(i,k) + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo +! +!**************************** static control +! +!------- moisture and cloud work functions +! +!> - As before, recalculate the updraft cloud work function. + do i = 1, im + if(cnvflg(i)) then + xaa0(i) = 0. + xpwav(i) = 0. + endif + enddo +! + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + qcko(i,indx) = qo(i,indx) + endif + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + endif + endif + enddo + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + xdby = hcko(i,k) - heso(i,k) + xqrch = qeso(i,k) + & + gamma * xdby / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor +! + dq = eta(i,k) * (qcko(i,k) - xqrch) +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0..and.k.gt.jmin(i)) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + if(k.lt.ktcon1(i)) then + xaa0(i) = xaa0(i) - dz * g * qlk + endif + qcko(i,k) = qlk + xqrch + xpw = etah * c0 * dz * qlk + xpwav(i) = xpwav(i) + xpw + endif + endif + if(k.ge.kbcon(i).and.k.lt.ktcon1(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + xaa0(i) = xaa0(i) + & + dz1 * (g / (cp * to(i,k))) + & * xdby / (1. + gamma) + & * rfact + val=0. + xaa0(i)=xaa0(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +! +!------- downdraft calculations +! +!--- downdraft moisture properties +! +!> - As before, recalculate the downdraft cloud work function. + do i = 1, im + if(cnvflg(i)) then + jmn = jmin(i) + hcdo(i,jmn) = heo(i,jmn) + qcdo(i,jmn) = qo(i,jmn) + qrcd(i,jmn) = qo(i,jmn) + xpwev(i) = 0. + endif + enddo +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + hcdo(i,k) = ((1.-tem1)*hcdo(i,k+1)+tem*0.5* + & (heo(i,k)+heo(i,k+1)))/factor + endif + enddo + enddo +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .lt. jmin(i)) then + dq = qeso(i,k) + dt = to(i,k) + gamma = el2orc * dq / dt**2 + dh = hcdo(i,k) - heso(i,k) + qrcd(i,k)=dq+(1./hvap)*(gamma/(1.+gamma))*dh +! detad = etad(i,k+1) - etad(i,k) +! + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + qcdo(i,k) = ((1.-tem1)*qrcd(i,k+1)+tem*0.5* + & (qo(i,k)+qo(i,k+1)))/factor +! +! xpwd = etad(i,k+1) * qcdo(i,k+1) - +! & etad(i,k) * qrcd(i,k) +! xpwd = xpwd - detad * +! & .5 * (qrcd(i,k) + qrcd(i,k+1)) +! + xpwd = etad(i,k) * (qcdo(i,k) - qrcd(i,k)) + xpwev(i) = xpwev(i) + xpwd + endif + enddo + enddo +! + do i = 1, im + edtmax = edtmaxl + if(islimsk(i) == 0) edtmax = edtmaxs + if(cnvflg(i)) then + if(xpwev(i).ge.0.) then + edtx(i) = 0. + else + edtx(i) = -edtx(i) * xpwav(i) / xpwev(i) + edtx(i) = min(edtx(i),edtmax) + endif + endif + enddo +! +! +!--- downdraft cloudwork functions +! +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + gamma = el2orc * qeso(i,k) / to(i,k)**2 + dhh=hcdo(i,k) + dt= to(i,k) + dg= gamma + dh= heso(i,k) + dz=-1.*(zo(i,k+1)-zo(i,k)) + xaa0(i)=xaa0(i)+edtx(i)*dz*(g/(cp*dt))*((dhh-dh)/(1.+dg)) + & *(1.+delta*cp*dg*dt/hvap) + val=0. + xaa0(i)=xaa0(i)+edtx(i)* + & dz*g*delta*max(val,(qeso(i,k)-qo(i,k))) + endif + enddo + enddo +! +! calculate critical cloud work function +! +!> ## For the "dynamic control", using a reference cloud work function, estimate the change in cloud work function due to the large-scale dynamics. Following the quasi-equilibrium assumption, calculate the cloud base mass flux required to keep the large-scale convective destabilization in balance with the stabilization effect of the convection. +!! - Calculate the reference, or "critical", cloud work function derived from observations, denoted by \f$A^0\f$. + do i = 1, im + if(cnvflg(i)) then + if(pfld(i,ktcon(i)).lt.pcrit(15))then + acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) + & /(975.-pcrit(15)) + else if(pfld(i,ktcon(i)).gt.pcrit(1))then + acrt(i)=acrit(1) + else + k = int((850. - pfld(i,ktcon(i)))/50.) + 2 + k = min(k,15) + k = max(k,2) + acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* + & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) + endif + endif + enddo +!> - Calculate a correction factor, "acrtfct", that is a function of the cloud base vertical velocity, to multiply the critical cloud work function. + do i = 1, im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif +! +! modify critical cloud workfunction by cloud base vertical velocity +! + if(pdot(i).le.w4) then + acrtfct(i) = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) + else + acrtfct(i) = 0. + endif + val1 = -1. + acrtfct(i) = max(acrtfct(i),val1) + val2 = 1. + acrtfct(i) = min(acrtfct(i),val2) + acrtfct(i) = 1. - acrtfct(i) +! +! modify acrtfct(i) by colume mean rh if rhbar(i) is greater than 80 percent +! +! if(rhbar(i).ge..8) then +! acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. +! endif +! +! modify adjustment time scale by cloud base vertical velocity +! +!> - Also, modify the time scale over which the large-scale destabilization takes place (dtconv) according to the cloud base vertical velocity, ensuring that this timescale stays between previously calculated minimum and maximum values. + dtconv(i) = dt2 + max((1800. - dt2),0.) * + & (pdot(i) - w2) / (w1 - w2) +! dtconv(i) = max(dtconv(i), dt2) +! dtconv(i) = 1800. * (pdot(i) - w2) / (w1 - w2) + dtconv(i) = max(dtconv(i),dtmin) + dtconv(i) = min(dtconv(i),dtmax) +! + endif + enddo +! +!--- large scale forcing +! +!> - Calculate the large scale destabilization as in equation 5 of Pan and Wu (1995) \cite pan_and_wu_1995 : +!! \f[ +!! \frac{\partial A}{\partial t}_{LS}=\frac{A^+-cA^0}{\Delta t_{LS}} +!! \f] +!! where \f$c\f$ is the correction factor "acrtfct", \f$\Delta t_{LS}\f$ is the modified timescale over which the environment is destabilized, and the other quantities have been previously defined. + do i= 1, im + if(cnvflg(i)) then + fld(i)=(aa1(i)-acrt(i)* acrtfct(i))/dtconv(i) + if(fld(i).le.0.) cnvflg(i) = .false. + endif +!> - Calculate the stabilization effect of the convection (per unit cloud base mass flux) as in equation 6 of Pan and Wu (1995) \cite pan_and_wu_1995 : +!! \f[ +!! \frac{\partial A}{\partial t}_{cu}=\frac{A^*-A^+}{\Delta t_{cu}} +!! \f] +!! \f$\Delta t_{cu}\f$ is the short timescale of the convection. + if(cnvflg(i)) then +! xaa0(i) = max(xaa0(i),0.) + xk(i) = (xaa0(i) - aa1(i)) / mbdt + if(xk(i).ge.0.) cnvflg(i) = .false. + endif +! +!--- kernel, cloud base mass flux +! +!> - The cloud base mass flux (xmb) is then calculated from equation 7 of Pan and Wu (1995) \cite pan_and_wu_1995 +!! \f[ +!! M_c=\frac{-\frac{\partial A}{\partial t}_{LS}}{\frac{\partial A}{\partial t}_{cu}} +!! \f] + if(cnvflg(i)) then + xmb(i) = -fld(i) / xk(i) + xmb(i) = min(xmb(i),xmbmax(i)) + endif + enddo +!! +!> - If the large scale destabilization is less than zero, or the stabilization by the convection is greater than zero, then the scheme returns to the calling routine without modifying the state variables. + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! restore to,qo,uo,vo to t1,q1,u1,v1 in case convection stops +! + + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!--- feedback: simply the changes from the cloud with unit mass flux +!--- multiplied by the mass flux necessary to keep the +!--- equilibrium with the larger-scale. +! +!> ## For the "feedback" control, calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!> - Calculate the temperature tendency from the moist static energy and specific humidity tendencies. +!> - Update the temperature, specific humidity, and horiztonal wind state variables by multiplying the cloud base mass flux-normalized tendencies by the cloud base mass flux. +!> - Accumulate column-integrated tendencies. + do i = 1, im + delhbar(i) = 0. + delqbar(i) = 0. + deltbar(i) = 0. + delubar(i) = 0. + delvbar(i) = 0. + qcond(i) = 0. + enddo + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.le.ktcon(i)) then + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 + q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 +! tem = 1./rcs(i) +! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem +! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem + u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 + v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 + dp = 1000. * del(i,k) + delhbar(i) = delhbar(i) + dellah(i,k)*xmb(i)*dp/g + delqbar(i) = delqbar(i) + dellaq(i,k)*xmb(i)*dp/g + deltbar(i) = deltbar(i) + dellat*xmb(i)*dp/g + delubar(i) = delubar(i) + dellau(i,k)*xmb(i)*dp/g + delvbar(i) = delvbar(i) + dellav(i,k)*xmb(i)*dp/g + endif + endif + enddo + enddo +!> - Recalculate saturation specific humidity using the updated temperature. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.le.ktcon(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + endif + enddo + enddo +! +!> - Add up column-integrated convective precipitation by multiplying the normalized value by the cloud base mass flux. + do i = 1, im + rntot(i) = 0. + delqev(i) = 0. + delq2(i) = 0. + flg(i) = cnvflg(i) + enddo + do k = km, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.ge.jmin(i)) adw = 0. + rain = aup * pwo(i,k) + adw * edto(i) * pwdo(i,k) + rntot(i) = rntot(i) + rain * xmb(i) * .001 * dt2 + endif + endif + enddo + enddo +!> - Determine the evaporation of the convective precipitation and update the integrated convective precipitation. +!> - Update state temperature and moisture to account for evaporation of convective precipitation. +!> - Update column-integrated tendencies to account for evaporation of convective precipitation. + do k = km, 1, -1 + do i = 1, im + if (k .le. kmax(i)) then + deltv(i) = 0. + delq(i) = 0. + qevap(i) = 0. + if(cnvflg(i).and.k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.ge.jmin(i)) adw = 0. + rain = aup * pwo(i,k) + adw * edto(i) * pwdo(i,k) + rn(i) = rn(i) + rain * xmb(i) * .001 * dt2 + endif + if(flg(i).and.k.lt.ktcon(i)) then + evef = edt(i) * evfact + if(islimsk(i) == 1) evef=edt(i) * evfactl +! if(islimsk(i) == 1) evef=.07 +! if(islimsk(i) == 1) evef = 0. + qcond(i) = evef * (q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + dp = 1000. * del(i,k) + if(rn(i).gt.0..and.qcond(i).lt.0.) then + qevap(i) = -qcond(i) * (1.-exp(-.32*sqrt(dt2*rn(i)))) + qevap(i) = min(qevap(i), rn(i)*1000.*g/dp) + delq2(i) = delqev(i) + .001 * qevap(i) * dp / g + endif + if(rn(i).gt.0..and.qcond(i).lt.0..and. + & delq2(i).gt.rntot(i)) then + qevap(i) = 1000.* g * (rntot(i) - delqev(i)) / dp + flg(i) = .false. + endif + if(rn(i).gt.0..and.qevap(i).gt.0.) then + q1(i,k) = q1(i,k) + qevap(i) + t1(i,k) = t1(i,k) - elocp * qevap(i) + rn(i) = rn(i) - .001 * qevap(i) * dp / g + deltv(i) = - elocp*qevap(i)/dt2 + delq(i) = + qevap(i)/dt2 + delqev(i) = delqev(i) + .001*dp*qevap(i)/g + endif + dellaq(i,k) = dellaq(i,k) + delq(i) / xmb(i) + delqbar(i) = delqbar(i) + delq(i)*dp/g + deltbar(i) = deltbar(i) + deltv(i)*dp/g + endif + endif + enddo + enddo +! +! do i = 1, im +! if(me.eq.31.and.cnvflg(i)) then +! if(cnvflg(i)) then +! print *, ' deep delhbar, delqbar, deltbar = ', +! & delhbar(i),hvap*delqbar(i),cp*deltbar(i) +! print *, ' deep delubar, delvbar = ',delubar(i),delvbar(i) +! print *, ' precip =', hvap*rn(i)*1000./dt2 +! print*,'pdif= ',pfld(i,kbcon(i))-pfld(i,ktcon(i)) +! endif +! enddo +! +! precipitation rate converted to actual precip +! in unit of m instead of kg +! + do i = 1, im + if(cnvflg(i)) then +! +! in the event of upper level rain evaporation and lower level downdraft +! moistening, rn can become negative, in this case, we back out of the +! heating and the moistening +! + + if(rn(i).lt.0..and..not.flg(i)) rn(i) = 0. + if(rn(i).le.0.) then + rn(i) = 0. + else + ktop(i) = ktcon(i) + kbot(i) = kbcon(i) + kcnv(i) = 1 + cldwrk(i) = aa1(i) + endif + endif + enddo +! +! convective cloud water +! +!> - Calculate convective cloud water. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +! +! convective cloud cover +! +!> - Calculate convective cloud cover. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvc(i,k) = 0.04 * log(1. + 675. * eta(i,k) * xmb(i)) + cnvc(i,k) = min(cnvc(i,k), 0.6) + cnvc(i,k) = max(cnvc(i,k), 0.0) + endif + endif + enddo + enddo + +! +! cloud water +! +!> - Separate detrained cloud water into liquid and ice species as a function of temperature only. + if (ncloud.gt.0) then +! + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.gt.kb(i).and.k.le.ktcon(i)) then + tem = dellal(i,k) * xmb(i) * dt2 + tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) + if (qlc(i,k) .gt. -999.0) then + qli(i,k) = qli(i,k) + tem * tem1 ! ice + qlc(i,k) = qlc(i,k) + tem *(1.0-tem1) ! water + else + qli(i,k) = qli(i,k) + tem + endif + endif + endif + enddo + enddo +! + endif +! +!> - If convective precipitation is zero or negative, reset the updated state variables back to their original values (negating convective changes). + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).le.0.) then + if (k .le. kmax(i)) then + t1(i,k) = to(i,k) + q1(i,k) = qo(i,k) + u1(i,k) = uo(i,k) + v1(i,k) = vo(i,k) + endif + endif + enddo + enddo +! +! hchuang code change +! +!> - Calculate the updraft convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + if(k.ge.kb(i) .and. k.lt.ktop(i)) then + ud_mf(i,k) = eta(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +!> - Calculate the detrainment mass flux at cloud top. + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + k = ktop(i)-1 + dt_mf(i,k) = ud_mf(i,k) + endif + enddo +!> - Calculate the downdraft convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + if(k.ge.1 .and. k.le.jmin(i)) then + dd_mf(i,k) = edto(i) * etad(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo + + if(mp_phys == mp_phys_mg) then + do k=1,km + do i=1,im + qlcn(i,k) = qlc(i,k) + qicn(i,k) = qli(i,k) + cf_upi(i,k) = cnvc(i,k) + w_upi(i,k) = ud_mf(i,k)*t1(i,k)*rgas / + & (dt2*max(cf_upi(i,k),1.e-12)*prslp(i,k)) + cnv_mfd(i,k) = ud_mf(i,k)/dt2 + clcn(i,k) = cnvc(i,k) + cnv_fice(i,k) = qicn(i,k) + & / max(1.e-10,qlcn(i,k)+qicn(i,k)) + enddo + enddo + endif + +!! + return +!> @} +!! @} + end subroutine sascnvn_run + + end module sascnvn +! \section original Original Documentation +! Penetrative convection is simulated following Pan and Wu (1994), which is based on Arakawa and Schubert(1974) as simplified by Grell (1993) and with a saturated downdraft. Convection occurs when the cloud work function (CWF) exceeds a certain threshold. Mass flux of the cloud is determined using a quasi-equilibrium assumption based on this threshold CWF. The CWF is a function of temperature and moisture in each air column of the model gridpoint. The temperature and moisture profiles are adjusted towards the equilibrium CWF within a specified time scale using the deduced mass flux. A major simplification of the original Arakawa-Shubert scheme is to consider only the deepest cloud and not the spectrum of clouds. The cloud model incorporates a downdraft mechanism as well as the evaporation of precipitation. Entrainment of the updraft and detrainment of the downdraft in the sub-cloud layers are included. Downdraft strength is based on the vertical wind shear through the cloud. The critical CWF is a function of the cloud base vertical motion. As the large-scale rising motion becomes strong, the CWF [similar to convective available potential energy (CAPE)] is allowed to approach zero (therefore approaching neutral stability). +! +! Mass fluxes induced in the updraft and the downdraft are allowed to transport momentum. The momentum exchange is calculated through the mass flux formulation in a manner similar to that for heat and moisture. The effect of the convection-induced pressure gradient force on cumulus momentum transport is parameterized in terms of mass flux and vertical wind shear (Han and Pan, 2006). As a result, the cumulus momentum exchange is reduced by about 55 % compared to the full exchange. +! +! The entrainment rate in cloud layers is dependent upon environmental humidity (Han and Pan, 2010). A drier environment increases the entrainment, suppressing the convection. The entrainment rate in sub-cloud layers is given as inversely proportional to height. The detrainment rate is assumed to be a constant in all layers and equal to the entrainment rate value at cloud base, which is O(10-4). The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water with conversion parameter of 0.002 m-1, which is same as the rain conversion parameter. +! +! Following Han and Pan (2010), the trigger condition is that a parcel lifted from the convection starting level without entrainment must reach its level of free convection within 120-180 hPa of ascent, proportional to the large-scale vertical velocity. This is intended to produce more convection in large-scale convergent regions but less convection in large-scale subsidence regions. Another important trigger mechanism is to include the effect of environmental humidity in the sub-cloud layer, taking into account convection inhibition due to existence of dry layers below cloud base. On the other hand, the cloud parcel might overshoot beyond the level of neutral buoyancy due to its inertia, eventually stopping its overshoot at cloud top. The CWF is used to model the overshoot. The overshoot of the cloud top is stopped at the height where a parcel lifted from the neutral buoyancy level with energy equal to 10% of the CWF would first have zero energy. +! +! Deep convection parameterization (SAS) modifications include: +! - Detraining cloud water from every updraft layer +! - Starting convection from the level of maximum moist static energy within PBL +! - Random cloud top is eliminated and only deepest cloud is considered +! - Cloud water is detrained from every cloud layer +! - Finite entrainment and detrainment rates for heat, moisture, and momentum are specified +! - Similar to shallow convection scheme, +! - entrainment rate is given to be inversely proportional to height in sub-cloud layers +! - detrainment rate is set to be a constant as entrainment rate at the cloud base. +! -Above cloud base, an organized entrainment is added, which is a function of environmental relative humidity diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta new file mode 100644 index 000000000..48c56d4b9 --- /dev/null +++ b/physics/sascnvn.meta @@ -0,0 +1,583 @@ +[ccpp-arg-table] + name = sascnvn_init + type = scheme +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_sas] + standard_name = flag_for_sas_deep_convection_scheme + long_name = flag for SAS deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sascnvn_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sascnvn_run + type = scheme +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rgas] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal_dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[jcap] + standard_name = number_of_spectral_wave_trancation_for_sas + long_name = number of spectral wave trancation used only by sascnv and sascnvn + units = count + dimensions = () + type = integer + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qlc] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qli] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cldwrk] + standard_name = cloud_work_function + long_name = cloud work function + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[rn] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[clam] + standard_name = entrainment_rate_coefficient_deep_convection + long_name = entrainment rate coefficient for deep convection + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0] + standard_name = rain_conversion_parameter_deep_convection + long_name = convective rain conversion parameter for deep convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_deep_convection + long_name = convective detrainment conversion parameter for deep convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betal] + standard_name = downdraft_fraction_reaching_surface_over_land_deep_convection + long_name = downdraft fraction reaching surface over land for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betas] + standard_name = downdraft_fraction_reaching_surface_over_ocean_deep_convection + long_name = downdraft fraction reaching surface over ocean for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfact] + standard_name = rain_evaporation_coefficient_deep_convection + long_name = convective rain evaporation coefficient for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfactl] + standard_name = rain_evaporation_coefficient_over_land_deep_convection + long_name = convective rain evaporation coefficient over land for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_deep_convection + long_name = reduction factor in momentum transport due to deep convection induced pressure gradient force + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 4b308dd55..5900349e9 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -4,9 +4,30 @@ !! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). module satmedmfvdif + contains - subroutine satmedmfvdif_init () +!> \section arg_table_satmedmfvdif_init Argument Table +!! \htmlinclude satmedmfvdif_init.html +!! + subroutine satmedmfvdif_init (isatmedmf,isatmedmf_vdif, + & errmsg,errflg) + + integer, intent(in) :: isatmedmf,isatmedmf_vdif + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. isatmedmf==isatmedmf_vdif) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', + & 'called, but isatmedmf/=isatmedmf_vdif.' + errflg = 1 + return + end if + end subroutine satmedmfvdif_init subroutine satmedmfvdif_finalize () @@ -1485,68 +1506,5 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & return end subroutine satmedmfvdif_run !> @} -! -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- -!>\ingroup satmedmf -!! This subroutine solves tridiagonal problem for TKE. - subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) -!----------------------------------------------------------------------- -!! - use machine , only : kind_phys - implicit none - integer is,k,kk,n,nt,l,i - real(kind=kind_phys) fk(l) -!! - real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & - & rt(l,n*nt), & - & au(l,n-1), at(l,n*nt), & - & fkk(l,2:n-1) -!----------------------------------------------------------------------- - do i=1,l - fk(i) = 1./cm(i,1) - au(i,1) = fk(i)*cu(i,1) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - at(i,1+is) = fk(i) * rt(i,1+is) - enddo - enddo - do k=2,n-1 - do i=1,l - fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) - au(i,k) = fkk(i,k)*cu(i,k) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=2,n-1 - do i=1,l - at(i,k+is) = fkk(i,k)*(rt(i,k+is)-cl(i,k)*at(i,k+is-1)) - enddo - enddo - enddo - do i=1,l - fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - at(i,n+is) = fk(i)*(rt(i,n+is)-cl(i,n)*at(i,n+is-1)) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=n-1,1,-1 - do i=1,l - at(i,k+is) = at(i,k+is) - au(i,k)*at(i,k+is+1) - enddo - enddo - enddo -!----------------------------------------------------------------------- - return - end subroutine tridit -!> @} end module satmedmfvdif diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 7f21e58e1..63480e01b 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -1,3 +1,41 @@ +[ccpp-arg-table] + name = satmedmfvdif_init + type = scheme +[isatmedmf] + standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[isatmedmf_vdif] + standard_name = choice_of_original_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of original scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +##################################################################### [ccpp-arg-table] name = satmedmfvdif_run type = scheme diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F new file mode 100644 index 000000000..c3d061a9c --- /dev/null +++ b/physics/satmedmfvdifq.F @@ -0,0 +1,1416 @@ +!> \file satmedmfvdifq.F +!! This file contains the CCPP-compliant SATMEDMF scheme (updated version) which +!! computes subgrid vertical turbulence mixing using scale-aware TKE-based moist +!! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). + + module satmedmfvdifq + + contains + +!> \section arg_table_satmedmfvdifq_init Argument Table +!! \htmlinclude satmedmfvdifq_init.html +!! + subroutine satmedmfvdifq_init (isatmedmf,isatmedmf_vdifq, + & errmsg,errflg) + + integer, intent(in) :: isatmedmf,isatmedmf_vdifq + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. isatmedmf==isatmedmf_vdifq) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', + & 'called, but isatmedmf/=isatmedmf_vdifq.' + errflg = 1 + return + end if + + end subroutine satmedmfvdifq_init + + subroutine satmedmfvdifq_finalize () + end subroutine satmedmfvdifq_finalize + +!> \defgroup satmedmfq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module +!! @{ +!! \brief This subroutine contains all of the logic for the +!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, updated version) scheme. +!! +!> \section arg_table_satmedmfvdifq_run Argument Table +!! \htmlinclude satmedmfvdifq_run.html +!! +!!\section gen_satmedmfvdif GFS satmedmfvdif General Algorithm +!! satmedmfvdif_run() computes subgrid vertical turbulence mixing +!! using the scale-aware TKE-based moist eddy-diffusion mass-flux (EDMF) parameterization of +!! Han and Bretherton (2019) \cite Han_2019 . +!! -# The local turbulent mixing is represented by an eddy-diffusivity scheme which +!! is a function of a prognostic TKE. +!! -# For the convective boundary layer, nonlocal transport by large eddies +!! (mfpblt.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). +!! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence +!! (mfscu.f). +!! For local turbulence mixing, a TKE closure model is used. +!! Updated version of satmedmfvdif.f (May 2019) to have better low level +!! inversion, to reduce the cold bias in lower troposphere, +!! and to reduce the negative wind speed bias in upper troposphere +!! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm +!> @{ + subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & + & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & + & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & + & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & tsea,heat,evap,stress,spd1,kpbl, & + & prsi,del,prsl,prslk,phii,phil,delt, & + & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & + & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & + & errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! + implicit none +! +!---------------------------------------------------------------------- + integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke + integer, intent(in) :: kinver(im) + integer, intent(out) :: kpbl(im) +! + real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & + & eps,epsm1 + real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: dspfac, bl_upfr, bl_dnfr + real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & + & tdt(im,km), rtg(im,km,ntrac) + real(kind=kind_phys), intent(in) :: & + & u1(ix,km), v1(ix,km), & + & t1(ix,km), q1(ix,km,ntrac), & + & swh(ix,km), hlw(ix,km), & + & xmu(im), garea(im), & + & psk(ix), rbsoil(im), & + & zorl(im), tsea(im), & + & u10m(im), v10m(im), & + & fm(im), fh(im), & + & evap(im), heat(im), & + & stress(im), spd1(im), & + & prsi(ix,km+1), del(ix,km), & + & prsl(ix,km), prslk(ix,km), & + & phii(ix,km+1), phil(ix,km) + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im), & + & dtsfc(im), dqsfc(im), & + & hpbl(im) +! + logical, intent(in) :: dspheat + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! flag for tke dissipative heating +! +!---------------------------------------------------------------------- +!*** +!*** local variables +!*** + integer i,is,k,kk,n,ndt,km1,kmpbl,kmscu,ntrac1 + integer lcld(im),kcld(im),krad(im),mrad(im) + integer kx1(im), kpblx(im) +! + real(kind=kind_phys) tke(im,km), tkeh(im,km-1) +! + real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), + & qlx(im,km), thetae(im,km),thlx(im,km), + & slx(im,km), svx(im,km), qtx(im,km), + & tvx(im,km), pix(im,km), radx(im,km-1), + & dku(im,km-1),dkt(im,km-1), dkq(im,km-1), + & cku(im,km-1),ckt(im,km-1) +! + real(kind=kind_phys) plyr(im,km), rhly(im,km), cfly(im,km), + & qstl(im,km) +! + real(kind=kind_phys) dtdz1(im), gdx(im), + & phih(im), phim(im), prn(im,km-1), + & rbdn(im), rbup(im), thermal(im), + & ustar(im), wstar(im), hpblx(im), + & ust3(im), wst3(im), + & z0(im), crb(im), + & hgamt(im), hgamq(im), + & wscale(im),vpert(im), + & zol(im), sflux(im), + & tx1(im), tx2(im) +! + real(kind=kind_phys) radmin(im) +! + real(kind=kind_phys) zi(im,km+1), zl(im,km), zm(im,km), + & xkzo(im,km-1),xkzmo(im,km-1), + & xkzm_hx(im), xkzm_mx(im), tkmnz(im,km-1), + & rdzt(im,km-1),rlmnz(im,km), + & al(im,km-1), ad(im,km), au(im,km-1), + & f1(im,km), f2(im,km*(ntrac-1)) +! + real(kind=kind_phys) elm(im,km), ele(im,km), + & ckz(im,km), chz(im,km), frik(im), + & diss(im,km-1),prod(im,km-1), + & bf(im,km-1), shr2(im,km-1), + & xlamue(im,km-1), xlamde(im,km-1), + & gotvx(im,km), rlam(im,km-1) +! +! variables for updrafts (thermals) +! + real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), + & ucko(im,km), vcko(im,km), + & buou(im,km), xmf(im,km) +! +! variables for stratocumulus-top induced downdrafts +! + real(kind=kind_phys) tcdo(im,km), qcdo(im,km,ntrac), + & ucdo(im,km), vcdo(im,km), + & buod(im,km), xmfd(im,km) +! + logical pblflg(im), sfcflg(im), flg(im) + logical scuflg(im), pcnvflg(im) + logical mlenflg +! +! pcnvflg: true for unstable pbl +! + real(kind=kind_phys) aphi16, aphi5, + & wfac, cfac, + & gamcrt, gamcrq, sfcfrac, + & conq, cont, conw, + & dsdz2, dsdzt, dkmax, + & dsig, dt2, dtodsd, + & dtodsu, g, factor, dz, + & gocp, gravi, zol1, zolcru, + & buop, shrp, dtn, + & prnum, prmax, prmin, prtke, + & prscu, pr0, ri, + & dw2, dw2min, zk, + & elmfac, elefac, dspmax, + & alp, clwt, cql, + & f0, robn, crbmin, crbmax, + & es, qs, value, onemrh, + & cfh, gamma, elocp, el2orc, + & epsi, beta, chx, cqx, + & rdt, rdz, qmin, qlmin, + & rimin, rbcr, rbint, tdzmin, + & rlmn, rlmn1, rlmx, elmx, + & ttend, utend, vtend, qtend, + & zfac, zfmin, vk, spdk2, + & tkmin, xkzinv, xkgdx, + & zlup, zldn, bsum, + & tem, tem1, tem2, + & ptem, ptem0, ptem1, ptem2 +! + real(kind=kind_phys) ck0, ck1, ch0, ch1, ce0, rchck +! + real(kind=kind_phys) qlcr, zstblmax +! + real(kind=kind_phys) h1 +!! + parameter(wfac=7.0,cfac=3.0) + parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) + parameter(vk=0.4,rimin=-100.) + parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) + parameter(rlmn=30.,rlmn1=5.,rlmx=300.,elmx=300.) + parameter(prmin=0.25,prmax=4.0) + parameter(pr0=1.0,prtke=1.0,prscu=0.67) + parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) + parameter(tkmin=1.e-9,dspmax=10.0) + parameter(qmin=1.e-8,qlmin=1.e-12,zfmin=1.e-8) + parameter(aphi5=5.,aphi16=16.) + parameter(elmfac=1.0,elefac=1.0,cql=100.) + parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=25000.) + parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) + parameter(h1=0.33333333) + parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) + parameter(ce0=0.4) + parameter(rchck=1.5,ndt=20) + + gravi=1.0/grav + g=grav + gocp=g/cp + cont=cp/g + conq=hvap/g + conw=1.0/g ! for del in pa +! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) !kpa + elocp=hvap/cp + el2orc=hvap*hvap/(rv*cp) +! +!************************************************************************ +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + dt2 = delt + rdt = 1. / dt2 +! +! the code is written assuming ntke=ntrac +! if ntrac > ntke, the code needs to be modified +! + ntrac1 = ntrac - 1 + km1 = km - 1 + kmpbl = km / 2 + kmscu = km / 2 +! + do k=1,km + do i=1,im + zi(i,k) = phii(i,k) * gravi + zl(i,k) = phil(i,k) * gravi + xmf(i,k) = 0. + xmfd(i,k) = 0. + buou(i,k) = 0. + buod(i,k) = 0. + ckz(i,k) = ck1 + chz(i,k) = ch1 + rlmnz(i,k) = rlmn + enddo + enddo + do i=1,im + frik(i) = 1.0 + enddo + do i=1,im + zi(i,km+1) = phii(i,km+1) * gravi + enddo + do k=1,km + do i=1,im + zm(i,k) = zi(i,k+1) + enddo + enddo +! horizontal grid size + do i=1,im + gdx(i) = sqrt(garea(i)) + enddo +! + do k=1,km + do i=1,im + tke(i,k) = max(q1(i,k,ntke), tkmin) + enddo + enddo + do k=1,km1 + do i=1,im + tkeh(i,k) = 0.5 * (tke(i,k) + tke(i,k+1)) + enddo + enddo +! + do k = 1,km1 + do i=1,im + rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) + prn(i,k) = pr0 + enddo + enddo +! +! set background diffusivities as a function of +! horizontal grid size with xkzm_h & xkzm_m for gdx >= 25km +! and 0.01 for gdx=5m, i.e., +! xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) +! xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) +! + do i=1,im + kx1(i) = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + if(gdx(i) >= xkgdx) then + xkzm_hx(i) = xkzm_h + xkzm_mx(i) = xkzm_m + else + tem = 1. / (xkgdx - 5.) + tem1 = (xkzm_h - 0.01) * tem + tem2 = (xkzm_m - 0.01) * tem + ptem = gdx(i) - 5. + xkzm_hx(i) = 0.01 + tem1 * ptem + xkzm_mx(i) = 0.01 + tem2 * ptem + endif + enddo + do k = 1,km1 + do i=1,im + xkzo(i,k) = 0.0 + xkzmo(i,k) = 0.0 + if (k < kinver(i)) then +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 10.0 + tem2 = min(1.0, exp(-tem2)) + xkzo(i,k) = xkzm_hx(i) * tem2 +! + ptem = prsl(i,k) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 2.5 + tem2 = min(1.0, exp(-tem2)) + rlmnz(i,k)= rlmn * tem2 + rlmnz(i,k)= max(rlmnz(i,k), rlmn1) +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_mx(i) + kx1(i) = k + 1 + else + if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_mx(i) * min(1.0, exp(-tem1)) + endif + endif + enddo + enddo +! + do i = 1,im + z0(i) = 0.01 * zorl(i) + dusfc(i) = 0. + dvsfc(i) = 0. + dtsfc(i) = 0. + dqsfc(i) = 0. + kpbl(i) = 1 + hpbl(i) = 0. + kpblx(i) = 1 + hpblx(i) = 0. + pblflg(i)= .true. + sfcflg(i)= .true. + if(rbsoil(i) > 0.) sfcflg(i) = .false. + pcnvflg(i)= .false. + scuflg(i)= .true. + if(scuflg(i)) then + radmin(i)= 0. + mrad(i) = km1 + krad(i) = 1 + lcld(i) = km1 + kcld(i) = km1 + endif + enddo +! + do k=1,km + do i=1,im + pix(i,k) = psk(i) / prslk(i,k) + theta(i,k) = t1(i,k) * pix(i,k) + if(ntiw > 0) then + tem = max(q1(i,k,ntcw),qlmin) + tem1 = max(q1(i,k,ntiw),qlmin) + qlx(i,k) = tem + tem1 + ptem = hvap*tem + (hvap+hfus)*tem1 + slx(i,k) = cp * t1(i,k) + phil(i,k) - ptem + else + qlx(i,k) = max(q1(i,k,ntcw),qlmin) + slx(i,k) = cp * t1(i,k) + phil(i,k) - hvap*qlx(i,k) + endif + tem2 = 1.+fv*max(q1(i,k,1),qmin)-qlx(i,k) + thvx(i,k) = theta(i,k) * tem2 + tvx(i,k) = t1(i,k) * tem2 + qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) + thlx(i,k) = theta(i,k) - pix(i,k)*elocp*qlx(i,k) + thlvx(i,k) = thlx(i,k) * (1. + fv * qtx(i,k)) + svx(i,k) = cp * tvx(i,k) + ptem1 = elocp * pix(i,k) * max(q1(i,k,1),qmin) + thetae(i,k)= theta(i,k) + ptem1 + gotvx(i,k) = g / tvx(i,k) + enddo + enddo +! +! compute an empirical cloud fraction based on +! Xu & Randall's (1996,JAS) study +! + do k = 1, km + do i = 1, im + plyr(i,k) = 0.01 * prsl(i,k) ! pa to mb (hpa) +! --- ... compute relative humidity + es = 0.01 * fpvs(t1(i,k)) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k) + epsm1*es)) + rhly(i,k) = max(0.0, min(1.0, max(qmin, q1(i,k,1))/qs)) + qstl(i,k) = qs + enddo + enddo +! + do k = 1, km + do i = 1, im + cfly(i,k) = 0. + clwt = 1.0e-6 * (plyr(i,k)*0.001) + if (qlx(i,k) > clwt) then + onemrh= max(1.e-10, 1.0-rhly(i,k)) + tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) + tem1 = cql / tem1 + value = max(min( tem1*qlx(i,k), 50.0), 0.0) + tem2 = sqrt(sqrt(rhly(i,k))) + cfly(i,k) = min(max(tem2*(1.0-exp(-value)), 0.0), 1.0) + endif + enddo + enddo +! +! compute buoyancy modified by clouds +! + do k = 1, km1 + do i = 1, im + tem = 0.5 * (svx(i,k) + svx(i,k+1)) + tem1 = 0.5 * (t1(i,k) + t1(i,k+1)) + tem2 = 0.5 * (qstl(i,k) + qstl(i,k+1)) + cfh = min(cfly(i,k+1),0.5*(cfly(i,k)+cfly(i,k+1))) + alp = g / tem + gamma = el2orc * tem2 / (tem1**2) + epsi = tem1 / elocp + beta = (1. + gamma*epsi*(1.+fv)) / (1. + gamma) + chx = cfh * alp * beta + (1. - cfh) * alp + cqx = cfh * alp * hvap * (beta - epsi) + cqx = cqx + (1. - cfh) * fv * g + ptem1 = (slx(i,k+1)-slx(i,k))*rdzt(i,k) + ptem2 = (qtx(i,k+1)-qtx(i,k))*rdzt(i,k) + bf(i,k) = chx * ptem1 + cqx * ptem2 + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k=1,km1 + do i=1,im + dku(i,k) = 0. + dkt(i,k) = 0. + dkq(i,k) = 0. + cku(i,k) = 0. + ckt(i,k) = 0. + tem = zi(i,k+1)-zi(i,k) + radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) + enddo + enddo +! + do i = 1,im + sflux(i) = heat(i) + evap(i)*fv*theta(i,1) + if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. + enddo +! +! compute critical bulk richardson number +! + do i = 1,im + if(pblflg(i)) then +! thermal(i) = thvx(i,1) + thermal(i) = thlvx(i,1) + crb(i) = rbcr + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + enddo +! + do i=1,im + dtdz1(i) = dt2 / (zi(i,2)-zi(i,1)) + enddo +! + do i=1,im + ustar(i) = sqrt(stress(i)) + enddo +! +! compute buoyancy (bf) and winshear square +! + do k = 1, km1 + do i = 1, im + rdz = rdzt(i,k) +! bf(i,k) = gotvx(i,k)*(thvx(i,k+1)-thvx(i,k))*rdz + dw2 = (u1(i,k)-u1(i,k+1))**2 + & + (v1(i,k)-v1(i,k+1))**2 + shr2(i,k) = max(dw2,dw2min)*rdz*rdz + enddo + enddo +! +! find pbl height based on bulk richardson number (mrf pbl scheme) +! and also for diagnostic purpose +! + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + enddo +! + do k = 1, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) +! rbup(i) = (thvx(i,k)-thermal(i))* +! & (g*zl(i,k)/thvx(i,1))/spdk2 + rbup(i) = (thlvx(i,k)-thermal(i))* + & (g*zl(i,k)/thlvx(i,1))/spdk2 + kpblx(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + do i = 1,im + if(kpblx(i) > 1) then + k = kpblx(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpblx(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpblx(i) < zi(i,kpblx(i))) kpblx(i)=kpblx(i)-1 + else + hpblx(i) = zl(i,1) + kpblx(i) = 1 + endif + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + if(kpbl(i) <= 1) pblflg(i)=.false. + enddo +! +! compute similarity parameters +! + do i=1,im + zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) + if(sfcflg(i)) then + zol(i) = min(zol(i),-zfmin) + else + zol(i) = max(zol(i),zfmin) + endif +! + zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) + if(sfcflg(i)) then + tem = 1.0 / (1. - aphi16*zol1) + phih(i) = sqrt(tem) + phim(i) = sqrt(phih(i)) + else + phim(i) = 1. + aphi5*zol1 + phih(i) = phim(i) + endif + enddo +! + do i=1,im + if(pblflg(i)) then + if(zol(i) < zolcru) then + pcnvflg(i) = .true. + endif + wst3(i) = gotvx(i,1)*sflux(i)*hpbl(i) + wstar(i)= wst3(i)**h1 + ust3(i) = ustar(i)**3. + wscale(i)=(ust3(i)+wfac*vk*wst3(i)*sfcfrac)**h1 + ptem = ustar(i)/aphi5 + wscale(i) = max(wscale(i),ptem) + endif + enddo +! +! compute a thermal excess +! + do i = 1,im + if(pcnvflg(i)) then + hgamt(i) = heat(i)/wscale(i) + hgamq(i) = evap(i)/wscale(i) + vpert(i) = hgamt(i) + hgamq(i)*fv*theta(i,1) + vpert(i) = max(vpert(i),0.) + vpert(i) = min(cfac*vpert(i),gamcrt) + endif + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! look for stratocumulus +! + do i=1,im + flg(i) = scuflg(i) + enddo + do k = 1, km1 + do i=1,im + if(flg(i).and.zl(i,k) >= zstblmax) then + lcld(i)=k + flg(i)=.false. + endif + enddo + enddo + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k <= lcld(i)) then + if(qlx(i,k) >= qlcr) then + kcld(i)=k + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. + enddo +! + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k <= kcld(i)) then + if(qlx(i,k) >= qlcr) then + if(radx(i,k) < radmin(i)) then + radmin(i)=radx(i,k) + krad(i)=k + endif + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. + if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute components for mass flux mixing by large thermals +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + tcko(i,k) = t1(i,k) + ucko(i,k) = u1(i,k) + vcko(i,k) = v1(i,k) + endif + if(scuflg(i)) then + tcdo(i,k) = t1(i,k) + ucdo(i,k) = u1(i,k) + vcdo(i,k) = v1(i,k) + endif + enddo + enddo + do kk = 1, ntrac1 + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,kk) = q1(i,k,kk) + endif + if(scuflg(i)) then + qcdo(i,k,kk) = q1(i,k,kk) + endif + enddo + enddo + enddo +! + call mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,dt2, + & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, + & gdx,hpbl,kpbl,vpert,buou,xmf, + & tcko,qcko,ucko,vcko,xlamue,bl_upfr) +! + call mfscuq(im,ix,km,kmscu,ntcw,ntrac1,dt2, + & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, + & thlx,thvx,thlvx,gdx,thetae, + & krad,mrad,radmin,buod,xmfd, + & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute prandtl number and exchange coefficient varying with height +! + do k = 1, kmpbl + do i = 1, im + if(k < kpbl(i)) then + tem = phih(i)/phim(i) + ptem = sfcfrac*hpbl(i) + tem1 = max(zi(i,k+1)-ptem, 0.) + tem2 = tem1 / (hpbl(i) - ptem) + if(pcnvflg(i)) then + tem = min(tem, pr0) + prn(i,k) = tem + (pr0 - tem) * tem2 + else + tem = max(tem, pr0) + prn(i,k) = tem + endif + prn(i,k) = min(prn(i,k),prmax) + prn(i,k) = max(prn(i,k),prmin) +! + ckz(i,k) = ck0 + (ck1 - ck0) * tem2 + ckz(i,k) = max(min(ckz(i,k), ck0), ck1) + chz(i,k) = ch0 + (ch1 - ch0) * tem2 + chz(i,k) = max(min(chz(i,k), ch0), ch1) +! + endif + enddo + enddo +! +! background diffusivity decreasing with increasing surface layer stability +! + do i = 1, im + if(.not.sfcflg(i)) then + tem = (1. + 5. * rbsoil(i))**2. +! tem = (1. + 5. * zol(i))**2. + frik(i) = 0.1 + 0.9 / tem + endif + enddo +! + do k = 1,km1 + do i=1,im + xkzo(i,k) = frik(i) * xkzo(i,k) + xkzmo(i,k)= frik(i) * xkzmo(i,k) + enddo + enddo +! +! The background vertical diffusivities in the inversion layers are limited +! to be less than or equal to xkzminv +! + do k = 1,km1 + do i=1,im +! tem1 = (tvx(i,k+1)-tvx(i,k)) * rdzt(i,k) +! if(tem1 > 1.e-5) then + tem1 = tvx(i,k+1)-tvx(i,k) + if(tem1 > 0.) then + xkzo(i,k) = min(xkzo(i,k),xkzinv) + xkzmo(i,k) = min(xkzmo(i,k),xkzinv) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute an asymtotic mixing length +! + do k = 1, km1 + do i = 1, im + zlup = 0.0 + bsum = 0.0 + mlenflg = .true. + do n = k, km1 + if(mlenflg) then + dz = zl(i,n+1) - zl(i,n) + ptem = gotvx(i,n)*(thvx(i,n+1)-thvx(i,k))*dz +! ptem = gotvx(i,n)*(thlvx(i,n+1)-thlvx(i,k))*dz + bsum = bsum + ptem + zlup = zlup + dz + if(bsum >= tke(i,k)) then + if(ptem >= 0.) then + tem2 = max(ptem, zfmin) + else + tem2 = min(ptem, -zfmin) + endif + ptem1 = (bsum - tke(i,k)) / tem2 + zlup = zlup - ptem1 * dz + zlup = max(zlup, 0.) + mlenflg = .false. + endif + endif + enddo + zldn = 0.0 + bsum = 0.0 + mlenflg = .true. + do n = k, 1, -1 + if(mlenflg) then + if(n == 1) then + dz = zl(i,1) + tem1 = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + else + dz = zl(i,n) - zl(i,n-1) + tem1 = thvx(i,n-1) +! tem1 = thlvx(i,n-1) + endif + ptem = gotvx(i,n)*(thvx(i,k)-tem1)*dz +! ptem = gotvx(i,n)*(thlvx(i,k)-tem1)*dz + bsum = bsum + ptem + zldn = zldn + dz + if(bsum >= tke(i,k)) then + if(ptem >= 0.) then + tem2 = max(ptem, zfmin) + else + tem2 = min(ptem, -zfmin) + endif + ptem1 = (bsum - tke(i,k)) / tem2 + zldn = zldn - ptem1 * dz + zldn = max(zldn, 0.) + mlenflg = .false. + endif + endif + enddo +! + tem = 0.5 * (zi(i,k+1)-zi(i,k)) + tem1 = min(tem, rlmnz(i,k)) +! + ptem2 = min(zlup,zldn) + rlam(i,k) = elmfac * ptem2 + rlam(i,k) = max(rlam(i,k), tem1) + rlam(i,k) = min(rlam(i,k), rlmx) +! + ptem2 = sqrt(zlup*zldn) + ele(i,k) = elefac * ptem2 + ele(i,k) = max(ele(i,k), tem1) + ele(i,k) = min(ele(i,k), elmx) +! + enddo + enddo +! + do k = 1, km1 + do i = 1, im + tem = vk * zl(i,k) + if (zol(i) < 0.) then + ptem = 1. - 100. * zol(i) + ptem1 = ptem**0.2 + zk = tem * ptem1 + elseif (zol(i) >= 1.) then + zk = tem / 3.7 + else + ptem = 1. + 2.7 * zol(i) + zk = tem / ptem + endif + elm(i,k) = zk*rlam(i,k)/(rlam(i,k)+zk) +! + dz = zi(i,k+1) - zi(i,k) + tem = max(gdx(i),dz) + elm(i,k) = min(elm(i,k), tem) + ele(i,k) = min(ele(i,k), tem) +! + enddo + enddo + do i = 1, im + elm(i,km) = elm(i,km1) + ele(i,km) = ele(i,km1) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute eddy diffusivities +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km1 + do i = 1, im + tem = 0.5 * (elm(i,k) + elm(i,k+1)) + tem = tem * sqrt(tkeh(i,k)) + ri = max(bf(i,k)/shr2(i,k),rimin) + if(k < kpbl(i)) then + if(pcnvflg(i)) then + dku(i,k) = ckz(i,k) * tem + dkt(i,k) = dku(i,k) / prn(i,k) + else + if(ri < 0.) then ! unstable regime + dku(i,k) = ckz(i,k) * tem + dkt(i,k) = dku(i,k) / prn(i,k) + else ! stable regime + dkt(i,k) = chz(i,k) * tem + dku(i,k) = dkt(i,k) * prn(i,k) + endif + endif + else + if(ri < 0.) then ! unstable regime + dku(i,k) = ck1 * tem + dkt(i,k) = rchck * dku(i,k) + else ! stable regime + dkt(i,k) = ch1 * tem + prnum = 1.0 + 2.1 * ri + prnum = min(prnum,prmax) + dku(i,k) = dkt(i,k) * prnum + endif + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + tem1 = ckz(i,k) * tem + ptem1 = tem1 / prscu + dku(i,k) = max(dku(i,k), tem1) + dkt(i,k) = max(dkt(i,k), ptem1) + endif + endif +! + dkq(i,k) = prtke * dkt(i,k) +! + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dkq(i,k) = min(dkq(i,k),dkmax) + dkq(i,k) = max(dkq(i,k),xkzo(i,k)) + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) +! + enddo + enddo +! +! compute a minimum TKE deduced from background diffusivity for momentum. +! + do k = 1, km1 + do i = 1, im + if(k == 1) then + tem = ckz(i,1) + tem1 = xkzmo(i,1) + else + tem = 0.5 * (ckz(i,k-1) + ckz(i,k)) + tem1 = 0.5 * (xkzmo(i,k-1) + xkzmo(i,k)) + endif + ptem = tem1 / (tem * elm(i,k)) + tkmnz(i,k) = ptem * ptem + tkmnz(i,k) = max(tkmnz(i,k), tkmin) + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute buoyancy and shear productions of tke +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km1 + do i = 1, im + if (k == 1) then + tem = -dkt(i,1) * bf(i,1) +! if(pcnvflg(i)) then +! ptem1 = xmf(i,1) * buou(i,1) +! else + ptem1 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem2 = xmfd(i,1) * buod(i,1) + else + ptem2 = 0. + endif + tem = tem + ptem1 + ptem2 + buop = 0.5 * (gotvx(i,1) * sflux(i) + tem) +! + tem1 = dku(i,1) * shr2(i,1) +! + tem = (u1(i,2)-u1(i,1))*rdzt(i,1) +! if(pcnvflg(i)) then +! ptem = xmf(i,1) * tem +! ptem1 = 0.5 * ptem * (u1(i,2)-ucko(i,2)) +! else + ptem1 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem = ucdo(i,1)+ucdo(i,2)-u1(i,1)-u1(i,2) + ptem = 0.5 * tem * xmfd(i,1) * ptem + else + ptem = 0. + endif + ptem1 = ptem1 + ptem +! + tem = (v1(i,2)-v1(i,1))*rdzt(i,1) +! if(pcnvflg(i)) then +! ptem = xmf(i,1) * tem +! ptem2 = 0.5 * ptem * (v1(i,2)-vcko(i,2)) +! else + ptem2 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem = vcdo(i,1)+vcdo(i,2)-v1(i,1)-v1(i,2) + ptem = 0.5 * tem * xmfd(i,1) * ptem + else + ptem = 0. + endif + ptem2 = ptem2 + ptem +! +! tem2 = stress(i)*spd1(i)/zl(i,1) + tem2 = stress(i)*ustar(i)*phim(i)/(vk*zl(i,1)) + shrp = 0.5 * (tem1 + ptem1 + ptem2 + tem2) + else + tem1 = -dkt(i,k-1) * bf(i,k-1) + tem2 = -dkt(i,k) * bf(i,k) + tem = 0.5 * (tem1 + tem2) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = 0.5 * (xmf(i,k-1) + xmf(i,k)) + ptem1 = ptem * buou(i,k) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = 0.5 * (xmfd(i,k-1) + xmfd(i,k)) + ptem2 = ptem0 * buod(i,k) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + buop = tem + ptem1 + ptem2 +! + tem1 = dku(i,k-1) * shr2(i,k-1) + tem2 = dku(i,k) * shr2(i,k) + tem = 0.5 * (tem1 + tem2) + tem1 = (u1(i,k+1)-u1(i,k))*rdzt(i,k) + tem2 = (u1(i,k)-u1(i,k-1))*rdzt(i,k-1) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = xmf(i,k) * tem1 + xmf(i,k-1) * tem2 + ptem1 = 0.5 * ptem * (u1(i,k)-ucko(i,k)) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = xmfd(i,k) * tem1 + xmfd(i,k-1) * tem2 + ptem2 = 0.5 * ptem0 * (ucdo(i,k)-u1(i,k)) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + shrp = tem + ptem1 + ptem2 + tem1 = (v1(i,k+1)-v1(i,k))*rdzt(i,k) + tem2 = (v1(i,k)-v1(i,k-1))*rdzt(i,k-1) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = xmf(i,k) * tem1 + xmf(i,k-1) * tem2 + ptem1 = 0.5 * ptem * (v1(i,k)-vcko(i,k)) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = xmfd(i,k) * tem1 + xmfd(i,k-1) * tem2 + ptem2 = 0.5 * ptem0 * (vcdo(i,k)-v1(i,k)) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + shrp = shrp + ptem1 + ptem2 + endif + prod(i,k) = buop + shrp + enddo + enddo +! +!---------------------------------------------------------------------- +! first predict tke due to tke production & dissipation(diss) +! + dtn = dt2 / float(ndt) + do n = 1, ndt + do k = 1,km1 + do i=1,im + tem = sqrt(tke(i,k)) + ptem = ce0 / ele(i,k) + diss(i,k) = ptem * tke(i,k) * tem + tem1 = prod(i,k) + tke(i,k) / dtn + diss(i,k)=max(min(diss(i,k), tem1), 0.) + tke(i,k) = tke(i,k) + dtn * (prod(i,k)-diss(i,k)) +! tke(i,k) = max(tke(i,k), tkmin) + tke(i,k) = max(tke(i,k), tkmnz(i,k)) + enddo + enddo + enddo +! +! compute updraft & downdraft properties for tke +! + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,ntke) = tke(i,k) + endif + if(scuflg(i)) then + qcdo(i,k,ntke) = tke(i,k) + endif + enddo + enddo + do k = 2, kmpbl + do i = 1, im + if (pcnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem + qcko(i,k,ntke)=((1.-tem)*qcko(i,k-1,ntke)+tem* + & (tke(i,k)+tke(i,k-1)))/factor + endif + enddo + enddo + do k = kmscu, 1, -1 + do i = 1, im + if (scuflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem + qcdo(i,k,ntke)=((1.-tem)*qcdo(i,k+1,ntke)+tem* + & (tke(i,k)+tke(i,k+1)))/factor + endif + endif + enddo + enddo +! +!---------------------------------------------------------------------- +! compute tridiagonal matrix elements for turbulent kinetic energy +! + do i=1,im + ad(i,1) = 1.0 + f1(i,1) = tke(i,1) + enddo +! + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkq(i,k) * rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = tke(i,k) + tke(i,k+1) + ptem = qcko(i,k,ntke) + qcko(i,k+1,ntke) + f1(i,k) = f1(i,k)-(ptem-tem)*ptem1 + f1(i,k+1) = tke(i,k+1)+(ptem-tem)*ptem2 + else + f1(i,k+1) = tke(i,k+1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = tke(i,k) + tke(i,k+1) + ptem = qcdo(i,k,ntke) + qcdo(i,k+1,ntke) + f1(i,k) = f1(i,k) + (ptem - tem) * ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) * ptem2 + endif + endif +! + enddo + enddo +c +c solve tridiagonal problem for tke +c + call tridit(im,km,1,al,ad,au,f1,au,f1) +c +c recover tendency of tke +c + do k = 1,km + do i = 1,im +! f1(i,k) = max(f1(i,k), tkmin) + qtend = (f1(i,k)-q1(i,k,ntke))*rdt + rtg(i,k,ntke) = rtg(i,k,ntke)+qtend + enddo + enddo +c +c compute tridiagonal matrix elements for heat and moisture +c + do i=1,im + ad(i,1) = 1. + f1(i,1) = t1(i,1) + dtdz1(i) * heat(i) + f2(i,1) = q1(i,1,1) + dtdz1(i) * evap(i) + enddo + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do i = 1, im + f2(i,1+is) = q1(i,1,kk) + enddo + enddo + endif +c + do k = 1,km1 + do i = 1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkt(i,k) * rdz + dsdzt = tem1 * gocp + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = t1(i,k) + t1(i,k+1) + ptem = tcko(i,k) + tcko(i,k+1) + f1(i,k) = f1(i,k)+dtodsd*dsdzt-(ptem-tem)*ptem1 + f1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+(ptem-tem)*ptem2 + tem = q1(i,k,1) + q1(i,k+1,1) + ptem = qcko(i,k,1) + qcko(i,k+1,1) + f2(i,k) = f2(i,k) - (ptem - tem) * ptem1 + f2(i,k+1) = q1(i,k+1,1) + (ptem - tem) * ptem2 + else + f1(i,k) = f1(i,k)+dtodsd*dsdzt + f1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + f2(i,k+1) = q1(i,k+1,1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ptem = tcdo(i,k) + tcdo(i,k+1) + tem = t1(i,k) + t1(i,k+1) + f1(i,k) = f1(i,k) + (ptem - tem) * ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) * ptem2 + tem = q1(i,k,1) + q1(i,k+1,1) + ptem = qcdo(i,k,1) + qcdo(i,k+1,1) + f2(i,k) = f2(i,k) + (ptem - tem) * ptem1 + f2(i,k+1) = f2(i,k+1) - (ptem - tem) * ptem2 + endif + endif + enddo + enddo +! + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do k = 1, km1 + do i = 1, im + if(pcnvflg(i) .and. k < kpbl(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) + tem2 = q1(i,k,kk) + q1(i,k+1,kk) + f2(i,k+is) = f2(i,k+is) - (tem1 - tem2) * ptem1 + f2(i,k+1+is)= q1(i,k+1,kk) + (tem1 - tem2) * ptem2 + else + f2(i,k+1+is) = q1(i,k+1,kk) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcdo(i,k,kk) + qcdo(i,k+1,kk) + tem2 = q1(i,k,kk) + q1(i,k+1,kk) + f2(i,k+is) = f2(i,k+is) + (tem1 - tem2) * ptem1 + f2(i,k+1+is)= f2(i,k+1+is) - (tem1 - tem2) * ptem2 + endif + endif +! + enddo + enddo + enddo + endif +c +c solve tridiagonal problem for heat and moisture +c + call tridin(im,km,ntrac1,al,ad,au,f1,f2,au,f1,f2) +c +c recover tendencies of heat and moisture +c + do k = 1,km + do i = 1,im + ttend = (f1(i,k)-t1(i,k))*rdt + qtend = (f2(i,k)-q1(i,k,1))*rdt + tdt(i,k) = tdt(i,k)+ttend + rtg(i,k,1) = rtg(i,k,1)+qtend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend + enddo + enddo +! + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (f2(i,k+is)-q1(i,k,kk))*rdt + rtg(i,k,kk) = rtg(i,k,kk)+qtend + enddo + enddo + enddo + endif +! +! add tke dissipative heating to temperature tendency +! + if(dspheat) then + do k = 1,km1 + do i = 1,im +! tem = min(diss(i,k), dspmax) +! ttend = tem / cp + ttend = diss(i,k) / cp + tdt(i,k) = tdt(i,k) + dspfac * ttend + enddo + enddo + endif +c +c compute tridiagonal matrix elements for momentum +c + do i=1,im + ad(i,1) = 1.0 + dtdz1(i) * stress(i) / spd1(i) + f1(i,1) = u1(i,1) + f2(i,1) = v1(i,1) + enddo +c + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dku(i,k) * rdz + dsdz2 = tem1*rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = u1(i,k) + u1(i,k+1) + ptem = ucko(i,k) + ucko(i,k+1) + f1(i,k) = f1(i,k) - (ptem - tem) * ptem1 + f1(i,k+1) = u1(i,k+1) + (ptem - tem) * ptem2 + tem = v1(i,k) + v1(i,k+1) + ptem = vcko(i,k) + vcko(i,k+1) + f2(i,k) = f2(i,k) - (ptem - tem) * ptem1 + f2(i,k+1) = v1(i,k+1) + (ptem - tem) * ptem2 + else + f1(i,k+1) = u1(i,k+1) + f2(i,k+1) = v1(i,k+1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = u1(i,k) + u1(i,k+1) + ptem = ucdo(i,k) + ucdo(i,k+1) + f1(i,k) = f1(i,k) + (ptem - tem) *ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) *ptem2 + tem = v1(i,k) + v1(i,k+1) + ptem = vcdo(i,k) + vcdo(i,k+1) + f2(i,k) = f2(i,k) + (ptem - tem) * ptem1 + f2(i,k+1) = f2(i,k+1) - (ptem - tem) * ptem2 + endif + endif +! + enddo + enddo +c +c solve tridiagonal problem for momentum +c + call tridi2(im,km,al,ad,au,f1,f2,au,f1,f2) +c +c recover tendencies of momentum +c + do k = 1,km + do i = 1,im + utend = (f1(i,k)-u1(i,k))*rdt + vtend = (f2(i,k)-v1(i,k))*rdt + du(i,k) = du(i,k)+utend + dv(i,k) = dv(i,k)+vtend + dusfc(i) = dusfc(i)+conw*del(i,k)*utend + dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! pbl height for diagnostic purpose +! + do i = 1, im + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + return + end subroutine satmedmfvdifq_run +!> @} + + end module satmedmfvdifq diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta new file mode 100644 index 000000000..ec679faec --- /dev/null +++ b/physics/satmedmfvdifq.meta @@ -0,0 +1,597 @@ +[ccpp-arg-table] + name = satmedmfvdifq_init + type = scheme +[isatmedmf] + standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[isatmedmf_vdifq] + standard_name = choice_of_updated_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of updated scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +##################################################################### +[ccpp-arg-table] + name = satmedmfvdifq_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate_vertical_diffusion_tracer + long_name = tracer index for ice water in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspfac] + standard_name = tke_dissipative_heating_factor + long_name = tke dissipative heating factor + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[bl_upfr] + standard_name = updraft_fraction_in_boundary_layer_mass_flux_scheme + long_name = updraft fraction in boundary layer mass flux scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[bl_dnfr] + standard_name = downdraft_fraction_in_boundary_layer_mass_flux_scheme + long_name = downdraft fraction in boundary layer mass flux scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/shalcnv.F b/physics/shalcnv.F new file mode 100644 index 000000000..5c9e65203 --- /dev/null +++ b/physics/shalcnv.F @@ -0,0 +1,1351 @@ +!> \defgroup SASHAL Mass-Flux Shallow Convection +!! @{ +!! \brief The Mass-Flux shallow convection scheme parameterizes the effect of shallow convection on the environment much like the \ref SAS scheme with a few key modifications. Perhaps most importantly, no quasi-equilibrium assumption is necessary since the shallow cloud base mass flux is parameterized from the surface buoyancy flux. Further, there are no convective downdrafts, the entrainment rate is greater than for deep convection, and the shallow convection is limited to not extend over the level where \f$p=0.7p_{sfc}\f$. +!! +!! This scheme was designed to replace the previous eddy-diffusivity approach to shallow convection with a mass-flux based approach as it is used for deep convection. Differences between the shallow and deep SAS schemes are presented in Han and Pan (2011) \cite han_and_pan_2011 . Like the deep scheme, it uses the working concepts put forth in Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 but includes modifications and simplifications from Grell (1993) \cite grell_1993 such as only one cloud type (the deepest possible, up to \f$p=0.7p_{sfc}\f$), rather than a spectrum based on cloud top heights or assumed entrainment rates, although it assumes no convective downdrafts. It contains many modifications associated with deep scheme as discussed in Han and Pan (2011) \cite han_and_pan_2011 , including the calculation of cloud top, a greater CFL-criterion-based maximum cloud base mass flux, and the inclusion of convective overshooting. +!! +!! \section diagram Calling Hierarchy Diagram +!! \image html Shallow_SAS_Flowchart.png "Diagram depicting how the SAS shallow convection scheme is called from the GSM physics time loop" height=2cm +!! \section intraphysics Intraphysics Communication +!! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. + +!> \file shalcnv.F +!! Contains the entire SAS shallow convection scheme. + module shalcnv + + implicit none + + private + + public :: shalcnv_init, shalcnv_run, shalcnv_finalize + + contains + +!! +!! \section arg_table_shalcnv_init Argument Table +!! \htmlinclude shalcnv_init.html +!! + subroutine shalcnv_init(do_shoc,shal_cnv,imfshalcnv, & + & imfshalcnv_sas,errmsg,errflg) +! + logical, intent(in) :: do_shoc,shal_cnv + integer, intent(in) :: imfshalcnv, imfshalcnv_sas + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (do_shoc .or. .not.shal_cnv .or. & + & imfshalcnv/=imfshalcnv_sas) then + write(errmsg,'(*(a))') 'Logic error: shalcnv incompatible with',& + & ' control flags do_shoc, shal_cnv or imfshalcnv' + errflg = 1 + return + endif +! + end subroutine shalcnv_init + +! \brief This subroutine is empty since there are no procedures that need to be done to finalize the shalcnv code. +!! +!! \section arg_table_shalcnv_finalize Argument Table +!! + subroutine shalcnv_finalize + end subroutine shalcnv_finalize + +!> \brief This subroutine contains the entirety of the SAS shallow convection scheme. +!! +!! This routine follows the \ref SAS scheme quite closely, although it can be interpreted as only having the "static" and "feedback" control portions, since the "dynamic" control is not necessary to find the cloud base mass flux. The algorithm is simplified from SAS deep convection by excluding convective downdrafts and being confined to operate below \f$p=0.7p_{sfc}\f$. Also, entrainment is both simpler and stronger in magnitude compared to the deep scheme. +!! +!! \param[in] im number of used points +!! \param[in] ix horizontal dimension +!! \param[in] km vertical layer dimension +!! \param[in] jcap number of spectral wave trancation +!! \param[in] delt physics time step in seconds +!! \param[in] delp pressure difference between level k and k+1 (Pa) +!! \param[in] prslp mean layer presure (Pa) +!! \param[in] psp surface pressure (Pa) +!! \param[in] phil layer geopotential (\f$m^2/s^2\f$) +!! \param[inout] qlc cloud water (kg/kg) +!! \param[inout] qli ice (kg/kg) +!! \param[inout] q1 updated tracers (kg/kg) +!! \param[inout] t1 updated temperature (K) +!! \param[inout] u1 updated zonal wind (\f$m s^{-1}\f$) +!! \param[inout] v1 updated meridional wind (\f$m s^{-1}\f$) +!! \param[out] rn convective rain (m) +!! \param[out] kbot index for cloud base +!! \param[out] ktop index for cloud top +!! \param[out] kcnv flag to denote deep convection (0=no, 1=yes) +!! \param[in] islimsk sea/land/ice mask (=0/1/2) +!! \param[in] dot layer mean vertical velocity (Pa/s) +!! \param[in] ncloud number of cloud species +!! \param[in] hpbl PBL height (m) +!! \param[in] heat surface sensible heat flux (K m/s) +!! \param[in] evap surface latent heat flux (kg/kg m/s) +!! \param[out] ud_mf updraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dt_mf ud_mf at cloud top (\f$kg/m^2\f$) +!! \param[out] cnvw convective cloud water (kg/kg) +!! \param[out] cnvc convective cloud cover (unitless) +!! +!! \section general General Algorithm +!! -# Compute preliminary quantities needed for the static and feedback control portions of the algorithm. +!! -# Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!! -# Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. +!! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! \section detailed Detailed Algorithm +!! +!! \section arg_table_shalcnv_run Argument Table +!! \htmlinclude shalcnv_run.html +!! +!! @{ + subroutine shalcnv_run( & + & grav,cp,hvap,rv,fv,t0c,rd,cvap,cliq,eps,epsm1, & + & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & q1,t1,u1,v1,rn,kbot,ktop,kcnv,islimsk, & + & dot,ncloud,hpbl,heat,evap,ud_mf,dt_mf,cnvw,cnvc, & + & clam,c0,c1,pgcon,errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & +! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & +! &, rd => con_rd, cvap => con_cvap, cliq => con_cliq & +! &, eps => con_eps, epsm1 => con_epsm1 + implicit none +! +! Interface variables +! + real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & + & rd, cvap, cliq, eps, epsm1 + integer, intent(in) :: im, ix, km, jcap, ncloud + integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) + integer, intent(in) :: islimsk(:) + real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon + real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & + & prslp(:,:), dot(:,:), & + & phil(:,:), hpbl(:), & + & heat(:), evap(:) + real(kind=kind_phys), intent(inout) :: & + & qlc(:,:), qli(:,:), & + & q1(:,:), t1(:,:), & + & u1(:,:), v1(:,:), & + & cnvw(:,:), cnvc(:,:) + real(kind=kind_phys), intent(out) :: rn(:), ud_mf(:,:), dt_mf(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! Local variables +! + integer i,j,indx, k, kk, km1 + integer kpbl(im) +! + real(kind=kind_phys) dellat, delta, + & desdt, + & dp, + & dq, dqsdp, dqsdt, dt, + & dt2, dtmax, dtmin, dv1h, + & dv1q, dv2h, dv2q, dv1u, + & dv1v, dv2u, dv2v, dv3q, + & dv3h, dv3u, dv3v, + & dz, dz1, e1, + & el2orc, elocp, aafac, + & es, etah, h1, dthk, + & evef, evfact, evfactl, fact1, + & fact2, factor, fjcap, + & g, gamma, pprime, betaw, + & qlk, qrch, qs, + & rfact, shear, tem1, + & val, val1, + & val2, w1, w1l, w1s, + & w2, w2l, w2s, w3, + & w3l, w3s, w4, w4l, + & w4s, tem, ptem, ptem1 +! + integer kb(im), kbcon(im), kbcon1(im), + & ktcon(im), ktcon1(im), + & kbm(im), kmax(im) +! + real(kind=kind_phys) aa1(im), + & delhbar(im), delq(im), delq2(im), + & delqbar(im), delqev(im), deltbar(im), + & deltv(im), edt(im), + & wstar(im), sflx(im), + & pdot(im), po(im,km), + & qcond(im), qevap(im), hmax(im), + & rntot(im), vshear(im), + & xlamud(im), xmb(im), xmbmax(im), + & delubar(im), delvbar(im), + & ps(im), del(im,km), prsl(im,km) +! + real(kind=kind_phys) cincr, cincrmax, cincrmin +! +! physical parameters +! parameter(g=grav) +! parameter(elocp=hvap/cp, +! & el2orc=hvap*hvap/(rv*cp)) +! parameter(c0=.002,c1=5.e-4,delta=fv) +! parameter(delta=fv) +! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) + parameter(cincrmax=180.,cincrmin=120.,dthk=25.) + parameter(h1=0.33333333) +! local variables and arrays + real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), + & uo(im,km), vo(im,km), qeso(im,km) +! cloud water +! real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), tvo(im,km), + real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), + & dbyo(im,km), zo(im,km), xlamue(im,km), + & heo(im,km), heso(im,km), + & dellah(im,km), dellaq(im,km), + & dellau(im,km), dellav(im,km), hcko(im,km), + & ucko(im,km), vcko(im,km), qcko(im,km), + & qrcko(im,km), eta(im,km), + & zi(im,km), pwo(im,km), + & tx1(im), cnvwt(im,km) +! + logical totflg, cnvflg(im), flg(im) +! + real(kind=kind_phys) tf, tcr, tcrf + parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) +! +!----------------------------------------------------------------------- +! +!************************************************************************ +! replace (derived) constants above with regular variables + g = grav + elocp = hvap/cp + el2orc = hvap*hvap/(rv*cp) + delta = fv + fact1 = (cvap-cliq)/rv + fact2 = hvap/rv-fact1*t0c +!************************************************************************ +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!************************************************************************ +! convert input pa terms to cb terms -- moorthi +!> ## Compute preliminary quantities needed for the static and feedback control portions of the algorithm. +!> - Convert input pressure terms to centibar units. + ps = psp * 0.001 + prsl = prslp * 0.001 + del = delp * 0.001 +!************************************************************************ +! + km1 = km - 1 +! +! compute surface buoyancy flux +! +!> - Compute the surface buoyancy flux according to +!! \f[ +!! \overline{w'\theta_v'}=\overline{w'\theta'}+\left(\frac{R_v}{R_d}-1\right)T_0\overline{w'q'} +!! \f] +!! where \f$\overline{w'\theta'}\f$ is the surface sensible heat flux, \f$\overline{w'q'}\f$ is the surface latent heat flux, \f$R_v\f$ is the gas constant for water vapor, \f$R_d\f$ is the gas constant for dry air, and \f$T_0\f$ is a reference temperature. + do i=1,im + sflx(i) = heat(i)+fv*t1(i,1)*evap(i) + enddo +! +! initialize arrays +! +!> - Initialize column-integrated and other single-value-per-column variable arrays. + do i=1,im + cnvflg(i) = .true. + if(kcnv(i).eq.1) cnvflg(i) = .false. + if(sflx(i).le.0.) cnvflg(i) = .false. + if(cnvflg(i)) then + kbot(i)=km+1 + ktop(i)=0 + endif + rn(i)=0. + kbcon(i)=km + ktcon(i)=1 + kb(i)=km + pdot(i) = 0. + qlko_ktcon(i) = 0. + edt(i) = 0. + aa1(i) = 0. + vshear(i) = 0. + enddo +!> - Initialize updraft and detrainment mass fluxes to zero. +! hchuang code change + do k = 1, km + do i = 1, im + ud_mf(i,k) = 0. + dt_mf(i,k) = 0. + enddo + enddo +!! +!> - Return to the calling routine if deep convection is present or the surface buoyancy flux is negative. + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Define tunable parameters. + dt2 = delt + val = 1200. + dtmin = max(dt2, val ) + val = 3600. + dtmax = max(dt2, val ) +! model tunable parameters are all here +! clam = .3 + aafac = .1 + betaw = .03 +! evef = 0.07 + evfact = 0.3 + evfactl = 0.3 +! +! pgcon = 0.7 ! gregory et al. (1997, qjrms) +! pgcon = 0.55 ! zhang & wu (2003,jas) + fjcap = (float(jcap) / 126.) ** 2 + val = 1. + fjcap = max(fjcap,val) + w1l = -8.e-3 + w2l = -4.e-2 + w3l = -5.e-3 + w4l = -5.e-4 + w1s = -2.e-4 + w2s = -2.e-3 + w3s = -1.e-3 + w4s = -2.e-5 +! +! define top layer for search of the downdraft originating layer +! and the maximum thetae for updraft +! +!> - Determine maximum indices for the parcel starting point (kbm) and cloud top (kmax). + do i=1,im + kbm(i) = km + kmax(i) = km + tx1(i) = 1.0 / ps(i) + enddo +! + do k = 1, km + do i=1,im + if (prsl(i,k)*tx1(i) .gt. 0.70) kbm(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.60) kmax(i) = k + 1 + enddo + enddo + do i=1,im + kbm(i) = min(kbm(i),kmax(i)) + enddo +! +! hydrostatic height assume zero terr and compute +! updraft entrainment rate as an inverse function of height +! +!> - Calculate hydrostatic height at layer centers assuming a flat surface (no terrain) from the geopotential. + do k = 1, km + do i=1,im + zo(i,k) = phil(i,k) / g + enddo + enddo +!> - Calculate interface height and the entrainment rate as an inverse function of height. + do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) + enddo + enddo + do i=1,im + xlamue(i,km) = xlamue(i,km1) + enddo +! +! pbl height +! +!> - Find the index for the PBL top using the PBL height; enforce that it is lower than the maximum parcel starting level. + do i=1,im + flg(i) = cnvflg(i) + kpbl(i)= 1 + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.zo(i,k).le.hpbl(i)) then + kpbl(i) = k + else + flg(i) = .false. + endif + enddo + enddo + do i=1,im + kpbl(i)= min(kpbl(i),kbm(i)) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! convert surface pressure to mb from cb +! +!> - Convert prsl from centibar to millibar, set normalized mass flux to 1, cloud properties to 0, and save model state variables (after advection/turbulence). + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + pfld(i,k) = prsl(i,k) * 10.0 + eta(i,k) = 1. + hcko(i,k) = 0. + qcko(i,k) = 0. + qrcko(i,k)= 0. + ucko(i,k) = 0. + vcko(i,k) = 0. + dbyo(i,k) = 0. + pwo(i,k) = 0. + dellal(i,k) = 0. + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) +! uo(i,k) = u1(i,k) * rcs(i) +! vo(i,k) = v1(i,k) * rcs(i) + cnvwt(i,k) = 0. + endif + enddo + enddo +! +! column variables +! p is pressure of the layer (mb) +! t is temperature at t-dt (k)..tn +! q is mixing ratio at t-dt (kg/kg)..qn +! to is temperature at t+dt (k)... this is after advection and turbulan +! qo is mixing ratio at t+dt (kg/kg)..q1 +! +!> - Calculate saturation mixing ratio and enforce minimum moisture values. + do k = 1, km + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +! compute moist static energy +! +!> - Calculate moist static energy (heo) and saturation moist static energy (heso). + do k = 1, km + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)) then +! tem = g * zo(i,k) + cp * to(i,k) + tem = phil(i,k) + cp * to(i,k) + heo(i,k) = tem + hvap * qo(i,k) + heso(i,k) = tem + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo + enddo +! +! determine level with largest moist static energy within pbl +! this is the level where updraft starts +! +!> ## Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!> - Search in the PBL for the level of maximum moist static energy to start the ascending parcel. + do i=1,im + if (cnvflg(i)) then + hmax(i) = heo(i,1) + kb(i) = 1 + endif + enddo + do k = 2, km + do i=1,im + if (cnvflg(i).and.k.le.kpbl(i)) then + if(heo(i,k).gt.hmax(i)) then + kb(i) = k + hmax(i) = heo(i,k) + endif + endif + enddo + enddo +! +!> - Calculate the temperature, water vapor mixing ratio, and pressure at interface levels. + do k = 1, km1 + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo +! +!> - Recalculate saturation mixing ratio, moist static energy, saturation moist static energy, and horizontal momentum on interface levels. Enforce minimum mixing ratios. + do k = 1, km1 + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + uo(i,k) = .5 * (uo(i,k) + uo(i,k+1)) + vo(i,k) = .5 * (vo(i,k) + vo(i,k+1)) + endif + enddo + enddo +! +! look for the level of free convection as cloud base +!!> - Search below the index "kbm" for the level of free convection (LFC) where the condition \f$h_b > h^*\f$ is first met, where \f$h_b, h^*\f$ are the state moist static energy at the parcel's starting level and saturation moist static energy, respectively. Set "kbcon" to the index of the LFC. + do i=1,im + flg(i) = cnvflg(i) + if(flg(i)) kbcon(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kbm(i)) then + if(k.gt.kb(i).and.heo(i,kb(i)).gt.heso(i,k)) then + kbcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! +!> - If no LFC, return to the calling routine without modifying state variables. + do i=1,im + if(cnvflg(i)) then + if(kbcon(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine critical convective inhibition +! as a function of vertical velocity at cloud base. +! +!> - Determine the vertical pressure velocity at the LFC. After Han and Pan (2011) \cite han_and_pan_2011 , determine the maximum pressure thickness between a parcel's starting level and the LFC. If a parcel doesn't reach the LFC within the critical thickness, then the convective inhibition is deemed too great for convection to be triggered, and the subroutine returns to the calling routine without modifying the state variables. + do i=1,im + if(cnvflg(i)) then +! pdot(i) = 10.* dot(i,kbcon(i)) + pdot(i) = 0.01 * dot(i,kbcon(i)) ! now dot is in pa/s + endif + enddo + do i=1,im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif + if(pdot(i).le.w4) then + ptem = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + ptem = - (pdot(i) + w4) / (w4 - w3) + else + ptem = 0. + endif + val1 = -1. + ptem = max(ptem,val1) + val2 = 1. + ptem = min(ptem,val2) + ptem = 1. - ptem + ptem1= .5*(cincrmax-cincrmin) + cincr = cincrmax - ptem * ptem1 + tem1 = pfld(i,kb(i)) - pfld(i,kbcon(i)) + if(tem1.gt.cincr) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! assume the detrainment rate for the updrafts to be same as +! the entrainment rate at cloud base +! +!> - The updraft detrainment rate is set constant and equal to the entrainment rate at cloud base. + do i = 1, im + if(cnvflg(i)) then + xlamud(i) = xlamue(i,kbcon(i)) + endif + enddo +! +! determine updraft mass flux for the subcloud layers +! +!> - Calculate the normalized mass flux for subcloud and in-cloud layers according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 1: +!! \f[ +!! \frac{1}{\eta}\frac{\partial \eta}{\partial z} = \lambda_e - \lambda_d +!! \f] +!! where \f$\eta\f$ is the normalized mass flux, \f$\lambda_e\f$ is the entrainment rate and \f$\lambda_d\f$ is the detrainment rate. The normalized mass flux increases upward below the cloud base and decreases upward above. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.kbcon(i).and.k.ge.kb(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k+1))-xlamud(i) + eta(i,k) = eta(i,k+1) / (1. + ptem * dz) + endif + endif + enddo + enddo +! +! compute mass flux above cloud base +! + do k = 2, km1 + do i = 1, im + if(cnvflg(i))then + if(k.gt.kbcon(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k-1))-xlamud(i) + eta(i,k) = eta(i,k-1) * (1 + ptem * dz) + endif + endif + enddo + enddo +! +! compute updraft cloud property +! +!> - Set initial cloud properties equal to the state variables at cloud base. + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + ucko(i,indx) = uo(i,indx) + vcko(i,indx) = vo(i,indx) + endif + enddo +! +!> - Calculate the cloud properties as a parcel ascends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . Following Han and Pan (2006) \cite han_and_pan_2006, the convective momentum transport is reduced by the convection-induced pressure gradient force by the constant "pgcon", currently set to 0.55 after Zhang and Wu (2003) \cite zhang_and_wu_2003 . + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + ptem = 0.5 * tem + pgcon + ptem1= 0.5 * tem - pgcon + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + ucko(i,k) = ((1.-tem1)*ucko(i,k-1)+ptem*uo(i,k) + & +ptem1*uo(i,k-1))/factor + vcko(i,k) = ((1.-tem1)*vcko(i,k-1)+ptem*vo(i,k) + & +ptem1*vo(i,k-1))/factor + dbyo(i,k) = hcko(i,k) - heso(i,k) + endif + endif + enddo + enddo +! +! taking account into convection inhibition due to existence of +! dry layers below cloud base +! +!> - With entrainment, recalculate the LFC as the first level where buoyancy is positive. The difference in pressure levels between LFCs calculated with/without entrainment must be less than a threshold (currently 25 hPa). Otherwise, convection is inhibited and the scheme returns to the calling routine without modifying the state variables. This is the subcloud dryness trigger modification discussed in Han and Pan (2011) \cite han_and_pan_2011. + do i=1,im + flg(i) = cnvflg(i) + kbcon1(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kbm(i)) then + if(k.ge.kbcon(i).and.dbyo(i,k).gt.0.) then + kbcon1(i) = k + flg(i) = .false. + endif + endif + enddo + enddo + do i=1,im + if(cnvflg(i)) then + if(kbcon1(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo + do i=1,im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i)) - pfld(i,kbcon1(i)) + if(tem.gt.dthk) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine first guess cloud top as the level of zero buoyancy +! limited to the level of sigma=0.7 +! +!> - Calculate the cloud top as the first level where parcel buoyancy becomes negative; the maximum possible value is at \f$p=0.7p_{sfc}\f$. + do i = 1, im + flg(i) = cnvflg(i) + if(flg(i)) ktcon(i) = kbm(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k .lt. kbm(i)) then + if(k.gt.kbcon1(i).and.dbyo(i,k).lt.0.) then + ktcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! +! turn off shallow convection if cloud top is less than pbl top +! +! do i=1,im +! if(cnvflg(i)) then +! kk = kpbl(i)+1 +! if(ktcon(i).le.kk) cnvflg(i) = .false. +! endif +! enddo +!! +! totflg = .true. +! do i = 1, im +! totflg = totflg .and. (.not. cnvflg(i)) +! enddo +! if(totflg) return +!! +! +! specify upper limit of mass flux at cloud base +! +!> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. + do i = 1, im + if(cnvflg(i)) then +! xmbmax(i) = .1 +! + k = kbcon(i) + dp = 1000. * del(i,k) + xmbmax(i) = dp / (g * dt2) +! +! tem = dp / (g * dt2) +! xmbmax(i) = min(tem, xmbmax(i)) + endif + enddo +! +! compute cloud moisture property and precipitation +! +!> - Initialize the cloud moisture at cloud base and set the cloud work function to zero. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = 0. + qcko(i,kb(i)) = qo(i,kb(i)) + qrcko(i,kb(i)) = qo(i,kb(i)) + endif + enddo +!> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. Above the level of minimum moist static energy, some of the cloud water is detrained into the grid-scale cloud water from every cloud layer with a rate of 0.0005 \f$m^{-1}\f$ (dellal). + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +!j + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +!j + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! +! below lfc check if there is excess moisture to release latent heat +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0.) then + dp = 1000. * del(i,k) + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + aa1(i) = aa1(i) - dz * g * qlk + qcko(i,k)= qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! calculate cloud work function +! +!> - Calculate the cloud work function according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 4: +!! \f[ +!! A_u=\int_{z_0}^{z_t}\frac{g}{c_pT(z)}\frac{\eta}{1 + \gamma}[h(z)-h^*(z)]dz +!! \f] +!! (discretized according to Grell (1993) \cite grell_1993 equation B.10 using B.2 and B.3 of Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 and assuming \f$\eta=1\f$) where \f$A_u\f$ is the updraft cloud work function, \f$z_0\f$ and \f$z_t\f$ are cloud base and cloud top, respectively, \f$\gamma = \frac{L}{c_p}\left(\frac{\partial \overline{q_s}}{\partial T}\right)_p\f$ and other quantities are previously defined. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.kbcon(i).and.k.lt.ktcon(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + val = 0. + aa1(i)=aa1(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +!> - If the updraft cloud work function is negative, convection does not occur, and the scheme returns to the calling routine. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! estimate the onvective overshooting as the level +! where the [aafac * cloud work function] becomes zero, +! which is the final cloud top +! limited to the level of sigma=0.7 +! +!> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. Overshooting is also limited to the level where \f$p=0.7p_{sfc}\f$. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = aafac * aa1(i) + endif + enddo +! + do i = 1, im + flg(i) = cnvflg(i) + ktcon1(i) = kbm(i) + enddo + do k = 2, km1 + do i = 1, im + if (flg(i)) then + if(k.ge.ktcon(i).and.k.lt.kbm(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + if(aa1(i).lt.0.) then + ktcon1(i) = k + flg(i) = .false. + endif + endif + endif + enddo + enddo +! +! compute cloud moisture property, detraining cloud water +! and precipitation in overshooting layers +! +!> - For the overshooting convection, calculate the moisture content of the entraining/detraining parcel as before. Partition convective cloud water and precipitation and detrain convective cloud water in the overshooting layers. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.ktcon(i).and.k.lt.ktcon1(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +!j + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +!j + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0.) then + dp = 1000. * del(i,k) + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! exchange ktcon with ktcon1 +! + do i = 1, im + if(cnvflg(i)) then + kk = ktcon(i) + ktcon(i) = ktcon1(i) + ktcon1(i) = kk + endif + enddo +! +! this section is ready for cloud water +! + if(ncloud.gt.0) then +! +! compute liquid and vapor separation at cloud top +! +!> - => Separate the total updraft cloud water at cloud top into vapor and condensate. + do i = 1, im + if(cnvflg(i)) then + k = ktcon(i) - 1 + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) + dq = qcko(i,k) - qrch +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + qlko_ktcon(i) = dq + qcko(i,k) = qrch + endif + endif + enddo + endif +! +!--- compute precipitation efficiency in terms of windshear +! +!! - Calculate the wind shear and precipitation efficiency according to equation 58 in Fritsch and Chappell (1980) \cite fritsch_and_chappell_1980 : +!! \f[ +!! E = 1.591 - 0.639\frac{\Delta V}{\Delta z} + 0.0953\left(\frac{\Delta V}{\Delta z}\right)^2 - 0.00496\left(\frac{\Delta V}{\Delta z}\right)^3 +!! \f] +!! where \f$\Delta V\f$ is the integrated horizontal shear over the cloud depth, \f$\Delta z\f$, (the ratio is converted to units of \f$10^{-3} s^{-1}\f$). The variable "edt" is \f$1-E\f$ and is constrained to the range \f$[0,0.9]\f$. + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 0. + endif + enddo + do k = 2, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + shear= sqrt((uo(i,k)-uo(i,k-1)) ** 2 + & + (vo(i,k)-vo(i,k-1)) ** 2) + vshear(i) = vshear(i) + shear + endif + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 1.e3 * vshear(i) / (zi(i,ktcon(i))-zi(i,kb(i))) + e1=1.591-.639*vshear(i) + & +.0953*(vshear(i)**2)-.00496*(vshear(i)**3) + edt(i)=1.-e1 + val = .9 + edt(i) = min(edt(i),val) + val = .0 + edt(i) = max(edt(i),val) + endif + enddo +! +!--- what would the change be, that a cloud with unit mass +!--- will do to the environment? +! +!> ## Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. +!> - Calculate the change in moist static energy, moisture mixing ratio, and horizontal winds per unit cloud base mass flux for all layers below cloud top from equations B.14 and B.15 from Grell (1993) \cite grell_1993, and for the cloud top from B.16 and B.17. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + dellah(i,k) = 0. + dellaq(i,k) = 0. + dellau(i,k) = 0. + dellav(i,k) = 0. + endif + enddo + enddo +! +!--- changed due to subsidence and entrainment +! + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dp = 1000. * del(i,k) + dz = zi(i,k) - zi(i,k-1) +! + dv1h = heo(i,k) + dv2h = .5 * (heo(i,k) + heo(i,k-1)) + dv3h = heo(i,k-1) + dv1q = qo(i,k) + dv2q = .5 * (qo(i,k) + qo(i,k-1)) + dv3q = qo(i,k-1) + dv1u = uo(i,k) + dv2u = .5 * (uo(i,k) + uo(i,k-1)) + dv3u = uo(i,k-1) + dv1v = vo(i,k) + dv2v = .5 * (vo(i,k) + vo(i,k-1)) + dv3v = vo(i,k-1) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) + tem1 = xlamud(i) +!j + dellah(i,k) = dellah(i,k) + + & ( eta(i,k)*dv1h - eta(i,k-1)*dv3h + & - tem*eta(i,k-1)*dv2h*dz + & + tem1*eta(i,k-1)*.5*(hcko(i,k)+hcko(i,k-1))*dz + & ) *g/dp +!j + dellaq(i,k) = dellaq(i,k) + + & ( eta(i,k)*dv1q - eta(i,k-1)*dv3q + & - tem*eta(i,k-1)*dv2q*dz + & + tem1*eta(i,k-1)*.5*(qrcko(i,k)+qcko(i,k-1))*dz + & ) *g/dp +!j + dellau(i,k) = dellau(i,k) + + & ( eta(i,k)*dv1u - eta(i,k-1)*dv3u + & - tem*eta(i,k-1)*dv2u*dz + & + tem1*eta(i,k-1)*.5*(ucko(i,k)+ucko(i,k-1))*dz + & - pgcon*eta(i,k-1)*(dv1u-dv3u) + & ) *g/dp +!j + dellav(i,k) = dellav(i,k) + + & ( eta(i,k)*dv1v - eta(i,k-1)*dv3v + & - tem*eta(i,k-1)*dv2v*dz + & + tem1*eta(i,k-1)*.5*(vcko(i,k)+vcko(i,k-1))*dz + & - pgcon*eta(i,k-1)*(dv1v-dv3v) + & ) *g/dp +!j + endif + endif + enddo + enddo +! +!------- cloud top +! + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) + dp = 1000. * del(i,indx) + dv1h = heo(i,indx-1) + dellah(i,indx) = eta(i,indx-1) * + & (hcko(i,indx-1) - dv1h) * g / dp + dv1q = qo(i,indx-1) + dellaq(i,indx) = eta(i,indx-1) * + & (qcko(i,indx-1) - dv1q) * g / dp + dv1u = uo(i,indx-1) + dellau(i,indx) = eta(i,indx-1) * + & (ucko(i,indx-1) - dv1u) * g / dp + dv1v = vo(i,indx-1) + dellav(i,indx) = eta(i,indx-1) * + & (vcko(i,indx-1) - dv1v) * g / dp +! +! cloud water +! + dellal(i,indx) = eta(i,indx-1) * + & qlko_ktcon(i) * g / dp + endif + enddo +! +! mass flux at cloud base for shallow convection +! (grant, 2001) +! +!> - Calculate the cloud base mass flux according to equation 6 in Grant (2001) \cite grant_2001, based on the subcloud layer convective velocity scale, \f$w_*\f$. +!! \f[ +!! M_c = 0.03\rho w_* +!! \f] +!! where \f$M_c\f$ is the cloud base mass flux, \f$\rho\f$ is the air density, and \f$w_*=\left(\frac{g}{T_0}\overline{w'\theta_v'}h\right)^{1/3}\f$ with \f$h\f$ the PBL height and other quantities have been defined previously. + do i= 1, im + if(cnvflg(i)) then + k = kbcon(i) +! ptem = g*sflx(i)*zi(i,k)/t1(i,1) + ptem = g*sflx(i)*hpbl(i)/t1(i,1) + wstar(i) = ptem**h1 + tem = po(i,k)*100. / (rd*t1(i,k)) + xmb(i) = betaw*tem*wstar(i) + xmb(i) = min(xmb(i),xmbmax(i)) + endif + enddo +!> ## For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! - Recalculate saturation specific humidity. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> - Calculate the temperature tendency from the moist static energy and specific humidity tendencies. +!> - Update the temperature, specific humidity, and horiztonal wind state variables by multiplying the cloud base mass flux-normalized tendencies by the cloud base mass flux. +!> - Accumulate column-integrated tendencies. + do i = 1, im + delhbar(i) = 0. + delqbar(i) = 0. + deltbar(i) = 0. + delubar(i) = 0. + delvbar(i) = 0. + qcond(i) = 0. + enddo + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 + q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 +! tem = 1./rcs(i) +! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem +! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem + u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 + v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 + dp = 1000. * del(i,k) + delhbar(i) = delhbar(i) + dellah(i,k)*xmb(i)*dp/g + delqbar(i) = delqbar(i) + dellaq(i,k)*xmb(i)*dp/g + deltbar(i) = deltbar(i) + dellat*xmb(i)*dp/g + delubar(i) = delubar(i) + dellau(i,k)*xmb(i)*dp/g + delvbar(i) = delvbar(i) + dellav(i,k)*xmb(i)*dp/g + endif + endif + enddo + enddo +!> - Recalculate saturation specific humidity using the updated temperature. + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + endif + enddo + enddo +! +!> - Add up column-integrated convective precipitation by multiplying the normalized value by the cloud base mass flux. + do i = 1, im + rntot(i) = 0. + delqev(i) = 0. + delq2(i) = 0. + flg(i) = cnvflg(i) + enddo + do k = km, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.ktcon(i).and.k.gt.kb(i)) then + rntot(i) = rntot(i) + pwo(i,k) * xmb(i) * .001 * dt2 + endif + endif + enddo + enddo +! +! evaporating rain +! +!> - Determine the evaporation of the convective precipitation and update the integrated convective precipitation. +!> - Update state temperature and moisture to account for evaporation of convective precipitation. +!> - Update column-integrated tendencies to account for evaporation of convective precipitation. + do k = km, 1, -1 + do i = 1, im + if (k .le. kmax(i)) then + deltv(i) = 0. + delq(i) = 0. + qevap(i) = 0. + if(cnvflg(i)) then + if(k.lt.ktcon(i).and.k.gt.kb(i)) then + rn(i) = rn(i) + pwo(i,k) * xmb(i) * .001 * dt2 + endif + endif + if(flg(i).and.k.lt.ktcon(i)) then + evef = edt(i) * evfact + if(islimsk(i) == 1) evef=edt(i) * evfactl +! if(islimsk(i) == 1) evef=.07 +! if(islimsk(i) == 1) evef = 0. + qcond(i) = evef * (q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + dp = 1000. * del(i,k) + if(rn(i).gt.0..and.qcond(i).lt.0.) then + qevap(i) = -qcond(i) * (1.-exp(-.32*sqrt(dt2*rn(i)))) + qevap(i) = min(qevap(i), rn(i)*1000.*g/dp) + delq2(i) = delqev(i) + .001 * qevap(i) * dp / g + endif + if(rn(i).gt.0..and.qcond(i).lt.0..and. + & delq2(i).gt.rntot(i)) then + qevap(i) = 1000.* g * (rntot(i) - delqev(i)) / dp + flg(i) = .false. + endif + if(rn(i).gt.0..and.qevap(i).gt.0.) then + tem = .001 * dp / g + tem1 = qevap(i) * tem + if(tem1.gt.rn(i)) then + qevap(i) = rn(i) / tem + rn(i) = 0. + else + rn(i) = rn(i) - tem1 + endif + q1(i,k) = q1(i,k) + qevap(i) + t1(i,k) = t1(i,k) - elocp * qevap(i) + deltv(i) = - elocp*qevap(i)/dt2 + delq(i) = + qevap(i)/dt2 + delqev(i) = delqev(i) + .001*dp*qevap(i)/g + endif + dellaq(i,k) = dellaq(i,k) + delq(i) / xmb(i) + delqbar(i) = delqbar(i) + delq(i)*dp/g + deltbar(i) = deltbar(i) + deltv(i)*dp/g + endif + endif + enddo + enddo +!j +! do i = 1, im +! if(me.eq.31.and.cnvflg(i)) then +! if(cnvflg(i)) then +! print *, ' shallow delhbar, delqbar, deltbar = ', +! & delhbar(i),hvap*delqbar(i),cp*deltbar(i) +! print *, ' shallow delubar, delvbar = ',delubar(i),delvbar(i) +! print *, ' precip =', hvap*rn(i)*1000./dt2 +! print*,'pdif= ',pfld(i,kbcon(i))-pfld(i,ktcon(i)) +! endif +! enddo +!j + do i = 1, im + if(cnvflg(i)) then + if(rn(i).lt.0..or..not.flg(i)) rn(i) = 0. + ktop(i) = ktcon(i) + kbot(i) = kbcon(i) + kcnv(i) = 0 + endif + enddo +! +! convective cloud water +! +!> - Calculate shallow convective cloud water. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo + +! +! convective cloud cover +! +!> - Calculate shallow convective cloud cover. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvc(i,k) = 0.04 * log(1. + 675. * eta(i,k) * xmb(i)) + cnvc(i,k) = min(cnvc(i,k), 0.2) + cnvc(i,k) = max(cnvc(i,k), 0.0) + endif + endif + enddo + enddo + +! +! cloud water +! +!> - Separate detrained cloud water into liquid and ice species as a function of temperature only. + if (ncloud.gt.0) then +! + do k = 1, km1 + do i = 1, im + if (cnvflg(i)) then + if (k.gt.kb(i).and.k.le.ktcon(i)) then + tem = dellal(i,k) * xmb(i) * dt2 + tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) + if (qlc(i,k) .gt. -999.0) then + qli(i,k) = qli(i,k) + tem * tem1 ! ice + qlc(i,k) = qlc(i,k) + tem *(1.0-tem1) ! water + else + qli(i,k) = qli(i,k) + tem + endif + endif + endif + enddo + enddo +! + endif +! +! hchuang code change +! +!> - Calculate the updraft shallow convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i)) then + if(k.ge.kb(i) .and. k.lt.ktop(i)) then + ud_mf(i,k) = eta(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +!> - Calculate the detrainment mass flux at shallow cloud top. + do i = 1, im + if(cnvflg(i)) then + k = ktop(i)-1 + dt_mf(i,k) = ud_mf(i,k) + endif + enddo +!! + return + + end subroutine shalcnv_run + + end module shalcnv +!> @} +!! @} diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta new file mode 100644 index 000000000..a8f8a8ba3 --- /dev/null +++ b/physics/shalcnv.meta @@ -0,0 +1,466 @@ +[ccpp-arg-table] + name = shalcnv_init + type = scheme +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[shal_cnv] + standard_name = flag_for_shallow_convection + long_name = flag for calling shallow convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_sas] + standard_name = flag_for_sas_shallow_convection_scheme + long_name = flag for SAS shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = shalcnv_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = shalcnv_run + type = scheme +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal_dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[jcap] + standard_name = number_of_spectral_wave_trancation_for_sas + long_name = number of spectral wave trancation used only by sascnv and shalcnv + units = count + dimensions = () + type = integer + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qlc] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qli] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rn] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = pbl height + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clam] + standard_name = entrainment_rate_coefficient_shallow_convection + long_name = entrainment rate coefficient for shallow convection + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0] + standard_name = rain_conversion_parameter_shallow_convection + long_name = convective rain conversion parameter for shallow convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_shallow_convection + long_name = convective detrainment conversion parameter for shallow convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_shallow_convection + long_name = reduction factor in momentum transport due to shallow convection induced pressure gradient force + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/tridi.f b/physics/tridi.f index 5ffcc4686..22a35ea9c 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -38,7 +38,9 @@ subroutine tridi1(l,n,cl,cm,cu,r1,au,a1) enddo ! return - end + end subroutine tridi1 + +c----------------------------------------------------------------------- !>\ingroup satmedmf !> This subroutine .. subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) @@ -78,7 +80,7 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) enddo c----------------------------------------------------------------------- return - end + end subroutine tridi2 c----------------------------------------------------------------------- !>\ingroup satmedmf @@ -148,4 +150,66 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) enddo c----------------------------------------------------------------------- return - end + end subroutine tridin + +c----------------------------------------------------------------------- +!>\ingroup satmedmf +!! This subroutine solves tridiagonal problem for TKE. + subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) +!----------------------------------------------------------------------- +!! + use machine , only : kind_phys + implicit none + integer is,k,kk,n,nt,l,i + real(kind=kind_phys) fk(l) +!! + real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & + & rt(l,n*nt), & + & au(l,n-1), at(l,n*nt), & + & fkk(l,2:n-1) +!----------------------------------------------------------------------- + do i=1,l + fk(i) = 1./cm(i,1) + au(i,1) = fk(i)*cu(i,1) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + at(i,1+is) = fk(i) * rt(i,1+is) + enddo + enddo + do k=2,n-1 + do i=1,l + fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fkk(i,k)*cu(i,k) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=2,n-1 + do i=1,l + at(i,k+is) = fkk(i,k)*(rt(i,k+is)-cl(i,k)*at(i,k+is-1)) + enddo + enddo + enddo + do i=1,l + fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + at(i,n+is) = fk(i)*(rt(i,n+is)-cl(i,n)*at(i,n+is-1)) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=n-1,1,-1 + do i=1,l + at(i,k+is) = at(i,k+is) - au(i,k)*at(i,k+is+1) + enddo + enddo + enddo +!----------------------------------------------------------------------- + return + end subroutine tridit +!> @}