SUBROUTINE IRAS_CLD(KNCHAN,PFGDEP,PTSURF,KCLDFLG)

USE PARKIND1  ,ONLY : JPIM     ,JPRB 
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 
!**** SUBROUTINE IRAS_CLD CLOUD CHANNEL FLAG FOR IRAS SATELLITE DATA

!          G KELLY           ECMWF          18/01/2002
 
!*    PURPOSE
!     -------

!        calculate cloud in hirs co2 channels 1-8 and use to q/c other hirs chs

!**   INTERFACE
!     ---------

!     ***CALL*HIRS_CLD(KNCHAN,PFGDEP,KCLDFLG)

!     WHERE KNCHAN     = Maximum number of channels
!           PFGDEP     = first guess departures
!           PTSURF     = surface temperature
!           KCLDFLG    = array of hirs cloud flags (1:clear, 0:cloud)

!        HIRS_CLD IS CALLED BY SUBROUTINE HRETR

!*    METHOD

!       uses gradients of departures from top 15 mircon chs to determine cloud layer
!       (   channels 1-8 ) . It is assumed no cloud present in channels 1 2 .
!       UPDATE (BK) : fg-departures are smoothed before gradients calculation to
!       reduce false cloud signatures from noise

!*    EXTERNALS
!     ---------
!     none
!
!     MODIFICATIONS
!     -------------
!
!     14/07/2006    Niels Bormann         Move to HRETR, KNCHAN argument
!     10/10/2008    Blazej Krzeminski     Algorithm revised; code rewritten

!     ------------------------------------------------------------------
IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)      :: KNCHAN
REAL(KIND=JPRB)   ,INTENT(IN)      :: PFGDEP(KNCHAN)
REAL(KIND=JPRB)   ,INTENT(IN)      :: PTSURF
INTEGER(KIND=JPIM),INTENT(OUT)     :: KCLDFLG(KNCHAN)

!clear-sky STDDEV of fg-departures, used as
!thresholds to eliminate outliers in fg-departures
REAL(KIND=JPRB), PARAMETER :: ZFGDEPLIM(3:8) = &
&    (/ 0.423, 0.214, 0.213, 0.283, 0.415, 0.685 /)
!thresholds for fg-departure differences("gradients")
REAL (KIND=JPRB), PARAMETER :: ZGRADLIM(3:8) = &
&    (/ 0.22,  0.22,  0.12,  0.25,  0.23,  0.30  /)
!weights used for fg-departure smoothing
REAL (KIND=JPRB), PARAMETER :: ZW(-1:1) = &
&    (/ 0.33333, 0.33333, 0.33333 /)

REAL(KIND=JPRB)    :: ZSFGDEP(1:8)   !smoothed FG-departures
REAL(KIND=JPRB)    :: ZGRAD(3:8)     !gradients of the smoothed FG-departures
INTEGER(KIND=JPIM) :: I
LOGICAL            :: LLCLOUD
REAL(KIND=JPRB)    :: ZHOOK_HANDLE

! error of radS
IF (LHOOK) CALL DR_HOOK('IRAS_CLD',0,ZHOOK_HANDLE)

KCLDFLG(1:2) = 0  !channels 1 and 2 assumed clear
KCLDFLG(3:8) = 1  !other channels assumed cloudy

! smooth FG-departures

ZSFGDEP(1) = PFGDEP(1)*ZW(-1) + PFGDEP(1)*ZW(0) + PFGDEP(2)*ZW(1)
DO I = 2, 6
  ZSFGDEP(I) = PFGDEP(I-1)*ZW(-1) + PFGDEP(I)*ZW(0) + PFGDEP(I+1)*ZW(1)
ENDDO
ZSFGDEP(7) = PFGDEP(6)*ZW(-1) + PFGDEP(7)*ZW(0) + PFGDEP(9)*ZW(1)
ZSFGDEP(8) = PFGDEP(9)

! calculate gradients

DO I = 3, 8
  ZGRAD(I) = ZSFGDEP(I) - ZSFGDEP(I-1)
ENDDO

! look for cloud signature

LLCLOUD = .FALSE.
DO I = 3, 8
  IF ((ZSFGDEP(8)-ZSFGDEP(4) > 0.5_JPRB) .AND. PTSURF < 274.0_JPRB) THEN
    ! check for possible warm cloud over cold surface
    IF (ZGRAD(I) > ZGRADLIM(I)) THEN
      LLCLOUD = .TRUE.
      ! confirm that this is cloud signature and not just noise
      ! (next gradient should be at least 80% of the current gradient)
      IF (I<8) THEN
        LLCLOUD = LLCLOUD .AND. (ZGRAD(I+1) > 0.8_JPRB*ZGRAD(I))
      ENDIF
    ENDIF
    ! special case for channel 8 - make QC symmetric to prevent
    ! bias correction drift (until better "mode" metrics is found for VarBC)
    IF (I==8 .AND. ZGRAD(I) < -ZGRADLIM(I)) THEN
      LLCLOUD=.TRUE.
    ENDIF
  ELSE
    ! check for cold cloud over warm surface
    IF (ZGRAD(I) < -ZGRADLIM(I)) THEN
      LLCLOUD = .TRUE.
      IF (I<8) THEN
        LLCLOUD = LLCLOUD .AND. (ZGRAD(I+1) < 0.8_JPRB*ZGRAD(I))
      ENDIF
    ENDIF
    ! special case for channel 8...
    IF (I==8 .AND. ZGRAD(I) > ZGRADLIM(I)) THEN
      LLCLOUD=.TRUE.
    ENDIF
  ENDIF
  ! check for outliers
  LLCLOUD = LLCLOUD .OR. (ABS(PFGDEP(I)) > 3.0_JPRB*ZFGDEPLIM(I))

  IF (LLCLOUD) THEN
    EXIT
  ELSE
    KCLDFLG(I) = 0_JPIM
  ENDIF
ENDDO

! cloud settings for non 15 micron
! channels other than surface channel

KCLDFLG(9)=KCLDFLG(8)
!KCLDFLG(10)=KCLDFLG(7)
KCLDFLG(10)=KCLDFLG(8)
KCLDFLG(11)=KCLDFLG(6)
KCLDFLG(12)=KCLDFLG(7)
KCLDFLG(13)=KCLDFLG(5)
KCLDFLG(14)=KCLDFLG(8)
KCLDFLG(15)=KCLDFLG(7)

IF (LHOOK) CALL DR_HOOK('IRAS_CLD',1,ZHOOK_HANDLE)

END SUBROUTINE IRAS_CLD

