SUBROUTINE PPGEOPTL(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,&
 & KLEVB,PLNPRES,LDBELO,LDBELS,LDBLOW,LDBLES,LDEXTR,POROG,&
 & PRXP,PRXPD,PTSTAR,PR0,PLNPR,PALPH,PTF,PZPP,&
 & PRXP5,PRXPD5,PTSTAR5,PR05,PLNPR5,PALPH5,PTF5)  

!**** *PPGEOPTL* - POST-PROCESS GEOPOTENTIAL - TANGENT LINEAR.

!     PURPOSE.
!     --------
!           COMPUTES GEOPOTENTIAL AT FULL LEVELS AND
!       PERFORMS THE VERTICAL INTERPOLATION TO A GIVEN
!       MODEL CO-ORDINATE LEVEL. ALSO EXTRAPOLATES GEOPOTENTIAL
!       IF SO REQUESTED. THE INTERPOLATION IS DONE IN TERMS OF
!       GEOPOTENTIAL DEPARTURES FROM THE ICAO STANDARD ATMOSPHERE.

!**   INTERFACE.
!     ----------
!        *CALL* *PPGEOPTL(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,
!           KLEVB,PLNPRES,LDBELO,LDBELS,LDBLOW,LDBLES,LDEXTR,POROG,
!           PRXP,PRXPD,PTSTAR,PR0,PLNPR,PALPH,PTF,PZPP,
!           PRXP5,PRXPD5,PTSTAR5,PR05,PLNPR5,PALPH5,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 PRES            (INPUT-C)
!                                    (SEE PPFLEV)
!        PLNPRES(KPROMA,KLEVP)     - LOG(POST-PROCESSING LEVEL PRES.)  (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)
!        PR0(KPROMA,KFLEV)         - R                                 (INPUT)
!        PLNPR(KPROMA,KFLEV)       - LOGARITHM OF RATIO OF PRESSURE
!                                    (PREVIOUSLY COMPUTED IN GPXYB)    (INPUT)
!        PALPH(KPROMA,KFLEV)       - COEFFICIENTS OF THE HYDROSTATICS
!                                    (PREVIOUSLY COMPUTED IN GPXYB)    (INPUT)
!        PTF(KPROMA,0:KFLEV)       - TEMPERATURE ON FULL INPUT LEVELS. (INPUT)

!        PZPP(KPROMA,KLEVP)        - POST-PROCESSED GEOPOTENTIAL       (OUTPUT)
!        PRXP5(KPROMA,0:KFLEV,NPPM) - HALF,FULL AND LN HALF,FULL LEVEL
!                                    PRESSURES (SEE PPINIT)            (INPUT-R)
!        PRXPD5(KPROMA,0:KFLEV,NPPM)- 1./D(P) AND 1./D(LN(P))           (INPUT-R)
!        PTSTAR5(KPROMA)           - SURFACE TEMPERATURE               (INPUT-R)
!        PR05(KPROMA,KFLEV)        - R                                 (INPUT)
!        PLNPR5(KPROMA,KFLEV)      - LOGARITHM OF RATIO OF PRESSURE
!                                    (PREVIOUSLY COMPUTED IN GPXYB)    (INPUT-R)
!        PALPH5(KPROMA,KFLEV)      - COEFFICIENTS OF THE HYDROSTATICS
!                                    (PREVIOUSLY COMPUTED IN GPXYB)    (INPUT-R)
!        PTF5(KPROMA,0:KFLEV)      - TEMPERATURE ON FULL INPUT LEVELS. (INPUT-R)

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

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

!     EXTERNALS.  GPGEO    - COMPUTE GEOPOTENTIAL
!     ----------  GPGEOTL  - COMPUTE GEOPOTENTIAL
!                 GPRCPTL  - COMPUTE R,CP AND KAPPA
!                 PPSTA    - TEMP. AND GEOPOTENTIAL OF THE STANDARD ATM.
!                 PPSTATL  - TEMP. AND GEOPOTENTIAL OF THE STANDARD ATM.
!                 PPINTP   - LINEAR INTERPOLATION
!                 PPINTPTL - LINEAR INTERPOLATION
!                 PPITPQTL - QUADRATIC INTERPOLATION FOR TOP LEVELS

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

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-01-26
!        Erik Andersson  920409: PP geop. on full levels, in ln(p).
!                                Integrate and interpolate dep. fr. ICAO
!          "  , J-F. Geleyn      Mod. T*, T0 and alpha below surface.
!        Mike Fisher 20-01-95 :  Fix bug
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NPPM
USE YOMCST   , ONLY : RG       ,RD
USE YOMCT0   , ONLY : LOLDPP
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)    :: PLNPRES(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)    :: PRXP(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRXPD(KPROMA,0:KFLEV,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSTAR(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR0(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PZPP(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)    :: PR05(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(KPROMA,0:KFLEV) 
REAL(KIND=JPRB) :: ZFLDH(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZFLDF(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZTSTAR(KPROMA)
REAL(KIND=JPRB) :: ZALPHA(KPROMA)

!     REAL ZSTTP(KPROMA,KLEVP),ZSTZP(KPROMA,KLEVP)
REAL(KIND=JPRB) :: ZSTTF(KPROMA,0:KFLEV),ZSTZF(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZSTTF5(KPROMA,0:KFLEV),ZSTZF5(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZSTTH(KPROMA),ZSTZH(KPROMA)

REAL(KIND=JPRB) :: ZTSTAR5(KPROMA)
REAL(KIND=JPRB) :: ZALPHA5(KPROMA)
REAL(KIND=JPRB) :: ZFLDH5(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZFLDF5(KPROMA,0:KFLEV)

INTEGER(KIND=JPIM) :: IBL, JL, JLEV, JLEVP

REAL(KIND=JPRB) :: ZALFLP2, ZALFLP25, ZALFLPR, ZALFLPR5, ZDTDZSG,&
 & ZGAM, ZGAM5, ZLNPRT, ZLNPRT5, ZOROG, ZT0, &
 & ZT05, ZTX, ZTY, ZVAL, ZVAL5, ZXX, ZXX5  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "gpgeo.intfb.h"
#include "gpgeotl.intfb.h"
#include "ppgeoptl_old.intfb.h"
#include "ppsta.intfb.h"
#include "ppstatl.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PPGEOPTL',0,ZHOOK_HANDLE)
IF(LOLDPP) THEN
  CALL PPGEOPTL_OLD(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,&
   & KLEVB,PLNPRES,LDBELO,LDBELS,LDBLOW,LDBLES,LDEXTR,POROG,&
   & PRXP,PRXPD,PTSTAR,PR0,PLNPR,PALPH,PTF,PZPP,&
   & PRXP5,PRXPD5,PTSTAR5,PR05,PLNPR5,PALPH5,PTF5)  
ELSE

!*       1.    POST-PROCESS GEOPOTENTIAL.
!              --------------------------

!*       1.1   COMPUTE GEOPOTENTIAL ON MODEL LEVELS. DEP FROM ICAO.
!           ZSTTF FIRST CONTAINS ICAO TEMPERATURES ON FULL LEVELS, THEN
!           IT IS CHANGED TO CONTAIN 'MOIST' DEPARTURES FROM ICAO.

  CALL PPSTA('PPREF',KPROMA,KSTART,KPROF,KFLEV+1,1,&
   & PRXP5(1,0,2),PRXP5(1,0,4),&
   & ZSTTF5,ZSTZF5)  
  CALL PPSTATL('PPREF',KPROMA,KSTART,KPROF,KFLEV+1,1,&
   & PRXP(1,0,2),PRXP(1,0,4),&
   & ZSTTF,ZSTZF,&
   & PRXP5(1,0,2))
  DO JLEV=1,KFLEV
    DO JL=KSTART,KPROF
      ZSTTF(JL,JLEV)=PTF(JL,JLEV)-RD/PR05(JL,JLEV)*ZSTTF(JL,JLEV)&
       & + ZSTTF5(JL,JLEV)*RD/(PR05(JL,JLEV)**2)*PR0(JL,JLEV)  
      ZSTTF5(JL,JLEV)=PTF5(JL,JLEV)-ZSTTF5(JL,JLEV)*RD/PR05(JL,JLEV)
    ENDDO
  ENDDO
  
  DO JL=KSTART,KPROF
    ZFLDH5(JL,KFLEV)=0.0_JPRB
    ZFLDH(JL,KFLEV)=0.0_JPRB
  ENDDO
  CALL GPGEO(KPROMA,KSTART,KPROF,KFLEV,ZFLDH5,ZFLDF5(1,1),&
   & ZSTTF5(1,1),PR05,PLNPR5,PALPH5)  
  CALL GPGEOTL(KPROMA,KSTART,KPROF,KFLEV,ZFLDH,ZFLDF(1,1),&
   & ZSTTF(1,1),PR0,PLNPR,PALPH,&
   & ZSTTF5(1,1),PR05,PLNPR5,PALPH5)  

  DO JLEV = 1,KFLEV
    DO JL = KSTART,KPROF
      ZSTTF(JL,JLEV) = ZSTTF(JL,JLEV) * PR05(JL,JLEV)&
       & +  ZSTTF5(JL,JLEV) * PR0(JL,JLEV)  
      ZSTTF5(JL,JLEV) = ZSTTF5(JL,JLEV) * PR05(JL,JLEV)
    ENDDO
  ENDDO
  DO JL = KSTART, KPROF
    ZSTTF(JL,0) = ZSTTF(JL,1)
    ZSTTF5(JL,0) = ZSTTF5(JL,1)
  ENDDO

!*       1.2   INTERPOLATE GEOPOTENTIAL.
!*       1.3   INTERPOLATE BETWEEN LOWEST LEVEL AND SURFACE.

  DO JLEVP = KLOLEV, KLEVP
    IF (.NOT. LDBLOW(JLEVP)) THEN
      DO JL = KSTART, KPROF
        IBL = KLEVB(JL,JLEVP,4)
        ZXX5 = (PRXP5(JL,IBL,4)-PLNPRES(JL,JLEVP))&
         & / (PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
        ZGAM5 = (PRXP5(JL,IBL-1,4)+PRXP5(JL,IBL,4)-2.0_JPRB*&
         & PRXP5(JL,IBL-1,3))/(PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
        ZVAL5 = (0.5_JPRB + ZGAM5 * (ZXX5 - 1.5_JPRB)) * ZXX5

        ZXX =(PRXP(JL,IBL,4)-ZXX5*(PRXP(JL,IBL,4)-PRXP(JL,IBL-1,4)))&
         & / (PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
        ZGAM= ( PRXP(JL,IBL-1,4)+PRXP(JL,IBL,4)&
         & -2.0_JPRB*PRXP(JL,IBL-1,3) - &
         & ZGAM5*(PRXP(JL,IBL,4)-PRXP(JL,IBL-1,4)) )&
         & / (PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
        ZVAL= ZGAM*(ZXX5*ZXX5-1.5_JPRB*ZXX5)+ZGAM5*(2.0_JPRB*ZXX5*ZXX-1.5_JPRB* &
         & ZXX)&
         & +0.5_JPRB*ZXX  
        PZPP(JL,JLEVP) = ZFLDF(JL,IBL) +&
         & PRXP(JL,IBL,4) *&
         & ( ZSTTF5(JL,IBL)+(ZSTTF5(JL,IBL-1)-ZSTTF5(JL,IBL))*ZVAL5) +&
         & (PRXP5(JL,IBL,4)-PLNPRES(JL,JLEVP)) *&
         & ( ZSTTF(JL,IBL) + (ZSTTF(JL,IBL-1)-ZSTTF(JL,IBL)) * ZVAL5 +&
         & (ZSTTF5(JL,IBL-1)-ZSTTF5(JL,IBL)) * ZVAL )  
      ENDDO
    ELSE
      DO JL = KSTART, KPROF
        IF (.NOT.LDBELO(JL,JLEVP)) THEN
          IBL = KLEVB(JL,JLEVP,4)
          ZXX5 = (PRXP5(JL,IBL,4)-PLNPRES(JL,JLEVP))&
           & / (PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
          ZGAM5 = (PRXP5(JL,IBL-1,4)+PRXP5(JL,IBL,4)-2.0_JPRB*&
           & PRXP5(JL,IBL-1,3))/(PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
          ZVAL5 = (0.5_JPRB + ZGAM5 * (ZXX5 - 1.5_JPRB)) * ZXX5

          ZXX =(PRXP(JL,IBL,4)-ZXX5*(PRXP(JL,IBL,4)-PRXP(JL,IBL-1,&
           & 4)))&
           & / (PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
          ZGAM= ( PRXP(JL,IBL-1,4)+PRXP(JL,IBL,4)&
           & -2.0_JPRB*PRXP(JL,IBL-1,3) - &
           & ZGAM5*(PRXP(JL,IBL,4)-PRXP(JL,IBL-1,4)) )&
           & / (PRXP5(JL,IBL,4)-PRXP5(JL,IBL-1,4))  
          ZVAL= ZGAM*(ZXX5*ZXX5-1.5_JPRB*ZXX5)+ZGAM5*(2.0_JPRB*ZXX5*ZXX-1.5_JPRB*&
           & ZXX)&
           & +0.5_JPRB*ZXX  
          PZPP(JL,JLEVP) = ZFLDF(JL,IBL) +&
           & PRXP(JL,IBL,4) *&
           & ( ZSTTF5(JL,IBL)+(ZSTTF5(JL,IBL-1)-ZSTTF5(JL,IBL))*&
           & ZVAL5) +&
           & (PRXP5(JL,IBL,4)-PLNPRES(JL,JLEVP)) *&
           & ( ZSTTF(JL,IBL) + (ZSTTF(JL,IBL-1)-ZSTTF(JL,IBL)) * &
           & ZVAL5 +&
           & (ZSTTF5(JL,IBL-1)-ZSTTF5(JL,IBL)) * ZVAL )  
        ELSEIF (LDBELO(JL,JLEVP).AND..NOT.LDBELS(JL,JLEVP) ) THEN
          ZXX5 = (PRXP5(JL,KFLEV,3) - PLNPRES(JL,JLEVP))&
           & / (PRXP5(JL,KFLEV,3) - PRXP5(JL,KFLEV,4))  
          ZXX = ( PRXP(JL,KFLEV,3) -&
           & ZXX5*( PRXP(JL,KFLEV,3) - PRXP(JL,KFLEV,4) ) )&
           & / (PRXP5(JL,KFLEV,3) - PRXP5(JL,KFLEV,4))  
          PZPP(JL,JLEVP) = ZXX * ZFLDF5(JL,KFLEV)+ ZXX5 * ZFLDF(JL,KFLEV)
        ENDIF
      ENDDO
    ENDIF
  ENDDO

!*       1.5   CALCULATE ICAO GEOPOTENTIAL ON PRESSURE LEVELS.
!*          ADD ICAO GEOPOTENTIAL TO THE POST-PROCESSED DEPARTURES.
!*          ALSO CALCULATE ICAO HEIGHTS AT MODEL SURFACE AND
!*          ADD TO POST-PROCESSED GEOPOTENTIAL.

!     CALL PPSTA('PPREF',KPROMA,KSTART,KPROF,KLEVP,KLOLEV
!    S          ,PRES,PLNPRES,ZSTTP,ZSTZP)

  CALL PPSTATL('PPREF',KPROMA,KSTART,KPROF,1,1,&
   & PRXP(1,KFLEV,1),PRXP(1,KFLEV,3),ZSTTH,ZSTZH,&
   & PRXP5(1,KFLEV,1))

  DO JLEVP = KLOLEV, KLEVP
    DO JL = KSTART, KPROF
      IF (.NOT.LDBELS(JL,JLEVP)) THEN
        PZPP(JL,JLEVP) = PZPP(JL,JLEVP) - ZSTZH(JL)
      ENDIF
    ENDDO
  ENDDO
  
!*       1.6   EXTRAPOLATE GEOPOTENTIAL DOWNWARDS.

  IF(LDEXTR) THEN
    ZTX=290.5_JPRB
    ZTY=255.0_JPRB
    ZDTDZSG=-RDTDZ1/RG
    DO JL=KSTART,KPROF
      IF(PTSTAR5(JL) < ZTY) THEN
        ZTSTAR5(JL)=0.5_JPRB*(ZTY+PTSTAR5(JL))
        ZTSTAR(JL)=0.5_JPRB*PTSTAR(JL)
      ELSEIF(PTSTAR5(JL) < ZTX) THEN
        ZTSTAR5(JL)=PTSTAR5(JL)
        ZTSTAR(JL)=PTSTAR(JL)
      ELSE
        ZTSTAR5(JL)=0.5_JPRB*(ZTX+PTSTAR5(JL))
        ZTSTAR(JL)=0.5_JPRB*PTSTAR(JL)
      ENDIF

      ZT05=ZTSTAR5(JL)+ZDTDZSG*POROG(JL)
      ZT0 =ZTSTAR (JL)
      IF(ZTX > ZTSTAR5(JL) .AND. ZT05 > ZTX) THEN
        ZT05=ZTX
        ZT0=0.0_JPRB
      ELSEIF(ZTX <= ZTSTAR5(JL) .AND. ZT05 > ZTSTAR5(JL)) THEN
        ZT05=ZTSTAR5(JL)
        ZT0=ZTSTAR(JL)
      ENDIF

      ZOROG=SIGN(MAX(1.0_JPRB,ABS(POROG(JL))),POROG(JL))
      ZALPHA5(JL)=RD*(ZT05-ZTSTAR5(JL))/ZOROG
      ZALPHA(JL)=RD*(ZT0-ZTSTAR(JL))/ZOROG
    ENDDO

    DO JLEVP=KLOLEV,KLEVP
      IF(LDBLES(JLEVP)) THEN
        DO JL=KSTART,KPROF
          IF(LDBELS(JL,JLEVP)) THEN
            ZLNPRT5=PLNPRES(JL,JLEVP)-PRXP5(JL,KFLEV,3)
            ZLNPRT=-PRXP(JL,KFLEV,3)
            ZALFLPR5=ZALPHA5(JL)*ZLNPRT5
            ZALFLPR=ZALPHA(JL)*ZLNPRT5+ZALPHA5(JL)*ZLNPRT
            ZALFLP2=2.0_JPRB*ZALFLPR*ZALFLPR5
            ZALFLP25=ZALFLPR5*ZALFLPR5
            PZPP(JL,JLEVP)=&
             & -RD*ZTSTAR(JL)*ZLNPRT5*&
             & (1.0_JPRB+0.5_JPRB*ZALFLPR5+1.0_JPRB/6._JPRB*ZALFLP25)&
             & -RD*ZTSTAR5(JL)*ZLNPRT*&
             & (1.0_JPRB+0.5_JPRB*ZALFLPR5+1.0_JPRB/6._JPRB*ZALFLP25)&
             & -RD*ZTSTAR5(JL)*ZLNPRT5*&
             & (   0.5_JPRB*ZALFLPR+1.0_JPRB/6._JPRB*ZALFLP2)  
          ENDIF
        ENDDO
      ENDIF
    ENDDO
    
  ELSE
    DO JLEVP = KLOLEV, KLEVP
      IF (LDBLES(JLEVP)) THEN
        DO JL = KSTART, KPROF
          IF (LDBELS(JL,JLEVP)) THEN
            PZPP(JL,JLEVP) = 0.0_JPRB
          ENDIF
        ENDDO
      ENDIF
    ENDDO

  ENDIF
ENDIF

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

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

