SUBROUTINE PPLTP(KPROMA,KSTART,KPROF,KFLEV,&
 & PRPRESF,PTOUP,PXTOUP,LDCP,PCORIO,&
 & PRPRES,PRLNPRES,PCP2D)  

!**** *PPLTP*    Compute the pressures of the TP level

!      PURPOSE.
!      --------
!           COMPUTE THE PRESSURES OF THE TP LEVEL

!**    INTERFACE.
!      ----------
!           *CALL* PPLTP( ... )

!           EXPLICITE ARGUMENTS.
!           --------------------
!           KPROMA      : horizontal dimension.                     (INPUT)
!           KSTART      : start of work.                            (INPUT)
!           KPROF       : depth of work.                            (INPUT)
!           KFLEV       : number of input pressure levels.          (INPUT)
!           PRPRESF(kproma,kflev) : model full level pressures.     (INPUT)
!           PTOUP(kproma,kflev)   : TP.                             (INPUT)
!           PXTOUP      : value of the TP level.                    (INPUT)
!           LDCP        : .true. if post-proc of tropo folding     (INPUT)
!           PCORIO      : Coriolis parameter                       (input)
!           PRPRES(kproma)    : pressures of the TP level.         (OUTPUT)
!           PRLNPRES(kproma)  : ln-pressure of the TP level.       (OUTPUT)
!           PCP2D       : tropopause folding                (OUTPUT)

!      EXTERNALS.
!      ----------
!           NONE

!      AUTHOR.
!      -------
!           C. PERIARD        aviateur

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 1992
!        Modified : 95-01-05 Thierry bergot (search between the lowest level
!                   and a given upper level
!        A. Simmons :00-04-12 provide for an equatorial cap by means of
!                   a minimum pressure of model level (namelist RFPVCAP)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        R. El Khatib  20-Apr-2007 Optimisation.
!      -----------------------------------------------------------------

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

USE YOMFPC   , ONLY : RFPVCAP

IMPLICIT NONE

!     EXTERNAL INTEGER FUNCTIONS
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPRESF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTOUP(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXTOUP 
LOGICAL           ,INTENT(IN)    :: LDCP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCORIO(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRPRES(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRLNPRES(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCP2D(KPROMA) 
INTEGER(KIND=JPIM), EXTERNAL :: ISRCHFGE
INTEGER(KIND=JPIM), EXTERNAL :: ISRCHFLT

REAL(KIND=JPRB) :: ZPVPLUS(KPROMA,KFLEV)

INTEGER(KIND=JPIM) :: ILEFLEV, ILEV2, ILEVI, JL, JLEV, JROF
INTEGER(KIND=JPIM) :: ILEVSEC(KPROMA), ILEV(KPROMA), INBLEV(KPROMA), I

REAL(KIND=JPRB) :: ZQNN, ZSECUR, ZPMIN
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('PPLTP',0,ZHOOK_HANDLE)
ZSECUR=1.E-10_JPRB
ZPMIN=RFPVCAP

!     Correct southern hemisphere negative values
DO JLEV = 1, KFLEV
  DO JROF = KSTART, KPROF
    ZPVPLUS(JROF,JLEV) = SIGN(1.0_JPRB,PCORIO(JROF))*PTOUP(JROF,JLEV)
  ENDDO
ENDDO

IF (LDCP) THEN
  DO JL=KSTART,KPROF
    ILEVSEC(JL)=ISRCHFGE(KFLEV,PRPRESF(JL,1),KPROMA,ZPMIN)
    INBLEV(JL) = KFLEV - 1
    ILEV(JL)=ISRCHFLT(INBLEV(JL),ZPVPLUS(JL,2),KPROMA,PXTOUP)
    ILEV(JL) = ILEV(JL) + 1
    ILEVI=MAX(ILEV(JL),ILEVSEC(JL))
    IF (ILEVI == 1.OR. ILEVI >= KFLEV+1) THEN
      ILEVI=MIN(ILEVI,KFLEV)
      PRPRES(JL)=PRPRESF(JL,ILEVI)
      PRLNPRES(JL)=LOG(PRPRES(JL))
    ELSE
      ZQNN=MAX(ZPVPLUS(JL,ILEVI-1)-ZPVPLUS(JL,ILEVI),ZSECUR)
      PRPRES(JL)=(PRPRESF(JL,ILEV(JL)-1)-PRPRESF(JL,ILEV(JL)))*&
       & (PXTOUP-ZPVPLUS(JL,ILEVI))/ZQNN &
       & + PRPRESF(JL,ILEVI)  
      PRPRES(JL)=MAX(PRPRES(JL),PRPRESF(JL,ILEVSEC(JL)))
      PRLNPRES(JL)=LOG(PRPRES(JL))
    ENDIF
    ILEFLEV = MAX(1,KFLEV-ILEV(JL))
    ILEV2=ISRCHFGE(ILEFLEV,ZPVPLUS(JL,ILEV(JL)),KPROMA,PXTOUP)
    IF (ILEV2 >= ILEFLEV+1) THEN
      PCP2D(JL)=0.0_JPRB
    ELSE
      PCP2D(JL)=1.0_JPRB
    ENDIF
  ENDDO
ELSE
  DO JL=KSTART,KPROF
    ILEVSEC(JL)=ISRCHFGE(KFLEV,PRPRESF(JL,1),KPROMA,ZPMIN)
  ENDDO
  DO JL=KSTART,KPROF
    INBLEV(JL) = KFLEV-ILEVSEC(JL)+1
  ENDDO
  DO JL=KSTART,KPROF
    ILEV(JL)=ISRCHFLT(INBLEV(JL),ZPVPLUS(JL,ILEVSEC(JL)),KPROMA,PXTOUP)
  ENDDO
  DO JL=KSTART,KPROF
    ILEV(JL)=MAX(ILEV(JL)+ILEVSEC(JL)-1,ILEVSEC(JL))
  ENDDO
  DO JL=KSTART,KPROF
    IF (ILEV(JL) == ILEVSEC(JL) .OR. ILEV(JL) >= KFLEV+1) THEN
      I=MIN(ILEV(JL),KFLEV)
      PRPRES(JL)=PRPRESF(JL,I)
      PRLNPRES(JL)=LOG(PRPRES(JL))
    ELSE
      I=ILEV(JL)
      ZQNN=MAX(ZPVPLUS(JL,I-1)-ZPVPLUS(JL,I),ZSECUR)
      PRPRES(JL)=(PRPRESF(JL,I-1)-PRPRESF(JL,I))*&
       & (PXTOUP-ZPVPLUS(JL,I))/ZQNN + PRPRESF(JL,I)  
      PRPRES(JL)=MAX(PRPRES(JL),PRPRESF(JL,ILEVSEC(JL)))
      PRLNPRES(JL)=LOG(PRPRES(JL))
    ENDIF
  ENDDO
ENDIF

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

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

