SUBROUTINE PPZHLEV(KPROMA,KSTART,KPROF,KFLEV,KLEVP,&
 & PRZ,PRGEOPH,PRGEOPF,&
 & KLEVB,&
 & LDBELO,LDBELS,LDBLOW,LDBLES)  

!**** *PPZHLEV* - FIND PRESSURE LEVEL UNDER SPECIFIED PRESSURES

!     PURPOSE.
!     --------
!       FINDS THE POINTER TO THE INPUT GRID LEVEL BELOW (HIGHER NUMBER)
!       THE SPECIFIED PRESSURES WE WANT TO INTERPOLATE TO.
!       FLAGS POINTS OUT OF RANGE OF INPUT GRID LEVELS.

!**   INTERFACE.
!     ----------
!        *CALL* *PPZHLEV(KPROMA,KSTART,KPROF,KFLEV,KLEVP,
!                       PRZ,PRPRESH,PRPRESF,
!                       KLEVB,
!                       LDBELO,LDBELS,LDBLOW,LDBLES)

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

!        KPROMA                    - HORIZONTAL DIMENSION.             (INPUT)
!        KSTART                    - START OF WORK.                    (INPUT)
!        KPROF                     - DEPTH OF WORK.                    (INPUT)
!        KFLEV                     - NUMBER OF INPUT LEVELS            (INPUT)
!        KLEVP                     - NUMBER OF OUTPUT LEVELS           (INPUT)
!        PRZ                       - POST-PROCESSING LEVELS            (INPUT)
!        PRGEOPH                   - INPUT HALF LEVEL HEIGHTS          (INPUT)
!        PRGEOPF                   - INPUT FULL LEVEL HEIGHTS          (INPUT)
!        KLEVB                     - INPUT LEVEL BELOW PRZ             (OUTPUT)
!        LDBELO                    - .TRUE. IF PRESSURE IS UNDER
!                                     LOWEST (FULL) MODEL LEVEL        (OUTPUT)
!        LDBELS                    - .TRUE. IF PRESSURE IS UNDER
!                                     MODEL SURFACE                    (OUTPUT)
!        LDBLOW                    - .TRUE. IF LDBELO(J) IS CONTAINING
!                                    AT LEAST ONE .TRUE.               (OUTPUT)
!        LDBLES                    - .TRUE. IF LDBELS(J) IS CONTAINING
!                                    AT LEAST ONE .TRUE.               (OUTPUT)

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

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

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

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

!     AUTHOR.
!     -------

!        D. VASILJEVIC *ECMWF*

!     MODIFICATIONS.
!     --------------
!     Erik Andersson 97-10-20 : Change to using F90 ANY-intrinsic
!     Modified : ??-??-?? J.Latour ?? tidied up by M.Hamrud
!        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)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRZ(KPROMA,KLEVP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRGEOPH(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRGEOPF(KPROMA,KFLEV) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KLEVB(KPROMA,KLEVP,NPPM) 
LOGICAL           ,INTENT(OUT)   :: LDBELO(KPROMA,KLEVP) 
LOGICAL           ,INTENT(OUT)   :: LDBELS(KPROMA,KLEVP) 
LOGICAL           ,INTENT(OUT)   :: LDBLOW(KLEVP) 
LOGICAL           ,INTENT(OUT)   :: LDBLES(KLEVP) 
INTEGER(KIND=JPIM) :: JLEVP,JL,ILB,JLEV
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.    FIND INPUT GRID LEVELS BELOW OUTPUT GRID LEVELS.
!              ------------------------------------------------

!*       1.1   FIND HALF AND FULL LEVEL BELOW SPECIFIED HEIGHT

IF (LHOOK) CALL DR_HOOK('PPZHLEV',0,ZHOOK_HANDLE)
KLEVB(:,:,1)=KFLEV
DO JLEV=1,KFLEV-1
  DO JLEVP=1,KLEVP
    DO JL=KSTART,KPROF
      IF( PRGEOPH(JL,JLEV) < PRZ(JL,JLEVP)&
       & .AND. KLEVB(JL,JLEVP,1) == KFLEV) KLEVB(JL,JLEVP,1)=JLEV  
    ENDDO
  ENDDO
ENDDO

DO JLEVP=1,KLEVP
  DO JL=KSTART,KPROF
    ILB=KLEVB(JL,JLEVP,1)
    IF(PRGEOPF(JL,ILB)-PRZ(JL,JLEVP)  <=  0.0_JPRB ) THEN
      KLEVB(JL,JLEVP,2)=ILB
    ELSE
      KLEVB(JL,JLEVP,2)=ILB+1
    ENDIF
    KLEVB(JL,JLEVP,2)=MIN(KLEVB(JL,JLEVP,2),KFLEV)
    KLEVB(JL,JLEVP,3)=KLEVB(JL,JLEVP,1)
    KLEVB(JL,JLEVP,4)=KLEVB(JL,JLEVP,2)
  ENDDO
ENDDO

!*       1.2   FLAG VALUES OUTSIDE RANGE OF MODEL LEVELS.

DO JLEVP=1,KLEVP
  DO JL=KSTART,KPROF
    LDBELO(JL,JLEVP)=PRZ   (JL,JLEVP) < PRGEOPF(JL,KFLEV)
    LDBELS(JL,JLEVP)=PRZ   (JL,JLEVP) < PRGEOPH(JL,KFLEV)
  ENDDO
  LDBLOW(JLEVP) = ANY(LDBELO(KSTART:KPROF,JLEVP))
  LDBLES(JLEVP) = ANY(LDBELS(KSTART:KPROF,JLEVP))
ENDDO

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

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