SUBROUTINE AOD_AD &
 & ( KDLEN  , KLEN  , KMXCOUNT, & 
 &   PQF, PTF, PPRESH, PPRESF, &
 &   YDGEMSPROF, &  
 &   PQF5, PTF5, PPRESH5, PPRESF5, &
 &   YDGEMSPROF5, &
 &   PAEROD_HAT)

!*** *AOD_AD* Adjoint Operator routine for aerosol optical depth observations.

!**   INTERFACE.
!     ----------
!          *AOD_AD* IS CALLED FROM *HOPAD*.
!     CALL AOD_AD(KDLEN,ILEN,IMXCOUNT,ZQF, ZTF, ZPRESH, ZPRESF, YDGEMSPROF,
!                  ZQF5, ZTF5, ZPRESH5, ZPRESF5, ZLS5, ZAERF5, ZXPP)
!     WHERE KDLEN      = First dimension: Max number of observations, this set (INPUT)
!           KLEN       = Number of aerosol optical depth obs (INPUT)
!           IMXCOUNT   = Number of channels (INPUT)
!           ZQF       =  Perturb in specific humidity at observation points, model levels (INPUT)
!           ZTF       =  Perturb in temperature at observation points, model levels (INPUT)
!           ZPRESH,ZPRESF = Perturb in Half/Full level pressure values at obs points, model levels (INPUT)
!           YDGEMSPROF  =  GEMS arrays containing perturb in aerosol mixing ratios (INOUT)
!           ZQF5       =  Specific humidity at observation points, model levels (INPUT)
!           ZTF5       =  Temperature at observation points, model levels (INPUT)
!           ZPRESH5,ZPRESF5 =   Half/Full level pressure values at obs points, model levels (INPUT)
!           YDGEMSPROF5     = GEMS arrays containing aerosol mixing ratios (INPUT)

!           ZXPP       = Aerosol optical depth at different wavelengths (OUTPUT)



!**   AUTHOR.
!     -------
!        ANGELA BENEDETTI        *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 2005-06-17

!     PURPOSE.
!     --------
!     - derive adjoint aerosol optical thickness from profiles of mass mixing ratio 

! Optical properties in su_aerop.F90 avaliable at following wavelenghts
! (340)355(380)400 440 469 500 532 550 645 670 800 858 865(1020)1064 1240 1640 2130
! corresponding IWAVL
!   1   2   3   4   5   6   7   8   9  10   11  12  13  14  15  16   17    18   19
!                      ---         ---     ---         ---           ---- ---- ---- MODIS
!              ***                             ***                                  SEVIRI
!  ---     ---     xxx     ---             xxx         xxx xxxx                     AERONET
!      000                     000                               000                EARLINET/CALIPSO
!

!     'MODIS Channels' (channels from other instruments can be added)
!      -         470 nm, 550 nm, 660 nm, 870 nm, 1240 nm, 1630 nm, 2130 nm
! Corresponding IWAVL
!      IWAVL = [ 6, 9, 11, 14, 17, 18, 19]
! **** DEPENDS ON J.-J.'s choice of numbering in su_aerop.F90 !!!!!! CHECK PERIODICALLY !!!
!-----------------------------------------------------------------------

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

USE YOM_YGFL , ONLY : NAERO, NACTAERO, JPAERO
USE YOMDIM, ONLY : NFLEVG
USE YOMDB
USE YOMCST    ,ONLY : RG
USE YOMLUN    ,ONLY : NULERR
USE YOEAEROP  ,ONLY : ALF_SU, ALF_OM, ALF_DD, ALF_SS, ALF_BC
USE YOEAERSNK ,ONLY : RRHTAB
USE YOEAERSRC ,ONLY : NMAXTAER, NTYPAER, NTYP, NBIN

USE TYPE_GEMS_PROFILES

IMPLICIT NONE

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

!*       0.1   ARGUMENTS
!              ---------

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN, KLEN, KMXCOUNT

REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESH5(KDLEN,0:NFLEVG) ! PRESSURE ON HALF LEVELS FROM TRAJ
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESF5(KDLEN,NFLEVG)   ! PRESSURE ON FULL LEVELS FROM TRAJ
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(KDLEN,0:NFLEVG)    ! temperature FROM TRAJ
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQF5(KDLEN,0:NFLEVG)    ! specific humidity FROM TRAJ

REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPRESH(KDLEN,0:NFLEVG) ! perturbation on PRESSURE ON HALF LEVELS
REAL(KIND=JPRB)   ,INTENT(IN) :: PPRESF(KDLEN,NFLEVG) !  " "    PRESSURE ON FULL LEVELS
REAL(KIND=JPRB)   ,INTENT(IN) :: PTF(KDLEN,NFLEVG)    !  " "    temperature
REAL(KIND=JPRB)   ,INTENT(IN) :: PQF(KDLEN,NFLEVG)    !  " "    specific humidity

TYPE (TYPE_GEMSPROF)   ,INTENT(IN) :: YDGEMSPROF5(KDLEN,NGEMS)
TYPE (TYPE_GEMSPROF)   ,INTENT(INOUT) :: YDGEMSPROF(KDLEN,NGEMS)

REAL(KIND=JPRB), INTENT(INOUT) :: PAEROD_HAT(KDLEN,KMXCOUNT) ! AEROSOL OPT DEPTH GRADIENT 

!*       0.5   LOCAL VARIABLES
!              ---------------
!INTEGER(KIND=JPIM), PARAMETER :: IWAVLMX=7 ! Max number of MODIS channels
!INTEGER(KIND=JPIM), DIMENSION(IWAVLMX) :: IWAVL=(/6, 9, 11, 14, 17, 18, 19/) ! Index for MODIS channels
INTEGER(KIND=JPIM) :: IACTAEROP ! Number of optically active aerosol species (NACTAERO-1, for now)
INTEGER(KIND=JPIM) :: IAER, ITYP, IBIN, ISUM, IWAVLINDEX
INTEGER(KIND=JPIM) :: JAER, JK, JL, JJ, JF, JP, JLEN, JLEV, JTAB
INTEGER(KIND=JPIM) :: IFLAG 
INTEGER(KIND=JPIM), PARAMETER  :: JTABMX=12
INTEGER(KIND=JPIM), ALLOCATABLE :: ITYPE(:) !index to determine optically active aerosol species
INTEGER(KIND=JPIM), DIMENSION(KLEN,NFLEVG) :: IRH

REAL(KIND=JPRB), DIMENSION(KLEN,NFLEVG)   :: ZQSAT5, ZT5, ZPF5
REAL(KIND=JPRB), DIMENSION(KLEN,NFLEVG)   :: ZT, ZPF

REAL(KIND=JPRB), ALLOCATABLE   :: ZAERTAU5(:,:)
REAL(KIND=JPRB), ALLOCATABLE   :: ZAERTAU(:,:)
REAL(KIND=JPRB), ALLOCATABLE   :: ZAERF5(:,:,:) ! aer mixing ratios from traj (interpolated to obs locations)
REAL(KIND=JPRB), ALLOCATABLE   :: ZAERF(:,:,:) ! pert aer mixing ratios from traj (interpolated to obs locations)

REAL(KIND=JPRB), DIMENSION(KLEN,NFLEVG) :: ZAERFT5 !
REAL(KIND=JPRB), DIMENSION(KLEN,NFLEVG) :: ZAERTMR5 ! total aer mixing ratios from traj
REAL(KIND=JPRB), DIMENSION(KLEN,NFLEVG) :: ZAERTMR ! total aer mixing ratios pert 

REAL(KIND=JPRB), ALLOCATABLE :: ZFRACAER5(:,:,:) ! fraction of mixing ratios wrt total mass

