SUBROUTINE EXHEIZ2P(CDACT,KDIM1,KDIM2,KOBS,KSET,KCOUNT,PHEIGH,LDZORPHI)

!**** EXHEIZ2P - EXTRACT OBSERVATION LEVEL IF GIVEN IN HEIGHT

!     HEIKKI JARVINEN        ECMWF           15/8/95

!     PURPOSE
!     -------

!        EXHEIZ2P EXTRACTS OBSERVATION LEVEL IF GIVEN IN HEIGHT.  THAT
!     IS USED WHEN CHANGING THE VERTICAL COORDINATE FROM Z TO P.  THE
!     FIRST GUESS PRESSURE CORRESPONDING TO THE HEIGHT IS INSERTED TO
!     CMA (OVERWRITES THE HEIGHT).

!**   INTERFACE
!     ---------

!        CALL EXHEIZ2P(CDACT,KDIM1,KDIM2,KOBS,KSET,KCOUNT,PHEIGH)
!     WHERE CDACT  : 'GETHVC' - EXTRACT HEIGHT (STANDARD CASE),
!                    'PUTHVC' - INSERT PRESSURE (STANDARD CASE),
!                    'GETNSU' - EXTRACT HEIGHT (NEAR SURFACE CASE),
!                    'PUTNSU' - INSERT PRESSURE (NEAR SURFACE CASE)
!           KDIM1  : FIRST DIMENSION
!           KDIM2  : SECOND DIMENSION
!           KOBS   : A GIVEN OBSERVATION IN THE OBS. SET
!           KSET   : OBS. SET NUMBER
!           KCOUNT : COUNTER FOR THE PARTICULAR OBS. PARAMETER
!           PHEIGH : VERTICAL COORDINATE
!                    - IF 'GET' PHEIGH IS HEIGHT   OF OBSERVATION
!                    - IF 'PUT' PHEIGH IS PRESSURE OF OBSERVATION

!**   METHOD
!     ------

!**   MODIFICATIONS
!     -------------

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

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

