CRTM_SfcOptics_Define.f90

!
! CRTM_SfcOptics_Define
!
! Module defining the CRTM SfcOptics structure and containing
! routines to manipulate it.
!
!
! CREATION HISTORY:
!       Written by:     Yong Han,       NOAA/NESDIS;     Yong.Han@noaa.gov
!                       Quanhua Liu,    QSS Group, Inc;  Quanhua.Liu@noaa.gov
!                       Paul van Delst, CIMSS/SSEC;      paul.vandelst@ssec.wisc.edu
!                       02-Apr-2004
!

MODULE CRTM_SfcOptics_Define

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE Type_Kinds           , ONLY: fp
  USE Message_Handler      , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message,warning
  USE Compare_Float_Numbers, ONLY: DEFAULT_N_SIGFIG, &
                                   OPERATOR(.EqualTo.), &
                                   Compares_Within_Tolerance
  USE CRTM_Parameters      , ONLY: ZERO, ONE, SET, NOT_SET
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Datatypes
  PUBLIC :: CRTM_SfcOptics_type
  ! Operators
  PUBLIC :: OPERATOR(==)
  PUBLIC :: OPERATOR(+)
  PUBLIC :: OPERATOR(-)
  ! Procedures
  PUBLIC :: CRTM_SfcOptics_Associated
  PUBLIC :: CRTM_SfcOptics_Destroy
  PUBLIC :: CRTM_SfcOptics_Create
  PUBLIC :: CRTM_SfcOptics_Zero
  PUBLIC :: CRTM_SfcOptics_Inspect
  PUBLIC :: CRTM_SfcOptics_DefineVersion
  PUBLIC :: CRTM_SfcOptics_Compare


  ! ---------------------
  ! Procedure overloading
  ! ---------------------
  INTERFACE OPERATOR(==)
    MODULE PROCEDURE CRTM_SfcOptics_Equal
  END INTERFACE OPERATOR(==)
  
  INTERFACE OPERATOR(+)
    MODULE PROCEDURE CRTM_SfcOptics_Add
  END INTERFACE OPERATOR(+)  
  
  INTERFACE OPERATOR(-)
    MODULE PROCEDURE CRTM_SfcOptics_Subtract
  END INTERFACE OPERATOR(-)  


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
  '$Id: CRTM_SfcOptics_Define.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $'


  ! -----------------------------------
  ! Surface optics data type definition
  ! -----------------------------------
  TYPE :: CRTM_SfcOptics_type
    ! Allocation indicator
    LOGICAL :: Is_Allocated = .FALSE.
    ! Dimensions
    INTEGER :: n_Angles = 0 ! I
    INTEGER :: n_Stokes = 0 ! Ls
    ! Flag for SfcOptics computation
    LOGICAL :: Compute = .TRUE.

    ! MW Water SfcOptics options
    LOGICAL  :: Use_New_MWSSEM = .TRUE.    ! Flag for MW Water SfcOptics algorithm switch
    REAL(fp) :: Azimuth_Angle  = 999.9_fp  ! Relative azimuth angle
    REAL(fp) :: Transmittance  = ZERO      ! Total atmospheric transmittance

    ! Index of the satellite view angle in the angle arrays
    INTEGER  :: Index_Sat_Ang = 1
    ! The counter for the m'th component of the Fourier exapnsion of
    ! the radiance for azimuth angle
    INTEGER  :: mth_Azi = 0
    ! The weighted mean surface temperature
    REAL(fp) :: Surface_Temperature = ZERO

    ! The stream angles and weights
    REAL(fp), ALLOCATABLE :: Angle(:)                 ! I
    REAL(fp), ALLOCATABLE :: Weight(:)                ! I
    ! The emissivities and reflectivities
    REAL(fp), ALLOCATABLE :: Emissivity(:,:)          ! I x Ls
    REAL(fp), ALLOCATABLE :: Reflectivity(:,:,:,:)    ! I x Ls x I x Ls
    REAL(fp), ALLOCATABLE :: Direct_Reflectivity(:,:) ! I x Ls
  END TYPE CRTM_SfcOptics_type

  ! Some notes regarding the above definition:
  !
  ! 1) The physical meaning of Reflectivity(:,:,:,:) is the following:
  !
  !    Given a pair of polarization indices, ip and rp, for the incident and
  !    reflected radiances respectively, assuming there are no cross contributions
  !    from incident radiation with different polarization, Reflectivity(:, rp, :, ip)
  !    is defined as a reflectivity matrix with
  !
  !      Reflectivity(:, rp, :, ip) = 0 ;  if rp /= ip
  !
  !    and
  !
  !      I(angle_r, p) = SUM( Reflectivity(angle_r, p, :, p) * I(:, p)), if rp=ip=p
  !
  !    where I(angle_r, p) is the reflected radiance at zenith angle with index angle_r,
  !    and I(:, p) are the incident radiances and the summation is over the number of
  !    incident angles.  Thus, if BRDF(angle_r, p, angle_in, p) is the bidirectional
  !    reflectivity distribution function, then
  !
  !       Reflectivity(angle_r, p, angle_in, p) = &
  !             BRDF(angle_r, p, angle_in, p)*cos(angle_in)*w(angle_in)
  !
  !    where w(angle_in) is the quadrature weight.
  !
  !    A SPECIAL CASE
  !    --------------
  !    For a Lambertian surface, if only one angle is given, then
  !
  !        I_r = Reflectivity(1, rp, 1, ip) * I_diff
  !
  !    where I_r is the reflected radiance, constant at all angles, I_diff
  !    is the incident radiance at the diffusivity angle.
  !
  !
  ! 2) Regarding the Direct_Reflectivity(:,:) component,
  !
  !    If I(angle_r, p) is the reflected radiance at the zenith angle with index
  !    angle_r and F_direct(angle_in) is the direct incident irradiance at the surface,
  !    then Direct_Reflectivity(angle_r, p) is defined as
  !
  !      I(angle_r, p) = Direct_Reflectivity(angle_r, p) * cos(angle_in) * F_direct(angle_in)
  !


