diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 3a3378e15..efea61226 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -861,7 +861,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ! for zhao/moorthi's (imp_phys=99) & ! ferrier's (imp_phys=5) microphysics schemes - if ((num_p3d == 4) .and. (npdf3d == 3)) then ! same as imp_physics = 98 + if ((num_p3d == 4) .and. (npdf3d == 3)) then ! same as imp_physics = imp_physics_zhao_carr_pdf do k=1,lm k1 = k + kd do i=1,im @@ -872,7 +872,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & cnvc (i,k1) = cnvc_in(i,k) enddo enddo - elseif ((npdf3d == 0) .and. (ncnvcld3d == 1)) then ! same as imp_physics=99 + elseif ((npdf3d == 0) .and. (ncnvcld3d == 1)) then ! all other microphysics with pdfcld = .false. and cnvcld = .true. do k=1,lm k1 = k + kd do i=1,im @@ -891,7 +891,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & enddo endif - if (imp_physics == imp_physics_zhao_carr) then ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK) endif @@ -1020,7 +1019,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, & - cldcov(:,1:LMK), effrl_inout, & + cldcov(:,1:LMK), cnvw, effrl_inout, & effri_inout, effrs_inout, & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & dzb, xlat_d, julian, yearlen, & diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index f58ec8d11..36c928b2d 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -40,7 +40,7 @@ ! ! ! 'progcld3' --- zhao/moorthi prognostic cloud + pdfcld! ! inputs: ! -! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, cnvw,cnvc, ! +! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, ! ! xlat,xlon,slmsk, dz, delp, ! ! ix, nlay, nlp1, ! ! deltaq,sup,kdt,me, ! @@ -2881,7 +2881,7 @@ subroutine progcld6 & & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & & IX, NLAY, NLP1, & - & uni_cld, lmfshal, lmfdeep2, cldcov, & + & uni_cld, lmfshal, lmfdeep2, cldcov, cnvw, & & re_cloud,re_ice,re_snow, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, latdeg, julian, yearlen, & @@ -2976,7 +2976,7 @@ subroutine progcld6 & real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & - & re_cloud, re_ice, re_snow + & re_cloud, re_ice, re_snow, cnvw real (kind=kind_phys), dimension(:), intent(inout) :: & & lwp_ex, iwp_ex, lwp_fc, iwp_fc @@ -3010,13 +3010,11 @@ subroutine progcld6 & integer :: i, k, id, nf ! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. + real (kind=kind_phys), parameter :: xrc3 = 200. ! !===> ... begin here -! do nf=1,nf_clds do k=1,nlay do i=1,ix @@ -3065,6 +3063,7 @@ subroutine progcld6 & do k = 1, NLAY do i = 1, IX clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + & + clw(i,k,ntrw) + cnvw(i,k) enddo enddo !> - Find top pressure for each cloud domain for given latitude. @@ -3091,8 +3090,7 @@ subroutine progcld6 & cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) - csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * & - & gfac * delp(i,k)) + csp(i,k) = max(0.0, clw(i,k,ntsw) * gfac * delp(i,k)) enddo enddo @@ -3123,33 +3121,56 @@ subroutine progcld6 & !> - Calculate 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 (.not. lmfshal) then + 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 ) + 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 ) - if (.not. lmfshal) then tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) tem1 = 2000.0 / tem1 - else - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif - 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 + 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 + else + do k = 1, NLAY-1 + do i = 1, IX + clwt = 1.0e-10 * (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))**0.49,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 + else + cldtot(i,k) = 0.0 + endif + enddo + enddo + endif endif ! if (uni_cld) then do k = 1, NLAY @@ -3190,7 +3211,6 @@ subroutine progcld6 & enddo endif -! do k = 1, NLAY do i = 1, IX clouds(i,k,1) = cldtot(i,k) @@ -3241,7 +3261,6 @@ subroutine progcld6 & & clds, mtop, mbot & & ) -! return !............................................