<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
!
! ACCoeff_Define
!
! Module defining the ACCoeff data structure and containing routines to
! manipulate it.
!
! CREATION HISTORY:
! Written by: Paul van Delst, 25-Jan-2011
! paul.vandelst@noaa.gov
!
<A NAME='ACCOEFF_DEFINE'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_DEFINE' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A>
MODULE ACCoeff_Define 7,7
! ------------------
! Environment set up
! ------------------
! 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 :: ACCoeff_type
! Operators
PUBLIC :: OPERATOR(==)
! Procedures
PUBLIC :: ACCoeff_Associated
PUBLIC :: ACCoeff_Destroy
PUBLIC :: ACCoeff_Create
PUBLIC :: ACCoeff_Inspect
PUBLIC :: ACCoeff_ValidRelease
PUBLIC :: ACCoeff_Info
PUBLIC :: ACCoeff_DefineVersion
PUBLIC :: ACCoeff_Subset
PUBLIC :: ACCoeff_Concat
PUBLIC :: ACCoeff_ChannelReindex
! ---------------------
! Procedure overloading
! ---------------------
<A NAME='OPERATOR'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#OPERATOR' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
INTERFACE OPERATOR(==)
MODULE PROCEDURE
END INTERFACE OPERATOR(==)
! -----------------
! Module parameters
! -----------------
! Version Id for the module
CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
'$Id: ACCoeff_Define.f90 29405 2013-06-20 20:19:52Z 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 :: ACCOEFF_RELEASE = 1
INTEGER, PARAMETER :: ACCOEFF_VERSION = 1
! -----------------------
! Derived type definition
! -----------------------
TYPE :: ACCoeff_type
! Allocation indicator
LOGICAL :: Is_Allocated = .FALSE.
! Release and version information
INTEGER(Long) :: Release = ACCOEFF_RELEASE
INTEGER(Long) :: Version = ACCOEFF_VERSION
! Dimensions
INTEGER(Long) :: n_FOVs = 0 ! N
INTEGER(Long) :: n_Channels = 0 ! L
! 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(:) ! L
! Antenna correction coefficients
REAL(Double) , ALLOCATABLE :: A_earth(:,:) ! N x L
REAL(Double) , ALLOCATABLE :: A_space(:,:) ! N x L
REAL(Double) , ALLOCATABLE :: A_platform(:,:) ! N x L
END TYPE ACCoeff_type
CONTAINS
!################################################################################
!################################################################################
!## ##
!## ## PUBLIC MODULE ROUTINES ## ##
!## ##
!################################################################################
!################################################################################
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_Associated
!
! PURPOSE:
! Elemental function to test the status of the allocatable components
! of the ACCoeff structure.
!
! CALLING SEQUENCE:
! Status = ACCoeff_Associated( ACCoeff )
!
! OBJECTS:
! ACCoeff: Structure which is to have its member's
! status tested.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar or any rank
! ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
! Status: The return value is a logical value indicating the
! status of the ACCoeff members.
! .TRUE. - if ANY of the ACCoeff allocatable members
! are in use.
! .FALSE. - if ALL of the ACCoeff allocatable members
! are not in use.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Same as input
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_ASSOCIATED'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_ASSOCIATED' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
ELEMENTAL FUNCTION ACCoeff_Associated( ACCoeff ) RESULT( Status ) 1
TYPE(ACCoeff_type), INTENT(IN) :: ACCoeff
LOGICAL :: Status
Status = ACCoeff%Is_Allocated
END FUNCTION ACCoeff_Associated
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_Destroy
!
! PURPOSE:
! Elemental subroutine to re-initialize ACCoeff objects.
!
! CALLING SEQUENCE:
! CALL ACCoeff_Destroy( ACCoeff )
!
! OBJECTS:
! ACCoeff: Re-initialized ACCoeff structure.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar or any rank
! ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_DESTROY'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_DESTROY' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
ELEMENTAL SUBROUTINE ACCoeff_Destroy( ACCoeff ) 2
TYPE(ACCoeff_type), INTENT(OUT) :: ACCoeff
ACCoeff%Is_Allocated = .FALSE.
ACCoeff%n_FOVs = 0
ACCoeff%n_Channels = 0
ACCoeff%Sensor_Id = ''
ACCoeff%WMO_Satellite_ID = INVALID_WMO_SATELLITE_ID
ACCoeff%WMO_Sensor_ID = INVALID_WMO_SENSOR_ID
END SUBROUTINE ACCoeff_Destroy
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_Create
!
! PURPOSE:
! Elemental subroutine to create an instance of an ACCoeff object.
!
! CALLING SEQUENCE:
! CALL ACCoeff_Create( ACCoeff , &
! n_FOVs , &
! n_Channels )
!
! OBJECTS:
! ACCoeff: ACCoeff object structure.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar or any rank
! ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
! n_FOVs: Number of sensor fields-of-view (FOVs).
! Must be > 0.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! n_Channels: Number of sensor channels.
! Must be > 0.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_CREATE'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_CREATE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
ELEMENTAL SUBROUTINE ACCoeff_Create( & 4
ACCoeff , & ! Output
n_FOVs , & ! Input
n_Channels ) ! Input
! Arguments
TYPE(ACCoeff_type), INTENT(OUT) :: ACCoeff
INTEGER , INTENT(IN) :: n_FOVs
INTEGER , INTENT(IN) :: n_Channels
! Local variables
INTEGER :: alloc_stat
! Check input
IF ( n_FOVs < 1 .OR. &
n_Channels < 1 ) RETURN
! Perform the allocation
ALLOCATE( ACCoeff%Sensor_Channel( 1:n_Channels ), &
ACCoeff%A_earth( 1:n_FOVs, 1:n_Channels ), &
ACCoeff%A_space( 1:n_FOVs, 1:n_Channels ), &
ACCoeff%A_platform( 1:n_FOVs, 1:n_Channels ), &
STAT = alloc_stat )
IF ( alloc_stat /= 0 ) RETURN
! Initialise
! ...Dimensions
ACCoeff%n_FOVs = n_FOVs
ACCoeff%n_Channels = n_Channels
! ...Arrays
ACCoeff%Sensor_Channel = 0
ACCoeff%A_earth = ONE
ACCoeff%A_space = ZERO
ACCoeff%A_platform = ZERO
! Set allocation indicator
ACCoeff%Is_Allocated = .TRUE.
END SUBROUTINE ACCoeff_Create
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_Inspect
!
! PURPOSE:
! Subroutine to print the contents of a ACCoeff object to stdout.
!
! CALLING SEQUENCE:
! CALL ACCoeff_Inspect( ACCoeff )
!
! OBJECTS:
! ACCoeff: ACCoeff object to display.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_INSPECT'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_INSPECT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ACCoeff_Inspect( ACCoeff ) 1
TYPE(ACCoeff_type), INTENT(IN) :: ACCoeff
WRITE(*,'(1x,"ACCoeff OBJECT")')
! Release/version info
WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') ACCoeff%Release, ACCoeff%Version
! Dimensions
WRITE(*,'(3x,"n_FOVs :",1x,i0)') ACCoeff%n_FOVs
WRITE(*,'(3x,"n_Channels :",1x,i0)') ACCoeff%n_Channels
IF ( .NOT. ACCoeff_Associated(ACCoeff) ) RETURN
! Sensor info
WRITE(*,'(3x,"Sensor_Id :",1x,a )') TRIM(ACCoeff%Sensor_Id)
WRITE(*,'(3x,"WMO_Satellite_ID :",1x,i0)') ACCoeff%WMO_Satellite_ID
WRITE(*,'(3x,"WMO_Sensor_ID :",1x,i0)') ACCoeff%WMO_Sensor_ID
WRITE(*,'(3x,"Sensor_Channel :")')
WRITE(*,'(10(1x,i5,:))') ACCoeff%Sensor_Channel
! Coefficient arrays
WRITE(*,'(3x,"A_earth :")')
WRITE(*,'(5(1x,es13.6,:))') ACCoeff%A_earth
WRITE(*,'(3x,"A_space :")')
WRITE(*,'(5(1x,es13.6,:))') ACCoeff%A_space
WRITE(*,'(3x,"A_platform :")')
WRITE(*,'(5(1x,es13.6,:))') ACCoeff%A_platform
END SUBROUTINE ACCoeff_Inspect
!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_ValidRelease
!
! PURPOSE:
! Function to check the ACCoeff Release value.
!
! CALLING SEQUENCE:
! IsValid = ACCoeff_ValidRelease( ACCoeff )
!
! INPUTS:
! ACCoeff: ACCoeff object for which the Release component
! is to be checked.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
! IsValid: Logical value defining the release validity.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
!
!:sdoc-:
!----------------------------------------------------------------------------------
<A NAME='ACCOEFF_VALIDRELEASE'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_VALIDRELEASE' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION ACCoeff_ValidRelease( ACCoeff ) RESULT( IsValid ),2
! Arguments
TYPE(ACCoeff_type), INTENT(IN) :: ACCoeff
! Function result
LOGICAL :: IsValid
! Local parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'ACCoeff_ValidRelease'
! Local variables
CHARACTER(ML) :: msg
! Set up
IsValid = .TRUE.
! Check release is not too old
IF ( ACCoeff%Release < ACCOEFF_RELEASE ) THEN
IsValid = .FALSE.
WRITE( msg,'("An ACCoeff data update is needed. ", &
&"ACCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
ACCoeff%Release, ACCOEFF_RELEASE
CALL Display_Message( ROUTINE_NAME, msg, INFORMATION )
RETURN
END IF
! Check release is not too new
IF ( ACCoeff%Release > ACCOEFF_RELEASE ) THEN
IsValid = .FALSE.
WRITE( msg,'("An ACCoeff software update is needed. ", &
&"ACCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
ACCoeff%Release, ACCOEFF_RELEASE
CALL Display_Message( ROUTINE_NAME, msg, INFORMATION )
RETURN
END IF
END FUNCTION ACCoeff_ValidRelease
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_Info
!
! PURPOSE:
! Subroutine to return a string containing version and dimension
! information about a ACCoeff object.
!
! CALLING SEQUENCE:
! CALL ACCoeff_Info( ACCoeff, Info )
!
! OBJECTS:
! ACCoeff: ACCoeff object about which info is required.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
! Info: String containing version and dimension information
! about the ACCoeff object.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_INFO'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_INFO' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ACCoeff_Info( ACCoeff, Info ) 3
! Arguments
TYPE(ACCoeff_type), INTENT(IN) :: ACCoeff
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,"ACCoeff RELEASE.VERSION: ",i2,".",i2.2,a,3x, &
&"N_FOVS=",i0,2x,&
&"N_CHANNELS=",i0 )' ) &
ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), &
ACCoeff%Release, ACCoeff%Version, &
ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), &
ACCoeff%n_FOVs , &
ACCoeff%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 ACCoeff_Info
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_DefineVersion
!
! PURPOSE:
! Subroutine to return the module version information.
!
! CALLING SEQUENCE:
! CALL ACCoeff_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-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_DEFINEVERSION'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_DEFINEVERSION' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ACCoeff_DefineVersion( Id ) 1
CHARACTER(*), INTENT(OUT) :: Id
Id = MODULE_VERSION_ID
END SUBROUTINE ACCoeff_DefineVersion
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_Subset
!
! PURPOSE:
! Subroutine to return a channel subset of the input ACCoeff object.
!
! CALLING SEQUENCE:
! CALL ACCoeff_Subset( ACCoeff, Subset, AC_Subset )
!
! OBJECTS:
! ACCoeff: ACCoeff object which is to be subsetted.
! UNITS: N/A
! TYPE: ACCoeff_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:
! AC_Subset: ACCoeff object containing the requested channel subset
! of the input ACCoeff data.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_SUBSET'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_SUBSET' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ACCoeff_Subset( & 1,3
ACCoeff , & ! Input
Sensor_Channel, & ! Input
AC_Subset ) ! Output
! Arguments
TYPE(ACCoeff_type), INTENT(IN) :: ACCoeff
INTEGER , INTENT(IN) :: Sensor_Channel(:)
TYPE(ACCoeff_type), INTENT(OUT) :: AC_Subset
! Local variables
TYPE(Subset_type) :: subset
INTEGER :: n_subset_channels
INTEGER, ALLOCATABLE :: idx(:)
! Check input is valid
IF ( .NOT. ACCoeff_Associated(ACCoeff) ) RETURN
! Generate the subset list
CALL Subset_Generate( &
subset, &
ACCoeff%Sensor_Channel, &
Sensor_Channel )
IF ( .NOT. Subset_Associated( subset ) ) RETURN
! Allocate the output subset ACCoeff object
CALL Subset_GetValue( subset, n_Values = n_subset_channels, Index = idx )
CALL ACCoeff_Create( AC_Subset, ACCoeff%n_FOVs, n_subset_channels )
IF ( .NOT. ACCoeff_Associated(AC_Subset) ) RETURN
! Extract out the subset channels
! ...First assign some scalars
AC_Subset%Version = ACCoeff%Version
AC_Subset%Sensor_Id = ACCoeff%Sensor_Id
AC_Subset%WMO_Satellite_ID = ACCoeff%WMO_Satellite_ID
AC_Subset%WMO_Sensor_ID = ACCoeff%WMO_Sensor_ID
! ...and now extract the subset
AC_Subset%Sensor_Channel = ACCoeff%Sensor_Channel(idx)
AC_Subset%A_earth = ACCoeff%A_earth(:,idx)
AC_Subset%A_space = ACCoeff%A_space(:,idx)
AC_Subset%A_platform = ACCoeff%A_platform(:,idx)
END SUBROUTINE ACCoeff_Subset
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_Concat
!
! PURPOSE:
! Subroutine to concatenate multiple ACCoeff objects along the channel
! dimension into a single ACCoeff object.
!
! CALLING SEQUENCE:
! CALL ACCoeff_Concat( ACCoeff, AC_Array, Sensor_Id=Sensor_Id )
!
! OBJECTS:
! ACCoeff: ACCoeff object containing the concatenated result.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
! AC_Array: Array of ACCoeff objects to be concatenated.
! UNITS: N/A
! TYPE: ACCoeff_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 AC_Array is used.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_CONCAT'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_CONCAT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ACCoeff_Concat( & 1,2
ACCoeff , & ! Output
AC_Array , & ! Input
Sensor_Id ) ! Optional input
! Arguments
TYPE(ACCoeff_type) , INTENT(OUT) :: ACCoeff
TYPE(ACCoeff_type) , INTENT(IN) :: AC_Array(:)
CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Id
! Local variables
INTEGER, ALLOCATABLE :: valid_index(:)
INTEGER :: i, j, n_ac, n_valid, n_channels
INTEGER :: ch1, ch2
! Set up
! ...Check input is valid
n_ac = SIZE(AC_Array)
IF ( n_ac < 1 ) RETURN
! ...Count valid input
n_valid = COUNT(ACCoeff_Associated(AC_Array))
IF ( n_valid == 0 ) RETURN
! ...Index the valid input
ALLOCATE( valid_index(n_valid) )
valid_index = PACK( (/(i,i=1,n_ac)/), MASK=ACCoeff_Associated(AC_Array) )
! ...Check non-channel dimensions and ids
DO j = 1, n_valid
i = valid_index(j)
IF ( AC_Array(i)%n_FOVs /= AC_Array(valid_index(1))%n_FOVs .OR. &
AC_Array(i)%WMO_Satellite_ID /= AC_Array(valid_index(1))%WMO_Satellite_ID .OR. &
AC_Array(i)%WMO_Sensor_ID /= AC_Array(valid_index(1))%WMO_Sensor_ID ) THEN
RETURN
END IF
END DO
! Sum channel dimensions
n_channels = SUM(AC_Array(valid_index)%n_Channels)
! Allocate the output concatenated ACCoeff object
CALL ACCoeff_Create( &
ACCoeff, &
AC_Array(valid_index(1))%n_FOVs, &
n_channels )
IF ( .NOT. ACCoeff_Associated(ACCoeff) ) RETURN
! Concatenate the channel data
! ...First assign the non-channel dependent data
ACCoeff%Version = AC_Array(valid_index(1))%Version
IF ( PRESENT(Sensor_Id) ) THEN
ACCoeff%Sensor_Id = ADJUSTL(Sensor_Id)
ELSE
ACCoeff%Sensor_Id = AC_Array(valid_index(1))%Sensor_Id
END IF
ACCoeff%WMO_Satellite_ID = AC_Array(valid_index(1))%WMO_Satellite_ID
ACCoeff%WMO_Sensor_ID = AC_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 + AC_Array(i)%n_Channels - 1
ACCoeff%Sensor_Channel(ch1:ch2) = AC_Array(i)%Sensor_Channel
ACCoeff%A_earth(:,ch1:ch2) = AC_Array(i)%A_earth
ACCoeff%A_space(:,ch1:ch2) = AC_Array(i)%A_space
ACCoeff%A_platform(:,ch1:ch2) = AC_Array(i)%A_platform
ch1 = ch2 + 1
END DO
! Cleanup
DEALLOCATE( valid_index )
END SUBROUTINE ACCoeff_Concat
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! ACCoeff_ChannelReindex
!
! PURPOSE:
! Subroutine to re-index an ACCoeff object for a different complete
! channel set.
!
! CALLING SEQUENCE:
! CALL ACCoeff_ChannelReindex( ACCoeff, Sensor_Channels )
!
! OBJECTS:
! ACCoeff: ACCoeff object to have its channel information reindexed.
! UNITS: N/A
! TYPE: ACCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! INPUTS:
! Sensor_Channel: Array of channel numbers for which the ACCoeff object
! is to be re-indexed against.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Rank-1
! ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='ACCOEFF_CHANNELREINDEX'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_CHANNELREINDEX' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ACCoeff_ChannelReindex( & 1,2
ACCoeff , & ! In/output
Sensor_Channel ) ! Input
! Arguments
TYPE(ACCoeff_type), INTENT(IN OUT) :: ACCoeff
INTEGER , INTENT(IN) :: Sensor_Channel(:)
! Local variables
TYPE(ACCoeff_type) :: ac_copy
INTEGER :: i, i_orig
INTEGER :: n_channels
! Setup
IF ( .NOT. ACCoeff_Associated(ACCoeff) ) RETURN
n_channels = SIZE(Sensor_Channel)
IF ( n_channels < 1 ) RETURN
! Copy the input structure
ac_copy = ACCoeff
! Allocate the reindexed ACCoeff object
CALL ACCoeff_Create( &
ACCoeff , &
ac_copy%n_FOVs, &
n_channels )
IF ( .NOT. ACCoeff_Associated(ACCoeff) ) RETURN
! Fill the new structure
! ...Copy over the non-channel related information
ACCoeff%Version = ac_copy%Version
ACCoeff%Sensor_Id = ac_copy%Sensor_Id
ACCoeff%WMO_Satellite_ID = ac_copy%WMO_Satellite_ID
ACCoeff%WMO_Sensor_ID = ac_copy%WMO_Sensor_ID
! ...Copy over the all-channel related information
ACCoeff%Sensor_Channel = Sensor_Channel
! Perform the channel reindexing
i_orig = 1
DO i = 1, n_channels
IF ( ACCoeff%Sensor_Channel(i) == ac_copy%Sensor_Channel(i_orig) ) THEN
ACCoeff%A_earth(:,i) = ac_copy%A_earth(:,i_orig)
ACCoeff%A_space(:,i) = ac_copy%A_space(:,i_orig)
ACCoeff%A_platform(:,i) = ac_copy%A_platform(:,i_orig)
i_orig = i_orig + 1
END IF
END DO
! Clean up
CALL ACCoeff_Destroy(ac_copy)
END SUBROUTINE ACCoeff_ChannelReindex
!##################################################################################
!##################################################################################
!## ##
!## ## PRIVATE MODULE ROUTINES ## ##
!## ##
!##################################################################################
!##################################################################################
!------------------------------------------------------------------------------
!
! NAME:
! ACCoeff_Equal
!
! PURPOSE:
! Elemental function to test the equality of two ACCoeff objects.
! Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
! is_equal = ACCoeff_Equal( x, y )
!
! or
!
! IF ( x == y ) THEN
! ...
! END IF
!
! OBJECTS:
! x, y: Two ACCoeff objects to be compared.
! UNITS: N/A
! TYPE: ACCoeff_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.
!
!------------------------------------------------------------------------------
<A NAME='ACCOEFF_EQUAL'><A href='../../html_code/crtm/ACCoeff_Define.f90.html#ACCOEFF_EQUAL' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
ELEMENTAL FUNCTION ACCoeff_Equal( x, y ) RESULT( is_equal ) 1
TYPE(ACCoeff_type), INTENT(IN) :: x, y
LOGICAL :: is_equal
! Set up
is_equal = .FALSE.
! Check the object association status
IF ( (.NOT. ACCoeff_Associated(x)) .OR. &
(.NOT. ACCoeff_Associated(y)) ) RETURN
! Check contents
! ...Release/version info
IF ( (x%Release /= y%Release) .OR. &
(x%Version /= y%Version) ) RETURN
! ...Dimensions
IF ( (x%n_FOVs /= y%n_FOVs ) .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%A_earth .EqualTo. y%A_earth ) .AND. &
ALL(x%A_space .EqualTo. y%A_space ) .AND. &
ALL(x%A_platform .EqualTo. y%A_platform ) ) &
is_equal = .TRUE.
END FUNCTION ACCoeff_Equal
END MODULE ACCoeff_Define