!
! Common_RTSolution
!
! Module containing common ancillary functions for
! available radiative transfer algorithms. 
!
! CREATION HISTORY:
!       Written by:     David Neil Groff,    IMSG at EMC;    david.groff@noaa.gov
!                       09-Sep-2010


MODULE Common_RTSolution

  ! ------------------
  ! Environment set up
  ! ------------------
  ! Module use statements
  USE Type_Kinds,                ONLY: fp
  USE CRTM_Parameters,           ONLY: ONE, ZERO, PI, &
                                       DEGREES_TO_RADIANS, &
                                       SECANT_DIFFUSIVITY, &
                                       SCATTERING_ALBEDO_THRESHOLD
  USE Message_Handler,           ONLY: SUCCESS, Display_Message
  USE CRTM_Atmosphere_Define,    ONLY: CRTM_Atmosphere_type
  USE CRTM_Surface_Define,       ONLY: CRTM_Surface_type
  USE CRTM_GeometryInfo_Define,  ONLY: CRTM_GeometryInfo_type
  USE CRTM_Planck_Functions,     ONLY: CRTM_Planck_Radiance , &
                                       CRTM_Planck_Temperature, &
                                       CRTM_Planck_Radiance_TL, &
                                       CRTM_Planck_Temperature_TL, &
                                       CRTM_Planck_Temperature_AD, &
                                       CRTM_Planck_Radiance_AD
  USE CRTM_SpcCoeff
  USE CRTM_AtmOptics_Define,     ONLY: CRTM_AtmOptics_type
  USE RTV_Define
  USE CRTM_SfcOptics
  USE CRTM_SfcOptics_Define
  USE CRTM_Utility
  USE CRTM_RTSolution_Define
  
  ! Disable all implicit typing
  IMPLICIT NONE
  
  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE 
  
  PUBLIC :: Assign_Common_Input
  PUBLIC :: Assign_Common_Output
  PUBLIC :: Assign_Common_Input_TL
  PUBLIC :: Assign_Common_Output_TL
  PUBLIC :: Assign_Common_Input_AD
  PUBLIC :: Assign_Common_Output_AD
  
  ! -----------------
  ! Module parameters
  ! -----------------
  ! Version Id for the module
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
  '$Id: $'
  
CONTAINS

!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

!-------------------------------------------------------------------------
!
! NAME:
!       Assign_Common_Input
!
! PURPOSE:
!       Function to assign input that is used when calling both the ADA and
!       SOI RT algorithms. 
!
! CALLING SEQUENCE:
!       Error_Status = Assign_Common_Input( Atmosphere  , &  ! Input
!                                           Surface     , &  ! Input                         
!                                           AtmOptics   , &  ! Input                         
!                                           SfcOptics   , &  ! Input                         
!                                           GeometryInfo, &  ! Input                         
!                                           SensorIndex , &  ! Input                         
!                                           ChannelIndex, &  ! Input                         
!                                           RTSolution  , &  ! Output                        
!                                           RTV           )  ! Internal variable output      
!
! INPUT ARGUMENTS:
!       Atmosphere:     Structure containing the atmospheric state data.
!                       UNITS:      N/A
!                       TYPE:       CRTM_Atmosphere_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Surface:        Structure containing the surface state data.
!                       UNITS:      N/A
!                       TYPE:       CRTM_Surface_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       AtmOptics:      Structure containing the combined atmospheric
!                       optical properties for gaseous absorption, clouds,
!                       and aerosols.
!                       UNITS:      N/A
!                       TYPE:       CRTM_AtmOptics_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       SfcOptics:      Structure containing the surface optical properties
!                       data. Argument is defined as INTENT (IN OUT ) as
!                       different RT algorithms may compute the surface
!                       optics properties before this routine is called.
!                       UNITS:      N/A
!                       TYPE:       CRTM_SfcOptics_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
!       GeometryInfo:   Structure containing the view geometry data.
!                       UNITS:      N/A
!                       TYPE:       CRTM_GeometryInfo_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
!       SensorIndex:    Sensor index id. This is a unique index associated
!                       with a (supported) sensor used to access the
!                       shared coefficient data for a particular sensor.
!                       See the ChannelIndex argument.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       ChannelIndex:   Channel index id. This is a unique index associated
!                       with a (supported) sensor channel used to access the
!                       shared coefficient data for a particular sensor's
!                       channel.
!                       See the SensorIndex argument.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       RTSolution:     Structure containing the soluition to the RT equation
!                       for the given inputs.
!                       UNITS:      N/A
!                       TYPE:       CRTM_RTSolution_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
!       nz              Assignment of RTV%n_Angles for
!                       existing RTSolution interfaces
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT)
!
!
!       RTV:            Structure containing internal variables required for
!                       tangent-linear or adjoint model calls in CRTM_RTSolution.
!                       UNITS:      N/A
!                       TYPE:       RTV_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was sucessful
!                          == FAILURE an unrecoverable error occurred
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output RTSolution argument is IN OUT rather than
!       just OUT. This is necessary because the argument is defined upon
!       input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!--------------------------------------------------------------------------------

  FUNCTION Assign_Common_Input( &
    Atmosphere  , &  ! Input
    Surface     , &  ! Input
    AtmOptics   , &  ! Input
    SfcOptics   , &  ! Input
    GeometryInfo, &  ! Input
    SensorIndex , &  ! Input
    ChannelIndex, &  ! Input
    RTSolution  , &  ! Output
    nz          , &  ! Input
    RTV         ) &  ! Internal variable output
  RESULT( Error_Status )
    ! Arguments
    TYPE(CRTM_Atmosphere_type),   INTENT(IN)     :: Atmosphere
    TYPE(CRTM_Surface_type),      INTENT(IN)     :: Surface
    TYPE(CRTM_AtmOptics_type),    INTENT(IN)     :: AtmOptics 
    TYPE(CRTM_SfcOptics_type),    INTENT(IN OUT) :: SfcOptics
    TYPE(CRTM_GeometryInfo_type), INTENT(IN OUT) :: GeometryInfo
    INTEGER,                      INTENT(IN)     :: SensorIndex
    INTEGER,                      INTENT(IN)     :: ChannelIndex
    TYPE(CRTM_RTSolution_type),   INTENT(IN OUT) :: RTSolution
    INTEGER,                      INTENT(OUT)    :: nz
    TYPE(RTV_type),               INTENT(IN OUT) :: RTV
    ! Function result
    INTEGER :: Error_Status
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Assign_Common_Input'
    ! Local variables
    CHARACTER(256) :: Message 
    INTEGER :: no, na, nt
    INTEGER :: i, k
    REAL(fp) :: Factor  ! SfcOptics quadrature weights normalisation factor
    REAL(fp) :: User_Emissivity, Direct_Reflectivity
    
    ! Set Up
    Error_Status = SUCCESS

    GeometryInfo%Cosine_Sensor_Zenith = ONE / GeometryInfo%Secant_Sensor_Zenith

    RTV%n_Added_Layers = Atmosphere%n_Added_Layers
    RTV%n_Layers       = Atmosphere%n_Layers
    RTV%n_Streams      = RTSolution%n_Full_Streams/2

    ! Save the optical depth if required
    IF ( CRTM_RTSolution_Associated( RTSolution ) ) THEN
      ! Shorter names for indexing
      no = RTSolution%n_Layers  ! Original no. of layers
      na = RTV%n_Added_Layers   ! No. of added layers
      nt = RTV%n_Layers         ! Current total no. of layers
      ! Assign only the optical depth profile
      ! defined by the user input layering
      RTSolution%Layer_Optical_Depth(1:no) = AtmOptics%Optical_Depth(na+1:nt)
    END IF
    ! Required SpcCoeff components
    RTV%Cosmic_Background_Radiance = SC(SensorIndex)%Cosmic_Background_Radiance(ChannelIndex)
    RTV%Sensor_Type                = SC(SensorIndex)%Sensor_Type
    RTV%Is_Solar_Channel           = SpcCoeff_IsSolar( SC(SensorIndex), ChannelIndex=ChannelIndex )
    RTV%COS_SUN                = cos(GeometryInfo%Source_Zenith_Radian)
    RTV%Solar_Irradiance       = SC(SensorIndex)%Solar_Irradiance(ChannelIndex) * GeometryInfo%AU_ratio2
   
    ! Determine the surface emission behavior
    !   By default, surface is SPECULAR.
    RTV%Diffuse_Surface = .FALSE.

    ! -------------------------------------------
    ! Determine the quadrature angles and weights
    ! -------------------------------------------
    ! Default is to assume scattering RT
    RTV%Scattering_RT = .FALSE.

    ! Check for scattering conditions
    Determine_Stream_Angles: IF( RTSolution%Scattering_FLAG .AND. &
                                 MAXVAL(AtmOptics%Single_Scatter_Albedo) >= SCATTERING_ALBEDO_THRESHOLD ) THEN 

      ! --------------------------
      ! Set the scattering RT flag
      ! --------------------------
      RTV%Scattering_RT = .TRUE.

      ! ---------------------------------------
      ! Compute the Gaussian angles and weights
      ! ---------------------------------------
      CALL Double_Gauss_Quadrature( RTV%n_Streams, RTV%COS_Angle, RTV%COS_Weight )


      ! ----------------------------------------------------------------
      ! Is an additional stream required for the satellite zenith angle?
      ! That is, is the satellite zenith angle sufficiently different
      ! from the stream angles?
      ! ----------------------------------------------------------------
      ! Search for a matching angle
      DO i = 1, RTV%n_Streams
        IF( ABS( RTV%COS_Angle(i) - GeometryInfo%Cosine_Sensor_Zenith ) < ANGLE_THRESHOLD ) THEN
          SfcOptics%Index_Sat_Ang = i         ! Identify the sensor zenith angle
          RTV%n_Angles = RTV%n_Streams
          ! *****FLAW*****
          ! CAN WE REPLACE THIS CONSTRUCT WITH ANOTHER
          GO TO 100
          ! *****FLAW*****
        END IF
      END DO

      ! No match found, so flag an additional
      ! spot for the satellite zenith angle
      RTV%n_Angles = RTV%n_Streams + 1
      SfcOptics%Index_Sat_Ang = RTV%n_Angles      ! Identify the sensor zenith angle
      RTV%COS_Angle( RTV%n_Angles )  = GeometryInfo%Cosine_Sensor_Zenith
      RTV%COS_Weight( RTV%n_Angles ) = ZERO
      
      100 CONTINUE

      ! ------------------------
      ! Compute the phase matrix
      ! ------------------------
      CALL CRTM_Phase_Matrix( AtmOptics, & ! Input
                              RTV        ) ! Internal variable

    ELSE IF( RTV%Diffuse_Surface) THEN

      ! ------------------
      ! Lambertian surface
      ! ------------------
      ! The default diffusivity angle
      RTV%n_Streams       = 1
      RTV%COS_Angle( 1 )  = ONE/SECANT_DIFFUSIVITY
      RTV%COS_Weight( 1 ) = ONE
      ! The satellite zenith angle
      RTV%n_Angles                   = RTV%n_Streams + 1
      SfcOptics%Index_Sat_Ang        = RTV%n_Angles      ! Identify the sensor zenith angle
      RTV%COS_Angle( RTV%n_Angles )  = GeometryInfo%Cosine_Sensor_Zenith
      RTV%COS_Weight( RTV%n_Angles ) = ZERO

    ELSE

      ! ----------------
      ! Specular surface
      ! ----------------
      RTV%n_Streams = 0
      RTV%n_Angles  = 1
      RTV%COS_Angle( RTV%n_Angles )  = GeometryInfo%Cosine_Sensor_Zenith
      RTV%COS_Weight( RTV%n_Angles ) = ONE
      SfcOptics%Index_Sat_Ang        = RTV%n_Angles

    END IF Determine_Stream_Angles
    ! -------------------------------------------------
    ! Copy the RTV angles to a short name for use below
    ! -------------------------------------------------
    nZ = RTV%n_Angles

    ! ---------------------------------------------------------------------
    ! Assign the number of Stokes parameters. Currently, this is set to 1
    ! for decoupled polarization between surface and atmosphere.
    ! Remember for polarised microwave instruments, each frequency's Stokes
    ! parameter is treated as a separate channel.
    ! ---------------------------------------------------------------------
    SfcOptics%n_Stokes = 1
    
    ! ----------------------------------------------------
    ! Assign the angles and weights to SfcOptics structure
    ! ----------------------------------------------------
    SfcOptics%n_Angles = RTV%n_Angles
    Factor = ZERO
    DO i = 1, nZ
      SfcOptics%Angle(i)  = ACOS( RTV%COS_Angle(i) ) / DEGREES_TO_RADIANS
      SfcOptics%Weight(i) = RTV%COS_Angle(i) * RTV%COS_Weight(i)
      ! Compute the weight normalisation factor
      Factor = Factor + SfcOptics%Weight(i)
    END DO
    ! Normalise the quadrature weights                                               
    IF( Factor > ZERO) SfcOptics%Weight(1:nZ) = SfcOptics%Weight(1:nZ) / Factor

    ! --------------------------------
    ! Populate the SfcOptics structure
    ! --------------------------------
    IF ( SfcOptics%Compute ) THEN
      Error_Status = CRTM_Compute_SfcOptics( &
                       Surface     , & ! Input
                       GeometryInfo, & ! Input
                       SensorIndex , & ! Input
                       ChannelIndex, & ! Input
                       SfcOptics   , & ! In/Output
                       RTV%SOV       ) ! Internal variable output
      IF ( Error_Status /= SUCCESS ) THEN
        WRITE( Message,'("Error computing SfcOptics for ",a," channel ",i0)' ) &
               TRIM(SC(SensorIndex)%Sensor_Id), &
               SC(SensorIndex)%Sensor_Channel(ChannelIndex)
        CALL Display_Message( ROUTINE_NAME, TRIM(Message), Error_Status )
        RETURN
      END IF

    ELSE

      IF( RTV%Scattering_RT ) THEN
        ! Replicate the user emissivity for all angles
        SfcOptics%Reflectivity = ZERO
        User_Emissivity = SfcOptics%Emissivity(1,1)
        SfcOptics%Emissivity(1,1) = ZERO
        Direct_Reflectivity = SfcOptics%Direct_Reflectivity(1,1)/PI
        SfcOptics%Emissivity(1:nZ,1) = User_Emissivity
        ! Replicate the user reflectivities for all angles
        SfcOptics%Direct_Reflectivity(1:nZ,1) = Direct_Reflectivity
        IF( RTV%Diffuse_Surface) THEN
          DO i = 1, nZ 
            SfcOptics%Reflectivity(1:nZ, 1, i, 1) = (ONE-SfcOptics%Emissivity(i,1))*SfcOptics%Weight(i)   
          END DO
        ELSE ! Specular surface
          DO i = 1, nZ 
            SfcOptics%Reflectivity(i, 1, i, 1) = (ONE-SfcOptics%Emissivity(i,1))
          END DO
        END IF
      ELSE
        User_Emissivity = SfcOptics%Emissivity(1,1)
        SfcOptics%Emissivity( SfcOptics%Index_Sat_Ang,1 ) = User_Emissivity
        SfcOptics%Reflectivity(1,1,1,1) = ONE - User_Emissivity
      END IF

    END IF

    ! ------------------------------------------------------
    ! Save the emissivity in the RTSolution output structure
    ! ------------------------------------------------------
    RTSolution%Surface_Emissivity = SfcOptics%Emissivity( SfcOptics%Index_Sat_Ang, 1 )

    ! ------------------------
    ! Compute Planck radiances
    ! ------------------------
    IF( RTV%mth_Azi == 0 ) THEN
      DO k = 1, Atmosphere%n_Layers 
        CALL CRTM_Planck_Radiance( &
               SensorIndex              , & ! Input
               ChannelIndex             , & ! Input
               Atmosphere%Temperature(k), & ! Input
               RTV%Planck_Atmosphere(k)   ) ! Output
      END DO
      ! Surface radiance
      CALL CRTM_Planck_Radiance( &
             SensorIndex                  , & ! Input
             ChannelIndex                 , & ! Input
             SfcOptics%Surface_Temperature, & ! Input
             RTV%Planck_Surface             ) ! Output
    ELSE
      RTV%Planck_Atmosphere = ZERO
      RTV%Planck_Surface = ZERO
    END IF
    
  END FUNCTION Assign_Common_Input
  
