SUBROUTINE PPPS(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
 & KSLCT,LDEXTLI,PZO,LDBELO,LDBELS,LDBLOW,LDBLES,&
 & LDEXTR,POROG,&
 & PGEOPH,PGEOPF,PRXZ,PRXZD,PRESH,PRESF,PT,&
 & PPPP)  

!**** *PPPS* - POST-PROCESS Ps

!     PURPOSE.
!     --------

!        COMPUTES SURFACE PRESSURE AT A GIVEN HEIGHT.

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

!        *CALL* *PPPS(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,
!                     KSLCT,LDEXTLI,PZO,LDBELO,LDBELS,LDBLOW,LDBLES,
!                     LDEXTR,POROG,
!                     PGEOPH,PGEOPF,PRXP,PRXPD,PRESH,PRESF,
!                     PPPP)

!        EXPLICIT ARGUMENTS
!        --------------------

!        KPROMA                    - HORIZONTAL DIMENSION.
!        KSTART                    - START OF WORK.
!        KPROF                     - DEPTH OF WORK.
!        KFLEV                     - NUMBER OF INPUT PRESSURE LEVELS
!        KLEVP                     - NUMBER OF OUTPUT PRESSURE LEVELS
!        KLOLEV                    - BEGINING FOR THE INTERPOLATION
!        KLEVB                     - INPUT LEVEL BELOW PRES (PLNPRES)
!                                    (SEE PPFLEV)
!        KSLCT                     - INTERPOLATION SELECTION
!        LDEXTLI                   - LINEAR EXTRAPOLATION
!        PZO                       - POST-PROCESSING LEVEL HEIGHTS
!        LDBELO                    - .TRUE. IF PRESSURE IS UNDER
!                                     LOWEST (FULL) MODEL LEVEL
!        LDBELS                    - .TRUE. IF PRESSURE IS UNDER
!                                     MODEL SURFACE
!        LDBLOW                    - .TRUE. IF LDBELO(J) IS CONTAINING
!                                    AT LEAST ONE .TRUE.
!        LDBLES                    - .TRUE. IF LDBELS(J) IS CONTAINING
!                                    AT LEAST ONE .TRUE.
!        LDEXTR                    - .TRUE. IF EXTRAPOLATION REQUESTED
!        POROG                     - MODEL OROGRAPHY.
!        PGEOPH                    - HALF LEVEL GEOP.
!        PGEOPF                    - FULL LEVEL GEOP.
!        PRXZ                      - HALF,FULL AND LN HALF,FULL LEVEL
!                                    GEOPS (SEE PPINITZ)
!        PRXZD                     - 1./D(P) AND 1./D(LN(P))
!        PRESH                     - HALF LEVEL PRESSURE
!        PRESF                     - FULL LEVEL PRESSURE
!        PT                        - TEMPERATURE
!        PPPP                      - POST-PROCESSED PRESSURE

!        IMPLICIT ARGUMENTS :  CONSTANTS FROM YOMCST,YOMGEM,YOMSTA.
!        --------------------

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS
!     ---------

!        PPINTZ  - LINEAR INTERPOLATION
!        EXPBESU - EXTRAPOLATION BELOW MODEL'S SURFACE

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        D. VASILJEVIC   *ECMWF*