USE YOMCT0   , ONLY : LCANARI
USE YOMVNMB  , ONLY : NVNUMB
USE YOMLUN   , ONLY : NULERR
USE YOMNMEV  , ONLY : ND1EVENT
USE YOMANCS  , ONLY : RMDI
USE YOMCST   , ONLY : RG
USE YOMCOCTP , ONLY : NSYNOP   ,NDRIBU   ,NTEMP    ,NPILOT   ,&
 & NSHSCD   ,NABSCD   ,NSHRED   ,NATSHS   ,&
 & NSHTCD   ,NSHPCD  
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM1 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM2 
CHARACTER(LEN=6)  ,INTENT(IN)    :: CDACT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSET 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KCOUNT(KDIM1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PHEIGH(KDIM1,KDIM2) 
LOGICAL           ,INTENT(IN)    :: LDZORPHI 
INTEGER(KIND=JPIM) :: IANMOMHP, ICDTYPE, &
 & IDEVEN1, IEVEN23, IOBT, IVCO, IVNM, J  

LOGICAL :: LLSHDR

REAL(KIND=JPRB) :: ZINTH, ZVCO, ZORPHI
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!*
#include "fcobs.h"

#include "openmp_obs.h"

!     ------------------------------------------------------------------
!           1.       EXTRACT PRESSURES
!                    -----------------

IF (LHOOK) CALL DR_HOOK('EXHEIZ2P',0,ZHOOK_HANDLE)
ZORPHI=1.
IF(LDZORPHI) ZORPHI=RG

!*             1.0   GET REPORT INFORMATION

IOBT   = ROBHDR(KOBS,MDBOTP)
ICDTYPE= ROBHDR(KOBS,MDB_CODETYPE_AT_HDR)

IF(CDACT == 'GETNSU'.OR.CDACT == 'PUTNSU'    ) THEN
  LLSHDR = (IOBT == NSYNOP.AND.(ICDTYPE == NSHSCD.OR.&
   & ICDTYPE == NABSCD.OR.&
   & ICDTYPE == NSHRED.OR.&
   & ICDTYPE == NATSHS    )).OR.&
   & IOBT == NDRIBU                              .OR.&
   & (IOBT == NTEMP .AND. ICDTYPE == NSHTCD     ).OR.&
   & (IOBT == NPILOT.AND. ICDTYPE == NSHPCD     )  
  IF(.NOT.LLSHDR)                                GO TO 2
  IANMOMHP = MDBHOANS
  IF(IOBT == NSYNOP)      THEN
    IANMOMHP = MDBHOANS
  ELSEIF(IOBT == NDRIBU) THEN
    IANMOMHP = MDBHOAND
  ELSEIF(IOBT == NTEMP ) THEN
    IANMOMHP = MDBHOANT
  ELSEIF(IOBT == NPILOT) THEN
    IANMOMHP = MDBHOANP
  ENDIF
ENDIF

!*             1.1   LOOP OVER THE REPORT

REPORT_LOOP: DO J= MLNKH2B(KOBS),MLNKH2B(KOBS+1)-1
  IVCO = ROBODY(J,MDBVCO)
  ZVCO = ROBODY(J,MDBPPP)
  IVNM = ROBODY(J,MDBVNM)

!*             1.2   STANDARD CASE

  IF(CDACT == 'GETHVC'.OR.CDACT == 'PUTHVC'    ) THEN

!*             1.2.1  SET COUNTERS/POINTERS

    IF(IVCO == 2 .AND. ZVCO /= RMDI) THEN
      IF(IVNM /= NVNUMB(47)) THEN
        KCOUNT(KOBS)=KCOUNT(KOBS)+1
        IF(KCOUNT(KOBS) > KDIM2)    THEN
          WRITE(NULERR,'('' *** ERROR IN EXHEIZ2P'')')
          WRITE(NULERR,'('' KSET  ='',I10,'' KOBS  ='',I10)')KSET,KOBS
          WRITE(NULERR,'('' KCOUNT='',I10,'' KDIM2='',I10)')&
           & KCOUNT(KOBS),KDIM2  
          CALL ABOR1('EXHEIZ2P: DIMENSION ERROR')
        ENDIF
        IF(CDACT == 'GETHVC') THEN
          PHEIGH(KOBS,KCOUNT(KOBS)) = ROBODY(J,MDBPPP) * ZORPHI
        ELSEIF(CDACT == 'PUTHVC') THEN
          ROBODY(J,MDBVCO) = 1
          ROBODY(J,MDBPPP) = MAX(1.0_JPRB,PHEIGH(KOBS,KCOUNT(KOBS)))
          IF(.NOT.LCANARI) &
           & ROBODY(J,MDBDEV1) = ZCHEV1(ROBODY(J,MDBDEV1),ND1EVENT(23))
        ENDIF
      ENDIF
    ENDIF

!*             1.3   NEAR SURFACE CASE

  ELSEIF(CDACT == 'GETNSU' .OR. CDACT == 'PUTNSU') THEN
    IF(IVNM == NVNUMB(56) .OR. IVNM == NVNUMB(57)) THEN
      IF(IVCO == 1) THEN
        KCOUNT(KOBS)=KCOUNT(KOBS)+1
        IF(KCOUNT(KOBS) > KDIM2) THEN
          WRITE(NULERR,'('' *** ERROR IN EXHEIZ2P'')')
          WRITE(NULERR,'('' KSET  ='',I10,'' KOBS  ='',I10)')KSET,KOBS
          WRITE(NULERR,'('' KCOUNT='',I10,'' KDIM2='',I10)')&
           & KCOUNT(KOBS),KDIM2  
          CALL ABOR1('EXHEIZ2P: DIMENSION ERROR')
        ENDIF
        IF(CDACT == 'GETNSU') THEN
          ZINTH = 10._JPRB*RG
          IF(ROBHDR(KOBS,IANMOMHP) /= RMDI) THEN
            ZINTH = ROBHDR(KOBS,IANMOMHP)*RG
          ENDIF
          PHEIGH(KOBS,KCOUNT(KOBS)) = ZINTH
        ELSEIF(CDACT == 'PUTNSU') THEN
          ROBODY(J,MDBPPP)=MAX(1.0_JPRB,PHEIGH(KOBS,KCOUNT(KOBS)))
          IF(.NOT.LCANARI) THEN
            IDEVEN1 = ROBODY(J,MDBDEV1)
            IEVEN23 = IBITS (IDEVEN1,ND1EVENT(23)-1,1)
            IF(IEVEN23 == 0) THEN
              ROBODY(J,MDBDEV1) = ZCHEV1( ROBODY(J,MDBDEV1),ND1EVENT(23))
            ENDIF
          ENDIF
        ENDIF
      ELSE
        WRITE(NULERR,'('' *** ERROR IN EXHEIZ2P'')')
        WRITE(NULERR,'('' VERTICAL COORDINATE='',I10)') IVCO
        WRITE(NULERR,'('' IS NOT PRESSURE'')')
        WRITE(NULERR,'('' IOBT   ='',I10)') IOBT
        WRITE(NULERR,'('' ICDTYPE='',I10)') ICDTYPE
        CALL ABOR1('EXHEIZ2P: COORDINATE ERROR')
      ENDIF
    ENDIF
  ENDIF
ENDDO REPORT_LOOP

!     ------------------------------------------------------------------
!        2.       RETURN
!                 ------
2 CONTINUE

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