SUBROUTINE PPINTPAD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
 & KSLCT,LDBELO,LDBLOW,PRPRESC,&
 & PRXP,PRXPD,PFLDI,PFLDO,&
 & PRXP5,PRXPD5,PFLDI5)  

!**** *PPINTPAD* - LINEARLY INTERPOLATE FIELDS TO GIVEN LEVEL - ADJOINT

!     PURPOSE.
!     --------
!           PERFORMS THE VERTICAL INTERPOLATION OF A FIELD TO A GIVEN
!       LEVEL. IMPLICITLY ALSO EXTRAPOLATES ABOVE TOP.

!**   INTERFACE.
!     ----------
!        *CALL* *PPINTPAD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB
!                        ,KSLCT,LDBELO,LDBLOW,PRPRESC
!                        ,PRXP,PRXPD,PFLDI,PFLDO
!                        ,PRXP5,PRXPD5,PFLDI5)

!        EXPLICIT ARGUMENTS :
!        --------------------
!        KPROMA                    - HORIZONTAL DIMENSION.             (INPUT-C)
!        KSTART                    - START OF WORK.                    (INPUT-C)
!        KPROF                     - DEPTH OF WORK.                    (INPUT-C)
!        KFLEV                     - NUMBER OF INPUT PRESSURE LEVELS   (INPUT-C)
!        KLEVP                     - NUMBER OF OUTPUT PRESSURE LEVELS  (INPUT-C)
!        KLEVB(KPROMA,KLEVP,NPPM)  - INPUT LEVEL BELOW PRPRES          (INPUT-C)
!                                    (SEE PPFLEV)
!        KSLCT                     - 1:  FIELD GIVEN ON HALF LEVELS.
!                                        INTERPOLATE IN P
!                                  - 2:  FIELD GIVEN ON FULL LEVELS.
!                                        INTERPOLATE IN P
!                                  - 3:  FIELD GIVEN ON HALF LEVELS.
!                                        INTERPOLATE IN LN(P)
!                                  - 4:  FIELD GIVEN ON FULL LEVELS.
!                                        INTERPOLATE IN LN(P)          (INPUT-C)
!        LDBELO(KPROMA,KLEVP)      - .TRUE. IF PRESSURE IS UNDER
!                                     LOWEST  MODEL LEVEL              (INPUT-C)
!        LDBLOW(KLEVP)             - .TRUE. IF LDBELO( ,JL) IS CONTAINING
!                                    AT LEAST ONE .TRUE.               (INPUT-C)
!        PRPRESC(KPROMA,KLEVP)      - POST-PROCESSING LEVEL
!                                    PRESSURES:
!                                    IF KVINT=1 OR KVINT = 2:
!                                     PRESSURE
!                                    IF KVINT=3:
!                                     LN PRESSURE                      (INPUT-C)
!        PRXP(KPROMA,0:KFLEV,NPPM) - HALF,FULL AND LN HALF,FULL LEVEL
!                                    PRESSURES (SEE PPINIT)            (INPUT)
!        PRXPD(KPROMA,0:KFLEV,NPPM)- 1./D(P) AND 1./D(LN(P))           (INPUT)
!        PFLDI(KPROMA,KLB:KFLEV)   - MODEL LEVEL FIELD VALUES          (INPUT)

!        PFLDO(KPROMA,KLEVP)       - INTERPOLATED FIELD VALUES         (OUTPUT)
!        PRXP5(KPROMA,0:KFLEV,NPPM)-HALF,FULL AND LN HALF,FULL LEVEL P.(INPUT-T)
!        PRXPD5(KPROMA,0:KFLEV,NPPM)- 1./D(P) AND 1./D(LN(P))          (INPUT-T)
!        PFLDI5(KPROMA,KLB:KFLEV) - MODEL LEVEL FIELD VALUES           (INPUT-T)

!        IMPLICIT ARGUMENTS :  NONE.
!        --------------------

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

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

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

!     AUTHOR.
!     -------
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*

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

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

USE YOMDIM   , ONLY : NPPM

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)    :: LDBELO(KPROMA,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBLOW(KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPRESC(KPROMA,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRXP(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRXPD(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFLDI(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFLDO(KPROMA,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRXP5(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRXPD5(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFLDI5(KPROMA,0:KFLEV) 
INTEGER(KIND=JPIM) :: IAB, IBL, JL, JLEVP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.    Linear interpolation and constant value extrapolation.
!              ------------------------------------------------------

!*       1.1   INTERPOLATE .
IF (LHOOK) CALL DR_HOOK('PPINTPAD',0,ZHOOK_HANDLE)
DO JLEVP=KLOLEV,KLEVP
  IF (.NOT. LDBLOW(JLEVP)) THEN
    DO JL=KSTART,KPROF
      IBL=KLEVB(JL,JLEVP,KSLCT)
      IAB=IBL-1
      PFLDI(JL,IAB)=PFLDI(JL,IAB)+(1.0_JPRB-((PRPRESC(JL,JLEVP)-&
       & PRXP5(JL,IAB,KSLCT))*PRXPD5(JL,IAB,KSLCT)))*PFLDO(JL,JLEVP)  
      PFLDI(JL,IBL)=PFLDI(JL,IBL)+((PRPRESC(JL,JLEVP)&
       & -PRXP5(JL,IAB,KSLCT))*PRXPD5(JL,IAB,KSLCT))*PFLDO(JL,JLEVP)  
      PRXP(JL,IAB,KSLCT)=PRXP(JL,IAB,KSLCT)-(PFLDI5(JL,IBL)-&
       & PFLDI5(JL,IAB))*PRXPD5(JL,IAB,KSLCT)*PFLDO(JL,JLEVP)  
      PRXPD(JL,IAB,KSLCT)=PRXPD(JL,IAB,KSLCT)+(PFLDI5(JL,IBL)-&
       & PFLDI5(JL,IAB))*(PRPRESC(JL,JLEVP)-PRXP5(JL,IAB,KSLCT))*&
       & PFLDO(JL,JLEVP)  
      PFLDO(JL,JLEVP)=0.0_JPRB
    ENDDO

  ELSE
    DO JL=KSTART,KPROF
      IF(.NOT.LDBELO(JL,JLEVP)) THEN
        IBL=KLEVB(JL,JLEVP,KSLCT)
        IAB=IBL-1
        PFLDI(JL,IAB)=PFLDI(JL,IAB)+(1.0_JPRB-((PRPRESC(JL,JLEVP)-&
         & PRXP5(JL,IAB,KSLCT))*PRXPD5(JL,IAB,KSLCT)))*PFLDO(JL,&
         & JLEVP)  
        PFLDI(JL,IBL)=PFLDI(JL,IBL)+((PRPRESC(JL,JLEVP)&
         & -PRXP5(JL,IAB,KSLCT))*PRXPD5(JL,IAB,KSLCT))*PFLDO(JL,&
         & JLEVP)  
        PRXP(JL,IAB,KSLCT)=PRXP(JL,IAB,KSLCT)-(PFLDI5(JL,IBL)-&
         & PFLDI5(JL,IAB))*PRXPD5(JL,IAB,KSLCT)*PFLDO(JL,JLEVP)  
        PRXPD(JL,IAB,KSLCT)=PRXPD(JL,IAB,KSLCT)+(PFLDI5(JL,IBL)-&
         & PFLDI5(JL,IAB))*(PRPRESC(JL,JLEVP)-PRXP5(JL,IAB,KSLCT))*&
         & PFLDO(JL,JLEVP)  
        PFLDO(JL,JLEVP)=0.0_JPRB
      ENDIF
    ENDDO
  ENDIF
ENDDO

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

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