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

!**** GRG_AK_OP - Observation operator for GRG based on ppobsa.F90

!     A. Dethof              ECMWF           22-Feb-06

!     PURPOSE
!     -------

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

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

!        CALL GRG_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),
!                     =1 for total columns, > 1 for partial columns (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   : Apriori 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: GRG AT MODEL FULL LEVELS                (INPUT)
!           KDPP    : Number of fields, dimension of PXPP
!           PXGEMS   : GRG layer value                           (OUTPUT)
!           PNO25   : NO2 (optional)                            (INPUT)

!        GRG_AK_OP IS CALLED FROM HOP

!**   METHOD
!     ------

!        CALL TO PPPWC POST-PROCESSING ROUTINE

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

!        PPFLEV  - FIND PRESSURE LEVEL UNDER SPECIFIED PRESSURES
!        PPPWC   - CALCULATE columns above model levels

!**   AUTHOR  
!     ------
!     A.Dethof    22-Feb-2006: Obs operator for GRG variables 
!                              using averaging kernels

!**   MODIFICATIONS
!     -------------
!     A.Inness    13-Oct-2009: Include apriori profile
!     ------------------------------------------------------------------

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, RMCO
USE YOMLUN   , ONLY : NULERR

USE YOM_YGFL , ONLY : NGRG,YGRG_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) 
REAL(KIND=JPRB)   ,INTENT(IN), OPTIONAL:: PNO25(KDLEN,0:NFLEVG) 

INTEGER(KIND=JPIM), ALLOCATABLE :: ILEVB(:,:,:)
LOGICAL, ALLOCATABLE :: LLBELO(:,:),LLBLOW(:),LLBELS(:,:),LLBLES(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZLNPRESO(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZGEMSMODEL5(:,:),ZGEMS_AK5(:,:)
REAL(KIND=JPRB)  :: ZPRESO(KDLEN,JPMX_AK)
LOGICAL :: LLNO2

INTEGER(KIND=JPIM) :: JGEMS,JGRG,JLEN
INTEGER(KIND=JPIM) :: ILEN,IMXCNT,IMXKAK,INPP,IND_NOX,IAK
INTEGER(KIND=JPIM) :: JLEVP
LOGICAL, DIMENSION(NGRG) :: LLGRG
REAL(KIND=JPRB) :: ZRGI, ZDP,ZVMR2MMRCO,ZCOL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

ZRGI=1.0_JPRB/RG
ZVMR2MMRCO=RMCO/RMD

ILEN   = KLEN
IMXCNT = MAXVAL(KCOUNT(1:ILEN))
IF(IMXCNT == 0) GOTO 9
IF(IMXCNT > 1) THEN
  WRITE(NULERR,*) 'GRG_AK_OP: ROUTINE DOES NOT WORK FOR IMXCNT>1. IMXCNT=',IMXCNT
  CALL ABOR1('GRG_AK_OP: ROUTINE DOES NOT WORK FOR IMXCNT>1.')
ENDIF
IMXKAK=MAXVAL(KAK(1:ILEN,1:IMXCNT))

LLNO2=.FALSE.
IF(PRESENT(PNO25)) LLNO2=.TRUE.

DO JGRG=1,NGRG
  LLGRG(JGRG)=CDPAR == TRIM(YGRG_NL(JGRG)%cname)
  IF(LLNO2) THEN
    IF(TRIM(YGRG_NL(JGRG)%cname) =='NOX') IND_NOX=JGRG
    IF (IND_NOX==-1) THEN
      WRITE(NULERR,*) 'GRG_AK_OP: PROBLEM WITH NOX OPERATOR. NOX FIELD NEEDED BUT DOES NOT EXIST.'
      CALL ABOR1('GRG_AK_OP: PROBLEM WITH NOX OPERATOR. NOX FIELD DOES NOT EXIST')
    ENDIF
  ENDIF
ENDDO

INPP=0

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

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

ZPRESO(:,:)=0.0_JPRB
ZLNPRESO(:,:)=0.0_JPRB

ZPRESO(1:ILEN,1:IMXKAK)=PRESO(1:ILEN,1,1:IMXKAK)

CALL PPFLEV(KDLEN,1,ILEN,NFLEVG,IMXKAK,ZPRESO,PRESH5,PRESF5,ILEVB,&
 & LLBELO,LLBELS,LLBLOW,LLBLES)  

!*    1.3 LN(P)

DO JLEVP=1,IMXKAK
  ZLNPRESO(1:ILEN,JLEVP) = LOG(ZPRESO(1:ILEN,JLEVP))
ENDDO
  
!*    2. GRG variables:
!        Interpolate model values to averaging kernel  pressures 
!        and calculate model equivalent of obs as SUM(pgrg*wak)

JGRG=0
DO JGEMS=1,NGEMS
  IF(YDGEMSPROF5(1,JGEMS)%CSPECIES=='GRG') THEN
    JGRG=JGRG+1
    IF(LLGRG(JGRG)) THEN
      IF(INPP+1 > KDPP) CALL ABOR1('PPOBSA: KDPP EXCEEDED, GRG')
      INPP=INPP+1
      ALLOCATE(ZGEMSMODEL5(KDLEN,0:NFLEVG))
      ALLOCATE(ZGEMS_AK5(KDLEN,IMXKAK))
      IF(LLNO2.AND.JGRG==IND_NOX) THEN
        DO JLEN=1,ILEN
          ZGEMSMODEL5(JLEN,0:NFLEVG)= &
           & PNO25(JLEN,0:NFLEVG)
        ENDDO
      ELSE
        DO JLEN=1,ILEN
          ZGEMSMODEL5(JLEN,1:NFLEVG)= &
           & YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1:NFLEVG)
          ZGEMSMODEL5(JLEN,0)=YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1)
        ENDDO
      ENDIF

!Calculate columns above AK pressure levels for GRG profile
      CALL PPPWC(KDLEN,1,ILEN,NFLEVG,IMXKAK,1,ILEVB,&
       & PRESO,ZLNPRESO,LLBELS,LLBLES,&
       & PXP5,PXPD5,ZGEMSMODEL5,&
       & ZGEMS_AK5)  

      PXGEMS(:,:,:)=0.0_JPRB
      DO IAK=1,IMXKAK
        DO JLEN=1,ILEN     ! loop over observations  (header entries)
          IF (IAK == 1) THEN
            ZDP=ZPRESO(JLEN,IAK)
            ZCOL=ZGEMS_AK5(jlen,IAK) 
          ELSE
            ZDP=ZPRESO(JLEN,IAK)-ZPRESO(JLEN,IAK-1)
            ZCOL=ZGEMS_AK5(jlen,IAK)-ZGEMS_AK5(jlen,IAK-1) 
          ENDIF
          PXGEMS(JLEN,1,INPP)=PXGEMS(JLEN,1,INPP) + &
           &    ZCOL*PWAK(JLEN,1,IAK) + &
           &    (1.0_JPRB-PWAK(JLEN,1,IAK))*PAPAK(JLEN,1,IAK) *ZVMR2MMRCO**(ZDP*ZRGI)
        ENDDO
      ENDDO

      DEALLOCATE(ZGEMSMODEL5,ZGEMS_AK5)
    ENDIF
  ENDIF
ENDDO

DEALLOCATE(ILEVB,LLBELO,LLBELS,LLBLOW,LLBLES,ZLNPRESO)

9 CONTINUE
IF (LHOOK) CALL DR_HOOK('GRG_AK_OP',1,ZHOOK_HANDLE)

END SUBROUTINE GRG_AK_OP
