SUBROUTINE PPPSAD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
 & KSLCT,LDEXTLI,PZO,LDBELO,LDBELS,LDBLOW,LDBLES,&
 & LDEXTR,POROG,&
 & PGEOPH,PGEOPF,PRXZ,PRXZD,PRESH,PRESF,PT,&
 & PPPP,&
 & PGEOPH5,PGEOPF5,PRXZ5,PRXZD5,PRESH5,PRESF5,PT5)  

!**** *PPPSAD* - POST-PROCESS Ps (ADJOINT)

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

!           COMPUTES SURFACE PRESSURE AT A GIVEN HEIGHT.

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

!        *CALL* *PPPSAD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,
!                     KSLCT,LDEXTLI,PZO,LDBELO,LDBELS,LDBLOW,LDBLES,
!                     LDEXTR,POROG,
!                     PGEOPH,PGEOPF,PRXZ,PRXZD,PRESH,PRESF,PT,
!                     PPPP,
!                     PGEOPH5,PGEOPF5,PRXZ5,PRXZD5,PRESH5,PRESF5,PT5)

!        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(KPROMA)             - MODEL OROGRAPHY.
!        PGEOPH                    - HALF LEVEL HEIGHTS
!        PGEOPF                    - FULL LEVEL HEIGHTS
!        PRXZ                      - HALF,FULL AND LN HALF,FULL LEVEL
!                                    HEIGHTS
!        PRXZD                     - 1./D(Z) AND 1./D(LN(Z))
!        PRESH                     - HALF LEVEL PRESSURE
!        PRESF                     - FULL LEVEL PRESSURE
!        PT                        - TEMPERATURE
!        PPPP                      - POST-PROCESSED PRESSURE
!        PGEOPH5                   - HALF LEVEL HEIGHTS
!        PGEOPF5                   - FULL LEVEL HEIGHTS
!        PRXZ5                     - HALF,FULL AND LN HALF,FULL LEVEL
!                                    HEIGHTS
!        PRXZD5                    - 1./D(Z) AND 1./D(LN(Z))
!        PRESH5                    - HALF LEVEL PRESSURE
!        PRESF5                    - FULL LEVEL PRESSURE
!        PT5                       - TEMPERATURE

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

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

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

!        PPINTZAD - LINEAR INTERPOLATION (ADJOINT)
!        EXPBESUAD - EXTRAPOLATION BELOW MODEL'S SURFACE (ADJOINT)