CONTAINS


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

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_SfcOptics_Associated
!
! PURPOSE:
!       Elemental function to test the status of the allocatable components
!       of a CRTM SfcOptics object.
!
! CALLING SEQUENCE:
!       Status = CRTM_SfcOptics_Associated( SfcOptics )
!
! OBJECTS:
!       SfcOptics:   SfcOptics structure which is to have its member's
!                    status tested.
!                    UNITS:      N/A
!                    TYPE:       CRTM_SfcOptics_type
!                    DIMENSION:  Scalar or any rank
!                    ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:      The return value is a logical value indicating the
!                    status of the SfcOptics members.
!                      .TRUE.  - if the array components are allocated.
!                      .FALSE. - if the array components are not allocated.
!                    UNITS:      N/A
!                    TYPE:       LOGICAL
!                    DIMENSION:  Same as input SfcOptics argument
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_SfcOptics_Associated( self ) RESULT( Status )
    TYPE(CRTM_SfcOptics_type), INTENT(IN) :: self
    LOGICAL :: Status
    Status = self%Is_Allocated
  END FUNCTION CRTM_SfcOptics_Associated


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_SfcOptics_Destroy
!
! PURPOSE:
!       Elemental subroutine to re-initialize CRTM SfcOptics objects.
!
! CALLING SEQUENCE:
!       CALL CRTM_SfcOptics_Destroy( SfcOptics )
!
! OBJECTS:
!       SfcOptics:    Re-initialized SfcOptics structure.
!                     UNITS:      N/A
!                     TYPE:       CRTM_SfcOptics_type
!                     DIMENSION:  Scalar OR any rank
!                     ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE CRTM_SfcOptics_Destroy( self )
    TYPE(CRTM_SfcOptics_type), INTENT(OUT) :: self
    self%Is_Allocated = .FALSE.
  END SUBROUTINE CRTM_SfcOptics_Destroy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_SfcOptics_Create
