SpcCoeff_Define.f90

Go to the documentation of this file.

!
! SpcCoeff_Define
!
! Module defining the SpcCoeff data structure and routines
! to manipulate them.
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 18-Mar-2002
!                       paul.vandelst@noaa.gov
!

MODULE spccoeff_define

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds,            ONLY: long, double
  USE message_handler      , ONLY: success, failure, information, display_message
  USE compare_float_numbers, ONLY: OPERATOR(.equalto.)
  USE subset_define        , ONLY: subset_type      , &
                                   subset_associated, &
                                   subset_getvalue  , &
                                   subset_generate
  USE sensorinfo_parameters, ONLY: invalid_wmo_satellite_id, &
                                   invalid_wmo_sensor_id   , &
                                   n_sensor_types          , &
                                   invalid_sensor          , &
                                   microwave_sensor        , &
                                   infrared_sensor         , &
                                   visible_sensor          , &
                                   ultraviolet_sensor      , &
                                   sensor_type_name        , &
                                   n_polarization_types    , &
                                   invalid_polarization    , &
                                   unpolarized             , &
                                   intensity               , &
                                   first_stokes_component  , &
                                   second_stokes_component , &
                                   third_stokes_component  , &
                                   fourth_stokes_component , &
                                   vl_polarization         , &
                                   hl_polarization         , &
                                   plus45l_polarization    , &
                                   minus45l_polarization   , &
                                   vl_mixed_polarization   , &
                                   hl_mixed_polarization   , &
                                   rc_polarization         , &
                                   lc_polarization         , &
                                   polarization_type_name
  USE accoeff_define       , ONLY: accoeff_type          , &
                                   OPERATOR(==)          , &
                                   accoeff_associated    , &
                                   accoeff_destroy       , &
                                   accoeff_create        , &
                                   accoeff_inspect       , &
                                   accoeff_validrelease  , &
                                   accoeff_info          , &
                                   accoeff_defineversion , &
                                   accoeff_subset        , &
                                   accoeff_concat        , &
                                   accoeff_channelreindex
  USE nltecoeff_define     , ONLY: nltecoeff_type          , &
                                   OPERATOR(==)            , &
                                   nltecoeff_associated    , &
                                   nltecoeff_destroy       , &
                                   nltecoeff_create        , &
                                   nltecoeff_inspect       , &
                                   nltecoeff_validrelease  , &
                                   nltecoeff_info          , &
                                   nltecoeff_defineversion , &
                                   nltecoeff_subset        , &
                                   nltecoeff_concat        , &
                                   nltecoeff_channelreindex
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Datatypes
  PUBLIC :: spccoeff_type
  ! Operators
  PUBLIC :: OPERATOR(==)
  ! Procedures
  PUBLIC :: spccoeff_associated
  PUBLIC :: spccoeff_destroy
  PUBLIC :: spccoeff_create
  PUBLIC :: spccoeff_inspect
  PUBLIC :: spccoeff_validrelease
  PUBLIC :: spccoeff_info
  PUBLIC :: spccoeff_defineversion
  PUBLIC :: spccoeff_subset
  PUBLIC :: spccoeff_concat
  ! ...Channel flag specific procedures
  PUBLIC :: spccoeff_clearallflags
  PUBLIC :: spccoeff_issolar , spccoeff_setsolar , spccoeff_clearsolar
  PUBLIC :: spccoeff_iszeeman, spccoeff_setzeeman, spccoeff_clearzeeman
  ! ...Sensor specific procedures
  PUBLIC :: spccoeff_ismicrowavesensor  , spccoeff_setmicrowavesensor
  PUBLIC :: spccoeff_isinfraredsensor   , spccoeff_setinfraredsensor
  PUBLIC :: spccoeff_isvisiblesensor    , spccoeff_setvisiblesensor
  PUBLIC :: spccoeff_isultravioletsensor, spccoeff_setultravioletsensor
  ! ...Inherited procedures
  PUBLIC :: accoeff_associated
  PUBLIC :: accoeff_destroy
  PUBLIC :: accoeff_create
  PUBLIC :: accoeff_inspect
  PUBLIC :: accoeff_validrelease
  PUBLIC :: accoeff_info
  PUBLIC :: accoeff_defineversion
  PUBLIC :: nltecoeff_associated    
  PUBLIC :: nltecoeff_destroy       
  PUBLIC :: nltecoeff_create        
  PUBLIC :: nltecoeff_inspect       
  PUBLIC :: nltecoeff_validrelease  
  PUBLIC :: nltecoeff_info          
  PUBLIC :: nltecoeff_defineversion


  ! ---------------------
  ! Procedure overloading
  ! ---------------------
  INTERFACE OPERATOR(==)
    MODULE PROCEDURE spccoeff_equal
  END INTERFACE OPERATOR(==)


  ! -----------------
  ! Module parameters
  ! -----------------
  ! Version Id for the module
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: SpcCoeff_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Literal constants
  REAL(Double), PARAMETER :: zero = 0.0_double
  ! Default message string length
  INTEGER, PARAMETER :: ml = 512
  ! Sensor id string length
  INTEGER, PARAMETER :: sl = 20
  ! Current valid release and version numbers
  INTEGER, PARAMETER :: spccoeff_release = 8  ! This determines structure and file formats.
  INTEGER, PARAMETER :: spccoeff_version = 1  ! This is just the data version.
  ! The bit positions for the various channel flags
  INTEGER, PARAMETER :: solar_flag  = 0
  INTEGER, PARAMETER :: zeeman_flag = 1
  


  ! -----------------------------
  ! SpcCoeff data type definition
  ! -----------------------------
  TYPE :: spccoeff_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! Release and version information
    INTEGER(Long) :: release = spccoeff_release
    INTEGER(Long) :: version = spccoeff_version
    ! Dimensions
    INTEGER(Long) :: n_channels = 0  ! L dimension
    ! Sensor info
    CHARACTER(SL) :: sensor_id        = ''
    INTEGER(Long) :: sensor_type      = invalid_sensor
    INTEGER(Long) :: wmo_satellite_id = invalid_wmo_satellite_id
    INTEGER(Long) :: wmo_sensor_id    = invalid_wmo_sensor_id
    ! Channel data arrays
    INTEGER(Long), ALLOCATABLE :: sensor_channel(:)              ! L
    INTEGER(Long), ALLOCATABLE :: polarization(:)                ! L
    INTEGER(Long), ALLOCATABLE :: channel_flag(:)                ! L
    REAL(Double) , ALLOCATABLE :: frequency(:)                   ! L
    REAL(Double) , ALLOCATABLE :: wavenumber(:)                  ! L
    REAL(Double) , ALLOCATABLE :: planck_c1(:)                   ! L
    REAL(Double) , ALLOCATABLE :: planck_c2(:)                   ! L
    REAL(Double) , ALLOCATABLE :: band_c1(:)                     ! L
    REAL(Double) , ALLOCATABLE :: band_c2(:)                     ! L
    REAL(Double) , ALLOCATABLE :: cosmic_background_radiance(:)  ! L
    REAL(Double) , ALLOCATABLE :: solar_irradiance(:)            ! L
    ! Derived type components
    TYPE(accoeff_type)   :: ac  ! Antenna correction coefficients
    TYPE(nltecoeff_type) :: nc  ! non-LTE correction coefficients
  END TYPE spccoeff_type


