!OPTIONS XOPT(NOEVAL)
SUBROUTINE FPCINCAPE(KST,KEND,KPROMA,KLEV,KLEVST,PT,PRP,PQV,PCAPE,PCIN,KLCL,KFCL,KEL)

! --------------------------------------------------------------
! **** *FPCINCAPE* COMPUTE CAPE AND CIN.
! --------------------------------------------------------------
! SUBJECT:
!    ROUTINE COMPUTING CAPE AND CIN  

! INTERFACE:
!    *CALL* *FPCINCAPE*

! --------------------------------------------------------------
! -   INPUT ARGUMENTS
!     ---------------

! - DIMENSIONING

! KST      : FIRST INDEX OF LOOPS
! KEND     : LAST INDEX OF LOOPS
! KPROMA   : DEPTH OF THE VECTORIZATION ARRAYS
! KLEV     : END OF VERTICAL LOOP AND VERTICAL DIMENSION

! - VARIABLES
! KLEVST   : LEVEL FROM WHICH PARCEL IS RAISED
! PT       : TEMPERATURE (K)
! PRP      : PRESSURE (PA)
! PQV      : WATER VAPOUR SPECIFIC HUMIDITY (NO DIM)

! --------------------------------------------------------------
! -   OUTPUT ARGUMENTS
!     ---------------
! - VARIABLES
! PCAPE    : CAPE - CONVECTIVE AVAILABLE POTENTIAL ENERGY (J/KG)
!                   (POTENTIALLY AVAILABLE CONVECTIVE KINETIC ENERGY)
! PCIN     : CIN - CONVECTIVE INHIBITION (J/KG)

! --------------------------------------------------------------
! -   IMPLICITE ARGUMENTS
!     -------------------
! YOMCAPE 
! YOMCST
! FCTTRM
! FCTAST
! FCTTIM

! --------------------------------------------------------------
! EXTERNALS:

! METHOD:

!      THE PARCEL IS RAISED FROM LEVEL (LO which is equal KLEVST) 
!      TO THE LEVEL OF CONDENSATION (LC),
!      FURTHER TO ITS LEVEL OF FREE CONVECTION (LFC), WHERE THE 
!      PARCEL BECOMES BUOYANT,
!      THEN FURTHER TO THE LEVEL OF NEUTRAL BUOYANCY (LNB), WHERE THE
!      PARCEL BECOMES UNBUOYANT.

!      ALL COMPUTATIONS ARE DONE WITHOUT ENTRAINMENT OF ENVIRONMENTAL AIR.

!      CIN IS MASS SPECIFIC ENERGY TO RAISE THE PARCEL FROM 
!          from LO to LC further to LFC.
!          ONLY THE SUM OF NEGATIVE TERMS.
!      CAPE IS MASS SPECIFIC ENERGY  PROVIDED BY THE RAISE OF THE PARCEL
!          from LFC to LNB.
!          ONLY THE SUM OF POSITIVE TERMS.

! AUTEUR/AUTHOR:   2001-03, J.M. PIRIOU, N. PRISTOV.

! MODIFICATIONS:
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
! --------------------------------------------------------------

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

USE YOMCAPE  , ONLY :  NCAPEITER,NETAPES  ,GCAPERET
USE YOMCST   , ONLY :  RTT      ,RDAY     ,REPSM    ,RETV     ,&
 & RCW      ,REA      ,RD       ,RV       ,RCPD     ,RCPV     ,&
 & RCS      ,RLVTT    ,RLSTT    ,RBETS    ,RALPW    ,RBETW    ,&
 & RGAMW    ,RALPS    ,RGAMS    ,RALPD    ,RBETD    ,RGAMD    ,&
 & RG