!--------------------------------------------------------------------------------
!
! NAME:
!       Assign_Common_Input_TL
!
! PURPOSE:
!       Function to assign tangent-linear input common to both the ADA and
!       SOI RT models.
!
! CALLING SEQUENCE:
!      Error_Status = Assign_Common_Input_TL( Atmosphere   , &  ! FWD Input
!                                             Surface      , &  ! FWD Input                  
!                                             AtmOptics    , &  ! FWD Input                  
!                                             SfcOptics    , &  ! FWD Input                  
!                                             RTSolution   , &  ! FWD Input                  
!                                             Atmosphere_TL, &  ! TL Input                   
!                                             Surface_TL   , &  ! TL Input                   
!                                             AtmOptics_TL , &  ! TL Input                   
!                                             SfcOptics_TL , &  ! TL Input                   
!                                             GeometryInfo , &  ! Input                      
!                                             SensorIndex  , &  ! Input                      
!                                             ChannelIndex , &  ! Input                      
!                                             RTSolution_TL, &  ! TL Output                  
!                                             RTV            )  ! Internal variable input    
!
! INPUT ARGUMENTS:
!       Atmosphere:             Structure containing the atmospheric state data.                
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_Atmosphere_type                                
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       Surface:                Structure containing the surface state data.                    
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_Surface_type                                   
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       AtmOptics:              Structure containing the combined atmospheric                   
!                               optical properties for gaseous absorption, clouds,              
!                               and aerosols.                                                   
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_AtmOptics_type                                 
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       SfcOptics:              Structure containing the surface optical properties
!                               data.
!                               UNITS:      N/A
!                               TYPE:       CRTM_SfcOptics_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!       Atmosphere_TL:          Structure containing the tangent-linear atmospheric             
!                               state data.                                                     
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_Atmosphere_type                                
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       Surface_TL:             Structure containing the tangent-linear surface state data.     
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_Surface_type                                   
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       AtmOptics_TL:           Structure containing the tangent-linear atmospheric             
!                               optical properties.                                             
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_AtmOptics_type                                 
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN) 
!
!       SfcOptics_TL:           Structure containing the tangent-linear surface optical         
!                               properties. Argument is defined as INTENT (IN OUT ) as          
!                               different RT algorithms may compute the surface optics          
!                               properties before this routine is called.                       
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_SfcOptics_type                                 
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN OUT)
!
!       GeometryInfo:           Structure containing the view geometry data.                    
!                               UNITS:      N/A                                                 
!                               TYPE:       CRTM_GeometryInfo_type                              
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       SensorIndex:            Sensor index id. This is a unique index associated              
!                               with a (supported) sensor used to access the                    
!                               shared coefficient data for a particular sensor.                
!                               See the ChannelIndex argument.                                  
!                               UNITS:      N/A                                                 
!                               TYPE:       INTEGER                                             
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       ChannelIndex:           Channel index id. This is a unique index associated             
!                               with a (supported) sensor channel used to access the            
!                               shared coefficient data for a particular sensor's               
!                               channel.                                                        
!                               See the SensorIndex argument.                                   
!                               UNITS:      N/A                                                 
!                               TYPE:       INTEGER                                             
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                          
!
!       RTV:                    Structure containing internal forward model variables           
!                               required for subsequent tangent-linear or adjoint model         
!                               calls. The contents of this structure are NOT accessible        
!                               outside of the CRTM_RTSolution module.                          
!                               UNITS:      N/A                                                 
!                               TYPE:       RTV_type                                            
!                               DIMENSION:  Scalar                                              
!                               ATTRIBUTES: INTENT(IN)                                         
!
! OUTPUT ARGUMENTS:
!
!
!       RTSolution_TL:          Structure containing the solution to the tangent-linear        
!                               RT equation for the given inputs.                              
!                               UNITS:      N/A                                                
!                               TYPE:       CRTM_RTSolution_type                               
!                               DIMENSION:  Scalar                                             
!                               ATTRIBUTES: INTENT(IN OUT)                                     
!
!       nz:                     Integer assigned from RTV%n_Angles                             
!                               UNITS:      N/A                                                
!                               TYPE:       INTEGER                                            
!                               DIMENSION:  Scalar                                             
!                               ATTRIBUTES: INTENT(OUT)                                        
!
!       User_Emissivity_TL:     Tangent linear of emissivity 
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(OUT)
!
!       Direct_Reflectivity_TL: Tangent linear of direct reflectivity
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(OUT)
!
!       Planck_Surface_TL:      Tangent linear of Planck Surface
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(OUT)
!
!       Planck_Atmosphere_TL:   Tangent linear of Planck Atmosphere
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Rank-1
!                               ATTRIBUTES: INTENT(OUT)
!
!       Pff_TL:                 Tangent linear of forward scattering 
!                               phase function
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Rank-3
!                               ATTRIBUTES: INTENT(OUT)
!
!       Pbb_TL:                 Tangent linear of backward scattering 
!                               phase function
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Rank-3
!                               ATTRIBUTES: INTENT(OUT)  
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was sucessful
!                          == FAILURE an unrecoverable error occurred
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output RTSolution_TL argument is IN OUT rather
!       than just OUT. This is necessary because the argument may be defined
!       upon input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!--------------------------------------------------------------------------------
  FUNCTION Assign_Common_Input_TL( &
    Atmosphere            , &  ! FWD Input
    Surface               , &  ! FWD Input
    AtmOptics             , &  ! FWD Input
    SfcOptics             , &  ! FWD Input
    Atmosphere_TL         , &  ! TL Input
    Surface_TL            , &  ! TL Input
    AtmOptics_TL          , &  ! TL Input
    SfcOptics_TL          , &  ! TL Input/Output 
    GeometryInfo          , &  ! Input
    SensorIndex           , &  ! Input
    ChannelIndex          , &  ! Input
    RTSolution_TL         , &  ! TL Output
    nz                    , &  ! Output
    User_Emissivity_TL    , &  ! Output                                            
    Direct_Reflectivity_TL, &  ! Output                                            
    Planck_Surface_TL     , &  ! Output                                            
    Planck_Atmosphere_TL  , &  ! Output                                            
    Pff_TL                , &  ! Output                                            
    Pbb_TL                , &  ! Output                                                                            
    RTV                   ) &  ! Internal variable input
  RESULT( Error_Status )
    ! Arguments
    TYPE(CRTM_Atmosphere_type),   INTENT(IN)     :: Atmosphere
    TYPE(CRTM_Surface_type),      INTENT(IN)     :: Surface
    TYPE(CRTM_AtmOptics_type),    INTENT(IN)     :: AtmOptics 
    TYPE(CRTM_SfcOptics_type),    INTENT(IN)     :: SfcOptics
    TYPE(CRTM_Atmosphere_type),   INTENT(IN)     :: Atmosphere_TL
    TYPE(CRTM_Surface_type),      INTENT(IN)     :: Surface_TL 
    TYPE(CRTM_AtmOptics_type),    INTENT(IN)     :: AtmOptics_TL
    TYPE(CRTM_SfcOptics_type),    INTENT(IN OUT) :: SfcOptics_TL
    TYPE(CRTM_GeometryInfo_type), INTENT(IN)     :: GeometryInfo
    INTEGER,                      INTENT(IN)     :: SensorIndex
    INTEGER,                      INTENT(IN)     :: ChannelIndex
    TYPE(CRTM_RTSolution_type),   INTENT(IN OUT) :: RTSolution_TL
    INTEGER,                      INTENT(OUT)    :: nz
    REAL(fp),                     INTENT(OUT)    :: User_Emissivity_TL
    REAL(fp),                     INTENT(OUT)    :: Direct_Reflectivity_TL
    REAL(fp),                     INTENT(OUT)    :: Planck_Surface_TL
    REAL(fp),                     INTENT(OUT)    :: Planck_Atmosphere_TL(0:)
    REAL(fp),                     INTENT(OUT)    :: Pff_TL(:,:,:)
    REAL(fp),                     INTENT(OUT)    :: Pbb_TL(:,:,:)    
    TYPE(RTV_type),               INTENT(IN)     :: RTV
    ! Function result
    INTEGER :: Error_Status
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Assign_Common_Input_TL'
    ! Local variables
    CHARACTER(256) :: Message 
    INTEGER :: i, k
    INTEGER :: no, na, nt

    ! ------
    ! Set up
    ! ------
    Error_Status = SUCCESS
    
    nz = RTV%n_Angles
    ! Set the sensor zenith angle index
    SfcOptics_TL%Index_Sat_Ang = SfcOptics%Index_Sat_Ang
    ! Save the TL optical depth if required
    IF ( CRTM_RTSolution_Associated( RTSolution_TL ) ) THEN
      ! Shorter names for indexing
      no = RTSolution_TL%n_Layers  ! Original no. of layers
      na = RTV%n_Added_Layers      ! No. of added layers
      nt = RTV%n_Layers            ! Current total no. of layers
      ! Assign only the optical depth profile
      ! defined by the user input layering
      RTSolution_TL%Layer_Optical_Depth(1:no) = AtmOptics_TL%Optical_Depth(na+1:nt)
    END IF

    ! ---------------------------------------------------
    ! Compute the tangent-linear phase matrix if required
    ! ---------------------------------------------------
    IF ( RTV%Scattering_RT ) THEN
      CALL CRTM_Phase_Matrix_TL( &
             AtmOptics,    & ! Input
             AtmOptics_TL, & ! Input
             Pff_TL,       & ! Output - TL forward scattering
             Pbb_TL,       & ! Output - TL backward scattering
             RTV           ) ! Internal variable
    END IF


    ! ---------------------------------------------------------------------
    ! Assign the number of Stokes parameters. Currently, this is set to 1
    ! for decoupled polarization between surface and atmosphere.
    ! Remember for polarised microwave instruments, each frequency's Stokes
    ! parameter is treated as a separate channel.
    ! ---------------------------------------------------------------------
    SfcOptics_TL%n_Stokes = 1

    
    ! ----------------------------------------------------
    ! Assign the angles and weights to SfcOptics structure
    ! ----------------------------------------------------
    SfcOptics_TL%n_Angles = SfcOptics%n_Angles
    SfcOptics_TL%Angle    = SfcOptics%Angle 
    SfcOptics_TL%Weight   = SfcOptics%Weight


    ! -----------------------------------------
    ! Populate the SfcOptics_TL structure based
    ! on FORWARD model SfcOptics Compute_Switch
    ! -----------------------------------------
    IF ( SfcOptics%Compute ) THEN
      Error_Status = CRTM_Compute_SfcOptics_TL( &
                       Surface     , & ! Input
                       SfcOptics   , & ! Input
                       Surface_TL  , & ! Input
                       GeometryInfo, & ! Input
                       SensorIndex , & ! Input
                       ChannelIndex, & ! Input
                       SfcOptics_TL, & ! In/Output
                       RTV%SOV       ) ! Internal variable input
      IF ( Error_Status /= SUCCESS ) THEN
        WRITE( Message,'("Error computing SfcOptics_TL for ",a," channel ",i0)' ) &
               TRIM(SC(SensorIndex)%Sensor_Id), &
               SC(SensorIndex)%Sensor_Channel(ChannelIndex)
        CALL Display_Message( ROUTINE_NAME, TRIM(Message), Error_Status )
        RETURN
      END IF
    ELSE
      IF( RTV%Scattering_RT ) THEN
        ! Replicate the user emissivity for all angles
        SfcOptics_TL%Reflectivity       = ZERO
        User_Emissivity_TL              = SfcOptics_TL%Emissivity(1,1)
        SfcOptics_TL%Emissivity(1,1)    = ZERO
        Direct_Reflectivity_TL          = SfcOptics_TL%Direct_Reflectivity(1,1)/PI
        SfcOptics_TL%Emissivity(1:nZ,1) = User_Emissivity_TL
        ! Replicate the user reflectivities for all angles
        SfcOptics_TL%Direct_Reflectivity(1:nZ,1) = Direct_Reflectivity_TL
        IF( RTV%Diffuse_Surface) THEN
          DO i = 1, nZ 
            SfcOptics_TL%Reflectivity(1:nZ, 1, i, 1) = -SfcOptics_TL%Emissivity(i,1)*SfcOptics%Weight(i)   
          END DO
        ELSE ! Specular surface
          DO i = 1, nZ 
            SfcOptics_TL%Reflectivity(i, 1, i, 1) = -SfcOptics_TL%Emissivity(i,1)
          END DO
        END IF
      ELSE
        User_Emissivity_TL = SfcOptics_TL%Emissivity(1,1)
        SfcOptics_TL%Emissivity( SfcOptics%Index_Sat_Ang,1 ) = User_Emissivity_TL
        SfcOptics_TL%Reflectivity(1,1,1,1) = - User_Emissivity_TL
      END IF
    END IF

    ! ------------------------------------------------------------
    ! Save the TL emissivity in the RTSolution_TL output structure
    ! ------------------------------------------------------------
    RTSolution_TL%Surface_Emissivity = SfcOptics_TL%Emissivity( SfcOptics_TL%Index_Sat_Ang, 1 )

    ! -------------------------------------------
    ! Compute the tangent-linear planck radiances
    ! -------------------------------------------
    IF( RTV%mth_Azi == 0 ) THEN
      ! Atmospheric layer TL radiances
      DO k = 1, Atmosphere%n_Layers 
        CALL CRTM_Planck_Radiance_TL( &
               SensorIndex                 , & ! Input
               ChannelIndex                , & ! Input
               Atmosphere%Temperature(k)   , & ! Input
               Atmosphere_TL%Temperature(k), & ! Input
               Planck_Atmosphere_TL(k)       ) ! Output
      END DO
      ! Surface TL radiance
      CALL CRTM_Planck_Radiance_TL( &
             SensorIndex                     , & ! Input
             ChannelIndex                    , & ! Input
             SfcOptics%Surface_Temperature   , & ! Input
             SfcOptics_TL%Surface_Temperature, & ! Input
             Planck_Surface_TL                 ) ! Output
    ELSE
      Planck_Atmosphere_TL = ZERO
      Planck_Surface_TL = ZERO
    END IF

  END FUNCTION Assign_Common_Input_TL
  