!
! PURPOSE:
!       Elemental subroutine to create an instance of the CRTM SfcOptics object.
!
! CALLING SEQUENCE:
!       CALL CRTM_SfcOptics_Create( SfcOptics, n_Angles, n_Stokes )
!
! OBJECTS:
!       SfcOptics:    SfcOptics structure.
!                     UNITS:      N/A
!                     TYPE:       CRTM_SfcOptics_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Angles:     Number of angles for which there is SfcOptics data.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Conformable with SfcOptics object
!                     ATTRIBUTES: INTENT(IN)
!
!       n_Stokes:     Number of Stokes components for which there is SfcOptics
!                     data.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Conformable with SfcOptics object
!                     ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE CRTM_SfcOptics_Create( &
    self, &
    n_Angles , &
    n_Stokes   )
    ! Arguments
    TYPE(CRTM_SfcOptics_type), INTENT(OUT) :: self
    INTEGER,                   INTENT(IN)  :: n_Angles
    INTEGER,                   INTENT(IN)  :: n_Stokes
    ! Local variables
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_Angles < 1 .OR. n_Stokes < 1 ) RETURN

    ! Perform the allocation
    ALLOCATE( self%Angle( n_Angles ), &
              self%Weight( n_Angles ), &
              self%Emissivity( n_Angles, n_Stokes ), &
              self%Reflectivity( n_Angles, n_Stokes, n_Angles, n_Stokes), &
              self%Direct_Reflectivity( n_Angles, n_Stokes ), &
              STAT = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN

    ! Initialise
    ! ...Dimensions
    self%n_Angles = n_Angles
    self%n_Stokes = n_Stokes
    ! ...Arrays
    self%Angle               = ZERO
    self%Weight              = ZERO
    self%Emissivity          = ZERO
    self%Reflectivity        = ZERO
    self%Direct_Reflectivity = ZERO

    ! Set allocation indicator
    self%Is_Allocated = .TRUE.

  END SUBROUTINE CRTM_SfcOptics_Create


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_SfcOptics_Zero
!
! PURPOSE:
!       Elemental subroutine to initialise the components of an SfcOptics
!       object to a value of zero.
!
! CALLING SEQUENCE:
!       CALL CRTM_SfcOptics_Zero( SfcOptics )
!
! OBJECTS:
!       SfcOptics:   SfcOptics object which is to have its components
!                    set to a zero value.
!                    UNITS:      N/A
!                    TYPE:       CRTM_SfcOptics_type
!                    DIMENSION:  Scalar or any rank
!                    ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE CRTM_SfcOptics_Zero( self )
    TYPE(CRTM_SfcOptics_type), INTENT(IN OUT) :: self
    self%Azimuth_Angle       = 999.9_fp
    self%Transmittance       = ZERO
    self%Surface_Temperature = ZERO
    IF ( .NOT. CRTM_SfcOptics_Associated( self ) ) RETURN
    self%Emissivity          = ZERO
    self%Reflectivity        = ZERO
    self%Direct_Reflectivity = ZERO
  END SUBROUTINE CRTM_SfcOptics_Zero


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_SfcOptics_Inspect
!
! PURPOSE:
!       Subroutine to print the contents of a CRTM SfcOptics object to stdout.
!
! CALLING SEQUENCE:
!       CALL CRTM_SfcOptics_Inspect( SfcOptics )
!
! INPUTS:
!       SfcOptics:     CRTM SfcOptics object to display.
!                      UNITS:      N/A
!                      TYPE:       CRTM_SfcOptics_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE CRTM_SfcOptics_Inspect( self )
    TYPE(CRTM_SfcOptics_type), INTENT(IN) :: self

    WRITE(*, '(1x,"SfcOptics OBJECT")')
    ! Dimensions
    WRITE(*, '(3x,"n_Angles   :",1x,i0)') self%n_Angles
    WRITE(*, '(3x,"n_Stokes   :",1x,i0)') self%n_Stokes
    ! Display components
    WRITE(*, '(3x,"Compute flag              :",1x,l1)') self%Compute
    WRITE(*, '(3x,"Use_New_MWSSEM flag       :",1x,l1)') self%Use_New_MWSSEM
    WRITE(*, '(3x,"  MWSSEM- azimuth angle   :",1x,es13.6)') self%Azimuth_Angle
    WRITE(*, '(3x,"  MWSSEM- transmittance   :",1x,es13.6)') self%Transmittance
    WRITE(*, '(3x,"Satellite view angle index:",1x,i0)') self%Index_Sat_Ang
    WRITE(*, '(3x,"Azimuth Fourier component :",1x,i0)') self%mth_Azi
    WRITE(*, '(3x,"Weighted mean Tsfc        :",1x,es13.6)') self%Surface_Temperature
    IF ( .NOT. CRTM_SfcOptics_Associated(self) ) RETURN
    WRITE(*, '(3x,"Angle :")')
    WRITE(*, '(5(1x,es13.6,:))') self%Angle
    WRITE(*, '(3x,"Weight :")')
    WRITE(*, '(5(1x,es13.6,:))') self%Weight
    WRITE(*, '(3x,"Emissivity :")')
    WRITE(*, '(5(1x,es13.6,:))') self%Emissivity
    WRITE(*, '(3x,"Reflectivity :")')
    WRITE(*, '(5(1x,es13.6,:))') self%Reflectivity
    WRITE(*, '(3x,"Direct_Reflectivity :")')
    WRITE(*, '(5(1x,es13.6,:))') self%Direct_Reflectivity
  END SUBROUTINE CRTM_SfcOptics_Inspect


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_SfcOptics_DefineVersion
!
! PURPOSE:
!       Subroutine to return the module version information.
!
! CALLING SEQUENCE:
!       CALL CRTM_SfcOptics_DefineVersion( Id )
!
! OUTPUTS:
!       Id:            Character string containing the version Id information
!                      for the module.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE CRTM_SfcOptics_DefineVersion( Id )
    CHARACTER(*), INTENT(OUT) :: Id
    Id = MODULE_VERSION_ID
  END SUBROUTINE CRTM_SfcOptics_DefineVersion


!------------------------------------------------------------------------------
!:sdoc+:
! NAME:
!       CRTM_SfcOptics_Compare
!
! PURPOSE:
!       Elemental function to compare two CRTM_SfcOptics objects to within
!       a user specified number of significant figures.
!
! CALLING SEQUENCE:
!       is_comparable = CRTM_SfcOptics_Compare( x, y, n_SigFig=n_SigFig )
!
! OBJECTS:
!       x, y:          Two CRTM SfcOptics objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       CRTM_SfcOptics_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       n_SigFig:      Number of significant figure to compare floating point
!                      components.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar or same as input
!                      ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       is_equal:      Logical value indicating whether the inputs are equal.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as inputs.
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_SfcOptics_Compare( &
    x, &
    y, &
    n_SigFig ) &
  RESULT( is_comparable )
    TYPE(CRTM_SfcOptics_type), INTENT(IN) :: x, y
    INTEGER,         OPTIONAL, INTENT(IN) :: n_SigFig
    LOGICAL :: is_comparable
    ! Variables
    INTEGER :: n

    ! Set up
    is_comparable = .FALSE.
    IF ( PRESENT(n_SigFig) ) THEN
      n = ABS(n_SigFig)
    ELSE
      n = DEFAULT_N_SIGFIG
    END IF

    ! Check the structure association status
    IF ( (.NOT. CRTM_SfcOptics_Associated(x)) .OR. &
         (.NOT. CRTM_SfcOptics_Associated(y)) ) RETURN

    ! Check dimensions
    IF ( (x%n_Angles /= y%n_Angles) .OR. &
         (x%n_Stokes /= y%n_Stokes) ) RETURN

    ! Check scalars
    ! ...Logicals
    IF ( (x%Compute        .NEQV. y%Compute       ) .OR. &
         (x%Use_New_MWSSEM .NEQV. y%Use_New_MWSSEM) ) RETURN
    ! ...Other types
    IF ( (.NOT. Compares_Within_Tolerance(x%Azimuth_Angle,y%Azimuth_Angle,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Transmittance,y%Transmittance,n)) .OR. &
         (x%Index_Sat_Ang /= y%Index_Sat_Ang) .OR. &
         (x%mth_Azi       /= y%mth_Azi      ) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Surface_Temperature,y%Surface_Temperature,n)) ) RETURN
    
    ! Check arrays
    IF ( (.NOT. ALL(Compares_Within_Tolerance(x%Angle              ,y%Angle              ,n))) .OR. &
         (.NOT. ALL(Compares_Within_Tolerance(x%Weight             ,y%Weight             ,n))) .OR. &
         (.NOT. ALL(Compares_Within_Tolerance(x%Emissivity         ,y%Emissivity         ,n))) .OR. &
         (.NOT. ALL(Compares_Within_Tolerance(x%Reflectivity       ,y%Reflectivity       ,n))) .OR. &
         (.NOT. ALL(Compares_Within_Tolerance(x%Direct_Reflectivity,y%Direct_Reflectivity,n))) ) RETURN

    ! If we get here, the structures are comparable
    is_comparable = .TRUE.

  END FUNCTION CRTM_SfcOptics_Compare