CONTAINS


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

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

  ELEMENTAL FUNCTION spccoeff_associated( SpcCoeff ) RESULT( Status )
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    LOGICAL :: status
    status = spccoeff%Is_Allocated
  END FUNCTION spccoeff_associated


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_Destroy
! 
! PURPOSE:
!       Elemental subroutine to re-initialize SpcCoeff objects.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_Destroy( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Re-initialized SpcCoeff structure.
!                     UNITS:      N/A
!                     TYPE:       SpcCoeff_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_destroy( SpcCoeff )
    TYPE(spccoeff_type), INTENT(OUT) :: spccoeff
    spccoeff%Is_Allocated = .false.
    spccoeff%n_Channels        = 0
    spccoeff%Sensor_Id         = ''
    spccoeff%WMO_Satellite_ID  = invalid_wmo_satellite_id
    spccoeff%WMO_Sensor_ID     = invalid_wmo_sensor_id
    spccoeff%Sensor_Type       = invalid_sensor
  END SUBROUTINE spccoeff_destroy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_Create
! 
! PURPOSE:
!       Elemental subroutine to create an instance of an SpcCoeff object.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_Create( SpcCoeff  , &
!                             n_Channels  )         
!
! OBJECTS:
!       SpcCoeff:           SpcCoeff object structure.
!                           UNITS:      N/A
!                           TYPE:       SpcCoeff_type
!                           DIMENSION:  Scalar or any rank
!                           ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Channels:         Number of sensor channels.
!                           Must be > 0.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_create( &
    SpcCoeff  , &  ! Output
    n_Channels  )  ! Input
    ! Arguments
    TYPE(spccoeff_type), INTENT(OUT) :: spccoeff
    INTEGER            , INTENT(IN)  :: n_channels
    ! Local variables
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_channels < 1 ) RETURN
    
    ! Perform the allocation
    ALLOCATE( spccoeff%Sensor_Channel( n_channels ),             &
              spccoeff%Polarization( n_channels ),               &
              spccoeff%Channel_Flag( n_channels ),               &
              spccoeff%Frequency( n_channels ),                  &
              spccoeff%Wavenumber( n_channels ),                 &
              spccoeff%Planck_C1( n_channels ),                  &
              spccoeff%Planck_C2( n_channels ),                  &
              spccoeff%Band_C1( n_channels ),                    &
              spccoeff%Band_C2( n_channels ),                    &
              spccoeff%Cosmic_Background_Radiance( n_channels ), &
              spccoeff%Solar_Irradiance( n_channels ),           &
              stat = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN


    ! Initialise
    ! ...Dimensions
    spccoeff%n_Channels = n_channels
    ! ...Arrays
    spccoeff%Sensor_Channel             = 0
    spccoeff%Polarization               = invalid_polarization
    spccoeff%Channel_Flag               = 0
    spccoeff%Frequency                  = zero
    spccoeff%Wavenumber                 = zero
    spccoeff%Planck_C1                  = zero
    spccoeff%Planck_C2                  = zero
    spccoeff%Band_C1                    = zero
    spccoeff%Band_C2                    = zero
    spccoeff%Cosmic_Background_Radiance = zero
    spccoeff%Solar_Irradiance           = zero


    ! Set allocation indicator
    spccoeff%Is_Allocated = .true.

  END SUBROUTINE spccoeff_create


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_Inspect
!
! PURPOSE:
!       Subroutine to print the contents of a SpcCoeff object to stdout.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_Inspect( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      SpcCoeff object to display.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE spccoeff_inspect( SpcCoeff )
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    INTEGER :: n
    WRITE(*,'(1x,"SpcCoeff OBJECT")')
    ! Release/version info
    WRITE(*,'(3x,"Release.Version  :",1x,i0,".",i0)') spccoeff%Release, spccoeff%Version
    ! Dimensions
    WRITE(*,'(3x,"n_Channels       :",1x,i0)') spccoeff%n_Channels
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    ! Sensor info
    WRITE(*,'(3x,"Sensor_Id        :",1x,a )') trim(spccoeff%Sensor_Id)
    WRITE(*,'(3x,"WMO_Satellite_ID :",1x,i0)') spccoeff%WMO_Satellite_ID 
    WRITE(*,'(3x,"WMO_Sensor_ID    :",1x,i0)') spccoeff%WMO_Sensor_ID
    WRITE(*,'(3x,"Sensor_Type      :",1x,a )') trim(sensor_type_name(spccoeff%Sensor_Type))
    WRITE(*,'(3x,"Sensor_Channel   :")')
    WRITE(*,'(10(1x,i5,:))') spccoeff%Sensor_Channel
    ! Data arrays
    IF ( spccoeff_ismicrowavesensor(spccoeff) ) THEN
      WRITE(*,'(3x,"Polarization               :")')
      DO n = 1, spccoeff%n_Channels
        WRITE(*,'(5x,"Channel ",i0,": ",a)') spccoeff%Sensor_Channel(n), &
                                             polarization_type_name(spccoeff%Polarization(n))
      END DO
    END IF
    WRITE(*,'(3x,"Channel_Flag               :")')
    WRITE(*,'(3(1x,b32.32,:))') spccoeff%Channel_Flag
    WRITE(*,'(3x,"Frequency                  :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Frequency                 
    WRITE(*,'(3x,"Wavenumber                 :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Wavenumber                
    WRITE(*,'(3x,"Planck_C1                  :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Planck_C1                 
    WRITE(*,'(3x,"Planck_C2                  :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Planck_C2                 
    WRITE(*,'(3x,"Band_C1                    :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Band_C1                   
    WRITE(*,'(3x,"Band_C2                    :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Band_C2                   
    WRITE(*,'(3x,"Cosmic_Background_Radiance :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Cosmic_Background_Radiance
    WRITE(*,'(3x,"Solar_Irradiance           :")')
    WRITE(*,'(5(1x,es13.6,:))') spccoeff%Solar_Irradiance          
    ! Derived types
    IF ( accoeff_associated(   spccoeff%AC ) ) CALL accoeff_inspect(   spccoeff%AC )
    IF ( nltecoeff_associated( spccoeff%NC ) ) CALL nltecoeff_inspect( spccoeff%NC )
          
  END SUBROUTINE spccoeff_inspect
  

!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_ValidRelease
!
! PURPOSE:
!       Function to check the SpcCoeff Release value.
!
! CALLING SEQUENCE:
!       IsValid = SpcCoeff_ValidRelease( SpcCoeff )
!
! INPUTS:
!       SpcCoeff:      SpcCoeff object for which the Release component
!                      is to be checked.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       IsValid:       Logical value defining the release validity.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Scalar
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION spccoeff_validrelease( SpcCoeff ) RESULT( IsValid )
    ! Arguments
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    ! Function result
    LOGICAL :: isvalid
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'SpcCoeff_ValidRelease'
    ! Local variables
    CHARACTER(ML) :: msg

    ! Set up
    isvalid = .true.


    ! Check release is not too old
    IF ( spccoeff%Release < spccoeff_release ) THEN
      isvalid = .false.
      WRITE( msg,'("An SpcCoeff data update is needed. ", &
                  &"SpcCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
                  spccoeff%Release, spccoeff_release
      CALL display_message( routine_name, msg, information )
      RETURN
    END IF


    ! Check release is not too new
    IF ( spccoeff%Release > spccoeff_release ) THEN
      isvalid = .false.
      WRITE( msg,'("An SpcCoeff software update is needed. ", &
                  &"SpcCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
                  spccoeff%Release, spccoeff_release
      CALL display_message( routine_name, msg, information )
      RETURN
    END IF

  END FUNCTION spccoeff_validrelease


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_Info
!
! PURPOSE:
!       Subroutine to return a string containing version and dimension
!       information about a SpcCoeff object.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_Info( SpcCoeff, Info, NoComponents=NoComponents )
!
! OBJECTS:
!       SpcCoeff:      SpcCoeff object about which info is required.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       Info:          String containing version and dimension information
!                      about the SpcCoeff object.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUTS:
!       NoComponents:  Set this logical argument to not include the version
!                      and dimension information of structure components.
!                      If .FALSE. the substructure information is included [DEFAULT]
!                         .TRUE.  the substructure information is NOT included
!                      If not specfied the default is .FALSE.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE spccoeff_info( &
    SpcCoeff    , &  ! Input
    Info        , &  ! Output
    NoComponents  )  ! Optional input
    ! Arguments
    TYPE(spccoeff_type), INTENT(IN)  :: spccoeff
    CHARACTER(*),        INTENT(OUT) :: info
    LOGICAL,   OPTIONAL, INTENT(IN)  :: nocomponents
    ! Parameters
    INTEGER, PARAMETER :: carriage_return = 13
    INTEGER, PARAMETER :: linefeed = 10
    ! Local variables
    LOGICAL :: includecomponents
    CHARACTER(5000) :: long_string
    CHARACTER(2000) :: ac_info, nc_info

    ! Setup
    includecomponents = .true.
    IF ( PRESENT(nocomponents) ) includecomponents = .NOT. nocomponents
    
    ! Write the required data to the local string
    WRITE( long_string, &
           '(a,1x,"SpcCoeff RELEASE.VERSION: ",i2,".",i2.2,a,3x, &
           &"N_CHANNELS=",i0 )' ) &
           achar(carriage_return)//achar(linefeed), &
           spccoeff%Release, spccoeff%Version, &
           achar(carriage_return)//achar(linefeed), &
           spccoeff%n_Channels

    ! Add derived type info strings
    IF ( includecomponents ) THEN
      ! ...Antenna correction structure
      IF ( accoeff_associated( spccoeff%AC ) ) THEN
        CALL accoeff_info( spccoeff%AC, ac_info )
        long_string = trim(long_string)//trim(ac_info)
      END IF
      ! ...non-LTE correction structure
      IF ( nltecoeff_associated( spccoeff%NC ) ) THEN
        CALL nltecoeff_info( spccoeff%NC, nc_info )
        long_string = trim(long_string)//trim(nc_info)
      END IF
    END IF
    
    ! Trim the output based on the
    ! dummy argument string length
    info = long_string(1:min(len(info), len_trim(long_string)))

  END SUBROUTINE spccoeff_info


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_DefineVersion
!
! PURPOSE:
!       Subroutine to return the version information for the
!       definition module(s).
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_DefineVersion( Id )
!
! OUTPUTS:
!       Id:     Character string containing the version Id information for the
!               structure definition module(s). If the string length is
!               sufficient, the version information for all the modules (this,
!               and those for the derived type components) are concatenated.
!               Otherwise only the version id for this module is returned.
!               UNITS:      N/A
!               TYPE:       CHARACTER(*)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE spccoeff_defineversion( Id )
    CHARACTER(*), INTENT(OUT) :: id
    INTEGER, PARAMETER :: carriage_return = 13
    INTEGER, PARAMETER :: linefeed = 10
    INTEGER, PARAMETER :: sl = 256
    CHARACTER(SL)   :: ac_id
    CHARACTER(SL)   :: nc_id
    CHARACTER(SL*3) :: define_id
    CALL accoeff_defineversion( ac_id )
    CALL nltecoeff_defineversion( nc_id )
    define_id = module_version_id//';'//achar(carriage_return)//achar(linefeed)//&
                '  '//trim(ac_id)//';'//achar(carriage_return)//achar(linefeed)//&
                '  '//trim(nc_id)
    IF ( len_trim(define_id) <= len(id) ) THEN
      id = define_id
    ELSE
      id = module_version_id
    END IF
  END SUBROUTINE spccoeff_defineversion


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_Subset
!
! PURPOSE:
!       Subroutine to return a channel subset of the input SpcCoeff object.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_Subset( SpcCoeff, Subset, SC_Subset )
!
! OBJECTS:
!       SpcCoeff:     SpcCoeff object which is to be subsetted.
!                     UNITS:      N/A
!                     TYPE:       SpcCoeff_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
! INPUTS:
!       Subset:       Subset object containing the list of indices
!                     corresponding the channels to be extracted.
!                     UNITS:      N/A
!                     TYPE:       Subset_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       SC_Subset:    SpcCoeff object containing the requested channel subset
!                     of the input SpcCoeff data.
!                     UNITS:      N/A
!                     TYPE:       SpcCoeff_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE spccoeff_subset( &
    SpcCoeff      , &  ! Input
    Sensor_Channel, &  ! Input
    SC_Subset       )  ! Output
    ! Arguments
    TYPE(spccoeff_type), INTENT(IN)  :: spccoeff
    INTEGER            , INTENT(IN)  :: sensor_channel(:)
    TYPE(spccoeff_type), INTENT(OUT) :: sc_subset
    ! Local variables
    TYPE(subset_type) :: subset
    INTEGER :: n_subset_channels
    INTEGER, ALLOCATABLE :: idx(:)
    
    ! Check input is valid
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    
    ! Generate the subset list
    CALL subset_generate( &
           subset, &
           spccoeff%Sensor_Channel, &
           sensor_channel )
    IF ( .NOT. subset_associated( subset ) ) RETURN
    
    
    ! Allocate the output subset SpcCoeff object
    CALL subset_getvalue( subset, n_values = n_subset_channels, index = idx )
    CALL spccoeff_create( sc_subset, n_subset_channels )
    IF ( .NOT. spccoeff_associated(sc_subset) ) RETURN


    ! Extract out the subset channels
    ! ...First assign some scalars
    sc_subset%Version          = spccoeff%Version
    sc_subset%Sensor_Id        = spccoeff%Sensor_Id       
    sc_subset%Sensor_Type      = spccoeff%Sensor_Type     
    sc_subset%WMO_Satellite_ID = spccoeff%WMO_Satellite_ID
    sc_subset%WMO_Sensor_ID    = spccoeff%WMO_Sensor_ID   
    ! ...and now extract the subset
    sc_subset%Sensor_Channel             = spccoeff%Sensor_Channel(idx)
    sc_subset%Polarization               = spccoeff%Polarization(idx)
    sc_subset%Channel_Flag               = spccoeff%Channel_Flag(idx)
    sc_subset%Frequency                  = spccoeff%Frequency(idx)
    sc_subset%Wavenumber                 = spccoeff%Wavenumber(idx)
    sc_subset%Planck_C1                  = spccoeff%Planck_C1(idx)
    sc_subset%Planck_C2                  = spccoeff%Planck_C2(idx)
    sc_subset%Band_C1                    = spccoeff%Band_C1(idx)
    sc_subset%Band_C2                    = spccoeff%Band_C2(idx)
    sc_subset%Cosmic_Background_Radiance = spccoeff%Cosmic_Background_Radiance(idx)
    sc_subset%Solar_Irradiance           = spccoeff%Solar_Irradiance(idx)


    ! Operate on the components
    ! ...Antenna correction coefficients
    IF ( accoeff_associated( spccoeff%AC ) ) &
      CALL accoeff_subset( spccoeff%AC, sensor_channel, sc_subset%AC )
    ! ...NLTE correction coefficients
    IF ( nltecoeff_associated( spccoeff%NC ) ) &
      CALL nltecoeff_subset( spccoeff%NC, sensor_channel, sc_subset%NC )

  END SUBROUTINE spccoeff_subset


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_Concat
!
! PURPOSE:
!       Subroutine to concatenate multiple SpcCoeff objects along the channel
!       dimension into a single SpcCoeff object.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_Concat( SpcCoeff, SC_Array, Sensor_Id=Sensor_Id )
!
! OBJECTS:
!       SpcCoeff:     SpcCoeff object containing the concatenated result.
!                     UNITS:      N/A
!                     TYPE:       SpcCoeff_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       SC_Array:     Array of SpcCoeff objects to be concatenated.
!                     UNITS:      N/A
!                     TYPE:       SpcCoeff_type
!                     DIMENSION:  Rank-1
!                     ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       Sensor_Id:    Sensor id character to string to use for the concatenated
!                     result. If not specified, the sensor id of the first valid
!                     element of SC_Array is used.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE spccoeff_concat( &
    SpcCoeff , &  ! Output
    SC_Array , &  ! Input
    Sensor_Id  )  ! Optional input
    ! Arguments
    TYPE(spccoeff_type)   , INTENT(OUT) :: spccoeff
    TYPE(spccoeff_type)   , INTENT(IN)  :: sc_array(:)
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: sensor_id
    ! Local variables
    INTEGER, ALLOCATABLE :: valid_index(:)
    INTEGER :: i, j, n_sc, n_valid, n_channels
    INTEGER :: ch1, ch2
    
    ! Set up
    ! ...Check input is valid
    n_sc = SIZE(sc_array)
    IF ( n_sc < 1 ) RETURN          ! Zero-sized array
    ! ...Count valid input
    n_valid = count(spccoeff_associated(sc_array))
    IF ( n_valid == 0 ) RETURN      ! All elements unallocated
    ! ...Index the valid input
    ALLOCATE( valid_index(n_valid) )
    valid_index = pack( (/(i,i=1,n_sc)/), mask=spccoeff_associated(sc_array) )
    ! ...Check non-channel dimensions and ids
    DO j = 1, n_valid
      i = valid_index(j)
      IF ( sc_array(i)%Sensor_Type      /= sc_array(valid_index(1))%Sensor_Type      .OR. & 
           sc_array(i)%WMO_Satellite_ID /= sc_array(valid_index(1))%WMO_Satellite_ID .OR. &
           sc_array(i)%WMO_Sensor_ID    /= sc_array(valid_index(1))%WMO_Sensor_ID         ) THEN
        RETURN
      END IF
    END DO


    ! Sum channel dimensions
    n_channels = sum(sc_array%n_Channels)
    
    
    ! Allocate the output concatenated SpcCoeff object
    CALL spccoeff_create( spccoeff, n_channels )
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN


    ! Concatenate the channel data
    ! ...First assign the non-channel dependent data
    spccoeff%Version = sc_array(valid_index(1))%Version
    IF ( PRESENT(sensor_id) ) THEN
      spccoeff%Sensor_Id = adjustl(sensor_id)
    ELSE
      spccoeff%Sensor_Id = sc_array(valid_index(1))%Sensor_Id
    END IF
    spccoeff%Sensor_Type      = sc_array(valid_index(1))%Sensor_Type     
    spccoeff%WMO_Satellite_ID = sc_array(valid_index(1))%WMO_Satellite_ID
    spccoeff%WMO_Sensor_ID    = sc_array(valid_index(1))%WMO_Sensor_ID   
    ! ...and now concatenate the channel data
    ch1 = 1
    DO j = 1, n_valid
      i = valid_index(j)
      
      ch2 = ch1 + sc_array(i)%n_Channels - 1
      
      spccoeff%Sensor_Channel(ch1:ch2)             = sc_array(i)%Sensor_Channel            
      spccoeff%Polarization(ch1:ch2)               = sc_array(i)%Polarization 
      spccoeff%Channel_Flag(ch1:ch2)               = sc_array(i)%Channel_Flag 
      spccoeff%Frequency(ch1:ch2)                  = sc_array(i)%Frequency    
      spccoeff%Wavenumber(ch1:ch2)                 = sc_array(i)%Wavenumber   
      spccoeff%Planck_C1(ch1:ch2)                  = sc_array(i)%Planck_C1    
      spccoeff%Planck_C2(ch1:ch2)                  = sc_array(i)%Planck_C2    
      spccoeff%Band_C1(ch1:ch2)                    = sc_array(i)%Band_C1      
      spccoeff%Band_C2(ch1:ch2)                    = sc_array(i)%Band_C2      
      spccoeff%Cosmic_Background_Radiance(ch1:ch2) = sc_array(i)%Cosmic_Background_Radiance
      spccoeff%Solar_Irradiance(ch1:ch2)           = sc_array(i)%Solar_Irradiance          
      
      ch1 = ch2 + 1
    END DO


    ! Operate on the components
    ! ...Antenna correction coefficients
    CALL accoeff_concat( spccoeff%AC, sc_array%AC, sensor_id = sensor_id )
    CALL accoeff_channelreindex( spccoeff%AC, spccoeff%Sensor_Channel )
    ! ...NLTE correction coefficients
    CALL nltecoeff_concat( spccoeff%NC, sc_array%NC, sensor_id = sensor_id )
    CALL nltecoeff_channelreindex( spccoeff%NC, spccoeff%Sensor_Channel )


    ! Cleanup
    DEALLOCATE( valid_index )

  END SUBROUTINE spccoeff_concat


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_ClearAllFlags
!
! PURPOSE:
!       Elemental subroutine to clear ALL SpcCoeff channel flags.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_ClearAllFlags( SpcCoeff, ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object for which all the
!                      flags are to be cleared.
!                      If not specified, all the channels cleared.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_clearallflags( SpcCoeff, ChannelIndex )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER,   OPTIONAL, INTENT(IN)     :: channelindex
    INTEGER :: n
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    DO n = 0, bit_size(0_long)
      CALL spccoeff_clearflag( spccoeff, n, channelindex=channelindex )
    END DO
  END SUBROUTINE spccoeff_clearallflags
  

!--------------------------------------------------------------------------------
!--------------------------------------------------------------------------------
! NOTE: The following flag check, set, and clear procedures were generated
!       automatically using the
!         gen_flag_procedures.rb
!       script. Modify at your own risk!
!--------------------------------------------------------------------------------
!--------------------------------------------------------------------------------

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_IsSolar
!
! PURPOSE:
!       Elemental function to test if SpcCoeff channels are flagged as being
!       solar sensitive.
!
! CALLING SEQUENCE:
!       Status = SpcCoeff_IsSolar( SpcCoeff, ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be tested.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object to test if it is a
!                      solar sensitive channel.
!                      If not specified, all the channels are tested.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value.
!                       .TRUE.  - The channel(s) is(are) solar sensitive.
!                       .FALSE. - The channel(s) is(are) NOT solar sensitive.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as SpcCoeff input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION spccoeff_issolar(SpcCoeff, ChannelIndex) RESULT(Is_Set)
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    INTEGER,   OPTIONAL, INTENT(IN) :: channelindex
    LOGICAL :: is_set
    is_set = .false.
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    is_set = spccoeff_isflagset(spccoeff, solar_flag, channelindex=channelindex)
  END FUNCTION spccoeff_issolar
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_IsZeeman
!
! PURPOSE:
!       Elemental function to test if SpcCoeff channels are flagged as being
!       Zeeman affected.
!
! CALLING SEQUENCE:
!       Status = SpcCoeff_IsZeeman( SpcCoeff, ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be tested.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object to test if it is a
!                      Zeeman affected channel.
!                      If not specified, all the channels are tested.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value.
!                       .TRUE.  - The channel(s) is(are) Zeeman affected.
!                       .FALSE. - The channel(s) is(are) NOT Zeeman affected.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as SpcCoeff input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION spccoeff_iszeeman(SpcCoeff, ChannelIndex) RESULT(Is_Set)
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    INTEGER,   OPTIONAL, INTENT(IN) :: channelindex
    LOGICAL :: is_set
    is_set = .false.
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    is_set = spccoeff_isflagset(spccoeff, zeeman_flag, channelindex=channelindex)
  END FUNCTION spccoeff_iszeeman
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_SetSolar
!
! PURPOSE:
!       Elemental subroutine to flag a SpcCoeff channel as solar sensitive.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_SetSolar( SpcCoeff, ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object to flag as a
!                      solar sensitive channel.
!                      If not specified, all the channels are flagged.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_setsolar( SpcCoeff, ChannelIndex )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER,   OPTIONAL, INTENT(IN)     :: channelindex
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    CALL spccoeff_setflag(spccoeff, solar_flag, channelindex=channelindex)
  END SUBROUTINE spccoeff_setsolar
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_SetZeeman
!
! PURPOSE:
!       Elemental subroutine to flag a SpcCoeff channel as Zeeman affected.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_SetZeeman( SpcCoeff, ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object to flag as a
!                      Zeeman affected channel.
!                      If not specified, all the channels are flagged.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_setzeeman( SpcCoeff, ChannelIndex )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER,   OPTIONAL, INTENT(IN)     :: channelindex
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    CALL spccoeff_setflag(spccoeff, zeeman_flag, channelindex=channelindex)
  END SUBROUTINE spccoeff_setzeeman
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_ClearSolar
!
! PURPOSE:
!       Elemental subroutine to flag a SpcCoeff channel as NOT being
!       solar sensitive.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_ClearSolar( SpcCoeff, ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object to indicate as being
!                      NOT solar sensitive.
!                      If not specified, all the channels cleared.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_clearsolar( SpcCoeff, ChannelIndex )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER,   OPTIONAL, INTENT(IN)     :: channelindex
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    CALL spccoeff_clearflag( spccoeff, solar_flag, channelindex=channelindex )
  END SUBROUTINE spccoeff_clearsolar
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_ClearZeeman
!
! PURPOSE:
!       Elemental subroutine to flag a SpcCoeff channel as NOT being
!       Zeeman affected.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_ClearZeeman( SpcCoeff, ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object to indicate as being
!                      NOT Zeeman affected.
!                      If not specified, all the channels cleared.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_clearzeeman( SpcCoeff, ChannelIndex )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER,   OPTIONAL, INTENT(IN)     :: channelindex
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    CALL spccoeff_clearflag( spccoeff, zeeman_flag, channelindex=channelindex )
  END SUBROUTINE spccoeff_clearzeeman
  
  


!--------------------------------------------------------------------------------
!--------------------------------------------------------------------------------
! NOTE: The following sensor check and set procedures were generated
!       automatically using the
!         gen_sensor_procedures.rb
!       script. Modify at your own risk!
!--------------------------------------------------------------------------------
!--------------------------------------------------------------------------------

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_IsMicrowaveSensor
!
! PURPOSE:
!       Elemental function to test if the SpcCoeff object is for
!       a microwave sensor.
!
! CALLING SEQUENCE:
!       Status = SpcCoeff_IsMicrowaveSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be tested.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value.
!                       .TRUE.  - The sensor is a microwave instrument.
!                       .FALSE. - The sensor is NOT a microwave instrument.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as SpcCoeff input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION spccoeff_ismicrowavesensor(SpcCoeff) RESULT(Is_Set)
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    LOGICAL :: is_set
    is_set = spccoeff_issensor(spccoeff, microwave_sensor)
  END FUNCTION spccoeff_ismicrowavesensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_IsInfraredSensor
!
! PURPOSE:
!       Elemental function to test if the SpcCoeff object is for
!       an infrared sensor.
!
! CALLING SEQUENCE:
!       Status = SpcCoeff_IsInfraredSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be tested.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value.
!                       .TRUE.  - The sensor is an infrared instrument.
!                       .FALSE. - The sensor is NOT an infrared instrument.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as SpcCoeff input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION spccoeff_isinfraredsensor(SpcCoeff) RESULT(Is_Set)
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    LOGICAL :: is_set
    is_set = spccoeff_issensor(spccoeff, infrared_sensor)
  END FUNCTION spccoeff_isinfraredsensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_IsVisibleSensor
!
! PURPOSE:
!       Elemental function to test if the SpcCoeff object is for
!       a visible sensor.
!
! CALLING SEQUENCE:
!       Status = SpcCoeff_IsVisibleSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be tested.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value.
!                       .TRUE.  - The sensor is a visible instrument.
!                       .FALSE. - The sensor is NOT a visible instrument.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as SpcCoeff input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION spccoeff_isvisiblesensor(SpcCoeff) RESULT(Is_Set)
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    LOGICAL :: is_set
    is_set = spccoeff_issensor(spccoeff, visible_sensor)
  END FUNCTION spccoeff_isvisiblesensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_IsUltravioletSensor
!
! PURPOSE:
!       Elemental function to test if the SpcCoeff object is for
!       an ultraviolet sensor.
!
! CALLING SEQUENCE:
!       Status = SpcCoeff_IsUltravioletSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be tested.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value.
!                       .TRUE.  - The sensor is an ultraviolet instrument.
!                       .FALSE. - The sensor is NOT an ultraviolet instrument.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as SpcCoeff input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION spccoeff_isultravioletsensor(SpcCoeff) RESULT(Is_Set)
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    LOGICAL :: is_set
    is_set = spccoeff_issensor(spccoeff, ultraviolet_sensor)
  END FUNCTION spccoeff_isultravioletsensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_SetMicrowaveSensor
!
! PURPOSE:
!       Elemental subroutine to set a SpcCoeff object as being
!       for a microwave sensor.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_SetMicrowaveSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_setmicrowavesensor( SpcCoeff )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    CALL spccoeff_setsensor(spccoeff, microwave_sensor)
  END SUBROUTINE spccoeff_setmicrowavesensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_SetInfraredSensor
!
! PURPOSE:
!       Elemental subroutine to set a SpcCoeff object as being
!       for an infrared sensor.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_SetInfraredSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_setinfraredsensor( SpcCoeff )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    CALL spccoeff_setsensor(spccoeff, infrared_sensor)
  END SUBROUTINE spccoeff_setinfraredsensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_SetVisibleSensor
!
! PURPOSE:
!       Elemental subroutine to set a SpcCoeff object as being
!       for a visible sensor.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_SetVisibleSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_setvisiblesensor( SpcCoeff )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    CALL spccoeff_setsensor(spccoeff, visible_sensor)
  END SUBROUTINE spccoeff_setvisiblesensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_SetUltravioletSensor
!
! PURPOSE:
!       Elemental subroutine to set a SpcCoeff object as being
!       for an ultraviolet sensor.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_SetUltravioletSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_setultravioletsensor( SpcCoeff )
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    CALL spccoeff_setsensor(spccoeff, ultraviolet_sensor)
  END SUBROUTINE spccoeff_setultravioletsensor
  

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       SpcCoeff_ClearSensor
!
! PURPOSE:
!       Elemental subroutine to reinitialise the sensor type.
!
! CALLING SEQUENCE:
!       CALL SpcCoeff_ClearSensor( SpcCoeff )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be altered.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_clearsensor(SpcCoeff)
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    spccoeff%Sensor_Type = invalid_sensor
  END SUBROUTINE spccoeff_clearsensor
  

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

!------------------------------------------------------------------------------
!
! NAME:
!       SpcCoeff_Equal
!
! PURPOSE:
!       Elemental function to test the equality of two SpcCoeff objects.
!       Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
!       is_equal = SpcCoeff_Equal( x, y )
!
!         or
!
!       IF ( x == y ) THEN
!         ...
!       END IF
!
! OBJECTS:
!       x, y:          Two SpcCoeff objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_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 spccoeff_equal( x, y ) RESULT( is_equal )
    TYPE(spccoeff_type), INTENT(IN) :: x, y
    LOGICAL :: is_equal

    ! Set up
    is_equal = .false.
   
    ! Check the object association status
    IF ( (.NOT. spccoeff_associated(x)) .OR. &
         (.NOT. spccoeff_associated(y))      ) RETURN

    ! Check contents
    ! ...Release/version info
    IF ( (x%Release /= y%Release) .OR. &
         (x%Version /= y%Version) ) RETURN
    ! ...Dimensions
    IF ( x%n_Channels /= y%n_Channels ) RETURN
    ! ...Scalars
    IF ( (x%Sensor_Id        /= y%Sensor_Id       ) .OR. &
         (x%WMO_Satellite_ID /= y%WMO_Satellite_ID) .OR. &
         (x%WMO_Sensor_ID    /= y%WMO_Sensor_ID   ) .OR. &
         (x%Sensor_Type      /= y%Sensor_Type     ) ) RETURN
    ! ...Structures
    IF ( accoeff_associated( x%AC ) .NEQV. accoeff_associated( y%AC ) ) RETURN
    IF ( accoeff_associated( x%AC ) .AND.  accoeff_associated( y%AC ) ) THEN
      IF ( .NOT. (x%AC == y%AC) ) RETURN
    END IF
    IF ( nltecoeff_associated( x%NC ) .NEQV. nltecoeff_associated( y%NC ) ) RETURN
    IF ( nltecoeff_associated( x%NC ) .AND.  nltecoeff_associated( y%NC ) ) THEN
      IF ( .NOT. (x%NC == y%NC) ) RETURN
    END IF
    ! ...Arrays
    IF ( all(x%Sensor_Channel                 ==    y%Sensor_Channel            ) .AND. &
         all(x%Polarization                   ==    y%Polarization              ) .AND. &
         all(x%Channel_Flag                   ==    y%Channel_Flag              ) .AND. &
         all(x%Frequency                  .equalto. y%Frequency                 ) .AND. &
         all(x%Wavenumber                 .equalto. y%Wavenumber                ) .AND. &
         all(x%Planck_C1                  .equalto. y%Planck_C1                 ) .AND. &
         all(x%Planck_C2                  .equalto. y%Planck_C2                 ) .AND. &
         all(x%Band_C1                    .equalto. y%Band_C1                   ) .AND. &
         all(x%Band_C2                    .equalto. y%Band_C2                   ) .AND. &
         all(x%Cosmic_Background_Radiance .equalto. y%Cosmic_Background_Radiance) .AND. &
         all(x%Solar_Irradiance           .equalto. y%Solar_Irradiance          ) ) &
      is_equal = .true.

  END FUNCTION spccoeff_equal

  
  ELEMENTAL FUNCTION spccoeff_issensor(SpcCoeff, Sensor_Type) RESULT(Is_Set)
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    INTEGER,             INTENT(IN) :: sensor_type
    LOGICAL :: is_set
    is_set = .false.
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    is_set = (spccoeff%Sensor_Type == sensor_type)
  END FUNCTION spccoeff_issensor


  ELEMENTAL SUBROUTINE spccoeff_setsensor(SpcCoeff, Sensor_Type)
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER            , INTENT(IN)     :: sensor_type
    spccoeff%Sensor_Type = sensor_type
  END SUBROUTINE spccoeff_setsensor


!--------------------------------------------------------------------------------
!
! NAME:
!       SpcCoeff_IsFlagSet
!
! PURPOSE:
!       Private elemental function to test if ANY SpcCoeff channels have
!       the specified bitflags set in the Channel_Flag component.
!
! CALLING SEQUENCE:
!       Status = SpcCoeff_IsFlagSet( &
!                  SpcCoeff , &
!                  Flag_Type, &
!                  ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to be tested.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! INPUTS:
!       Flag_Type:     Integer specifying the bitflag position.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object to test.
!                      If not specified, all the channels are tested.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value.
!                       .TRUE.  - The specified flag is set on ANY channel.
!                       .FALSE. - The specified flag is NOT set on ALL channels.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as SpcCoeff input
!
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION spccoeff_isflagset( &
    SpcCoeff     , &  ! Input
    Flag_Type    , &  ! Input
    ChannelIndex ) &  ! Optional input
  result(is_set)
    ! Arguments
    TYPE(spccoeff_type), INTENT(IN) :: spccoeff
    INTEGER            , INTENT(IN) :: flag_type
    INTEGER,  OPTIONAL , INTENT(IN) :: channelindex
    ! Function result
    LOGICAL :: is_set
    
    ! Setup
    is_set = .false.
    IF ( .NOT. spccoeff_associated(spccoeff) ) RETURN
    
    ! Perform test based on presence of channel index
    IF ( PRESENT(channelindex) ) THEN
      IF ( channelindex < 1 .OR. channelindex > spccoeff%n_Channels ) RETURN
      is_set = btest(spccoeff%Channel_Flag(channelindex),flag_type)
    ELSE
      is_set = any(btest(spccoeff%Channel_Flag,flag_type))
    END IF

  END FUNCTION spccoeff_isflagset

  
!--------------------------------------------------------------------------------
!
! NAME:
!       SpcCoeff_SetFlag
!
! PURPOSE:
!       Private elemental subroutine to set the specified bitflags in the 
!       Channel_Flag component of an SpcCoeff object.
!
! CALLING SEQUENCE:
!        CALL SpcCoeff_SetFlag( &
!               SpcCoeff , &
!               Flag_Type, &
!               ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to have its channel bitflags set.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! INPUTS:
!       Flag_Type:     Integer specifying the bitflag position.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object for which the bitflag
!                      is to be set.
!                      If not specified, the bitflag is set for all the channels.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_setflag( &
    SpcCoeff    , &  ! In/Output
    Flag_Type   , &  ! Input
    ChannelIndex  )  ! Optional input
    ! Arguments
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER            , INTENT(IN)     :: flag_type
    INTEGER,  OPTIONAL , INTENT(IN)     :: channelindex

    ! Perform test based on presence of channel index
    IF ( PRESENT(channelindex) ) THEN
      IF ( channelindex < 1 .OR. channelindex > spccoeff%n_Channels ) RETURN
      spccoeff%Channel_Flag(channelindex) = ibset(spccoeff%Channel_Flag(channelindex),flag_type)
    ELSE
      spccoeff%Channel_Flag = ibset(spccoeff%Channel_Flag,flag_type)
    END IF

  END SUBROUTINE spccoeff_setflag


!--------------------------------------------------------------------------------
!
! NAME:
!       SpcCoeff_ClearFlag
!
! PURPOSE:
!       Private elemental subroutine to clear the specified bitflags in the 
!       Channel_Flag component of an SpcCoeff object.
!
! CALLING SEQUENCE:
!        CALL SpcCoeff_ClearFlag( &
!               SpcCoeff , &
!               Flag_Type, &
!               ChannelIndex=ChannelIndex )
!
! OBJECTS:
!       SpcCoeff:      Structure which is to have its channel bitflags cleared.
!                      UNITS:      N/A
!                      TYPE:       SpcCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! INPUTS:
!       Flag_Type:     Integer specifying the bitflag position.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       ChannelIndex:  Set this to the index corresponding to a particular
!                      channel in the SpcCoeff object for which the bitflag
!                      is to be cleared.
!                      If not specified, the bitflag is cleared for all the
!                      channels.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Conformable with SpcCoeff input
!                      ATTRIBUTES: INTENT(IN)
!
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE spccoeff_clearflag( &
    SpcCoeff    , &  ! In/Output
    Flag_Type   , &  ! Input
    ChannelIndex  )  ! Optional input
    ! Arguments
    TYPE(spccoeff_type), INTENT(IN OUT) :: spccoeff
    INTEGER            , INTENT(IN)     :: flag_type
    INTEGER,  OPTIONAL , INTENT(IN)     :: channelindex
    
    ! Perform test based on presence of channel index
    IF ( PRESENT(channelindex) ) THEN
      IF ( channelindex < 1 .OR. channelindex > spccoeff%n_Channels ) RETURN
      spccoeff%Channel_Flag(channelindex) = ibclr(spccoeff%Channel_Flag(channelindex),flag_type)
    ELSE
      spccoeff%Channel_Flag = ibclr(spccoeff%Channel_Flag,flag_type)
    END IF

  END SUBROUTINE spccoeff_clearflag
  
END MODULE spccoeff_define