SUBROUTINE PPTAD_OLD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
 & PRPRES,POROG,LDBELO,LDBELS,LDBLOW,LDBLES,LDEXTR,&
 & PRXP,PRXPD,PTSTAR,PT0,PTF,&
 & PTPP,&
 & PRXP5,PRXPD5,PTSTAR5,PT05,PTF5)  

!**** *PPTAD* - POST-PROCESS TEMPERATURE - ADJOINT.

!     PURPOSE.
!     --------
!           PERFORMS THE VERTICAL INTERPOLATION OF TEMPERATURETO A GIVEN
!       MODEL CO-ORDINATE LEVEL. ALSO EXTRAPOLATES TEMPERATURE
!       BELOW SURFACE AND BOTTOM MODEL LEVEL IF SO REQUESTED.

!**   INTERFACE.
!     ----------
!        *CALL* *PPTAD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,
!                    PRPRES,POROG,LDBELO,LDBELS,LDBLOW,LDBLES,LDEXTR,
!                    PRXP,PRXPD,PTSTAR,PT0,
!                    PTF,PTPP,PRXP5,PRXPD5,PTSTAR5,PT05,PTF5)

!        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)
!        PRPRES(KPROMA,KFLEV)       - POST-PROCESS   LEVEL PRESSURES.   (INPUT-C)
!        PLNPRT(KPROMA,KLEVP)      - PLNPRT(.,JLEVP)=
!                                     LOG(PRPRES(.,JLEVP)/PSOL)        (INPUT-C)
!        POROG(KPROMA)             - MODEL OROGRAPHY.                  (INPUT-C)
!        LDBELO(KPROMA,KLEVP)      - .TRUE. IF PRESSURE IS UNDER
!                                     LOWEST (FULL) MODEL LEVEL        (INPUT-C)
!        LDBELS(KPROMA,KLEVP)      - .TRUE. IF PRESSURE IS UNDER
!                                     MODEL SURFACE                    (INPUT-C)
!        LDBLOW(KLEVP)             - FIRST LEVEL OF LDBELO CONTAINING
!                                    AT LEAST ONE .TRUE.               (INPUT-C)
!        LDBLES(KLEVP)             - FIRST LEVEL OF LDBELS CONTAINING
!                                    AT LEAST ONE .TRUE.               (INPUT-C)
!        LDEXTR                    - .TRUE. IF EXTRAPOLATION REQUESTED (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)
!        PTSTAR(KPROMA)            - SURFACE TEMPERATURE               (INPUT)
!        PT0(KPROMA)               - STANDARD SURFACE TEMPERATURE      (INPUT)
!        PTF(KPROMA,0:KFLEV)       - TEMPERATURE ON FULL INPUT LEVELS. (INPUT)

!        PTPP(KPROMA,KLEVP)        - POST-PROCESSED TEMPERATURE        (OUTPUT)

!        PRXP5(KPROMA,0:KFLEV,NPPM)- HALF,FULL AND LN HALF,FULL LEVEL
!                                    PRESSURES (SEE PPINIT)            (INPUT-T)
!        PRXPD5(KPROMA,0:KFLEV,NPPM)- 1./D(P) AND 1./D(LN(P))          (INPUT-T)
!        PTSTAR5(KPROMA)           - SURFACE TEMPERATURE               (INPUT-T)
!        PT05(KPROMA)              - STANDARD SURFACE TEMPERATURE      (INPUT-T)
!        PTF5(KPROMA,0:KFLEV)      - TEMPERATURE ON FULL INPUT LEVELS. (INPUT-T)

!        IMPLICIT ARGUMENTS :  CONSTANTS FROM YOMCST AND YOMSTA.
!        --------------------

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

!     EXTERNALS.  PPINTP - LINEAR INTERPOLATION
!     ----------

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

!     AUTHOR.
!     -------
!        MATS HAMRUD  *ECMWF*

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

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