USE YOMFPC , ONLY : RENTRA

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVST 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRP(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQV(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCAPE(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCIN(KPROMA) 
INTEGER(KIND=JPIM)   ,INTENT(OUT)   :: KLCL(KPROMA)
INTEGER(KIND=JPIM)   ,INTENT(OUT)   :: KFCL(KPROMA)
INTEGER(KIND=JPIM)   ,INTENT(OUT)   :: KEL(KPROMA)
INTEGER(KIND=JPIM)      :: IPREVIOUS_NULL_ZRT(KPROMA)
INTEGER(KIND=JPIM) :: JLEV,JLON,JIT,JETAPES
REAL(KIND=JPRB) :: ZDLOG,ZBUOY,ZTV1,ZTV2,ZQV2,ZRT,ZT2,ZDT,ZST,ZDELARG,ZL,ZCP, &
 & ZRAPP,ZFDERQS,ZADD,ZDERL,ZRDLOG,ZZQV  
REAL(KIND=JPRB) :: ZBUOYPREC(KPROMA),ZQS(KPROMA),ZQV(KPROMA), ZQV1(KPROMA), &
 & ZT(KPROMA), ZT1(KPROMA),ZQL(KPROMA),ZQI(KPROMA),ZSQV(KPROMA), &
 & ZSQL(KPROMA),ZSQI(KPROMA),ZTDEPART(KPROMA),ZLOG(KPROMA), &
 & ZPARRIVEE(KPROMA),ZPDEPART(KPROMA),ZQVDEPART(KPROMA),ZZT(KPROMA)  
REAL(KIND=JPRB) :: ZFDERFOLH0(KPROMA),ZDELARG0(KPROMA),ZL0(KPROMA),ZCP0(KPROMA)
REAL(KIND=JPRB) :: ZFDERQS0(KPROMA)
REAL(KIND=JPRB) :: ZHOOK_HANDLE,ZDZ
!---------

!  FUNCTIONS
#include "fctast.h"
#include "fcttrm.h"
#include "fcttim.h"

!-------------------------------------------------
! INITIALIZE TO ZERO.
!-------------------------------------------------

IF (LHOOK) CALL DR_HOOK('FPCINCAPE',0,ZHOOK_HANDLE)
PCIN(KST:KEND)=0.0_JPRB
PCAPE(KST:KEND)=0.0_JPRB
ZBUOYPREC(KST:KEND)=0.0_JPRB
ZT (KST:KEND)=PT (KST:KEND,KLEVST)
ZQV(KST:KEND)=PQV(KST:KEND,KLEVST)
ZQL(KST:KEND)=0.0_JPRB
ZQI(KST:KEND)=0.0_JPRB

KLCL(KST:KEND)=-1
KFCL(KST:KEND)=-1
KEL(KST:KEND)=-1
IPREVIOUS_NULL_ZRT(KST:KEND)=999999

DO JLEV=KLEVST,2,-1
  DO JLON=KST,KEND
    !
    !-------------------------------------------------
    ! SATURATION SPECIFIC HUMIDITY.
    !-------------------------------------------------
    !
    ZQS(JLON)=FOQS(FOEW(ZT(JLON), &
     & MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT(JLON))))/PRP(JLON,JLEV))  
    !
    !-------------------------------------------------
    ! PRESSURE AND BUOYANCY.
    !-------------------------------------------------
    !
    ZTV1=ZT(JLON)*(1.0_JPRB+ZQV(JLON)/(1.0_JPRB-ZQV(JLON))*RV/RD)/ &
     & (1.0_JPRB+ZQV(JLON)/ &
     & (1.0_JPRB-ZQV(JLON))+ZQL(JLON)/(1.0_JPRB-ZQL(JLON))+ZQI(JLON)/(1.0_JPRB-ZQI(JLON)))  
    ZTV2=PT(JLON,JLEV)*(1.0_JPRB+PQV(JLON,JLEV)/(1.0_JPRB-PQV(JLON,JLEV))*RV/RD)/&
     & (1.0_JPRB+PQV(JLON,JLEV)/(1.0_JPRB-PQV(JLON,JLEV)) )  
    ZBUOY=(ZTV1/ZTV2-1.0_JPRB)*(RD+(RV-RD)*PQV(JLON,JLEV))*PT(JLON,JLEV)
    !
    !-------------------------------------------------
    ! CIN AND CAPE INTEGRALS.
    !-------------------------------------------------
    !
    ZDLOG=LOG(PRP(JLON,MIN(KLEVST,JLEV+1))/PRP(JLON,JLEV)) &
     & * MAX(0,-SIGN(1,JLEV-KLEVST))  
    ZRT=0.5_JPRB*(ZBUOY+ZBUOYPREC(JLON))*ZDLOG
    !------------------------------------------
    ! CUMULATE CAPE IF POSITIVE CONTRIBUTION.
    !------------------------------------------
    PCAPE(JLON)=PCAPE(JLON)+MAX(0.0_JPRB,ZRT)
    !------------------------------------------
    ! CUMULATE CIN IF NEGATIVE CONTRIBUTION AND BELOW LFC.
    !------------------------------------------
    IF(PCAPE(JLON) == 0.0_JPRB) PCIN(JLON)=PCIN(JLON)+MIN(0.0_JPRB,ZRT)
    ZBUOYPREC(JLON)=ZBUOY
    !
    !-------------------------------------------------
    ! IF THE PARCEL IS SUPERSATURATED, SUPERSATURATION IS REMOVED.
    ! THIS IS DONE THROUGH AN ISOBARIC TRANSFORMATION FROM (ZT,ZQV)
    ! TO (ZT1,ZQV1).
    !       Solution for T
    !            f(T)=cp*(T-T0)+L*(q-q0)=0
    !            with constraint q=qs(T,p0),
    !       it is solved by the method of Newton, iteration
    !       T --> T-f(T)/f'(T), with starting point ZT.
    !-------------------------------------------------
    !
    ZT1(JLON)=ZT(JLON)
    ZQV1(JLON)=FOQS(FOEW(ZT1(JLON),MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT1(JLON))))/ &
     & PRP(JLON,JLEV))  
    IF ((ZQV1(JLON)<=ZQV(JLON)).AND.(KLCL(JLON)==-1)) THEN
      KLCL(JLON)=JLEV
    ENDIF
    IF ((PCAPE(JLON) > 0.0_JPRB).AND.(KFCL(JLON)==-1)) THEN
      KFCL(JLON)=JLEV
    ENDIF
    IF ((ZRT <= 0.0_JPRB).AND.(JLEV<KFCL(JLON)).AND.(JLEV<IPREVIOUS_NULL_ZRT(JLON)-1)) THEN
      KEL(JLON)=JLEV
    ENDIF
    IF (ZRT <= 0.0_JPRB) THEN
      IPREVIOUS_NULL_ZRT(JLON)=JLEV
    ENDIF
 ENDDO

  DO JIT=1,NCAPEITER