REAL(KIND=JPRB), DIMENSION(KDLEN,KMXCOUNT) :: ZAEROD5 ! aer optical depth
REAL(KIND=JPRB), ALLOCATABLE :: ZALF5(:)
REAL(KIND=JPRB)   :: ZRHCL5, ZAEREXT5
REAL(KIND=JPRB), DIMENSION(KLEN,NFLEVG):: ZDP5 ! pressure difference from trajectory
REAL(KIND=JPRB)   :: ZAEREXT, ZDP

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "satur.intfb.h"
#include "abor1.intfb.h"
!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('AOD_AD',0,ZHOOK_HANDLE)

! Check that total number of aerosol bins is not larger than NACTAERO
ISUM=0
DO IAER=1,NMAXTAER
  ISUM=ISUM+NTYPAER(IAER)
ENDDO
IF (ISUM > NACTAERO) THEN
  CALL ABOR1('AOD_AD:TOTAL NUMBER OF REQUESTED BINS PER TYPE EXCEEDS NACTAERO')
ENDIF



IACTAEROP=NACTAERO-1 ! Number of optically active aerosol species

ALLOCATE(ZAERF5(KLEN,NFLEVG,IACTAEROP))
ALLOCATE(ZAERF(KLEN,NFLEVG,IACTAEROP))
ALLOCATE(ITYPE(IACTAEROP))
ALLOCATE(ZAERTAU(KLEN,IACTAEROP))
ALLOCATE(ZAERTAU5(KLEN,IACTAEROP))
ALLOCATE(ZFRACAER5(KLEN,NFLEVG,IACTAEROP))
ALLOCATE(ZALF5(IACTAEROP))

ZAERF5(:,:,:)=0.0_JPRB
ZAERF(:,:,:)=0.0_JPRB
ITYPE(:)=0

! Extract aerosol mixing ratios from GEMS profiles structure
IF(NAERO > 0) THEN
  DO JLEN=1,KLEN
    IAER=0
    DO JF=1,NGEMS
      JP=0
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210001 .OR.  &
       &   YDGEMSPROF5(JLEN,JF)%IGRIB == 210002 .OR.  &
       &   YDGEMSPROF5(JLEN,JF)%IGRIB == 210003) JP=1 !SS 3 bins
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210004 .OR.  &
       &   YDGEMSPROF5(JLEN,JF)%IGRIB == 210005 .OR.  &
       &   YDGEMSPROF5(JLEN,JF)%IGRIB == 210006 ) JP=2 !DD 3 bins
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210007 .OR. & 
       &   YDGEMSPROF5(JLEN,JF)%IGRIB == 210008) JP=3 ! ORGANIC MATTER - 2 bins
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210009 .OR. &
       &   YDGEMSPROF5(JLEN,JF)%IGRIB == 210010) JP=4 ! Black Carbon - 2 bins
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210011) JP=5 ! SO4
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210013) JP=7 ! Stratospheric background

      IF(JP > 0) THEN
        IAER=IAER+1
        ZAERF5(JLEN,:,IAER)=YDGEMSPROF5(JLEN,JF)%MODELPROF(:)
        ITYPE(IAER)=JP
        IF(IAER > JPAERO) THEN
          CALL ABOR1('AOD_AD: NOT ENOUGH AEROSOL SPECIES ALLOCATED')
        ENDIF
      ENDIF
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210048) THEN ! Total aerosol mixing ratio
        ZAERTMR5(JLEN,:)=YDGEMSPROF5(JLEN,JF)%MODELPROF(:)
      ENDIF
    ENDDO
 ENDDO
ENDIF

! Compute total mixing ratio by summing single contributions
    ZAERFT5(:,:) = 0.0_JPRB
    DO JAER=1,IACTAEROP
      ZAERFT5(:,:)=ZAERFT5(:,:)+ ZAERF5(:,:,JAER)
    ENDDO

! BEN the perturbations on the various species are computed from the perturbation
! on the total mass mixing ratio using the mass fraction assumed constant

