SUBROUTINE ACNEBSM ( KIDIA, KFDIA, KLON, KTDIA, KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT -
 & PT, PQ, PQL, PQI, &
 & PAPHI, PAPRSF, PCP, PR, &
 & PTS, PNEIJ, PLSM, PGM, PVETAF, &
 ! - OUTPUT -
 & PQCS, PNEBS, PQCS0, PNEBS0 )  

!**** *ACNEBSM* - CALCUL DU SEUIL D'HUMIDITE CRITIQUE, DE LA 
!                 NEBULOSITE ET DE CONDENSATION - EVAPORATION
!                 SELON SMITH, QJRMS 90.
!                 COMPUTATION OF CRITICAL RELATIVE HUMIDITY,
!                 CLOUDINESS AND CONDENSATION - EVAPORATION
!                 FROM SMITH (QJRMS, 1990).

!**   Interface.
!     ----------
!        *CALL* *ACNEBSM*

! -   ARGUMENTS D'ENTREE.
!     -------------------

! - NOM DES PARAMETRES DE DIMENSIONNEMENT DE LA PHYSIQUE.

! KIDIA      : INDICE DE DEPART DES BOUCLES VECTORISEES SUR L'HORIZONT..
!            : START OF HORIZONTAL LOOP 
! KFDIA      : INDICE DE FIN DES BOUCLES VECTORISEES SUR L'HORIZONTALE.
!            : END OF HORIZONTAL LOOP
! KLON       : DIMENSION HORIZONTALE DES TABLEAUX.
!            : HORIZONTAL DIMENSION  
! KTDIA      : INDICE DE DEPART DES BOUCLES VERTICALES. 
!            : START OF THE VERTICAL LOOP IN THE PHYSICS. 
! KLEV       : DIMENSION VERTICALE DES TABLEAUX "FULL LEVEL".
!            : END OF VERTICAL LOOP AND VERTICAL DIMENSION

! - 1D (1:KLEV) .

! PTS        : TEMPERATURE DE SURFACE.
!            : SURFACE TEMPERATURE.
! PNEIJ      : PROPORTION DE LA MAILLE RECOUVERTE DE NEIGE.
!            : SNOW FRACTION.
! PLSM       : INDICE TERRE/MER.
!            : LAND/SEA MASK.
! PGM        : FACTEUR D'ECHELLE.
!            : MAPPING FACTOR.
! PVETAF     : COORDONNEE VERTICALE ETA.
!            : VERTICAL COORDINATE ETA.

! - 2D (0:KLEV) .

! PAPHI      : GEOPOTENTIEL AUX DEMI-NIVEAUX.
!            : GEOPOTENTIAL ON HALF-LEVELS.

! - 2D (1:KLEV) .

! PT         : TEMPERATURE
!            : TEMPERATURE
! PQ         : HUMIDITE SPECIFIQUE DE LA VAPEUR D'EAU.
!            : SPECIFIC HUMIDITY OF WATER VAPOUR.
! PQL        : HUMIDITE SPECIFIQUE DE L'EAU CONDENSEE LIQUIDE.
!            : SPECIFIC HUMIDITY OF LIQUID CONDENSATED WATER.
! PQI        : HUMIDITE SPECIFIQUE DE L'EAU CONDENSEE GLACE.
!            : SPECIFIC HUMIDITY OF SOLID CONDENSATED WATER.
! PAPRSF     : PRESSION AUX NIVEAUX DES COUCHES.
!            : PRESSURE ON FULL LEVELS.
! PCP        : CHALEUR MASSIQUE A PRESSION CONSTANTE DE L'AIR.
!            : SPECIFIC HEAT AT CONSTANT PRESSURE FOR AIR.
! PR         : CONSTANTE DES GAZ POUR L'AIR.
!            : GAS CONSTANT FOR AIR.

! -   ARGUMENTS DE SORTIE.
!     --------------------

! - 2D (1:KLEV) .