!     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(INOUT) :: PGEOPH(KPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGEOPF(KPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRXZ(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRXZD(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRESH(KPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRESF(KPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPPP(KPROMA,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOPH5(KPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOPF5(KPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRXZ5(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRXZD5(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH5(KPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF5(KPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT5(KPROMA) 
INTEGER(KIND=JPIM) :: ISTL, JL, JLEVP

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

#include "expbesuad.intfb.h"
#include "ppintzad.intfb.h"

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

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

!*       1.4   EXTRAPOLATE BELOW MODEL'S SURFACE

IF (LHOOK) CALL DR_HOOK('PPPSAD',0,ZHOOK_HANDLE)
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
              PRESH(JL,NFLEVG)=PRESH(JL,NFLEVG)+&
               & PPPP(JL,JLEVP)*&
               & (1.0_JPRB-&
               & PZO(JL,JLEVP)*PRXZD5(JL,NFLEVG-1,KSLCT)+&
               & PRXZ5(JL,NFLEVG,KSLCT)*PRXZD5(JL,NFLEVG-1,KSLCT))  

              PRESH(JL,NFLEVG-1)=PRESH(JL,NFLEVG-1)+&
               & PPPP(JL,JLEVP)*&
               & (PZO(JL,JLEVP)*PRXZD5(JL,NFLEVG-1,KSLCT)-&
               & PRXZ5(JL,NFLEVG,KSLCT)*PRXZD5(JL,NFLEVG-1,KSLCT))  

              PRXZ(JL,NFLEVG,KSLCT)=PRXZ(JL,NFLEVG,KSLCT)+&
               & PPPP(JL,JLEVP)*&
               & (PRESH5(JL,NFLEVG  )*PRXZD5(JL,NFLEVG-1,KSLCT)-&
               & PRESH5(JL,NFLEVG-1)*PRXZD5(JL,NFLEVG-1,KSLCT) )  

              PRXZD(JL,NFLEVG-1,KSLCT)=PRXZD(JL,NFLEVG-1,KSLCT) +&
               & PPPP(JL,JLEVP)*&
               & (PZO   (JL,JLEVP  )*PRESH5(JL,NFLEVG-1)-&
               & PRESH5(JL,NFLEVG-1)*PRXZ5 (JL,NFLEVG  ,KSLCT)-&
               & PZO   (JL,JLEVP  )*PRESH5(JL,NFLEVG  )+&
               & PRESH5(JL,NFLEVG  )*PRXZ5 (JL,NFLEVG,KSLCT)   )  
            ENDIF
          ENDDO
        ENDIF
      ENDDO
    ELSE

!*       1.4.1.2   PHYSICAL EXTRAPOLATION

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

!*       1.4.2 FULL LEVELS ARE IN USE

    CALL EXPBESUAD(KPROMA,KSTART,KPROF,KLEVP,KLOLEV,&
     & PZO,LDBELS,LDBLES,POROG,&
     & PRESH,PT,&
     & PPPP,&
     & PRESH5,PT5)  

!*       1.4.3 NOT KNOWEN

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

!*       1.1   HALF LEVEL PRESSURE INTERPOLATION

IF(KSLCT == 1)       THEN
  ISTL = 0
  CALL PPINTZAD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
   & KSLCT,ISTL,LDBELS,LDBLES,PZO,&
   & PRXZ,PRXZD,PRESH,&
   & PPPP,&
   & PRXZ5,PRXZD5,PRESH5)  

!*       1.2   FULL LEVEL PRESSURE:

ELSEIF(KSLCT == 2)       THEN

!*       1.2.1 INTERPOLATION

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

!*       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
          ZDL5=1.0_JPRB/(PGEOPF5(JL,NFLEVG)-PGEOPH5(JL,NFLEVG))

          ZDL=0.0_JPRB

          PRESH(JL,KFLEV)=PRESH(JL,KFLEV) +&
           & PPPP(JL,JLEVP)*&
           & (1.0_JPRB-&
           & PZO(JL,JLEVP)*ZDL5+&
           & PRXZ5(JL,KFLEV,KSLCT-1)*ZDL5)  

          PRESF(JL,KFLEV)=PRESF(JL,KFLEV) +&
           & PPPP(JL,JLEVP)*&
           & (PZO(JL,JLEVP)*ZDL5-&
           & PRXZ5(JL,KFLEV,KSLCT-1)*ZDL5)  

          PRXZ(JL,KFLEV,KSLCT-1)=PRXZ(JL,KFLEV,KSLCT-1) +&
           & PPPP(JL,JLEVP)*&
           & (PRESH5(JL,KFLEV)*ZDL5-&
           & PRESF5(JL,KFLEV)*ZDL5)  

          ZDL=ZDL +&
           & PPPP(JL,JLEVP)*&
           & (PZO(JL,JLEVP)*PRESF5(JL,KFLEV)-&
           & PRESF5(JL,KFLEV)*PRXZ5(JL,KFLEV,KSLCT-1)-&
           & PZO(JL,JLEVP)*PRESH5(JL,KFLEV)+&
           & PRESH5(JL,KFLEV)*PRXZ5(JL,KFLEV,KSLCT-1)  )  

          PGEOPH(JL,KFLEV) = PGEOPH(JL,KFLEV) +&
           & ZDL*&
           & ( 1.0_JPRB/(PGEOPF5(JL,KFLEV)-PGEOPH5(JL,KFLEV))**2)  

          PGEOPF(JL,KFLEV) = PGEOPF(JL,KFLEV) +&
           & ZDL*&
           & (-1.0_JPRB/(PGEOPF5(JL,KFLEV)-PGEOPH5(JL,KFLEV))**2)  
        ENDIF
      ENDDO
    ENDIF
  ENDDO

!*       1.3   UNKNOWEN OPTION

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

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

