SUBROUTINE RT6S_GEMS(PDIFFANG,PSOLANG,PVIEANG,PWL,                     &
&    PHASEL_IN,PIZ_IN,PTRAY550_VERTIN,PTAER_VERTIN,PROC,               &
&                                                           PREFLET)

!****RT6S_GEMS*** MAIN CALLING ROUTINE OF THE RADIATIVE TRANSFER CODE

!  THIS CORRESPONDS TO A MODIFIED VERSION OF THE 6S RADIATIVE TRANSFER 
! MODEL DEVELLOPED AT LOA. FEATURES SUCH AS AIRPLANE MEASUREMENTS, MULTIPLE CHOICE 
! IN  THE AEROSOL MODELS, ATMOSPHERIC CONDITIONS, SURFACE MODEL FOR THE COMPUTING OF 
! SURFACE REFLECTANCE ARE ELIMINATED. THE MODEL IS ADAPTED IN ORDER TO FIT THE NEEDS
! OF GEMS PROJECT, THIS IS TO COMPUTE THE REFLECTANCE AT MULTIPLE WAVELENGTH (KWL)
! FOR A SINGLE AEROSOL MODEL WITH A GIVEN VERTICAL DISTRIBUTION.



!     INTERFACE
!     ---------
!           RT6S_GEMS IS CALLED BY ECMWF MODEL

!     INPUTS
!     ------
! PDIFFANG(KLON)    : DIFFERENCE IN AZIMUTAL ANGLE [RAD]
! PSOLANG(KLON)     : COSINE OF SOLAR ZENITH ANGLE
! PVIEANG(KLON)     : COSINE OF VIEWING ZENITH ANGLE
! PWL(KWL)                     : Wavelengths at which the calculations are done (m).
! PTRAY550_VERTIN(KLON,KLEV)   : Molecular optical thickness profile at 0.55e-6 m.
! PTAER_VERTIN(KLON,KLEV,KWL)  : Aerosol optical thickness profile.
! PHASEL_IN(KLON,KLEV,KWL,KMU) : Aerosol phase function profile.
! PIZ_IN(KLON,KLEV,KWL)        : Aerosol single scattering albedo profile.
! PROC(KLON,KWL)               : TARGET SURFACE REFLECTANCE

!     OUTPUTS
!     -------
! REFLET(KLON,KWL) = APPARENT REFLECTANCE AT KWL WAVELENGTH

!     EXTERNALS.
!     ----------

!     MODIFICATIONS.
!     -------------
!          N.HUNEEUS 02.05.2007
!          A.BENEDETTI - ECMWF 06.08.2008

!     SOURCE
!     ------
! ADAPTED FROM MAIN CALLING ROUTINE IN ORIGINAL 6S CODE, SEE VERMOTE ET AL. (1997)

!     MODEL PARAMETERS
!     ----------------
!--------------------------------------------------------------------------------------

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

USE RT6SVALUES

IMPLICIT NONE

REAL(KIND=JPRB),INTENT(IN)  :: PWL(KWL), PDIFFANG(KLON), PSOLANG(KLON), PVIEANG(KLON)
REAL(KIND=JPRB),INTENT(IN)  :: PTRAY550_VERTIN(KLON,0:KLEV),PTAER_VERTIN(KLON,0:KLEV,KWL)  
REAL(KIND=JPRB),INTENT(IN)  :: PHASEL_IN(KLON,0:KLEV,KWL,KNBMU),PIZ_IN(KLON,0:KLEV,KWL)
REAL(KIND=JPRB),INTENT(IN)  :: PROC(KLON,KWL)     
REAL(KIND=JPRB),INTENT(OUT) :: PREFLET(KLON,KWL)

! LOCAL VARIABLES
! ---------------

!INTEGER(KIND=JPIM),PARAMETER  :: KMU=25, KMU2=48, KNP=49, KNANG=80, KNBMU=83, KNT=20
!INTEGER(KIND=JPIM),PARAMETER  :: KWL =1 !!!!!! This value is totally invented. CHECK WITH NICOLAS.
!INTEGER(KIND=JPIM),PARAMETER  :: KLON =1, KLEV = 60 