ZFRACAER5(:,:,:) = 0.0_JPRB
DO JLEN=1,KLEN
  DO JAER=1,IACTAEROP
    DO JLEV=1,NFLEVG
      IF(ZAERFT5(JLEN,JLEV) /= 0.0_JPRB) THEN
        ZFRACAER5(JLEN,JLEV,JAER) = ZAERF5(JLEN,JLEV,JAER)/ZAERFT5(JLEN,JLEV)
      ENDIF
    ENDDO
  ENDDO
ENDDO

!! Compute fraction of given species (and bin) wrt total mass mixing ratio

!DO JLEN=1,KLEN
!  DO JAER=1,IACTAEROP
!    DO JLEV=1,NFLEVG
!      IF(ZAERTMR5(JLEN,JLEV) /= 0.0_JPRB) THEN
!	ZFRACAER5(JLEN,JLEV,JAER) = ZAERF5(JLEN,JLEV,JAER)/ZAERTMR5(JLEN,JLEV)
!      ELSE
!	ZFRACAER5(JLEN,JLEV,JAER) = 0.0_JPRB
!      ENDIF
!    ENDDO
!  ENDDO
!ENDDO

! Compute relative humidity at observation points, on model levels
ZT5(1:KLEN,:) = PTF5(1:KLEN,1:NFLEVG) ! trajectory
ZPF5(1:KLEN,:)= PPRESF5(1:KLEN,:)     ! trajectory
ZT(1:KLEN,:) = 0.0_JPRB       ! perturb
ZPF(1:KLEN,:)= 0.0_JPRB       ! perturb
!CALL SATURAD (1 , KLEN , KLEN  , 1 , NFLEVG,&
!  & ZPF5, ZT5 , ZQSAT5, &
!  & ZPF,  ZT ,  ZQSAT)

IFLAG=2
CALL SATUR (1 , KLEN , KLEN  , 1 , NFLEVG,&
  & ZPF5, ZT5 , ZQSAT5 , IFLAG)


!PPRESF(1:KLEN,:)=PPRESF(1:KLEN,:)+ZPF(1:KLEN,:)     ! perturb in pressure - do not include
!PTF(1:KLEN,:)= PTF(1:KLEN,:) + ZT(1:KLEN,:)         ! perturb in temperature - do not include 
!ZT(1:KLEN,:) = 0.0_JPRB       
!ZPF(1:KLEN,:)= 0.0_JPRB   

!-- define RH index from "clear-sky" relative humidity
IRH(:,:)=1
DO JK=1,NFLEVG
  DO JL=1,KLEN
    ZRHCL5=(PQF5(JL,JK)/ZQSAT5(JL,JK))*100._JPRB
    DO JTAB=1,JTABMX
      IF (ZRHCL5 > RRHTAB(JTAB)) THEN
        IRH(JL,JK)=JTAB
      ENDIF
    ENDDO
! Save the pressure difference from trajectory 
    ZDP5(JL,JK)=PPRESH5(JL,JK)-PPRESH5(JL,JK-1)
  ENDDO
ENDDO

    IF(KMXCOUNT ==1) IWAVLINDEX=9   ! 550nm

 ZAEROD5(:,:)=0.0_JPRB
! Trajectory computations
 DO JJ=1,KMXCOUNT

