SUBROUTINE DISCOM_GEMS(PHIRAD,PXMUS,PXMUV,PRM,PGB,PRP,PRMU,PGA,PTAER,PTRAY,POMEGA, &
                     & PHASEF,PPL,PPSL,PROATM,PDTDIR,PDTDIF,PUTDIR,PUTDIF,PSPHAL)  

!****DISCOM*** COMPUTES OPTICAL PROPERTIES OF THE ATMOSPHERE AT REQUESTED WAVELENGTHS

!     INTERFACE
!     ---------
! DISCOM IS CALLED BY MAIN ROUTINE 6S_GEMS

!     INPUTS
!     ------

! PHIRAD          : DIFFERENCE IN AZIMUTAL ANGLE [RAD]
! PXMUS           : COSINE OF SOLAR ZENITH ANGLE
! PXMUV           : COSINE OF VIEWING ZENITH ANGLE
! PRP(KNP)        : GAUSSIAN ANGLES FOR AZIMUTH
! PRMU(KNBMU)     : GAUSSIAN ANGLES FOR TRUNCATION OF PHASE FUNCTION 
! PGA(KNBMU)      : GAUSSIAN WEIGHTS FOR TRUNCATION OF PHASE FUNCTION
! PRM(-KMU:KMU)   : GAUSSIAN ANGLES FOR THE ZENITH
! PGB(-KMU:KMU)   : GAUSSIAN WEIGHTS FOR THE ZENITH
! PTAER(0:KNT)      : Aerosol optical thickness profile.
! PTRAY(0:KNT)      : Molecular optical thickness profile
! PHASEF(0:KNT,KMU) : Aerosol phase function profile.
! POMEGA(0:KNT)     : Aerosol single scattering albedo profile.
! PPL(KNBMU,-1:KNANG+1) : USED IN TRUNCATION OF PHASE FUNCTION
! PPSL(0:KNANG,-1:KNANG,-KMU:KMU) :

!     OUTPUTS
!     -------

! PROATM : ATMOSPHERIC REFLECTANCE
! PDTDIR : DOWNWARD DIRECT TRANSMITTANCE
! PDTDIF : DOWNWARD DIFFUSE TRANSMITTANCE
! PUTDIR : UPWARD DIRECT TRANSMITTANCE
! PUTDIF : UPWARD DIFFUSE TRANSMITTANCE
! PSPHAL : SPHERICAL ALBEDO

!     EXTERNALS.
!     ----------
! TRUNCA, ATMREF, SCATRA

!     MODIFICATIONS.
!     -------------
! N.HUNEEUS 02.05.2007

!     SOURCE
!     ------
! ADAPTED FROM DISCOM.f FROM ORIGINAL 6S CODE, SEE VERMOTE ET AL. (1997)

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

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

USE RT6SVALUES


IMPLICIT NONE

!INTEGER(KIND=JPIM),PARAMETER :: KMU=25, KNP=49, KNANG=80, KNBMU=83, KNT=20
REAL(KIND=JPRB),INTENT(IN) :: PRP(KNP), PRMU(KNBMU), PGA(KNBMU)
REAL(KIND=JPRB),INTENT(INOUT) :: PRM(-KMU:KMU), PGB(-KMU:KMU)
REAL(KIND=JPRB),INTENT(IN) :: PHIRAD, PXMUS, PXMUV             
REAL(KIND=JPRB),INTENT(IN) :: PTAER(0:KNT), PTRAY(0:KNT)
REAL(KIND=JPRB),INTENT(IN) :: PPL(KNBMU,-1:KNANG+1)
REAL(KIND=JPRB),INTENT(INOUT) :: PHASEF(0:KNT,KNBMU)
REAL(KIND=JPRB),INTENT(IN) :: POMEGA(0:KNT)
REAL(KIND=JPRB),INTENT(IN) :: PPSL(0:KNANG,-1:KNANG,-KMU:KMU)
REAL(KIND=JPRB),INTENT(OUT) :: PROATM, PSPHAL
REAL(KIND=JPRB),INTENT(OUT) :: PDTDIR, PDTDIF 
REAL(KIND=JPRB),INTENT(OUT) :: PUTDIR, PUTDIF

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

INTEGER(KIND=JPIM) :: JLEV
REAL(KIND=JPRB) :: z_PBETAL(0:KNT,0:KNANG), z_PCOEFF(0:KNT)
REAL(KIND=JPRB) :: z_PROMIX
REAL(KIND=JPRB) :: z_PTAMOY(0:KNT), z_PIZMOY(0:KNT)
REAL(KIND=JPRB) :: z_PTODAER, z_PTODRAY
REAL(KIND=JPRB) :: z_PDDIRTT,z_PDDIFTT,z_PUDIRTT,z_PUDIFTT,z_PSPHALBT

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "atmref_gems.intfb.h"
#include "scatra_gems.intfb.h"
#include "trunca_gems.intfb.h"


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

! THE AEROSOL PHASE FUNCTION IS DECOMPOSED IN THE BETAL

 CALL TRUNCA_GEMS(PHASEF,PRMU,PGA,PPL, &
& z_PBETAL, z_PCOEFF)


! TRUNCATION OF THE MOLECULAR AND AEROSOL PHASE FUNCTION

DO JLEV=0,KNT
  z_PTAMOY(JLEV)=PTAER(JLEV)*(1.0_JPRB-POMEGA(JLEV)*z_PCOEFF(JLEV))
  z_PIZMOY(JLEV)=POMEGA(JLEV)*(1.0_JPRB-z_PCOEFF(JLEV))/(1.0_JPRB-POMEGA(JLEV)*z_PCOEFF(JLEV))
ENDDO


! AEROSOL AND MOLECULAR OPTICAL DEPTH

z_PTODAER=0.0_JPRB
z_PTODRAY=0.0_JPRB
DO JLEV=0,KNT
  z_PTODAER=z_PTODAER+z_PTAMOY(JLEV)  ! AEROSOL OPTICAL THICKNESS
  z_PTODRAY=z_PTODRAY+PTRAY(JLEV)   ! MOLECULAR OPTICAL THICKNESS
ENDDO

! COMPUTATION OF AEROSOL, RAYLEIGH AND MIXTURE REFLECTANCE

  CALL ATMREF_GEMS(z_PTAMOY,PTRAY,z_PIZMOY,PHIRAD,PXMUS,PXMUV,PRM,PGB,PRP,z_PBETAL,PPSL,&
  & z_PTODAER,z_PTODRAY,z_PROMIX)

! COMPUTATION OF THE TRANSMISSION FUNCTION

  CALL SCATRA_GEMS(z_PTAMOY,PTRAY,z_PTODAER,z_PTODRAY,z_PIZMOY,PRM,PGB,PXMUS, &
   &  PXMUV,z_PBETAL,PPSL,  &
   & z_PDDIRTT,z_PDDIFTT,z_PUDIRTT,z_PUDIFTT,z_PSPHALBT)

PROATM=z_PROMIX      
PDTDIR=z_PDDIRTT      
PDTDIF=z_PDDIFTT      
PUTDIR=z_PUDIRTT      
PUTDIF=z_PUDIFTT      
PSPHAL=z_PSPHALBT      

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