! PQCS       : CONTENU "STRATIFORME" EN CONDENSAT NUAGEUX (LIQ. + SOL.).
!            : STRATIRORM CLOUD WATER (LIQUID + SOLID).
! PNEBS      : NEBULOSITE PARTIELLE STRATIFORME APRES AJUSTEMENT.
!            : STRATIFORM FRACTIONAL CLOUDINESS APRES AJUSTEMENT.
! PQCS0      : CONTENU "STRATIFORME" EN CONDENSAT NUAGEUX POUR RAYT.
!            : STRATIRORM CLOUD WATER (LIQUID + SOLID) FOR RADIATION.
! PNEBS0     : NEBULOSITE PARTIELLE STRATIFORME POUR RAYT.
!            : STRATIFORM FRACTIONAL CLOUDINESS FOR RADIATION.

!-----------------------------------------------------------------------

!     Auteur.
!     -------
!     99-07, Philippe Lopez, CNRM/GMME/RECYF

!     Modifications.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     2004-10-15, F. Bouyssel : Introduction of PGM
!     2005-03-03, F. Bouyssel : Improve consistency between Ns and Qs
!                             : Qsat(Tl,P) instead of Qsat(T,P)
!     2005-07-18, F. Bouyssel : Introduction of RFACNSM (change in cloudiness)
!                             : Modification of RHcrit above RETAMIN
!     2005-09-26, F. Bouyssel : Introduction of RQCRNS (change in Qc0,Neb0)
!     2005-11-10, F. Bouyssel : Vertical smoothing of cloudiness (LNSMLIS)
!     2006-01-25, F. Bouyssel : Modification in the use of RFACNSM
!     2006-10-30, F. Bouyssel : Autoconversion before radiation

!-----------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMPHY    , ONLY : LNSMLIS, LAUTONEB
USE YOMCST    , ONLY : RD   , RV   , RTT  , RDT  ,&
 & RCS  , RCW  , RCPV , RLVTT, RLSTT, RETV , RALPW, RALPS,&
 & RALPD, RBETW, RBETS, RBETD, RGAMW, RGAMS, RGAMD
USE YOMGEM   , ONLY : TEQH
USE YOMPHY0  , ONLY : RHCRIT1, RHCRIT2, GRHCMOD, RETAMIN, RFACNSM, RQCRNS,&
 & RDTFAC
