SUBROUTINE CO2CLDAIRS(K_IEND,PPRES,PANGL,PANGLA,&
 & PANGS,PANGSA,KSURF,KSAT,KCHPF,KCHID,KNCHU,PROF,PROFS,  &
 & PROFSS,PROFCV,PEMIS,PTAU,POBS,PRADM,P_ZTBM,PRADOV,&
 & PLAT,POROG,PCT,P_ZEM)
!****** CLDCO2 * - CALCUL DE LA PRESSION AU SOMMET DES NUAGES ET L'EMISSIVITE
!                  EFFECTIVE A PARTIR DES DONNEES SATELLITAIRES
!       Externes.
!       ---------
!           RTTOV : modele de transfert radiatif RTTOV
!           GETCPARAM
!       Methode.
!       --------
!           Methode CO2 slicing d'apres Menzel and Stewart (1983)
!       Auteur.
!       -------
!           M. Dahoui  (03/2003) a partir d'une version originale ecrite par
!               L. Lavanant (CMS/Meteo-France)
!       Proprietaire du code.
!       ---------------------
!           Meteo-France
!       Modifications
!       -------------
!       V.Guidard    08.Jul.2009   Cleaning (variables from sat) and mod. call to RTTOV_EC
!----------------------------------------------------------------------------------------

USE YOMLUN    , ONLY : NULOUT
USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
USE PARKIND1  , ONLY : JPIM, JPRB
USE YOMDIMO   , ONLY : NLSAT, NMXTCHU, NPNSAV, NPNSSV, NPNCV, NPTNAV
USE YOMTVRAD  , ONLY : NJPPF, AIRSCHAN, M__NumAIRSChans
USE YOMMP     , ONLY : MYPROC

IMPLICIT NONE

REAL(KIND=JPRB), INTENT(IN), DIMENSION(NLSAT) :: PPRES   ! Pression aux niveaux RTTOV
INTEGER(KIND=JPIM), INTENT(IN)   :: K_IEND     ! Nombre de profils
INTEGER(KIND=JPIM), INTENT(IN)   :: KSAT     ! Nombre des satellites
INTEGER(KIND=JPIM), INTENT(IN)   :: KCHPF    ! Nombre de profils*radiances en entree
REAL(KIND=JPRB), INTENT(IN), DIMENSION(K_IEND) :: PANGL,PANGS
REAL(KIND=JPRB), INTENT(IN), DIMENSION(K_IEND) :: PANGLA,PANGSA
INTEGER(KIND=JPIM), INTENT(IN), DIMENSION(NJPPF*NMXTCHU) :: KCHID
INTEGER(KIND=JPIM), INTENT(IN), DIMENSION(K_IEND)         :: KSURF
INTEGER(KIND=JPIM), INTENT(IN), DIMENSION(K_IEND)          :: KNCHU    ! tableau du nb de radiances par profil
REAL(KIND=JPRB), INTENT(IN), DIMENSION(NLSAT,NPTNAV+2,K_IEND) :: PROF    ! Profils d'entree de RTTOV
REAL(KIND=JPRB), INTENT(IN), DIMENSION(NPNSAV,K_IEND)     :: PROFS   ! Variables a 2 M en entree de RTTOV
REAL(KIND=JPRB), INTENT(IN), DIMENSION(NPNSSV,K_IEND)     :: PROFSS  ! Variables de surface en entree de RTTOV
REAL(KIND=JPRB), INTENT(IN), DIMENSION(NPNCV,K_IEND)      :: PROFCV  ! Variables realtives aux nuages
REAL(KIND=JPRB),INTENT(IN), DIMENSION(NJPPF*NMXTCHU)     :: PEMIS
REAL(KIND=JPRB), INTENT(IN), DIMENSION(NLSAT,KCHPF)      :: PTAU     ! Transmittance totale
REAL(KIND=JPRB),INTENT(IN), DIMENSION(NJPPF*NMXTCHU)     :: POBS
REAL(KIND=JPRB), INTENT(IN), DIMENSION(NJPPF*NMXTCHU)    :: PRADM    ! rad claires calculees
REAL(KIND=JPRB), INTENT(IN), DIMENSION(NJPPF*NMXTCHU)    :: P_ZTBM     ! TB claires calculees
REAL(KIND=JPRB), INTENT(IN), DIMENSION(2*NLSAT+2,KCHPF)  :: PRADOV   ! Radiances aux niveaux pression
REAL(KIND=JPRB), INTENT(IN), DIMENSION(K_IEND) :: PLAT,POROG

