SUBROUTINE PPPWCTL(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,&
 & PRES,PLNPRES,LDBELS,LDBLES,&
 & PRXP,PRXPD,PQF,&
 & PWCPP,&
 & PRXP5,PRXPD5,PQF5)  

!**** *PPPWCTL*  - POST-PROCESS PWC, TANGENT LINEAR

!     PURPOSE.
!     --------
!           COMPUTES PWC AT HALF LEVELS  AND
!       PERFORMS THE VERTICAL INTERPOLATION TO A GIVEN
!       PRESSURE LEVEL. ALSO EXTRAPOLATES PWC
!       IF SO REQUESTED.

!**   INTERFACE.
!     ----------
!        *CALL* *PPPWCTL(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,
!                        PRES,PLNPRES,LDBELS,LDBLES,
!                        PRXP,PRXPD,PQF,
!                        PWCPP,
!                        PRXP5,PRXPD5,PQF5)

!        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)
!        KLOLEV                    - BEGINING FOR THE INTERPOLATION    (INPUT-C)
!        KLEVB(KPROMA,KLEVP,NPPM)  - INPUT LEVEL BELOW PRES            (INPUT-C)
!                                    (SEE PPFLEV)
!        PRES(KPROMA,KLEVP)        - POST-PROCESSING LEVEL PRESSURES   (INPUT-C)
!        PLNPRES(KPROMA,KLEVP)     - LOG(PRES)                        (INPUT-C)
!        LDBELS(KPROMA,KLEVP)      - .TRUE. IF PRESSURE IS UNDER
!                                     MODEL SURFACE                    (INPUT-C)
!        LDBLES(KLEVP)             - .TRUE. IF LDBELS(J) IS CONTAINING
!                                    AT LEAST ONE .TRUE.               (INPUT-C)
!        PRXP(KPROMA,0:KFLEV,NPPM) - HALF,FULL AND LN HALF LEVEL
!                                    PRESSURES (SEE PPINIT)            (INPUT)
!        PRXPD(KPROMA,0:KFLEV,NPPM)- 1./D(P) AND 1./D(LN(P))           (INPUT)
!        PQF(KPROMA,0:KFLEV)       - SPECIFIC HUMIDITY ON FULL
!                                    INPUT LEVELS.                     (INPUT)

!        PWCPP(KPROMA,KLEVP)       - POST-PROCESSED PWC                (OUTPUT)
!        PRXP5(KPROMA,0:KFLEV,NPPM)- HALF,FULL AND LN HALF LEVEL
!                                    PRESSURES (SEE PPINIT)            (INPUT-T)
!        PRXPD5(KPROMA,0:KFLEV,NPPM)- 1./D(P) AND 1./D(LN(P))          (INPUT-T)
!        PQF5(KPROMA,0:KFLEV)      - SPECIFIC HUMIDITY ON FULL
!                                    INPUT LEVELS.                     (INPUT-T)

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

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

!     EXTERNALS.  GPPWC  - COMPUTE PWC ON HALF LEVELS
!     ----------  PPINTP - LINEAR INTERPOLATION

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

!     AUTHOR.
!     -------
!        ERIK ANDERSSON, BASED ON PP-ROUTINES BY
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 92-06-08
!        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

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)    :: PRES(KPROMA,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPRES(KPROMA,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBELS(KPROMA,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBLES(KLEVP) 
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)    :: PQF(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWCPP(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)    :: PQF5(KPROMA,0:KFLEV) 
REAL(KIND=JPRB) :: ZPWCH(KPROMA,0:KFLEV)

REAL(KIND=JPRB) :: ZPWCH5(KPROMA,0:KFLEV)

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

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

#include "gppwc.intfb.h"
#include "gppwctl.intfb.h"
#include "ppintptl.intfb.h"

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

!*       1.    POST-PROCESS PWC
!              ----------------

!*       1.1   COMPUTE PWC ON MODEL HALF LEVELS. PWC=0 AT TOP OF MODEL.

IF (LHOOK) CALL DR_HOOK('PPPWCTL',0,ZHOOK_HANDLE)
CALL GPPWC(KPROMA,KSTART,KPROF,KFLEV,ZPWCH5,PQF5(1,1),PRXP5)
CALL GPPWCTL(KPROMA,KSTART,KPROF,KFLEV,ZPWCH,PQF(1,1),PRXP,PQF5(1,1),PRXP5)

!*       1.2   INTERPOLATE PWC

ISLCT=3
CALL PPINTPTL(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEVB,ISLCT,&
 & LDBELS,LDBLES,PLNPRES,PRXP,PRXPD,&
 & ZPWCH,PWCPP,&
 & PRXP5,PRXPD5,ZPWCH5)  

!*       1.4   EXTRAPOLATE PWC DOWNWARDS.
!*             ASSUME CONSTANT Q, AS IN ROUTINE PPQ.

ZRGI=1.0_JPRB/RG
DO JLEVP=KLOLEV,KLEVP
  IF(LDBLES(JLEVP)) THEN
    DO JL=KSTART,KPROF
      IF(LDBELS(JL,JLEVP)) THEN
        PWCPP(JL,JLEVP)=ZPWCH(JL,KFLEV)&
         & + ( -PQF5(JL,KFLEV)*PRXP(JL,KFLEV,1)&
         & +PQF(JL,KFLEV)*(PRES(JL,JLEVP)-PRXP5(JL,KFLEV,1)) )*ZRGI  
      ENDIF
    ENDDO
  ENDIF
ENDDO

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

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