subroutine cldsav(lchnk ,ncol , & 1,2
cld ,pmid ,cldtot ,cldlow ,cldmed , &
cldhgh ,nmxrgn ,pmxrgn )
!-----------------------------------------------------------------------
!
! Purpose:
! Compute total & 3 levels of cloud fraction assuming maximum-random overlap.
! Pressure ranges for the 3 cloud levels are specified.
!
! Method:
! <Describe the algorithm(s) used in the routine.>
! <Also include any applicable external references.>
!
! Author: W. Collins
!
!-----------------------------------------------------------------------
use shr_kind_mod
, only: r8 => shr_kind_r8
use ppgrid
implicit none
!------------------------------Parameters-------------------------------
real(r8) plowmax ! Max prs for low cloud cover range
real(r8) plowmin ! Min prs for low cloud cover range
real(r8) pmedmax ! Max prs for mid cloud cover range
real(r8) pmedmin ! Min prs for mid cloud cover range
real(r8) phghmax ! Max prs for hgh cloud cover range
real(r8) phghmin ! Min prs for hgh cloud cover range
!
parameter (plowmax = 120000._r8,plowmin = 70000._r8, &
pmedmax = 70000._r8,pmedmin = 40000._r8, &
phghmax = 40000._r8,phghmin = 5000._r8)
real(r8) ptypmin(4)
real(r8) ptypmax(4)
data ptypmin /phghmin, plowmin, pmedmin, phghmin/
data ptypmax /plowmax, plowmax, pmedmax, phghmax/
!
!------------------------------Arguments--------------------------------
!
! Input arguments
!
integer, intent(in) :: lchnk ! chunk identifier
integer, intent(in) :: ncol ! number of atmospheric columns
real(r8), intent(in) :: cld(pcols,pver) ! Cloud fraction
real(r8), intent(in) :: pmid(pcols,pver) ! Level pressures
real(r8), intent(in) :: pmxrgn(pcols,pverp) ! Maximum values of pressure for each
! maximally overlapped region.
! 0->pmxrgn(i,1) is range of pressure for
! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for
! 2nd region, etc
integer, intent(in) :: nmxrgn(pcols) ! Number of maximally overlapped regions
!
! Output arguments
!
real(r8), intent(out) :: cldtot(pcols) ! Total random overlap cloud cover
real(r8), intent(out) :: cldlow(pcols) ! Low random overlap cloud cover
real(r8), intent(out) :: cldmed(pcols) ! Middle random overlap cloud cover
real(r8), intent(out) :: cldhgh(pcols) ! High random overlap cloud cover
!
!---------------------------Local workspace-----------------------------
!
integer i,k ! Longitude,level indices
integer irgn(pcols) ! Max-overlap region index
integer max_nmxrgn ! maximum value of nmxrgn over columns
integer ityp ! Type counter
real(r8) clrsky(pcols) ! Max-random clear sky fraction
real(r8) clrskymax(pcols) ! Maximum overlap clear sky fraction
!
!-----------------------------------------------------------------------
!
! Initialize region number
!
max_nmxrgn = -1
do i=1,ncol
max_nmxrgn = max(max_nmxrgn,nmxrgn(i))
end do
do ityp = 1, 4
irgn(1:ncol) = 1
do k =1,max_nmxrgn-1
do i=1,ncol
if (pmxrgn(i,irgn(i)) < ptypmin(ityp) .and. irgn(i) < nmxrgn(i)) then
irgn(i) = irgn(i) + 1
end if
end do
end do
!
! Compute cloud amount by estimating clear-sky amounts
!
clrsky(1:ncol) = 1.0_r8
clrskymax(1:ncol) = 1.0_r8
do k = 1, pver
do i=1,ncol
if (pmid(i,k) >= ptypmin(ityp) .and. pmid(i,k) <= ptypmax(ityp)) then
if (pmxrgn(i,irgn(i)) < pmid(i,k) .and. irgn(i) < nmxrgn(i)) then
irgn(i) = irgn(i) + 1
clrsky(i) = clrsky(i) * clrskymax(i)
clrskymax(i) = 1.0_r8
endif
clrskymax(i) = min(clrskymax(i),1.0_r8-cld(i,k))
endif
end do
end do
if (ityp == 1) cldtot(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol))
if (ityp == 2) cldlow(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol))
if (ityp == 3) cldmed(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol))
if (ityp == 4) cldhgh(1:ncol) = 1.0_r8 - (clrsky(1:ncol) * clrskymax(1:ncol))
end do
return
end subroutine cldsav