!--------------------------------------------------------------------------------
!
! NAME:
!       Assign_Common_Input_AD
!
! PURPOSE:
!       Function to assign common input before calling the adjoint RT algorithms.
!
! CALLING SEQUENCE:
!      Error_Status = Assign_Common_Input_AD( SfcOptics    , &  ! FWD Input                  
!                                             RTSolution   , &  ! FWD Input                              
!                                             GeometryInfo , &  ! Input                      
!                                             SensorIndex  , &  ! Input                      
!                                             ChannelIndex , &  ! Input
!                                             RTSolution_AD, &  ! AD Input/Output                      
!                                             Atmosphere_AD, &  ! AD Output                  
!                                             Surface_AD   , &  ! AD Output                  
!                                             AtmOptics_AD , &  ! AD Output                  
!                                             SfcOptics_AD , &  ! AD Output                  
!                                             RTV            )  ! Internal variable input    
!
! INPUT ARGUMENTS:
!
!       SfcOptics:            Structure containing the surface optical properties           
!                             data.                                                         
!                             UNITS:      N/A                                               
!                             TYPE:       CRTM_SfcOptics_type                               
!                             DIMENSION:  Scalar                                            
!                             ATTRIBUTES: INTENT(IN)                                        
!
!       RTSolution:           Structure containing the solution to the RT equation          
!                             for the given inputs.                                         
!                             UNITS:      N/A                                               
!                             TYPE:       CRTM_RTSolution_type                              
!                             DIMENSION:  Scalar                                            
!                             ATTRIBUTES: INTENT(IN)                                                                            
!
!       GeometryInfo:         Structure containing the view geometry data.                  
!                             UNITS:      N/A                                               
!                             TYPE:       CRTM_GeometryInfo_type                            
!                             DIMENSION:  Scalar                                            
!                             ATTRIBUTES: INTENT(IN)                                        
!
!       SensorIndex:          Sensor index id. This is a unique index associated            
!                             with a (supported) sensor used to access the                  
!                             shared coefficient data for a particular sensor.              
!                             See the ChannelIndex argument.                                
!                             UNITS:      N/A                                               
!                             TYPE:       INTEGER                                           
!                             DIMENSION:  Scalar                                            
!                             ATTRIBUTES: INTENT(IN)                                        
!
!       ChannelIndex:         Channel index id. This is a unique index associated           
!                             with a (supported) sensor channel used to access the          
!                             shared coefficient data for a particular sensor's             
!                             channel.                                                      
!                             See the SensorIndex argument.                                 
!                             UNITS:      N/A                                               
!                             TYPE:       INTEGER                                           
!                             DIMENSION:  Scalar                                            
!                             ATTRIBUTES: INTENT(IN)                                        
!
!       RTV:                  Structure containing internal forward model variables         
!                             required for subsequent tangent-linear or adjoint model       
!                             calls. The contents of this structure are NOT accessible      
!                             outside of the CRTM_RTSolution module.                        
!                             UNITS:      N/A                                               
!                             TYPE:       RTV_type                                          
!                             DIMENSION:  Scalar                                            
!                             ATTRIBUTES: INTENT(IN)                                        
!
! OUTPUT ARGUMENTS:
!
!       RTSolution_AD:        Structure containing the RT solution adjoint inputs.          
!                             UNITS:      N/A                                               
!                             TYPE:       CRTM_RTSolution_type                              
!                             DIMENSION:  Scalar                                            
!                             ATTRIBUTES: INTENT(IN OUT)
!
!       SfcOptics_AD:         Structure containing the adjoint surface optical   
!                             properties data.                                   
!                             UNITS:      N/A                                    
!                             TYPE:       CRTM_SfcOptics_type                    
!                             DIMENSION:  Scalar                                 
!                             ATTRIBUTES: INTENT(IN OUT)                        
!
!       Planck_Surface_AD:    Adjoint of Planck surface.
!                             UNITS:      N/A
!                             TYPE:       REAL(fp)
!                             DIMENSION:  Scalar
!                             ATTRIBUTES: INTENT(OUT)
!
!       Planck_Atmosphere_AD: Adjoint of Planck atmosphere
!                             UNITS:      N/A
!                             TYPE:       REAL(fp)
!                             DIMENSION:  Rank-1 (0:n_Layers)
!                             ATTRIBUTES: INTENT(OUT)
!
!       Radiance_AD:          Adjoint of Radiance
!                             UNITS:      N/A
!                             TYPE:       REAL(fp)
!                             DIMENSION:  Scalar
!                             ATTRIBUTES: INTENT(OUT)        
!
!       nz:                   Adjoint of Planck atmosphere
!                             UNITS:      N/A
!                             TYPE:       INTEGER
!                             DIMENSION:  Scalar
!                             ATTRIBUTES: INTENT(OUT)                           
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was sucessful
!                          == FAILURE an unrecoverable error occurred
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on all of the adjoint arguments (whether input or output)
!       is IN OUT rather than just OUT. This is necessary because the Input
!       adjoint arguments are modified, and the Output adjoint arguments must
!       be defined prior to entry to this routine. So, anytime a structure is
!       to be output, to prevent memory leaks the IN OUT INTENT is a must.
!
!--------------------------------------------------------------------------------

  FUNCTION Assign_Common_Input_AD( &
    SfcOptics            , &  ! FWD Input
    RTSolution           , &  ! FWD Input
    GeometryInfo         , &  ! Input
    SensorIndex          , &  ! Input
    ChannelIndex         , &  ! Input
    RTSolution_AD        , &  ! AD Output/Input
    SfcOptics_AD         , &  ! AD Output
    Planck_Surface_AD    , &  ! AD Output
    Planck_Atmosphere_AD , &  ! AD Output
    Radiance_AD          , &  ! AD Output
    nz                   , &  ! Output
    RTV                  ) &  ! Internal variable input
  RESULT( Error_Status )
    ! Arguments
    TYPE(CRTM_SfcOptics_type),    INTENT(IN)     :: SfcOptics
    TYPE(CRTM_RTSolution_type),   INTENT(IN)     :: RTSolution
    TYPE(CRTM_GeometryInfo_type), INTENT(IN)     :: GeometryInfo
    INTEGER,                      INTENT(IN)     :: SensorIndex
    INTEGER,                      INTENT(IN)     :: ChannelIndex
    TYPE(CRTM_RTSolution_type),   INTENT(IN OUT) :: RTSolution_AD    
    TYPE(CRTM_SfcOptics_type),    INTENT(IN OUT) :: SfcOptics_AD
    REAL(fp),                     INTENT(OUT)    :: Planck_Surface_AD
    REAL(fp),                     INTENT(OUT)    :: Planck_Atmosphere_AD(0:)
    REAL(fp),                     INTENT(OUT)    :: Radiance_AD
    INTEGER,                      INTENT(OUT)    :: nz
    TYPE(RTV_type),               INTENT(IN)     :: RTV
    ! Function result
    INTEGER :: Error_Status
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Assign_Common_Input_AD' 

    ! -----
    ! Setup
    ! -----
    Error_Status = SUCCESS
    ! Short named local copies
    nz = RTV%n_Angles
    ! Set the sensor zenith angle index
    SfcOptics_AD%Index_Sat_Ang = SfcOptics%Index_Sat_Ang

    ! Initialise local adjoint variables
    Planck_Surface_AD    = ZERO
    Planck_Atmosphere_AD = ZERO
    Radiance_AD = ZERO

    ! ------------------------------------------
    ! Compute the brightness temperature adjoint
    ! ------------------------------------------
    IF ( SpcCoeff_IsInfraredSensor( SC(SensorIndex) ) .OR. &
         SpcCoeff_IsMicrowaveSensor( SC(SensorIndex) ) ) THEN 
      IF( RTV%mth_Azi == 0 ) THEN
        CALL CRTM_Planck_Temperature_AD( &
               SensorIndex                         , & ! Input
               ChannelIndex                        , & ! Input
               RTSolution%Radiance                 , & ! Input
               RTSolution_AD%Brightness_Temperature, & ! Input
               Radiance_AD                           ) ! Output
        RTSolution_AD%Brightness_Temperature = ZERO 
      END IF
    END IF

    ! accumulate Fourier component
    Radiance_AD = Radiance_AD + RTSolution_AD%Radiance * &
         COS( RTV%mth_Azi*(GeometryInfo%Sensor_Azimuth_Radian-GeometryInfo%Source_Azimuth_Radian) )
         
  END FUNCTION Assign_Common_Input_AD 

