SUBROUTINE PPAK(KPROMA,KSTART,KPROF,KFLEV,KLEVP,KLOLEV,KLEV_AK,KLEVB,&
 & PRES,PLNPRES,LDBELS,LDBLES,PWEIGHT,&
 & PRXP,PRXPD,PGRGF,&
 & PGRGPP)  

!**** *PPAK* - POST-PROCESS GRG fields using AVERAGING KERNELS (AK)

!     PURPOSE.
!     --------
!       PERFORMS THE VERTICAL INTERPOLATION TO THE GIVEN
!       averaging kernel PRESSURE LEVELS. 
!       COMPUTES model equivalent of obs as SUM(ZGRG*pweight)

!**   INTERFACE.
!     ----------
!        *CALL* *PPAK(KPROMA,KSTART,KPROF,KFLEV,KLEVP,PWEIGHT,KLOLEV,KLEVB,
!                      PRES,PLNPRES,LDBELS,LDBLES,
!                      PRXP,PRXPD,PGRGF,
!                      PGRGPP)

!        EXPLICIT ARGUMENTS
!        --------------------

!        KPROMA                    - HORIZONTAL DIMENSION.             (INPUT)
!        KSTART                    - START OF WORK.                    (INPUT)
!        KPROF                     - DEPTH OF WORK.                    (INPUT)
!        KFLEV                     - NUMBER OF INPUT PRESSURE LEVELS   (INPUT)
!        KLEVP                     - NUMBER OF OUTPUT PRESSURE LEVELS, (INPUT)
!        KLOLEV                    - BEGINING FOR THE INTERPOLATION    (INPUT)
!        KLEV_AK                  - NUMBER OF averaging kernel
!                                    PRESSURE LEVELS,                  (INPUT)
!        KLEVB(KPROMA,KLEV_AK,NPPM,KLEVP)  - INPUT LEVEL BELOW PRES    (INPUT)
!                                    (SEE PPFLEV)
!        PRES(KPROMA,KLEVP,KLEV_AK) - POST-PROCESSING LEVEL PRESSURES  (INPUT)
!        PLNPRES(KPROMA,KLEV_AK,KLEVP)- LOG(PRES)                      (INPUT)
!        LDBELS(KPROMA,KLEV_AK,KLEVP) - .TRUE. IF PRESSURE IS UNDER
!                                     MODEL SURFACE                    (INPUT)
!        LDBLES(KLEV_AK,KLEVP)             - .TRUE. IF LDBELS(J) IS CONTAINING
!                                    AT LEAST ONE .TRUE.               (INPUT)
!        PWEIGHT(KPROMA,KLEVP,KLEV_AK)     - Weights for averaging kernel (INPUT)
!        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)
!        PGRGF(KPROMA,0:KFLEV)     - GRG field ON FULL
!                                    INPUT LEVELS.                     (INPUT)
!        PGRGPP(KPROMA,KLEVP)            - POST-PROCESSED GRG column field   (OUTPUT)

!        IMPLICIT ARGUMENTS :  CONSTANTS FROM YOMDIM.
!        --------------------

!     METHOD.
!     -------
!        CALCULATE model fields on averaging kernel pressure levels and
!        model equivalent of observation as PGRGPP=SUM(ZGRG*PWEIGHT)

