  SUBROUTINE AER_REFL_AD( KDLEN  , KLEN  , KMXCOUNT, &
 &   PQF, PTF, PPRESH, PPRESF, &
 &   YDGEMSPROF, &
 &   PQF5, PTF5, PPRESH5, PPRESF5, &
 &   YDGEMSPROF5, &
 &   PSOLANG5, PVIEANG5, PDIFFANG5, & 
 &   PAERREFL) 

!**** AER_REFL_AD *** ADJOINT OF OBSERVATION OPERATOR FOR AEROSOL REFLECTANCE

!     INTERFACE
!     ---------
!           MAIN CALLING ROUTINE THAT COMPUTES AEROSOL OPTICAL PROPERTIES AND CALLS 6S (RT6S_GEMS_AD)

!          *AER_REFL_AD* IS CALLED FROM *HOPAD*.

!     CALL AER_REFL_AD(KDLEN,ILEN,IMXCOUNT,ZQF5, ZTF5, ZPRESH5, ZPRESF5, ZGEMSPROF5, 
!                   &  ZDIFFANG5, ZSOLANG5, ZVIEANG5, & 
!                   &  ZQF, ZTF, ZPRESH, ZPRESF, ZGEMSPROF, ZXPP )
!     WHERE KDLEN      = First dimension: Max number of observations, this set (INPUT)
!           KLEN       = Number of aerosol reflectance obs (INPUT)
!           IMXCOUNT   = Number of channels (INPUT)
!           ZQF       =  Grad in Specific humidity at observation points, model levels (INPUT)
!           ZTF       =  Grad in Temperature at observation points, model levels (INPUT)
!           ZPRESH,ZPRESF =  Grad in  Half/Full level pressure values at obs points, model levels (INPUT)
!           ZGEMSPROF = Grad in GEMS variables (INPUT)
!           ZQF5       =  Traj. Specific humidity at observation points, model levels (INPUT)
!           ZTF5       =  Traj. Temperature at observation points, model levels (INPUT)
!           ZPRESH5,ZPRESF5 = Traj.   Half/Full level pressure values at obs points, model levels (INPUT)
!           ZGEMSPROF5 = Traj. GEMS variables (INPUT)
!           ZSOLANG5  = Traj. SOLAR ZENITH ANGLE (INPUT) - degrees
!           ZVIEANG5  = Traj. VIEWING ZENTIH ANGLE (INOUT) - degrees
!           ZDIFFANG5 = Traj. difference in azimuthal angle (radiants) (viewing minus solar azimuthal angle).
!           ZXPP     = Aerosol reflectance at different wavelengths (OUTPUT)


!     EXTERNALS
!     ---------
!           AER_OPT_PROP_AD - adjoint of routine that computes and returns the aerosol optical 
!                             properties (extinction, single scattering albedo and asymmetry parameter)
!           RT6S_GEMS_AD     - adjoint of routine that performs radiative transfer calculations. 
!                             For now, this is tuned to the MODIS instrument but it can be made more general.   


!     AUTHOR 
!     -------------
!          A.BENEDETTI - ECMWF 12.08.2008

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

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

USE YOMDIM, ONLY : NFLEVG
USE YOMLUN   , ONLY : NULOUT

USE RT6SVALUES

USE TYPE_GEMS_PROFILES

IMPLICIT NONE 

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN, KLEN  !NUMBER OF OBS POINTS
INTEGER(KIND=JPIM),INTENT(IN)    :: KMXCOUNT     !NUMBER OF CHANNELS (WAVELENGTHS) 

REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PPRESH(KDLEN,0:NFLEVG) ! PRESSURE ON HALF LEVELS PERTURBATION/GRAD
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PPRESF(KDLEN,NFLEVG)   ! PRESSURE ON FULL LEVELS PERTURBATION/GRAD
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PTF(KDLEN,0:NFLEVG)    ! temperature PERTURBATION/GRAD
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PQF(KDLEN,0:NFLEVG)    ! specific humidity PERTURBATION/GRAD

TYPE (TYPE_GEMSPROF)   ,INTENT(INOUT) :: YDGEMSPROF(KDLEN,NGEMS) ! GEMS VARIABLE PERTURBATION/GRAD

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

TYPE (TYPE_GEMSPROF)   ,INTENT(IN) :: YDGEMSPROF5(KDLEN,NGEMS) ! GEMS VARIABLES FROM TRAJ

