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

!**** GHG_AK_TL - Observation operator for GHG based on grg_ak_tl.F90
!                 Tangent linear version.

!     R. Engelen              ECMWF           08-Jan-2009

!     PURPOSE
!     -------

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

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

!        CALL GHG_AK_TL(KDLEN,KLEN,KDCOUNT,CDPAR,KCOUNT,
!    I                  KAK,PWAK,PRESO,PXP,PXPD,YDGEMSPROF,
!    O                  KDPP,PXGRG, &
!    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)
!       PAPAK   : Prior values for averaging kernels                  (INPUT)
!       PRESO   : Perturb in Output PRESSURES (ak pressures)          (INPUT)
!       PXP     : Perturb in INTERMEDIATE ARRAY                       (INPUT)
!       PXPD    : Perturb in ..................                       (INPUT)
!       YDGEMSPROF: Perturb in GEMS species (GRG) AT MODEL FULL LEVELS (INPUT)
!       KDPP    : Number of fields, dimension of PXPP.
!       PXGEMS  : GEMS layer value                                     (OUTPUT)
!       PRESH5  : HALF LEVEL PRESSURES                                (INPUT)
!       PRESF5  : FULL LEVEL PRESSURES                                (INPUT)
!       PXP5    : INTERMEDIATE ARRAY                                  (INPUT)
!       PXPD5   : ..................                                  (INPUT)
!       YDGEMSPROF5: GEMS species (GRG) AT MODEL FULL LEVELS           (INPUT)

!        GHG_AK_TL IS CALLED FROM HOPTL

!**   METHOD
!     ------

!        CALL TO PPQTL POST-PROCESSING ROUTINE

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

!        PPFLEV  - FIND PRESSURE LEVEL UNDER SPECIFIED PRESSURES
!        PPQTL  - CALCULATE GHG layer value using averaging kernels

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

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

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

USE YOMDIM   , ONLY : NFLEVG   ,NPPM

USE YOM_YGFL , ONLY : NGHG,YGHG_NL
USE YOMCST   , ONLY : RG, RMD, RMCH4
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)    :: PXP(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXPD(KDLEN,0:NFLEVG,NPPM) 
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)  :: YDGEMSPROF(KDLEN,NGEMS)
TYPE (TYPE_GEMSPROF),INTENT(IN)  :: YDGEMSPROF5(KDLEN,NGEMS)

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 :: ZGEMSMODEL(:,:),ZGEMSMODEL5(:,:),ZGEMS_AK(:,:)

REAL(KIND=JPRB) :: ZPRESO_AK(KDLEN,JPMX_AK)

REAL(KIND=JPRB) :: ZXGEMS(KDLEN,KDCOUNT,KDPP) 
REAL(KIND=JPRB) :: ZMMR2VMRCH4, ZRGI, ZDP5, ZDPSUM5
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 "ppqtl.intfb.h"
#include "ppflev.intfb.h"
!     ------------------------------------------------------------------
!*    1.  PREPARATION
!*    1.1 MAX. NO. OF LEVELS/obs

IF (LHOOK) CALL DR_HOOK('GHG_AK_TL',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('GHG_AK_TL: KDPP EXCEEDED, GHG')
      INPP=INPP+1
      ALLOCATE(ZGEMSMODEL(KDLEN,0:NFLEVG))
      ALLOCATE(ZGEMSMODEL5(KDLEN,0:NFLEVG))
      ALLOCATE(ZGEMS_AK(KDLEN,IMXKAK))
      DO JLEN=1,ILEN
        ZGEMSMODEL(JLEN,0)=0.0_JPRB
        ZGEMSMODEL(JLEN,1:NFLEVG)=YDGEMSPROF(JLEN,JGEMS)%MODELPROF(:)*ZMMR2VMRCH4
        ZGEMSMODEL5(JLEN,0)=YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1)*ZMMR2VMRCH4
        ZGEMSMODEL5(JLEN,1:NFLEVG)=YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(:)*ZMMR2VMRCH4
      ENDDO

     CALL PPQTL(KDLEN,1,ILEN,NFLEVG,IMXKAK,1,ILEVB,&
      & PRESO,LLBELS,LLBLES,&
      & PXP,PXPD,ZGEMSMODEL,&
      & ZGEMS_AK,&
      & PXP5,PXPD5,ZGEMSMODEL5) 
       
      ZXGEMS(:,:,:)=0.0_JPRB
      DO JLEN=1,ILEN
        ZDPSUM5=0.0_JPRB
        DO IAK=1,IMXKAK
          IF (IAK == 1) THEN
            ZDP5=ZPRESO_AK(JLEN,IAK)
          ELSE
            ZDP5=ZPRESO_AK(JLEN,IAK)-ZPRESO_AK(JLEN,IAK-1)
          ENDIF
          ZXGEMS(JLEN,1,INPP)=ZXGEMS(JLEN,1,INPP) + &
           &     ZGEMS_AK(JLEN,IAK)*PWAK(JLEN,1,IAK) *(ZDP5*ZRGI)
          ZDPSUM5 = ZDPSUM5 + (ZDP5*ZRGI)
        ENDDO
        PXGEMS(JLEN,1,INPP) = ZXGEMS(JLEN,1,INPP)/ZDPSUM5
      ENDDO
      
      DEALLOCATE(ZGEMS_AK)
      DEALLOCATE(ZGEMSMODEL)
      DEALLOCATE(ZGEMSMODEL5)
    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_TL',1,ZHOOK_HANDLE)

END SUBROUTINE GHG_AK_TL