!     MODIFICATIONS.
!     --------------
!        L. Isaksen : 96-02-20  NFLEV --> NFLEVG
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMDIM   , ONLY : NFLEVG   ,NPPM
USE YOMLUN   , ONLY : NULOUT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLOLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVB(KPROMA,KLEVP,NPPM) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLCT 
LOGICAL           ,INTENT(IN)    :: LDEXTLI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZO(KPROMA,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBELO(KPROMA,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBELS(KPROMA,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBLOW(KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBLES(KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDEXTR 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOPH(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOPF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRXZ(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRXZD(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPPP(KPROMA,KLEVP) 
INTEGER(KIND=JPIM) :: ISTL, JL, JLEVP

REAL(KIND=JPRB) :: ZDL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "expbesu.intfb.h"
#include "ppintz.intfb.h"

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

!*       1.    POST-PROCESS PRESSURE
!              ---------------------

IF (LHOOK) CALL DR_HOOK('PPPS',0,ZHOOK_HANDLE)
IF(KSLCT == 1)       THEN

!*       1.1   HALF LEVEL PRESSURE INTERPOLATION

  ISTL = 0
  CALL PPINTZ(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
   & KSLCT,ISTL,LDBELS,LDBLES,PZO,&
   & PRXZ,PRXZD,PRESH,&
   & PPPP)  

!*       1.2   FULL LEVEL PRESSURE:
!              1. INTERPOLATION
!              2. EXTRAPOLATION BETWEEN LOWEST LEVEL AND SURFACE

ELSEIF(KSLCT == 2)       THEN

!*       1.2.1 INTERPOLATION

  ISTL = 1
  CALL PPINTZ(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
   & KSLCT,ISTL,LDBELO,LDBLOW,PZO,&
   & PRXZ,PRXZD,PRESF,&
   & PPPP)  

!*       1.2.2 INTERPOLATION (L.L-SURFACE)

  DO JLEVP=KLOLEV,KLEVP
    IF(LDBLOW(JLEVP)) THEN
      DO JL=KSTART,KPROF
        IF(LDBELO(JL,JLEVP).AND..NOT.LDBELS(JL,JLEVP)) THEN
          ZDL           =1.0_JPRB/(PGEOPF(JL,NFLEVG)-PGEOPH(JL,NFLEVG))
          PPPP(JL,JLEVP)=PRESH(JL,NFLEVG) +&
           & (PRESF(JL,NFLEVG)-PRESH(JL,NFLEVG))*&
           & (PZO(JL,JLEVP)-PRXZ(JL,NFLEVG,KSLCT-1))*&
           & ZDL  
        ENDIF
      ENDDO
    ENDIF
  ENDDO

!*       1.3   UNKNOWEN OPTION

ELSE
  WRITE(NULOUT,'('' *** ERROR IN PPPS'')')
  WRITE(NULOUT,'('' *** SELECTED OPTION='',I2)') KSLCT
ENDIF

!*       1.4   EXTRAPOLATE BELOW MODEL'S SURFACE

IF(LDEXTR)                          THEN
  IF(KSLCT == 1)                      THEN

!*       1.4.1 HALF LEVELS ARE IN USE

    IF(LDEXTLI)                            THEN

!*       1.4.1.1   LINEAR EXTRAPOLATION

      DO JLEVP=KLOLEV,KLEVP
        IF(LDBLES(JLEVP))                   THEN
          DO JL=KSTART,KPROF
            IF(LDBELS(JL,JLEVP))                THEN
              PPPP(JL,JLEVP) = PRESH(JL,NFLEVG) +&
               & (PRESH(JL,NFLEVG-1)-PRESH(JL,NFLEVG))*&
               & (PZO(JL,JLEVP)-PRXZ(JL,NFLEVG,KSLCT))*&
               & PRXZD(JL,NFLEVG-1,KSLCT)  
            ENDIF
          ENDDO
        ENDIF
      ENDDO
    ELSE

!*       1.4.1.2   PHYSICAL EXTRAPOLATION

      CALL EXPBESU(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,&
       & PZO,LDBELS,LDBLES,POROG,&
       & PRESH,PT,&
       & PPPP)  
    ENDIF
  ELSEIF(KSLCT == 2)                      THEN

!*       1.4.2 FULL LEVELS ARE IN USE

    CALL EXPBESU(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,&
     & PZO,LDBELS,LDBLES,POROG,&
     & PRESH,PT,&
     & PPPP)  

!*       1.4.3 NOT KNOWEN

  ELSE
    WRITE(NULOUT,'('' *** ERROR IN PPPS'')')
    WRITE(NULOUT,'('' *** SELECTED OPTION='',I2)') KSLCT
  ENDIF
ENDIF

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

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