!##################################################################################
!##################################################################################
!##                                                                              ##
!##                          ## PRIVATE MODULE ROUTINES ##                       ##
!##                                                                              ##
!##################################################################################
!##################################################################################

!------------------------------------------------------------------------------
!
! NAME:
!       CRTM_SfcOptics_Equal
!
! PURPOSE:
!       Elemental function to test the equality of two CRTM_SfcOptics objects.
!       Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
!       is_equal = CRTM_SfcOptics_Equal( x, y )
!
!         or
!
!       IF ( x == y ) THEN
!         ...
!       END IF
!
! OBJECTS:
!       x, y:          Two CRTM SfcOptics objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       CRTM_SfcOptics_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       is_equal:      Logical value indicating whether the inputs are equal.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as inputs.
!
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_SfcOptics_Equal( x, y ) RESULT( is_equal )
    TYPE(CRTM_SfcOptics_type), INTENT(IN) :: x, y
    LOGICAL :: is_equal

    ! Set up
    is_equal = .FALSE.

    ! Check the structure association status
    IF ( CRTM_SfcOptics_Associated(x) .NEQV. CRTM_SfcOptics_Associated(y) ) RETURN

    ! Check contents
    ! ...Dimensions
    IF ( (x%n_Angles /= y%n_Angles) .OR. &
         (x%n_Stokes /= y%n_Stokes) ) RETURN
    ! ...Scalars
    IF ( .NOT. ((x%Compute               .EQV.   y%Compute            ) .AND. &
                (x%Use_New_MWSSEM        .EQV.   y%Use_New_MWSSEM     ) .AND. &
                (x%Azimuth_Angle       .EqualTo. y%Azimuth_Angle      ) .AND. &
                (x%Transmittance       .EqualTo. y%Transmittance      ) .AND. &
                (x%Index_Sat_Ang          ==     y%Index_Sat_Ang      ) .AND. &
                (x%mth_Azi                ==     y%mth_Azi            ) .AND. &
                (x%Surface_Temperature .EqualTo. y%Surface_Temperature)) ) RETURN
    ! ...Arrays
    IF ( CRTM_SfcOptics_Associated(x) .AND. CRTM_SfcOptics_Associated(y) ) THEN
      IF ( .NOT. (ALL(x%Angle               .EqualTo. y%Angle              ) .AND. &
                  ALL(x%Weight              .EqualTo. y%Weight             ) .AND. &
                  ALL(x%Emissivity          .EqualTo. y%Emissivity         ) .AND. &
                  ALL(x%Reflectivity        .EqualTo. y%Reflectivity       ) .AND. &
                  ALL(x%Direct_Reflectivity .EqualTo. y%Direct_Reflectivity)) ) RETURN
    END IF


    ! If we get here, then...
    is_equal = .TRUE.

  END FUNCTION CRTM_SfcOptics_Equal

  