!   The next two loops are not fused because one single loop was leading 
!   to problems when vectorization is active on VPP5000 ; I don't understand
!   why. Ryad El Khatib. Well let's try again on NEC ;-)
    DO JLON=KST,KEND
      !
      !-------------------------------------------------
      ! LATENT HEAT
      !-------------------------------------------------
      !
      ZDELARG0(JLON)=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT1(JLON)))
      ZL0(JLON)=FOLH(ZT1(JLON),ZDELARG0(JLON))
      !
      !-------------------------------------------------
      ! NEWTON'S LOOP
      !-------------------------------------------------
      !
      ZCP0(JLON)=RCPD*(1.0_JPRB-ZQV1(JLON))+RCPV*ZQV1(JLON)
      ZRAPP=RV/RD*PRP(JLON,JLEV)/FOEW(ZT1(JLON),ZDELARG0(JLON))
      ZFDERQS0(JLON)=ZRAPP/(ZRAPP-RETV)**2*&
       & ( ( RBETW+ZDELARG0(JLON)*RBETD )-( RGAMW+ZDELARG0(JLON)*RGAMD ) &
       & * ZT1(JLON) ) / ( ZT1(JLON)*ZT1(JLON) )  
    ENDDO
    DO JLON=KST,KEND
      ZFDERFOLH0(JLON)=-RV*(RGAMW+ZDELARG0(JLON)*RGAMD)
      ZT1(JLON)=ZT1(JLON)-(ZCP0(JLON)*(ZT1(JLON)-ZT(JLON))+ZL0(JLON)*(ZQV1(JLON)-ZQV(JLON)))&
       & /(ZCP0(JLON)+(RCPV-RCPD+ZL0(JLON))* ZFDERQS0(JLON)+ZQV1(JLON)*ZFDERFOLH0(JLON))  
      !
      !-------------------------------------------------
      ! SATURATION SPECIFIC HUMIDITY
      !-------------------------------------------------
      !
      ZQV1(JLON)=FOQS(FOEW(ZT1(JLON),MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT1(JLON))))/ &
       & PRP(JLON,JLEV))  
    ENDDO
  ENDDO

  DO JLON=KST,KEND
    ZADD=GCAPERET*(ZQV(JLON)-ZQV1(JLON))
                        
    ZSQL(JLON)=ZQL(JLON)+ZADD*MAX(0.0_JPRB,SIGN(1.0_JPRB,ZT1(JLON)-RTT))
    ZSQI(JLON)=ZQI(JLON)+ZADD*MAX(0.0_JPRB,-SIGN(1.0_JPRB,ZT1(JLON)-RTT))
    !
    !-------------------------------------------------
    ! MOIST ADIABATIC ASCENT.
    ! TRANSFORMATION FROM (ZT1,ZQV1) TO (ZT2,ZQV2).
    !      Solution for T
    !             f(T)=cp*(T-T0)+L*(q-q0)+phi-phi0=0
    !      either f(T)=cp*(T-T0)+L*(q-q0)-R*T*log(p/p0)=0
    !            with constraint q=qs(T,p), knowing that q0=qs(T0,p0)
    !       it is solved by the method of Newton, iteration
    !       T --> T-f(T)/f'(T), with starting point ZT1.
    !-------------------------------------------------
    !
    ZZT(JLON)=ZT1(JLON)
  ENDDO
  !-------------------------------------------------
  ! CALCULATION IS DIVIDED IN MORE STEPS IN ORDER
  ! TO GET MORE PRECISE VALUES
  !-------------------------------------------------
  DO JETAPES=1,NETAPES
    DO JLON=KST,KEND
      ZPDEPART(JLON)=PRP(JLON,JLEV)+(PRP(JLON,JLEV-1)-PRP(JLON,JLEV))  &
       & *REAL(JETAPES-1)/REAL(NETAPES)  
      ZPARRIVEE(JLON)=PRP(JLON,JLEV)+(PRP(JLON,JLEV-1)-PRP(JLON,JLEV)) &
       & *REAL(JETAPES)/REAL(NETAPES)  
      ZTDEPART(JLON)=ZZT(JLON)
      ZQVDEPART(JLON)=FOQS(FOEW(ZTDEPART(JLON),MAX(0.0_JPRB, &
       & SIGN(1.0_JPRB,RTT-ZTDEPART(JLON))))/ZPDEPART(JLON))  
      ZLOG(JLON)=LOG(ZPARRIVEE(JLON)/ZPDEPART(JLON))
    ENDDO
    DO JIT=1,NCAPEITER
      DO JLON=KST,KEND
        !
        !-------------------------------------------------
        ! SATURATION SPECIFIC HUMIDITY
        !-------------------------------------------------
        !
        ZZQV=FOQS(FOEW(ZZT(JLON),MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZZT(JLON))))/ &
         & ZPARRIVEE(JLON))  
        !
        !-------------------------------------------------
        ! LATENT HEAT
        !-------------------------------------------------
        !
        ZDELARG=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZTDEPART(JLON)))
        !
        ! CALCULATION WHERE IT IS CONSIDERED THAT LATENT HEAT RELEASE
        ! FROM CONDENSATION IS ABSORBTED ONLY BY THE GASEOUS PORTION 
        ! OF THE PARCEL, AND NOT BY THE CONDENSATE
        !
        ZL=FOLH(ZZT(JLON),ZDELARG)  
        ZDERL=-RV*(RGAMW+ZDELARG*RGAMD)
        !
        !-------------------------------------------------
        ! NEWTON'S LOOP
        !-------------------------------------------------
        !
        ZRDLOG=(RD+(RV-RD)*ZZQV)*ZLOG(JLON)
        ZCP=RCPD*(1.0_JPRB-ZZQV)+RCPV*ZZQV 
        ZRAPP=RV/RD*ZPARRIVEE(JLON)/FOEW(ZZT(JLON),ZDELARG)
        ZDELARG=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZZT(JLON)))
        ZFDERQS=ZRAPP/(ZRAPP-RETV)**2*( (RBETW+ZDELARG*RBETD) - &
         & ( RGAMW+ZDELARG*RGAMD ) * ZZT(JLON)) / ( ZZT(JLON)*ZZT(JLON) )  
        ZZT(JLON)=ZZT(JLON)-(ZCP*(ZZT(JLON)-ZTDEPART(JLON)) &
         & +ZL*(ZZQV-ZQVDEPART(JLON))-ZZT(JLON) &
         & *ZRDLOG)/(ZCP+(RCPV-RCPD+ZL-ZLOG(JLON)*ZZT(JLON)*(RV-RD))*ZFDERQS &
         & +ZZQV*ZDERL-ZRDLOG)  
      ENDDO      ! JLON
    ENDDO     ! JIT
  ENDDO   !JETAPES
  
  DO JLON=KST,KEND
    ZT2=ZZT(JLON)

    ZQV2=FOQS(FOEW(ZT2,MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT2)))/PRP(JLON,JLEV-1))

    ZADD=GCAPERET*(ZQV1(JLON)-ZQV2)*MAX(0.0_JPRB,SIGN(1.0_JPRB,ZQV1(JLON)-ZQV2))
    ZSQL(JLON)=ZSQL(JLON)+ZADD*MAX(0.0_JPRB,SIGN(1.0_JPRB,ZT2-RTT))
    ZSQI(JLON)=ZSQI(JLON)+ZADD*MAX(0.0_JPRB,-SIGN(1.0_JPRB,ZT2-RTT))
    !
    !-------------------------------------------------
    ! UPDATE PARCEL STATE. The result of moist adiabatic ascent.
    !-------------------------------------------------
    !
    ZST=ZT2
    ZSQV(JLON)=ZQV2
    !
    !-------------------------------------------------
    ! DRY ADIABATIC ASCENT.
    !-------------------------------------------------
    !
    ZDT=ZT(JLON)*(PRP(JLON,JLEV-1)/PRP(JLON,JLEV))**((RD+(RV-RD) &
     & *ZQV(JLON))/(RCPD*(1.0_JPRB-ZQV(JLON))+RCPV*ZQV(JLON)))  
    !
    !-------------------------------------------------
    !  VALUES FROM DRY ADIABATIC OR MOIST ADIABATIC ASCENT ARE CHOSEN 
    !-------------------------------------------------
    !
    ZADD=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZQV(JLON)-ZQS(JLON)))
    ZT(JLON)=ZST*ZADD + ZDT*(1.0_JPRB-ZADD)
    ZQV(JLON)=ZSQV(JLON)*ZADD + ZQV(JLON)*(1.0_JPRB-ZADD)
    ZQL(JLON)=ZSQL(JLON)*ZADD
    ZQI(JLON)=ZSQI(JLON)*ZADD
    !-----------------------------------------------------
    ! Entrainement
    !-----------------------------------------------------
    IF (RENTRA > 0.0_JPRB) THEN
      ZDZ=(PRP(JLON,JLEV)-PRP(JLON,JLEV-1))/(0.5*(PRP(JLON,JLEV)+ &
        & PRP(JLON,JLEV-1)))*(RD+(RV-RD)*(0.5*(PQV(JLON,JLEV)+ &
        & (PQV(JLON,JLEV-1)))))*0.5*(PT(JLON,JLEV)+(PT(JLON,JLEV-1)))/RG
      IF(ZT(JLON) > PT(JLON,JLEV-1)) THEN
        ZT(JLON)=MAX(PT(JLON,JLEV-1),ZT(JLON)+RENTRA*ZDZ*(PT(JLON,JLEV-1)-ZT(JLON)))
      ELSE
        ZT(JLON)=MIN(PT(JLON,JLEV-1),ZT(JLON)+RENTRA*ZDZ*(PT(JLON,JLEV-1)-ZT(JLON)))
      ENDIF
      IF(ZQV(JLON) > PQV(JLON,JLEV-1)) THEN
        ZQV(JLON)=MAX(PQV(JLON,JLEV-1),ZQV(JLON)+RENTRA*ZDZ*(PQV(JLON,JLEV-1)-ZQV(JLON)))
      ELSE
        ZQV(JLON)=MIN(PQV(JLON,JLEV-1),ZQV(JLON)+RENTRA*ZDZ*(PQV(JLON,JLEV-1)-ZQV(JLON)))
      ENDIF
    ENDIF
  ENDDO                     ! JLON
ENDDO                     !JLEV

!-------------------------------------------------
! IF CAPE IS 0, CIN IS PUT ALSO TO 0, 
! BECAUSE NO CONVECTION IS EXPECTED ANYWAY.
!-------------------------------------------------

!DO  JLON=KST,KEND
!  IF(PCAPE(JLON) == _ZERO_) PCIN(JLON) = _ZERO_
!ENDDO

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