! ! RTV_Define ! ! Module containing the intermediate variables for RTSolution module. ! ! ! NOTE: Modified as generic "bucket" for all RT-related algorithm, ! ADA, AMOM, and SOI. ! This is initial step in truly separating out the algorithms ! into their own modules. Currently each algorithm ties into ! the same RTV components (not good.) ! ! ! ! CREATION HISTORY: ! Written by: Quanhua Liu, QSS at JCSDA; Quanhua.Liu@noaa.gov ! Yong Han, NOAA/NESDIS; Yong.Han@noaa.gov ! Paul van Delst, paul.vandelst@noaa.gov ! 08-Jun-2004 MODULE RTV_Define ! ------------------ ! Environment set up ! ------------------ ! Module use statements USE Type_Kinds, ONLY: fp USE Message_Handler, ONLY: SUCCESS, FAILURE, Display_Message USE CRTM_Parameters, ONLY: SET, ZERO, ONE, TWO, PI, & MAX_N_LAYERS, MAX_N_ANGLES, MAX_N_LEGENDRE_TERMS, & DEGREES_TO_RADIANS, & SECANT_DIFFUSIVITY, & SCATTERING_ALBEDO_THRESHOLD, & OPTICAL_DEPTH_THRESHOLD, & RT_ADA USE SensorInfo_Parameters, ONLY: INVALID_SENSOR USE CRTM_SfcOptics, ONLY: SOVar_type => iVar_type ! Disable all implicit typing IMPLICIT NONE ! -------------------- ! Default visibilities ! -------------------- ! Everything private by default PRIVATE ! Parameters PUBLIC :: ANGLE_THRESHOLD PUBLIC :: PHASE_THRESHOLD PUBLIC :: DELTA_OPTICAL_DEPTH PUBLIC :: MAX_ALBEDO PUBLIC :: SMALL_OD_FOR_SC PUBLIC :: MAX_N_DOUBLING PUBLIC :: MAX_N_SOI_ITERATIONS ! Datatypes PUBLIC :: aircraft_rt_type PUBLIC :: RTV_type ! Procedures PUBLIC :: RTV_Associated PUBLIC :: RTV_Destroy PUBLIC :: RTV_Create ! ----------------- ! Module parameters ! ----------------- ! Version Id for the module CHARACTER(*), PARAMETER :: MODULE_RCS_ID = & '$Id: RTV_Define.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $' ! Threshold for determing if an additional stream ! angle is required for the satellite zenith angle REAL(fp), PARAMETER :: ANGLE_THRESHOLD = 1.0e-7_fp ! Small positive value used to replace negative ! values in the computed phase function REAL(fp), PARAMETER :: PHASE_THRESHOLD = 1.0e-7_fp REAL(fp), PARAMETER :: DELTA_OPTICAL_DEPTH = 1.0e-8_fp REAL(fp), PARAMETER :: MAX_ALBEDO = 0.999999_fp ! Threshold layer optical depth for single scattering REAL(fp), PARAMETER :: SMALL_OD_FOR_SC = 1.E-5_fp ! The maximum number of doubling processes in the ! the doubling-adding scheme. INTEGER, PARAMETER :: MAX_N_DOUBLING = 55 ! The maximum number of iterations for the SOI solution method. INTEGER, PARAMETER :: MAX_N_SOI_ITERATIONS = 75 ! --------------------- ! Structure definitions ! --------------------- ! ...Aircraft model structure TYPE :: aircraft_rt_type ! The switch LOGICAL :: rt = .FALSE. ! The output level index INTEGER :: idx END TYPE aircraft_rt_type ! -------------------------------------- ! Structure definition to hold forward ! variables across FWD, TL, and AD calls ! -------------------------------------- TYPE :: RTV_type ! Type of sensor INTEGER :: Sensor_Type = INVALID_SENSOR ! Type of RT algorithm INTEGER :: RT_Algorithm_Id = RT_ADA ! Dimension information INTEGER :: n_Layers = 0 ! Total number of atmospheric layers INTEGER :: n_Added_Layers = 0 ! Number of layers appended to TOA INTEGER :: n_Angles = 0 ! Number of angles to be considered INTEGER :: n_SOI_Iterations = 0 ! Number of SOI iterations REAL(fp):: COS_SUN = ZERO ! Cosine of sun zenith angle REAL(fp):: Solar_irradiance = ZERO ! channel solar iiradiance at TOA REAL(fp):: Cosmic_Background_Radiance = ZERO ! For background temp=2.7253 ! Variable to hold the various portions of the ! radiance for emissivity retrieval algorithms ! Passed to FWD RTSolution structure argument output REAL(fp) :: Up_Radiance = ZERO REAL(fp) :: Down_Solar_Radiance = ZERO REAL(fp) :: Secant_Down_Angle = 0 ! Overcast radiance for cloud detection REAL(fp), DIMENSION( 0:MAX_N_LAYERS ) :: e_Cloud_Radiance_UP= ZERO REAL(fp), DIMENSION( 0:MAX_N_LAYERS ) :: e_Source_UP = ZERO REAL(fp), DIMENSION( 0:MAX_N_LAYERS ) :: e_Level_Trans_UP = ONE ! Emission model variables REAL(fp) :: Total_OD = ZERO REAL(fp), DIMENSION( MAX_N_LAYERS ) :: e_Layer_Trans_UP = ZERO REAL(fp), DIMENSION( MAX_N_LAYERS ) :: e_Layer_Trans_DOWN = ZERO REAL(fp), DIMENSION( 0:MAX_N_LAYERS ) :: e_Level_Rad_UP = ZERO REAL(fp), DIMENSION( 0:MAX_N_LAYERS ) :: e_Level_Rad_DOWN = ZERO ! Planck radiances REAL(fp) :: Planck_Surface = ZERO REAL(fp), DIMENSION( 0:MAX_N_LAYERS ) :: Planck_Atmosphere = ZERO ! Quadrature information REAL(fp), DIMENSION( MAX_N_ANGLES ) :: COS_Angle = ZERO ! Gaussian quadrature abscissa REAL(fp), DIMENSION( MAX_N_ANGLES ) :: COS_Weight = ZERO ! Gaussian quadrature weights ! Logical switches LOGICAL :: Diffuse_Surface = .TRUE. LOGICAL :: Is_Solar_Channel = .FALSE. ! Aircraft model RT information TYPE(aircraft_rt_type) :: aircraft ! Scattering, visible model variables INTEGER :: n_Streams = 0 ! Number of *hemispheric* stream angles used in RT INTEGER :: mth_Azi ! mth fourier component INTEGER :: n_Azi ! number of fourier components LOGICAL :: Solar_Flag_true = .FALSE. LOGICAL :: Visible_Flag_true = .FALSE. LOGICAL :: Scattering_RT = .FALSE. !----------------------------------- ! Variables used in the ADA routines !----------------------------------- ! Flag to indicate the following arrays have all been allocated LOGICAL :: Is_Allocated = .FALSE. ! Phase function variables ! Forward and backward scattering phase matrices REAL(fp), ALLOCATABLE :: Pff(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES+1, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: Pbb(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES+1, MAX_N_LAYERS ! Positive and negative cosine angle Legendre phase functions REAL(fp), ALLOCATABLE :: Pplus(:,:) ! 0:MAX_N_LEGENDRE_TERMS, MAX_N_ANGLES REAL(fp), ALLOCATABLE :: Pminus(:,:) ! 0:MAX_N_LEGENDRE_TERMS, MAX_N_ANGLES REAL(fp), ALLOCATABLE :: Pleg(:,:) ! 0:MAX_N_LEGENDRE_TERMS, MAX_N_ANGLES+1 ! Original forward and backward scattering phase matrices. ! These may be slightly negative and, if so, need to be made ! positive and thus adjusted to ensure energy conservation REAL(fp), ALLOCATABLE :: Off(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES+1, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: Obb(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES+1, MAX_N_LAYERS ! Normalisation factor and intermediate sum used for original ! phase matrix energy conservation. REAL(fp), ALLOCATABLE :: n_Factor(:,:) ! MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: sum_fac(:,:) ! 0:MAX_N_ANGLES, MAX_N_LAYERS ! Adding-Doubling model variables REAL(fp), ALLOCATABLE :: Inv_Gamma(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: Inv_GammaT(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: Refl_Trans(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: s_Layer_Trans(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: s_Layer_Refl(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: s_Level_Refl_UP(:,:,:) ! MAX_N_ANGLES, MAX_N_ANGLES, 0:MAX_N_LAYERS REAL(fp), ALLOCATABLE :: s_Level_Rad_UP(:,:) ! MAX_N_ANGLES, 0:MAX_N_LAYERS REAL(fp), ALLOCATABLE :: s_Layer_Source_UP(:,:) ! MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: s_Layer_Source_DOWN(:,:) ! MAX_N_ANGLES, MAX_N_LAYERS !------------------------------------ ! Variables used in the AMOM routines !------------------------------------ ! dimensions, MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: Thermal_C(:,:) REAL(fp), ALLOCATABLE :: EigVa(:,:) REAL(fp), ALLOCATABLE :: Exp_x(:,:) REAL(fp), ALLOCATABLE :: EigValue(:,:) ! dimensions, MAX_N_ANGLES, MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: HH(:,:,:) REAL(fp), ALLOCATABLE :: PM(:,:,:) REAL(fp), ALLOCATABLE :: PP(:,:,:) REAL(fp), ALLOCATABLE :: PPM(:,:,:) REAL(fp), ALLOCATABLE :: PPP(:,:,:) REAL(fp), ALLOCATABLE :: i_PPM(:,:,:) REAL(fp), ALLOCATABLE :: i_PPP(:,:,:) REAL(fp), ALLOCATABLE :: EigVe(:,:,:) REAL(fp), ALLOCATABLE :: Gm(:,:,:) REAL(fp), ALLOCATABLE :: i_Gm(:,:,:) REAL(fp), ALLOCATABLE :: Gp(:,:,:) REAL(fp), ALLOCATABLE :: EigVeF(:,:,:) REAL(fp), ALLOCATABLE :: EigVeVa(:,:,:) REAL(fp), ALLOCATABLE :: A1(:,:,:) REAL(fp), ALLOCATABLE :: A2(:,:,:) REAL(fp), ALLOCATABLE :: A3(:,:,:) REAL(fp), ALLOCATABLE :: A4(:,:,:) REAL(fp), ALLOCATABLE :: A5(:,:,:) REAL(fp), ALLOCATABLE :: A6(:,:,:) REAL(fp), ALLOCATABLE :: Gm_A5(:,:,:) REAL(fp), ALLOCATABLE :: i_Gm_A5(:,:,:) !----------------------------------- ! Variables used in the SOI routines !----------------------------------- INTEGER :: Number_SOI_Iter = 0 REAL(fp), ALLOCATABLE :: e_Layer_Trans(:,:) ! MAX_N_ANGLES, MAX_N_LAYERS REAL(fp), ALLOCATABLE :: s_Level_IterRad_DOWN(:,:,:) ! MAX_N_ANGLES, 0:MAX_N_LAYERS, MAX_N_SOI_ITERATIONS REAL(fp), ALLOCATABLE :: s_Level_IterRad_UP(:,:,:) ! MAX_N_ANGLES, 0:MAX_N_LAYERS, MAX_N_SOI_ITERATIONS INTEGER , ALLOCATABLE :: Number_Doubling(:) ! n_Layers REAL(fp), ALLOCATABLE :: Delta_Tau(:) ! n_Layers REAL(fp), ALLOCATABLE :: Refl(:,:,:,:) ! n_Angles, n_Angles, 0:MAX_N_DOUBLING, n_Layers REAL(fp), ALLOCATABLE :: Trans(:,:,:,:) ! n_Angles, n_Angles, 0:MAX_N_DOUBLING, n_Layers REAL(fp), ALLOCATABLE :: Inv_BeT(:,:,:,:) ! n_Angles, n_Angles, 0:MAX_N_DOUBLING, n_Layers REAL(fp), ALLOCATABLE :: C1(:,:) ! n_Angles, n_Layers REAL(fp), ALLOCATABLE :: C2(:,:) ! n_Angles, n_Layers ! The surface optics forward variables TYPE(SOVar_type) :: SOV END TYPE RTV_type CONTAINS !################################################################################ !################################################################################ !## ## !## ## PRIVATE MODULE ROUTINES ## ## !## ## !################################################################################ !################################################################################ !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! RTV_Associated ! ! PURPOSE: ! Elemental function to test if the allocatable components of an ! RTV object have been allocated. ! ! CALLING SEQUENCE: ! Status = RTV_Associated( RTV ) ! ! OBJECTS: ! RTV: RTV structure which is to have its member's ! status tested. ! UNITS: N/A ! TYPE: RTV_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! Status: The return value is a logical value indicating the ! status of the RTV members. ! .TRUE. - if ANY of the RTV allocatable or ! pointer members are in use. ! .FALSE. - if ALL of the RTV allocatable or ! pointer members are not in use. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Same as input RTV argument ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL FUNCTION RTV_Associated( RTV ) RESULT( Status ) ! Arguments TYPE(RTV_type), INTENT(IN) :: RTV ! Function result LOGICAL :: Status ! Test the structure members Status = RTV%Is_Allocated END FUNCTION RTV_Associated !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! RTV_Destroy ! ! PURPOSE: ! Elemental subroutine to re-initialize RTV objects. ! ! CALLING SEQUENCE: ! CALL RTV_Destroy( RTV ) ! ! OBJECTS: ! RTV: Re-initialized RTV structure. ! UNITS: N/A ! TYPE: RTV_type ! DIMENSION: Scalar OR any rank ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE RTV_Destroy( RTV ) TYPE(RTV_type), INTENT(OUT) :: RTV ! Belts and braces RTV%Is_Allocated = .FALSE. END SUBROUTINE RTV_Destroy !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! RTV_Create ! ! PURPOSE: ! Elemental subroutine to create an instance of the RTV object. ! ! CALLING SEQUENCE: ! CALL RTV_Create( RTV, & ! n_Angles , & ! n_Legendre_Terms, & ! n_Layers ) ! ! OBJECTS: ! RTV: RTV structure. ! UNITS: N/A ! TYPE: RTV_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! n_Angles: Number of ! Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Same as RTV object ! ATTRIBUTES: INTENT(IN) ! ! n_Legendre_Terms: Number of ! Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Same as RTV object ! ATTRIBUTES: INTENT(IN) ! ! n_Layers: Number of atmospheric layers. ! Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Same as RTV object ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE RTV_Create( & RTV, & n_Angles , & n_Legendre_Terms, & n_Layers ) ! Arguments TYPE(RTV_type), INTENT(OUT) :: RTV INTEGER , INTENT(IN) :: n_Angles INTEGER , INTENT(IN) :: n_Legendre_Terms INTEGER , INTENT(IN) :: n_Layers ! Local variables INTEGER :: alloc_stat ! Check input IF ( n_Angles < 1 .OR. n_Legendre_Terms < 1 .OR. n_Layers < 1 ) RETURN ! Perform the allocation for phase function variables ALLOCATE( RTV%Pff(n_Angles, n_Angles+1, n_Layers) , & RTV%Pbb(n_Angles, n_Angles+1, n_Layers) , & RTV%Pplus( 0:n_Legendre_Terms, n_Angles), & RTV%Pminus(0:n_Legendre_Terms, n_Angles), & RTV%Pleg(0:n_Legendre_Terms, n_Angles+1), & RTV%Off(n_Angles, n_Angles+1, n_Layers) , & RTV%Obb(n_Angles, n_Angles+1, n_Layers) , & RTV%n_Factor (n_Angles, n_Layers) , & RTV%sum_fac(0:n_Angles, n_Layers) , & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Perform the allocation for adding-doubling variables ALLOCATE( RTV%Inv_Gamma( n_Angles, n_Angles, n_Layers) , & RTV%Inv_GammaT(n_Angles, n_Angles, n_Layers) , & RTV%Refl_Trans(n_Angles, n_Angles, n_Layers) , & RTV%s_Layer_Trans(n_Angles, n_Angles, n_Layers) , & RTV%s_Layer_Refl( n_Angles, n_Angles, n_Layers) , & RTV%s_Level_Refl_UP(n_Angles, n_Angles, 0:n_Layers), & RTV%s_Level_Rad_UP(n_Angles, 0:n_Layers) , & RTV%s_Layer_Source_UP( n_Angles, n_Layers) , & RTV%s_Layer_Source_DOWN(n_Angles, n_Layers) , & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Perform the allocation for AMOM variables ALLOCATE( RTV%Thermal_C(n_Angles, n_Layers) , & RTV%EigVa(n_Angles, n_Layers) , & RTV%Exp_x(n_Angles, n_Layers) , & RTV%EigValue(n_Angles, n_Layers) , & RTV%HH(n_Angles, n_Angles, n_Layers) , & RTV%PM(n_Angles, n_Angles, n_Layers) , & RTV%PP(n_Angles, n_Angles, n_Layers) , & RTV%PPM(n_Angles, n_Angles, n_Layers) , & RTV%PPP(n_Angles, n_Angles, n_Layers) , & RTV%i_PPM(n_Angles, n_Angles, n_Layers) , & RTV%i_PPP(n_Angles,n_Angles,n_Layers) , & RTV%EigVe(n_Angles, n_Angles, n_Layers) , & RTV%Gm(n_Angles, n_Angles, n_Layers) , & RTV%i_Gm(n_Angles, n_Angles, n_Layers) , & RTV%Gp(n_Angles, n_Angles, n_Layers) , & RTV%EigVeF(n_Angles, n_Angles, n_Layers) , & RTV%EigVeVa(n_Angles,n_Angles,n_Layers) , & RTV%A1(n_Angles,n_Angles, n_Layers) , & RTV%A2(n_Angles, n_Angles, n_Layers) , & RTV%A3(n_Angles, n_Angles, n_Layers) , & RTV%A4(n_Angles, n_Angles, n_Layers) , & RTV%A5(n_Angles, n_Angles, n_Layers) , & RTV%A6(n_Angles, n_Angles, n_Layers) , & RTV%Gm_A5(n_Angles, n_Angles, n_Layers) , & RTV%i_Gm_A5(n_Angles, n_Angles, n_Layers), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Perform the allocation for SOI variables ALLOCATE( RTV%e_Layer_Trans( n_Angles, n_Layers), & RTV%s_Level_IterRad_DOWN( n_Angles, 0:n_Layers, MAX_N_SOI_ITERATIONS ), & RTV%s_Level_IterRad_UP( n_Angles, 0:n_Layers, MAX_N_SOI_ITERATIONS ), & RTV%Number_Doubling(n_Layers), & RTV%Delta_Tau(n_Layers), & RTV%Refl(n_Angles, n_Angles, 0:MAX_N_DOUBLING, n_Layers), & RTV%Trans(n_Angles, n_Angles, 0:MAX_N_DOUBLING, n_Layers), & RTV%Inv_BeT(n_Angles, n_Angles, 0:MAX_N_DOUBLING, n_Layers), & RTV%C1(n_Angles, n_Layers), & RTV%C2(n_Angles, n_Layers), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Set dimensions RTV%n_Layers = n_Layers RTV%n_Angles = n_Angles RTV%n_SOI_Iterations = 0 ! Set the allocate flag RTV%Is_Allocated = .TRUE. END SUBROUTINE RTV_Create END MODULE RTV_Define