! SORTIES :
! ---------
REAL(KIND=JPRB), INTENT(OUT), DIMENSION(K_IEND)            :: PCT ! Pression au sommet des nuages
REAL(KIND=JPRB), INTENT(OUT), DIMENSION(K_IEND)            :: P_ZEM ! Emissivite effective finale

! VARIABLES LOCALES :
! -------------------
REAL(KIND=JPRB), ALLOCATABLE    :: ZPRADCLR(:)      ! Radiances claires
REAL(KIND=JPRB), ALLOCATABLE    :: ZPRADOV(:,:)     ! Radiances aux niveaux pression
REAL(KIND=JPRB), ALLOCATABLE    :: ZTB(:)           ! Temperatures de brillances calculees
REAL(KIND=JPRB), ALLOCATABLE    :: ZTAU(:,:)        ! Transmittance totale
REAL(KIND=JPRB), ALLOCATABLE    :: ZTM(:,:)         ! Profil de temperature modele
REAL(KIND=JPRB), ALLOCATABLE    :: ZTBCLR(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZRADCLR(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZTBTOT(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZRADTOT(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZRADCLD(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZRADCLDLEV(:,:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZVAROUT(:,:)

REAL(KIND=JPRB), ALLOCATABLE    :: Z_TBOBS(:)
REAL(KIND=JPRB), ALLOCATABLE    :: Z_RADOBS(:)
REAL(KIND=JPRB), ALLOCATABLE    :: Z_RAPG(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZDRAP(:,:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZPRES(:,:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZALT(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZDTAU(:)
REAL(KIND=JPRB), ALLOCATABLE    :: Z_DB(:)
REAL(KIND=JPRB), ALLOCATABLE    :: ZTP(:)
REAL(KIND=JPRB)                 :: ZRAPD
REAL(KIND=JPRB) :: ZTSTORE

INTEGER(KIND=JPIM)              :: IJPLEV
INTEGER(KIND=JPIM)              :: IFMV_CHN
INTEGER(KIND=JPIM), PARAMETER                :: INBCAN=123    ! Nombre de canaux CO2
INTEGER(KIND=JPIM),ALLOCATABLE    ::ICHID(:)
INTEGER(KIND=JPIM),ALLOCATABLE    ::IPFID(:)
REAL(KIND=JPRB), DIMENSION(NPNCV,K_IEND)      :: ZPROFCV       ! Variables realtives aux nuages
REAL(KIND=JPRB), ALLOCATABLE                 :: ZPRAD(:),ZTAUSFC(:),ZEMIS(:)
INTEGER(KIND=JPIM), ALLOCATABLE              :: I_KNCH(:)
INTEGER(KIND=JPIM), ALLOCATABLE              :: JL_PN(:)
REAL(KIND=JPRB), ALLOCATABLE                 :: Z_IFAIL(:)
REAL(KIND=JPRB), ALLOCATABLE                 :: ZCOEF_FF_CWN(:)
REAL(KIND=JPRB), ALLOCATABLE                 :: ZCOEF_FF_BCO(:)
REAL(KIND=JPRB), ALLOCATABLE                 :: ZCOEF_FF_BCS(:)
REAL(KIND=JPRB), ALLOCATABLE                 :: ZCOEF_PLANCK1(:)
REAL(KIND=JPRB), ALLOCATABLE                 :: ZCOEF_PLANCK2(:)
LOGICAL                                      :: LL_LCLOUD
LOGICAL, DIMENSION(4)                        :: LLTRACER


INTEGER(KIND=JPIM)                           :: I_KNCHPF! Nb de tr ds le co2slicing
INTEGER(KIND=JPIM)                           :: I,IC,J,JLEV,J_MAX(K_IEND)
INTEGER(KIND=JPIM)                           :: ICHAN,ICPT
REAL(KIND=JPRB), ALLOCATABLE                 :: ZFC(:,:)
REAL(KIND=JPRB)                              :: ZNMSEUIL
REAL(KIND=JPRB)                              :: Z_DMIN
REAL(KIND=JPRB)                              :: Z_B1, Z_B2
REAL(KIND=JPRB), PARAMETER                   :: C1=1.191044E-05
REAL(KIND=JPRB), PARAMETER                   :: C2=1.438769
! Choix des canaux CO2 :
! ----------------------
INTEGER(KIND=JPIM), PARAMETER, DIMENSION(INBCAN) :: I_SETCAN=(/   &
    & 1,6,7,10,11,15,16,17,20,21,22,24,27,28,30,36,39,40,&  ! chan   1 ->  18
    & 42,51,52,54,55,56,59,62,63,68,69,71,72,73,74,75,76,&  ! chan  19 ->  35
    & 77,78,79,80,82,83,84,86,92,93,98,99,101,104,105,   &  ! chan  36 ->  50
    & 108,110,111,113,116,117,123,124,128,129,138,139,   &  ! chan  51 ->  62
    & 144,145,150,151,156,157,159,162,165,168,169,170,   &  ! chan  63 ->  74
    & 172,173,174,175,177,179,180,182,185,186,190,192,   &  ! chan  75 ->  86
    & 198,201,204,207,210,215,216,221,226,227,232,252,   &  ! chan  87 ->  98
    & 253,256,257,261,262,267,272,295,299,300,305,310,   &  ! chan  99 -> 110
    & 321,325,333,338,355,362,375,453,475,484,497,528,787/) ! chan 111 -> 123
REAL(KIND=JPRB), ALLOCATABLE           :: Z_WAVEN(:)
REAL(KIND=JPRB), ALLOCATABLE           :: Z_WK(:)            ! Poids
REAL(KIND=JPRB)                        :: ZWKMAX           ! Poid maximal
REAL(KIND=JPRB)                        :: Z_POIDS

INTEGER(KIND=JPIM) :: IFILE

REAL(KIND=JPRB)                        :: ZHOOK_HANDLE

INTERFACE
#include "getcparam.h"
#include "getcoef_field.h"
END INTERFACE

#include "abor1.intfb.h"

IF (LHOOK) CALL DR_HOOK('CO2CLDAIRS',0,ZHOOK_HANDLE)

! Initialisations
! ---------------

  CALL GETCPARAM(KJPLEV=IJPLEV)

  CALL GETCOEF_FIELD(KMSAT=11, KFMV_CHN=IFMV_CHN)

  ALLOCATE(ZCOEF_FF_CWN(IFMV_CHN))
  ALLOCATE(ZCOEF_FF_BCO(IFMV_CHN))
  ALLOCATE(ZCOEF_FF_BCS(IFMV_CHN))
  ALLOCATE(ZCOEF_PLANCK1(IFMV_CHN))
  ALLOCATE(ZCOEF_PLANCK2(IFMV_CHN))

  CALL GETCOEF_FIELD(KMSAT=11, KFMV_CHN=IFMV_CHN, PFF_CWN=ZCOEF_FF_CWN, PFF_BCO=ZCOEF_FF_BCO,&
   & PFF_BCS=ZCOEF_FF_BCS, PPLANCK1=ZCOEF_PLANCK1, PPLANCK2=ZCOEF_PLANCK2)

  LL_LCLOUD=.TRUE.
  LLTRACER(1:4)=.FALSE.
  I_KNCHPF=INBCAN*K_IEND
  !KNCHPF=NJPPF*NMXTCHU
  ALLOCATE (ICHID(I_KNCHPF))
  ALLOCATE (IPFID(I_KNCHPF))
  ALLOCATE (ZPRADCLR(I_KNCHPF))
  ALLOCATE (ZPRADOV(2*NLSAT+2,I_KNCHPF))
  ALLOCATE (ZTAU(NLSAT,I_KNCHPF))
  ALLOCATE (ZTB(I_KNCHPF))
  ALLOCATE (Z_IFAIL(K_IEND))
  ALLOCATE (ZTM(K_IEND,IJPLEV))
  ALLOCATE (Z_TBOBS(I_KNCHPF))
  ALLOCATE (Z_RADOBS(I_KNCHPF))
  ALLOCATE (ZEMIS(I_KNCHPF))
  ALLOCATE (ZDTAU(INBCAN))
  ALLOCATE (Z_DB(INBCAN))
  ALLOCATE (ZTP(INBCAN))
  ALLOCATE (Z_WAVEN(INBCAN))
  ALLOCATE (ZFC(I_KNCHPF,IJPLEV))
  ALLOCATE (I_KNCH(K_IEND))
  ALLOCATE (ZPRES(NLSAT,K_IEND))


!    Methode CO2-slicing
!    -------------------

ZFC(:,:)=-9999.
PCT(:)=-9999.
P_ZEM(:)=0.
ZNMSEUIL=0.3
ZPROFCV=PROFCV
ICPT=0
PACKET_LOOP0: DO I=1,K_IEND
  ZTM(I,:)=PROF(:,1,I)
  I_KNCH(I)=INBCAN
  DO J=1,INBCAN
     DO IC=1, M__NumAIRSChans
       IF (AIRSCHAN(IC) == I_SETCAN(J)) THEN
         ICHAN=IC
         EXIT
       ENDIF
     ENDDO
     ICHID(INBCAN*(I-1)+J)=ICHAN !! I_SETCAN(J)
     IPFID(INBCAN*(I-1)+J)=I
     Z_WAVEN(J)=ZCOEF_FF_CWN(ICHAN)
     DO IC=1,KNCHU(I)
        IF (ICHAN == KCHID(IC+ICPT)) THEN
            Z_TBOBS(J+(I-1)*INBCAN)=POBS(IC+ICPT)
            ZPRADCLR(J+(I-1)*INBCAN)=PRADM(IC+ICPT)
            ZTB(J+(I-1)*INBCAN)=P_ZTBM(IC+ICPT)
            ZEMIS(J+(I-1)*INBCAN)=PEMIS(IC+ICPT)
            ZTAU(:,J+(I-1)*INBCAN)=PTAU(:,IC+ICPT)
            ZPRADOV(:,J+(I-1)*INBCAN)=PRADOV(:,IC+ICPT)
            IF ((POBS(IC+ICPT)>400).OR.(POBS(IC+ICPT)<100.)) THEN
              CALL FLUSH(NULOUT)
              CALL ABOR1('CO2CLDAIRS: OBS out of bounds')
            ENDIF
        ENDIF
     ENDDO
  ENDDO
  ICPT=ICPT+KNCHU(I)
ENDDO PACKET_LOOP0
DO I=1,K_IEND
  DO J=1, INBCAN
    DO IC=1, M__NumAIRSChans
      IF (AIRSCHAN(IC) == I_SETCAN(J)) THEN
        ICHAN=IC
        EXIT
      ENDIF
    ENDDO
    ZTSTORE=ZCOEF_FF_BCO(ICHAN)+ZCOEF_FF_BCS(ICHAN)*Z_TBOBS(J+(I-1)*INBCAN)
    IF (ABS(ZTSTORE)<0.000001) THEN
      CALL ABOR1('CO2CLDAIRS: ZTSTORE NEAR ZERO')
    ENDIF
    IF (ABS(EXP(ZCOEF_PLANCK2(ICHAN)/ZTSTORE)-1.0_JPRB)<0.000001) THEN
      CALL ABOR1('CO2CLDAIRS: EXP() NEAR ZERO')
    ENDIF
    Z_RADOBS(J+(I-1)*INBCAN)=ZCOEF_PLANCK1(ICHAN)/(EXP(ZCOEF_PLANCK2(ICHAN)/ZTSTORE)-1.0_JPRB)
  ENDDO
ENDDO

DO JLEV=1,IJPLEV
   ZFC(:,JLEV) = ZPRADCLR(:) - ZPRADOV(JLEV,:)
ENDDO

DEALLOCATE (ZPRADOV)

!     1. Calcul du rapport gauche de l'Eq
!     -----------------------------------

ALLOCATE (Z_RAPG(INBCAN-1))
ALLOCATE (ZDRAP(INBCAN-1,IJPLEV))
ALLOCATE (ZALT(INBCAN))
ALLOCATE (JL_PN(INBCAN-1))
ALLOCATE (Z_WK(INBCAN-1))

PACKET_LOOP1: DO I=1,K_IEND
  Z_RAPG(:)=-9999.
  PCT(I)=-9999.
  ZDRAP(:,:)=9999.
  JL_PN(:)=-9999
  ZALT(:)=-9999.
  Z_WK(:)=0.

  DO J=1, INBCAN-1
   IF ( ABS(ZTB(I*INBCAN)-Z_TBOBS(I*INBCAN)) > ZNMSEUIL .AND. &
      & ABS(ZTB(J+(I-1)*INBCAN)-Z_TBOBS(J+(I-1)*INBCAN)) > ZNMSEUIL ) THEN
      Z_RAPG(J) = (ZPRADCLR(J+(I-1)*INBCAN)-Z_RADOBS(J+(I-1)*INBCAN))/(ZPRADCLR(I*INBCAN)-Z_RADOBS(I*INBCAN))
   ENDIF
  ENDDO
!     2. Calcul du rapport droit de l'Eq et de la diffrence des deux rapports
!     -----------------------------------------------------------------------
  DO J=1, INBCAN-1
    DO JLEV=16, IJPLEV-1
      IF ( (ZFC(J+(I-1)*INBCAN,JLEV) > 0.) .AND. (ZFC(I*INBCAN,JLEV) > 0.)    &
         & .AND. Z_RAPG(J) > -9000. ) THEN
         ZRAPD=ZFC(J+(I-1)*INBCAN,JLEV)/ZFC(INBCAN*I,JLEV)
         ZDRAP(J,JLEV)=Z_RAPG(J)-ZRAPD
      ENDIF
    ENDDO
  ENDDO
!     3. Minimisation
!     ---------------
  DO J=1, INBCAN-1
     Z_DMIN=MINVAL(ABS(ZDRAP(J,:)))
     IF ( Z_DMIN < 9000. )  THEN
        DO JLEV=16, IJPLEV-1
           IF ( ABS(ZDRAP(J,JLEV)) == Z_DMIN ) THEN
              ZALT(J)=PPRES(JLEV)
              JL_PN(J)=JLEV
           ENDIF
        ENDDO
     ENDIF
  ENDDO
!      4. Calcul des poids
!     -------------------
  DO J=1, INBCAN-1
     IF ( ZALT(J) > -9000. ) THEN

        ZDTAU(J)=ZTAU(JL_PN(J)-1,J+(I-1)*INBCAN)-ZTAU(JL_PN(J),J+(I-1)*INBCAN)
        Z_B1=C1*C2*Z_WAVEN(J)**4
        Z_B2=EXP(C2*Z_WAVEN(J)/ZTM(I,JL_PN(J)))
        Z_DB(J)=Z_B1*Z_B2/(ZTM(I,JL_PN(J))*(Z_B2-1))**2
        ZTP(J)=(ZTM(I,JL_PN(J)-1) - ZTM(I,JL_PN(J)+1))/&
        &LOG(PPRES(JL_PN(J)-1)/PPRES(JL_PN(J)+1))

        ZDTAU(INBCAN) = ZTAU(JL_PN(J)-1,I*INBCAN)-ZTAU(JL_PN(J),I*INBCAN)
        Z_B1=C1*C2*Z_WAVEN(INBCAN)**4
        Z_B2=EXP(C2*Z_WAVEN(INBCAN)/ZTM(I,JL_PN(J)))
        Z_DB(INBCAN)=Z_B1*Z_B2/(ZTM(I,JL_PN(J))*(Z_B2-1))**2
        IF ( ZFC(I*INBCAN,JL_PN(J)) > 0. ) THEN
           Z_WK(J)=ZTP(J)*(ZDTAU(J)*Z_DB(J)*ZFC(I*INBCAN,JL_PN(J)) - &
           &ZDTAU(INBCAN)*Z_DB(INBCAN)*ZFC(J+(I-1)*INBCAN,JL_PN(J)))/   &
           &ZFC(I*INBCAN,JL_PN(J))**2
        ENDIF
     ENDIF
  ENDDO


  ZWKMAX = MAXVAL(ABS(Z_WK))
  DO J=1, INBCAN-1
     IF (ZWKMAX == Z_WK(J)) J_MAX(I)=JL_PN(J)
     IF ( Z_WK(J) < 0.3*ZWKMAX)  Z_WK(J)=0
  ENDDO

  PCT(I)=0
  Z_POIDS=0

  DO J=1, INBCAN-1
     IF ( ZALT(J) > -9000. .AND. Z_WK(J) > 0. ) THEN
        PCT(I) = PCT(I) + ZALT(J)*Z_WK(J)**2
        Z_POIDS  = Z_POIDS + Z_WK(J)**2
     ENDIF
  ENDDO
  IF ( Z_POIDS > 0 ) THEN
     PCT(I) = PCT(I)/Z_POIDS
  ELSE
     PCT(I) = -9999.
  ENDIF
!      5.  Traitement de la pression du sommet des nuages
!          et Calcul de l'emissivite
!      --------------------------------------------------
  IF ( PCT(I) > -9999. ) THEN
     ZPROFCV(1,I)=PCT(I)
     ZPROFCV(2,I)=1.0      ! corps noir
  ENDIF
ENDDO PACKET_LOOP1

DEALLOCATE(Z_DB,ZTP,Z_WAVEN,ZDTAU,ZTM)

ALLOCATE (ZPRAD(I_KNCHPF))
ALLOCATE (ZTAUSFC(I_KNCHPF))
ALLOCATE (ZTBCLR(I_KNCHPF))
ALLOCATE (ZRADCLR(I_KNCHPF))
ALLOCATE (ZTBTOT(I_KNCHPF))
ALLOCATE (ZRADTOT(I_KNCHPF))
ALLOCATE (ZRADCLD(I_KNCHPF))
ALLOCATE (ZRADCLDLEV(NLSAT,I_KNCHPF))
ALLOCATE (ZVAROUT(4,I_KNCHPF))

DO J = 1, K_IEND
  ZPRES(:,J) = PPRES(:)
ENDDO
! Appel de RTTOV pour le calcul de l'emissivite
CALL RTTOV_EC(Z_IFAIL, KSAT, I_KNCHPF, K_IEND, NLSAT,               &
   &    ICHID, IPFID,                                         &
   &    ZPRES, PROF, PROFS, PROFSS, KSURF, ZEMIS, ZPROFCV,    &
   &    PANGL, PANGLA, PANGS, PANGSA, PLAT, POROG,            &
   &    .FALSE., .FALSE., LLTRACER,                           &
   &    ZTBCLR, ZRADCLR, ZTBTOT, ZRADTOT, ZRADCLD, ZRADCLDLEV,&
   &    ZTAU, ZTAUSFC, .FALSE., Z_TBOBS, ZVAROUT) 

      IF ( Z_IFAIL(1) >= 20 ) THEN
         WRITE(*,*) 'ERREUR DANS RTTOV ', Z_IFAIL(1)
         CALL EXIT(1)
      ENDIF

DEALLOCATE(ZTAUSFC,ZEMIS)

ZPRAD(:) = ZRADTOT(:)

! Emissivity computation

PACKET_LOOP2: DO I=1,K_IEND
      IF ( PCT(I) > -9999. ) THEN
       IF ( ABS(ZPRAD(I*INBCAN)-ZPRADCLR(I*INBCAN)) > 0. ) THEN
         P_ZEM(I)=(Z_RADOBS(I*INBCAN)-ZPRADCLR(I*INBCAN))/  &
         & (ZPRAD(I*INBCAN)-ZPRADCLR(I*INBCAN))
       ENDIF
      ENDIF
!     Test d'incoherences eventuelles et definition du flag nuage
!     ----------------------------------------------------------
! Clear Pixel
!    CLDFLG(I)=1
! Rejected pixel
    IF ( PCT(I) <  0. ) THEN
!     PCT(I)=-999.0_JPRB
     PCT(I)=500.0_JPRB
     P_ZEM(I)=0.0_JPRB
!     CLDFLG(I)=0
    ENDIF

    IF ( PCT(I) > 900._JPRB .OR. P_ZEM(I) < 0._JPRB ) THEN
       IF ( Z_RADOBS(I*INBCAN)-ZPRADCLR(I*INBCAN) > -1.5  .AND. &
           & Z_RADOBS(I*INBCAN)-ZPRADCLR(I*INBCAN) < 3.0 ) THEN
          PCT(I)=500.0_JPRB
          P_ZEM(I)=0.0_JPRB
!          CLDFLG(I)=0
       ENDIF
    ENDIF
    IF ( P_ZEM(I) < 0. ) P_ZEM(I)=0._JPRB
    IF ( P_ZEM(I) > 1. ) P_ZEM(I)=1._JPRB

    IFILE=130+MYPROC

ENDDO PACKET_LOOP2

DEALLOCATE(ZTAU,ZPRADCLR,ZPRAD,ZTB)
DEALLOCATE(Z_IFAIL,Z_TBOBS,Z_RADOBS)
DEALLOCATE(Z_RAPG,ZDRAP,ZALT,JL_PN,Z_WK)
DEALLOCATE(I_KNCH,ZPRES)
DEALLOCATE(ZCOEF_FF_CWN, ZCOEF_FF_BCO, ZCOEF_FF_BCS, ZCOEF_PLANCK1, ZCOEF_PLANCK2)
IF(ALLOCATED(ZTBCLR))DEALLOCATE(ZTBCLR)
IF(ALLOCATED(IPFID))DEALLOCATE(IPFID)
IF(ALLOCATED(ZRADCLD))DEALLOCATE(ZRADCLD)
IF(ALLOCATED(ICHID))DEALLOCATE(ICHID)
IF(ALLOCATED(ZRADCLR))DEALLOCATE(ZRADCLR)
IF(ALLOCATED(ZFC))DEALLOCATE(ZFC)
IF(ALLOCATED(ZRADTOT))DEALLOCATE(ZRADTOT)
IF(ALLOCATED(ZTBTOT))DEALLOCATE(ZTBTOT)
IF(ALLOCATED(ZRADCLDLEV))DEALLOCATE(ZRADCLDLEV)
IF(ALLOCATED(ZVAROUT))DEALLOCATE(ZVAROUT)

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

END SUBROUTINE CO2CLDAIRS
