SUBROUTINE GHG_AK_OP(KDLEN,KLEN,KDCOUNT,CDPAR,KCOUNT,&
 & KAK,PWAK,PAPAK,PRESO,PRESH5,PRESF5,PXP5,PXPD5,YDGEMSPROF5,&
 & KDPP,PXGEMS)  

!**** GHG_AK_OP - Observation operator for GHG based on grg_ak_op.F90

!     R. Engelen              ECMWF           7-Jan-09

!     PURPOSE
!     -------

!        FIND OUT AN EQUIVALENT MODEL PARAMETER FOR A GIVEN OBSERVED.

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

!        CALL GHG_AK_OP(KDLEN,KLEN,KDCOUNT,CDPAR,KCOUNT,
!    I                  KAK,PWAK,PRESO,PRESH5,PRESF5,PXP5,PXPD5,YDGEMSPROF5,
!    O                  KDPP,PXGEMS)
!     WHERE KDLEN   : FIRST DIMENSION (Observations)            (INPUT)
!           KLEN    : ACTUAL NUMBER OF OBSERVATIONS             (INPUT)
!           KDCOUNT : SECOND DIMENSION (Data/bodies per observation,
!                     pressure values from grg layer observations (INPUT)
!           CDPAR   : PARAMETER FOR POST-PROCESSING             (INPUT)
!           KCOUNT  : COUNTER FOR THE PARTICULAR OBS. PARAMETER (INPUT)
!           KAK     : Number of averaging kernel elements       (INPUT)
!           PWAK    : Weights for averaging kernels             (INPUT)
!           PAPAK   : Prior values for averaging kernels        (INPUT)
!           PRESO   : Output PRESSURES (ak pressures)           (INPUT)
!           PRESH5  : HALF LEVEL PRESSURES                      (INPUT)
!           PRESF5  : FULL LEVEL PRESSURES                      (INPUT)
!           PXP5    : INTERMEDIATE ARRAY                        (INPUT)
!           PXPD5   : ..................                        (INPUT)
!           YDGEMSPROF5: GHG AT MODEL FULL LEVELS                (INPUT)
!           KDPP    : Number of fields, dimension of PXPP
!           PXGEMS  : GEMS layer value                           (OUTPUT)

!        GHG_AK_OP IS CALLED FROM HOP

!**   METHOD
!     ------

!        CALL TO PPAK POST-PROCESSING ROUTINE

!**   EXTERNALS
!     ---------

!        PPFLEV  - FIND PRESSURE LEVEL UNDER SPECIFIED PRESSURES
!        PPQ     - CALCULATE GRG layer value using averaging kernels

!**   AUTHOR  
!     ------
!     R. Engelen    7-Jan-2009: Obs operator for GHG variables 
!                              using averaging kernels

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

USE YOMDIM   , ONLY : NFLEVG   ,NPPM

USE YOMCST   , ONLY : RG, RMD, RMCH4
USE YOM_YGFL , ONLY : NGHG,YGHG_NL
USE TYPE_GEMS_PROFILES

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDCOUNT
CHARACTER(LEN=*)  ,INTENT(IN)    :: CDPAR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCOUNT(KDLEN) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAK(KDLEN,KDCOUNT)  
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWAK(KDLEN,KDCOUNT,JPMX_AK) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPAK(KDLEN,KDCOUNT,JPMX_AK) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESO(KDLEN,KDCOUNT,JPMX_AK) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXP5(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXPD5(KDLEN,0:NFLEVG,NPPM) 
TYPE (TYPE_GEMSPROF),INTENT(IN)  :: YDGEMSPROF5(KDLEN,NGEMS)
INTEGER(KIND=JPIM),INTENT(IN)    :: KDPP
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXGEMS(KDLEN,KDCOUNT,KDPP) 

INTEGER(KIND=JPIM), ALLOCATABLE :: ILEVB_AK(:,:,:),ILEVB(:,:,:,:)
LOGICAL, ALLOCATABLE :: LLBELO(:,:,:),LLBLOW(:,:),LLBELS(:,:,:),LLBLES(:,:)
LOGICAL, ALLOCATABLE :: LLBELO_AK(:,:),LLBLOW_AK(:),LLBELS_AK(:,:),LLBLES_AK(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZGEMSMODEL5(:,:),ZGEMS_AK5(:,:)
REAL(KIND=JPRB)  :: ZPRESO_AK(KDLEN,JPMX_AK)
REAL(KIND=JPRB) :: ZMMR2VMRCH4, ZRGI, ZDP, ZDPSUM

INTEGER(KIND=JPIM) :: JGEMS,JGHG,JLEN
INTEGER(KIND=JPIM) :: ILEN,IMXCNT,ICOUNT,IMXKAK,INPP
INTEGER(KIND=JPIM) :: IAK
LOGICAL, DIMENSION(NGHG) :: LLGHG
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "ppq.intfb.h"
#include "ppflev.intfb.h"
!     ------------------------------------------------------------------
!*    1.  PREPARATION
!*    1.1 MAX. NO. OF LEVELS/obs

IF (LHOOK) CALL DR_HOOK('GHG_AK_OP',0,ZHOOK_HANDLE)

ZMMR2VMRCH4=RMD/RMCH4
ZRGI=1.0_JPRB/RG

ILEN   = KLEN
IMXCNT = MAXVAL(KCOUNT(1:ILEN))
IF(IMXCNT == 0) GOTO 9
IMXKAK=MAXVAL(KAK(1:ILEN,1:IMXCNT))


DO JGHG=1,NGHG
  LLGHG(JGHG)=CDPAR == TRIM(YGHG_NL(JGHG)%cname)
ENDDO

INPP=0

ALLOCATE(ILEVB_AK(KDLEN,IMXKAK,NPPM))
ALLOCATE(LLBELO_AK(KDLEN,IMXKAK))
ALLOCATE(LLBELS_AK(KDLEN,IMXKAK))
ALLOCATE(LLBLOW_AK(IMXKAK))
ALLOCATE(LLBLES_AK(IMXKAK))

ALLOCATE(ILEVB(KDLEN,IMXKAK,NPPM,IMXCNT))
ALLOCATE(LLBELO(KDLEN,IMXKAK,IMXCNT))
ALLOCATE(LLBELS(KDLEN,IMXKAK,IMXCNT))
ALLOCATE(LLBLOW(IMXKAK,IMXCNT))
ALLOCATE(LLBLES(IMXKAK,IMXCNT))

!*    1.2 FIND OUT PRESSURE LEVEL BELOW SPECIFIED (OBSERVED) PRESSURES

Do ICOUNT=1,IMXCNT

  ZPRESO_AK(:,:)=PRESO(:,ICOUNT,:)

  CALL PPFLEV(KDLEN,1,ILEN,NFLEVG,IMXKAK,&
   & ZPRESO_AK,PRESH5,PRESF5,&
   & ILEVB_AK,&
   & LLBELO_AK,LLBELS_AK,LLBLOW_AK,LLBLES_AK)  

  
  ILEVB(1:ILEN,1:IMXKAK,:,ICOUNT)=ILEVB_AK(1:ILEN,1:IMXKAK,:)
  LLBELO(1:ILEN,1:IMXKAK,ICOUNT)=LLBELO_AK(1:ILEN,1:IMXKAK)
  LLBELS(1:ILEN,1:IMXKAK,ICOUNT)=LLBELS_AK(1:ILEN,1:IMXKAK)
  LLBLOW(1:IMXKAK,ICOUNT)=LLBLOW_AK(1:IMXKAK)
  LLBLES(1:IMXKAK,ICOUNT)=LLBLES_AK(1:IMXKAK)

ENDDO
  
!*    2. GHG variables:
!        Interpolate model values to averaging kernel  pressures 
!        and calculate model equivalent of obs as SUM(pgrg*wak)

JGHG=0
DO JGEMS=1,NGEMS
  IF(YDGEMSPROF5(1,JGEMS)%CSPECIES=='GHG') THEN
    JGHG=JGHG+1
    IF(LLGHG(JGHG)) THEN
      IF(INPP+1 > KDPP) CALL ABOR1('PPOBSA: KDPP EXCEEDED, GRG')
      INPP=INPP+1
      ALLOCATE(ZGEMSMODEL5(KDLEN,0:NFLEVG))
      ALLOCATE(ZGEMS_AK5(KDLEN,IMXKAK))
      DO JLEN=1,ILEN
        ZGEMSMODEL5(JLEN,1:NFLEVG)= &
         & YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1:NFLEVG)*ZMMR2VMRCH4
        ZGEMSMODEL5(JLEN,0)=YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1)*ZMMR2VMRCH4
      ENDDO

      CALL PPQ(KDLEN,1,ILEN,NFLEVG,IMXKAK,1,ILEVB,&
       & PRESO,LLBELS,LLBLES,&
       & PXP5,PXPD5,ZGEMSMODEL5,&
       & ZGEMS_AK5)

      PXGEMS(:,:,:)=0.0_JPRB
      DO JLEN=1,ILEN
        ZDPSUM=0.0_JPRB
        DO IAK=1,IMXKAK
          IF (IAK == 1) THEN
            ZDP=ZPRESO_AK(JLEN,IAK)
          ELSE
            ZDP=ZPRESO_AK(JLEN,IAK)-ZPRESO_AK(JLEN,IAK-1)
          ENDIF
          PXGEMS(JLEN,1,INPP)=PXGEMS(JLEN,1,INPP) + &
           &    (ZGEMS_AK5(JLEN,IAK)*PWAK(JLEN,1,IAK) + &
           &    (1.0_JPRB-PWAK(JLEN,1,IAK))*PAPAK(JLEN,1,IAK)) *(ZDP*ZRGI)
          ZDPSUM = ZDPSUM + (ZDP*ZRGI)
        ENDDO
        PXGEMS(JLEN,1,INPP) = PXGEMS(JLEN,1,INPP)/ZDPSUM
      ENDDO
      DEALLOCATE(ZGEMSMODEL5,ZGEMS_AK5)
    ENDIF
  ENDIF
ENDDO

DEALLOCATE(ILEVB,LLBELO,LLBELS,LLBLOW,LLBLES)
DEALLOCATE(ILEVB_AK,LLBELO_AK,LLBELS_AK,LLBLOW_AK,LLBLES_AK)

9 CONTINUE

IF (LHOOK) CALL DR_HOOK('GHG_AK_OP',1,ZHOOK_HANDLE)

END SUBROUTINE GHG_AK_OP