!------------------------------------------------------------------------------
!
! NAME:
!       CRTM_SfcOptics_Add
!
! PURPOSE:
!       Pure function to add two CRTM_SfcOptics objects.
!       Used in OPERATOR(+) interface block.
!
! CALLING SEQUENCE:
!       sosum = CRTM_SfcOptics_Add( so1, so2 )
!
!         or
!
!       sosum = so1 + so2
!
! INPUTS:
!       so1, so2:      Two CRTM SfcOptics objects to be added.
!                      UNITS:      N/A
!                      TYPE:       CRTM_SfcOptics_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN OUT)
!
! RESULT:
!       sosum:         SfcOptics object containing the added components.
!                      UNITS:      N/A
!                      TYPE:       CRTM_SfcOptics_type
!                      DIMENSION:  Scalar
!
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_SfcOptics_Add( so1, so2 ) RESULT( sosum )
    TYPE(CRTM_SfcOptics_type), INTENT(IN) :: so1, so2
    TYPE(CRTM_SfcOptics_type) :: sosum

    ! Check the structure association status
    IF ( (.NOT. CRTM_SfcOptics_Associated(so1)) .OR. &
         (.NOT. CRTM_SfcOptics_Associated(so2))      ) RETURN

    ! Check contents
    ! ...Dimensions
    IF ( (so1%n_Angles /= so2%n_Angles) .OR. &
         (so1%n_Stokes /= so2%n_Stokes) ) RETURN

    ! Copy the first structure
    sosum = so1
    
    ! And add its components to the second one
    ! ...The scalar values
    sosum%Transmittance       = sosum%Transmittance       + so2%Transmittance
    sosum%Surface_Temperature = sosum%Surface_Temperature + so2%Surface_Temperature
    ! ...The arrays
    sosum%Reflectivity        = sosum%Reflectivity        + so2%Reflectivity
    sosum%Direct_Reflectivity = sosum%Direct_Reflectivity + so2%Direct_Reflectivity
    sosum%Emissivity          = sosum%Emissivity          + so2%Emissivity    

  END FUNCTION CRTM_SfcOptics_Add


  
