diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 index a335f56a4..ae035b5b9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 @@ -5,7 +5,7 @@ module GFS_rrtmgp_cloud_mp use machine, only: kind_phys use radiation_tools, only: check_error_msg - use module_radiation_clouds, only: progcld_thompson + use module_radiation_clouds, only: progcld_thompson, cld_frac_XuRandall use rrtmgp_lw_cloud_optics, only: & radliq_lwr => radliq_lwrLW, radliq_upr => radliq_uprLW,& radice_lwr => radice_lwrLW, radice_upr => radice_uprLW @@ -371,9 +371,9 @@ subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) if(qi > 1.E-8) cld_cnv_reice(iCol,iLay) = max(173.45 + 2.14*(t_lay(iCol,iLay)-273.15), 20.) - ! Xu-Randall (1996) cloud-fraction. - cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & - qs_lay(iCol,iLay), relhum(iCol,iLay), qc+qi, alpha0) + ! Xu-Randall (1996) cloud-fraction, lambda = 0.5 + cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay)*0.01, & + qs_lay(iCol,iLay), relhum(iCol,iLay), qc+qi, alpha0, 0.5, 1.0) endif enddo enddo @@ -503,9 +503,10 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, cld_cnv_reliq(iCol,iLay) = reliq_def cld_cnv_reice(iCol,iLay) = reice_def - ! Xu-Randall (1996) cloud-fraction. - cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & - qs_lay(iCol,iLay), relhum(iCol,iLay), cnv_mixratio(iCol,iLay), alpha0) + ! Xu-Randall (1996) cloud-fraction, lambda = 0.5 + cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay)*0.01, & + qs_lay(iCol,iLay), relhum(iCol,iLay), cnv_mixratio(iCol,iLay), & + alpha0, 0.5, 1.0) endif enddo enddo @@ -738,10 +739,12 @@ subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_c cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1 * deltaP) ! Xu-Randall (1996) cloud-fraction. **Additionally, Conditioned on relative-humidity** + ! lambda = 0.5 cld_mr = cld_condensate(iCol,iLay,1) + cld_condensate(iCol,iLay,2) + & cld_condensate(iCol,iLay,3) + cld_condensate(iCol,iLay,4) - cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & - qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0, cond_cfrac_onRH) + cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay)*0.01, & + qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0, & + 0.5, 1.0, cond_cfrac_onRH) enddo enddo @@ -769,52 +772,6 @@ subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_c end subroutine cloud_mp_thompson -!> This function computes the cloud-fraction following -!! Xu-Randall(1996) \cite xu_and_randall_1996 -!! - function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha, cond_cfrac_onRH) - implicit none - ! Inputs - logical, intent(in), optional :: & - cond_cfrac_onRH ! If true, cloud-fracion set to unity when rh>99% - - real(kind_phys), intent(in) :: & - p_lay, & !< Pressure (Pa) - qs_lay, & !< Saturation vapor-pressure (Pa) - relhum, & !< Relative humidity - cld_mr, & !< Total cloud mixing ratio - alpha !< Scheme parameter (default=100) - - ! Outputs - real(kind_phys) :: cld_frac_XuRandall - - ! Locals - real(kind_phys) :: clwt, clwm, onemrh, tem1, tem2, tem3 - - ! Parameters - real(kind_phys) :: & - lambda = 0.50, & ! - P = 0.25 - - clwt = 1.0e-8 * (p_lay*0.001) - if (cld_mr > clwt) then - if(present(cond_cfrac_onRH) .and. relhum > 0.99) then - cld_frac_XuRandall = 1. - else - onemrh = max(1.e-10, 1.0 - relhum) - tem1 = alpha / min(max((onemrh*qs_lay)**lambda,0.0001),1.0) - tem2 = max(min(tem1*(cld_mr - clwt), 50.0 ), 0.0 ) - tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p - ! - cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) - endif - else - cld_frac_XuRandall = 0.0 - endif - - return - end function - !> This routine is a wrapper to update the Thompson effective particle sizes used by the !! RRTMGP radiation scheme. subroutine cmp_reff_Thompson(nLev, nCol, i_cldliq, i_cldice, i_cldsnow, i_cldice_nc, & diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index d779d56c2..54c673e91 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -44,8 +44,6 @@ ! clds,mtop,mbot,de_lgth,alpha) ! ! ! ! internal/external accessable subroutines: ! -! 'progcld_zhao_carr' --- zhao/moorthi prognostic cloud scheme ! -! 'progcld_zhao_carr_pdf' --- zhao/moorthi prognostic cloud + pdfcld ! ! 'progcld_gfdl_lin' --- GFDL-Lin cloud microphysics ! ! 'progcld_fer_hires' --- Ferrier-Aligo cloud microphysics ! ! 'progcld_thompson_wsm6' --- Thompson/wsm6 cloud microphysics (EMC) ! @@ -226,8 +224,7 @@ module module_radiation_clouds & 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, & & 205.728, 214.055, 222.694, 231.661, 240.971, 250.639/) - public progcld_zhao_carr, progcld_zhao_carr_pdf, & - & progcld_gfdl_lin, progclduni, progcld_fer_hires, & + public progcld_gfdl_lin, progclduni, progcld_fer_hires, & & cld_init, radiation_clouds_prop, & & progcld_thompson_wsm6, progcld_thompson, cal_cldfra3, & & find_cloudLayers, adjust_cloudIce, adjust_cloudH2O, & @@ -242,8 +239,6 @@ module module_radiation_clouds !!\param si model vertical sigma layer interface !!\param NLAY vertical layer number !!\param imp_physics cloud microphysics scheme control flag -!!\n =99: Zhao-Carr/Sundqvist microphysics cloud -!!\n =98: Zhao-Carr/Sundqvist microphysics cloud = pdfcld !!\n =11: GFDL microphysics cloud !!\n =8: Thompson microphysics !!\n =6: WSM6 microphysics @@ -302,11 +297,7 @@ subroutine cld_init & if (me == 0) then print *, VTAGCLD !print out version tag print *,' - Using Prognostic Cloud Method' - if (imp_physics == 99) then - print *,' --- Zhao/Carr/Sundqvist microphysics' - elseif (imp_physics == 98) then - print *,' --- zhao/carr/sundqvist + pdf cloud' - elseif (imp_physics == 11) then + if (imp_physics == 11) then print *,' --- GFDL Lin cloud microphysics' elseif (imp_physics == 8) then print *,' --- Thompson cloud microphysics' @@ -379,8 +370,6 @@ subroutine radiation_clouds_prop & ! ! ! subprograms called: ! ! ! -! 'progcld_zhao_carr' --- zhao/moorthi prognostic cloud scheme ! -! 'progcld_zhao_carr_pdf' --- zhao/moorthi prognostic cloud + pdfcld ! ! 'progcld_gfdl_lin' --- GFDL-Lin cloud microphysics ! ! 'progcld_fer_hires' --- Ferrier-Aligo cloud microphysics ! ! 'progcld_thompson_wsm6' --- Thompson/wsm6 cloud microphysics (EMC) ! @@ -618,9 +607,8 @@ subroutine radiation_clouds_prop & end do end do - if (imp_physics == imp_physics_zhao_carr .or. & - & imp_physics == imp_physics_mg) then ! zhao/moorthi's p - ! or unified cloud and/or with MG microphysics + if (imp_physics == imp_physics_mg) then ! + ! unified cloud and/or with MG microphysics if (uni_cld .and. ncndl >= 2) then call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs @@ -632,30 +620,8 @@ subroutine radiation_clouds_prop & & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs & cld_reice,cld_rwp, cld_rerain,cld_swp, & & cld_resnow) - else - call progcld_zhao_carr (plyr ,plvl, tlyr, tvly, qlyr, & ! --- inputs - & qstl, rhly, ccnd(1:IX,1:NLAY,1), xlat, xlon, & - & slmsk, dz, delp, IX, NLAY, NLP1, uni_cld, & - & lmfshal, lmfdeep2, xr_con, xr_exp, & - & cldcov, effrl, effri, effrr, effrs, effr_in, & - & dzlay, & - & cldtot, cldcnv, lcrick, lcnorm, con_ttp, & ! inout - & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, & - & cld_resnow) endif - elseif(imp_physics == imp_physics_zhao_carr_pdf) then ! zhao/moorthi's prognostic cloud+pdfcld - - call progcld_zhao_carr_pdf (plyr, plvl, tlyr, tvly, qlyr, & ! --- inputs - & qstl, rhly, ccnd(1:IX,1:NLAY,1), cnvw, cnvc, & - & xlat, xlon, slmsk, dz, delp, IX, NLAY, NLP1, & - & deltaq, sup, kdt, me, dzlay, & - & cldtot, cldcnv, lcrick, lcnorm, con_thgni, & ! inout - & con_ttp, cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, & - & cld_resnow) - elseif (imp_physics == imp_physics_gfdl) then ! GFDL cloud scheme if (.not. lgfdlmprad) then @@ -756,715 +722,128 @@ subroutine radiation_clouds_prop & & cldcov(:,1:LM), effrl, effri, effrs, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, gridkm, top_at_1, & - & cldtot, cldcnv, & ! inout - & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, & - & cld_resnow) - else - - !-- MYNN PBL or convective GF - !-- use cloud fractions with SGS clouds - do k=1,NLAY - do i=1,IX - cld_frac(i,k) = clouds1(i,k) - enddo - enddo - - ! --- use clduni as with the GFDL microphysics. - ! --- make sure that effr_in=.true. in the input.nml! - call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - & xlat, xlon, slmsk, dz, delp, IX, NLAY, NLP1, & - & cld_frac, & - & effrl, effri, effrr, effrs, effr_in , & - & dzlay, & - & cldtot, cldcnv, lcrick, lcnorm, con_ttp, & ! inout - & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, & - & cld_resnow) - endif - - else - ! MYNN PBL or GF convective are not used - - if (icloud == 3) then - call progcld_thompson (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs - & tracer1,xlat,xlon,slmsk,dz,delp, & - & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1, & - & IX, LM, NLP1, uni_cld, lmfshal, lmfdeep2, & - & cldcov(:,1:LM), effrl, effri, effrs, & - & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & - & dzlay, gridkm, top_at_1, & - & cldtot, cldcnv, & ! inout - & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, & - & cld_resnow) - - else - call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs - & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & - & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & - & IX, NLAY, NLP1, xr_con, xr_exp, uni_cld, & - & lmfshal, lmfdeep2, & - & cldcov(:,1:NLAY), cnvw, effrl, effri, effrs, & - & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & - & dzlay, & - & cldtot, cldcnv, lcnorm, & ! inout - & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, & - & cld_resnow) - endif - endif ! MYNN PBL or GF - - endif ! end if_imp_physics - -!> - Compute SFC/low/middle/high cloud top pressure for each cloud -!! domain for given latitude. -! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; -! --- i=1,2 are low-lat (<45 degree) and pole regions) - - do i =1, IX - rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range -! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range - enddo - - do id = 1, 4 - tem1 = ptopc(id,2) - ptopc(id,1) - - do i =1, IX - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) - enddo - enddo - - ! Compute cloud decorrelation length - if (idcor == idcor_hogan) then - call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) - endif - if (idcor == idcor_oreopoulos) then - call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) - endif - if (idcor == idcor_con) then - de_lgth(:) = dcorr_con - endif - - ! Call subroutine get_alpha_exper to define alpha parameter for exponential cloud overlap options - if ( iovr == iovr_dcorr .or. iovr == iovr_exp & - & .or. iovr == iovr_exprand) then - call get_alpha_exper(ix, nLay, iovr, iovr_exprand, dzlay, & - & de_lgth, cld_frac, alpha) - else - de_lgth(:) = 0. - alpha(:,:) = 0. - endif - -!> - Call gethml() to compute low,mid,high,total, and boundary layer -!! cloud fractions and clouds top/bottom layer indices for low, mid, -!! and high clouds. -! --- compute low, mid, high, total, and boundary layer cloud fractions -! and clouds top/bottom layer indices for low, mid, and high clouds. -! The three cloud domain boundaries are defined by ptopc. The cloud -! overlapping method is defined by control flag 'iovr', which may -! be different for lw and sw radiation programs. - - call gethml & -! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & - & IX, NLAY, iovr, iovr_rand, iovr_maxrand, iovr_max, & - & iovr_dcorr, iovr_exp, iovr_exprand, top_at_1, si, & -! --- outputs: - & clds, mtop, mbot & - & ) - -!................................... - end subroutine radiation_clouds_prop - -!> This subroutine computes cloud related quantities using -!! zhao/moorthi's prognostic cloud microphysics scheme. -!>\section progcld_zhao_carr General Algorithm - subroutine progcld_zhao_carr & - & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, & - & uni_cld, lmfshal, lmfdeep2, xr_con, xr_exp, cldcov, & - & effrl,effri,effrr,effrs,effr_in, & - & dzlay, cldtot, cldcnv, lcrick, lcnorm, con_ttp, & - & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & - & ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: progcld_zhao_carr computes cloud related quantities using ! -! zhao/moorthi's prognostic cloud microphysics scheme. ! -! ! -! abstract: this program computes cloud fractions from cloud ! -! condensates, calculates liquid/ice cloud droplet effective radius, ! -! and computes the low, mid, high, total and boundary layer cloud ! -! fractions and the vertical indices of low, mid, and high cloud ! -! top and base. the three vertical cloud domains are set up in the ! -! initial subroutine "cld_init". ! -! ! -! usage: call progcld_zhao_carr ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! input variables: ! -! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! -! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! -! tlyr (IX,NLAY) : model layer mean temperature in k ! -! tvly (IX,NLAY) : model layer virtual temperature in k ! -! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! -! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! -! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! -! clw (IX,NLAY) : layer cloud condensate amount ! -! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! -! range, otherwise see in-line comment ! -! xlon (IX) : grid longitude in radians (not used) ! -! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! -! dz (ix,nlay) : layer thickness (km) ! -! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! -! IX : horizontal dimention ! -! NLAY,NLP1 : vertical layer/level dimensions ! -! uni_cld : logical - true for cloud fraction from shoc ! -! lmfshal : logical - true for mass flux shallow convection ! -! lmfdeep2 : logical - true for mass flux deep convection ! -! cldcov : layer cloud fraction (used when uni_cld=.true. ! -! effrl : effective radius for liquid water -! effri : effective radius for ice water -! effrr : effective radius for rain water -! effrs : effective radius for snow water -! effr_in : logical, if .true. use input effective radii -! dzlay(ix,nlay) : thickness between model layer centers (km) ! -! lmfshal : mass-flux shallow conv scheme flag ! -! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! -! lcrick : control flag for eliminating CRICK ! -! =t: apply layer smoothing to eliminate CRICK ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! ! -! output variables: ! -! cloud profiles: ! -! cld_frac (:,:) - layer total cloud fraction ! -! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! -! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! -! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! -! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! -! cld_rwp (:,:) - layer rain drop water path not assigned ! -! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! -! *** cld_swp (:,:) - layer snow flake water path not assigned ! -! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! -! ! -! ==================== end of description ===================== ! -! - implicit none - -! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 - - logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, effr_in, & - & lcrick, lcnorm - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, cldcov, delp, dz, & - & effrl, effri, effrr, effrs, dzlay - - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk - real (kind=kind_phys), intent(in) :: con_ttp, xr_con, xr_exp - -! --- inputs/outputs - - real (kind=kind_phys), dimension(:,:), intent(inout) :: & - & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & - & cld_rwp, cld_rerain, cld_swp, cld_resnow - -! --- local variables: - real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2, tem3 - - integer :: i, k, id, nf - -! -!===> ... begin here -! -!> - Assgin liquid/ice/rain/snow cloud effective radius from input or predefined values. - if(effr_in) then - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = effrl (i,k) - rei (i,k) = effri (i,k) - rer (i,k) = effrr (i,k) - res (i,k) = effrs (i,k) - tem2d (i,k) = min(1.0, max(0.0,(con_ttp-tlyr(i,k))*0.05)) - clwf(i,k) = 0.0 - enddo - enddo - else - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = reliq_def ! default liq radius to 10 micron - rei (i,k) = reice_def ! default ice radius to 50 micron - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = rsnow_def ! default snow radius to 250 micron - tem2d (i,k) = min(1.0, max(0.0, (con_ttp-tlyr(i,k))*0.05)) - clwf(i,k) = 0.0 - enddo - enddo - endif -! - if ( lcrick ) then - do i = 1, IX - clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) - clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) - enddo - do k = 2, NLAY-1 - do i = 1, IX - clwf(i,K) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) - enddo - enddo - else - do k = 1, NLAY - do i = 1, IX - clwf(i,k) = clw(i,k) - enddo - enddo - endif - -!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - - do k = 1, NLAY - do i = 1, IX - clwt = max(0.0, clwf(i,k)) * gfac * delp(i,k) - cip(i,k) = clwt * tem2d(i,k) - cwp(i,k) = clwt - cip(i,k) - enddo - enddo - -!> - Compute effective liquid cloud droplet radius over land. - - if(.not. effr_in) then - do i = 1, IX - if (nint(slmsk(i)) == 1) then - do k = 1, NLAY - rew(i,k) = 5.0 + 5.0 * tem2d(i,k) - enddo - endif - enddo - endif - - if (uni_cld) then ! use unified sgs clouds generated outside - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = cldcov(i,k) - enddo - enddo - - else - -!> - Compute layer cloud fraction. - - - if (.not. lmfshal) then - call cloud_fraction_XuRandall & - & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) & ! --- outputs - else - call cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & - & qstl, & ! --- inputs - & cldtot ) - endif - - endif ! if (uni_cld) then - - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) < climit) then - cldtot(i,k) = 0.0 - cwp(i,k) = 0.0 - cip(i,k) = 0.0 - crp(i,k) = 0.0 - csp(i,k) = 0.0 - endif - enddo - enddo - - if ( lcnorm ) then - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) >= climit) then - tem1 = 1.0 / max(climit2, cldtot(i,k)) - cwp(i,k) = cwp(i,k) * tem1 - cip(i,k) = cip(i,k) * tem1 - crp(i,k) = crp(i,k) * tem1 - csp(i,k) = csp(i,k) * tem1 - endif - enddo - enddo - endif - -!> - Compute effective ice cloud droplet radius following Heymsfield -!! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. - - if(.not.effr_in) then - do k = 1, NLAY - do i = 1, IX - tem2 = tlyr(i,k) - con_ttp - - if (cip(i,k) > 0.0) then - tem3 = gord * cip(i,k) * plyr(i,k) / (delp(i,k)*tvly(i,k)) - - if (tem2 < -50.0) then - rei(i,k) = (1250.0/9.917) * tem3 ** 0.109 - elseif (tem2 < -40.0) then - rei(i,k) = (1250.0/9.337) * tem3 ** 0.08 - elseif (tem2 < -30.0) then - rei(i,k) = (1250.0/9.208) * tem3 ** 0.055 - else - rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 - endif -! rei(i,k) = max(20.0, min(rei(i,k), 300.0)) -! rei(i,k) = max(10.0, min(rei(i,k), 100.0)) - rei(i,k) = max(10.0, min(rei(i,k), 150.0)) -! rei(i,k) = max(5.0, min(rei(i,k), 130.0)) - endif - enddo - enddo - endif - -! - do k = 1, NLAY - do i = 1, IX - cld_frac(i,k) = cldtot(i,k) - cld_lwp(i,k) = cwp(i,k) - cld_reliq(i,k) = rew(i,k) - cld_iwp(i,k) = cip(i,k) - cld_reice(i,k) = rei(i,k) -! cld_rwp(i,k) = 0.0 - cld_rerain(i,k) = rer(i,k) -! cld_swp(i,k) = 0.0 - cld_resnow(i,k) = res(i,k) - enddo - enddo -! -!................................... - end subroutine progcld_zhao_carr -!----------------------------------- -!----------------------------------- - -!> This subroutine computes cloud related quantities using -!! zhao/moorthi's prognostic cloud microphysics scheme + pdfcld. -!>\section progcld_zhao_carr_pdf General Algorithm - subroutine progcld_zhao_carr_pdf & - & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: - & xlat,xlon,slmsk, dz, delp, & - & ix, nlay, nlp1, & - & deltaq,sup,kdt,me, & - & dzlay, cldtot, cldcnv, lcrick, lcnorm, con_thgni, con_ttp, & - & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs - & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & - & ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: progcld_zhao_carr_pdf computes cloud related quantities using ! -! zhao/moorthi's prognostic cloud microphysics scheme. ! -! ! -! abstract: this program computes cloud fractions from cloud ! -! condensates, calculates liquid/ice cloud droplet effective radius, ! -! and computes the low, mid, high, total and boundary layer cloud ! -! fractions and the vertical indices of low, mid, and high cloud ! -! top and base. the three vertical cloud domains are set up in the ! -! initial subroutine "cld_init". ! -! ! -! usage: call progcld_zhao_carr_pdf ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== defination of variables ==================== ! -! ! -! input variables: ! -! plyr (ix,nlay) : model layer mean pressure in mb (100pa) ! -! plvl (ix,nlp1) : model level pressure in mb (100pa) ! -! tlyr (ix,nlay) : model layer mean temperature in k ! -! tvly (ix,nlay) : model layer virtual temperature in k ! -! qlyr (ix,nlay) : layer specific humidity in gm/gm ! -! qstl (ix,nlay) : layer saturate humidity in gm/gm ! -! rhly (ix,nlay) : layer relative humidity (=qlyr/qstl) ! -! clw (ix,nlay) : layer cloud condensate amount ! -! xlat (ix) : grid latitude in radians, default to pi/2 -> -pi/2! -! range, otherwise see in-line comment ! -! xlon (ix) : grid longitude in radians (not used) ! -! slmsk (ix) : sea/land mask array (sea:0,land:1,sea-ice:2) ! -! dz (ix,nlay) : layer thickness (km) ! -! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! -! ix : horizontal dimention ! -! nlay,nlp1 : vertical layer/level dimensions ! -! cnvw (ix,nlay) : layer convective cloud condensate ! -! cnvc (ix,nlay) : layer convective cloud cover ! -! deltaq(ix,nlay) : half total water distribution width ! -! sup : supersaturation ! -! dzlay(ix,nlay) : thickness between model layer centers (km) ! -! lcrick : control flag for eliminating crick ! -! =t: apply layer smoothing to eliminate crick ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! ! -! output variables: ! -! cloud profiles: ! -! cld_frac (:,:) - layer total cloud fraction ! -! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! -! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! -! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! -! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! -! cld_rwp (:,:) - layer rain drop water path not assigned ! -! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! -! *** cld_swp (:,:) - layer snow flake water path not assigned ! -! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! -! ! -! ==================== end of description ===================== ! -! - implicit none - -! --- inputs - integer, intent(in) :: ix, nlay, nlp1,kdt - logical, intent(in) :: lcrick, lcnorm - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp, dzlay -! & tlyr, tvly, qlyr, qstl, rhly, clw, cnvw, cnvc -! real (kind=kind_phys), dimension(:,:), intent(in) :: deltaq - real (kind=kind_phys), intent(in) :: con_thgni, con_ttp - real (kind=kind_phys), dimension(:,:) :: deltaq, cnvw, cnvc - real (kind=kind_phys) qtmp,qsc,rhs - real (kind=kind_phys), intent(in) :: sup - real (kind=kind_phys), parameter :: epsq = 1.0e-12 - - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk - integer :: me - -! --- inputs/outputs - - real (kind=kind_phys), dimension(:,:), intent(inout) :: & - & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & - & cld_rwp, cld_rerain, cld_swp, cld_resnow - -! --- local variables: - real (kind=kind_phys), dimension(ix,nlay) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2, tem3 - - integer :: i, k, id, nf - -! -!===> ... begin here -! - do k = 1, nlay - do i = 1, ix - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = reliq_def ! default liq radius to 10 micron - rei (i,k) = reice_def ! default ice radius to 50 micron - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = rsnow_def ! default snow radius to 250 micron - tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) - clwf(i,k) = 0.0 - enddo - enddo -! - if ( lcrick ) then - do i = 1, ix - clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) - clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) - enddo - do k = 2, nlay-1 - do i = 1, ix - clwf(i,k) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) - enddo - enddo - else - do k = 1, nlay - do i = 1, ix - clwf(i,k) = clw(i,k) - enddo - enddo - endif - - if(kdt==1) then - do k = 1, nlay - do i = 1, ix - deltaq(i,k) = (1.-0.95)*qstl(i,k) - enddo - enddo - endif - -!> -# Calculate liquid/ice condensate path in \f$ g/m^2 \f$ + & cldtot, cldcnv, & ! inout + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) + else - do k = 1, nlay - do i = 1, ix - clwt = max(0.0,(clwf(i,k)+cnvw(i,k))) * gfac * delp(i,k) - cip(i,k) = clwt * tem2d(i,k) - cwp(i,k) = clwt - cip(i,k) - enddo - enddo + !-- MYNN PBL or convective GF + !-- use cloud fractions with SGS clouds + do k=1,NLAY + do i=1,IX + cld_frac(i,k) = clouds1(i,k) + enddo + enddo -!> -# Calculate effective liquid cloud droplet radius over land. + ! --- use clduni as with the GFDL microphysics. + ! --- make sure that effr_in=.true. in the input.nml! + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs + & xlat, xlon, slmsk, dz, delp, IX, NLAY, NLP1, & + & cld_frac, & + & effrl, effri, effrr, effrs, effr_in , & + & dzlay, & + & cldtot, cldcnv, lcrick, lcnorm, con_ttp, & ! inout + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) + endif - do i = 1, ix - if (nint(slmsk(i)) == 1) then - do k = 1, nlay - rew(i,k) = 5.0 + 5.0 * tem2d(i,k) - enddo - endif - enddo + else + ! MYNN PBL or GF convective are not used -!> -# Calculate layer cloud fraction. + if (icloud == 3) then + call progcld_thompson (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs + & tracer1,xlat,xlon,slmsk,dz,delp, & + & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + & ntsw-1,ntgl-1, & + & IX, LM, NLP1, uni_cld, lmfshal, lmfdeep2, & + & cldcov(:,1:LM), effrl, effri, effrs, & + & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & + & dzlay, gridkm, top_at_1, & + & cldtot, cldcnv, & ! inout + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) - do k = 1, nlay - do i = 1, ix - tem1 = tlyr(i,k) - 273.16 - if(tem1 < (con_thgni - 273.16)) then ! for pure ice, has to be consistent with gscond - qsc = sup * qstl(i,k) - rhs = sup else - qsc = qstl(i,k) - rhs = 1.0 + call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs + & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & + & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & + & IX, NLAY, NLP1, xr_con, xr_exp, uni_cld, & + & lmfshal, lmfdeep2, & + & cldcov(:,1:NLAY), cnvw, effrl, effri, effrs, & + & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & + & dzlay, & + & cldtot, cldcnv, lcnorm, & ! inout + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) endif - if(rhly(i,k) >= rhs) then - cldtot(i,k) = 1.0 - else - qtmp = qlyr(i,k) + clwf(i,k) - qsc - if(deltaq(i,k) > epsq) then -! if(qtmp <= -deltaq(i,k) .or. cwmik < epsq) then - if(qtmp <= -deltaq(i,k)) then - cldtot(i,k) = 0.0 - elseif(qtmp >= deltaq(i,k)) then - cldtot(i,k) = 1.0 - else - cldtot(i,k) = 0.5*qtmp/deltaq(i,k) + 0.5 - cldtot(i,k) = max(cldtot(i,k),0.0) - cldtot(i,k) = min(cldtot(i,k),1.0) - endif - else - if(qtmp > 0.) then - cldtot(i,k) = 1.0 - else - cldtot(i,k) = 0.0 - endif - endif - endif - cldtot(i,k) = cnvc(i,k) + (1-cnvc(i,k))*cldtot(i,k) - cldtot(i,k) = max(cldtot(i,k),0.) - cldtot(i,k) = min(cldtot(i,k),1.) + endif ! MYNN PBL or GF - enddo - enddo + endif ! end if_imp_physics - do k = 1, nlay - do i = 1, ix - if (cldtot(i,k) < climit) then - cldtot(i,k) = 0.0 - cwp(i,k) = 0.0 - cip(i,k) = 0.0 - crp(i,k) = 0.0 - csp(i,k) = 0.0 - endif - enddo +!> - Compute SFC/low/middle/high cloud top pressure for each cloud +!! domain for given latitude. +! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; +! --- i=1,2 are low-lat (<45 degree) and pole regions) + + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range enddo - if ( lcnorm ) then - do k = 1, nlay - do i = 1, ix - if (cldtot(i,k) >= climit) then - tem1 = 1.0 / max(climit2, cldtot(i,k)) - cwp(i,k) = cwp(i,k) * tem1 - cip(i,k) = cip(i,k) * tem1 - crp(i,k) = crp(i,k) * tem1 - csp(i,k) = csp(i,k) * tem1 - endif - enddo + do id = 1, 4 + tem1 = ptopc(id,2) - ptopc(id,1) + + do i =1, IX + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo + enddo + + ! Compute cloud decorrelation length + if (idcor == idcor_hogan) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == idcor_oreopoulos) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == idcor_con) then + de_lgth(:) = dcorr_con endif -!> -# Calculate effective ice cloud droplet radius following Heymsfield -!! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. - - do k = 1, nlay - do i = 1, ix - tem2 = tlyr(i,k) - con_ttp + ! Call subroutine get_alpha_exper to define alpha parameter for exponential cloud overlap options + if ( iovr == iovr_dcorr .or. iovr == iovr_exp & + & .or. iovr == iovr_exprand) then + call get_alpha_exper(ix, nLay, iovr, iovr_exprand, dzlay, & + & de_lgth, cld_frac, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. + endif - if (cip(i,k) > 0.0) then -! tem3 = gord * cip(i,k) * (plyr(i,k)/delp(i,k)) / tvly(i,k) - tem3 = gord * cip(i,k) * plyr(i,k) / (delp(i,k)*tvly(i,k)) +!> - Call gethml() to compute low,mid,high,total, and boundary layer +!! cloud fractions and clouds top/bottom layer indices for low, mid, +!! and high clouds. +! --- compute low, mid, high, total, and boundary layer cloud fractions +! and clouds top/bottom layer indices for low, mid, and high clouds. +! The three cloud domain boundaries are defined by ptopc. The cloud +! overlapping method is defined by control flag 'iovr', which may +! be different for lw and sw radiation programs. - if (tem2 < -50.0) then - rei(i,k) = (1250.0/9.917) * tem3 ** 0.109 - elseif (tem2 < -40.0) then - rei(i,k) = (1250.0/9.337) * tem3 ** 0.08 - elseif (tem2 < -30.0) then - rei(i,k) = (1250.0/9.208) * tem3 ** 0.055 - else - rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 - endif -! rei(i,k) = max(20.0, min(rei(i,k), 300.0)) -! rei(i,k) = max(10.0, min(rei(i,k), 100.0)) - rei(i,k) = max(10.0, min(rei(i,k), 150.0)) -! rei(i,k) = max(5.0, min(rei(i,k), 130.0)) - endif - enddo - enddo + call gethml & +! --- inputs: + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & + & IX, NLAY, iovr, iovr_rand, iovr_maxrand, iovr_max, & + & iovr_dcorr, iovr_exp, iovr_exprand, top_at_1, si, & +! --- outputs: + & clds, mtop, mbot & + & ) -! - do k = 1, NLAY - do i = 1, IX - cld_frac(i,k) = cldtot(i,k) - cld_lwp(i,k) = cwp(i,k) - cld_reliq(i,k) = rew(i,k) - cld_iwp(i,k) = cip(i,k) - cld_reice(i,k) = rei(i,k) -! cld_rwp(i,k) = 0.0 - cld_rerain(i,k) = rer(i,k) -! cld_swp(i,k) = 0.0 - cld_resnow(i,k) = res(i,k) - enddo - enddo -! !................................... - end subroutine progcld_zhao_carr_pdf -!----------------------------------- + end subroutine radiation_clouds_prop !----------------------------------- @@ -1822,6 +1201,8 @@ subroutine progcld_fer_hires & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 + real (kind=kind_phys) :: xrc3 + integer :: i, k, id, nf ! @@ -1893,14 +1274,22 @@ subroutine progcld_fer_hires & !> - Calculate layer cloud fraction. if (.not. lmfshal) then - call cloud_fraction_XuRandall & - & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) & ! --- outputs + xrc3 = xr_con + do k = 1, NLAY-1 + do i = 1, IX + cldtot(i,k) = cld_frac_XuRandall(plyr(i,k), qstl(i,k), & + & rhly(i,k), clwf(i,k), xrc3, xr_exp, 0.) + end do + end do else - call cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & - & qstl, & ! --- inputs - & cldtot ) & ! --- outputs + xrc3 = 100. + if (lmfdeep2) xrc3 = xr_con + do k = 1, NLAY-1 + do i = 1, IX + cldtot(i,k) = cld_frac_XuRandall(plyr(i,k), qstl(i,k), & + & rhly(i,k), clwf(i,k), xrc3, xr_exp, 0.) + end do + end do endif endif ! if (uni_cld) then @@ -2072,8 +1461,12 @@ subroutine progcld_thompson_wsm6 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 + real (kind=kind_phys) :: xrc3 + integer :: i, k, id, nf + logical :: cond_cfrac_onRH + ! --- constant values real (kind=kind_phys), parameter :: snow2ice = 0.25 real (kind=kind_phys), parameter :: coef_t = 0.025 @@ -2196,14 +1589,24 @@ subroutine progcld_thompson_wsm6 & !> - Calculate layer cloud fraction. if (.not. lmfshal) then - call cloud_fraction_XuRandall & - & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) & ! --- outputs + xrc3 = xr_con + do k = 1, NLAY-1 + do i = 1, IX + cldtot(i,k) = cld_frac_XuRandall(plyr(i,k), qstl(i,k), & + & rhly(i,k), clwf(i,k), xrc3, xr_exp, 0.) + end do + end do else - call cloud_fraction_mass_flx_2 & - & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & - & qstl, & ! --- inputs - & cldtot ) + xrc3 = 100. + if (lmfdeep2) xrc3 = xr_con + cond_cfrac_onRH = .true. + do k = 1, NLAY-1 + do i = 1, IX + cldtot(i,k) = cld_frac_XuRandall(plyr(i,k), qstl(i,k), & + & rhly(i,k), clwf(i,k), xrc3, xr_exp, 0., & + & cond_cfrac_onRH) + end do + end do endif endif ! if (uni_cld) then @@ -2261,6 +1664,7 @@ subroutine progcld_thompson_wsm6 & enddo enddo + !............................................ end subroutine progcld_thompson_wsm6 !............................................ @@ -2545,6 +1949,7 @@ subroutine progcld_thompson & iwp_ex(i) = iwp_ex(i)*1.E-3 enddo ! + !............................................ end subroutine progcld_thompson !............................................ @@ -3730,155 +3135,56 @@ SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte) END SUBROUTINE adjust_cloudFinal -!> This subroutine computes the Xu-Randall cloud fraction scheme. - subroutine cloud_fraction_XuRandall & - & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) & ! --- outputs - -! --- inputs: - integer, intent(in) :: IX, NLAY - real (kind=kind_phys), intent(in) :: xr_con, xr_exp - real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & - & rhly, qstl - -! --- outputs - real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot - -! --- local variables: - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2 - integer :: i, k - -!> - Compute layer cloud fraction. - - clwmin = 0.0 - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - - tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) - tem1 = xr_con / tem1 - - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt(sqrt(rhly(i,k))) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - - end subroutine cloud_fraction_XuRandall - -!> - subroutine cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xrc3, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) & ! --- outputs - -! --- inputs: - integer, intent(in) :: IX, NLAY - real (kind=kind_phys), intent(in) :: xrc3, xr_exp - real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & - & rhly, qstl - logical, intent(in) :: lmfdeep2 - -! --- outputs - real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot - -! --- local variables: - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2 - integer :: i, k - -!> - Compute layer cloud fraction. - - clwmin = 0.0 - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! - tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) !jhan - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif -! - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - - end subroutine cloud_fraction_mass_flx_1 - -!> - subroutine cloud_fraction_mass_flx_2 & - & ( IX, NLAY, lmfdeep2, xrc3, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) & ! --- outputs - -! --- inputs: - integer, intent(in) :: IX, NLAY - real (kind=kind_phys), intent(in) :: xrc3, xr_exp - real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & - & rhly, qstl - logical, intent(in) :: lmfdeep2 - -! --- outputs - real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot - -! --- local variables: - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2 - integer :: i, k - -!> - Compute layer cloud fraction. - - clwmin = 0.0 - do k = 1, NLAY-1 - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - if(rhly(i,k) > 0.99) then - cldtot(i,k) = 1. - else - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - - tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif - - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif +!> This function computes the cloud-fraction following +!! Xu-Randall(1996) \cite xu_and_randall_1996 +!! + function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha, & ! --- inputs + & lambda, factor, cond_cfrac_onRH) + implicit none + ! Inputs + logical, intent(in), optional :: & + & cond_cfrac_onRH ! If true, cloud-fracion set to unity when rh>99% + + real(kind_phys), intent(in) :: & + & p_lay, & !< Pressure (100Pa) + & qs_lay, & !< Saturation vapor-pressure (Pa) + & relhum, & !< Relative humidity + & cld_mr, & !< Total cloud mixing ratio + & alpha, & !< Scheme parameter (default=100) + & lambda, & + & factor ! factor=1.0 for RRTMGP, factor=0 for RRTMG + + ! Outputs + real(kind_phys) :: cld_frac_XuRandall + + ! Locals + real(kind_phys) :: clwt, clwm, onemrh, tem1, tem2, tem3 + +! ! Parameters +! real(kind_phys) :: & +! lambda = 0.50 ! , & +! P = 0.25 + + clwt = 1.0e-6 * (p_lay*0.001) + clwm = clwt * factor + if (cld_mr > clwt) then + if(present(cond_cfrac_onRH) .and. relhum > 0.99) then + cld_frac_XuRandall = 1. else - cldtot(i,k) = 0.0 + onemrh = max(1.e-10, 1.0 - relhum) + tem1 = alpha/min(max((onemrh*qs_lay)**lambda,0.0001),1.0) + tem2 = max(min(tem1*(cld_mr - clwm), 50.0 ), 0.0 ) + tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p + ! + cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) endif - enddo - enddo + else + cld_frac_XuRandall = 0.0 + endif + + return + end function - end subroutine cloud_fraction_mass_flx_2 !........................................! end module module_radiation_clouds !>@}