!     REFERENCE.
!     ----------

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 27-Jul-2005
!     ------------------------------------------------------------------

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)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLOLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV_AK
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVB(KPROMA,KLEV_AK,NPPM,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRES(KPROMA,KLEVP,KLEV_AK) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPRES(KPROMA,KLEV_AK,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBELS(KPROMA,KLEV_AK,KLEVP) 
LOGICAL           ,INTENT(IN)    :: LDBLES(KLEV_AK,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWEIGHT(KPROMA,KLEVP,KLEV_AK) 
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)    :: PGRGF(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGRGPP(KPROMA,KLEVP) 

INTEGER(KIND=JPIM) :: ISLCT, JL, JLEVP,IAK
INTEGER(KIND=JPIM) :: IAB, IBL

REAL(KIND=JPRB) :: ZCOL(KPROMA,0:KFLEV),ZGRG(KPROMA,KLEVP,0:KLEV_AK),ZRGI
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "gppwc.intfb.h"
!     ------------------------------------------------------------------

!*       1.    POST-PROCESS GRG field
!              -----------------------

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

IF (LHOOK) CALL DR_HOOK('PPAK',0,ZHOOK_HANDLE)
CALL GPPWC(KPROMA,KSTART,KPROF,KFLEV,ZCOL,PGRGF(1,1),PRXP)


!*       1.2   INTERPOLATE GRG field LINEARLY IN LN(P)
ZGRG(:,:,0)=0.0_JPRB
ISLCT=3
DO JLEVP=KLOLEV,KLEVP

  DO IAK=1,KLEV_AK
    IF (.NOT.LDBLES(IAK,JLEVP)) THEN
      DO JL=KSTART,KPROF
        IBL=KLEVB(JL,IAK,ISLCT,JLEVP)
        IAB=IBL-1
        ZGRG(JL,JLEVP,IAK)=ZCOL(JL,IAB)+(ZCOL(JL,IBL)-ZCOL(JL,IAB))*&
         & (PLNPRES(JL,IAK,JLEVP)-PRXP(JL,IAB,ISLCT))*PRXPD(JL,IAB,ISLCT)
      ENDDO
    ELSE
      DO JL=KSTART,KPROF
        IF (.NOT.LDBELS(JL,IAK,JLEVP)) THEN
          IBL=KLEVB(JL,IAK,ISLCT,JLEVP)
          IAB=IBL-1
          ZGRG(JL,JLEVP,IAK)=ZCOL(JL,IAB)+(ZCOL(JL,IBL)-ZCOL(JL,IAB))*&
           & (PLNPRES(JL,IAK,JLEVP)-PRXP(JL,IAB,ISLCT))*PRXPD(JL,IAB,&
           & ISLCT)
        ENDIF
      ENDDO
    ENDIF
  ENDDO

ENDDO

!*       1.4   EXTRAPOLATE GRG COLUMNS DOWNWARDS.
!*             ASSUME GRG=const below surface

ZRGI=1.0_JPRB/RG
DO JLEVP=KLOLEV,KLEVP
  DO IAK=1,KLEV_AK
    IF(LDBLES(IAK,JLEVP)) THEN
      DO JL=KSTART,KPROF
        IF(LDBELS(JL,IAK,JLEVP)) THEN
!          ZGRG(JL,JLEVP,IAK)=0.0_JPRB
          ZGRG(JL,JLEVP,IAK)=ZCOL(JL,KFLEV)&
           & +PGRGF(JL,KFLEV)*(PRES(JL,JLEVP,IAK)-PRXP(JL,KFLEV,1))*ZRGI
        ENDIF
      ENDDO
    ENDIF
  ENDDO
ENDDO

!*       1.2   COMPUTE SUM(ZGRG*PWEIGHT)

!PGRGPP(:,:)=0.0_JPRB
!Do IAK=1,KLEV_AK
!    PGRGPP(:,:)=PGRGPP(:,:) + &
!     &         (ZGRG(:,:,IAK)-ZGRG(:,:,IAK-1))*PWEIGHT(:,:,IAK)
!ENDDO

PGRGPP(:,:)=0.0_JPRB
Do IAK=1,KLEV_AK
  DO JLEVP=KLOLEV,KLEVP
    DO JL=KSTART,KPROF
      PGRGPP(JL,JLEVP)=PGRGPP(JL,JLEVP) + &
       &         (ZGRG(JL,JLEVP,IAK)-ZGRG(JL,JLEVP,IAK-1))*PWEIGHT(JL,JLEVP,IAK)
    ENDDO
  ENDDO
ENDDO
!     ------------------------------------------------------------------

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