!-------------------------------------------------------------------------
!
! NAME:
!       Assign_Common_Output
!
! PURPOSE:
!       Function to assign output from CRTM_ADA, CRTM_SOI and CRTM_Emission
!
! CALLING SEQUENCE:
!       Error_Status = Assign_Common_Output( Atmosphere   , & ! Input
!                                            SfcOptics    , & ! Input
!                                            GeometryInfo , & ! Input
!                                            SensorIndex  , & ! Input
!                                            ChannelIndex , & ! Input
!                                            RTV          , & ! Input
!                                            RTSolution     ) ! Output     
!
! INPUT ARGUMENTS:
!
!       Atmosphere:     Structure containing the atmospheric state data.
!                       UNITS:      N/A
!                       TYPE:       CRTM_Atmosphere_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       SfcOptics:      Structure containing the surface optical properties
!                       data. Argument is defined as INTENT (IN OUT ) as
!                       different RT algorithms may compute the surface
!                       optics properties before this routine is called.
!                       UNITS:      N/A
!                       TYPE:       CRTM_SfcOptics_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       GeometryInfo:   Structure containing the view geometry data.
!                       UNITS:      N/A
!                       TYPE:       CRTM_GeometryInfo_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!   
!       SensorIndex:    Sensor index id. This is a unique index associated
!                       with a (supported) sensor used to access the
!                       shared coefficient data for a particular sensor.
!                       See the ChannelIndex argument.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       ChannelIndex:   Channel index id. This is a unique index associated
!                       with a (supported) sensor channel used to access the
!                       shared coefficient data for a particular sensor's
!                       channel.
!                       See the SensorIndex argument.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       RTV:            Structure containing internal variables required for
!                       subsequent tangent-linear or adjoint model calls.
!                       The contents of this structure are NOT accessible
!                       outside of the CRTM_RTSolution module.
!                       UNITS:      N/A
!                       TYPE:       RTV_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       RTSolution:     Structure containing the soluition to the RT equation
!                       for the given inputs.
!                       UNITS:      N/A
!                       TYPE:       CRTM_RTSolution_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was sucessful
!                          == FAILURE an unrecoverable error occurred
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output RTSolution argument is IN OUT rather than
!       just OUT. This is necessary because the argument is defined upon
!       input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!--------------------------------------------------------------------------------

  FUNCTION Assign_Common_Output( & 
    Atmosphere   , & ! Input
    SfcOptics    , & ! Input
    GeometryInfo , & ! Input
    SensorIndex  , & ! Input
    ChannelIndex , & ! Input
    RTV          , & ! Input
    RTSolution   ) & ! Output
  RESULT( Error_Status )
    ! Arguments
    TYPE(CRTM_Atmosphere_type)  , INTENT(IN)     :: Atmosphere
    TYPE(CRTM_SfcOptics_type)   , INTENT(IN)     :: SfcOptics
    TYPE(CRTM_GeometryInfo_type), INTENT(IN)     :: GeometryInfo
    INTEGER                     , INTENT(IN)     :: SensorIndex
    INTEGER                     , INTENT(IN)     :: ChannelIndex
    TYPE(RTV_type)              , INTENT(IN)     :: RTV
    TYPE(CRTM_RTSolution_type)  , INTENT(IN OUT) :: RTSolution

    ! Function Result
    INTEGER :: Error_Status
    ! Local Parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Assign_Common_Output'
    ! Local variables
    INTEGER :: no, na, nt
    REAL(fp) :: Radiance
    
    Error_Status = SUCCESS
    
    ! ADA and SOI specific assignments
    IF( RTV%Scattering_RT ) THEN
      
      ! Assign radiance output from ADA or SOI
      IF ( RTV%aircraft%rt ) THEN
        Radiance = RTV%s_Level_Rad_UP(SfcOptics%Index_Sat_Ang, RTV%aircraft%idx)
      ELSE
        Radiance = RTV%s_Level_Rad_UP(SfcOptics%Index_Sat_Ang, 0)
      END IF
    
    ! Emission specific assignments
    ELSE       
      
      ! The output radiance at TOA or at Aircraft height
      IF ( RTV%aircraft%rt ) THEN
        Radiance = RTV%e_Level_Rad_UP(RTV%aircraft%idx)
      ELSE
        Radiance = RTV%e_Level_Rad_UP(0)
      END IF 

      ! Other emission-only output
      RTSolution%Up_Radiance             = RTV%Up_Radiance
      RTSolution%Down_Radiance           = RTV%e_Level_Rad_DOWN(Atmosphere%n_Layers)
      RTSolution%Down_Solar_Radiance     = RTV%Down_Solar_Radiance
      RTSolution%Surface_Planck_Radiance = RTV%Planck_Surface
      IF ( CRTM_RTSolution_Associated( RTSolution ) ) THEN
        ! Shorter names for indexing
        no = RTSolution%n_Layers  ! Original no. of layers
        na = RTV%n_Added_Layers   ! No. of added layers
        nt = RTV%n_Layers         ! Current total no. of layers
        ! Assign only the upwelling radiance profile
        ! defined by the user input layering
        RTSolution%Upwelling_Radiance(1:no) = RTV%e_Level_Rad_UP(na+1:nt)
      END IF
    END IF
    
    ! accumulate Fourier component
    RTSolution%Radiance = RTSolution%Radiance + Radiance*  &
       COS( RTV%mth_Azi*(GeometryInfo%Sensor_Azimuth_Radian-GeometryInfo%Source_Azimuth_Radian) )

    ! ------------------------------------------------
    ! Compute the corresponding brightness temperature
    ! ------------------------------------------------
    IF( RTV%mth_Azi == 0 ) &
      CALL CRTM_Planck_Temperature( &
             SensorIndex,                      & ! Input
             ChannelIndex,                     & ! Input
             RTSolution%Radiance,              & ! Input
             RTSolution%Brightness_Temperature ) ! Output  
             
  END FUNCTION Assign_Common_Output   
