NLTECoeff_Define.f90

Go to the documentation of this file.

!
! NLTECoeff_Define
!
! Module defining the NLTECoeff structure and containing routines to 
! manipulate it.
!
!
! CREATION HISTORY:
!       Written by:     Yong Han, 08-05-2010
!                       yong.han@noaa.gov
!
!       Refactored by:  Paul van Delst, 19-Jan-2011
!                       paul.vandelst@noaa.gov
!

MODULE nltecoeff_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   
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Datatypes
  PUBLIC :: nltecoeff_type
  ! Operators
  PUBLIC :: OPERATOR(==)
  ! Procedures
  PUBLIC :: nltecoeff_associated
  PUBLIC :: nltecoeff_destroy
  PUBLIC :: nltecoeff_create
  PUBLIC :: nltecoeff_inspect
  PUBLIC :: nltecoeff_validrelease
  PUBLIC :: nltecoeff_info
  PUBLIC :: nltecoeff_defineversion
  PUBLIC :: nltecoeff_subset
  PUBLIC :: nltecoeff_concat
  PUBLIC :: nltecoeff_channelreindex


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


  ! -----------------
  ! Module parameters
  ! -----------------
  ! Version Id for the module
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: NLTECoeff_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Literal constants
  REAL(Double), PARAMETER :: zero = 0.0_double
  REAL(Double), PARAMETER :: one  = 1.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 :: nltecoeff_release = 2   ! This determines structure and file formats.
  INTEGER, PARAMETER :: nltecoeff_version = 1   ! This is just the data version.
  ! Number of layers for which mean temperatures are computed
  INTEGER, PARAMETER :: n_layers = 2
  ! Integer flags corresponding to logical false/true
  INTEGER, PARAMETER :: false = 0
  INTEGER, PARAMETER :: true  = 1

  
  ! -----------------------
  ! Derived type definition
  ! -----------------------
  TYPE :: nltecoeff_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! Release and version information
    INTEGER(Long) :: release = nltecoeff_release
    INTEGER(Long) :: version = nltecoeff_version
    ! Dimensions
    INTEGER(Long) :: n_predictors     = 0  ! n1 dimension
    INTEGER(Long) :: n_sensor_angles  = 0  ! n2 dimension
    INTEGER(Long) :: n_solar_angles   = 0  ! n3 dimension
    INTEGER(Long) :: n_nlte_channels  = 0  ! n4 dimension
    INTEGER(Long) :: n_channels       = 0  ! n5 dimension
    ! ..."Internal" dimension
    INTEGER(Long) :: n_layers = n_layers
    ! Sensor info
    CHARACTER(SL)              :: sensor_id        = ''
    INTEGER(Long)              :: wmo_satellite_id = invalid_wmo_satellite_id
    INTEGER(Long)              :: wmo_sensor_id    = invalid_wmo_sensor_id
    INTEGER(Long), ALLOCATABLE :: sensor_channel(:)        ! n5  
    ! Pressure levels used for computing mean temperatures in the two layers
    REAL(Double) :: upper_plevel(n_layers) = zero
    REAL(Double) :: lower_plevel(n_layers) = zero
    ! Min., max. and mean layer temperatures used as the temperature predictor limits 
    REAL(Double) :: min_tm(n_layers)  = zero
    REAL(Double) :: max_tm(n_layers)  = zero
    REAL(Double) :: mean_tm(n_layers) = zero
    ! Coefficient table dimension vectors
    REAL(Double) , ALLOCATABLE :: secant_sensor_zenith(:)  ! n2  
    REAL(Double) , ALLOCATABLE :: secant_solar_zenith(:)   ! n3  
    INTEGER(Long), ALLOCATABLE :: nlte_channel(:)          ! n4
    LOGICAL      , ALLOCATABLE :: is_nlte_channel(:)       ! n5
    ! Coefficients for NLTE corrections
    INTEGER(Long), ALLOCATABLE :: c_index(:)               ! n5
    REAL(Double) , ALLOCATABLE :: c(:,:,:,:)               ! n1 x n2 x n3 x n4 
  END TYPE nltecoeff_type

