SUBROUTINE GRG_AK_AD(KDLEN,KLEN,KDCOUNT,CDPAR,KCOUNT,&
 & KAK,PWAK,PRESO,PXP,PXPD,YDGEMSPROF,&
 & KDPP,PXGEMS,&
 & PRESH5,PRESF5,PXP5,PXPD5,YDGEMSPROF5,PNO2,PNO25)  

!**** GRG_AK_AD - Adjoint of Observation operator for GRG

!     A. Dethof              ECMWF           22-Feb-06

!     PURPOSE
!     -------

!        FIND OUT A GRADIENT WITH RESPECT TO POST-PROCESSED VALUES.

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

!        CALL GRG_AK_AD(KDLEN,KLEN,KDCOUNT,CDPAR,KOBSTYPE,KCOUNT,
!    I                  KAK,PWAK,PRESO,PXP,PXPD,YDGEMSPROF,
!    O                  KDPP,PXGEMS,
!    R                  PRESH5,PRESF5,PXP5,PXPD5,YDGEMSPROF5,PNO2,PNO25)
!     WHERE KDLEN   : FIRST DIMENSION (Observations)            (INPUT)
!           KLEN    : ACTUAL NUMBER OF OBSERVATIONS             (INPUT)
!           KDCOUNT : SECOND DIMENSION (Data)                   (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)
!           PRESO   : Output PRESSURES (ak pressures)           (INPUT)
!           PXP     : GRADIENT WITH RESPECT TO PXP5             (INOUT)
!           PXPD    : ..................                        (INOUT)
!           YDGEMSPROF: GRADIENT WITH RESPECT TO YDGEMSPROF5      (INOUT)
!           KDPP    : Number of fields, dimension of PXPP
!           PXGEMS   : GRG layer value                           (INOUT)
!           PRESH5  : HALF LEVEL PRESSURES                      (INPUT)
!           PRESF5  : FULL LEVEL PRESSURES                      (INPUT)
!           PXP5    : INTERMEDIATE ARRAY                        (INPUT)
!           PXPD5   : ..................                        (INPUT)
!           YDGEMSPROF5: GEMS array containing GRG mixing ratios (INPUT)
!           PNO2    : Perturb in NO2 (optional)                 (INOUT)
!           PNO25   : NO2 (optional)                            (INPUT)


!        GRG_AK_AD IS CALLED FROM HOPAD

!**   METHOD
!     ------

!        CALL TO PPPWCAD POST-PROCESSING ROUTINE

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

!        PPFLEV  - FIND PRESSURE LEVEL UNDER SPECIFIED PRESSURES
!        PPPWCAD - Calculate columns above model levels

!**   AUTHOR  
!     ------
!     A.Dethof    22-Feb-2006: Adjoint of 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 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)    :: PRESO(KDLEN,KDCOUNT,JPMX_AK) 
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PXP(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PXPD(KDLEN,0:NFLEVG,NPPM) 
TYPE (TYPE_GEMSPROF),INTENT(INOUT) :: YDGEMSPROF(KDLEN,NGEMS)
INTEGER(KIND=JPIM),INTENT(IN)    :: KDPP
REAL(KIND=JPRB)   ,INTENT(INOUT)   :: PXGEMS(KDLEN,KDCOUNT,KDPP) 
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)
REAL(KIND=JPRB)   ,INTENT(INOUT), OPTIONAL:: PNO2(KDLEN,0:NFLEVG)
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 :: ZGEMSMODEL(:,:),ZGEMSMODEL5(:,:),ZGEMS_AK(:,:)
REAL(KIND=JPRB):: ZPRESO(KDLEN,JPMX_AK),ZCOL(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) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('GRG_AK_AD',0,ZHOOK_HANDLE)
ILEN   = KLEN
IMXCNT = MAXVAL(KCOUNT(1:ILEN))
IF(IMXCNT == 0) GOTO 9
IF(IMXCNT > 1) THEN
  WRITE(NULERR,*) 'GRG_AK_AD: ROUTINE DOES NOT WORK FOR IMXCNT>1. IMXCNT=',IMXCNT
  CALL ABOR1('GRG_AK_AD: 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_AD: PROBLEM WITH NOX OPERATOR. NOX FIELD NEEDED BUT DOES NOT EXIST.'
      CALL ABOR1('GRG_AK_AD: PROBLEM WITH NOX OPERATOR. NOX FIELD DOES NOT EXIST')
    ENDIF
  ENDIF
ENDDO

INPP=0

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

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

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

!  ZPRESO_AK(:,:)=PRESO(:,ICOUNT,:)
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('PPOBSAAD: KDPP EXCEEDED, GRG')
      INPP=INPP+1

      ALLOCATE(ZGEMSMODEL(KDLEN,0:NFLEVG))
      ALLOCATE(ZGEMSMODEL5(KDLEN,0:NFLEVG))
      ALLOCATE(ZGEMS_AK(KDLEN,IMXKAK))
      IF(LLNO2.AND.JGRG==IND_NOX) THEN
        DO JLEN=1,ILEN
          ZGEMSMODEL(JLEN,:)=0.0_JPRB
          ZGEMSMODEL5(JLEN,0:NFLEVG)= PNO25(JLEN,0:NFLEVG)
        ENDDO
      ELSE
        DO JLEN=1,ILEN
          ZGEMSMODEL(JLEN,:)=0.0_JPRB
          ZGEMSMODEL5(JLEN,0)= &
           & YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1)
          ZGEMSMODEL5(JLEN,1:NFLEVG)= &
           & YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(:)
        ENDDO
      ENDIF

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

      CALL PPPWCAD(KDLEN,1,ILEN,NFLEVG,IMXKAK,1,ILEVB,&
       & PRESO,ZLNPRESO,LLBELS,LLBLES,&
       & PXP,PXPD,ZGEMSMODEL,&
       & ZGEMS_AK,&
       & PXP5,PXPD5,ZGEMSMODEL5)  

      IF(LLNO2.AND.JGRG==IND_NOX) THEN
        DO JLEN=1,ILEN
          PNO2(JLEN,1:NFLEVG)=&
          & PNO2(JLEN,1:NFLEVG)+ZGEMSMODEL(JLEN,1:NFLEVG)
        ENDDO
      ELSE
        DO JLEN=1,ILEN
          YDGEMSPROF(JLEN,JGEMS)%MODELPROF(1:NFLEVG)=&
          & YDGEMSPROF(JLEN,JGEMS)%MODELPROF(1:NFLEVG)+ZGEMSMODEL(JLEN,1:NFLEVG)
        ENDDO
      ENDIF

      DEALLOCATE(ZGEMSMODEL,ZGEMSMODEL5,ZGEMS_AK)
    ENDIF
  ENDIF
ENDDO

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

9 CONTINUE
IF (LHOOK) CALL DR_HOOK('GRG_AK_AD',1,ZHOOK_HANDLE)
END SUBROUTINE GRG_AK_AD