INTEGER(KIND=JPIM):: JLEV, JWL, JLON, JNBMU
!GAUSS WHEIGHTS AND ANGLES
REAL(KIND=JPRB) :: ZRP(KNP), ZGP(KNP)
REAL(KIND=JPRB) :: ZRMU(KNBMU),ZGA(KNBMU)
REAL(KIND=JPRB) :: ZRM(-KMU:KMU),z_PGB(-KMU:KMU)
REAL(KIND=JPRB) :: ZRM_AUX(KLON,-KMU:KMU)
! VERTICAL DISCRETIZATION                                  
REAL(KIND=JPRB) :: ZTAER_VERT(KLON,0:KNT,KWL), ZTRAY_VERT(KLON,0:KNT,KWL)
REAL(KIND=JPRB) :: ZPHASEL(KLON,0:KNT,KWL,KNBMU), ZPIZ(KLON,0:KNT,KWL)
! DISCOM VARIABLES
REAL(KIND=JPRB) :: ZPHIRAD, ZXMUS, ZXMUV
REAL(KIND=JPRB) :: ZTAER(0:KNT), ZTRAY(0:KNT), ZOMEGA(0:KNT), ZPHASEF(0:KNT,KNBMU)
REAL(KIND=JPRB) :: ZROATM, ZDTDIR, ZDTDIF, ZUTDIR, ZUTDIF, ZSPHAL
REAL(KIND=JPRB) :: ZPPL(KNBMU,-1:KNANG+1), ZAUX1, ZAUX2 
! KERNEL VARIABLE
REAL(KIND=JPRB) :: ZPPSL(0:KNANG,-1:KNANG,-KMU:KMU)
REAL(KIND=JPRB) :: ZPPSL_AUX(KLON,0:KNANG,-1:KNANG,-KMU:KMU)
! SURFACE REFLECTANCE
REAL(KIND=JPRB) :: ZSURFREF

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "discom_gems.intfb.h"
#include "pre_calc.intfb.h"
#include "vertdisc.intfb.h"

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


PREFLET(:,:)=0.0_JPRB

! CALCULATION OF GAUSS WEIGHTS AND ANGLES
! ---------------------------------------

  CALL PRE_CALC(PVIEANG, PSOLANG, &
&               ZRP, ZGP, ZRM_AUX, z_PGB, ZRMU, ZGA, ZPPL,ZPPSL_AUX)

! CONVERTING VERTICAL DISCRETIZATION INTO ONE WITH ISO-OD LAYERS
! --------------------------------------------------------------

  CALL VERTDISC(PWL , PTRAY550_VERTIN , PTAER_VERTIN , PHASEL_IN, PIZ_IN, &
&  ZTAER_VERT, ZTRAY_VERT, ZPHASEL, ZPIZ)

ZAUX1=0.0_JPRB
ZAUX2=0.0_JPRB
DO JLEV=0,KNT
  ZAUX1=ZAUX1+ZTAER_VERT(1,JLEV,1)
  ZAUX2=ZAUX2+ZTRAY_VERT(1,JLEV,1)
ENDDO

! TRUNCATION OF THE PHASE FUNCTION
! --------------------------------


DO JLON=1,KLON
  ZPHIRAD=PDIFFANG(JLON)
  ZXMUS=cos(PSOLANG(JLON)*zpi/180._JPRB)
  ZXMUV=cos(PVIEANG(JLON)*zpi/180._JPRB)
  ZRM(:)=ZRM_AUX(JLON,:)
  ZPPSL(:,:,:)=ZPPSL_AUX(JLON,:,:,:)
  DO JWL=1,KWL

! ONLY THE VERTICAL IS PASSED FROM NOW ON
! ---------------------------------------

    DO JLEV=0,KNT
      ZTAER(JLEV)=ZTAER_VERT(JLON,JLEV,JWL)
      ZTRAY(JLEV)=ZTRAY_VERT(JLON,JLEV,JWL)
      ZOMEGA(JLEV)=ZPIZ(JLON,JLEV,JWL)
      DO JNBMU=1,KNBMU
        ZPHASEF(JLEV,JNBMU)=ZPHASEL(JLON,JLEV,JWL,JNBMU)
      ENDDO
    ENDDO

! COMPUTATION OF ATMOSPHERIC REFLECTANCE AND TRANSMITTANCE
! --------------------------------------------------------

    CALL DISCOM_GEMS(ZPHIRAD,ZXMUS,ZXMUV,ZRM,z_PGB,ZRP,ZRMU,ZGA,ZTAER,ZTRAY,ZOMEGA,ZPHASEF,ZPPL,ZPPSL,   &
&                           ZROATM,ZDTDIR,ZDTDIF,ZUTDIR,ZUTDIF,ZSPHAL)

! COMPUTATION OF THE SURFACE REFLECTANCE
! --------------------------------------

    ZSURFREF=PROC(JLON,JWL)*(ZDTDIR+ZDTDIF)*(ZUTDIR+ZUTDIF)/(1.-PROC(JLON,JWL)*ZSPHAL)

! FINAL CALCULATION OF REFLECTANCE
! --------------------------------

    PREFLET(JLON,JWL)=ZROATM+ZSURFREF

   PRINT *,'APPARENT REFLECTANCE = ',PREFLET(JLON,JWL)
  ENDDO ! LOOP ON WAVELENGTH
ENDDO   ! LOOP ON KLON

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