!----------------------------------- subroutine progcld1 & !................................... ! --- inputs: ( plyr,tlyr,qlyr,qstl,clw, & xlat,xlon, & IX, NLAY, iflip, & ! --- outputs: cldtot & ) ! ================= subprogram documentation block ================ ! ! ! ! subprogram: progcld1 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 "cldinit". ! ! ! ! program history log: ! ! 11-xx-1992 y.h., k.a.c, a.k. - cloud parameterization ! ! 'cldjms' patterned after slingo and slingo's work (jgr, ! ! 1992), stratiform clouds are allowed in any layer except ! ! the surface and upper stratosphere. the relative humidity ! ! criterion may cery in different model layers. ! ! 10-25-1995 kenneth campana - tuned cloud rh curves ! ! rh-cld relation from tables created using mitchell-hahn ! ! tuning technique on airforce rtneph observations. ! ! 11-02-1995 kenneth campana - the bl relationships used ! ! below llyr, except in marine stratus regions. ! ! 04-11-1996 kenneth campana - save bl cld amt in cld(,5) ! ! 12-29-1998 s. moorthi - prognostic cloud method ! ! 04-15-2003 yu-tai hou - rewritten in frotran 90 ! ! modulized form, seperate prognostic and diagnostic methods ! ! into two packages. ! ! ! ! usage: call progcld1 ! ! ! ! subprograms called: gethml ! ! ! ! attributes: ! ! language: fortran 90 ! ! machine: ibm-sp, sgi ! ! ! ! ! ! ==================== defination of variables ==================== ! ! ! ! input variables: ! ! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! ! tlyr (IX,NLAY) : model layer mean 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 ! ! xlon (IX) : grid longitude in radians (not used) ! ! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! ! IX : horizontal dimention ! ! NLAY : vertical layer/level dimensions ! ! iflip : control flag for in/out vertical indexing ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! ! iovr : control flag for cloud overlap ! ! =0 random overlapping clouds ! ! =1 max/ran overlapping clouds ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! ! clouds(:,:,1) - layer total cloud fraction ! ! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! ! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! ! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! ! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! ! clouds(:,:,6) - layer rain drop water path not assigned ! ! clouds(:,:,7) - mean eff radius for rain drop (micron) ! ! *** clouds(:,:,8) - layer snow flake water path not assigned ! ! clouds(:,:,9) - mean eff radius for snow flake (micron) ! ! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! ! ! ==================== end of description ===================== ! ! use kinds, only: r_kind implicit none real, parameter:: climit=0.001 ! --- inputs integer, intent(in) :: IX, NLAY, iflip real (kind=r_kind), dimension(ix,nlay), intent(in) :: plyr, & tlyr, qlyr, qstl, clw real (kind=r_kind), dimension(ix), intent(in) :: xlat, xlon ! --- outputs ! real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=r_kind), dimension(ix,nlay), intent(out) :: cldtot ! integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: ! real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & ! & cwp, cip, crp, csp, rew, rei, res, rer, delp, tem2d ! real (kind=kind_phys) :: ptop1(IX,4) real (kind=r_kind) :: rhly(ix,nlay) real (kind=r_kind) :: clwmin, clwm, clwt, onemrh, value, & tem1, tem2, tem3 integer, dimension(IX) :: kinver integer :: i, k, id, id1 logical :: inversn(IX) ! !===> ... begin here ! ! clouds(:,:,:) = 0.0 do k = 1, NLAY do i = 1, IX cldtot(i,k) = 0.0 rhly(i,k) = qlyr(i,k)/qstl(i,k) ! Chuang: add RH computation here enddo enddo ! --- layer cloud fraction if (iflip == 0) then ! input data from toa to sfc do i = 1, IX inversn(i) = .false. kinver (i) = 1 enddo do k = NLAY-1, 2, -1 do i = 1, IX if (plyr(i,k) > 600.0 .and. (.not.inversn(i))) then tem1 = tlyr(i,k-1) - tlyr(i,k) if (tem1 > 0.1 .and. tlyr(i,k) > 278.0) then inversn(i) = .true. kinver(i) = k endif endif enddo enddo clwmin = 0.0 do k = NLAY, 1, -1 do i = 1, IX clwt = 1.0e-6 * (plyr(i,k)*0.001) ! clwt = 2.0e-6 * (plyr(i,k)*0.001) if (clw(i,k) > clwt .or. & (inversn(i) .and. k >= kinver(i)) ) then onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) tem1 = 2000.0 / tem1 ! tem1 = 1000.0 / tem1 ! if (inversn(i) .and. k >= kinver(i)) tem1 = tem1 * 5.0 value = max( min( tem1*(clw(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 ! input data from sfc to toa do i = 1, IX inversn(i) = .false. kinver (i) = NLAY enddo do k = 2, NLAY do i = 1, IX if (plyr(i,k) > 600.0 .and. (.not.inversn(i))) then tem1 = tlyr(i,k+1) - tlyr(i,k) if (tem1 > 0.1 .and. tlyr(i,k) > 278.0) then inversn(i) = .true. kinver(i) = k endif endif enddo enddo 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 (clw(i,k) > clwt .or. & (inversn(i) .and. k <= kinver(i)) ) then onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) tem1 = 2000.0 / tem1 ! tem1 = 1000.0 / tem1 ! if (inversn(i) .and. k <= kinver(i)) tem1 = tem1 * 5.0 value = max( min( tem1*(clw(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 endif ! end_if_flip where (cldtot < climit) cldtot = 0.0 endwhere ! return !................................... end subroutine progcld1 !-----------------------------------