USE YOMPHY2  , ONLY : TSPHY

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS   (KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNEIJ (KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM  (KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM   (KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVETAF(KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHI (KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT    (KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ    (KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQL   (KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQI   (KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCP   (KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR    (KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQCS  (KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNEBS (KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQCS0 (KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNEBS0(KLON,KLEV) 

REAL(KIND=JPRB) :: ZRHCRI(KLON,KLEV), ZICE(KLON,KLEV)
REAL(KIND=JPRB) :: ZQLI(KLON,KLEV), ZQICE(KLON,KLEV)
REAL(KIND=JPRB) :: ZAUTOL(KLON,KLEV), ZAUTOI(KLON,KLEV)
REAL(KIND=JPRB) :: ZVETAF(KLEV)
REAL(KIND=JPRB) :: ZRHCRI1(KLON), ZA(KLON), ZB(KLON), ZC(KLON) 
REAL(KIND=JPRB) :: ZSURF(KLEV)
REAL(KIND=JPRB) :: ZFACT,ZFACT0,ZFACTA,ZFACTB,ZFACTC
REAL(KIND=JPRB) :: ZEPS1,ZRHC,ZRATQ
REAL(KIND=JPRB) :: ZSQRT6,ZRDSRV,ZQL,ZQI,ZLV
REAL(KIND=JPRB) :: ZLS,ZLEFF,ZTLIQ,ZSIGS,ZRAT2,ZQC,ZQCS
REAL(KIND=JPRB) :: ZESAT,ZESP,ZQSAT
INTEGER(KIND=JPIM) :: JLON,JLEV
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "acmicro.intfb.h"
#include "fcttrm.h"
#include "fctdoi.h"
                                                                                
!     ------------------------------------------------------------------

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

!     ------------------------------------------------------------------

!     I - CRITICAL RELATIVE HUMIDITY PROFILE DEPENDENT ON THE LOCAL RESOLUTION.

ZFACT0=(RETAMIN*(RETAMIN-1.0_JPRB))**2
ZFACTA=(2.0_JPRB*RETAMIN-1.0_JPRB)
ZFACTB=(1.0_JPRB-3._JPRB*RETAMIN**2)
ZFACTC=(3._JPRB*RETAMIN-2.0_JPRB)*RETAMIN

DO JLON=KIDIA,KFDIA
  ZRHCRI1(JLON)=RHCRIT1+(RHCRIT2-RHCRIT1) &
   &           * GRHCMOD * EXP(-1.0_JPRB/(TEQH*PGM(JLON)))
  ZFACT=(RHCRIT2-ZRHCRI1(JLON))/ZFACT0
  ZA(JLON)=ZFACTA*ZFACT
  ZB(JLON)=ZFACTB*ZFACT
  ZC(JLON)=ZFACTC*ZFACT
ENDDO

DO JLEV=KTDIA,KLEV
  ZVETAF(JLEV) = MAX(PVETAF(JLEV),RETAMIN)
ENDDO
                                                                                
DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZRHCRI(JLON,JLEV) = ZA(JLON) * ZVETAF(JLEV)**3 &
     & + ZB(JLON) * ZVETAF(JLEV)**2 &
     & + ZC(JLON) * ZVETAF(JLEV) &
     & + RHCRIT2
  ENDDO   
ENDDO   

IF (RQCRNS /= 0.0_JPRB) THEN
  DO JLEV=KTDIA,KLEV
    ZSURF(JLEV) = 1.0_JPRB-EXP(-(1.0_JPRB-PVETAF(JLEV))/RQCRNS)
  ENDDO
ELSE
  DO JLEV=KTDIA,KLEV
    ZSURF(JLEV) = 1.0_JPRB
  ENDDO
ENDIF
     
!     II - CALCUL DE LA CONDENSATION - EVAPORATION ET DE LA NEBULOSITE
!          COMPUTATION OF CONDENSATION - EVAPORATION AND CLOUDINESS
!          FROM SMITH (QJRMS, 1990).

ZEPS1=1.E-12_JPRB
ZSQRT6 = SQRT(6._JPRB)
ZRDSRV = RD / RV

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
      !
    ZRHC = ZRHCRI(JLON,JLEV)
    ZQL = PQL(JLON,JLEV)
    ZQI = PQI(JLON,JLEV)
    ZQC = ZQL + ZQI
    ZICE(JLON,JLEV) = FONICE(PT(JLON,JLEV))
    ZLV = FOLH(PT(JLON,JLEV),0.0_JPRB) 
    ZLS = FOLH(PT(JLON,JLEV),1.0_JPRB) 
    ZLEFF = ZLV * (1.0_JPRB-ZICE(JLON,JLEV)) + ZLS * ZICE(JLON,JLEV)
    ZTLIQ = PT(JLON,JLEV) - ( ZLV*ZQL + ZLS*ZQI ) / PCP(JLON,JLEV)
    ZESAT = FOEW(ZTLIQ,0.0_JPRB) * (1.0_JPRB-ZICE(JLON,JLEV)) &
     &    + FOEW(ZTLIQ,1.0_JPRB) *           ZICE(JLON,JLEV)  
    ZESP = ZESAT / PAPRSF(JLON,JLEV)
    ZQSAT = FOQS(ZESP)
      !
    ZSIGS = (1.0_JPRB-ZRHC) / ZSQRT6 * ZQSAT &
     & / (1.0_JPRB + ZLEFF * ZLEFF * ZQSAT  &
     & * ZRDSRV / PR(JLON,JLEV) &
     & / ZTLIQ / ZTLIQ / PCP(JLON,JLEV))  
      !
    ZRATQ = (PQ(JLON,JLEV)+ZQC)/ZQSAT
    ZRAT2 = (ZRATQ - 1.0_JPRB)/(1.0_JPRB - ZRHC)
      !
    IF(ZRATQ <= ZRHC) THEN
      ZQCS = 0.0_JPRB
      PNEBS(JLON,JLEV) = 0.0_JPRB
    ELSEIF(ZRATQ <= 1.0_JPRB.AND.ZRATQ > ZRHC) THEN
      ZQCS = (1.0_JPRB + ZRAT2)**3 / ZSQRT6
      PNEBS(JLON,JLEV) = 0.5_JPRB * (1.0_JPRB+ZRAT2)**2
    ELSEIF(ZRATQ < (2.0_JPRB-ZRHC).AND.ZRATQ > 1.0_JPRB) THEN
      ZQCS = ZRAT2 * ZSQRT6 + (1.0_JPRB - ZRAT2)**3 / ZSQRT6
      PNEBS(JLON,JLEV) = 1.0_JPRB - 0.5_JPRB*(1.0_JPRB-ZRAT2)**2
    ELSE
      ZQCS = ZRAT2 * ZSQRT6
      PNEBS(JLON,JLEV) = 1.0_JPRB
    ENDIF
      !
    PQCS (JLON,JLEV) = ZSURF(JLEV) * ZQCS * ZSIGS
    PNEBS(JLON,JLEV) = ZSURF(JLEV) * PNEBS(JLON,JLEV) * RFACNSM
    PNEBS(JLON,JLEV) = MIN(1.0_JPRB-ZEPS1,MAX(PNEBS(JLON,JLEV),ZEPS1))
      !
    PQCS0 (JLON,JLEV) = PQCS (JLON,JLEV)
    PNEBS0(JLON,JLEV) = PNEBS(JLON,JLEV)
      !
  ENDDO
ENDDO

!     III - CORRECTION DU PROFIL NUAGEUX EN CAS DE FEUILLETAGE VERTICAL
!           CORRECTION OF CLOUD PROFILE IN CAS OF VERTICAL OSCILLATIONS

IF (LNSMLIS) THEN

  DO JLEV=KTDIA+1,KLEV-1
    DO JLON=KIDIA,KFDIA
      IF (PNEBS(JLON,JLEV)<MIN(PNEBS(JLON,JLEV-1),PNEBS(JLON,JLEV+1))) THEN
        IF (PNEBS(JLON,JLEV-1)<PNEBS(JLON,JLEV+1)) THEN
          PQCS0 (JLON,JLEV) = PQCS (JLON,JLEV-1)
          PNEBS0(JLON,JLEV) = PNEBS(JLON,JLEV-1)
        ELSE
          PQCS0 (JLON,JLEV) = PQCS (JLON,JLEV+1)
          PNEBS0(JLON,JLEV) = PNEBS(JLON,JLEV+1)
        ENDIF
      ENDIF
    ENDDO
  ENDDO

ENDIF
                                                                                
!     IV - AUTOCONVERSION AVANT RAYONNEMENT
!          AUTOCONVERSION BEFORE RADIATION

IF (LAUTONEB) THEN

  DO JLEV=KTDIA,KLEV
    DO JLON=KIDIA,KFDIA
      ZQLI (JLON,JLEV)=PQCS0(JLON,JLEV)*(1.0_JPRB-ZICE(JLON,JLEV))
      ZQICE(JLON,JLEV)=PQCS0(JLON,JLEV)*ZICE(JLON,JLEV)
    ENDDO
  ENDDO

  CALL ACMICRO( KIDIA, KFDIA, KLON, KTDIA, KLEV,&
   & PNEBS0, PT  , ZQLI , ZQICE , PTS , PNEIJ , PLSM,&
   & ZAUTOL, ZAUTOI )

  DO JLEV=KTDIA,KLEV
    DO JLON=KIDIA,KFDIA
      PQCS0(JLON,JLEV)=PQCS0(JLON,JLEV) &
       & -(ZAUTOL(JLON,JLEV)+ZAUTOI(JLON,JLEV))*TSPHY
    ENDDO
  ENDDO

ENDIF
                                                                                
IF (LHOOK) CALL DR_HOOK('ACNEBSM',1,ZHOOK_HANDLE)
END SUBROUTINE ACNEBSM