USE YOMDIM   , ONLY : NPPM
USE YOMCST   , ONLY : RG       ,RD
USE YOMSTA   , ONLY : RDTDZ1

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) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPRES(KPROMA,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA) 
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(INOUT) :: PRXP(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRXPD(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSTAR(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT0(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTF(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTPP(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)    :: PTSTAR5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT05(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTF5(KPROMA,0:KFLEV) 
REAL(KIND=JPRB) :: ZALPHA(KPROMA)
REAL(KIND=JPRB) :: ZALPHA5(KPROMA)

INTEGER(KIND=JPIM) :: ISLCT, JL, JLEVP

REAL(KIND=JPRB) :: ZALFLP2, ZALFLP25, ZALFLP3, ZALFLP35, ZALFLPR,&
 & ZALFLPR5, ZALPHAC, ZCOEF, ZCOEF5, ZCOEFPL, &
 & ZDFI, ZFI2000, ZFI2500, ZLNPRT, ZLNPRT5, &
 & ZTPLAT, ZTPLAT5, ZTX, ZUSDFI  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "ppintpad.intfb.h"

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

!*       1.    POST-PROCESS TEMPERATURE.
!              -------------------------

IF (LHOOK) CALL DR_HOOK('PPTAD_OLD',0,ZHOOK_HANDLE)
DO JL=KSTART,KPROF
  PTF5(JL,0)=PTF5(JL,1)
ENDDO

!*       1.4   EXTRAPOLATE TEMPERATURE BELOW SURFACE.

IF(LDEXTR) THEN

  ZTX=298.0_JPRB
  ZFI2000=2000.0_JPRB*RG
  ZFI2500=2500.0_JPRB*RG
  ZDFI   =ZFI2500-ZFI2000
  ZUSDFI =1.0_JPRB/ZDFI
  ZALPHAC=-RDTDZ1*RD/RG

  DO JL=KSTART,KPROF
    ZALPHA(JL)=0.0_JPRB
    ZCOEFPL=MIN(1.0_JPRB,MAX(0.0_JPRB,(POROG(JL)-ZFI2000)*ZUSDFI))
    ZTPLAT5=MIN(PT05(JL),ZTX)
    ZALPHA5(JL)=MAX(0.0_JPRB,ZALPHAC+(RD*ZCOEFPL*(ZTPLAT5-PT05(JL)))/&
     & MAX(POROG(JL),ZFI2000))  

  ENDDO

  DO JLEVP=KLOLEV,KLEVP
    IF(LDBLES(JLEVP)) THEN
      DO JL=KSTART,KPROF
        IF ( LDBELS(JL,JLEVP) ) THEN
          ZLNPRT5=LOG(PRPRES(JL,JLEVP)/PRXP5(JL,KFLEV,1))
          ZALFLPR5=ZALPHA5(JL)*ZLNPRT5
          ZALFLP25=ZALFLPR5*ZALFLPR5
          ZALFLP35=ZALFLP25*ZALFLPR5

          PTSTAR(JL)=PTSTAR(JL)+&
           & (1.0_JPRB+ZALFLPR5+0.5_JPRB*ZALFLP25+1.0_JPRB/6._JPRB*ZALFLP35)*PTPP(JL, &
           & JLEVP)  
          ZALFLPR=PTSTAR5(JL)*PTPP(JL,JLEVP)
          ZALFLP2=0.5_JPRB*PTSTAR5(JL)*PTPP(JL,JLEVP)
          ZALFLP3=1.0_JPRB/6._JPRB*PTSTAR5(JL)*PTPP(JL,JLEVP)
          PTPP(JL,JLEVP)=0.0_JPRB
          ZALFLPR=ZALFLPR+ZALFLP25*ZALFLP3
          ZALFLP2=ZALFLP2+ZALFLPR5*ZALFLP3
          ZALFLPR=ZALFLPR+2.0_JPRB*ZALFLPR5*ZALFLP2
          ZALPHA(JL)=ZALPHA(JL)+ZLNPRT5*ZALFLPR
          ZLNPRT=ZALPHA5(JL)*ZALFLPR
          PRXP(JL,KFLEV,1)=PRXP(JL,KFLEV,1)-1.0_JPRB/PRXP5(JL,KFLEV,1)*ZLNPRT
        ENDIF
      ENDDO
    ENDIF
  ENDDO

  DO JL=KSTART,KPROF
    ZCOEFPL=MIN(1.0_JPRB,MAX(0.0_JPRB,(POROG(JL)-ZFI2000)*ZUSDFI))

    IF(ZALPHA5(JL) > 0.0_JPRB) THEN
      ZTPLAT=RD*ZCOEFPL/MAX(POROG(JL),ZFI2000)*ZALPHA(JL)
      PT0(JL)=PT0(JL)-RD*ZCOEFPL/MAX(POROG(JL),ZFI2000)*ZALPHA(JL)
    ELSE
      ZTPLAT=0.0_JPRB
    ENDIF
    IF(PT05(JL) <= ZTX) THEN
      PT0(JL)=PT0(JL)+ZTPLAT
    ENDIF
  ENDDO

ENDIF

!*       1.3   INTERPOLATE BETWEEN LOWEST LEVEL AND SURFACE.

DO JLEVP=KLOLEV,KLEVP
  IF(LDBLOW(JLEVP)) THEN
    DO JL=KSTART,KPROF
      IF ( LDBELO(JL,JLEVP).AND..NOT.LDBELS(JL,JLEVP) ) THEN
        ZCOEF5=(PRXP5(JL,KFLEV,1)-PRPRES(JL,JLEVP) )/&
         & (PRXP5(JL,KFLEV,1)-PRXP5(JL,KFLEV,2))  
        PTSTAR(JL)=PTSTAR(JL)+(1.0_JPRB-ZCOEF5)*PTPP(JL,JLEVP)
        ZCOEF=(PTF5(JL,KFLEV)-PTSTAR5(JL))*PTPP(JL,JLEVP)
        PTF(JL,KFLEV)=PTF(JL,KFLEV)+ZCOEF5*PTPP(JL,JLEVP)
        PTPP(JL,JLEVP)=0.0_JPRB
        PRXP(JL,KFLEV,1)=PRXP(JL,KFLEV,1)+&
         & (1.0_JPRB/(PRXP5(JL,KFLEV,1)-PRXP5(JL,KFLEV,2))-&
         & (PRXP5(JL,KFLEV,1)-PRPRES(JL,JLEVP) )/&
         & (PRXP5(JL,KFLEV,1)-PRXP5(JL,KFLEV,2))**2)*ZCOEF  
        PRXP(JL,KFLEV,2)=PRXP(JL,KFLEV,2)+&
         & (PRXP5(JL,KFLEV,1)-PRPRES(JL,JLEVP) )/&
         & (PRXP5(JL,KFLEV,1)-PRXP5(JL,KFLEV,2))**2*ZCOEF  
      ENDIF
    ENDDO
  ENDIF
ENDDO

!*       1.2   INTERPOLATE TEMPERATURE.

ISLCT=2
CALL PPINTPAD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
 & ISLCT,LDBELO,LDBLOW,PRPRES,PRXP,PRXPD,&
 & PTF,PTPP,PRXP5,PRXPD5,PTF5)  

!*       1.1   PREPARE FOR EXTRAPOLATION ABOVE TOP

DO JL=KSTART,KPROF
  PTF(JL,1)=PTF(JL,1)+PTF(JL,0)
ENDDO

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

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

