! ! ODPS_Predictor_Define ! ! Module defining the Predictor object for the ODPS algorithm and ! containing routines to manipulate it. ! ! CREATION HISTORY: ! Written by: Yong Han, JCSDA, NOAA/NESDIS 20-Jun-2008 ! based on the content of CRTM_Predictor_Define.f90 ! ! Refactored: Paul van Delst, 27-Mar-2012 ! paul.vandelst@noaa.gov ! MODULE ODPS_Predictor_Define ! ------------------ ! Environment set up ! ------------------ ! Module use USE Type_Kinds , ONLY: fp USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message USE Compare_Float_Numbers, ONLY: OPERATOR(.EqualTo.) USE File_Utility , ONLY: File_Open, File_Exists USE Binary_File_Utility , ONLY: Open_Binary_File , & WriteGAtts_Binary_File, & ReadGAtts_Binary_File USE PAFV_Define , ONLY: PAFV_type , & PAFV_Associated, & PAFV_Destroy , & PAFV_Create ! Disable implicit typing IMPLICIT NONE ! ------------ ! Visibilities ! ------------ ! Everything private by default PRIVATE ! Local entities ! ...Datatypes PUBLIC :: ODPS_Predictor_type ! ! ...Operators ! PUBLIC :: OPERATOR(==) ! ...Procedures PUBLIC :: ODPS_Predictor_Associated PUBLIC :: ODPS_Predictor_Destroy PUBLIC :: ODPS_Predictor_Create PUBLIC :: ODPS_Predictor_Inspect PUBLIC :: ODPS_Predictor_Zero ! PUBLIC :: ODPS_Predictor_ValidRelease ! PUBLIC :: ODPS_Predictor_Info ! PUBLIC :: ODPS_Predictor_DefineVersion ! PUBLIC :: ODPS_Predictor_InquireFile ! PUBLIC :: ODPS_Predictor_ReadFile ! PUBLIC :: ODPS_Predictor_WriteFile ! ...Parameter PUBLIC :: MAX_OPTRAN_ORDER PUBLIC :: MAX_OPTRAN_PREDICTORS PUBLIC :: MAX_OPTRAN_USED_PREDICTORS ! USE-associated entities to pass through ! ...Datatypes PUBLIC :: PAFV_type ! ...Procedures PUBLIC :: PAFV_Associated PUBLIC :: PAFV_Destroy PUBLIC :: PAFV_Create ! --------------------- ! Procedure overloading ! --------------------- ! INTERFACE OPERATOR(==) ! MODULE PROCEDURE ODPS_Predictor_Equal ! END INTERFACE OPERATOR(==) ! ----------------- ! Module parameters ! ----------------- CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & '$Id: xODPS_Predictor_Define.f90 18500 2012-04-02 11:07:35Z paul.vandelst@noaa.gov $' ! Release and version INTEGER, PARAMETER :: ODPS_PREDICTOR_RELEASE = 2 ! This determines structure and file formats. INTEGER, PARAMETER :: ODPS_PREDICTOR_VERSION = 1 ! This is just the default data version. ! Close status for write errors CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' ! Literal constants REAL(fp), PARAMETER :: ZERO = 0.0_fp REAL(fp), PARAMETER :: ONE = 1.0_fp ! String lengths INTEGER, PARAMETER :: ML = 256 ! C-OPTRAN max. order and number of predictors INTEGER, PARAMETER :: MAX_OPTRAN_ORDER = 10 INTEGER, PARAMETER :: MAX_OPTRAN_PREDICTORS = 14 INTEGER, PARAMETER :: MAX_OPTRAN_USED_PREDICTORS = 6 ! ----------------------------------- ! ODPS_Predictor data type definition ! ----------------------------------- !:tdoc+: TYPE :: ODPS_Predictor_type ! Allocation indicator LOGICAL :: Is_Allocated = .FALSE. ! Release and version information INTEGER :: Release = ODPS_PREDICTOR_RELEASE INTEGER :: Version = ODPS_PREDICTOR_VERSION ! Dimension variables INTEGER :: Max_n_Layers = 0 ! K - maximum number of layers INTEGER :: n_Layers = 0 ! K - actual number of layers INTEGER :: n_User_Layers = 0 ! Ku - number of layers of user input profile INTEGER :: n_Components = 0 ! J - number of tau components INTEGER :: n_Predictors = 0 ! I - predictor dimension (Maximum) ! Scalars REAL(fp) :: Secant_Zenith_Surface ! Secant zenith angle at the surface REAL(fp) :: u, v, w ! Algorithm specific variables ! Arrays REAL(fp), ALLOCATABLE :: Secant_Zenith(:) ! K ; secant zenith angle INTEGER, ALLOCATABLE :: Component_ID(:) ! J ; Tau component Id INTEGER, ALLOCATABLE :: n_CP(:) ! J ; No. of predictors for each component REAL(fp), ALLOCATABLE :: X(:,:,:) ! K x I x J ; Predictor array REAL(fp), ALLOCATABLE :: Ref_Level_LnPressure(:) ! 0:K ; Pressure arrays used for optical REAL(fp), ALLOCATABLE :: User_Level_LnPressure(:) ! 0:Ku; path profile interpolation ! Compact-OPTRAN predictors LOGICAL :: OPTRAN = .FALSE. INTEGER :: n_OPredictors = 0 ! OI REAL(fp), ALLOCATABLE :: Ap(:,:) ! MAX_OPTRAN_ORDER x K; polynomial of the water vapor absorber level REAL(fp), ALLOCATABLE :: dA(:) ! K ; slant path layer integrated amount REAL(fp), ALLOCATABLE :: OX(:,:) ! K x OI ; Predictor array ! Structure variable to hold predictor and absorption ! forward variables across FWD, TL and AD calls. It ! should be allocated only for the FWD Predictor variable. TYPE(PAFV_type) :: PAFV END TYPE ODPS_Predictor_type !:tdoc-: CONTAINS !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! ODPS_Predictor_Associated ! ! PURPOSE: ! Elemental function to test the status of the allocatable components ! of the ODPS_Predictor structure. ! ! CALLING SEQUENCE: ! Status = ODPS_Predictor_Associated( ODPS_Predictor ) ! ! OBJECTS: ! ODPS_Predictor: ! Structure which is to have its member's ! status tested. ! UNITS: N/A ! TYPE: ODPS_Predictor_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! Status: ! The return value is a logical value indicating the ! status of the allocated members. ! .TRUE. - if the ODPS_Predictor object has been allocated. ! .FALSE. - if the ODPS_Predictor object has NOT been allocated. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Same as input ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL FUNCTION ODPS_Predictor_Associated( self ) RESULT( Status ) TYPE(ODPS_Predictor_type), INTENT(IN) :: self LOGICAL :: Status Status = self%Is_Allocated END FUNCTION ODPS_Predictor_Associated !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! ODPS_Predictor_Destroy ! ! PURPOSE: ! Elemental subroutine to re-initialize ODPS_Predictor objects. ! ! CALLING SEQUENCE: ! CALL ODPS_Predictor_Destroy( ODPS_Predictor ) ! ! OBJECTS: ! ODPS_Predictor: ! Re-initialized ODPS_Predictor structure. ! UNITS: N/A ! TYPE: ODPS_Predictor_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE ODPS_Predictor_Destroy( self ) TYPE(ODPS_Predictor_type), INTENT(OUT) :: self self%Is_Allocated = .FALSE. END SUBROUTINE ODPS_Predictor_Destroy !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! ODPS_Predictor_Create ! ! PURPOSE: ! Elemental subroutine to create an instance of an ODPS_Predictor object. ! ! CALLING SEQUENCE: ! CALL ODPS_Predictor_Create( & ! ODPS_Predictor, & ! n_Layers , & ! n_User_Layers , & ! n_Components , & ! n_Predictors , & ! No_OPTRAN = No_OPTRAN ) ! ! OBJECTS: ! ODPS_Predictor: ! ODPS_Predictor object structure. ! UNITS: N/A ! TYPE: ODPS_Predictor_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! n_Layers: ! Number of atmospheric layers. ! Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Conformable with the ODPS_Predictor object ! ATTRIBUTES: INTENT(IN) ! ! n_Components: ! Number of atmospheric absorption components. ! Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Conformable with the ODPS_Predictor object ! ATTRIBUTES: INTENT(IN) ! ! n_Predictors: ! Maximum number of absorption predictor. ! Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Conformable with the ODPS_Predictor object ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL INPUTS: ! No_OPTRAN: ! Logical switch to disable allocation of Compact-OPTRAN ! arrays for use with water vapour absorption. ! If == .FALSE., arrays are allocated [DEFAULT] ! == .TRUE., arrays are NOT allocated ! If not specified, arrays are allocated. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Conformable with the ODPS_Predictor object ! ATTRIBUTES: INTENT(IN), OPTIONAL ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE ODPS_Predictor_Create( & self , & ! Output n_Layers , & ! Input n_User_Layers, & ! Input n_Components , & ! Input n_Predictors , & ! Input No_OPTRAN ) ! Optional Input ! Arguments TYPE(ODPS_Predictor_type), INTENT(OUT) :: self INTEGER, INTENT(IN) :: n_Layers INTEGER, INTENT(IN) :: n_User_Layers INTEGER, INTENT(IN) :: n_Components INTEGER, INTENT(IN) :: n_Predictors LOGICAL, OPTIONAL, INTENT(IN) :: No_OPTRAN ! Local variables LOGICAL :: use_optran INTEGER :: alloc_stat ! Check input IF ( n_Layers < 1 .OR. & n_User_Layers < 1 .OR. & n_Components < 1 .OR. & n_Predictors < 1 ) RETURN ! ...Process options use_optran = .TRUE. IF ( PRESENT(No_OPTRAN) ) use_optran = .NOT. No_OPTRAN ! Perform the allocation ALLOCATE( self%Secant_Zenith(n_Layers), & self%Component_ID(n_Components), & self%n_CP(n_Components), & self%X(n_Layers, n_Predictors, n_Components), & self%Ref_Level_LnPressure(0:n_Layers), & self%User_Level_LnPressure(0:n_User_Layers), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Initialise dimensions self%Max_n_Layers = n_Layers self%n_Layers = n_Layers self%n_User_Layers = n_User_Layers self%n_Components = n_Components self%n_Predictors = n_Predictors ! Allocate OPTRAN if required IF ( use_optran ) THEN ALLOCATE( self%OX(n_Layers, MAX_OPTRAN_PREDICTORS), & self%Ap(n_Layers, MAX_OPTRAN_ORDER), & self%dA(n_Layers), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Initialise dimensions self%n_OPredictors = MAX_OPTRAN_PREDICTORS ! ...Flag OPTRAN section as usuable self%OPTRAN = .TRUE. END IF ! Set allocation indicator self%Is_Allocated = .TRUE. ! Initialise array data CALL ODPS_Predictor_Zero(self) END SUBROUTINE ODPS_Predictor_Create !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! ODPS_Predictor_Inspect ! ! PURPOSE: ! Subroutine to print the contents of a ODPS_Predictor object to stdout. ! ! CALLING SEQUENCE: ! CALL ODPS_Predictor_Inspect( ODPS_Predictor ) ! ! OBJECTS: ! ODPS_Predictor: ! ODPS_Predictor object to display. ! UNITS: N/A ! TYPE: ODPS_Predictor_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE ODPS_Predictor_Inspect(self) TYPE(ODPS_Predictor_type), INTENT(IN) :: self INTEGER :: i, j WRITE(*,'(1x,"ODPS_Predictor OBJECT")') ! Release/version info WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version ! Dimensions WRITE(*,'(3x,"n_Layers :",1x,i0)') self%n_Layers WRITE(*,'(3x,"n_User_Layers :",1x,i0)') self%n_User_Layers WRITE(*,'(3x,"n_Components :",1x,i0)') self%n_Components WRITE(*,'(3x,"n_Predictors :",1x,i0)') self%n_Predictors IF ( .NOT. ODPS_Predictor_Associated(self) ) RETURN ! ODPS data arrays WRITE(*,'(3x,"ODPS data arrays :")') ! ...ODPS Forward variables WRITE(*,'(5x,"Secant_Zenith :")') WRITE(*,'(5(1x,es23.15e3,:))') self%Secant_Zenith(1:self%n_Layers) WRITE(*,'(5x,"Component_ID :")') WRITE(*,'(10(1x,i0,:))') self%Component_ID(1:self%n_Components) WRITE(*,'(5x,"n_CP :")') WRITE(*,'(10(1x,i0,:))') self%n_CP(1:self%n_Components) WRITE(*,'(5x,"X (predictor array) :")') DO j = 1, self%n_Components DO i = 1, self%n_Predictors WRITE(*,'(7x,"Component#: ",i0,"; Predictor#: ",i0)') j, i WRITE(*,'(5(1x,es23.15e3,:))') self%X(1:self%n_Layers,i,j) END DO WRITE(*,*) END DO ! ...Pressure profiles for interpolations WRITE(*,'(5x,"Ref_Level_LnPressure :")') WRITE(*,'(5(1x,es13.6,:))') self%Ref_Level_LnPressure WRITE(*,'(5x,"User_Level_LnPressure :")') WRITE(*,'(5(1x,es13.6,:))') self%User_Level_LnPressure ! Compact-OPTRAN Forward variables IF ( self%OPTRAN ) THEN WRITE(*,'(3x,"n_OPredictors :",1x,i0)') self%n_OPredictors WRITE(*,'(5x,"OX :")'); WRITE(*,'(5(1x,es13.6,:))') self%OX WRITE(*,'(5x,"Ap :")'); WRITE(*,'(5(1x,es13.6,:))') self%Ap WRITE(*,'(5x,"dA :")'); WRITE(*,'(5(1x,es13.6,:))') self%dA END IF END SUBROUTINE ODPS_Predictor_Inspect !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! ODPS_Predictor_Zero ! ! PURPOSE: ! Elementl subroutine to zero-out an instance of an ODPS predictor object. ! ! CALLING SEQUENCE: ! CALL ODPS_Predictor_Zero( ODPS_Predictor ) ! ! OUTPUTS: ! ODPS_Predictor: ! ODPS_Predictor object structure. ! UNITS: N/A ! TYPE: ODPS_Predictor_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE ODPS_Predictor_Zero( self ) TYPE(ODPS_Predictor_type), INTENT(IN OUT) :: self IF ( .NOT. ODPS_Predictor_Associated(self) ) RETURN self%Secant_Zenith = ZERO self%Component_ID = 0 self%n_CP = self%n_Predictors self%X = ZERO self%Ref_Level_LnPressure = ZERO self%User_Level_LnPressure = ZERO IF ( self%OPTRAN ) THEN self%OX = ZERO self%Ap = ZERO self%dA = ZERO END IF END SUBROUTINE ODPS_Predictor_Zero END MODULE ODPS_Predictor_Define