! Library:phys $Id: hlcldia.F90 5126 2007-05-11 16:21:54Z towil $

!options xopt(noeval)
subroutine hlcldia (                             &
!     scalars and logicals 
     &              kcall,    khor,    klev,     &
     &              kstart,   kstop,   kstep,    &
!     diagnostic arrays   
     &              ptotcov,  pf,      phalf,    &
     &              pclch,    pclcm,   pclcl,    & 
     &              pclct,    cdlock             )
!     ======================================================
!     PURPOSE:

!     Subroutine to compute diagnostic cloud covers 
!     for high cloud cover (pclch), medium clouds 
!     (pclcm) and low clouds ( pclcl) and total cloud
!     cover (pclct)

!     METHOD: 
!     ------------------------------------------------------
!     A combination of random and maximum overlaps. 
!     Maximum overlaps are computed for high clouds, 
!     for medium clouds and for low clouds respectively.
!     These computations are done between selected pressure 
!     levels. Finally total cloud cover 'pclct' is computed 
!     from a random overlap assumption between 'pclch',
!     'pclcm' and pclcl. 
!     ------------------------------------------------------
!     AUTHOR: Bent H. Sass, DMI.

!     MODIFICATIONS: 
!     Original version 2006-04-18
!     A.Bogatchev : 26-Oct-2007 removing of severe breaks of coding rools

!     ======================================================
!     1. DECLARATIONS.
 
!     1.1 MODULES USED:

use parkind1  ,only : jpim, jprb
use yomhook   ,only : lhook, dr_hook

!     1.2 OTHER DECLARATIONS:
     
implicit none

! Scalars 

integer(kind=jpim),intent(in)    ::  kcall    ! mode of call 
integer(kind=jpim),intent(in)    ::  khor     ! hor. loop dimension
integer(kind=jpim),intent(in)    ::  klev     ! number of vert. lev.
integer(kind=jpim),intent(in)    ::  kstart   ! start index of loops
integer(kind=jpim),intent(in)    ::  kstop    ! end index of loops 
integer(kind=jpim),intent(in)    ::  kstep    ! step no. in forecast

! Diagnostic variables 

real(kind=jprb),   intent(in)    ::  ptotcov(khor,klev)
!                                    fractional cloud cover
real(kind=jprb),   intent(in)    ::  pf(khor,klev)
!                                    full level pressure (Pa) 
real(kind=jprb),   intent(in)    ::  phalf(khor,0:klev)
!                                    half level pressure (Pa)
real(kind=jprb),   intent(inout) ::  pclch(khor)
real(kind=jprb),   intent(inout) ::  pclcm(khor)
real(kind=jprb),   intent(inout) ::  pclcl(khor)
real(kind=jprb),   intent(inout) ::  pclct(khor)
character(len=7)  ,intent(in)    ::  cdlock
 
! Other declarations  

real(kind=jprb)      ::   zllow(khor)
real(kind=jprb)      ::   zsighig
real(kind=jprb)      ::   zsigmed
real(kind=jprb)      ::   zsiglow
real(kind=jprb)      ::   zsigvlow
real(kind=jprb)      ::   zhig
real(kind=jprb)      ::   zmed
real(kind=jprb)      ::   zlow
real(kind=jprb)      ::   zvlow
real(kind=jprb)      ::   zhook_handle

integer(kind=jpim)   ::   ikhig(khor)
integer(kind=jpim)   ::   ikmed(khor)
integer(kind=jpim)   ::   iklow(khor)
integer(kind=jpim)   ::   ikvlow(khor)
integer(kind=jpim)   ::   indexh(khor)
integer(kind=jpim)   ::   indexm(khor)
integer(kind=jpim)   ::   indexl(khor)
integer(kind=jpim)   ::   indexvl(khor)

integer(kind=jpim)   ::   jl,  jk

     if (lhook) call dr_hook('hlcldia',0,zhook_handle)
 
!     ===================================================================
!     1.  Initialization of pressure thesholds
 
      zsighig  =0.100_jprb
      zsigmed  =0.500_jprb
      zsiglow  =0.800_jprb 
      zsigvlow =0.980_jprb

      do jl=kstart,kstop
        ikhig(jl)  =klev
        ikmed(jl)  =klev
        iklow(jl)  =klev 
        ikvlow(jl) =klev
        indexh(jl) =0_jpim
        indexm(jl) =0_jpim
        indexl(jl) =0_jpim 
        indexvl(jl)=0_jpim
        pclch(jl)  =0.0_jprb
        pclcm(jl)  =0.0_jprb
        pclcl(jl)  =0.0_jprb
        pclct(jl)  =0.0_jprb 
        zllow(jl)  =0.0_jprb
      enddo 

      do jk=klev,1,-1  
        do jl=kstart,kstop
          zvlow = zsigvlow*phalf(jl,klev)
          zlow  = zsiglow *phalf(jl,klev)
          zmed  = zsigmed *phalf(jl,klev)
          zhig  = zsighig *phalf(jl,klev)

          if( (pf(jl,jk) < zvlow).and. (indexvl(jl) ==0) ) then 
            ikvlow(jl) =jk
            indexvl(jl)=1_jpim
          endif 

          if( (pf(jl,jk) < zlow).and. (indexl(jl) ==0) ) then
            iklow(jl) =jk
            indexl(jl)=1_jpim
           endif

          if( (pf(jl,jk) < zmed).and. (indexm(jl) ==0) ) then
            ikmed(jl) =jk
            indexm(jl)=1_jpim
          endif

          if( (pf(jl,jk) < zhig).and. (indexh(jl) ==0) ) then
            ikhig(jl) =jk
            indexh(jl)=1_jpim
          endif
       enddo  
      enddo 

      do jl=kstart,kstop
        do jk=ikhig(jl),ikmed(jl)-1 
          pclch(jl)=max( pclch(jl), ptotcov(jl,jk) )
        enddo
      enddo

      do jl=kstart,kstop
        do jk=ikmed(jl),iklow(jl)-1
          pclcm(jl)=max( pclcm(jl), ptotcov(jl,jk) )
        enddo
      enddo

      do jl=kstart,kstop
        do jk=iklow(jl),ikvlow(jl)-1
          pclcl(jl)=max( pclcl(jl), ptotcov(jl,jk) )
        enddo
      enddo

      do jl=kstart,kstop
        do jk=ikvlow(jl),klev
          zllow(jl)=max( zllow(jl), ptotcov(jl,jk) )
        enddo
      enddo

!     Finally compute total cloud cover from a random 
!     overlap assumption:

      do jl=kstart,kstop
        pclct(jl)=1.0_jprb - &
  &       (1.0_jprb -pclch(jl))*(1.0_jprb -pclcm(jl))*  &
  &       (1.0_jprb -pclcl(jl))*(1.0_jprb -zllow(jl))
      enddo

      if(lhook)  call dr_hook('hlcldia',1,zhook_handle)

end subroutine hlcldia