!   IWAVLINDEX is the wavelength index: for now the choice of channels is tailored to MODIS optical
!         depth retrievals (Remer et al. 2005 and Benedetti et al, 2009, ECMWF Tech. Memo 571).
!
!      IWAVLINDEX=IWAVL(JJ)

  DO JL=1,KLEN
   DO JAER=1,IACTAEROP

      ZAERTAU5(JL,JAER)= 0.0_JPRB

      ITYP=NTYP(JAER)
      IBIN=NBIN(JAER)
      IF(ITYP /= 0 .AND. IBIN == 0) THEN
       WRITE(NULERR,*) 'AT LEAST ONE BIN NEEDS TO BE ALLOCATED FOR TYPE ', ITYP,'!'
       WRITE(NULERR,*) 'PROGRAM WILL STOP'
       CALL ABOR1('') 
      ENDIF
     IF(ITYP /= ITYPE(JAER)) THEN
      WRITE(NULERR,*)'AOD_AD: AEROSOL TYPE IS NOT MATCHING', ITYP
      WRITE(NULERR,*) 'PROGRAM WILL STOP'
      CALL ABOR1('')
     ENDIF


      DO JK=1,NFLEVG
      
         IF (ITYP == 1) THEN
          ZALF5(JAER)=ALF_SS(IRH(JL,JK),IWAVLINDEX,IBIN)
         ELSEIF (ITYP == 2) THEN
          ZALF5(JAER)=ALF_DD(IBIN,IWAVLINDEX)
         ELSEIF (ITYP == 3) THEN
          ZALF5(JAER)=ALF_OM(IRH(JL,JK),IWAVLINDEX)
         ELSEIF (ITYP == 4 .OR. ITYP == 6) THEN
          ZALF5(JAER)=ALF_BC(IWAVLINDEX)
         ELSEIF (ITYP == 5 .OR. ITYP == 7 .OR. ITYP == 8 .OR. ITYP == 9) THEN
          ZALF5(JAER)=ALF_SU(IRH(JL,JK),IWAVLINDEX)
         ENDIF

! convert units from m^2/g to m^2/kg
         ZALF5(JAER)=ZALF5(JAER)*1000._JPRB

         ZAEREXT5=ZAERF5(JL,JK,JAER)*ZALF5(JAER)
         ZAERTAU5(JL,JAER)  =ZAERTAU5(JL,JAER)+ZAEREXT5 * (ZDP5(JL,JK)/RG)
 
     ENDDO  ! loop over vertical levels
      ZAEROD5(JL,JJ)=ZAEROD5(JL,JJ)+ZAERTAU5(JL,JAER)
    ENDDO ! loop over aerosol type
   ENDDO ! loop over horizontal observational points
 ENDDO ! loop over MODIS channels

! Security check for negative optical depths (adjoint)
   DO  JJ = 1,KMXCOUNT
    DO JL=1, KLEN
     IF(ZAEROD5(JL,JJ) < 0.0_JPRB) THEN
      PAEROD_HAT(JL,JJ)= 0.0_JPRB
     ENDIF
    ENDDO
   ENDDO

!---------------------------------------------------------
! Adjoint calculations
!---------------------------------------------------------
DO JJ=1,KMXCOUNT

!   IWAVLINDEX is the wavelength index: for now the choice of channels is tailored to MODIS optical
!         depth retrievals (Remer et al. 2005 and Benedetti et al, 2009, ECMWF Tech. Memo 571)
!
!      IWAVLINDEX=IWAVL(JJ)

  DO JL=1,KLEN
    DO JAER=IACTAEROP,1,-1

! Initialize local variables
      ZDP     = 0.0_JPRB
      ZAEREXT = 0.0_JPRB
      ZAERTAU(JL,JAER)=0.0_JPRB

      ZAERTAU(JL,JAER)= ZAERTAU(JL,JAER)+ PAEROD_HAT(JL,JJ)