!-------------------------------------------------------------------------
!
! NAME:
!       Assign_Common_Output_TL
!
! PURPOSE:
!       Function to assign output from CRTM_ADA, CRTM_SOI and CRTM_Emission
!
! CALLING SEQUENCE:
!       Error_Status = Assign_Common_Output_TL( SfcOptics              , & ! Input 
!                                               RTSolution             , & ! Input 
!                                               GeometryInfo           , & ! Input 
!                                               Radiance_TL            , & ! Input 
!                                               Scattering_Radiance_TL , & ! Input 
!                                               SensorIndex            , & ! Input
!                                               ChannelIndex           , & ! Input
!                                               RTV                    , & ! Input
!                                               RTSolution_TL            ) ! Output     
!
! INPUT ARGUMENTS:
!
!       SfcOptics:              Structure containing the surface optical properties
!                               data. 
!                               UNITS:      N/A
!                               TYPE:       CRTM_SfcOptics_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!       RTSolution:             Structure containing the soluition to the RT equation
!                               UNITS:      N/A
!                               TYPE:       CRTM_RTSolution_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!       GeometryInfo:           Structure containing the view geometry data.
!                               UNITS:      N/A
!                               TYPE:       CRTM_GeometryInfo_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!       Radiance_TL:            TL radiance
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!       Scattering_Radiance_TL: Scattering TL radiance
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Rank-1
!                               ATTRIBUTES: INTENT(IN)
!                          
!       SensorIndex:            Sensor index id. This is a unique index associated
!                               with a (supported) sensor used to access the
!                               shared coefficient data for a particular sensor.
!                               See the ChannelIndex argument.
!                               UNITS:      N/A
!                               TYPE:       INTEGER
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!       ChannelIndex:           Channel index id. This is a unique index associated
!                               with a (supported) sensor channel used to access the
!                               shared coefficient data for a particular sensor's
!                               channel.
!                               See the SensorIndex argument.
!                               UNITS:      N/A
!                               TYPE:       INTEGER
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!       RTV:                    Structure containing internal variables required for
!                               subsequent tangent-linear or adjoint model calls.
!                               The contents of this structure are NOT accessible
!                               outside of the CRTM_RTSolution module.
!                               UNITS:      N/A
!                               TYPE:       RTV_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       RTSolution_TL:          Structure containing the TL soluition to the RT equation.
!                               UNITS:      N/A
!                               TYPE:       CRTM_RTSolution_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT)
!
! FUNCTION RESULT:
!       Error_Status:           The return value is an integer defining the error status.
!                               The error codes are defined in the Message_Handler module.
!                               If == SUCCESS the computation was sucessful
!                               == FAILURE an unrecoverable error occurred
!                               UNITS:      N/A
!                               TYPE:       INTEGER
!                               DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output RTSolution argument is IN OUT rather than
!       just OUT. This is necessary because the argument is defined upon
!       input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!--------------------------------------------------------------------------------

  FUNCTION Assign_Common_Output_TL( & 
    SfcOptics              , & ! Input
    RTSolution             , & ! Input
    GeometryInfo           , & ! Input    
    Radiance_TL            , & ! Input
    Scattering_Radiance_TL , & ! Input
    SensorIndex            , & ! Input
    ChannelIndex           , & ! Input
    RTV                    , & ! Input
    RTSolution_TL          ) & ! Output
  RESULT( Error_Status )
    ! Arguments
    TYPE(CRTM_SfcOptics_type)   , INTENT(IN)     :: SfcOptics
    TYPE(CRTM_RTSolution_type)  , INTENT(IN)     :: RTSolution    
    TYPE(CRTM_GeometryInfo_type), INTENT(IN)     :: GeometryInfo
    REAL(fp)                    , INTENT(IN)     :: Radiance_TL
    REAL(fp)                    , INTENT(IN)     :: Scattering_Radiance_TL(:)
    INTEGER                     , INTENT(IN)     :: SensorIndex
    INTEGER                     , INTENT(IN)     :: ChannelIndex
    TYPE(RTV_type)              , INTENT(IN)     :: RTV
    TYPE(CRTM_RTSolution_type)  , INTENT(IN OUT) :: RTSolution_TL

    ! Function Result
    INTEGER :: Error_Status
    ! Local Parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Assign_Common_Output_TL'
  
    Error_Status = SUCCESS
    
    ! ADA and SOI specific assignments
    IF( RTV%Scattering_RT ) THEN
      ! accumulate Fourier component
      RTSolution_TL%Radiance = RTSolution_TL%Radiance + Scattering_Radiance_TL( SfcOptics%Index_Sat_Ang )*  &
         COS( RTV%mth_Azi*(GeometryInfo%Sensor_Azimuth_Radian-GeometryInfo%Source_Azimuth_Radian) )
      ! Emission specific assignments
    ELSE
      ! accumulate Fourier component
      RTSolution_TL%Radiance = RTSolution_TL%Radiance + Radiance_TL*  &
         COS( RTV%mth_Azi*(GeometryInfo%Sensor_Azimuth_Radian-GeometryInfo%Source_Azimuth_Radian) )
    END IF
    
    ! ---------------------------------------------------------------
    ! Compute the corresponding tangent-linear brightness temperature
    ! ---------------------------------------------------------------
    IF( RTV%mth_Azi == 0 ) &
      CALL CRTM_Planck_Temperature_TL( &
             SensorIndex                        , & ! Input
             ChannelIndex                       , & ! Input
             RTSolution%Radiance                , & ! Input
             RTSolution_TL%Radiance             , & ! Input
             RTSolution_TL%Brightness_Temperature ) ! Output
             
  END FUNCTION Assign_Common_Output_TL

!------------------------------------------------------------------------------
!
! NAME:
!       Assign_Common_Output_AD
!
! PURPOSE:
!       Function to assign output from CRTM_ADA, CRTM_SOI and CRTM_Emission
!       adjoint calls
!
! CALLING SEQUENCE:
!       Error_Status = Assign_Common_Output_AD( Atmosphere           , & ! Input
!                                               Surface              , & ! Input
!                                               AtmOptics            , & ! Input
!                                               SfcOptics            , & ! Input
!                                               Pff_AD               , & ! Input
!                                               Pbb_AD               , & ! Input
!                                               RTSolution           , & ! Input
!                                               GeometryInfo         , & ! Input
!                                               SensorIndex          , & ! Input
!                                               ChannelIndex         , & ! Input
!                                               nZ                   , & ! Input
!                                               AtmOptics_AD         , & ! Output
!                                               SfcOptics_AD         , & ! Output
!                                               Planck_Surface_AD    , & ! Output
!                                               Planck_Atmosphere_AD , & ! Output
!                                               User_Emissivity_AD   , & ! Output
!                                               Atmosphere_AD        , & ! Output
!                                               Surface_AD           , & ! Output
!                                               RTSolution_AD        , & ! Output
!                                               RTV                  ) & ! Input   
!
! INPUT ARGUMENTS:
!
!      Atmosphere:              Structure containing the atmospheric state data.
!                               UNITS:      N/A
!                               TYPE:       CRTM_Atmosphere_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)   
!
!      Surface:                 Structure containing the Surface state data.
!                               UNITS:      N/A
!                               TYPE:       CRTM_Surface_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!      AtmOptics:               Structure containing the combined atmospheric
!                               optical properties for gaseous absorption, clouds,
!                               and aerosols.
!                               UNITS:      N/A
!                               TYPE:       CRTM_AtmOptics_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!      SfcOptics:               Structure containing the surface
!                               optical properties data. 
!                               UNITS:      N/A
!                               TYPE:       CRTM_SfcOptics_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)                              
!
!      GeometryInfo:            Structure containing the view geometry data.
!                               UNITS:      N/A
!                               TYPE:       CRTM_GeometryInfo_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!                          
!      SensorIndex:             Sensor index id. This is a unique index associated
!                               with a (supported) sensor used to access the
!                               shared coefficient data for a particular sensor.
!                               See the ChannelIndex argument.
!                               UNITS:      N/A
!                               TYPE:       INTEGER
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
!
!      ChannelIndex:            Channel index id. This is a unique index associated
!                               with a (supported) sensor channel used to access the
!                               shared coefficient data for a particular sensor's
!                               channel.
!                               See the SensorIndex argument.
!                               UNITS:      N/A
!                               TYPE:       INTEGER
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
! 
!      nz:                      Integer assigned from RTV%n_Angles                             
!                               UNITS:      N/A                                                
!                               TYPE:       INTEGER                                            
!                               DIMENSION:  Scalar                                             
!                               ATTRIBUTES: INTENT(IN) 
!
!      RTV:                     Structure containing internal variables required for
!                               subsequent tangent-linear or adjoint model calls.
!                               The contents of this structure are NOT accessible
!                               outside of the CRTM_RTSolution module.
!                               UNITS:      N/A
!                               TYPE:       RTV_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN)
! 
!  OUTPUT ARGUMENTS
! 
!      Pff_AD:                  Forward scattering AD phase matrix
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT)
!
!      Pbb_AD:                  Backward scattering AD phase matrix
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT) 
!
!      AtmOptics_AD:            Structure containing the adjoint combined atmospheric
!                               optical properties for gaseous absorption, clouds,
!                               and aerosols.
!                               UNITS:      N/A
!                               TYPE:       CRTM_AtmOptics_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT)
!
!      SfcOptics_AD:            Structure containing the adjoint surface optical
!                               properties data.
!                               UNITS:      N/A
!                               TYPE:       CRTM_SfcOptics_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT)               
!
!      Planck_Surface_AD:       Adjoint of Planck surface.
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT)
!
!      Planck_Atmosphere_AD:    Adjoint of Planck atmosphere
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Rank-1 (0:n_Layers)
!                               ATTRIBUTES: INTENT(IN OUT)
!
!      User_Emissivity_AD:      Adjoint of user emissivity
!                               UNITS:      N/A
!                               TYPE:       REAL(fp)
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(OUT)
!
!      Atmosphere_AD:           Adjoint of atmosphere
!                               UNITS:      N/A
!                               TYPE:       CRTM_Atmosphere_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT)
!
!      Surface_AD:              Adjoint of surface
!                               UNITS:      N/A
!                               TYPE:       CRTM_Surface_type
!                               DIMENSION:  Scalar
!                               ATTRIBUTES: INTENT(IN OUT)
!
!      RTSolution_AD:           Structure containing the RT solution adjoint inputs. 
!                               UNITS:      N/A
!                               TYPE:       CRTM_RTSolution_type       
!                               DIMENSION:  Scalar                     
!                               ATTRIBUTES: INTENT(IN OUT)             
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was sucessful
!                          == FAILURE an unrecoverable error occurred
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output RTSolution argument is IN OUT rather than
!       just OUT. This is necessary because the argument is defined upon
!       input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!--------------------------------------------------------------------------------

  FUNCTION Assign_Common_Output_AD( & 
    Atmosphere             , & ! Input
    Surface                , & ! Input
    AtmOptics              , & ! Input
    SfcOptics              , & ! Input
    Pff_AD                 , & ! Input
    Pbb_AD                 , & ! Input
    GeometryInfo           , & ! Input
    SensorIndex            , & ! Input
    ChannelIndex           , & ! Input
    nZ                     , & ! Input
    AtmOptics_AD           , & ! Output
    SfcOptics_AD           , & ! Output
    Planck_Surface_AD      , & ! Output
    Planck_Atmosphere_AD   , & ! Output
    User_Emissivity_AD     , & ! Output
    Atmosphere_AD          , & ! Output
    Surface_AD             , & ! Output
    RTSolution_AD          , & ! Output
    RTV                    ) & ! Input
  RESULT( Error_Status )
    ! Arguments
    TYPE(CRTM_Atmosphere_type)  , INTENT(IN)     :: Atmosphere
    TYPE(CRTM_Surface_type)     , INTENT(IN)     :: Surface
    TYPE(CRTM_AtmOptics_type)   , INTENT(IN)     :: AtmOptics
    TYPE(CRTM_SfcOptics_type)   , INTENT(IN)     :: SfcOptics
    REAL(fp)                    , INTENT(IN OUT) :: Pff_AD(:,:,:)
    REAL(fp)                    , INTENT(IN OUT) :: Pbb_AD(:,:,:)
    TYPE(CRTM_GeometryInfo_type), INTENT(IN)     :: GeometryInfo
    INTEGER                     , INTENT(IN)     :: SensorIndex
    INTEGER                     , INTENT(IN)     :: ChannelIndex
    INTEGER                     , INTENT(IN)     :: nZ
    TYPE(CRTM_AtmOptics_type)   , INTENT(IN OUT) :: AtmOptics_AD
    TYPE(CRTM_SfcOptics_type)   , INTENT(IN OUT) :: SfcOptics_AD
    REAL(fp)                    , INTENT(IN OUT) :: Planck_Surface_AD
    REAL(fp)                    , INTENT(IN OUT) :: Planck_Atmosphere_AD(0:)
    REAL(fp)                    , INTENT(OUT)    :: User_Emissivity_AD
    TYPE(CRTM_Atmosphere_type)  , INTENT(IN OUT) :: Atmosphere_AD
    TYPE(CRTM_Surface_type)     , INTENT(IN OUT) :: Surface_AD
    TYPE(CRTM_RTSolution_type)  , INTENT(IN OUT) :: RTSolution_AD     
    TYPE(RTV_type)              , INTENT(IN)     :: RTV    

    ! Function Result
    INTEGER :: Error_Status
    ! Local Parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Assign_Common_Output_AD'
    ! Local variables
    CHARACTER(256) :: Message
    INTEGER :: no, na, nt
    INTEGER :: k, i
  
    Error_Status = SUCCESS
    
    ! ------------------------------------
    ! Compute the adjoint planck radiances
    ! ------------------------------------
    IF( RTV%mth_Azi == 0 ) THEN
      ! Surface AD radiance
      CALL CRTM_Planck_Radiance_AD( &
             SensorIndex                    , & ! Input
             ChannelIndex                   , & ! Input
             SfcOptics%Surface_Temperature  , & ! Input
             Planck_Surface_AD              , & ! Input
             SfcOptics_AD%Surface_Temperature ) ! In/Output
      Planck_Surface_AD = ZERO
      ! Atmospheric layer AD radiances
      DO k = 1, Atmosphere%n_Layers
        CALL CRTM_Planck_Radiance_AD( &
               SensorIndex                , & ! Input
               ChannelIndex               , & ! Input
               Atmosphere%Temperature(k)  , & ! Input
               Planck_Atmosphere_AD(k)    , & ! Input
               Atmosphere_AD%Temperature(k) ) ! In/Output
        Planck_Atmosphere_AD(k) = ZERO
      END DO
    ELSE
      Planck_Surface_AD = ZERO
      Planck_Atmosphere_AD = ZERO
    END IF


    ! ---------------------------------------------------------------------
    ! Assign the number of Stokes parameters. Currently, this is set to 1
    ! for decoupled polarization between surface and atmosphere.
    ! Remember for polarised microwave instruments, each frequency's Stokes
    ! parameter is treated as a separate channel.
    ! ---------------------------------------------------------------------
    SfcOptics_AD%n_Stokes = 1

    
    ! ----------------------------------------------------
    ! Assign the angles and weights to SfcOptics structure
    ! ----------------------------------------------------
    SfcOptics_AD%n_Angles = SfcOptics%n_Angles
    SfcOptics_AD%Angle    = SfcOptics%Angle 
    SfcOptics_AD%Weight   = SfcOptics%Weight


    ! --------------------------------------------------------------------------------
    ! This part is designed for specific requirement for the total sensitivity
    ! of emissivity. The requirement is regardless whether having user input or not.
    ! Therefore, this part is common part with/without optional input.
    ! The outputs of CRTM_Compute_RTSolution are the partial derivative
    ! of emissivity and reflectivity. Since SfcOptics_AD is used as input only in 
    ! CRTM_Compute_SfcOptics_AD, the total sensitivity of the emissivity is taken into
    ! account for here.
    ! --------------------------------------------------------------------------------
    IF( RTV%Scattering_RT ) THEN
      User_Emissivity_AD = ZERO
      IF( RTV%Diffuse_Surface) THEN
        DO i = nZ, 1, -1
          User_Emissivity_AD = User_Emissivity_AD - &
            (SUM(SfcOptics_AD%Reflectivity(1:nZ,1,i,1))*SfcOptics%Weight(i))
        END DO
      ELSE ! Specular surface
        DO i = nZ, 1, -1
          User_Emissivity_AD = User_Emissivity_AD - SfcOptics_AD%Reflectivity(i,1,i,1)
        END DO
      END IF