CONTAINS


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

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

  ELEMENTAL FUNCTION nltecoeff_associated( NLTECoeff ) RESULT( Status )
    TYPE(nltecoeff_type), INTENT(IN) :: nltecoeff
    LOGICAL :: status
    status = nltecoeff%Is_Allocated
  END FUNCTION nltecoeff_associated


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

  ELEMENTAL SUBROUTINE nltecoeff_destroy( NLTECoeff )
    TYPE(nltecoeff_type), INTENT(OUT) :: nltecoeff
    nltecoeff%Is_Allocated = .false.
    nltecoeff%n_Predictors     = 0
    nltecoeff%n_Sensor_Angles  = 0
    nltecoeff%n_Solar_Angles   = 0
    nltecoeff%n_NLTE_Channels  = 0
    nltecoeff%n_Channels       = 0
    nltecoeff%Sensor_Id        = ''
    nltecoeff%WMO_Satellite_ID = invalid_wmo_satellite_id
    nltecoeff%WMO_Sensor_ID    = invalid_wmo_sensor_id
  END SUBROUTINE nltecoeff_destroy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTECoeff_Create
! 
! PURPOSE:
!       Elemental subroutine to create an instance of an NLTECoeff object.
!
! CALLING SEQUENCE:
!       CALL NLTECoeff_Create( NLTECoeff       , &
!                              n_Predictors    , &      
!                              n_Sensor_Angles , &      
!                              n_Solar_Angles  , &      
!                              n_NLTE_Channels , &      
!                              n_Channels        )         
!
! OBJECTS:
!       NLTECoeff:          NLTECoeff object structure.
!                           UNITS:      N/A
!                           TYPE:       NLTECoeff_type
!                           DIMENSION:  Scalar or any rank
!                           ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Predictors:       Number of predictors used in NLTE correction algorithm.
!                           Must be > 0.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Same as the NLTECoeff object
!                           ATTRIBUTES: INTENT(IN)
!
!       n_Sensor_Angles:    Number of sensor zenith angles.
!                           Must be > 0.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Same as the NLTECoeff object
!                           ATTRIBUTES: INTENT(IN)
!
!       n_Solar_Angles:     Number of solar zenith angles.
!                           Must be > 0.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Same as the NLTECoeff object
!                           ATTRIBUTES: INTENT(IN)
!
!       n_NLTE_Channels:    Number of NLTE channels for the sensor.
!                           Must be > 0.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Same as the NLTECoeff object
!                           ATTRIBUTES: INTENT(IN)
!
!        n_Channels:        Total number of channels for the sensor.
!                           Must be >= n_NLTE_Channels.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Same as NLTECoeff object
!                           ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE nltecoeff_create( &
    NLTECoeff       , &  ! Output
    n_Predictors    , &  ! Input
    n_Sensor_Angles , &  ! Input
    n_Solar_Angles  , &  ! Input
    n_NLTE_Channels , &  ! Input
    n_Channels        )  ! Input
    ! Arguments
    TYPE(nltecoeff_type), INTENT(OUT) :: nltecoeff
    INTEGER             , INTENT(IN)  :: n_predictors            
    INTEGER             , INTENT(IN)  :: n_sensor_angles              
    INTEGER             , INTENT(IN)  :: n_solar_angles            
    INTEGER             , INTENT(IN)  :: n_nlte_channels            
    INTEGER             , INTENT(IN)  :: n_channels              
    ! Local variables
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_predictors    < 1 .OR. &
         n_sensor_angles < 1 .OR. &
         n_solar_angles  < 1 .OR. &
         n_nlte_channels < 1 .OR. &
         n_channels < n_nlte_channels ) RETURN
    
    ! Perform the allocation
    ALLOCATE( nltecoeff%Sensor_Channel( n_channels ), &
              nltecoeff%Secant_Sensor_Zenith( n_sensor_angles ), &
              nltecoeff%Secant_Solar_Zenith( n_solar_angles ), &
              nltecoeff%NLTE_Channel( n_nlte_channels ), &
              nltecoeff%Is_NLTE_Channel( n_channels ), &
              nltecoeff%C_Index( n_channels ), &
              nltecoeff%C( n_predictors, n_sensor_angles, n_solar_angles, n_nlte_channels ), &
              stat = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN


    ! Initialise
    ! ...Dimensions
    nltecoeff%n_Predictors    = n_predictors
    nltecoeff%n_Sensor_Angles = n_sensor_angles
    nltecoeff%n_Solar_Angles  = n_solar_angles
    nltecoeff%n_NLTE_Channels = n_nlte_channels
    nltecoeff%n_Channels      = n_channels
    ! ...Arrays
    nltecoeff%Sensor_Channel       = 0
    nltecoeff%Secant_Sensor_Zenith = zero
    nltecoeff%Secant_Solar_Zenith  = zero
    nltecoeff%NLTE_Channel         = 0
    nltecoeff%Is_NLTE_Channel      = .false.
    nltecoeff%C_Index              = 0
    nltecoeff%C                    = zero

    ! Set allocation indicator
    nltecoeff%Is_Allocated = .true.

  END SUBROUTINE nltecoeff_create


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

  SUBROUTINE nltecoeff_inspect( NLTECoeff )
    TYPE(nltecoeff_type), INTENT(IN) :: nltecoeff
    INTEGER :: i
    CHARACTER(3) :: maybe
    WRITE(*,'(1x,"NLTECoeff OBJECT")')
    ! Release/version info
    WRITE(*,'(3x,"Release.Version  :",1x,i0,".",i0)') nltecoeff%Release, nltecoeff%Version
    ! Dimensions
    WRITE(*,'(3x,"n_Predictors     :",1x,i0)') nltecoeff%n_Predictors    
    WRITE(*,'(3x,"n_Sensor_Angles  :",1x,i0)') nltecoeff%n_Sensor_Angles 
    WRITE(*,'(3x,"n_Solar_Angles   :",1x,i0)') nltecoeff%n_Solar_Angles  
    WRITE(*,'(3x,"n_NLTE_Channels  :",1x,i0)') nltecoeff%n_NLTE_Channels 
    WRITE(*,'(3x,"n_Channels       :",1x,i0)') nltecoeff%n_Channels
    IF ( .NOT. nltecoeff_associated(nltecoeff) ) RETURN
    ! Sensor info
    WRITE(*,'(3x,"Sensor_Id        :",1x,a )') trim(nltecoeff%Sensor_Id)
    WRITE(*,'(3x,"WMO_Satellite_ID :",1x,i0)') nltecoeff%WMO_Satellite_ID 
    WRITE(*,'(3x,"WMO_Sensor_ID    :",1x,i0)') nltecoeff%WMO_Sensor_ID
    WRITE(*,'(3x,"Sensor_Channel   :")')
    WRITE(*,'(10(1x,i5,:))') nltecoeff%Sensor_Channel
    ! Pressure arrays
    WRITE(*,'(3x,"Upper_Plevel :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%Upper_Plevel
    WRITE(*,'(3x,"Lower_Plevel :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%Lower_Plevel
    ! Temperature arrays
    WRITE(*,'(3x,"Min_Tm  :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%Min_Tm
    WRITE(*,'(3x,"Max_Tm  :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%Max_Tm
    WRITE(*,'(3x,"Mean_Tm :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%Mean_Tm
    ! Coefficient table dimension vectors
    WRITE(*,'(3x,"Secant_Sensor_Zenith :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%Secant_Sensor_Zenith
    WRITE(*,'(3x,"Secant_Solar_Zenith  :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%Secant_Solar_Zenith
    WRITE(*,'(3x,"NLTE_Channel         :")')
    WRITE(*,'(10(1x,i5,:))') nltecoeff%NLTE_Channel
    ! NLTE channel flag
    WRITE(*,'(3x,"NLTE_Channel_Flag :")')
    DO i = 1, nltecoeff%n_Channels
      IF ( mod(i,5) == 0 .OR. i == nltecoeff%n_Channels ) THEN
        maybe = 'yes'
      ELSE
        maybe = 'no'
      END IF
      WRITE(*,fmt='(1x,i5,":",l1,", c-index: ",i0)',advance=maybe) nltecoeff%Sensor_Channel(i), &
                                                                   nltecoeff%Is_NLTE_Channel(i), &
                                                                   nltecoeff%C_Index(i)
    END DO
    ! Coefficient data
    WRITE(*,'(3x,"NLTE correction coefficients :")')
    WRITE(*,'(5(1x,es13.6,:))') nltecoeff%C
  END SUBROUTINE nltecoeff_inspect


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

  FUNCTION nltecoeff_validrelease( NLTECoeff ) RESULT( IsValid )
    ! Arguments
    TYPE(nltecoeff_type), INTENT(IN) :: nltecoeff
    ! Function result
    LOGICAL :: isvalid
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'NLTECoeff_ValidRelease'
    ! Local variables
    CHARACTER(ML) :: msg

    ! Set up
    isvalid = .true.


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


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

  END FUNCTION nltecoeff_validrelease


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTECoeff_Info
!
! PURPOSE:
!       Subroutine to return a string containing version and dimension
!       information about a NLTECoeff object.
!
! CALLING SEQUENCE:
!       CALL NLTECoeff_Info( NLTECoeff, Info )
!
! OBJECTS:
!       NLTECoeff:     NLTECoeff object about which info is required.
!                      UNITS:      N/A
!                      TYPE:       NLTECoeff_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       Info:          String containing version and dimension information
!                      about the NLTECoeff object.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE nltecoeff_info( NLTECoeff, Info )
    ! Arguments
    TYPE(nltecoeff_type), INTENT(IN)  :: nltecoeff
    CHARACTER(*),         INTENT(OUT) :: info
    ! Parameters
    INTEGER, PARAMETER :: carriage_return = 13
    INTEGER, PARAMETER :: linefeed = 10
    ! Local variables
    CHARACTER(2000) :: long_string

    ! Write the required data to the local string
    WRITE( long_string, &
           '(a,1x,"NLTECoeff RELEASE.VERSION: ",i2,".",i2.2,a,3x, &
           &"N_PREDICTORS=",i0,2x,&
           &"N_SENSOR_ANGLES=",i0,2x,&
           &"N_SOLAR_ANGLES=",i0,2x,&
           &"N_NLTE_CHANNELS=",i0,2x,&
           &"N_CHANNELS=",i0 )' ) &
           achar(carriage_return)//achar(linefeed), &
           nltecoeff%Release, nltecoeff%Version, &
           achar(carriage_return)//achar(linefeed), &
           nltecoeff%n_Predictors    , &
           nltecoeff%n_Sensor_Angles , &
           nltecoeff%n_Solar_Angles  , &
           nltecoeff%n_NLTE_Channels , &
           nltecoeff%n_Channels
                       
    ! Trim the output based on the
    ! dummy argument string length
    info = long_string(1:min(len(info), len_trim(long_string)))

  END SUBROUTINE nltecoeff_info
 
 
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTECoeff_DefineVersion
!
! PURPOSE:
!       Subroutine to return the module version information.
!
! CALLING SEQUENCE:
!       CALL NLTECoeff_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 nltecoeff_defineversion( Id )
    CHARACTER(*), INTENT(OUT) :: id
    id = module_version_id
  END SUBROUTINE nltecoeff_defineversion


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTECoeff_Subset
!
! PURPOSE:
!       Subroutine to return a channel subset of the input NLTECoeff object.
!
! CALLING SEQUENCE:
!       CALL NLTECoeff_Subset( NLTECoeff, Subset, NC_Subset )
!
! OBJECTS:
!       NLTECoeff:      NLTECoeff object which is to be subsetted.
!                     UNITS:      N/A
!                     TYPE:       NLTECoeff_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:
!       NC_Subset:    NLTECoeff object containing the requested channel subset
!                     of the input NLTECoeff data.
!                     UNITS:      N/A
!                     TYPE:       NLTECoeff_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE nltecoeff_subset( &
    NLTECoeff     , &  ! Input
    Sensor_Channel, &  ! Input
    NC_Subset       )  ! Output
    ! Arguments
    TYPE(nltecoeff_type), INTENT(IN)  :: nltecoeff
    INTEGER             , INTENT(IN)  :: sensor_channel(:)
    TYPE(nltecoeff_type), INTENT(OUT) :: nc_subset
    ! Local variables
    TYPE(subset_type) :: subset, nlte_subset
    INTEGER :: n_subset_channels, n_nlte_subset_channels
    INTEGER, ALLOCATABLE :: idx(:), nlte_idx(:)
    
    ! Check input is valid
    IF ( .NOT. nltecoeff_associated(nltecoeff) ) RETURN
    
    
    ! Generate the channel subset list
    CALL subset_generate( &
           subset, &
           nltecoeff%Sensor_Channel, &
           sensor_channel )
    IF ( .NOT. subset_associated( subset ) ) RETURN
    ! ...Generate the NLTE channel subset list
    ! ...(which is itself a subset of the sensor channel list)
    CALL subset_generate( &
           nlte_subset, &
           nltecoeff%NLTE_Channel, &
           sensor_channel )
    IF ( .NOT. subset_associated( nlte_subset ) ) RETURN


    ! Allocate the output subset NLTECoeff object
    CALL subset_getvalue( subset     , n_values = n_subset_channels     , index = idx )
    CALL subset_getvalue( nlte_subset, n_values = n_nlte_subset_channels, index = nlte_idx )
    CALL nltecoeff_create( &
           nc_subset                , &
           nltecoeff%n_Predictors   , &
           nltecoeff%n_Sensor_Angles, &
           nltecoeff%n_Solar_Angles , &
           n_nlte_subset_channels   , &
           n_subset_channels          )
    IF ( .NOT. nltecoeff_associated(nc_subset) ) RETURN


    ! Extract out the subset channels
    ! ...First assign the non-channel dependent data
    nc_subset%Version              = nltecoeff%Version
    nc_subset%Sensor_Id            = nltecoeff%Sensor_Id       
    nc_subset%WMO_Satellite_ID     = nltecoeff%WMO_Satellite_ID
    nc_subset%WMO_Sensor_ID        = nltecoeff%WMO_Sensor_ID   
    nc_subset%Upper_Plevel         = nltecoeff%Upper_Plevel        
    nc_subset%Lower_Plevel         = nltecoeff%Lower_Plevel        
    nc_subset%Min_Tm               = nltecoeff%Min_Tm              
    nc_subset%Max_Tm               = nltecoeff%Max_Tm              
    nc_subset%Mean_Tm              = nltecoeff%Mean_Tm             
    nc_subset%Secant_Sensor_Zenith = nltecoeff%Secant_Sensor_Zenith
    nc_subset%Secant_Solar_Zenith  = nltecoeff%Secant_Solar_Zenith 
    ! ...and now extract the subset
    nc_subset%Sensor_Channel  = nltecoeff%Sensor_Channel(idx)
    nc_subset%NLTE_Channel    = nltecoeff%NLTE_Channel(nlte_idx)
    nc_subset%Is_NLTE_Channel = nltecoeff%Is_NLTE_Channel(idx)
    nc_subset%C_Index         = nltecoeff%C_Index(idx)
    nc_subset%C               = nltecoeff%C(:,:,:,nlte_idx)
    ! ...Reindex the correction coefficient index array
    CALL nltecoeff_reindex( nc_subset )

  END SUBROUTINE nltecoeff_subset


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTECoeff_Concat
!
! PURPOSE:
!       Subroutine to concatenate multiple NLTECoeff objects along the channel
!       dimension into a single NLTECoeff object.
!
! CALLING SEQUENCE:
!       CALL NLTECoeff_Concat( NLTECoeff, NC_Array, Sensor_Id=Sensor_Id )
!
! OBJECTS:
!       NLTECoeff:    NLTECoeff object containing the concatenated result.
!                     UNITS:      N/A
!                     TYPE:       NLTECoeff_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       NC_Array:     Array of NLTECoeff objects to be concatenated.
!                     UNITS:      N/A
!                     TYPE:       NLTECoeff_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 NC_Array is used.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE nltecoeff_concat( &
    NLTECoeff, &  ! Output
    NC_Array , &  ! Input
    Sensor_Id  )  ! Optional input
    ! Arguments
    TYPE(nltecoeff_type)  , INTENT(OUT) :: nltecoeff
    TYPE(nltecoeff_type)  , INTENT(IN)  :: nc_array(:)
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: sensor_id
    ! Local variables
    INTEGER, ALLOCATABLE :: valid_index(:)
    INTEGER :: i, j, n_nc, n_valid, n_channels, n_nlte_channels
    INTEGER :: ch1, ch2, nlte_ch1, nlte_ch2

    ! Set up
    ! ...Check input is valid
    n_nc = SIZE(nc_array)
    IF ( n_nc < 1 ) RETURN
    ! ...Count valid input
    n_valid = count(nltecoeff_associated(nc_array))
    IF ( n_valid == 0 ) RETURN
    ! ...Index the valid input
    ALLOCATE( valid_index(n_valid) )
    valid_index = pack( (/(i,i=1,n_nc)/), mask=nltecoeff_associated(nc_array) )
    ! ...Check non-channel dimensions and ids
    DO j = 1, n_valid
      i = valid_index(j)
      IF ( nc_array(i)%n_Predictors     /= nc_array(valid_index(1))%n_Predictors     .OR. &
           nc_array(i)%n_Sensor_Angles  /= nc_array(valid_index(1))%n_Sensor_Angles  .OR. &
           nc_array(i)%n_Solar_Angles   /= nc_array(valid_index(1))%n_Solar_Angles   .OR. &
           nc_array(i)%WMO_Satellite_ID /= nc_array(valid_index(1))%WMO_Satellite_ID .OR. &
           nc_array(i)%WMO_Sensor_ID    /= nc_array(valid_index(1))%WMO_Sensor_ID         ) THEN
        RETURN
      END IF
    END DO
    
    
    ! Sum channel dimensions
    n_nlte_channels = sum(nc_array(valid_index)%n_NLTE_Channels)
    n_channels      = sum(nc_array(valid_index)%n_Channels)
    

    ! Allocate the output concatenated NLTECoeff object
    CALL nltecoeff_create( &
           nltecoeff                  , &
           nc_array(valid_index(1))%n_Predictors   , &
           nc_array(valid_index(1))%n_Sensor_Angles, &
           nc_array(valid_index(1))%n_Solar_Angles , &
           n_nlte_channels            , &
           n_channels                   )
    IF ( .NOT. nltecoeff_associated(nltecoeff) ) RETURN
    

    ! Concatenate the channel data
    ! ...First assign the non-channel dependent data
    nltecoeff%Version = nc_array(valid_index(1))%Version
    IF ( PRESENT(sensor_id) ) THEN
      nltecoeff%Sensor_Id = adjustl(sensor_id)
    ELSE
      nltecoeff%Sensor_Id = nc_array(valid_index(1))%Sensor_Id
    END IF
    nltecoeff%WMO_Satellite_ID     = nc_array(valid_index(1))%WMO_Satellite_ID
    nltecoeff%WMO_Sensor_ID        = nc_array(valid_index(1))%WMO_Sensor_ID   
    nltecoeff%Upper_Plevel         = nc_array(valid_index(1))%Upper_Plevel        
    nltecoeff%Lower_Plevel         = nc_array(valid_index(1))%Lower_Plevel        
    nltecoeff%Min_Tm               = nc_array(valid_index(1))%Min_Tm              
    nltecoeff%Max_Tm               = nc_array(valid_index(1))%Max_Tm              
    nltecoeff%Mean_Tm              = nc_array(valid_index(1))%Mean_Tm             
    nltecoeff%Secant_Sensor_Zenith = nc_array(valid_index(1))%Secant_Sensor_Zenith
    nltecoeff%Secant_Solar_Zenith  = nc_array(valid_index(1))%Secant_Solar_Zenith 
    ! ...and now concatenate the channel data
    ch1      = 1
    nlte_ch1 = 1
    DO j = 1, n_valid
      i = valid_index(j)
      
      nlte_ch2 = nlte_ch1 + nc_array(i)%n_NLTE_Channels - 1
      ch2      = ch1      + nc_array(i)%n_Channels      - 1
      
      nltecoeff%Sensor_Channel(ch1:ch2)         = nc_array(i)%Sensor_Channel
      nltecoeff%NLTE_Channel(nlte_ch1:nlte_ch2) = nc_array(i)%NLTE_Channel
      nltecoeff%Is_NLTE_Channel(ch1:ch2)        = nc_array(i)%Is_NLTE_Channel
      nltecoeff%C_Index(ch1:ch2)                = nc_array(i)%C_Index
      nltecoeff%C(:,:,:,nlte_ch1:nlte_ch2)      = nc_array(i)%C
      
      nlte_ch1 = nlte_ch2 + 1
      ch1      = ch2      + 1
    END DO
    ! ...Reindex the correction coefficient index array
    CALL nltecoeff_reindex( nltecoeff )


    ! Cleanup
    DEALLOCATE( valid_index )
    
  END SUBROUTINE nltecoeff_concat


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTECoeff_ChannelReindex
!
! PURPOSE:
!       Subroutine to re-index an NLTECoeff object for a different complete
!       channel set.
!
! CALLING SEQUENCE:
!       CALL NLTECoeff_ChannelReindex( NLTECoeff, Sensor_Channels )
!
! OBJECTS:
!       NLTECoeff:      NLTECoeff object to have its channel information reindexed.
!                       UNITS:      N/A
!                       TYPE:       NLTECoeff_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
! INPUTS:
!       Sensor_Channel: Array of channel numbers for which the NLTECoeff object 
!                       is to be re-indexed against.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Rank-1
!                       ATTRIBUTES: INTENT(IN)
!
! COMMENTS:
!       If there is a mismatch between the channel sets, e.g. total number of
!       sensor channels is less than the number of NLTE channels, or if ANY of
!       the NLTE channels are NOT in the sensor channel list, no reindexing is
!       performed and the input structure is returned with no changes.
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE nltecoeff_channelreindex( NLTECoeff, Sensor_Channel )
    ! Arguments
    TYPE(nltecoeff_type), INTENT(IN OUT) :: nltecoeff
    INTEGER             , INTENT(IN)     :: sensor_channel(:)
    ! Local variables
    TYPE(nltecoeff_type) :: nc_copy
    INTEGER :: i, i_nlte
    INTEGER :: n_channels, n_nlte_channels
    
    ! Setup
    IF ( .NOT. nltecoeff_associated(nltecoeff) ) RETURN
    n_channels = SIZE(sensor_channel)
    IF ( n_channels < 1 ) RETURN
    IF ( n_channels < nltecoeff%n_NLTE_Channels ) RETURN
    
    
    ! Copy the input structure
    nc_copy = nltecoeff
    
    
    ! Allocate the reindexed NLTECoeff object
    CALL nltecoeff_create( &
           nltecoeff              , &
           nc_copy%n_Predictors   , &
           nc_copy%n_Sensor_Angles, &
           nc_copy%n_Solar_Angles , &
           nc_copy%n_NLTE_Channels, &
           n_channels               )
    IF ( .NOT. nltecoeff_associated(nltecoeff) ) RETURN
    
    
    ! Fill the new structure
    ! ...Copy over the non-channel related information
    nltecoeff%Version              = nc_copy%Version
    nltecoeff%Sensor_Id            = nc_copy%Sensor_Id
    nltecoeff%WMO_Satellite_ID     = nc_copy%WMO_Satellite_ID
    nltecoeff%WMO_Sensor_ID        = nc_copy%WMO_Sensor_ID   
    nltecoeff%Upper_Plevel         = nc_copy%Upper_Plevel        
    nltecoeff%Lower_Plevel         = nc_copy%Lower_Plevel        
    nltecoeff%Min_Tm               = nc_copy%Min_Tm              
    nltecoeff%Max_Tm               = nc_copy%Max_Tm              
    nltecoeff%Mean_Tm              = nc_copy%Mean_Tm             
    nltecoeff%Secant_Sensor_Zenith = nc_copy%Secant_Sensor_Zenith
    nltecoeff%Secant_Solar_Zenith  = nc_copy%Secant_Solar_Zenith 
    ! ...Copy over the NLTE channel related information
    nltecoeff%NLTE_Channel = nc_copy%NLTE_Channel
    nltecoeff%C            = nc_copy%C
    ! ...Copy over the all-channel related information
    nltecoeff%Sensor_Channel = sensor_channel

    
    ! Perform the channel reindexing
    i_nlte = 1
    reindex_loop: DO i = 1, n_channels
      IF ( nltecoeff%Sensor_Channel(i) == nltecoeff%NLTE_Channel(i_nlte) ) THEN
        nltecoeff%Is_NLTE_Channel(i) = .true.
        nltecoeff%C_Index(i)         = i_nlte
        i_nlte = i_nlte + 1
        IF (i_nlte > nltecoeff%n_NLTE_Channels) EXIT reindex_loop
      END IF
    END DO reindex_loop
    ! ...Unless ALL the NLTE channel were reindexed, restore the original structure
    n_nlte_channels = i_nlte - 1
    IF ( n_nlte_channels /= nltecoeff%n_NLTE_Channels ) nltecoeff = nc_copy

    
    ! Clean up
    CALL nltecoeff_destroy(nc_copy)
    
  END SUBROUTINE nltecoeff_channelreindex



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

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

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

    ! Check contents
    ! ...Release/version info
    IF ( (x%Release /= y%Release) .OR. &
         (x%Version /= y%Version) ) RETURN
    ! ...Dimensions
    IF ( (x%n_Predictors     /= y%n_Predictors    ) .OR. &
         (x%n_Sensor_Angles  /= y%n_Sensor_Angles ) .OR. &
         (x%n_Solar_Angles   /= y%n_Solar_Angles  ) .OR. &
         (x%n_NLTE_Channels  /= y%n_NLTE_Channels ) .OR. &
         (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   ) ) RETURN
    ! ...Arrays
    IF ( all(x%Sensor_Channel           ==    y%Sensor_Channel      ) .AND. &
         all(x%Upper_Plevel         .equalto. y%Upper_Plevel        ) .AND. &
         all(x%Lower_Plevel         .equalto. y%Lower_Plevel        ) .AND. &
         all(x%Min_Tm               .equalto. y%Min_Tm              ) .AND. &
         all(x%Max_Tm               .equalto. y%Max_Tm              ) .AND. &
         all(x%Mean_Tm              .equalto. y%Mean_Tm             ) .AND. &
         all(x%Secant_Sensor_Zenith .equalto. y%Secant_Sensor_Zenith) .AND. &
         all(x%Secant_Solar_Zenith  .equalto. y%Secant_Solar_Zenith ) .AND. &
         all(x%NLTE_Channel             ==    y%NLTE_Channel        ) .AND. &
         all(x%Is_NLTE_Channel        .EQV.   y%Is_NLTE_Channel     ) .AND. &
         all(x%C_Index                  ==    y%C_Index             ) .AND. &
         all(x%C                    .equalto. y%C                   ) ) &
      is_equal = .true.

  END FUNCTION nltecoeff_equal


!--------------------------------------------------------------------------------
!
! NAME:
!       NLTECoeff_Reindex
!
! PURPOSE:
!       Subroutine to reindex the C_Index component of an NLTECoeff object after,
!       for example, subsetting or concatenation.
!
! CALLING SEQUENCE:
!       CALL NLTECoeff_Reindex( NLTECoeff )
!
! OBJECTS:
!       NLTECoeff:    NLTECoeff object which is to have its C_Index
!                     component reindexed.
!                     UNITS:      N/A
!                     TYPE:       NLTECoeff_type
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN OUT)
!
!--------------------------------------------------------------------------------

  SUBROUTINE nltecoeff_reindex( NLTECoeff )
    TYPE(NLTECoeff_type), INTENT(IN OUT) :: NLTECoeff
    INTEGER :: i, j
    j = 1
    DO i = 1, nltecoeff%n_Channels
      IF ( nltecoeff%C_Index(i) > 0 ) THEN
        nltecoeff%C_Index(i) = j
        j = j + 1
      END IF
    END DO
  END SUBROUTINE nltecoeff_reindex

END MODULE nltecoeff_define