!-- ITYP is the aerosol type 1:SeaSalt,   2:DesertDust,   3:OrganicMatter, 4: BlackCarbon,
!                            7:Strat background
!   IBIN is the bin index: 1-3:SS, 1-3:DD, 1-2:OM, 1-2:BC, 1:STRAT BACKGROUND

      ITYP=NTYP(JAER)
      IBIN=NBIN(JAER)
      IF(ITYP /= 0 .AND. IBIN == 0) THEN
        WRITE(NULERR,*) 'AT LEAST ONE BIN NEEDS TO BE ALLOCATED FOR TYPE ', ITYP,'!'
        WRITE(NULERR,*) 'PROGRAM WILL STOP'
        CALL ABOR1('') 
      ENDIF
      IF(ITYP /= ITYPE(JAER)) THEN
       WRITE(NULERR,*)'AOD_AD: AEROSOL TYPE IS NOT MATCHING', ITYP
       WRITE(NULERR,*) 'PROGRAM WILL STOP'
       CALL ABOR1('')
      ENDIF

      DO JK=NFLEVG,1,-1
      
         IF (ITYP == 1) THEN
          ZALF5(JAER)=ALF_SS(IRH(JL,JK),IWAVLINDEX,IBIN)
         ELSEIF (ITYP == 2) THEN
          ZALF5(JAER)=ALF_DD(IBIN,IWAVLINDEX)
         ELSEIF (ITYP == 3) THEN
          ZALF5(JAER)=ALF_OM(IRH(JL,JK),IWAVLINDEX)
         ELSEIF (ITYP == 4 .OR. ITYP == 6) THEN
          ZALF5(JAER)=ALF_BC(IWAVLINDEX)
         ELSEIF (ITYP == 5 .OR. ITYP == 7 .OR. ITYP == 8 .OR. ITYP == 9) THEN
          ZALF5(JAER)=ALF_SU(IRH(JL,JK),IWAVLINDEX)
         ENDIF

! convert units from m^2/g to m^2/kg
            ZALF5(JAER)=ZALF5(JAER)*1000._JPRB

            ZAEREXT5=ZAERF5(JL,JK,JAER)*ZALF5(JAER)
 
            ZAEREXT= ZAEREXT + (ZDP5(JL,JK)/RG)* ZAERTAU(JL,JAER)
            ZDP    = ZDP + ZAEREXT5/RG * ZAERTAU (JL,JAER)  
! For now set ZDP to zero here and avoid increments in surface pressure
!         ZDP= 0.0_JPRB
   
            ZAERF(JL,JK,JAER) = ZAERF(JL,JK,JAER) + ZALF5(JAER)* ZAEREXT
            ZAEREXT= 0.0_JPRB

            PPRESH(JL,JK)   = PPRESH(JL,JK)  + ZDP
            PPRESH(JL,JK-1) = PPRESH(JL,JK-1)- ZDP
            ZDP =0.0_JPRB
  
      ENDDO  ! loop over vertical levels
      ZAERTAU(JL,JAER)=0.0_JPRB 
    ENDDO
    PAEROD_HAT(JL,JJ)=0.0_JPRB
  ENDDO
ENDDO

!! BEN the gradient of the total mass mixing ratio are computed from the gradient of
!  the various species using the mass fraction assumed constant 

ZAERTMR(:,:)=0.0_JPRB
DO JLEN=1,KLEN
  DO JAER=IACTAEROP,1,-1
    ZAERTMR(JLEN,:) = ZAERTMR(JLEN,:) + ZAERF(JLEN,:,JAER)* ZFRACAER5(JLEN,:,JAER)
    ZAERF(JLEN,:,JAER)=0.0_JPRB
  ENDDO
ENDDO
! Put back gradient of cost function with respect to total aerosol mixing ratio
IF(NAERO > 0) THEN
  DO JLEN=1,KLEN
    DO JF=1,NGEMS
      IF(YDGEMSPROF5(JLEN,JF)%IGRIB == 210048) THEN 
        YDGEMSPROF(JLEN,JF)%MODELPROF(:) = YDGEMSPROF(JLEN,JF)%MODELPROF(:) + ZAERTMR(JLEN,:)
        ZAERTMR(JLEN,:)=0.0_JPRB
      ENDIF
    ENDDO
  ENDDO
ENDIF

DEALLOCATE(ZAERF5)
DEALLOCATE(ZAERF)
DEALLOCATE(ITYPE)
DEALLOCATE(ZAERTAU)
DEALLOCATE(ZAERTAU5)
DEALLOCATE(ZFRACAER5)
DEALLOCATE(ZALF5)
!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('AOD_AD',1,ZHOOK_HANDLE)
END SUBROUTINE AOD_AD