!      Direct_Reflectivity_AD = SUM(SfcOptics_AD%Direct_Reflectivity(1:nZ,1))
!      SfcOptics_AD%Direct_Reflectivity(1,1) = SfcOptics_AD%Direct_Reflectivity(1,1) +
!                                              (Direct_Reflectivity_AD/PI)
      RTSolution_AD%Surface_Emissivity = User_Emissivity_AD
    ELSE
      RTSolution_AD%Surface_Emissivity = SfcOptics_AD%Emissivity(SfcOptics_AD%Index_Sat_Ang,1) - &
                                         SfcOptics_AD%Reflectivity(1,1,1,1)
    END IF

    ! -----------------------------------------
    ! Populate the SfcOptics_AD structure based
    ! on FORWARD model SfcOptics Compute_Switch
    ! -----------------------------------------
    IF ( SfcOptics%Compute ) THEN
      Error_Status = CRTM_Compute_SfcOptics_AD( &
                       Surface     , & ! Input
                       SfcOptics   , & ! Input
                       SfcOptics_AD, & ! Input
                       GeometryInfo, & ! Input
                       SensorIndex , & ! Input
                       ChannelIndex, & ! Input
                       Surface_AD  , & ! In/Output
                       RTV%SOV       ) ! Internal variable input
      IF ( Error_Status /= SUCCESS ) THEN
        WRITE( Message,'("Error computing SfcOptics_AD for ",a," channel ",i0)' ) &
               TRIM(SC(SensorIndex)%Sensor_Id), &
               SC(SensorIndex)%Sensor_Channel(ChannelIndex)
        CALL Display_Message( ROUTINE_NAME, TRIM(Message), Error_Status )
        RETURN
      END IF
    END IF

    ! --------------------------------------------
    ! Compute the adjoint phase matrix if required
    ! --------------------------------------------
    IF ( RTV%Scattering_RT ) THEN
      CALL CRTM_Phase_Matrix_AD( &
             AtmOptics,    &  ! Input - FWD
             Pff_AD,       &  ! Input - AD forward scattering
             Pbb_AD,       &  ! Input - AD backward scattering
             AtmOptics_AD, &  ! Output - AD
             RTV           )  ! Internal variable
    END IF

    ! ------------------------------------------
    ! Save the adjoint optical depth if required
    ! ------------------------------------------
    IF ( CRTM_RTSolution_Associated( RTSolution_AD ) ) THEN
      ! Shorter names for indexing
      no = RTSolution_AD%n_Layers  ! Original no. of layers
      na = RTV%n_Added_Layers      ! No. of added layers
      nt = RTV%n_Layers            ! Current total no. of layers
      ! Assign only the optical depth profile
      ! defined by the user input layering
      RTSolution_AD%Layer_Optical_Depth(1:no) = AtmOptics_AD%Optical_Depth(na+1:nt)
    END IF    
             
  END FUNCTION Assign_Common_Output_AD
  
!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PRIVATE MODULE ROUTINES ##                      ##
!##                                                                            ##
!################################################################################
!################################################################################  
 
! -------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Phase_Matrix
!
! PURPOSE:
!       Subroutine to calculate the phase function for the scattering model.
!
! CALLING SEQUENCE:
!       CALL CRTM_Phase_Matrix( AtmOptics,  &  ! Input
!                               RTV         )  ! Internal variable
!
! INPUT ARGUMENTS:
!       AtmOptics:      Structure containing the atmospheric optical
!                       parameters
!                       UNITS:      N/A
!                       TYPE:       CRTM_AtmOptics_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       RTV:            Structure containing internal forward model variables
!                       required for tangent-linear or adjoint model calls in
!                       CRTM_RTSolution module. 
!                       UNITS:      N/A
!                       TYPE:       RTV_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUT ARGUMENTS:
!       RTV:            Structure containing internal forward model variables
!                       required for tangent-linear or adjoint model
!                       calls in CRTM_RTSolution module.
!                       UNITS:      N/A
!                       TYPE:       RTV_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
!       Note that the INTENT on the RTV         argument is IN OUT as it 
!       contains data prior to this call and is filled with data within this
!       routine.
!
!S-
!--------------------------------------------------------------------------------  
  SUBROUTINE CRTM_Phase_Matrix( &
    AtmOptics, &  ! Input
    RTV        )  ! Internal variable
    ! Arguments
    TYPE(CRTM_AtmOptics_type), INTENT(IN)     :: AtmOptics
    TYPE(RTV_type),            INTENT(IN OUT) :: RTV
    ! Local variables
    INTEGER :: i, j, k, l, ifac, jn

    !#--------------------------------------------------------------------------#
    !#                   -- COMPUTING LEGENDRE FUNCTION --                      #
    !#                   Pplus  for positive cosine of angles                   #
    !#                   Pminus for negative cosine of angles                   #
    !#--------------------------------------------------------------------------#

    DO i = 1, RTV%n_Angles 
       CALL Legendre_M( RTV%mth_Azi               , &
                        AtmOptics%n_Legendre_Terms, &
                        RTV%COS_Angle(i)          , &
                        RTV%Pleg(0:,i)              )
    END DO

    IF(RTV%Solar_Flag_true) &
      CALL Legendre_M( RTV%mth_Azi                , &
                       AtmOptics%n_Legendre_Terms , &
                       RTV%COS_SUN                , &
                       RTV%Pleg(0:,RTV%n_Angles+1)  )

    IF( RTV%Solar_Flag_true ) THEN
      jn = RTV%n_Angles + 1
    ELSE
      jn = RTV%n_Angles
    END IF

    !#--------------------------------------------------------------------------#
    !#                    -- COMPUTE THE PHASE MATRICES --                      #
    !#--------------------------------------------------------------------------#

    Layer_Loop: DO  k = 1, RTV%n_Layers


      ! ------------------------------    
      ! Only proceed if the scattering    
      ! coefficient is significant        
      ! ------------------------------    

      Significant_Scattering: IF( AtmOptics%Single_Scatter_Albedo(k) > SCATTERING_ALBEDO_THRESHOLD) THEN
      
        DO j = 1, jn
          ! add solar angle
          DO i = 1, RTV%n_Angles

            RTV%Off(i,j,k)=ZERO
            RTV%Obb(i,j,k)=ZERO

            DO l = RTV%mth_Azi, AtmOptics%n_Legendre_Terms - 1
              ifac = (-1) ** (l - RTV%mth_Azi)
              RTV%Off(i,j,k) = RTV%Off(i,j,k) + ( AtmOptics%Phase_Coefficient(l,1,k)*RTV%Pleg(l,i)*RTV%Pleg(l,j) )
              RTV%Obb(i,j,k) = RTV%Obb(i,j,k) + ( AtmOptics%Phase_Coefficient(l,1,k)*RTV%Pleg(l,i)*RTV%Pleg(l,j)*ifac )
            END DO

            RTV%Pff(i,j,k) = RTV%Off(i,j,k)
            RTV%Pbb(i,j,k) = RTV%Obb(i,j,k)

            ! For intensity, the phase matrix element must >= ZERO   
            IF ( RTV%mth_Azi == 0 ) THEN          
              IF(RTV%Pff(i,j,k) < ZERO) RTV%Pff(i,j,k) = PHASE_THRESHOLD
              IF(RTV%Pbb(i,j,k) < ZERO) RTV%Pbb(i,j,k) = PHASE_THRESHOLD
            END IF

          END DO
        END DO

        ! Normalization to ensure energy conservation
        IF (  RTV%mth_Azi == 0 ) CALL Normalize_Phase( k, RTV )
             
      END IF Significant_Scattering

    END DO Layer_Loop

  END SUBROUTINE CRTM_Phase_Matrix
  