REAL(KIND=JPRB), INTENT(IN) :: PDIFFANG5(KDLEN), PSOLANG5(KDLEN), PVIEANG5(KDLEN)

REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAERREFL(KDLEN,KMXCOUNT) ! AEROSOL REFLECTANCE PERTURBATION/GRAD
                                                           !(FUNCTION OF HORIZONTAL POSITION AND CHANNEL #)

! LOCAL VARIABLES 
! Main driver

INTEGER(KIND=JPIM) :: JJ ! Max number of MODIS channels
INTEGER(KIND=JPIM), PARAMETER :: IWAVLMX=7 ! Max number of MODIS channels
REAL(KIND=JPRB), DIMENSION(IWAVLMX) :: ZWAVL=(/0.469e-06, .550e-06, 0.167e-06, 0.865e-06,  &
     &                                         1.240e-06, 1.640e-06, 2.130e-06 /) ! MODIS wavelengths

REAL(KIND=JPRB) :: ZAUX, ZAUX5


! For AER_OPT_PROP_AD 

REAL(KIND=JPRB) :: ZAEREXT5(KDLEN,NFLEVG,KMXCOUNT), ZAEROM5(KDLEN,NFLEVG,KMXCOUNT), & 
     &             ZAERASY5(KDLEN,NFLEVG,KMXCOUNT)  ! Trajectory

REAL(KIND=JPRB) :: ZAEREXT(KDLEN,NFLEVG,KMXCOUNT), ZAEROM(KDLEN,NFLEVG,KMXCOUNT), &
     &             ZAERASY(KDLEN,NFLEVG,KMXCOUNT)   ! Gradients 

! For RT6S_GEMS 

INTEGER(KIND=JPIM) :: JLEV, JMU, JLEN
! THESE VALUES ARE NOW IN A MODULE (rt6svalues)
!!!!!!!!!!!!!!!!!!!!!! REMEMBER KLON and KWL must always be equal to 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!INTEGER(KIND=JPIM),PARAMETER :: KLON=1, KWL=1, KLEV=60, KNT=26
!INTEGER(KIND=JPIM),PARAMETER :: KMU=25, KMU2=48, KNP=49, KNANG=80, KNBMU=83

! Trajectory
REAL(KIND=JPRB) :: ZPROC5(KLON,KWL)           ! Auxiliary surface reflectance
REAL(KIND=JPRB) :: ZWL5(KWL)                  ! Channel wavelength
REAL(KIND=JPRB) :: ZZDIFFANG5(KLON), ZZSOLANG5(KLON), ZZVIEANG5(KLON) ! Satellite and solar viewing angles
REAL(KIND=JPRB) :: ZTRAY550_VERTIN5(KLON,0:KLEV),ZTAER_VERTIN5(KLON,0:KLEV,KWL)
REAL(KIND=JPRB) :: ZPHASEL_IN5(KLON,0:KLEV,KWL,KNBMU),ZPIZ_IN5(KLON,0:KLEV,KWL)
REAL(KIND=JPRB) :: ZREFLET5(KLON,KWL)

! Gradients 
REAL(KIND=JPRB) :: ZTAER_VERTIN(KLON,0:KLEV,KWL)
REAL(KIND=JPRB) :: ZPHASEL_IN(KLON,0:KLEV,KWL,KNBMU),ZPIZ_IN(KLON,0:KLEV,KWL)
REAL(KIND=JPRB) :: ZREFLET(KLON,KWL)

REAL(KIND=JPRB) :: ZHEYGR, ZHEYGR5, ZSTEP, ZANGLE(KNBMU)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "aer_opt_prop.intfb.h"
#include "aer_opt_prop_ad.intfb.h"
#include "rt6s_gems_ad.intfb.h"

!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('AER_REFL_AD',0,ZHOOK_HANDLE)

!********************************************************************************************************
! TRAJECTORY CALCULATIONS
!********************************************************************************************************

! Call aerosol optical depth routine
        CALL AER_OPT_PROP( KDLEN  , KLEN  , KMXCOUNT, &
 &   PQF5, PTF5, PPRESH5, PPRESF5, &
 &   YDGEMSPROF5, &
 &   ZAEREXT5,ZAEROM5, ZAERASY5 )

!*************************************************************************************************
! ADJOINT CALCULATIONS
!*************************************************************************************************

ZAEREXT(:,:,:) = 0.0_JPRB
ZAEROM(:,:,:) = 0.0_JPRB
ZAERASY(:,:,:) = 0.0_JPRB


DO JJ=KMXCOUNT,1,-1

   ZWL5(1)=ZWAVL(JJ) ! Select JJ=2 for 550 nm is used

 DO JLEN =KDLEN,1,-1 ! loop on number of observations 

! Initialize adjoint variables to zero
   ZREFLET(:,:) = 0.0_JPRB
   ZPHASEL_IN (:,:,:,:) = 0.0_JPRB
   ZPIZ_IN (:,:,:) = 0.0_JPRB
   ZTAER_VERTIN (:,:,:) = 0.0_JPRB

!**********************
! TRAJECTORY  VARIABLES
!********************** 
    ZPROC5(1,1)=0.5  ! Surface reflectance - for now constant, but should be a function of wavelenght and
                    ! horizontal position such this:  ZPROC(1,1)= ZSURFREFL(JJ,JLEN) - this could be read
                    ! from a file or calculated from other model inputs: ask JEAN-JACQUES!!!

! Solar and satellite viewing angles

    ZZDIFFANG5(1) = PDIFFANG5(JLEN)  ! For testing purposes this could be fixed to PI/2.
    ZZSOLANG5(1)  = PSOLANG5(JLEN)   ! For testing purposes this could be fixed to =0.2
    ZZVIEANG5(1)  = PVIEANG5(JLEN)   ! For testing purposes this could be fixed to =0.3

! Profile of aerosol extinction from aer_opt_prop
    ZTAER_VERTIN5(1,1:KLEV,1) = ZAEREXT5(JLEN, 1:KLEV, JJ) + 0.001
    ZTAER_VERTIN5(1,0,1)      = ZAEREXT5(JLEN, 1, JJ) ! level 0 value is set equal to value for level 1

! Rayleigh optical depth from Dutton et al. (1994)
  DO JLEV= 0, NFLEVG
   ZTRAY550_VERTIN5(1,JLEV) = (PPRESH5(JLEN,JLEV)/101325._JPRB) * 0.00877_JPRB * (ZWL5(1)*1.E06)** (-4.05_JPRB)
 ENDDO

    ZPIZ_IN5(1,1:KLEV,1) = ZAEROM5(JLEN, 1:KLEV, JJ)    ! For convenience this could be set to 0.98
    ZPIZ_IN5(1,0,1)      = ZAEROM5(JLEN, 1, JJ)         ! level 0 value is set equal to value for level 1

! BEN - Heyney-Greenstein phase function based on the asymmetry parameter g (ZAERASY5)

    ZHEYGR5 = 0.0_JPRB
    ZSTEP = 0.037

   DO JLEV = 1,NFLEVG

    ZAUX5 = ZAERASY5(JLEN,JLEV,JJ)

    ZANGLE(1) = 3.034
    DO JMU = 2, KNBMU
      
     ZANGLE(JMU) = ZANGLE(JMU-1) - ZSTEP

     ZHEYGR5 = (1.-ZAUX5**2)/ &
        &       (1. + ZAUX5**2 - 2.0_JPRB * ZAUX5 * COS(ZANGLE(JMU)) )**(3./2.)

     ZPHASEL_IN5(1,JLEV,1,JMU) = ZHEYGR5
    ENDDO

! Phase function at scattering angle of 180 degrees
    ZPHASEL_IN5(1,JLEV,1,1) = (1.-ZAUX5**2)  / (1. + ZAUX5**2 - 2._JPRB * ZAUX5* COS(ZPI) )**(3./2.)

   ENDDO

   ZPHASEL_IN5 (:,0,:,:) = ZPHASEL_IN5 (:,1,:,:) ! level 0 value is set equal to value for level 1

!*********************************
! BACK TO THE ADJOINT CALCULATIONS 
!*********************************
    ZREFLET(1,1) = ZREFLET(1,1) + PAERREFL(JLEN,JJ)
    PAERREFL(JLEN,JJ) = 0.0_JPRB

     WRITE(NULOUT,*)'CALLING ADJOINT OF RT6S_GEMS '
     CALL RT6S_GEMS_AD(ZZDIFFANG5,ZZSOLANG5,ZZVIEANG5,ZWL5,ZPHASEL_IN5,ZPHASEL_IN,ZPIZ_IN5, ZPIZ_IN, &
      &            ZTRAY550_VERTIN5,ZTAER_VERTIN5,ZTAER_VERTIN,ZPROC5, &
      &            ZREFLET5, ZREFLET)
  WRITE(NULOUT,*) 'END OF ADJOINT OF RT6S_GEMS'
  ZREFLET(1,1) = 0.0_JPRB


   ZPHASEL_IN (:,1,:,:) = ZPHASEL_IN (:,1,:,:) +  ZPHASEL_IN (:,0,:,:) 
   ZPHASEL_IN (:,0,:,:) = 0.0_JPRB

   ZAUX=0.0_JPRB

   DO JLEV = NFLEVG,1,-1
       ZAUX5 = ZAERASY5(JLEN,JLEV,JJ)

       ZAUX=ZAUX -( 2.0_JPRB *ZAUX5* ZPHASEL_IN(1,JLEV,1,1)*(1+ZAUX5**2 -2.0_JPRB*ZAUX5*COS(ZPI) )**(3./2.)  &
      &     + (1.0_JPRB - ZAUX5**2) * (3._JPRB/2._JPRB)   &
      &     * ( 2._JPRB * ZAUX5 - 2._JPRB * COS(ZPI) )**(1./2.) * ZPHASEL_IN(1,JLEV,1,1) ) &
      &     / (1. + ZAUX5**2 - 2.0_JPRB * ZAUX5 * COS(ZPI) )**3 

      ZPHASEL_IN(1,JLEV,1,1) = 0.0_JPRB

      ZHEYGR = 0.0_JPRB     

     DO JMU = KNBMU,2,-1

       ZHEYGR = ZHEYGR + ZPHASEL_IN(1,JLEV,1,JMU)
       ZPHASEL_IN(1,JLEV,1,JMU) = 0.0_JPRB 

       ZAUX = ZAUX - ( 2.0_JPRB * ZAUX5 * ZHEYGR * (1+ZAUX5**2 -2.0_JPRB * ZAUX5 * COS(ZANGLE(JMU)) )**(3./2.)  &
      &     + (1.0_JPRB - ZAUX5**2) * (3._JPRB/2._JPRB)    &
      &     * ( 2._JPRB * ZAUX5 - 2._JPRB * COS(ZANGLE(JMU)) )**(1./2.)* ZHEYGR  ) &
      &     / (1. + ZAUX5**2 - 2.0_JPRB * ZAUX5 * COS(ZANGLE(JMU)) )**3
 
       ZHEYGR = 0.0_JPRB

     ENDDO

       ZAERASY(JLEN,JLEV,JJ) =  ZAERASY(JLEN,JLEV,JJ) + ZAUX
       ZAUX = 0.0_JPRB

   ENDDO

   ZAEROM(JLEN, 1, JJ) = ZAEROM(JLEN, 1, JJ) + ZPIZ_IN(1,0,1)
   ZPIZ_IN(1,0,1) = 0.0_JPRB
   ZAEREXT(JLEN, 1, JJ) = ZAEREXT(JLEN, 1, JJ) +  ZTAER_VERTIN(1,0,1) 
   ZTAER_VERTIN(1,0,1) = 0.0_JPRB

  DO JLEV = NFLEVG,1,-1
   ZAEREXT(JLEN, JLEV, JJ) =  ZAEREXT(JLEN, JLEV, JJ)  + ZTAER_VERTIN(1,JLEV,1) 
   ZAEROM(JLEN, JLEV, JJ)  =  ZAEROM(JLEN, JLEV, JJ) + ZPIZ_IN(1,JLEV,1)
   ZTAER_VERTIN(1,JLEV,1)  = 0.0_JPRB
   ZPIZ_IN(1,JLEV,1)       = 0.0_JPRB
  ENDDO
   
 ENDDO ! LOOP ON HORIZONTAL POINTS (JLEN) 
ENDDO ! LOOP ON CHANNELS  (JJ)

! Call tangent linear of aerosol optical depth routine
        CALL AER_OPT_PROP_AD( KDLEN  , KLEN  , KMXCOUNT, &
 &   PQF, PTF, PPRESH, PPRESF, &
 &   YDGEMSPROF, &
 &   ZAEREXT,ZAEROM, ZAERASY, &
 &   PQF5, PTF5, PPRESH5, PPRESF5, &
 &   YDGEMSPROF5, &
 &   ZAEREXT5,ZAEROM5, ZAERASY5 )

     ZAEROM(:,:,:) = 0.0_JPRB 
     ZAERASY(:,:,:) = 0.0_JPRB 
     ZAEREXT(:,:,:) = 0.0_JPRB

  IF (LHOOK) CALL DR_HOOK('AER_REFL_AD',1,ZHOOK_HANDLE)
END SUBROUTINE AER_REFL_AD