!------------------------------------------------------------------------------
!
! NAME:
!       CRTM_SfcOptics_Subtract
!
! PURPOSE:
!       Pure function to subtract two CRTM_SfcOptics objects.
!       Used in OPERATOR(-) interface block.
!
! CALLING SEQUENCE:
!       sodiff = CRTM_SfcOptics_Subtract( so1, so2 )
!
!         or
!
!       sodiff = so1 - so2
!
! INPUTS:
!       so1, so2:      Two CRTM SfcOptics objects to be subtracted.
!                      UNITS:      N/A
!                      TYPE:       CRTM_SfcOptics_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN OUT)
!
! RESULT:
!       sodiff:        SfcOptics object containing the differenced components.
!                      UNITS:      N/A
!                      TYPE:       CRTM_SfcOptics_type
!                      DIMENSION:  Scalar
!
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_SfcOptics_Subtract( so1, so2 ) RESULT( sodiff )
    TYPE(CRTM_SfcOptics_type), INTENT(IN) :: so1, so2
    TYPE(CRTM_SfcOptics_type) :: sodiff

    ! Check the structure association status
    IF ( (.NOT. CRTM_SfcOptics_Associated(so1)) .OR. &
         (.NOT. CRTM_SfcOptics_Associated(so2))      ) RETURN

    ! Check contents
    ! ...Dimensions
    IF ( (so1%n_Angles /= so2%n_Angles) .OR. &
         (so1%n_Stokes /= so2%n_Stokes) ) RETURN

    ! Copy the first structure
    sodiff = so1
    
    ! And subtract the second one from it
    ! ...The scalar values
    sodiff%Transmittance       = sodiff%Transmittance       - so2%Transmittance
    sodiff%Surface_Temperature = sodiff%Surface_Temperature - so2%Surface_Temperature
    ! ...The arrays
    sodiff%Reflectivity        = sodiff%Reflectivity        - so2%Reflectivity
    sodiff%Direct_Reflectivity = sodiff%Direct_Reflectivity - so2%Direct_Reflectivity
    sodiff%Emissivity          = sodiff%Emissivity          - so2%Emissivity    

  END FUNCTION CRTM_SfcOptics_Subtract

END MODULE CRTM_SfcOptics_Define