!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Phase_Matrix_TL
!
! PURPOSE:
!       Subroutine to calculate the tangent-linear phase function for the
!       scattering model.
!
! CALLING SEQUENCE:                                                        
!       CALL CRTM_Phase_Matrix_TL( AtmOptics,    &  ! FWD Input
!                                  AtmOptics_TL, &  ! TL  Input
!                                  Pff_TL,       &  ! TL Output
!                                  Pff_TL,       &  ! TL Output
!                                  RTV           )  ! Internal variable
!
! INPUT ARGUMENTS:                                                         
!       AtmOptics:      Structure containing the atmospheric optical         
!                       parameters                                         
!                       UNITS:      N/A                                    
!                       TYPE:       CRTM_AtmOptics_type                     
!                       DIMENSION:  Scalar                                 
!                       ATTRIBUTES: INTENT(IN)                             
!
!       AtmOptics_TL:   Structure containing the tangent-linear atmospheric  
!                       optical parameters                                 
!                       UNITS:      N/A                                    
!                       TYPE:       CRTM_AtmOptics_type                     
!                       DIMENSION:  Scalar                                 
!                       ATTRIBUTES: INTENT(IN)                             
!
!       RTV:            Structure containing internal forward model variables
!                       required for subsequent tangent-linear or adjoint model
!                       calls. The contents of this structure are NOT accessible
!                       outside of the CRTM_RTSolution module.               
!                       UNITS:      N/A                                    
!                       TYPE:       RTV_type                    
!                       DIMENSION:  Scalar                                 
!                       ATTRIBUTES: INTENT(IN)                             
!
! OUTPUT ARGUMENTS:
!       Pff_TL:         Array containing the tangent-linear of the 
!                       forward phase matrix.
!                       UNITS:      N/A
!                       TYPE:       REAL
!                       DIMENSION:  Rank-3, n_Angles x n_Angles x n_Layers
!                       ATTRIBUTES: INTENT(OUT)
!
!       Pbb_TL:         Array containing the tangent-linear of the 
!                       backward phase matrix.
!                       UNITS:      N/A
!                       TYPE:       REAL
!                       DIMENSION:  Rank-3, n_Angles x n_Angles x n_Layers
!                       ATTRIBUTES: INTENT(OUT)
!
!--------------------------------------------------------------------------------

  SUBROUTINE CRTM_Phase_Matrix_TL( &
    AtmOptics,    &  ! FWD Input
    AtmOptics_TL, &  ! TL  Input
    Pff_TL,       &  ! TL Output
    Pbb_TL,       &  ! TL Output
    RTV           )  ! Internal variable
    ! Arguments
    TYPE(CRTM_AtmOptics_type)  , INTENT(IN)  :: AtmOptics
    TYPE(CRTM_AtmOptics_type)  , INTENT(IN)  :: AtmOptics_TL
    REAL(fp)                   , INTENT(OUT) :: Pff_TL(:,:,:) ! n_Angles x n_Angles x n_Layers
    REAL(fp)                   , INTENT(OUT) :: Pbb_TL(:,:,:) ! n_Angles x n_Angles x n_Layers
    TYPE(RTV_type)             , INTENT(IN)  :: RTV
    ! Local variables
    INTEGER :: i, j, k, l, nZ, ifac, jn
    REAL(fp), DIMENSION(RTV%n_Angles,RTV%n_Angles+1) :: Lff, Lbb



    !#--------------------------------------------------------------------------#
    !#             -- COMPUTE THE TANGENT-LINEAR PHASE MATRICES --              #
    !#--------------------------------------------------------------------------#

    nZ = RTV%n_Angles
    IF( RTV%Solar_Flag_true ) THEN
      jn = RTV%n_Angles + 1
    ELSE
      jn = RTV%n_Angles
    END IF

    Layer_Loop: DO  k = 1, RTV%n_Layers
        
      ! ------------------------------    
      ! Only proceed if the scattering    
      ! coefficient is significant        
      ! ------------------------------    

      Significant_Scattering: IF( AtmOptics%Single_Scatter_Albedo(k) > SCATTERING_ALBEDO_THRESHOLD) THEN
                 
        Lff(1:nZ,1:jn) = RTV%Off(1:nZ,1:jn,k)
        Lbb(1:nZ,1:jn) = RTV%Obb(1:nZ,1:jn,k)


        DO j = 1, jn
          DO i = 1, RTV%n_Angles

            Pff_TL(i,j,k) = ZERO
            Pbb_TL(i,j,k) = ZERO    
                
            DO l = RTV%mth_Azi, AtmOptics%n_Legendre_Terms - 1
              ifac = (-1) ** (l - RTV%mth_Azi)
              Pff_TL(i,j,k) = Pff_TL(i,j,k) + ( AtmOptics_TL%Phase_Coefficient(l,1,k)*RTV%Pleg(l,i)*RTV%Pleg(l,j) )
              Pbb_TL(i,j,k) = Pbb_TL(i,j,k) + ( AtmOptics_TL%Phase_Coefficient(l,1,k)*RTV%Pleg(l,i)*RTV%Pleg(l,j)*ifac )
            END DO
              
            ! For intensity, the FWD phase matrix element must >= ZERO
            ! so the TL form is always == zero.
            IF ( RTV%mth_Azi == 0 ) THEN
              IF ( RTV%Off(i,j,k) < ZERO ) THEN
                Pff_TL(i,j,k) = ZERO
                Lff(i,j)      = PHASE_THRESHOLD 
              END IF

              IF ( RTV%Obb(i,j,k) < ZERO ) THEN
                Pbb_TL(i,j,k) = ZERO
                Lbb(i,j) = PHASE_THRESHOLD 
              END IF
            END IF
             
          END DO
        END DO

        IF ( RTV%mth_Azi == 0 ) THEN
          ! Normalisation for energy conservation
          CALL Normalize_Phase_TL( &
                 k, RTV, &
                 Lff,           & ! FWD Input
                 Lbb,           & ! FWD Input
                 Pff_TL(:,:,k), & ! TL  Output
                 Pbb_TL(:,:,k)  ) ! TL  Output
        END IF
      END IF Significant_Scattering
    
    END DO Layer_Loop

  END SUBROUTINE CRTM_Phase_Matrix_TL
  
!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Phase_Matrix_AD
!
! PURPOSE:
!       Subroutine to calculate the adjoint of the phase function for the
!       scattering model.
!
! CALLING SEQUENCE:
!       CALL CRTM_Phase_Matrix_AD( AtmOptics,    &  ! FWD Input
!                                  Pff_AD,       &  ! AD Input
!                                  Pbb_AD,       &  ! AD Input
!                                  AtmOptics_AD, &  ! AD Output
!                                  RTV           )  ! Internal variable
!
! INPUT ARGUMENTS:
!       AtmOptics:      Structure containing the atmospheric optical
!                       parameters
!                       UNITS:      N/A
!                       TYPE:       CRTM_AtmOptics_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Pff_AD:         Array containing the adjoint of the 
!                       forward phase matrix.
!                       ** NOTE: This argument will be zeroed upon exit
!                       **       from this routine.
!                       UNITS:      N/A
!                       TYPE:       REAL
!                       DIMENSION:  Rank-3, n_Angles x n_Angles x n_Layers
!                       ATTRIBUTES: INTENT(IN OUT)
!
!       Pbb_AD:         Array containing the adjoint of the 
!                       backward phase matrix.
!                       ** NOTE: This argument will be zeroed upon exit
!                       **       from this routine.
!                       UNITS:      N/A
!                       TYPE:       REAL
!                       DIMENSION:  Rank-3, n_Angles x n_Angles x n_Layers
!                       ATTRIBUTES: INTENT(IN OUT)
!
!       RTV:            Structure containing internal forward model variables
!                       required for subsequent tangent-linear or adjoint model
!                       calls. The contents of this structure are NOT accessible
!                       outside of the CRTM_RTSolution module.
!                       UNITS:      N/A
!                       TYPE:       RTV_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       AtmOptics_AD:   Structure containing the adjoint atmospheric optical
!                       parameters
!                       UNITS:      N/A
!                       TYPE:       CRTM_AtmOptics_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
!       Note the INTENT on the output AtmOptics argument is IN OUT rather than
!       just OUT. This is necessary because the argument MUST be defined upon
!       input. To prevent memory leaks, and in this case errors in accessing
!       unallocated memory, the IN OUT INTENT is a must.
!
!S-
!--------------------------------------------------------------------------------

  SUBROUTINE CRTM_Phase_Matrix_AD( &
    AtmOptics,    &  ! FWD Input
    Pff_AD,       &  ! AD Input
    Pbb_AD,       &  ! AD Input
    AtmOptics_AD, &  ! AD Output
    RTV           )  ! Internal variable
    ! Arguments
    TYPE(CRTM_AtmOptics_type), INTENT(IN)     :: AtmOptics
    REAL(fp)                 , INTENT(IN OUT) :: Pff_AD(:,:,:) ! n_Angles x n_Angles x n_Layers
    REAL(fp)                 , INTENT(IN OUT) :: Pbb_AD(:,:,:) ! n_Angles x n_Angles x n_Layers
    TYPE(CRTM_AtmOptics_type), INTENT(IN OUT) :: AtmOptics_AD
    TYPE(RTV_type)           , INTENT(IN)     :: RTV
    ! Local variables
    INTEGER :: i, j, k, l, nZ, ifac, jn
    REAL(fp), DIMENSION(RTV%n_Angles,RTV%n_Angles+1) :: Lff, Lbb



    !#--------------------------------------------------------------------------#
    !#             -- COMPUTE THE ADJOINT OF THE PHASE MATRICES --              #
    !#--------------------------------------------------------------------------#

    nZ = RTV%n_Angles
    IF( RTV%Solar_Flag_true ) THEN
      jn = RTV%n_Angles + 1
    ELSE
      jn = RTV%n_Angles
    END IF
        
    Layer_Loop: DO  k = 1, RTV%n_Layers
    
    
      ! ------------------------------    
      ! Only proceed if the scattering    
      ! coefficient is significant        
      ! ------------------------------    

      Significant_Scattering: IF( AtmOptics%Single_Scatter_Albedo(k) > SCATTERING_ALBEDO_THRESHOLD) THEN


        ! AD normalization to ensure energy conservation
     !!   AtmOptics_AD%Phase_Coefficient(0:,1,k) = ZERO
        
        Lff(1:nZ,1:jn) = RTV%Off(1:nZ,1:jn,k)
        Lbb(1:nZ,1:jn) = RTV%Obb(1:nZ,1:jn,k)

        IF ( RTV%mth_Azi == 0 ) THEN              
          DO j = 1, jn
            DO i = 1, RTV%n_Angles
           
              ! For intensity, the FWD phase matrix element must >= ZERO
              ! so the TL, and thus the AD, for is always == zero.

                IF ( RTV%Off(i,j,k) < ZERO) Lff(i,j) = PHASE_THRESHOLD
                IF ( RTV%Obb(i,j,k) < ZERO) Lbb(i,j) = PHASE_THRESHOLD
             
            END DO
          END DO

          CALL Normalize_Phase_AD( &
                 k, RTV, &
                 Lff, Lbb,      & ! FWD Input
                 Pff_AD(:,:,k), & ! AD  Output
                 Pbb_AD(:,:,k)  ) ! AD  Output
        END IF

        DO j = 1, jn
          DO i = 1, RTV%n_Angles
         
            ! For intensity, the FWD phase matrix element must >= ZERO
            ! so the TL, and thus the AD, for is always == zero.
            IF ( RTV%mth_Azi == 0 ) THEN
              IF ( RTV%Off(i,j,k) < ZERO) Pff_AD(i,j,k) = ZERO
              IF ( RTV%Obb(i,j,k) < ZERO) Pbb_AD(i,j,k) = ZERO
            END IF

            DO l = RTV%mth_Azi, AtmOptics%n_Legendre_Terms - 1
              ifac = (-1) ** (l - RTV%mth_Azi)
              AtmOptics_AD%Phase_Coefficient(l,1,k) = AtmOptics_AD%Phase_Coefficient(l,1,k) + &
                                                      ( Pff_AD(i,j,k)*RTV%Pleg(l,i)*RTV%Pleg(l,j) )
              AtmOptics_AD%Phase_Coefficient(l,1,k) = AtmOptics_AD%Phase_Coefficient(l,1,k) + &
                                                      ( Pbb_AD(i,j,k)*RTV%Pleg(l,i)*RTV%Pleg(l,j)*ifac ) 
            END DO

            Pff_AD(i,j,k) = ZERO
            Pbb_AD(i,j,k) = ZERO           

          END DO
        END DO

      END IF Significant_Scattering

    END DO Layer_Loop

  END SUBROUTINE CRTM_Phase_Matrix_AD

!**************************************************************
!                 Normalize Phase Subroutines
!**************************************************************
  
  SUBROUTINE Normalize_Phase( k, RTV )
    ! Arguments
    INTEGER,        INTENT(IN)     :: k
    TYPE(RTV_type), INTENT(IN OUT) :: RTV
    ! Local variables
    INTEGER :: i, j, nZ                                           

    nZ = RTV%n_Angles

    ! Normalisation for stream angles
    RTV%Sum_Fac(0,k)=ZERO
    DO i = 1, RTV%n_Streams
      RTV%n_Factor(i,k)=ZERO
      DO j = i,nZ
        RTV%n_Factor(i,k)=RTV%n_Factor(i,k)+(RTV%Pff(i,j,k)+RTV%Pbb(i,j,k))*RTV%COS_Weight(j)
      END DO
      DO j=i,nZ
        RTV%Pff(i,j,k)=RTV%Pff(i,j,k)/RTV%n_Factor(i,k)*(ONE-RTV%Sum_Fac(i-1,k))
        RTV%Pbb(i,j,k)=RTV%Pbb(i,j,k)/RTV%n_Factor(i,k)*(ONE-RTV%Sum_Fac(i-1,k))
      END DO
      RTV%Sum_Fac(i,k)=ZERO
      IF( i < nZ ) THEN
        DO j=i+1,nZ
          RTV%Pff(j,i,k)=RTV%Pff(i,j,k)
          RTV%Pbb(j,i,k)=RTV%Pbb(i,j,k)
        END DO
        DO j = 1, i
          RTV%Sum_Fac(i,k)=RTV%Sum_Fac(i,k) + (RTV%Pff(i+1,j,k)+RTV%Pbb(i+1,j,k))*RTV%COS_Weight(j)
        END DO
      END IF
    END DO

    IF( RTV%n_Streams < nZ ) THEN 
      ! Sensor viewing angle differs from the Gaussian angles
      RTV%n_Factor(nZ,k) =  RTV%Sum_Fac(nZ-1,k)
      DO j = 1, nZ
        RTV%Pff(j,nZ,k) = RTV%Pff(j,nZ,k)/RTV%n_Factor(nZ,k)
        RTV%Pbb(j,nZ,k) = RTV%Pbb(j,nZ,k)/RTV%n_Factor(nZ,k)
        ! Symmetric condition
        IF( j < nZ ) THEN
          RTV%Pff(nZ,j,k) = RTV%Pff(j,nZ,k)
          RTV%Pbb(nZ,j,k) = RTV%Pbb(j,nZ,k)
        END IF
      END DO      
    END IF

  END SUBROUTINE Normalize_Phase
  
  SUBROUTINE Normalize_Phase_TL( k, RTV, Pff, Pbb, Pff_TL, Pbb_TL )
    ! Arguments
    INTEGER       , INTENT(IN)     :: k
    TYPE(RTV_type), INTENT(IN)     :: RTV
    REAL(fp)      , INTENT(IN)     :: Pff(:,:)
    REAL(fp)      , INTENT(IN)     :: Pbb(:,:)
    REAL(fp)      , INTENT(IN OUT) :: Pff_TL(:,:)
    REAL(fp)      , INTENT(IN OUT) :: Pbb_TL(:,:)
    ! Local variables
    REAL(fp) :: n_Factor_TL
    REAL(fp) :: Sum_Fac_TL(0:RTV%n_Angles)
    INTEGER :: i, j, nZ                                           

    nZ = RTV%n_Angles

    ! Normalisation for stream angles
    Sum_Fac_TL(0) = ZERO
    DO i = 1, RTV%n_Streams
      n_Factor_TL = ZERO
      DO j = i,nZ
        n_Factor_TL=n_Factor_TL+(Pff_TL(i,j)+Pbb_TL(i,j))*RTV%COS_Weight(j)
      END DO
      DO j=i,nZ
        Pff_TL(i,j) = Pff_TL(i,j)/RTV%n_Factor(i,k)*(ONE-RTV%Sum_Fac(i-1,k)) - &
                      Pff(i,j)/RTV%n_Factor(i,k)/RTV%n_Factor(i,k)*n_Factor_TL*(ONE-RTV%Sum_Fac(i-1,k)) - &
                      Pff(i,j)/RTV%n_Factor(i,k)*Sum_Fac_TL(i-1)
        
        Pbb_TL(i,j) = Pbb_TL(i,j)/RTV%n_Factor(i,k)*(ONE-RTV%Sum_Fac(i-1,k)) - &
                      Pbb(i,j)/RTV%n_Factor(i,k)/RTV%n_Factor(i,k)*n_Factor_TL*(ONE-RTV%Sum_Fac(i-1,k)) - &
                      Pbb(i,j)/RTV%n_Factor(i,k)*Sum_Fac_TL(i-1)
      END DO
      Sum_Fac_TL(i)=ZERO
      ! Symmetric condition
      IF( i < nZ ) THEN
        DO j = i+1, nZ
          Pff_TL(j,i) = Pff_TL(i,j)
          Pbb_TL(j,i) = Pbb_TL(i,j)
        END DO
        DO j = 1, i
          Sum_Fac_TL(i)=Sum_Fac_TL(i) + (Pff_TL(j,i+1)+Pbb_TL(j,i+1))*RTV%COS_Weight(j)
        END DO
     END IF
    END DO

    IF( RTV%n_Streams < nZ ) THEN 
      ! Sensor viewing angle differs from the Gaussian angles
      n_Factor_TL = Sum_Fac_TL(nZ-1)
      DO j = 1, nZ
        Pff_TL(j,nZ) = Pff_TL(j,nZ)/RTV%n_Factor(nZ,k) - &
                       Pff(j,nZ)/RTV%n_Factor(nZ,k)/RTV%n_Factor(nZ,k)*n_Factor_TL
                     
        Pbb_TL(j,nZ) = Pbb_TL(j,nZ)/RTV%n_Factor(nZ,k) - &
                       Pbb(j,nZ)/RTV%n_Factor(nZ,k)/RTV%n_Factor(nZ,k)*n_Factor_TL             
        ! Symmetric condition
        IF( j < nZ ) THEN
          Pff_TL(nZ,j) = Pff_TL(j,nZ)
          Pbb_TL(nZ,j) = Pbb_TL(j,nZ)
        END IF
      END DO
    END IF

  END SUBROUTINE Normalize_Phase_TL 
  
  SUBROUTINE Normalize_Phase_AD( k, RTV, Pff, Pbb, Pff_AD, Pbb_AD )
    ! Arguments
    INTEGER       , INTENT(IN)     :: k
    TYPE(RTV_type), INTENT(IN)     :: RTV
    REAL(fp)      , INTENT(IN)     :: Pff(:,:)
    REAL(fp)      , INTENT(IN)     :: Pbb(:,:)
    REAL(fp)      , INTENT(IN OUT) :: Pff_AD(:,:)
    REAL(fp)      , INTENT(IN OUT) :: Pbb_AD(:,:)
    ! Local variables
    INTEGER :: i, j, nZ                                           
    REAL(fp) :: n_Factor_AD
    REAL(fp) :: Sum_Fac_AD(0:RTV%n_Angles)


    nZ = RTV%n_Angles
    Sum_Fac_AD = ZERO

    n_Factor_AD = ZERO
    IF( RTV%n_Streams < nZ ) THEN 
      ! Sensor viewing angle diffs from the Gaussian angles
      DO j = nZ, 1, -1
        ! Symmetric condition
        IF( j < nZ ) THEN
          Pff_AD(j,nZ) = Pff_AD(j,nZ) + Pff_AD(nZ,j)
          Pff_AD(nZ,j) = ZERO
          Pbb_AD(j,nZ) = Pbb_AD(j,nZ) + Pbb_AD(nZ,j)
          Pbb_AD(nZ,j) = ZERO
        END IF

        n_Factor_AD = n_Factor_AD - Pff(j,nZ)/RTV%n_Factor(nZ,k)/RTV%n_Factor(nZ,k)*Pff_AD(j,nZ)
        Pff_AD(j,nZ) = Pff_AD(j,nZ)/RTV%n_Factor(nZ,k)

        n_Factor_AD = n_Factor_AD - Pbb(j,nZ)/RTV%n_Factor(nZ,k)/RTV%n_Factor(nZ,k)*Pbb_AD(j,nZ)
        Pbb_AD(j,nZ) = Pbb_AD(j,nZ)/RTV%n_Factor(nZ,k)             
      END DO   
      Sum_Fac_AD(nZ-1) = n_Factor_AD      
      n_Factor_AD = ZERO
    END IF
    
    DO i = RTV%n_Streams, 1, -1 
      ! Symmetric condition
      IF( i < nZ ) THEN
        DO j = i, 1, -1       
          Pbb_AD(j,i+1) = Pbb_AD(j,i+1) + Sum_Fac_AD(i)*RTV%COS_Weight(j)
          Pff_AD(j,i+1) = Pff_AD(j,i+1) + Sum_Fac_AD(i)*RTV%COS_Weight(j)        
        END DO
        DO j = nZ,i+1,-1
          Pff_AD(i,j) = Pff_AD(i,j) + Pff_AD(j,i)
          Pff_AD(j,i) = ZERO
          Pbb_AD(i,j) = Pbb_AD(i,j) + Pbb_AD(j,i)
          Pbb_AD(j,i) = ZERO
        END DO
      END IF
      Sum_Fac_AD(i) = ZERO
      DO j = nZ, i, -1
        Sum_Fac_AD(i-1) = Sum_Fac_AD(i-1) - Pbb(i,j)/RTV%n_Factor(i,k)*Pbb_AD(i,j)
        n_Factor_AD = n_Factor_AD -Pbb(i,j)/RTV%n_Factor(i,k)/RTV%n_Factor(i,k) * &
                      Pbb_AD(i,j)*(ONE-RTV%Sum_Fac(i-1,k))
        Pbb_AD(i,j) = Pbb_AD(i,j)/RTV%n_Factor(i,k)*(ONE-RTV%Sum_Fac(i-1,k))
        
        Sum_Fac_AD(i-1) = Sum_Fac_AD(i-1) - Pff(i,j)/RTV%n_Factor(i,k)*Pff_AD(i,j)
        n_Factor_AD = n_Factor_AD -Pff(i,j)/RTV%n_Factor(i,k)/RTV%n_Factor(i,k) * &
                      Pff_AD(i,j)*(ONE-RTV%Sum_Fac(i-1,k))
        Pff_AD(i,j) = Pff_AD(i,j)/RTV%n_Factor(i,k)*(ONE-RTV%Sum_Fac(i-1,k))
      END DO
      DO j = nZ, i, -1
        Pbb_AD(i,j) = Pbb_AD(i,j) + n_Factor_AD*RTV%COS_Weight(j)
        Pff_AD(i,j) = Pff_AD(i,j) + n_Factor_AD*RTV%COS_Weight(j)
      END DO
      n_Factor_AD = ZERO
    END DO    
    Sum_Fac_AD(0) = ZERO
  END SUBROUTINE Normalize_Phase_AD   
  
END MODULE Common_RTSolution
