From 82c746009c27585e5cd323365286d6f57d65db0d Mon Sep 17 00:00:00 2001 From: Evan Parker Date: Tue, 23 Jun 2026 16:24:31 -0600 Subject: [PATCH 01/10] Update JEDI CI action with build cache (#321) Update to jedi-ci v2 with caching run-ci-on-draft = true Issue: JCSDA-internal/jedi-ci#77 --- .github/workflows/start-jedi-ci.yaml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/.github/workflows/start-jedi-ci.yaml b/.github/workflows/start-jedi-ci.yaml index 33eadb8b..f5538204 100644 --- a/.github/workflows/start-jedi-ci.yaml +++ b/.github/workflows/start-jedi-ci.yaml @@ -38,15 +38,12 @@ jobs: aws-region: us-east-2 - name: Run JEDI CI - uses: JCSDA-internal/jedi-ci@develop + uses: JCSDA-internal/jedi-ci@v2 with: container_version: latest target_project_name: crtm - test_dependencies: ioda ioda-data oops gsw ufo ufo-data - test_strategy: ALL test_script: run_tests.sh unittest_tag: CRTM_Tests bundle_repository: https://github.com/JCSDA/jedi-bundle.git - target_repo_dir: target_repository bundle_branch: develop jedi_ci_token: ${{ steps.generate-token.outputs.token }} From a36a0ec3f9d41ca4e30d959c5f8f879486306be4 Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Wed, 8 Jul 2026 13:59:46 -0600 Subject: [PATCH 02/10] Add new data sturcture Optical Profile --- src/Options/CRTM_Options_Define.f90 | 48 + src/Options/OP_Input/OP_Input_Define.f90 | 1209 ++++++++++++++++++++++ 2 files changed, 1257 insertions(+) create mode 100644 src/Options/OP_Input/OP_Input_Define.f90 diff --git a/src/Options/CRTM_Options_Define.f90 b/src/Options/CRTM_Options_Define.f90 index 870bc324..a44a3b80 100644 --- a/src/Options/CRTM_Options_Define.f90 +++ b/src/Options/CRTM_Options_Define.f90 @@ -51,6 +51,10 @@ MODULE CRTM_Options_Define CloudCover_Overcast_Overlap, & CloudCover_Overlap_IsValid, & CloudCover_Overlap_Name + USE OP_Input_Define , ONLY: OP_Input_type, & + OPERATOR(==), & + OP_Input_IsValid, & + OP_Input_Inspect ! Disable implicit typing IMPLICIT NONE @@ -177,6 +181,15 @@ MODULE CRTM_Options_Define ! Whether to skip this profile LOGICAL :: Skip_Profile = .FALSE. + + ! User defined optical profiles + LOGICAL :: Use_Aerosol_OP = .FALSE. ! Aerosol + LOGICAL :: Use_Cloud_OP = .FALSE. ! Cloud + LOGICAL :: Use_Total_OP = .FALSE. ! Aerosol + Cloud + TYPE(OP_Input_Type) :: AOP ! Aerosol optical profiles + TYPE(OP_Input_Type) :: COP ! Cloud optical profiles + TYPE(OP_Input_Type) :: TOP ! Total optical profiles + END TYPE CRTM_Options_type !:tdoc-: @@ -366,6 +379,9 @@ ELEMENTAL SUBROUTINE CRTM_Options_SetValue( & Set_Overcast_Overlap , & Use_Emissivity , & Use_Direct_Reflectivity, & + Use_Aerosol_OP , & + Use_Cloud_OP , & + Use_Total_OP , & n_Streams , & Aircraft_Pressure ) ! Arguments @@ -384,6 +400,9 @@ ELEMENTAL SUBROUTINE CRTM_Options_SetValue( & LOGICAL , OPTIONAL, INTENT(IN) :: Set_Overcast_Overlap LOGICAL , OPTIONAL, INTENT(IN) :: Use_Emissivity LOGICAL , OPTIONAL, INTENT(IN) :: Use_Direct_Reflectivity + LOGICAL , OPTIONAL, INTENT(IN) :: Use_Aerosol_OP + LOGICAL , OPTIONAL, INTENT(IN) :: Use_Cloud_OP + LOGICAL , OPTIONAL, INTENT(IN) :: Use_Total_OP INTEGER , OPTIONAL, INTENT(IN) :: n_Streams REAL(fp), OPTIONAL, INTENT(IN) :: Aircraft_Pressure @@ -429,6 +448,18 @@ ELEMENTAL SUBROUTINE CRTM_Options_SetValue( & IF ( PRESENT(Use_Direct_Reflectivity) ) & self%Use_Direct_Reflectivity = Use_Direct_Reflectivity .AND. self%Is_Allocated + ! Aerosol optical profiles + IF ( PRESENT(Use_Aerosol_OP) ) & + self%Use_Aerosol_OP = Use_Aerosol_OP .AND. self%Is_Allocated + + ! Cloud optical profiles + IF ( PRESENT(Use_Cloud_OP) ) & + self%Use_Cloud_OP = Use_Cloud_OP .AND. self%Is_Allocated + + ! Total optical profiles + IF ( PRESENT(Use_Total_OP) ) & + self%Use_Total_OP = Use_Total_OP .AND. self%Is_Allocated + END SUBROUTINE CRTM_Options_SetValue @@ -784,6 +815,19 @@ FUNCTION CRTM_Options_IsValid( self ) RESULT( IsValid ) ! Check cloud overlap option validity IsValid = CloudCover_Overlap_IsValid( self%Overlap_Id ) .AND. IsValid + ! Check OP input Options + IF ( self%Use_Aerosol_OP ) THEN + IsValid = OP_Input_IsValid( self%AOP ) .AND. IsValid + END IF + + IF ( self%Use_Cloud_OP ) THEN + IsValid = OP_Input_IsValid( self%COP ) .AND. IsValid + END IF + + IF ( self%Use_Total_OP ) THEN + IsValid = OP_Input_IsValid( self%TOP ) .AND. IsValid + END IF + END FUNCTION CRTM_Options_IsValid @@ -840,6 +884,10 @@ SUBROUTINE CRTM_Options_Inspect( self ) CALL SSU_Input_Inspect( self%SSU ) ! ...Zeeman input CALL Zeeman_Input_Inspect( self%Zeeman ) + ! ...OP input + CALL OP_Input_Inspect( self%AOP ) + CALL OP_Input_Inspect( self%COP ) + CALL OP_Input_Inspect( self%TOP ) END SUBROUTINE CRTM_Options_Inspect diff --git a/src/Options/OP_Input/OP_Input_Define.f90 b/src/Options/OP_Input/OP_Input_Define.f90 new file mode 100644 index 00000000..be03cd80 --- /dev/null +++ b/src/Options/OP_Input/OP_Input_Define.f90 @@ -0,0 +1,1209 @@ +! +! OP_Input_Define +! +! Module containing the structure definition and associated routines +! for CRTM optional inputs specific to user-defined aerosol/cloud/total optical profiles +! +! +! CREATION HISTORY: +! Written by: Cheng Dang, Jan, 2024 +! dangch@ucar.edu +! + +MODULE OP_Input_Define + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp, Long, Double + 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 netcdf + ! Disable all implicit typing + IMPLICIT NONE + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + ! Datatypes + PUBLIC :: OP_Input_type + ! Operators + PUBLIC :: OPERATOR(==) + ! Procedures + PUBLIC :: OP_Input_IsValid + PUBLIC :: OP_Input_Inspect + PUBLIC :: OP_Input_Create + PUBLIC :: OP_Input_Associated + PUBLIC :: OP_Input_InquireFile + PUBLIC :: OP_Input_ReadFile + PUBLIC :: OP_Input_WriteFile + + ! ------------------- + ! Procedure overloads + ! ------------------- + INTERFACE OPERATOR(==) + MODULE PROCEDURE OP_Input_Equal + END INTERFACE OPERATOR(==) + + ! ----------------- + ! Module parameters + ! ----------------- + ! Release and version + INTEGER, PARAMETER :: OP_INPUT_RELEASE = 1 ! This determines structure and file formats. + ! Close status for write errors + CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' + ! Literal constants + REAL(Double), PARAMETER :: ZERO = 0.0_Double + ! Message length + INTEGER, PARAMETER :: ML = 256 + + ! NetCDF attributes + ! Global attribute names. Case sensitive + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + + ! Dimension names + CHARACTER(*), PARAMETER :: CHANNEL_DIMNAME = 'n_Channels' + CHARACTER(*), PARAMETER :: LAYER_DIMNAME = 'n_Layers' + CHARACTER(*), PARAMETER :: LEGENDRE_DIMNAME = 'n_Legendre_Terms' + CHARACTER(*), PARAMETER :: PHASE_DIMNAME = 'n_Phase_Elements' + + ! Variable names + CHARACTER(*), PARAMETER :: TAU_VARNAME = 'tau' + CHARACTER(*), PARAMETER :: BS_VARNAME = 'bs' + CHARACTER(*), PARAMETER :: PCOEFF_VARNAME = 'pcoeff' + CHARACTER(*), PARAMETER :: KB_VARNAME = 'kb' + + ! Variable description attribute. + CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' + CHARACTER(*), PARAMETER :: TAU_DESCRIPTION = 'Layer optical depth' + CHARACTER(*), PARAMETER :: BS_DESCRIPTION = 'Layer volume scattering coefficient' + CHARACTER(*), PARAMETER :: PCOEFF_DESCRIPTION = 'Layer phase function coefficients for scatters' + CHARACTER(*), PARAMETER :: KB_DESCRIPTION = 'Layer backward scattering coefficient' + + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + CHARACTER(*), PARAMETER :: TAU_UNITS = 'unit' + CHARACTER(*), PARAMETER :: BS_UNITS = 'unit' + CHARACTER(*), PARAMETER :: PCOEFF_UNITS = 'unit' + CHARACTER(*), PARAMETER :: KB_UNITS = 'Metres squared per kilogram (m^2.kg^-1)' + + ! Variable _FillValue attribute. + CHARACTER(*), PARAMETER :: FILLVALUE_ATTNAME = '_FillValue' + REAL(Double), PARAMETER :: FILL_FLOAT = -999.0_fp + + ! Variable types + INTEGER, PARAMETER :: FLOAT_TYPE = NF90_DOUBLE + + !-------------------- + ! Structure defintion + !-------------------- + !:tdoc+: + TYPE :: OP_Input_type + ! Allocation indicator + LOGICAL :: Is_Allocated = .FALSE. + ! Release and version information + INTEGER(Long) :: Release = OP_INPUT_RELEASE + + ! Dimensions + INTEGER :: n_Channels = 0 ! K dimension + INTEGER :: n_Layers = 0 ! L dimension + INTEGER :: n_Phase_Elements = 0 ! Ip dimension + INTEGER :: n_Legendre_Terms = 0 ! Il dimension + + ! Scalar components + ! LOGICAL :: Include_Scattering = .TRUE. + ! INTEGER :: lOffset = 0 ! Start position in array for Legendre coefficients + ! REAL(fp) :: Scattering_Optical_Depth = ZERO + ! REAL(fp) :: depolarization = 0.0279_fp + + REAL(fp), ALLOCATABLE :: tau(:,:) ! K * L + REAL(fp), ALLOCATABLE :: bs(:,:) ! K * L + REAL(fp), ALLOCATABLE :: kb(:,:) ! K * L + REAL(fp), ALLOCATABLE :: pcoeff(:,:,:,:) ! K * L * Il * Ip + + END TYPE OP_Input_type + !:tdoc-: + +CONTAINS + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! OP_Input_Associated +! +! PURPOSE: +! Elemental function to test the status of the allocatable components +! of a CRTM RTSolution object. +! +! CALLING SEQUENCE: +! Status = OP_Input_Associated( OP ) +! +! OBJECTS: +! RTSolution: OP structure which is to have its member's +! status tested. +! UNITS: N/A +! TYPE: OP +! DIMENSION: Scalar or any rank +! ATTRIBUTES: INTENT(IN) +! +! FUNCTION RESULT: +! Status: The return value is a logical value indicating the +! status of the RTSolution members. +! .TRUE. - if the array components are allocated. +! .FALSE. - if the array components are not allocated. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Same as input RTSolution argument +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + ELEMENTAL FUNCTION OP_Input_Associated( op ) RESULT( Status ) + TYPE(OP_Input_type), INTENT(IN) :: op + LOGICAL :: Status + Status = op%Is_Allocated + END FUNCTION OP_Input_Associated + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! OP_Input_IsValid +! +! PURPOSE: +! Non-pure function to perform some simple validity checks on a +! OP_Input object. +! +! If invalid data is found, a message is printed to stdout. +! +! CALLING SEQUENCE: +! result = OP_Input_IsValid( OP ) +! +! or +! +! IF ( OP_Input_IsValid( OP ) ) THEN.... +! +! OBJECTS: +! op: OP_Input object which is to have its +! contents checked. +! UNITS: N/A +! TYPE: OP_Input_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! FUNCTION RESULT: +! result: Logical variable indicating whether or not the input +! passed the check. +! If == .FALSE., object is unused or contains +! invalid data. +! == .TRUE., object can be used. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + FUNCTION OP_Input_IsValid( op ) RESULT( IsValid ) + TYPE(OP_Input_type), INTENT(IN) :: op + LOGICAL :: IsValid + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'OP_Input_IsValid' + CHARACTER(ML) :: msg + + ! Setup + IsValid = .TRUE. + + ! CD: placeholder for now + + END FUNCTION OP_Input_IsValid + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! OP_Input_Inspect +! +! PURPOSE: +! Subroutine to print the contents of an Zeeman_Input object to stdout. +! +! CALLING SEQUENCE: +! CALL OP_Input_Inspect( op ) +! +! INPUTS: +! z: Zeeman_Input object to display. +! UNITS: N/A +! TYPE: OP_Input_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + SUBROUTINE OP_Input_Inspect(op) + ! Arguments + TYPE(OP_Input_type), INTENT(IN) :: op + !INTEGER, OPTIONAL, INTENT(IN) :: Unit + ! Local variables + INTEGER :: fid + CHARACTER(len=*), PARAMETER :: fmt64 = '(3x,a,es22.15)' ! print in 64-bit precision + CHARACTER(len=*), PARAMETER :: fmt32 = '(3x,a,es13.6)' ! print in 32-bit precision + CHARACTER(len=*), PARAMETER :: fmt = fmt64 ! choose 64-bit precision + + WRITE(*,'(1x,"OP_Input OBJECT")') + WRITE(*,'(3x,"n_Layers :",i0)') op%n_Layers + WRITE(*,'(3x,"n_Phase_Elements :",i0)') op%n_Phase_Elements + WRITE(*,'(3x,"n_Legendre_Terms :",i0)') op%n_Legendre_Terms + WRITE(fid,fmt) "Optical_Depth : ", op%tau + WRITE(fid,fmt) "Backscat_Coefficient : ", op%kb + WRITE(fid,fmt) "Scattering coefficient : ", op%bs + WRITE(fid,fmt) "Phase_Coefficient : ", op%pcoeff + + END SUBROUTINE OP_Input_Inspect + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! OP_Input_WriteFile +! +! PURPOSE: +! Function to write OP_Input object files in netCDF format. +! +! CALLING SEQUENCE: +! Error_Status = OP_Input_WriteFile( & +! Filename, & +! OP, & +! Quiet = Quiet ) +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! INPUTS: + +! Filename: Character string specifying the name of the +! OP_Input data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OP: Object containing the OP_Input data. +! UNITS: N/A +! TYPE: TYPE(OP_Input_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION OP_Input_WriteFile( & + Filename , & ! Input + OP , & ! Input + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(OP_Input_type) , INTENT(IN) :: OP + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'OP_Input_WriteFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + LOGICAL :: Noisy + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: VarId + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check structure pointer association status + IF ( .NOT. OP_Input_Associated( OP ) ) THEN + msg = 'OP_Input structure is empty. Nothing to do!' + CALL Write_CleanUp(); RETURN + END IF + ! ...Check if release is valid + ! IF ( .NOT. OP_Input_ValidRelease( OP ) ) THEN + ! msg = 'OP_Input Release check failed.' + ! CALL Write_Cleanup(); RETURN + ! END IF + ! ...Check Quiet argument + Noisy = .TRUE. + IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet + + ! Create the output file + err_stat = CreateFile( & + Filename , & ! Input + OP%n_Channels , & ! Input + OP%n_Layers , & ! Input + OP%n_Phase_Elements , & ! Input + OP%n_Legendre_Terms , & ! Input + OP%Release , & ! Input + FileId ) ! Output + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error creating output file '//TRIM(Filename) + CALL Write_Cleanup(); RETURN + END IF + + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Write the data items + ! ...tau variable + NF90_Status = NF90_INQ_VARID( FileId,TAU_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TAU_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,OP%tau ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//TAU_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...bs variable + NF90_Status = NF90_INQ_VARID( FileId,BS_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//BS_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,OP%bs ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//BS_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...kb variable + NF90_Status = NF90_INQ_VARID( FileId,KB_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//KB_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,OP%kb ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//KB_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...pcoeff variable + NF90_Status = NF90_INQ_VARID( FileId,PCOEFF_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//PCOEFF_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,OP%pcoeff ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//PCOEFF_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( Noisy ) THEN + CALL OP_Input_Info( OP, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing output file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION OP_Input_WriteFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! OP_Input_ReadFile +! +! PURPOSE: +! Function to read OP_Input object files. +! +! CALLING SEQUENCE: +! Error_Status = OP_Input_ReadFile( Filename , & +! OP , & +! noisy ) +! +! INPUTS: +! Filename: Character string specifying the name of an +! RTSolution format data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! OP: OP_Input object array containing the OP_Input +! data. +! UNITS: N/A +! TYPE: OP_Input +! ATTRIBUTES: INTENT(OUT), ALLOCATABLE +! +! OPTIONAL INPUTS: +! noisy: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .TRUE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .FALSE.,INFORMATION messages are SUPPRESSED. +! If not specified, default is .TRUE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file read was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION OP_Input_ReadFile( & + Filename , & ! Input + OP , & ! Output + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(OP_Input_type), ALLOCATABLE, INTENT(OUT) :: OP + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'OP_Input_ReadFile' + ! Function variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: io_msg + CHARACTER(ML) :: alloc_msg + INTEGER :: io_stat + INTEGER :: alloc_stat + INTEGER :: fid + INTEGER :: l, m, s, c + LOGICAL :: Close_File + INTEGER :: NF90_Status, FileId, VarId, Allocate_Status + INTEGER :: n_Channels + INTEGER :: n_Layers + INTEGER :: n_Phase_Elements + INTEGER :: n_Legendre_Terms + INTEGER :: Release + LOGICAL :: noisy + REAL(fp), ALLOCATABLE :: tau(:,:), bs(:,:), kb(:,:),pcoeff(:,:,:,:) + + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check that the file exists + IF ( .NOT. File_Exists(Filename) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + + ! Inquire the file to get the dimensions + err_stat = OP_Input_InquireFile( & + Filename , & + n_Channels = n_Channels , & + n_Layers = n_Layers , & + n_Phase_Elements = n_Phase_Elements , & + n_Legendre_Terms = n_Legendre_Terms , & + Release = Release ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error obtaining OP_Input dimensions from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + + ! Perform the allocations for local variables + ALLOCATE(tau( n_Channels, n_Layers ), & + bs( n_Channels, n_Layers ), & + kb( n_Channels, n_Layers ), & + pcoeff( n_Channels , & + n_Layers , & + n_Phase_Elements , & + n_Legendre_Terms ), & + STAT = alloc_stat ) + IF ( alloc_stat /= 0 ) RETURN + + ! Open the file for reading + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '//& + TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! ...Close the file if any error from here on + Close_File = .TRUE. + + + ! Read the OP Input data + ! ...tau variable + NF90_Status = NF90_INQ_VARID( FileId,TAU_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TAU_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarID,tau ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//TAU_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...bs variable + NF90_Status = NF90_INQ_VARID( FileId,BS_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//BS_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarID,bs ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//BS_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...kb variable + NF90_Status = NF90_INQ_VARID( FileId,KB_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//KB_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarID,kb ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//KB_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...pcoeff variable + NF90_Status = NF90_INQ_VARID( FileId,PCOEFF_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//PCOEFF_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarID,pcoeff ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//PCOEFF_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! Assign variables + ALLOCATE(OP) + OP%n_Channels = n_Channels + OP%n_Layers = n_Layers + OP%n_Phase_Elements = n_Phase_Elements + OP%n_Legendre_Terms = n_Legendre_Terms + OP%tau = tau + OP%bs = bs + OP%kb = kb + OP%pcoeff = pcoeff + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ); Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( noisy ) THEN + CALL OP_Input_Info( OP, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup- '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + CALL OP_Input_Destroy( OP ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION OP_Input_ReadFile + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! OP_Input_InquireFile +! +! PURPOSE: +! Subroutine to print the contents of an SSU_Input object to stdout. +! +! CALLING SEQUENCE: +! CALL OP_Input_InquireFile( & +! Filename , & ! Input +! n_Channels , & ! Output +! n_Layers , & ! Output +! n_Phase_Elements , & ! Output +! n_Legendre_Terms , & ! Output +! Release ) & ! Output +! +! INPUTS: +! ssu: SSU_Input object to display. +! UNITS: N/A +! TYPE: SSU_Input_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + FUNCTION OP_Input_InquireFile( & + Filename , & ! Input + n_Channels , & ! Output + n_Layers , & ! Output + n_Phase_Elements , & ! Output + n_Legendre_Terms , & ! Output + Release ) & ! Output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(OUT) :: n_Channels + INTEGER , INTENT(OUT) :: n_Layers + INTEGER , INTENT(OUT) :: n_Phase_Elements + INTEGER , INTENT(OUT) :: n_Legendre_Terms + INTEGER , INTENT(OUT) :: Release + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'OP_Input_InquireFile' + ! Function variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: GAttName + INTEGER :: io_stat + INTEGER :: fid + LOGICAL :: Close_File + INTEGER :: NF90_Status, FileId, VarId, DimId + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + + ! Open the file + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + + ! ...Close the file if any error from here on + Close_File = .TRUE. + ! Get the dimensions + ! ...n_Channels dimension + NF90_Status = NF90_INQ_DIMID( FileId,CHANNEL_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=n_Channels ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + ! ...n_Layers dimension + NF90_Status = NF90_INQ_DIMID( FileId,LAYER_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//LAYER_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=n_Layers ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//LAYER_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + ! ...n_Legendre_Terms dimension + NF90_Status = NF90_INQ_DIMID( FileId, LEGENDRE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//LEGENDRE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=n_Legendre_Terms ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//LEGENDRE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + ! ...n_Phase_Elements dimension + NF90_Status = NF90_INQ_DIMID( FileId,PHASE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//PHASE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=n_Phase_Elements ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//PHASE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_CleanUp(); RETURN + END IF + + ! Get the global attributes + GAttName = RELEASE_GATTNAME + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing input file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE ReadGAtts_CleanUp() + err_stat = FAILURE + msg = 'Error reading '//TRIM(GAttName)//' attribute from '//TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( NF90_Status ) ) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE ReadGAtts_CleanUp + + SUBROUTINE Inquire_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup.' + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION OP_Input_InquireFile + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! OP_Input_Destroy +! +! PURPOSE: +! Elemental subroutine to re-initialize CRTM RTSolution objects. +! +! CALLING SEQUENCE: +! CALL OP_Input_Destroy( OP ) +! +! OBJECTS: +! RTSolution: Re-initialized RTSolution structure. +! UNITS: N/A +! TYPE: CRTM_RTSolution_type +! DIMENSION: Scalar OR any rank +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + ELEMENTAL SUBROUTINE OP_Input_Destroy( op ) + TYPE(OP_Input_type), INTENT(OUT) :: op + op%Is_Allocated = .FALSE. + op%n_Channels = 0 + END SUBROUTINE OP_Input_Destroy + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! OP_Input_Info +! +! PURPOSE: +! Subroutine to return a string containing version and dimension +! information about a AerosolCoeff object. +! +! CALLING SEQUENCE: +! CALL OP_Input_Info( OP, Info ) +! +! INPUTS: +! OP: OP_Input object about which info is required. +! UNITS: N/A +! TYPE: TYPE(OP_Input) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! Info: String containing version and dimension information +! about the passed AerosolCoeff object. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + SUBROUTINE OP_Input_Info( OP, Info ) + ! Arguments + TYPE(OP_Input_type), INTENT(IN) :: OP + 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,"OP_Input RELEASE : ",i3, & + &"N_CHANNELS=",i4,2x,& + &"N_LAYERS=",i3,2x,& + &"N_PHASE_ELEMENTS=",i2,2x,& + &"N_LEGENDRE_TERMS=",i2 )' ) & + ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), & + OP%Release , & + OP%n_Channels , & + OP%n_Layers , & + OP%n_Phase_Elements , & + OP%n_Legendre_Terms + + ! Trim the output based on the + ! dummy argument string length + Info = Long_String(1:MIN(LEN(Info), LEN_TRIM(Long_String))) + + END SUBROUTINE OP_Input_Info + +!-------------------------------------------------------------------------------- +! +! NAME: +! OP_Input_Create +! PURPOSE: +! Elemental subroutine to create an instance of a OP_Input object. +! +! CALLING SEQUENCE: +! CALL OP_Input_Create( OP , & +! n_Channels , & +! n_Layers , & +! n_Phase_Elements, & +! n_Legendre_Terms ) +!:sdoc-: +!-------------------------------------------------------------------------------- + + ELEMENTAL SUBROUTINE OP_Input_Create( & + OP , & + n_Channels , & + n_Layers , & + n_Phase_Elements, & + n_Legendre_Terms ) + ! Arguments + TYPE(OP_Input_type), INTENT(OUT) :: OP + INTEGER, INTENT(IN) :: n_Channels + INTEGER, INTENT(IN) :: n_Layers + INTEGER, INTENT(IN) :: n_Phase_Elements + INTEGER, INTENT(IN) :: n_Legendre_Terms + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'OP_Input_Create' + ! Local variables + INTEGER :: alloc_stat + + ! Check input + IF ( n_Channels < 1 .OR. & + n_Layers < 1 .OR. & + n_Legendre_Terms < 0 .OR. & + n_Phase_Elements < 1 ) RETURN + + ! Perform the allocations. + ALLOCATE(OP%tau( n_Channels, n_Layers ), & + OP%bs( n_Channels, n_Layers ), & + OP%kb( n_Channels, n_Layers ), & + OP%pcoeff( n_Channels , & + n_Layers , & + n_Phase_Elements , & + n_Legendre_Terms ), & + STAT = alloc_stat ) + IF ( alloc_stat /= 0 ) RETURN + + ! Initialise + ! ...Dimensions + OP%n_Channels = n_Channels + OP%n_Layers = n_Layers + OP%n_Phase_Elements = n_Phase_Elements + OP%n_Legendre_Terms = n_Legendre_Terms + + ! ...Arrays + OP%tau = ZERO + OP%bs = ZERO + OP%kb = ZERO + OP%pcoeff = ZERO + + ! Set allocationindicator + OP%Is_Allocated = .TRUE. + + END SUBROUTINE OP_Input_Create + +!################################################################################ +!################################################################################ +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + FUNCTION CreateFile( & + Filename , & ! Input + n_Channels , & ! Input + n_Layers , & ! Input + n_Phase_Elements, & ! Input + n_Legendre_Terms, & ! Input + Release , & ! Input + FileId ) & ! Output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: n_Channels + INTEGER , INTENT(IN) :: n_Layers + INTEGER , INTENT(IN) :: n_Phase_Elements + INTEGER , INTENT(IN) :: n_Legendre_Terms + INTEGER , INTENT(IN) :: Release + INTEGER , INTENT(OUT) :: FileId + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'OP_Input_CreateFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + INTEGER :: NF90_Status, VarID + INTEGER :: n_Channels_DimID + INTEGER :: n_Layers_DimID + INTEGER :: n_Phase_Elements_DimID + INTEGER :: n_Legendre_Terms_DimID + INTEGER :: Put_Status(3) + + ! Setup + err_stat = SUCCESS + Close_File = .FALSE. + + ! Create the data file + NF90_Status = NF90_CREATE( Filename,NF90_CLOBBER,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Define the dimensions + ! ...Number of Channels + NF90_Status = NF90_DEF_DIM( FileID,CHANNEL_DIMNAME,n_Channels,n_Channels_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//CHANNEL_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of Layers + NF90_Status = NF90_DEF_DIM( FileID,LAYER_DIMNAME,n_Layers,n_Layers_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//LAYER_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of Phase_Elements + NF90_Status = NF90_DEF_DIM( FileID,PHASE_DIMNAME,n_Phase_Elements,n_Phase_Elements_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//PHASE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of Legendre_Terms + NF90_Status = NF90_DEF_DIM( FileID,LEGENDRE_DIMNAME,n_Legendre_Terms,n_Legendre_Terms_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//LEGENDRE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + + ! Write the global attributes + NF90_Status = NF90_PUT_ATT( FileId, NF90_GLOBAL,TRIM(RELEASE_GATTNAME),Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error setting '//RELEASE_GATTNAME//' global attribute in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + + + ! Write the variables + ! ...tau variable + NF90_Status = NF90_DEF_VAR( FileID, & + TAU_VARNAME, & + FLOAT_TYPE, & + dimIDs=(/n_Channels_DimID, n_Layers_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TAU_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME ,TAU_DESCRIPTION) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,TAU_UNITS) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,FILL_FLOAT) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//TAU_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...bs variable + NF90_Status = NF90_DEF_VAR( FileID, & + BS_VARNAME, & + FLOAT_TYPE, & + dimIDs=(/n_Channels_DimID, n_Layers_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//BS_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME ,BS_DESCRIPTION) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,BS_UNITS) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,FILL_FLOAT) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//BS_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...kb variable + NF90_Status = NF90_DEF_VAR( FileID, & + KB_VARNAME, & + FLOAT_TYPE, & + dimIDs=(/n_Channels_DimID, n_Layers_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//KB_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME ,KB_DESCRIPTION) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,KB_UNITS) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,FILL_FLOAT) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//KB_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...pcoeff variable + NF90_Status = NF90_DEF_VAR( FileID, & + PCOEFF_VARNAME, & + FLOAT_TYPE, & + dimIDs=(/n_Channels_DimID, n_Layers_DimID, n_Phase_Elements_DimID, n_Legendre_Terms_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//PCOEFF_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME ,PCOEFF_DESCRIPTION) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,PCOEFF_UNITS) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,FILL_FLOAT) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//PCOEFF_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + ! Take netCDF file out of define mode + NF90_Status = NF90_ENDDEF( FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error taking file '//TRIM(Filename)// & + ' out of define mode - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE Create_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileID ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Create_CleanUp + + END FUNCTION CreateFile + + + ! --------------------------------------------------------------------------- + + ELEMENTAL FUNCTION OP_Input_Equal(x, y) RESULT(is_equal) + TYPE(OP_Input_type), INTENT(IN) :: x, y + LOGICAL :: is_equal + + ! Setup + is_equal = .FALSE. + + is_equal = (x%n_Layers == y%n_Layers ) .AND. & + (x%n_Phase_Elements == y%n_Phase_Elements ) .AND. & + (x%n_Legendre_Terms == y%n_Legendre_Terms ) !.AND. & + ! ALL(x%Optical_Depth .EqualTo. y%Optical_Depth ) .AND. & + ! ALL(x%Single_Scatter_Albedo .EqualTo. y%Single_Scatter_Albedo) .AND. & + ! ALL(x%Asymmetry_Factor .EqualTo. y%Asymmetry_Factor ) .AND. & + ! ALL(x%Backscat_Coefficient .EqualTo. y%Backscat_Coefficient ) .AND. & + ! ALL(x%Delta_Truncation .EqualTo. y%Delta_Truncation ) .AND. & + ! ALL(x%Phase_Coefficient .EqualTo. y%Phase_Coefficient ) + END FUNCTION OP_Input_Equal + +END MODULE OP_Input_Define From 5003525b8b9510ab0eb4307776f54e4e79b5a284 Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Wed, 8 Jul 2026 14:32:17 -0600 Subject: [PATCH 03/10] Code updates to adopt OP data sturcture (forward only) --- .gitignore | 1 + src/CMakeLists.txt | 1 + src/CRTM_Forward_Module.f90 | 116 +++++++++++++++++++++++++++--------- src/CRTM_Module.F90 | 1 + 4 files changed, 91 insertions(+), 28 deletions(-) diff --git a/.gitignore b/.gitignore index d2322c0c..18d26ae3 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,4 @@ rebuild.bash .gitignore *~ conductor/ +.vscode/ diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ca09bba1..0ac8b109 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -133,6 +133,7 @@ list( APPEND crtm_src_files Options/CRTM_Options_Define.f90 Options/SSU_Input/SSU_Input_Define.f90 Options/Zeeman_Input/Zeeman_Input_Define.f90 + Options/OP_Input/OP_Input_Define.f90 RTSolution/ADA/ADA_Module.f90 RTSolution/Common_RTSolution.f90 RTSolution/CRTM_RTSolution_Define.f90 diff --git a/src/CRTM_Forward_Module.f90 b/src/CRTM_Forward_Module.f90 index f0141d01..8ec0aee4 100644 --- a/src/CRTM_Forward_Module.f90 +++ b/src/CRTM_Forward_Module.f90 @@ -98,6 +98,11 @@ MODULE CRTM_Forward_Module USE CRTM_CloudCover_Define, ONLY: CRTM_CloudCover_type USE CRTM_Active_Sensor, ONLY: CRTM_Compute_Reflectivity, & Calculate_Cloud_Water_Density + USE OP_Input_Define, ONLY: OP_Input_type , & + OP_Input_Create , & + OP_Input_WriteFile , & + OP_Input_ReadFile , & + OP_Input_Associated ! Internal variable definition modules ! ...AtmOptics @@ -443,6 +448,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) LOGICAL :: Atmosphere_Invalid, Surface_Invalid, Geometry_Invalid, Options_Invalid INTEGER :: iFOV INTEGER :: n, l ! sensor index, channel index + INTEGER :: ilay, iphas, ileg, ileg1 INTEGER :: SensorIndex INTEGER :: ChannelIndex INTEGER :: ln, nc, ks @@ -456,6 +462,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) INTEGER :: nt, start_ch, end_ch, chunk_ch, n_sensor_channels INTEGER :: n_inactive_channels(n_channel_threads+1) + TYPE(OP_Input_type) :: TOP ! Local atmosphere structure for extra layering TYPE(CRTM_Atmosphere_type) :: Atm ! Clear sky structures @@ -993,43 +1000,96 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END IF END IF - ! Compute the cloud particle absorption/scattering properties - IF( Atm%n_Clouds > 0 ) THEN - Error_Status = CRTM_Compute_CloudScatter( Atm , & ! Input - GeometryInfo , & ! Input - SensorIndex , & ! Input - ChannelIndex , & ! Input - AtmOptics(nt), & ! Output - CSvar(nt) ) ! Internal variable output - IF ( Error_Status /= SUCCESS ) THEN - WRITE( Message,'("Error computing CloudScatter for ",a,& - &", channel ",i0,", profile #",i0)' ) & - TRIM(ChannelInfo(n)%Sensor_ID), ChannelInfo(n)%Sensor_Channel(l), m - CALL Display_Message( ROUTINE_NAME, Message, Error_Status ) - END IF - END IF + ! Optical properties of clouds and aerosols + IF ( Options_Present .AND. opt%Use_Total_OP ) THEN + AtmOptics(nt)%Include_Scattering = .TRUE. + DO ilay = 1, Atm%n_Layers + AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%TOP%tau(ChannelIndex, ilay) + AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%TOP%bs(ChannelIndex, ilay) + AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%TOP%kb(ChannelIndex, ilay) + DO iphas = 1, 1 + DO ileg = 0, AtmOptics(nt)%n_Legendre_Terms + ileg1 = ileg + 1 + AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) = AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) + & + opt%TOP%pcoeff(ChannelIndex,ilay,iphas,ileg1) + END DO + END DO + END DO - ! Compute the aerosol absorption/scattering properties - IF ( Atm%n_Aerosols > 0 ) THEN - Error_Status = CRTM_Compute_AerosolScatter( Atm , & ! Input - SensorIndex , & ! Input - ChannelIndex , & ! Input - AtmOptics(nt), & ! In/Output - ASvar(nt) ) ! Internal variable output + ELSE - IF ( Error_Status /= SUCCESS ) THEN - WRITE( Message,'("Error computing AerosolScatter for ",a,& - &", channel ",i0,", profile #",i0)' ) & - TRIM(ChannelInfo(n)%Sensor_ID), ChannelInfo(n)%Sensor_Channel(l), m - CALL Display_Message( ROUTINE_NAME, Message, Error_Status ) + ! ...Clouds + IF ( Options_Present .AND. opt%Use_Cloud_OP ) THEN + ! Use user-defined cloud optical profiles + AtmOptics(nt)%Include_Scattering = .TRUE. + DO ilay = 1, Atm%n_Layers + AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%COP%tau(ChannelIndex, ilay) + AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%COP%bs(ChannelIndex, ilay) + AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%COP%kb(ChannelIndex, ilay) + DO iphas = 1, 1 + DO ileg = 0, AtmOptics(nt)%n_Legendre_Terms + ileg1 = ileg + 1 + AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) = AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) + & + opt%COP%pcoeff(ChannelIndex,ilay,iphas,ileg1) + END DO + END DO + END DO + ELSEIF( Atm%n_Clouds > 0 ) THEN + ! Compute the cloud particle absorption/scattering properties + Error_Status = CRTM_Compute_CloudScatter( Atm , & ! Input + GeometryInfo , & ! Input + SensorIndex , & ! Input + ChannelIndex , & ! Input + AtmOptics(nt), & ! Output + CSvar(nt) ) ! Internal variable output + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error computing CloudScatter for ",a,& + &", channel ",i0,", profile #",i0)' ) & + TRIM(ChannelInfo(n)%Sensor_ID), ChannelInfo(n)%Sensor_Channel(l), m + CALL Display_Message( ROUTINE_NAME, Message, Error_Status ) + END IF END IF - END IF + + ! ...Aerosols + IF ( Options_Present .AND. opt%Use_Aerosol_OP ) THEN + ! Use user-defined aerosol optical profiles + AtmOptics(nt)%Include_Scattering = .TRUE. + DO ilay = 1, Atm%n_Layers + AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%AOP%tau(ChannelIndex, ilay) + AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%AOP%bs(ChannelIndex, ilay) + AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%AOP%kb(ChannelIndex, ilay) + DO iphas = 1, 1 + DO ileg = 0, AtmOptics(nt)%n_Legendre_Terms + ileg1 = ileg + 1 + AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) = AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) + & + opt%AOP%pcoeff(ChannelIndex,ilay,iphas,ileg1) + END DO + END DO + END DO + ELSEIF ( Atm%n_Aerosols > 0 ) THEN + ! Compute the aerosol absorption/scattering properties + Error_Status = CRTM_Compute_AerosolScatter( Atm , & ! Input + SensorIndex , & ! Input + ChannelIndex, & ! Input + AtmOptics(nt) , & ! In/Output + ASvar(nt) ) ! Internal variable output + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error computing AerosolScatter for ",a,& + &", channel ",i0,", profile #",i0)' ) & + TRIM(ChannelInfo(n)%Sensor_ID), ChannelInfo(n)%Sensor_Channel(l), m + CALL Display_Message( ROUTINE_NAME, Message, Error_Status ) + END IF + END IF + END IF ! opt%Use_Total_OP + ! Compute the combined atmospheric optical properties IF( AtmOptics(nt)%Include_Scattering ) THEN CALL CRTM_AtmOptics_Combine( AtmOptics(nt), AOvar(nt) ) END IF + + ! ...Save vertically integrated scattering optical depth for output RTSolution(ln,m)%SOD = AtmOptics(nt)%Scattering_Optical_Depth diff --git a/src/CRTM_Module.F90 b/src/CRTM_Module.F90 index 0a29c96c..74455f93 100644 --- a/src/CRTM_Module.F90 +++ b/src/CRTM_Module.F90 @@ -21,6 +21,7 @@ MODULE CRTM_Module USE CRTM_RTSolution_Define USE CRTM_Options_Define USE CRTM_AncillaryInput_Define + USE OP_Input_Define USE CRTM_IRlandCoeff , ONLY: CRTM_IRlandCoeff_Classification ! Parameter definition module From 5aaebd4e998045b5b9bc034811d64533237793ef Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Wed, 8 Jul 2026 14:51:48 -0600 Subject: [PATCH 04/10] Unit test for optional optical profile interface (test_OP.f90) --- test/CMakeLists.txt | 14 +- .../Unit_Test/Load_Atm_Data_SingleProfile.inc | 245 ++++++++++++ .../Unit_Test/Load_Sfc_Data_SingleProfile.inc | 44 +++ .../mains/unit/Unit_Test/TOP_SingleProfile.nc | Bin 0 -> 48812 bytes test/mains/unit/Unit_Test/test_OP.f90 | 366 ++++++++++++++++++ 5 files changed, 668 insertions(+), 1 deletion(-) create mode 100644 test/mains/unit/Unit_Test/Load_Atm_Data_SingleProfile.inc create mode 100644 test/mains/unit/Unit_Test/Load_Sfc_Data_SingleProfile.inc create mode 100644 test/mains/unit/Unit_Test/TOP_SingleProfile.nc create mode 100644 test/mains/unit/Unit_Test/test_OP.f90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 7832e7fe..1f0a5d79 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -1,4 +1,4 @@ -# (C) Copyright 2017-2018 UCAR. +../../../CMakeLists.txt# (C) Copyright 2017-2018 UCAR. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. @@ -339,6 +339,12 @@ add_test(NAME test_Unit_Aerosol_Bypass_k_matrix COMMAND $) set_tests_properties(test_Unit_Aerosol_Bypass_k_matrix PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") +add_executable(Unit_OP_TEST mains/unit/Unit_Test/test_OP.f90) +target_link_libraries(Unit_OP_TEST PRIVATE crtm) +add_test(NAME test_Unit_OP_TEST + COMMAND $) +set_tests_properties(test_Unit_OP_TEST PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") + #SpcCoeff utilities list (APPEND SCoeff_Utils SpcCoeff_Edit @@ -685,6 +691,12 @@ SpcCoeff/Little_Endian/ssu_n11.SpcCoeff.bin SpcCoeff/Little_Endian/ssu_n14.SpcCoeff.bin ) +# update this and merge into the list above +# Symlink OP test data +CREATE_SYMLINK_FILENAME( $ENV{CRTM_TEST_ROOT}/mains/unit/Unit_Test + ${CMAKE_CURRENT_BINARY_DIR}/testinput + TOP_SingleProfile.nc ) + # Symlink all CRTM files # Version 3 CREATE_SYMLINK_FILENAME( ${CRTM_COEFFS_PATH}/${CRTM_COEFFS_BRANCH_PREFIX}/${CRTM_COEFFS_BRANCH}/fix diff --git a/test/mains/unit/Unit_Test/Load_Atm_Data_SingleProfile.inc b/test/mains/unit/Unit_Test/Load_Atm_Data_SingleProfile.inc new file mode 100644 index 00000000..a505d545 --- /dev/null +++ b/test/mains/unit/Unit_Test/Load_Atm_Data_SingleProfile.inc @@ -0,0 +1,245 @@ + ! + ! Include file containing an internal subprogam to load some test profile data + ! + SUBROUTINE Load_Atm_Data_SingleProfile() + ! Local variables + INTEGER :: nc + INTEGER :: k1, k2 + + + ! 4a.1 Profile #1 + ! --------------- + ! ...Profile and absorber definitions + atm(1)%Climatology = US_STANDARD_ATMOSPHERE + atm(1)%Absorber_Id(1:2) = (/ H2O_ID , O3_ID /) + atm(1)%Absorber_Units(1:2) = (/ MASS_MIXING_RATIO_UNITS, VOLUME_MIXING_RATIO_UNITS /) + ! ...Profile data + atm(1)%Level_Pressure = & + (/0.714_fp, 0.975_fp, 1.297_fp, 1.687_fp, 2.153_fp, 2.701_fp, 3.340_fp, 4.077_fp, & + 4.920_fp, 5.878_fp, 6.957_fp, 8.165_fp, 9.512_fp, 11.004_fp, 12.649_fp, 14.456_fp, & + 16.432_fp, 18.585_fp, 20.922_fp, 23.453_fp, 26.183_fp, 29.121_fp, 32.274_fp, 35.650_fp, & + 39.257_fp, 43.100_fp, 47.188_fp, 51.528_fp, 56.126_fp, 60.990_fp, 66.125_fp, 71.540_fp, & + 77.240_fp, 83.231_fp, 89.520_fp, 96.114_fp, 103.017_fp, 110.237_fp, 117.777_fp, 125.646_fp, & + 133.846_fp, 142.385_fp, 151.266_fp, 160.496_fp, 170.078_fp, 180.018_fp, 190.320_fp, 200.989_fp, & + 212.028_fp, 223.441_fp, 235.234_fp, 247.409_fp, 259.969_fp, 272.919_fp, 286.262_fp, 300.000_fp, & + 314.137_fp, 328.675_fp, 343.618_fp, 358.967_fp, 374.724_fp, 390.893_fp, 407.474_fp, 424.470_fp, & + 441.882_fp, 459.712_fp, 477.961_fp, 496.630_fp, 515.720_fp, 535.232_fp, 555.167_fp, 575.525_fp, & + 596.306_fp, 617.511_fp, 639.140_fp, 661.192_fp, 683.667_fp, 706.565_fp, 729.886_fp, 753.627_fp, & + 777.790_fp, 802.371_fp, 827.371_fp, 852.788_fp, 878.620_fp, 904.866_fp, 931.524_fp, 958.591_fp, & + 986.067_fp,1013.948_fp,1042.232_fp,1070.917_fp,1100.000_fp/) + + atm(1)%Pressure = & + (/0.838_fp, 1.129_fp, 1.484_fp, 1.910_fp, 2.416_fp, 3.009_fp, 3.696_fp, 4.485_fp, & + 5.385_fp, 6.402_fp, 7.545_fp, 8.822_fp, 10.240_fp, 11.807_fp, 13.532_fp, 15.423_fp, & + 17.486_fp, 19.730_fp, 22.163_fp, 24.793_fp, 27.626_fp, 30.671_fp, 33.934_fp, 37.425_fp, & + 41.148_fp, 45.113_fp, 49.326_fp, 53.794_fp, 58.524_fp, 63.523_fp, 68.797_fp, 74.353_fp, & + 80.198_fp, 86.338_fp, 92.778_fp, 99.526_fp, 106.586_fp, 113.965_fp, 121.669_fp, 129.703_fp, & + 138.072_fp, 146.781_fp, 155.836_fp, 165.241_fp, 175.001_fp, 185.121_fp, 195.606_fp, 206.459_fp, & + 217.685_fp, 229.287_fp, 241.270_fp, 253.637_fp, 266.392_fp, 279.537_fp, 293.077_fp, 307.014_fp, & + 321.351_fp, 336.091_fp, 351.236_fp, 366.789_fp, 382.751_fp, 399.126_fp, 415.914_fp, 433.118_fp, & + 450.738_fp, 468.777_fp, 487.236_fp, 506.115_fp, 525.416_fp, 545.139_fp, 565.285_fp, 585.854_fp, & + 606.847_fp, 628.263_fp, 650.104_fp, 672.367_fp, 695.054_fp, 718.163_fp, 741.693_fp, 765.645_fp, & + 790.017_fp, 814.807_fp, 840.016_fp, 865.640_fp, 891.679_fp, 918.130_fp, 944.993_fp, 972.264_fp, & + 999.942_fp,1028.025_fp,1056.510_fp,1085.394_fp/) + + atm(1)%Temperature = & + (/256.186_fp, 252.608_fp, 247.762_fp, 243.314_fp, 239.018_fp, 235.282_fp, 233.777_fp, 234.909_fp, & + 237.889_fp, 241.238_fp, 243.194_fp, 243.304_fp, 242.977_fp, 243.133_fp, 242.920_fp, 242.026_fp, & + 240.695_fp, 239.379_fp, 238.252_fp, 236.928_fp, 235.452_fp, 234.561_fp, 234.192_fp, 233.774_fp, & + 233.305_fp, 233.053_fp, 233.103_fp, 233.307_fp, 233.702_fp, 234.219_fp, 234.959_fp, 235.940_fp, & + 236.744_fp, 237.155_fp, 237.374_fp, 238.244_fp, 239.736_fp, 240.672_fp, 240.688_fp, 240.318_fp, & + 239.888_fp, 239.411_fp, 238.512_fp, 237.048_fp, 235.388_fp, 233.551_fp, 231.620_fp, 230.418_fp, & + 229.927_fp, 229.511_fp, 229.197_fp, 228.947_fp, 228.772_fp, 228.649_fp, 228.567_fp, 228.517_fp, & + 228.614_fp, 228.861_fp, 229.376_fp, 230.223_fp, 231.291_fp, 232.591_fp, 234.013_fp, 235.508_fp, & + 237.041_fp, 238.589_fp, 240.165_fp, 241.781_fp, 243.399_fp, 244.985_fp, 246.495_fp, 247.918_fp, & + 249.073_fp, 250.026_fp, 251.113_fp, 252.321_fp, 253.550_fp, 254.741_fp, 256.089_fp, 257.692_fp, & + 259.358_fp, 261.010_fp, 262.779_fp, 264.702_fp, 266.711_fp, 268.863_fp, 271.103_fp, 272.793_fp, & + 273.356_fp, 273.356_fp, 273.356_fp, 273.356_fp/) + + atm(1)%Absorber(:,1) = & + (/4.187E-03_fp,4.401E-03_fp,4.250E-03_fp,3.688E-03_fp,3.516E-03_fp,3.739E-03_fp,3.694E-03_fp,3.449E-03_fp, & + 3.228E-03_fp,3.212E-03_fp,3.245E-03_fp,3.067E-03_fp,2.886E-03_fp,2.796E-03_fp,2.704E-03_fp,2.617E-03_fp, & + 2.568E-03_fp,2.536E-03_fp,2.506E-03_fp,2.468E-03_fp,2.427E-03_fp,2.438E-03_fp,2.493E-03_fp,2.543E-03_fp, & + 2.586E-03_fp,2.632E-03_fp,2.681E-03_fp,2.703E-03_fp,2.636E-03_fp,2.512E-03_fp,2.453E-03_fp,2.463E-03_fp, & + 2.480E-03_fp,2.499E-03_fp,2.526E-03_fp,2.881E-03_fp,3.547E-03_fp,4.023E-03_fp,4.188E-03_fp,4.223E-03_fp, & + 4.252E-03_fp,4.275E-03_fp,4.105E-03_fp,3.675E-03_fp,3.196E-03_fp,2.753E-03_fp,2.338E-03_fp,2.347E-03_fp, & + 2.768E-03_fp,3.299E-03_fp,3.988E-03_fp,4.531E-03_fp,4.625E-03_fp,4.488E-03_fp,4.493E-03_fp,4.614E-03_fp, & + 7.523E-03_fp,1.329E-02_fp,2.468E-02_fp,4.302E-02_fp,6.688E-02_fp,9.692E-02_fp,1.318E-01_fp,1.714E-01_fp, & + 2.149E-01_fp,2.622E-01_fp,3.145E-01_fp,3.726E-01_fp,4.351E-01_fp,5.002E-01_fp,5.719E-01_fp,6.507E-01_fp, & + 7.110E-01_fp,7.552E-01_fp,8.127E-01_fp,8.854E-01_fp,9.663E-01_fp,1.050E+00_fp,1.162E+00_fp,1.316E+00_fp, & + 1.494E+00_fp,1.690E+00_fp,1.931E+00_fp,2.226E+00_fp,2.574E+00_fp,2.939E+00_fp,3.187E+00_fp,3.331E+00_fp, & + 3.352E+00_fp,3.260E+00_fp,3.172E+00_fp,3.087E+00_fp/) + + atm(1)%Absorber(:,2) = & + (/3.035E+00_fp,3.943E+00_fp,4.889E+00_fp,5.812E+00_fp,6.654E+00_fp,7.308E+00_fp,7.660E+00_fp,7.745E+00_fp, & + 7.696E+00_fp,7.573E+00_fp,7.413E+00_fp,7.246E+00_fp,7.097E+00_fp,6.959E+00_fp,6.797E+00_fp,6.593E+00_fp, & + 6.359E+00_fp,6.110E+00_fp,5.860E+00_fp,5.573E+00_fp,5.253E+00_fp,4.937E+00_fp,4.625E+00_fp,4.308E+00_fp, & + 3.986E+00_fp,3.642E+00_fp,3.261E+00_fp,2.874E+00_fp,2.486E+00_fp,2.102E+00_fp,1.755E+00_fp,1.450E+00_fp, & + 1.208E+00_fp,1.087E+00_fp,1.030E+00_fp,1.005E+00_fp,1.010E+00_fp,1.028E+00_fp,1.068E+00_fp,1.109E+00_fp, & + 1.108E+00_fp,1.071E+00_fp,9.928E-01_fp,8.595E-01_fp,7.155E-01_fp,5.778E-01_fp,4.452E-01_fp,3.372E-01_fp, & + 2.532E-01_fp,1.833E-01_fp,1.328E-01_fp,9.394E-02_fp,6.803E-02_fp,5.152E-02_fp,4.569E-02_fp,4.855E-02_fp, & + 5.461E-02_fp,6.398E-02_fp,7.205E-02_fp,7.839E-02_fp,8.256E-02_fp,8.401E-02_fp,8.412E-02_fp,8.353E-02_fp, & + 8.269E-02_fp,8.196E-02_fp,8.103E-02_fp,7.963E-02_fp,7.741E-02_fp,7.425E-02_fp,7.067E-02_fp,6.702E-02_fp, & + 6.368E-02_fp,6.070E-02_fp,5.778E-02_fp,5.481E-02_fp,5.181E-02_fp,4.920E-02_fp,4.700E-02_fp,4.478E-02_fp, & + 4.207E-02_fp,3.771E-02_fp,3.012E-02_fp,1.941E-02_fp,9.076E-03_fp,2.980E-03_fp,5.117E-03_fp,1.160E-02_fp, & + 1.428E-02_fp,1.428E-02_fp,1.428E-02_fp,1.428E-02_fp/) + + + ! Load CO2 absorber data if there are three absorrbers + IF ( atm(1)%n_Absorbers > 2 ) THEN + atm(1)%Absorber_Id(3) = CO2_ID + atm(1)%Absorber_Units(3) = VOLUME_MIXING_RATIO_UNITS + atm(1)%Absorber(:,3) = 380.0_fp + END IF + + + ! Cloud data + IF ( atm(1)%n_Clouds > 0 ) THEN + k1 = 60 + k2 = 80 + DO nc = 1, atm(1)%n_Clouds + atm(1)%Cloud_Fraction = 1.0_fp + atm(1)%Cloud(nc)%Is_Allocated = .TRUE. + atm(1)%Cloud(nc)%Type = SNOW_CLOUD + atm(1)%Cloud(nc)%Effective_Radius(k1:k2) = 20.0_fp ! microns + atm(1)%Cloud(nc)%Water_Content(k1:k2) = 5.0_fp ! kg/m^2 + END DO + END IF + + + ! Aerosol data. Three aerosol types can be loaded: + ! Dust, Sulphate, and Sea Salt SSCM3 + Load_Aerosol_Data_1: IF ( atm(1)%n_Aerosols > 0 ) THEN + + atm(1)%Aerosol(1)%Type = DUST_AEROSOL + atm(1)%Aerosol(1)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 5.305110E-16_fp, & + 7.340409E-16_fp, 1.037097E-15_fp, 1.496791E-15_fp, 2.207471E-15_fp, 3.327732E-15_fp, & + 5.128933E-15_fp, 8.083748E-15_fp, 1.303055E-14_fp, 2.148368E-14_fp, 3.622890E-14_fp, & + 6.248544E-14_fp, 1.102117E-13_fp, 1.987557E-13_fp, 3.663884E-13_fp, 6.901587E-13_fp, & + 1.327896E-12_fp, 2.608405E-12_fp, 5.228012E-12_fp, 1.068482E-11_fp, 2.225098E-11_fp, & + 4.717675E-11_fp, 1.017447E-10_fp, 2.229819E-10_fp, 4.960579E-10_fp, 1.118899E-09_fp, & + 2.555617E-09_fp, 5.902789E-09_fp, 1.376717E-08_fp, 3.237321E-08_fp, 7.662427E-08_fp, & + 1.822344E-07_fp, 4.346896E-07_fp, 1.037940E-06_fp, 2.475858E-06_fp, 5.887266E-06_fp, & + 1.392410E-05_fp, 3.267943E-05_fp, 7.592447E-05_fp, 1.741777E-04_fp, 3.935216E-04_fp, & + 8.732308E-04_fp, 1.897808E-03_fp, 4.027868E-03_fp, 8.323272E-03_fp, 1.669418E-02_fp, & + 3.239702E-02_fp, 6.063055E-02_fp, 1.090596E-01_fp, 1.878990E-01_fp, 3.089856E-01_fp, & + 4.832092E-01_fp, 7.159947E-01_fp, 1.001436E+00_fp, 1.317052E+00_fp, 1.622354E+00_fp, & + 1.864304E+00_fp, 1.990457E+00_fp, 1.966354E+00_fp, 1.789883E+00_fp, 1.494849E+00_fp, & + 1.140542E+00_fp, 7.915451E-01_fp, 4.974823E-01_fp, 2.818937E-01_fp, 1.433668E-01_fp, & + 6.514795E-02_fp, 2.633057E-02_fp, 9.421763E-03_fp, 2.971053E-03_fp, 8.218245E-04_fp/) + atm(1)%Aerosol(1)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 2.458105E-18_fp, 1.983430E-16_fp, & + 1.191432E-14_fp, 5.276880E-13_fp, 1.710270E-11_fp, 4.035105E-10_fp, 6.911389E-09_fp, & + 8.594215E-08_fp, 7.781797E-07_fp, 5.162773E-06_fp, 2.534018E-05_fp, 9.325154E-05_fp, & + 2.617738E-04_fp, 5.727150E-04_fp, 1.002153E-03_fp, 1.446048E-03_fp, 1.782757E-03_fp, & + 1.955759E-03_fp, 1.999206E-03_fp, 1.994698E-03_fp, 1.913109E-03_fp, 1.656122E-03_fp, & + 1.206328E-03_fp, 6.847261E-04_fp, 2.785695E-04_fp, 7.418821E-05_fp, 1.172680E-05_fp, & + 9.900895E-07_fp, 3.987399E-08_fp, 6.786932E-10_fp, 4.291151E-12_fp, 8.785440E-15_fp/) + + IF ( atm(1)%n_Aerosols > 1 ) THEN + atm(1)%Aerosol(2)%Type = SULFATE_AEROSOL + atm(1)%Aerosol(2)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.060238E-01_fp, 3.652677E-01_fp, 4.139419E-01_fp, 4.438249E-01_fp, & + 4.486394E-01_fp, 4.261471E-01_fp, 3.795067E-01_fp, 3.174571E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.243099E-01_fp, 4.662931E-01_fp, & + 6.103025E-01_fp, 6.958640E-01_fp, 6.776480E-01_fp, 5.570077E-01_fp, 3.828734E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp/) + atm(1)%Aerosol(2)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 7.299549E-21_fp, 2.154532E-20_fp, 6.848207E-20_fp, & + 2.339296E-19_fp, 8.562906E-19_fp, 3.346100E-18_fp, 1.389284E-17_fp, 6.094260E-17_fp, & + 2.805828E-16_fp, 1.345656E-15_fp, 6.665967E-15_fp, 3.378989E-14_fp, 1.734933E-13_fp, & + 8.924837E-13_fp, 4.546743E-12_fp, 2.266249E-11_fp, 1.091369E-10_fp, 5.013496E-10_fp, & + 2.168936E-09_fp, 8.725800E-09_fp, 3.224980E-08_fp, 1.082545E-07_fp, 3.266343E-07_fp, & + 8.780083E-07_fp, 2.087760E-06_fp, 4.370441E-06_fp, 8.038113E-06_fp, 1.300537E-05_fp, & + 1.860671E-05_fp, 2.376757E-05_fp, 2.751048E-05_fp, 2.945706E-05_fp, 2.998589E-05_fp, & + 2.995521E-05_fp, 2.909387E-05_fp, 2.609907E-05_fp, 2.031620E-05_fp, 1.274989E-05_fp, & + 5.920554E-06_fp, 1.842346E-06_fp, 3.429331E-07_fp, 3.355556E-08_fp, 1.506455E-09_fp, & + 1.720306E-10_fp, 1.161071E-09_fp, 7.599420E-09_fp, 4.096076E-08_fp, 1.815570E-07_fp, & + 6.623233E-07_fp, 1.994766E-06_fp, 4.987904E-06_fp, 1.044158E-05_fp, 1.850659E-05_fp, & + 2.817442E-05_fp, 3.750360E-05_fp, 4.459276E-05_fp, 4.857087E-05_fp, 4.990199E-05_fp, & + 4.998888E-05_fp, 4.922362E-05_fp, 4.582548E-05_fp, 3.844906E-05_fp, 2.757877E-05_fp, & + 1.615474E-05_fp, 9.509965E-06_fp, 1.672265E-05_fp, 4.602962E-05_fp, 8.740809E-05_fp, & + 1.165118E-04_fp, 1.248318E-04_fp, 1.240508E-04_fp, 1.095622E-04_fp, 7.116027E-05_fp, & + 2.756351E-05_fp, 5.072010E-06_fp, 3.467497E-07_fp, 6.759169E-09_fp, 2.828000E-11_fp/) + END IF + + IF ( atm(1)%n_Aerosols > 2 ) THEN + atm(1)%Aerosol(3)%Type = SEASALT_SSCM3_AEROSOL + atm(1)%Aerosol(3)%Effective_Radius = & ! microns + (/7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp/) + atm(1)%Aerosol(3)%Concentration = & ! kg/m^2 + (/1.834405E-15_fp, 2.004881E-15_fp, & + 2.234084E-15_fp, 2.543453E-15_fp, 2.964461E-15_fp, 3.544295E-15_fp, 4.355235E-15_fp, & + 5.510452E-15_fp, 7.191267E-15_fp, 9.695182E-15_fp, 1.352261E-14_fp, 1.953716E-14_fp, & + 2.926925E-14_fp, 4.550553E-14_fp, 7.346181E-14_fp, 1.231759E-13_fp, 2.145104E-13_fp, & + 3.878653E-13_fp, 7.276576E-13_fp, 1.414927E-12_fp, 2.847645E-12_fp, 5.921044E-12_fp, & + 1.269153E-11_fp, 2.797048E-11_fp, 6.318984E-11_fp, 1.458383E-10_fp, 3.425444E-10_fp, & + 8.153831E-10_fp, 1.958067E-09_fp, 4.720525E-09_fp, 1.136570E-08_fp, 2.718180E-08_fp, & + 6.420674E-08_fp, 1.489302E-07_fp, 3.372331E-07_fp, 7.410874E-07_fp, 1.571399E-06_fp, & + 3.197064E-06_fp, 6.208220E-06_fp, 1.145048E-05_fp, 1.997373E-05_fp, 3.283395E-05_fp, & + 5.072822E-05_fp, 7.354173E-05_fp, 1.000035E-04_fp, 1.276931E-04_fp, 1.535301E-04_fp, & + 1.746342E-04_fp, 1.892127E-04_fp, 1.971011E-04_fp, 1.997815E-04_fp, 1.999842E-04_fp, & + 1.985580E-04_fp, 1.917087E-04_fp, 1.753846E-04_fp, 1.474980E-04_fp, 1.101113E-04_fp, & + 7.010137E-05_fp, 3.636523E-05_fp, 1.460058E-05_fp, 4.282477E-06_fp, 8.603007E-07_fp, & + 1.101800E-07_fp, 8.310010E-09_fp, 3.382006E-10_fp, 6.751810E-12_fp, 3.060195E-13_fp, & + 9.145434E-12_fp, 2.343817E-10_fp, 4.156377E-09_fp, 5.122906E-08_fp, 4.424084E-07_fp, & + 2.708849E-06_fp, 1.194846E-05_fp, 3.874236E-05_fp, 9.466062E-05_fp, 1.795200E-04_fp, & + 2.735688E-04_fp, 3.486493E-04_fp, 3.889143E-04_fp, 3.997242E-04_fp, 3.991008E-04_fp, & + 3.826235E-04_fp, 3.287943E-04_fp, 2.344766E-04_fp, 1.275907E-04_fp, 4.835821E-05_fp, & + 1.156687E-05_fp, 1.570009E-06_fp, 1.078885E-07_fp, 3.321985E-09_fp, 4.023206E-11_fp/) + END IF + END IF Load_Aerosol_Data_1 + + END SUBROUTINE Load_Atm_Data_SingleProfile diff --git a/test/mains/unit/Unit_Test/Load_Sfc_Data_SingleProfile.inc b/test/mains/unit/Unit_Test/Load_Sfc_Data_SingleProfile.inc new file mode 100644 index 00000000..25988523 --- /dev/null +++ b/test/mains/unit/Unit_Test/Load_Sfc_Data_SingleProfile.inc @@ -0,0 +1,44 @@ + ! + ! Include file containing an internal subprogam to load some test surface data + ! + SUBROUTINE Load_Sfc_Data_SingleProfile() + + + ! 4a.0 Surface type definitions for default SfcOptics definitions + ! For IR and VIS, this is the NPOESS reflectivities. + ! --------------------------------------------------------------- + INTEGER, PARAMETER :: TUNDRA_SURFACE_TYPE = 10 ! NPOESS Land surface type for IR/VIS Land SfcOptics + INTEGER, PARAMETER :: SCRUB_SURFACE_TYPE = 7 ! NPOESS Land surface type for IR/VIS Land SfcOptics + INTEGER, PARAMETER :: COARSE_SOIL_TYPE = 1 ! Soil type for MW land SfcOptics + INTEGER, PARAMETER :: GROUNDCOVER_VEGETATION_TYPE = 7 ! Vegetation type for MW Land SfcOptics + INTEGER, PARAMETER :: BARE_SOIL_VEGETATION_TYPE = 11 ! Vegetation type for MW Land SfcOptics + INTEGER, PARAMETER :: SEA_WATER_TYPE = 1 ! Water type for all SfcOptics + INTEGER, PARAMETER :: FRESH_SNOW_TYPE = 2 ! NPOESS Snow type for IR/VIS SfcOptics + INTEGER, PARAMETER :: FRESH_ICE_TYPE = 1 ! NPOESS Ice type for IR/VIS SfcOptics + + + + ! 4a.1 Profile #1 + ! --------------- + ! ...Land surface characteristics + sfc(1)%Land_Coverage = 0.1_fp + sfc(1)%Land_Type = TUNDRA_SURFACE_TYPE + sfc(1)%Land_Temperature = 272.0_fp + sfc(1)%Lai = 0.17_fp + sfc(1)%Soil_Type = COARSE_SOIL_TYPE + sfc(1)%Vegetation_Type = GROUNDCOVER_VEGETATION_TYPE + ! ...Water surface characteristics + sfc(1)%Water_Coverage = 0.5_fp + sfc(1)%Water_Type = SEA_WATER_TYPE + sfc(1)%Water_Temperature = 275.0_fp + ! ...Snow coverage characteristics + sfc(1)%Snow_Coverage = 0.25_fp + sfc(1)%Snow_Type = FRESH_SNOW_TYPE + sfc(1)%Snow_Temperature = 265.0_fp + ! ...Ice surface characteristics + sfc(1)%Ice_Coverage = 0.15_fp + sfc(1)%Ice_Type = FRESH_ICE_TYPE + sfc(1)%Ice_Temperature = 269.0_fp + + + END SUBROUTINE Load_Sfc_Data_SingleProfile diff --git a/test/mains/unit/Unit_Test/TOP_SingleProfile.nc b/test/mains/unit/Unit_Test/TOP_SingleProfile.nc new file mode 100644 index 0000000000000000000000000000000000000000..1d56a3a000698082fb462941c43fc30e4752ab2f GIT binary patch literal 48812 zcmeI*bx_o8|LAc-DUmXek_PDz1c~owDN#Z~q!bhhQ9?;6ML`8YEJ~D;5CsVVDQQJg z0cixJ8%YrfJ=gBdnK?6O<~+~LnR$NCAIr?%y71z=*S>dgXRiCRU)0o(k&^uLL4*F- zfi5)8=hW=2oSkhQ-3VWxK>ww3KBr^lZR?8vj19UlIG@wEw{o*Rr{QSpWb5pX|2+OU z=<_4MATKP~O{XzIZ*O@BO&55FGWEcLq|Nrhh_8=M_f} zCtEHzYb$qmTh~j@7rCsj*xK1$vc7~m;cw*sb8Y)(@oRIqfIrl~-HHF7wOz2XcDQEc zYV-eC-T%ElL0wySS6eqOHx~~pS6dsdtG2FO4woFSTy(W^;yUDHDJ|}B(NauG2)~|x zv+tod$WmM-gu#Cs;kkf+jQ`!%;{V*AtN7<2mz{^RHU3HQe};DBvb*B?zwhQhkK_MG z_dpy8iK3&j&+H+QXt7xA>X5V+d(S83-mjj_VNaH^aw>|`p6w5@a8c&A>2(Xt%w*Pl zgp67Fv1(O7)Js$Brcv>Cx1k*66&u>S$MCA*wy3Tn~mZ-`!qi zhsPGMTr1qFq)9zyB2tOFl(vA)Tbn4cZ?<72Hxku#U4LUw!2Hf(lQAro^oXE^0t?oZ zj^mK@X~I0jNdw*`j$mt)T6ZhWGO-WZzG@>}x3HLI!yp$sD(o%ouQwzu4SEHAIQ3-o^B1e2z z?qdC%(T1CMDX?;A`{5Gu1DhJOR_*!Y3(S548v@^lun+qvzb_b&g2#Z_KT|8boLt9SWCC`rQsde zm*mT#Irl}ejpIDuC9-wk&{6@Jr59lB_FJ+X3`M}f=)A$pYmQBA>}#3(^AKwfcFSD~ zI|yV-;a^)!lt8jlD7LRs8T;nm`dIshG;q-mMUqz^#C}*=r?**$W4(#REHZM>fl?~^ zYJQCZ$lA)^Yv@qIhQeH_W!_{1Z!o+d7hu5_BOc{vhTCC-y^Mz|BxYdOpyhiPgK{|9 zG=Kf(*=lS|)N|~YZV~XO8W|KY=VB`?3Vkonr(>fTR`Z8L#(;tT#fuK66QKO*#ETI# zA8gWj;|SA*9UySpzM`I<0b8w&b-(HoicPky=|>6w0wxaDFy5F~fU6U^o6&Uvo4I#q z#dPi{2=rx-74MP5e!o_B;&_{g%|)<;^BGCP-u=v@6-OgM^~vH*d9GmWhgXQ-iGU_J zln}3%xM75Crb~bJXSj$hKIH2QeDxIe)2NBL*4Kc#(Yqw;h_Bef8!45H*!LjZDloPh zos0c#mvOpSuoGJuIU&@)W(Ws%xlc+4J%wXD%$wZlI@l8b`Tbe7OCVy(HE?c15J;oX z=!D4AVrwml*Q6~bft9&Rc9N_CG&dzP%Xo*d<<|-?Bpx<^$jhr|oOLUKT+d}|q`sv^4fpDKYlv-VP9bmETDj%ndtPZyFx0EdY`!OB^Uo-Oi-yg3 z2gO^^b){oJq9uu~@m}@0cytTIAAF{~DqROuqrb*jU$Ov&snt20c zeOYz!ls_04ODvJaKF2n1(TVJw836gO=6f$z?123~nxj2)xxl{sd#dvTE$|2n_LTT= zf`0#z`O8>8wozJr#YyWSDEQDWP-Z;^<_{qqja==(d5`1V@oSdAtzIRPeH}esv|3$4 zRSVd<-MF2JP%0?NM@ltP`T)!R>lZBBe*rgVj&Ol}A8>JxUl>~Sf|I1#Io27h92kPUSSQ4=~N2=m~!t zI5gxmcp8rYe|U1}RVNi-HfDaGZYBa6?>;`eJynk_b_nFUm3;(kb(Q~aLmeEfUd|q^-RHyr*vMOnfZ{lC-M>R?Q!Q>2&A5)?o_3wNFyzzwp6kp6Hps zdJqaag@R7rE&zPu%-jVUjUYwE{>gtj2KEFGetQ~g4Jt#6(!4b;*xV`BeY5@jpkJdl zrj*42{4}2amPw=_y@T^!+hRBDlk3eld}9D=XS2ptuBc)2pLXO-Pp^XE&Q^|bn=imW zn>ycIunN+D_2-|;@c}c5nV@bORmIa@i=q-is|R3$oS!UH~JL@9sGs=yl-rk*pr~HIN;{9z7R33d|2A z3ws;BfChW71*M1@wy3q==tH6>7#&w!EF!f8p*V7LlCNZNq)Yem$6@qy@BVg4rHmKU zXdi90>^zUnGtK(%d5wYLYJmm)-z*T0Af5T#@D1cDH0^{oT!CqHfpMvRC*U5qf`M!^ zHr*L*Jz;nS3=F8|WP8Iv7Ajh43F>Q1z1-(~|(2OVeu1OcQ(e9P2*57J%fTOwAfY2yAFoaU%LeC+O%F z2lM~s2eIg}O0ue0P&m~%wnoJP6h33YI876fmd#|#pP|G0j*T<#l+pyxG= zQS(XRYkn~<$h3F<1Xsq zxQ%Ua^9c*lTLF&+mxIpQMXbK$jDnp&A)K}64p*oW1j*St-t0~#Q0`N{rgh&B`_=nG z@?qmJa9k^F6Xd{Q9~@_sYYo-md~ESUqpv?f%3Dd4tX2=OidQ-j*wb>Tesjq z=KbPRby8TlL@9SDUo=>`QLnbnNPslui=g=ca)9Jts`qrAu%8lD7P0IKu*GLw5I6P8C0ofmq<$pK<){G&NQWWzx5@xFN{X?0)JpKgfEgUH)ix0aWjw zFBI}RjLXv5Fn&d`hRdqds*JsEkIP;@`l){16qkE`S$D2y9GClJIPSZYJTAx0=g}?y zM+Co?+=us7^BWBWKY8jC@+*B>G4*&KfBjeu-aig6=EHjvWk(jguU=B0!u#4?0~yG# zUZVQ&7Vi@{x*PERN!}Atg1;_1i}xQ|AzI|06zG$bk1rDPHt=A0zA4g!ku`bV%{OQHb6X@9Udd7?J3Q48Vy k9$ZPM_w9Uf%$%!6eT&@-A$2=Os`cvcltnfbef{HONOPB1(xr_Kd zCwtg?KOnETRC##~dGd)+(-i#i`!~W`@IKGMDi?X~tEZM$kheRVe$X6w?dK*N>&R29 zM7ND1Kc>MS--NvH$I_ld$X{VRlyw#PEOHV34CL>+_0Pv=l~sMk<+$&4GhUNwF1%pc@^j0N;Hk^go$jFboY!S7L5hLB%05K~9b|M{AqC|e&^0!Pf@+D7(^OKR+b8{*zN8W(Z>Bu_rnY#Mp!^mgZ zaZtWQeju60QWW_dwTe8{$Ne~~OE44ir+16mUPS)w^OiqJ$mi|hB~?Ry%roQMSLAb} zD9t#KKQY{+z7NKK&#P)bQih57j@SJA=wV9P(Kftv02ZE*+P>eB2s4lSYd7`-OfLg1WrTmf_rY{g;wYrzHV_boB{eIMgqLX zNucMlqm28<2QVD0ZzEo!1z*g}-5T`mkvYdf!F+MuUnvV zQRC)8n>M&IeBxThuXwO)J}uSAWd#PbWc_1#|lDa1qe#O*rFv zV+_oe5_UVd%K^*j(RQQ5)SzH-ir@P23R*~yJm!^(_f{1V$lkjig|1|GhCv+V;ZN=p?B>O;f;92L2`zJ6zYWh@rDFoO^ zM$OLrz7I!N`7#r~j{yHw<$(5{6VS=>{_ueJ5@`PVF{GSb59Zd!IUn5x(Eb|ngIIuA zfLMT7fLMT7fLMT7fLMT7fLP#vqyT@0Pe z!{rVwD$z(3;c~2dcS(m`Bl>^cM@GAe8Q*gk%fJGm=kIF+gq~}IzJ#7iQ@05{^}g2N zdn(vmM*BLITD#BBYTA}?8IRhW+Oka)(Kk>!r4kA66TqoJPLGsKbT=?YD5<`ZJr3{EszdA^iH!@EA8s zAupu%p%?9!T5p=o?m_!wC&hy!jx8bopk-s)8ST$pZI`)n68S{A~2CZl1V~51_S>(U<@}d2^+~JHJx!-t^cR2vr$B=hCNG9Bg zeE)47Mk?g{{PYV}kpD$~{h0;wO>JTc)X2xJc*oTvZy^)LitcaKXOVNXIOLlIw%#ox z|1)8~#a`rFB+lk^BA==HZhaMb^+O?2Xg{;+ZP|Ou&&X$qwbLdbKS?`XtBL%_ii;=u zk$(**ozcG4Nom^)nrz6&pZ$_^1^K7*PFl~A?`IAdzJq*;W%SA~|u$Hmm<|3LnGU-9V6HIL_n_a)^1mkm03a#?WVTv-w{M`KnnD**uW!chz>EJx(zc^Qz zN?m6vl#7J1wz*eIMh!4(9+j*3`!I}E>uBfejKDbAKBJPyhA`qd)0iz=2t%cR%j{Ip z{*}FpY-q|c=o6F(ww(J0-v$!JK&Ue>a$m)xvh)RMs z<}m*IP8G;IoV#CW-v|e|o(eu(TmagK>?$TLRM=v`lRG5VWZ34y{)FrddTg=hREnf? zIX2nwgZb3HP^|wN&!W(wb*xM2UCRq|U+kl#TDRf*$^VfT1>%ho3lIws3lIws3lIws z3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3;Yij zz?!7==hQl9vAWA%wMPAM4Sn=6$(N{<9uuKizafy0aY-2J- zE@)Q?HhGHb$Fh(Q)*&BrF^Dw`dwvRDR4 zKTojH46oF&RujtGf_&_Og{<`QdM&N5^6|(pI2}zBD*Atd;@Z4G_erJ9rJbw3T zEi-`(u0Nuf*1zQp?nUO(MV*&6HPL?z9b?8OP z(eYyFqI-QK!nO%|<+D_J8C-||G1ZAJ{yT+n5G-U3e$A@EH`PeMk4_S3Ipu#cpVOJNBjhGZ}Q;D~M*+YlY7FARjK* zM(Ca|&fVOz4|<#h|;s=-8gW>e`;a>fWBe>fN5d`nElP)w?}^)ww-? z)xAA`)w?}^)wex=)wex=)w4Z+)ww-?)w4Z+)w?}^)w?}^)w4Z+)v-N))xJG{)v-N) z)ww-?)wVr<)w(@@)v!H()wDf-)wn%>RlhxdRkb~TRkl5UmAgHERk%HWmA^fIm9;&8 zm9Ra36}>%w6|_Bn^>};!>hAXZmCyG4mG$=gmD%?EmHPJlmG<`hmE!jN)uHYAE2@9y zudvPS`KzJr`K#IO`KzJr`K#{j`K!;{^H;Uo^H=%A`K$lIf5wS7O)NkxKrBEkKrBEk zKrBEkKrBEk@LyN}7r*`f!T9a>4<-=aA2*Im+J66F65;)Wg}6k*`v*OV{$KZzY51m# zLp^u-4c6dL&m@gWc6?6?x}i)QzNc>UTS8BhB4&I~CAsAiyx$#M`iI~hTWtybdrbog zp6zBV!5@j`Kz>t5{^cazyM??|!~0rILruJ=xATJ2&IK-=3yBcpt#G{}|qLKFXs9RjY7U!a@D^Ud931sO)f5Jm`=dz{0j0D z)qD0o!o{Bqsy+In8Toj<0y+0lDftEX6uOhG7OwEe-J+=Mf zNyz^xSMxyqEkov1Ys+y-BgPDY=)7Brwxm|eru&fBI!y6A5$|8R(a+-&R(B56F`_P( zIbtsQddP>)TQc21{`9J*Bzj!+Bua-k1CY-X=(*;Cj^9qwZSffS#Ji3KX#FF1-P%fo zk$1wS1mcfR*>Bl4jeH=T&2wx>NE50>xLro z*4zoxw~%)!n5M}>{*vyR!ZqX#C%cY_qT`=@zm}(f{1SuwlR4xsbJguWg1q;Xlbtg1 z&V2E)H;^|ediu*6dBddp?&o2!g_+fX>>&(mD5$wldBMn7ef{T8wlE>X^n;&!8YV>* zA6~R&gUNd5PZp1`E%mR5aTPl3@wPwQlo85mzStX%Eugvsg}uRPlzn6wa@QT6qPG3}tj&1bzZ zbnwoF`Gi|Aa$wBnB^4WtD({%Szd-}TWsw7XENn2OFt+rkXBK+i$}>NDDF8h_pKO_~ zwL`Di`b>Vj9CYjY3T;wZLaTwi({avbXzE};^QGMksx<6wsBE}H?VhJrd4mJ+;a>E! z2PQ61w&TyRyRR#}NjqDgK|TU0i>^G}e@)=Y7T1?QWOpGkn8aD*Y&%3Uac8N_q(YDe z#j3-NRdCw1w;(Tp4lW4Lj8P4@fo4YD)VQQR7{^tsgy5z@{q)Syn&JB(@uZ)Ii6#>$ zCAQv)QZQp{($0}1Iv25y;;<5r=u&LiKCg+|Bn=xQFNn#g`GNHu9JDESDZ^@|XuSo5 zd9cd&WFCrBb=WJl<{YtWgcHL57rtx|mqaW;EI=$kEI=$kEI=$kEI=$kEI=&qA1{E* z6>#9;jg`XX(a1W^e~`fCbCGWbU);hKp4_W^xOoCs_?wkX*D(Z_|1CNzZ7GWA|BXHY zw}kLLop2Vegr1){l?gqqkF^ncx~CcwdX~LG=ld3L;Nx;PCHVBFL;rYmUVD81V~iFA zZ+23Q;4@0ldC>(N&Ss(WAfe;mA={`xe#cHqJ#DMRD2hCXE86oCgjhAoOwEj{He{Em$b+i1ygtj;Bp0bY?Ph-f&AdU z(z{H^=Uq8khVPTEw`FXGe1c=4N(=JKNw>Vykl&k@;AeyUY8`{t67t==K5`n!&-mQ= zBZT~fR@uffF27G%y7dhQ-t$)%Ga~=9xHXC=k$&cX**Qu|u4)`E{ zweBUa7V^{;W={)|pB&wzY>IrNj3Wy#I{t>fhUhuuDdUe%SRsEi-6OCB-QP_sNA&vw z@@RT)J{%TBzNk$CotLce@04tX5{`13cf9f*^TAy5@b{^>AMis)lg}@d8)j=*$dwbTVeGu& z&j&~QVbUh#cFt{9nAww$o4B$cW+zf78r;KRR^ixibN@I@9#}cZp+p0t)RiE1@F$E1 z3PpGa`@=+$t0Xt|Js9&CGz$!ggAu>+70KK6&?nw_h!m#{{oO4Q0TnqgaPtwWqKORj`AI-fzADNksYQGWAo`5{y-R$a}D`2h_s*S`FEKLRx~UtaeXNkYZ5B;m;& z1(4~;d|^8JIHZz{KRqTi0Z%w~1!}jB!HXUymi^}35IIv_Vl&SLLA*68krv!=c~oKN zKAT=R@2hwqm9YXe_HVMmo4;^+pjteEjTuziWF2Of)j{;E$6}Xs5bRW}l??8W$5xj) zk5)vfV_kU;4h@vwu%)-Z?0%%2$3~0H9M0^n#d<|0`m)cR#u}?`%e|)a#cE{Lgwv?J zu(y{u=d|KP{^KtQ#2X|QAQm7NAQm7NAQm7NAQm7NAQm7N_%AJh%gbU*V_;&!z4Hjq z`a#i!E9BLgh@@-5m5kI#Njgd6-ls@Eu6`SaD>@LU`YqCf=>LsA$9z@rJ+nEw=?Oh6 zbOs1LPbTOQdVb4$L+CkWJdf}BifVF=;1!qAejz&kn|U^Zml-c3_!<>Ag6}&VhWCwP zi{^M=DxDyM_cKvxdITSzrbX~S&|DY(@%p}!k37dZU(gcr5d-vv%gF0q=BT#DdmU|g zNxV<=;pD^nW7b?t$P4St+nOOCSF`?f0C~e&zIXWJ*U~%P-X|m-)ka=3 z*uTCX`4St7lh2U9%*^i)fP9-$Uvd=kN>Skq&d3LOKV|1b-ZoFmRUP?}hW)MS$UkNO zocjd%wY#jE%*damGx;8g{Ii4CVyTh8>YvRWg8b$upCNtZt2u_WC2%F9lJd6um5_hp z^(Ea1`5Lcu#uVfo_N$qQA;00#ymAQn&uNzqBp`1(Rh_eee06k!3={I}m2WAYAb;LU z;I$y~bLR0CY{*yEF5F*1{@g@|!=RC-2+=cwUESmG|P~YNopHlk(v^+AI>7v^W9oAhL z(zlJ_`}Z6B@5b=L(1Rrt-@AM;5*1ZpD83HOd@nh3Lc*b4FuIzwv>hrwsys`M;6dqdG3gJWdRKQB0pL05efrmD2M2Gvck8?>`A+| zX=t|)F8G$y3||KsMZWIRfcEr&A5va{(3UZy;_bZ*jqaTB`mUPr>FhP>?A6^+%vkwi zU3UnoGrN`#dWu3tpzf)y;dCg-RvruU4uBLjF}5Cw8HnYVE0SUEhr70s1zqxM5c72P z#qXFq@F1M#L-;N&xRLsS_A-4WoMX}%PcLl%gZ>Lig(fC&Sc7I@des56-&1dVW4;Em zvBqn29xTA_QhZo1ga=z7dnn5`pN|bhF80UWd4Uzuj&qC7p2J2A7gQauL}Bd;+2_N# zvamXDX#>@-0a#H|#zuFbI+pAFS2wPq2aB!7lC}nY|4Uysh|3}tAQm7NAQm7NAQm7N zAQm7NAQm7N_>ULBz0t2$S>`~$pNxukG;O*G_cnERkmu@qT>iT{TJ_C2+&itYoE+|X zTyExiK#JA_qW{-@RF593CG`B{8A|B+IJk_^)5KSg(6d7KpPp}AHSj%EM?;Pfe8c-J zg1?!K=73QDW6#0~{w?+0fBFX~;Jtkg#~R+xnCsQz{XPBLCkWmt0qs+v$E!Rrkl<5g zdy)V6lf%>wdA5XdhLbFFWBYPqtk(Vr_Ie&zQ%(*56c$^8{~1p?k(KNyK2d5 zpF`fhtiC1``9tGp)1D!(s?f`d=F+m%g_|=Lk(W`6``v)Nqg-^PIr26YQQc^+sz54b z=5ieJ`o%}$(C=T&I;)~mqlP@MnjFO&+LV`Ch*#_Q;E{gdg-rUiaHw{yyZb zMU8l*kl)KPi}n|DsLXdtxdtPz_v;UP3G!U2>(4}yS5IMi&V>9q|FpBx$nR<>)fYzo zw1{n@8}eEzuPl;~XBlH(M*E`L80Ao#I`ZbVv6(E$@Ae$qXNJ77&^@~hM-H%e+ z>2zqJrx^3?cFBSUW(&c~OQz8BeviX}E56WvdT~>%kr#T(hu2Jao1wSpozMFw{NCw40#tf(ELnnDA&f zXtc@d^!p_b^(^*xhkW{>GM&uxt)2>$l$u>Koq7hDln-e*6gr@=YZuMS`_hniSGYnr zsR%NTZ(Uw})NM8)B;To>=c5 zWozC)4Os1t%yoT7TI_j?c7Q0GDb`{0+4L=QGxmvnf3f=@Emrb8n@TZd1xsI28nB&L z$5Ir#N^YfwVh^))rOQtG{KsDqh&Md>3_xJ0%na_a?hToV0fzo5}yxYW93A)6P`xR(K>GCHH1xD+}a7IXDYqW?GgsQ!LT z=;_kcOXwLntVQT~<@F+=r!f~Nq35}ae+fMcbiNS$wZ2h;57QGMc-uftg4eaq{inZ; z3*Mi|IaGxAlutW{@c#OnOU?xEC!I#{M(Fkkk5}3j^6B4iPe$7i*Cw@)Z;oF1HGubx%RCS8K5`^w3-4t=>IWiU zzkA3d68V(tSBt8V?>0Fn{Ra6p`5J?D3D&e{CN`$`oxtJiq1+j8qR@+;N_CTKnNY)qWGKal5V zzu0ykd7H1t-X2E&8LuUTBA+;7BZJQWL_fR9aM2ifLH5{&-^j~;rtwHd-uu+PnKb0R ze735qkqcus*F6f<64y^@;qs3 zD}Rx{>AV#{hrBtH=HtD{dj>GPc0j&#H zIZ0l4{n7H(_z)-LIw$58_^QHt)m|WHF);ue`Jx~zfl zKKeAti*IgF!mmX&{EH7ls6S6IEr~-~n@y9tOabJb3604vWr6~ybEW5;lpw!f!Svx= zJY+qk%U^Wuf>cLrcSc z`=<+cz>b1T^t_H z2H&%inv-G+?MKBY7B{i-R}2Z)Oa-xY88?u+U0ez=m%KpQj7Is zASo7WTDiHoIg33^-K%G%{|F1l)|%A)#4)$`I!-3-PXDDZ8^mQ13lIws3lIws3lIws z3lIws3lIws3;f3m;QZ9>f86fR!`+PLmbIK%!39j5lYC(3jtjbxP4&El4;Snbc{&3Z zj=L+K{C9)Pjp+Y%pLrK_-g11;bgwl+&-ebKgr4d2ri7k(YPp1-o4h9oJ$>563EpbD zkl-I(@g?|JVY+|%duIL9pDz~gJ65-zca$lKAxs8b@J8E7lugnanDQJ;IrCoNo! z@W%ORSVTVTH5f-CAG2UpdmH(Z3n@+Z$UkjT-5-Pe3xzBab)26jGt;&3XSkbB zML#qvbKwFenYH-}U6KD)JyZPw`ReL@-{z3d5_gn+it{^eD{Ra57Wpo571u80i^gqO zmT*D-ms8x?-EhIKT%4a{nUNnX(WfcF`JIqG^j6apcQZ!2^ZXSTT)>q4PTfDP$d8!( zk=I22fxy9pINV(c@xO&hmyq`|`Xk?my!R-7P$u&3LD%`@a6vbvd*Zrz3ab&fI`ZRAh7GtNH31-p?P6FN46e5}6%eKGR#p}VdN zBX7^m!G8vMxA3h%^z(RA--Rsm2=WvL3+FtLe|7b?*9GKNpW_bKBku_IYIyG%f#p{s zZ$MXdEEDhPGEO-m|FV9Rx)<6RZzyOTd<0)Vul>Y{dO*w4?B7q_@1Q=0eG0||;FHt~ zd-v=RC~FF|IM#Lt+DWyuuS#^lS1ZrUI@DdzvOmvKq$>zMxx4!FTAzmMLh-xg3~O+Iq?T4L{+wq>|>ViVi5C?R8Wb zdjpwPf)fmLPz=db?O83BK76< zr|wY4+Nza5p?%1>%ob4YTi017U++||A$u#}?g$T-J70d=XFd~q(f=V)g4YXsd`}=l mAw&vuU03Se%hiV2kav2nMCD-O&lY}Xvj+XgUl9Jq4gN1$jeisX literal 0 HcmV?d00001 diff --git a/test/mains/unit/Unit_Test/test_OP.f90 b/test/mains/unit/Unit_Test/test_OP.f90 new file mode 100644 index 00000000..36c22da5 --- /dev/null +++ b/test/mains/unit/Unit_Test/test_OP.f90 @@ -0,0 +1,366 @@ +! +! test_OP +! +! Test program for the CRTM Forward function with user defined input optical profiles + + + +PROGRAM test_OP + + ! ============================================================================ + ! **** ENVIRONMENT SETUP FOR RTM USAGE **** + ! + ! Module usage + USE CRTM_Module + ! Disable all implicit typing + IMPLICIT NONE + ! ========================================================================== + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'test_OP' + CHARACTER(*), PARAMETER :: COEFFICIENTS_PATH = './testinput/' + CHARACTER(*), PARAMETER :: RESULTS_PATH = './results/unit/' + CHARACTER(*), PARAMETER :: TOP_FILE = 'TOP_SingleProfile.nc' + + ! ============================================================================ + ! 0. **** SOME SET UP PARAMETERS FOR THIS TEST **** + ! + ! Profile dimensions... + INTEGER, PARAMETER :: N_PROFILES = 1 + INTEGER, PARAMETER :: N_LAYERS = 92 + INTEGER, PARAMETER :: N_ABSORBERS = 2 + INTEGER, PARAMETER :: N_CLOUDS = 1 + INTEGER, PARAMETER :: N_AEROSOLS = 1 + ! ...but only ONE Sensor at a time + INTEGER, PARAMETER :: N_SENSORS = 1 + + ! Test GeometryInfo angles. The test scan angle is based + ! on the default Re (earth radius) and h (satellite height) + REAL(fp), PARAMETER :: ZENITH_ANGLE = 30.0_fp + REAL(fp), PARAMETER :: SCAN_ANGLE = 26.37293341421_fp + + ! ============================================================================ + + ! --------- + ! Variables + ! --------- + CHARACTER(256) :: Message + CHARACTER(256) :: Version + CHARACTER(256) :: Sensor_Id + INTEGER :: Error_Status + INTEGER :: Allocate_Status + INTEGER :: n_Channels, n_Stokes + INTEGER :: l, m + ! Declarations for RTSolution comparison + INTEGER :: n_l, n_m, n_k, n_s + CHARACTER(256) :: rts_File + CHARACTER(256) :: op_File + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: rts(:,:) + TYPE(OP_Input_type), ALLOCATABLE :: OP + + ! ============================================================================ + ! 1. **** DEFINE THE CRTM INTERFACE STRUCTURES **** + ! + TYPE(CRTM_ChannelInfo_type) :: ChannelInfo(N_SENSORS) + TYPE(CRTM_Geometry_type) :: Geometry(N_PROFILES) + TYPE(CRTM_Atmosphere_type) :: Atm(N_PROFILES) + TYPE(CRTM_Surface_type) :: Sfc(N_PROFILES) + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution(:,:) + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution_OP(:,:) + + ! Define Options + TYPE(CRTM_Options_type) :: Options(N_PROFILES) + ! ============================================================================ + + + ! Program header + ! -------------- + CALL CRTM_Version( Version ) + CALL Program_Message( PROGRAM_NAME, & + 'Test program for the CRTM Forward function with user defined aerosol optical profiles.', & + 'CRTM Version: '//TRIM(Version) ) + + ! Sensor_Id + Sensor_Id = 'v.abi_gr' + WRITE( *,'(//5x,"Running CRTM for ",a," sensor...")' ) TRIM(Sensor_Id) + ! ============================================================================ + ! 2. **** INITIALIZE THE CRTM **** + ! + ! 2a. Initialise the requested sensor + ! ----------------------------------- + WRITE( *,'(/5x,"Initializing the CRTM...")' ) + Error_Status = CRTM_Init( (/Sensor_Id/), & + ChannelInfo, & + File_Path=COEFFICIENTS_PATH) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error initializing CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 2b. Determine the total number of channels + ! for which the CRTM was initialized + ! ------------------------------------------ + n_Channels = SUM(CRTM_ChannelInfo_n_Channels(ChannelInfo)) + ! ============================================================================ + + ! ============================================================================ + ! 3. **** ALLOCATE STRUCTURE ARRAYS **** + ! + ! 3a. Allocate the ARRAYS + ! ----------------------- + ALLOCATE( RTSolution( n_Channels, N_PROFILES ), STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Message = 'Error allocating structure arrays' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ALLOCATE( RTSolution_OP( n_Channels, N_PROFILES ), STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Message = 'Error allocating structure arrays' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 3a-2. Allocate N_Layers for layered outputs + CALL CRTM_RTSolution_Create( RTSolution, N_LAYERS ) + IF ( ANY(.NOT. CRTM_RTSolution_Associated(RTSolution)) ) THEN + Message = 'Error allocating CRTM RTSolution structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + CALL CRTM_RTSolution_Create( RTSolution_OP, N_LAYERS ) + IF ( ANY(.NOT. CRTM_RTSolution_Associated(RTSolution)) ) THEN + Message = 'Error allocating CRTM RTSolution structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 3b. Allocate the Structures + ! --------------------------- + CALL CRTM_Atmosphere_Create( Atm, N_LAYERS, N_ABSORBERS, N_CLOUDS, N_AEROSOLS ) + IF ( ANY(.NOT. CRTM_Atmosphere_Associated(Atm)) ) THEN + Message = 'Error allocating CRTM Atmosphere structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + CALL CRTM_Options_Create( Options, n_Channels ) + IF ( ANY(.NOT. CRTM_Options_Associated(Options)) ) THEN + Message = 'Error allocating CRTM Options structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! ============================================================================ + + + ! ============================================================================ + ! 4. **** ASSIGN INPUT DATA **** + ! + ! 4a. Atmosphere and Surface input + ! -------------------------------- + CALL Load_Atm_Data_SingleProfile() + CALL Load_Sfc_Data_SingleProfile() + + + ! 4b. GeometryInfo input + ! ---------------------- + ! All profiles are given the same value + ! The Sensor_Scan_Angle is optional. + CALL CRTM_Geometry_SetValue( Geometry, & + Sensor_Zenith_Angle = ZENITH_ANGLE, & + Sensor_Scan_Angle = SCAN_ANGLE ) + + ! 4c. Optional varibles + CALL CRTM_Options_SetValue( Options, & + n_Streams = 6 , & + Use_Total_OP = .TRUE. ) + op_File = COEFFICIENTS_PATH//TOP_FILE + + !op_File = '/Users/dangch/Documents/CRTM/CRTM_dev/crtm_code_review/CRTMv3_ITF/teST/mains/unit/Unit_Test/top_test.nc' + print *, 'start reading optical profile from file : ', op_File + Error_Status = OP_Input_ReadFile(op_File, OP) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading OP file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! ...set total op values + Options(1)%TOP%tau = OP%tau + Options(1)%TOP%bs = OP%bs + Options(1)%TOP%kb = OP%kb + Options(1)%TOP%pcoeff = OP%pcoeff + + !PRINT *, 'RT_Algorithm_Id', Options(1)%RT_Algorithm_Id + !print*, 'TOP%n_Legendre_Terms', OP%n_Legendre_Terms + + !PRINT *, Options(1)%TOP%tau + !PRINT *, Options(1)%n_Stokes + + + ! ============================================================================ + + ! ============================================================================ + ! 5. **** CALL THE CRTM FORWARD MODEL **** + ! + ! CRTM Default Interface + Error_Status = CRTM_Forward( Atm , & + Sfc , & + Geometry , & + ChannelInfo, & + RTSolution ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Forward Model' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! n_Stokes = RTSolution(1,1)%n_Stokes+1 + PRINT *, 'FINISH CRTM Default Interface' + + ! CRTM TOP Interface + Error_Status = CRTM_Forward( Atm , & + Sfc , & + Geometry , & + ChannelInfo, & + RTSolution_OP, & + Options ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Forward Model with Options' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! n_Stokes = RTSolution_OP(1,1)%n_Stokes+1 + PRINT *, 'CRTM TOP Interface' + + + ! ============================================================================ + + ! ============================================================================ + ! 8. **** COMPARE RTSolution RESULTS TO SAVED VALUES **** + ! + WRITE( *, '( /5x, "Comparing calculated results with saved ones..." )' ) + + ! ! 8a. Create the output file if it does not exist + ! ! ----------------------------------------------- + ! ! ...Generate a filename + ! rts_File = RESULTS_PATH//TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.RTSolution.nc' + ! ! ...Check if the file exists + ! IF ( .NOT. File_Exists(rts_File) ) THEN + ! Message = 'RTSolution save file does not exist. Creating...' + ! CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + ! ! ...File not found, so write RTSolution structure to file + ! Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution, NetCDF=.TRUE., Quiet=.TRUE. ) + ! IF ( Error_Status /= SUCCESS ) THEN + ! Message = 'Error creating RTSolution save file' + ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! STOP 1 + ! END IF + ! END IF + + + ! 8b. Inquire the saved file + ! ! -------------------------- + ! Error_Status = CRTM_RTSolution_InquireFile( rts_File, & + ! NetCDF=.TRUE., & + ! n_Profiles = n_m, & + ! n_Layers = n_k, & + ! n_Channels = n_l, & + ! n_Stokes = n_s ) + ! IF ( Error_Status /= SUCCESS ) THEN + ! Message = 'Error inquiring RTSolution save file' + ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! STOP 1 + ! END IF + + ! 8c. Compare the dimensions + ! -------------------------- + ! IF ( n_l /= n_Channels .OR. n_m /= N_PROFILES .OR. n_k /= n_Layers .OR. n_s /= n_Stokes ) THEN + ! Message = 'Dimensions of saved data different from that calculated!' + ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! STOP 1 + ! END IF + + + ! 8d. Allocate the structure to read in saved data + ! ------------------------------------------------ + ! ALLOCATE( rts( n_l, n_m ), STAT=Allocate_Status ) + ! IF ( Allocate_Status /= 0 ) THEN + ! Message = 'Error allocating RTSolution saved data array' + ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! STOP 1 + ! END IF + ! CALL CRTM_RTSolution_Create( rts, n_k ) + ! IF ( ANY(.NOT. CRTM_RTSolution_Associated(rts)) ) THEN + ! Message = 'Error allocating CRTM RTSolution structures' + ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! STOP 1 + ! END IF + ! + ! + ! ! 8e. Read the saved data + ! ! ----------------------- + ! Error_Status = CRTM_RTSolution_ReadFile( rts_File, rts, NetCDF=.TRUE., Quiet=.TRUE. ) + ! IF ( Error_Status /= SUCCESS ) THEN + ! Message = 'Error reading RTSolution save file' + ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! STOP 1 + ! END IF + + + ! 8f. Compare the structures + ! -------------------------- + IF ( ALL(CRTM_RTSolution_Compare(RTSolution, RTSolution_OP)) ) THEN + Message = 'RTSolution results are the same!' + CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + ELSE + Message = 'RTSolution results are different!' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! Write the current RTSolution results to file + rts_File = TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.RTSolution.nc' + Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution, NetCDF=.TRUE., Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error creating temporary RTSolution save file for failed comparison' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + END IF + STOP 1 + END IF + + + ! ============================================================================ + + ! ============================================================================ + ! 7. **** DESTROY THE CRTM **** + ! + WRITE( *, '( /5x, "Destroying the CRTM..." )' ) + Error_Status = CRTM_Destroy( ChannelInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error destroying CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + ! ============================================================================ + ! 9. **** CLEAN UP **** + ! + ! 9a. Deallocate the structures + ! ----------------------------- + CALL CRTM_Atmosphere_Destroy(Atm) + + ! 9b. Deallocate the arrays + ! ------------------------- + DEALLOCATE(RTSolution, RTSolution_OP, STAT=Allocate_Status) + ! ============================================================================ + + ! Signal the completion of the program. It is not a necessary step for running CRTM. + +CONTAINS + + INCLUDE 'Load_Atm_Data_SingleProfile.inc' + INCLUDE 'Load_Sfc_Data_SingleProfile.inc' + +END PROGRAM test_OP From d2a08a66509db70bb0c9e26a5d70f4e065192185 Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Mon, 13 Jul 2026 18:13:03 -0600 Subject: [PATCH 05/10] Add unit test for OP options --- test/CMakeLists.txt | 10 +- .../mains/unit/Unit_Test/AOP_SingleProfile.nc | Bin 0 -> 96812 bytes .../mains/unit/Unit_Test/COP_SingleProfile.nc | Bin 0 -> 96812 bytes test/mains/unit/Unit_Test/Generate_OP.f90 | 372 ++++++++++++++++ .../mains/unit/Unit_Test/TOP_SingleProfile.nc | Bin 48812 -> 96812 bytes test/mains/unit/Unit_Test/test_OP.f90 | 411 ++++++++++-------- 6 files changed, 610 insertions(+), 183 deletions(-) create mode 100644 test/mains/unit/Unit_Test/AOP_SingleProfile.nc create mode 100644 test/mains/unit/Unit_Test/COP_SingleProfile.nc create mode 100644 test/mains/unit/Unit_Test/Generate_OP.f90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 1f0a5d79..7b49bfb5 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -1,4 +1,4 @@ -../../../CMakeLists.txt# (C) Copyright 2017-2018 UCAR. +# (C) Copyright 2017-2018 UCAR. # # This software is licensed under the terms of the Apache Licence Version 2.0 # which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. @@ -345,6 +345,10 @@ add_test(NAME test_Unit_OP_TEST COMMAND $) set_tests_properties(test_Unit_OP_TEST PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") +# Utility to (re)generate the AOP/COP/TOP_SingleProfile.nc files used by Unit_OP_TEST +add_executable(Generate_OP mains/unit/Unit_Test/Generate_OP.f90) +target_link_libraries(Generate_OP PRIVATE crtm) + #SpcCoeff utilities list (APPEND SCoeff_Utils SpcCoeff_Edit @@ -693,8 +697,10 @@ SpcCoeff/Little_Endian/ssu_n14.SpcCoeff.bin # update this and merge into the list above # Symlink OP test data -CREATE_SYMLINK_FILENAME( $ENV{CRTM_TEST_ROOT}/mains/unit/Unit_Test +CREATE_SYMLINK_FILENAME( ${CRTM_TEST_ROOT}/mains/unit/Unit_Test ${CMAKE_CURRENT_BINARY_DIR}/testinput + AOP_SingleProfile.nc + COP_SingleProfile.nc TOP_SingleProfile.nc ) # Symlink all CRTM files diff --git a/test/mains/unit/Unit_Test/AOP_SingleProfile.nc b/test/mains/unit/Unit_Test/AOP_SingleProfile.nc new file mode 100644 index 0000000000000000000000000000000000000000..ffc0e74e641c2ba64408021e13a5d4edb5c1bf92 GIT binary patch literal 96812 zcmeF)c`()g|M>lstRYDuN!B7+6XE$FNkSo8DN9IXU)xcZWX+aRS+YykP;s(m-^sr3 z92^cQMc3)`Ilq}}=9;pd!z8DrHP8IrJbd{>)+S^ z9*6Y0hNYFIy@j)-iLRxy-QU-lNsnFR&r|DI+FFv{M|%37@AdaRe;@SZ=Q~`@+(`f2 zww?6&U*r1w-W{X|y@jQVxwEyStF?nY>FIyIhUGt_;&vdtXl`c9ZDHx?dh_q+cDmVH z|7TF-ucQ3?ob+!xle5;gw)$qaZvPp=w!h~_Q5Gsg`s+U*r009eNZ;-l>Dl({|2_Zz z=~#IGI~I2bTQ@sPZWnViS654CYkMnha|g>CH>}OANlt&i$^Xx>vEu)Z?bh|bhx#8o z@&9*h*Uijtd6+p{{J)Iu|2aNEO-om2OBZezCpR-^OABsCOK0v|*0v5-&SrMpN9>Fx zj^DB}77;)CcRc??-y`oxUrXiqADF*y`_J#f-=FdS)cW{;&&Toa?;!ULH+%EHzZCy> zXcz7q4$lAUH2?c^{QvGwfy%aRle7IhQ0xN}zyvS>OaK$W1TX9|9k;7 zc%ZmRHPRdP%1U}IGwjR0W z2{}jC%pd%rhxkTE4faZX=qFxgReuu={rhxZ8e|Sak8Ik5?(JI8I`{qAr&)ezR53Nt z*P4ZLm)j+O?pMS3d~nJKULlxx(J1_F^ao5Bv}D$&8NjHR`?1~OfiN`45qDQO9=@Tz zBLVKEF#Yg=GaKhQn5m27ux_%0S=`4+mI4}>`8s>>vf36*dv&76`3^8HTSN$tAi~V+ zwQuqlEMRtCXT|Vy3Cv&Xzmk!=9q^i&0p;wMVZOgst9f}3%x=>w6!nyb>81SM?3ueT zOJywcESCZ1oManwGyMTCdnh<1VixcwpYv6k7h#^Z`vSw`-!SD~ap|ci!1UEnrHI4K zF!O4s!Pc`gF!$_>+VJyQnA_Z4G84c9b1x`+^6Twk(#ZHDol6W%3HH(5QB;9xwcy7> zFKu8}>d&G-krih1nY%NtF~Drr8)p`d37Cv!jovYl2UE6bO-BscVLDQCc2rIuW*@nk zgn668?52FIPazRzrwsQ#JEs9tKXvSqoLXUeAu9i*zCX;$_k9T2O*&7p%7ZGGgke5d zA~^dO9_D77Z>`eWz|6Icn54-_m<|43z7+EU=BaMeh_cWEKKxV5)Ibm5eFTr}Ir|dk zqSSYL3CqFEIniI*n*A`F&=gbWBn@+ujwSL!buc&aMEz>dI%zyyj2?$8VG6P|s$-A9 zq?nhShXE~2ah-RytBHasrDLfVgFIn8ZUR@Q5f7vIp{!Bre(39uRSPaZ00X1qu1`(faXjZ~;YMS(&c zVt_kWVkemw4%xA6>mht`kUG+|ewob|o^OudzBB6x3DzNj+6NRMx@W^8G*2F$R*xNy z{rL@C?yG+CuT23P@no@80a4K7&NPzN@YAFZUfpoAdEjOy{=Hik?J%-JupV+n4K2`?(K|3S9p{mmbcE9@#j1K*ue?`R3029CjFab;e6Tk#80ZafBzyvS>OyGY<0W=`4wV?cM z0rlA2_MVy1L0!k*bn7KwLCq)6F7v9sKy_EAj-|=oK&2|0Q=)YzfPN5G%54K%AX?)HC!-EIVRAKDvFf#O&jS@dh59o!N;v|Nhwn61j>Zdu}K#GQAHr? zV|~sb#oT|hq<*urwG3{kuNihNI$1Oy81nH#3)1}{OmN%p4)z)2=p;KpxZ z(BGfNcx5*aXhbbNIJUkAq*^$R-gN&Cc@2UO;)qI+X|C~RXTf_&_>lG^D{eakhf&RG zdE0|e@fC?;_d;+gX2?%I{t_A;bv*e`B|`1%NWQ9qgHTEDvXON&2MPv^BiPwEA&272 zb`^(X5btEMI;s5z`p<}1T&PfizUH-Eq94Yfhi)*jcDWf^YXqKaO}~Q19Rpp8w8~H} zc(tM@>phI0(23VSEDaMHHhQZEcfkbjah0#u-(i$W{Qk=xN*D^^IHNwS0bL_e;lF=t z!<6oqY_V2$m{Fzj8a)vKv*rq$9_J6j%-vuHj+P9VmSttNGseT%XhM?g)JK?ROn(?@ z*#NUA;|#Br1jF254xM860?ZE=^E0e`hI!`+yE#$P`yU(`qf^1d6!#vH00VQFk=Xr& zS&kiMd#?0}Rm;G9zOaJDxDLz@*=X?=o`AU<1iS36Z7>n4y|vlA6Q=G-tJc&1f$1N$ z5bHSxbK55CGc}80&hggUGtru)`K8DA#jfmvahF40hIw-^sUrAD_aqNYC5?96Q+9%x z#8cgSHV(oppLTKT@FAF4f3r*K3j>VjPBwQoQNUzC;q(0$+hA(R|1P(4Bg`y)%=^tk zn(wlY^ugB-!>m{mZD+<8nB0etWQa(FX(oX$nFp3g^J%o>jEt{gF7f`v0>@F9-yznO zAsq;Fa!k4(%3i}%vi|w8tGi*Q`mN%ReU>oiZs{|VG6#58_wb4o1HjW0EoWI+Nb^#} z%MTpwVQL|~$Sl7UW~pCXF$sDDbGN(N*f&Y@bx-p5|50>?+2oBqMJJ&gLt`3=#{pSu5X)#wn6czVL5wf+WeMHcy$UYBCo$VPNM`hi)@Kp@9dz8El`WD z={exoFZ;jRP6OHc=Re-H;Dyw;CrXZ}YQb~o`;OaK$W1TXOaK$W1TXW67{wj~$U%eprSIXr6N`l;99r|y7g?^Izt66e?RYC5r?veW|M{<8< zM((f9lKU%pa(~4~?ynNb{Z%Zvzj{XQuO5*5D_3%VWk&9=O33|HF}c6WC-+xLO_We^pQJuWHHtRT;UzDk1k*x#a$;gWO+rlKZPpa(~rE?ys83{Z%!&zxqb* zuX@P+RWG@}>LK@6-Q@nNo!nn_ll!Y)a(~rF?yvgE{Z&7?zv?0PSKr9}RS&tp>LvGA z{p9|tpWI*dk^8Goa)0%W++TH*`>Q^3f7M6suX@S-RR_7h>LT}7-^l${54peUCHGf7 zFI++TH(`>Su{{;G%EU-gpvt6p+{)kW^Fy2<@j54peUBllPRFU++Teo_g6jS z{;H4MUk#A^s{wL<)l2TLzLEQ@UUGlcNA9os$o*9>xxeZn_g9_d{;G@IUwtF@R~_X3 zs*T)V)sy?HMsk1EK<=;V$o*A0xxXqU_g8u3{;G)FUlox1tM}yoDvsP=Jty~9{^b7Z z8M(jmBllN#$^Df%xxczh?yt^}`zv*FetA@^4WSbz0TUZ=5RV*;1}CV&ZG0+;|MfC*p%m;fg5Zx=v4!ES<{mt#=J z@924|*@viArK7apHV#!EQPRyg^8l4g*D~pU+=ucqPp9qL^2)o3;-xQA`O zAZlw)G`JTHC~KMX_On$6lwh!4?!p#^yyQAXEFXHn1u4-_jq6PyJ5HP%wvPrL+?$iH zr>D`{xM-^A_d96ZJLt%L+fJ1K(O=f>-4F!aleX*S`T+Nxf8BT}wFS4z;tb6K=Rs4I zH}GSBEhw2B!iPpj0iQC(gDNf+$jjJ%`J=fjWayVA+VH=Gc(kype=iT7oN`cFFWm$$ z&Tx&=&-rk3`(C%P{M*n(&18IMs|{*D-DhNGw}y(mE26WRS&)C)+3bAxWq6kwc0#E1 z9K^Cz{8sB4gaNhirGUs*=(k(15xnshdM;2gZ;!kKt*&i7m-Yog!;Wq3Y|7Q}C0M(Y z>nAl#2&igZ_sN3Eoyr`^g*Rd1t)SLA$0&>ncZtx;hQd&=p}2dWCUjjHjw#+73Dais z{E_#RVOIO%OX;g8VeY)$^<}9;FiR=fBdS&a)A77{m0r;>wncoYYT^jf)5V^eCtFI;!j(``XU^F;&nY13Rxxk=13#M?VCd+jiU}p8FVZ0V; zJ>AHY+#1Ckz*i{vYZQ9`zQZDOFoCp>)~REhIBy4-q-kBq_#_Y042Hzf;98jJVeh$S zI1BUpbh}GGbilmpP9?SwADHVq82hPE7sdzf_fDDk!{is|3h}8*n6~a8v#Dc-*_SjF9YK#jCM(a5)pMU%8Y zmqM|hEomPrp$2EI@eeTh@)>u|^DdaqF4}nN_8Vpco^z^Cd%%3Lxzld_a=`E0D`-f) z3G;#{kGId5!t|Bn@|536>jU3x>9Y&uk3*E+oJl8~(ZQ6eG-g@zWVOlJ?a)l`0uu0x&08eJQ1l3#NGQp4jc536rLm zY8njbVJbFSO}pw5OvURfD$xFh@%O_81+NQW^jpGt9`SDIW1?|urg;d1atrhZH(6jH z@cDf@lVa%g(WH=j8V_yH#;12zc|#Lr`dUr(Whg(c9%-P(54HLxx9OzwplZ)o{{s8{ zP^x;Q;uDP#yt5zZ|9UYGl8Qrrf7wfb@X}Y}BEMoFK7KNJ`a%svuATQL7VCgNh1jjv zLlt2AUiVRcXBU_)zn&OmQ~}io>hTQC<)E(}ePp}s4>-djOkD4J0-_4{FUK6e0Mzt{ z@vU(&=m%>#m+4-1)b;L6yUWOFv?}Vy11a0lWNFM3W7j;?+tfXE=;TgR6SSTFsA424 zo8Qv8ZbpUD4CZ(YmH7Vc*Hi5LF#${f6Tk#80ZafBzyvS>OaK$W1pXNTG}xh{`C{)B z>R}HZix-|k9bVUVHROt;y5pSbrA2UTgJMs zW*tXuHYUY7SG7@|-ss@!$~a2>X5lBG(Tze>?Dw&CSAzP_eG(DJjo~EgsTf8G18%1? z;>MiCXce8h!}Kv6jeUQD&+lSIg+x}-x++U}dWN#rLpTTS75UrjmpcO1X^&~bOI1Ow zV2Qwfdp- z;6+kaV_2;Nj8*G&p1H;kqt=0*3IT;MXl=Y}*x?$qTe*ge?J|L;D-31>C6Q1j)YBoj zF$ePmpJLK`Oj!qukFugho62D6b`RcE@GdMzunJsjXN8r? z+GL~e2Y~2W5SbrE1mfP_N=NlbSms^X!3f$ANw{CMw6gWYMc z^6C~fcRm-a_;Z%6q-}#`mGH9j9_cW@m&Lo1umOvv>-me{+<@Q}q$n~c3dG+aLlTI0M9W9to50GVhxU_#L?FcG=rG-$1VVic zyF}tCSkd@YbNs{|Sm}=+Rt`~vv-9_$ zP|P%#ZsX&>D03Um|4O6$OB@pBHxQn!KdOOJ=IO`L&pg^ym8ppU+P zOuV?_9)r4H>6jOo973zHQ>;FvMrbM|&d_vZAL?H_&)LKK05yK-OAx`CV&ZG0+_(RT>$kd#|qQ!mqMNQ*aOCn zd83wza6`4voTySmzR1gj5#fB-HBXIKqW8bh^>FtGh@fbm!NTi=I%6v(HIEvjkA841@yXg`2WEA#Q&F+e*DzF9daM$idz7tP9qcVt6K!Ys?x`t1-CC%yl3>34W=r%&M9FVcMn>0UHj z2)TiNAn${Gvp3Ls{b6K(sUXy85&b_+L_oP>U{7kHBxJ=4{Jdk>4oOdwS~A~dK-im; zH*+1zVN67dpTBn}jBrIy8H@Qt9}UyZt{equmXaMkCOZu^#!G7zgJDoaJhvotod)KA z5YFsbIY;Vv5|up!3}9wL<;pyr6O8^bRt)r@hoPGeET?=Upo5C}d3^_IUgv7+`A+tG zu$SmG4#RbNhRnLjDmjK}yrJkatIjo?JM++CY zfOyvESL?zUtn9U_5TAGigtc8e#O$JA-ZsEMKJ+~-xF=nwxGn~St-QR7loD9^M01z3 zS`CQwOc%v33&DzUHI+n$1uQjp;kq_zVD3t}he&ocEGA^r`@e{TWl858VJ;q6u{TYn zD^G?MuJF`SMF$`lCcj4S21xtNcLmSyVgS77kBW*OJs=#g+}i!v9hTGRzO%3Fh2=+I zJ12v_1A)yex_|l(%naX&Zf&aqJW+V>=Bv{{FnF5IWatCS-&*XsXi4)>=>e2QD<-7# zTy{T5=K%8t>Y`ms0Ei^MuEZ%=Sn&Qqbw&~vWmp@n zsHXtGhkkx%dbXB-b^OJC!4uliP6?jpWABS5!w%xgfgb1jUw>r(Bj>+U&WBT z?N3VDn>1nHU z(7t?<)zU;6B>IJ3b+u7x)yY~-oDxp^Yw=tPt)rul?fjYv{v_nZ^Y(Efi1H z+?7MKOaK$W1TX9pAkTPFZnLX6}6+z9W3Y0nJS~E zx0~;75kyg$Sy|&|Njmzt|K<1hZAvJ$spr%0bze006tCw#JBq3Yi5*(0nkZeG>;4(l zM&x}vwCZ6*269Qq1xGPhBb{V*1!X)fNYR{|e4QT#>>~@(YbzS)*Dj5T;pib$wsoL8 zp0g9BY_Yh1VUa}F>+DJkwUXezs!(!U{R&uH*hl7SOv9yn&$pi%%K_mlC(nl#*T8{Q zM$hQ}-)McO^|9cBD#(hUt`8>kLxN6ie2tGJJaefx;xEbtXDfe|IrA>CbfuqFYWWPR zKOERQ&b)`_T%#@ib2U&+xM6mB_ziq6@VqEdX$8rm*XJ|Tm*AE7BktE)BP|I(r6{X|@<=-=@UN7B*oHgO-kp*Q~vZX&8 zx$7`2n0B82Oqhb1ngRwd?L#nJwdvhmT@Ssr$2E=XE<@9Y7@>^|F{F8d^oov|GR8A4r55f;H<~hIgcnsJht0!XH+7TWwz6jfJ&b`-^E5 zU9cKN5xY>#1H>a6KV439!s5LV4PK6quw)r1VOsG8R#dmI3BV~>m7?k9-&p~x<`oV$ zC!Ye*V?CZq`x6jk#CMPI55j_g?De^xN3gu>WypqcJ`kz0C{`WXfLKa#XNN`z5E*l+ zye+kXaLVr|xB4Aec+*y+TO$k07mY?cNb5U^=kjjn$=CsL`ng9?>NpTZ9>y^pBhAB| zCUS0GKMDl3=O;4`(89`8NPtZ3VOTAf)O2)NhSdlgc`d`+KzxMPJ-R~b*ywk8DC3w( z^H~nc)s=p*+Q#Z|?(Hgkr*KesR^th)416gg4i{m?jiw=eSsw7wEr$)Qj{@;#=R@(3 zU|3z+>Gh0Aa(S@jb)sqn2xfdr$=5Cbe*8gSubT->Xz%Bfs<;8mJBRuUZkhtYZR?HX zvwXm3tjkn$zJ+ns1#N>Lo-n-V_J+&f3Odeq@`-Be!}x48>sY@jj6@aMH5BGU&*q`Z z5|__Vub^RG>2CogY zFMMw9fC#3x>^8|XxLXra>!d~l(c1I#tPfMcpGhXI<>WfJYSk<%>qdjNp+LgZRSr1a z%XEV^-VqM>r!g=N9s#AjsFl}*8UzQqxNjf60K4|zJw`*xjC#knAK)CAL0^liMGQ*a zP^^B2ztHX7XjOaK$W1TXGq>fFmnRqSrvA?0r1=fB1Fg3k}A=O#Oj>zqIn^V_fAe;tJ0NL^c{ zxc3fu;Dj~|)CO=D!F_epR|A~Orhi8rKME!S7Vp_#zXX-v-lvA?4g*K&H&y0>-9U>k z(OYLPLt|>?`7P7zkaELGx;Gn6EH7?fa`V%MaIK&QtqGZk7!!)$jG&GsOlgCti-4-;IHl>CEuhv^iMb8Y~%qdqQVe)np@WvL~)pJSn zYO9q!oBKZkG5LAsCUXm{ZX6geF=K+2K!s4pQ-(lzPnF26AqF#7sM8xFI$*^?96|eco*p?FyaV zb-JfN*Fxn@_`%@2A4;gNh*CKRLfV9p{*?wps8VeC5_gITKJi>RGy45KWJN#T7)P%l z9Pd2r(vS`QFK`sw(lx>U>RF^|XbPbvJ;8H|6!6fFW4G@p8{Dk6TyLTL3a9T5GE2!O zgXDqQW`Thhz|`!xcQUsbBpX_e&lH^mc13aaS6p>yW6=0?Lf|V@m0=r0%_o3z##^b0 zuXB-?TXOnJ@HI3JdU~%OvZ4-PS~P!n2UTl|P)0c6QEt*oz+S6tl;-oqNzpbDh3S2c zAIN_CZ@->m=Z^_s0+;|MfC*p%m;fe#319-404DIy2%sLL*iVCT2B=NJbHpY1Aga-A z)uX)i6nzMzm)A49gWgZ4T)$@5f?l}R*j*q9qUO+TiM)y&D37N!=GL`o6lH1ADfM;) z+0SuY={;YD%mOri){^#jSM=;Z#}d2@tnq#FUeDg6)!XNgDkPfxxTQQD7lI-gjX zOmB~K`(orr@irG{PWaCnyY&UX(_5j-rdZat`b7%so+pAp#^3hEbiHamv) z!O`>0#76%xs9`y3PI!|GCH^9MX`k*w_MQ<|6~o66{+lIe{|qzuo3m6Eso8?v6}>kj zDQPguAM)_nQ9$?Is>Dh-Au-8DWFq{@{zHvGY~)h{F)@Y9oCv;dP+QH zVC{9ZZ1>_3AXtC6oO#Oy<_F89yxhHDv}MfkPir?U|DxhwON)lp(wFoGm#pDC8&4!7 zl^75&bv9IJiomj{Vd6~RW0?LWz;A-fgQY(KLx)Q3V5L#Wz40(Ftd>bV&#}<}V#oZS zt?Tzm^KF|p_BH{eeXpkJlw=%XA=XOqMGR@bD=%M8L2xHdaj;E3&hYVVfr1sup%uOLv7>< z^CeFm%|bb{~lk8g**n1>acIohLp?*U534&S zqdN2+!J4GvxvN+A0kQGpW8O?Jm{)nx$}#2zQ}<&IFo!rnKL-<^V|pblA1VAk8z?WVXI{Q)zZK*$EwIlt15*+ldkFK19T`J|>rUW%KU;g2z(P{(A^LaXTbKL~J z@|o`6Cw2%~Hu2}*@cM|xq^tgf{9H$E%daVoj<=#pf$ybPmn=~h=U3;cC-&%V$N{HY zcLLCpy>Jic{3Ss*`FNSYHGpI{iTz})|5-yCj;#D^1 zI_}x_X7K{YES$If#qnKhsyO|9t)-Vq`wf{c-5+T;xdZ29CgRl`Y(eA(-7wP_Kl;@| zJFqETj%Hf#1@*@!qC(ooG@lOl!pk?QM=dko!INPv|AX7^fy<)Jo6zNO&^*)BBIy_o z3MJtz`-PtZ+s0YxZd3x5iFszN%tBC@{Ua%9N)S>As^vG5BjL#e9MrpL1`n(caP-w% zf$5*U<2#$>VffN}rmOJ`(6#WYb&jSU>c3L|+H2$r`4wiebPt6f}(RfaG zoJs{&?q_FueN6yD(-g0xR}ReVPsFp3_IsKeEbu+PXa$7*eWKQ$>#(9=P&X1Q2`i%Z z&3wa2r1gv-b)S4k$NU!_3h@-t#+2`;J{7vu^LPg0AuGqYB~~K;R3$ zX(%lM3k+hTUJra>>P+NYo4TFwEx@a*x;X|~a|0=N8@s}nkx;6n?Hw=@H(2mHJ_EXA zl9L8r(nFKb=KKpO4fsH?iwIIRgDfQn%Q#7Sh~AfEZ2wFXN{vyeo4YRL7zmoqmPbNd z35$*O_7mW>-+wAarw*J0#zo`(WRwlR6?1d4_LAo+Hpq&-fF&u?9(=${`8}m@#)8Tc)`QPaEW|(Fm zPXY41Esgi==R?Xm8_vtBztMN>= z({`a_$UEekL!}Jszx{fOoj)dk319-4049J5U;>x`CV&ZG0+_%*BY?VawKu5!IZ%_Q zYzD3}0#(GeH^<75`U+>CMYe!y^tSVA%{aXl3Nqo(|GDrTRZ>noU8@C@+8nNzTIY#^ z5~2uYS_hE%vl8jMx~Gwz?z^bdH>8ln4v%;}!>4GvtXn|niX^UJykUpH+I!qb)u6LE zhpllDW)Uf_TDx)H_w7`qc74R@sBO2U`E&#fg`bV7Ncn=Iyj$P*2d=>5%kh?AfI~|+ zB+j{JB%*#gH+>;@P86?ErCw^m3{hxo@DI-+c$6qi!7suKx3+{hwtAD{v`?r-*w`MB zpbgKIUcUnLFOrVQr0_ubnLd{2o79juWV0<{FD)c2Jk6%!8vyV4$}|_zS#agg?TM5) z40#D% z@>T6BtZ*}#h31j=O^@Y~(r8bH(Zi$MhxhwH@7B-Sc&j^5_s#022TK&JL}z#e9(@L@ zMvqs6d`5v-vUX$9n+oPr??|33?}e#5hL?Q}D53X}Mm4WlG%Qn$`@|Y&0nuki^pwaJ zta`i1g$_EyGBw|!cGq{Xpl8^wtd#&`p*Gb`H#T9>@Rmx0d?D#Rh&zTpk(`JY9j5JB zYoz(E)TG|EyFj3@pO4bche>>fU~%bBz#kMl=67!wX`YPH@?b0JK8TmqVTM@(mXp7k zY#ej}0#{eu=vW?1Ex!x*&UXiVr2UzuystoLIWg_L=?E*4TQ`3B1jF)Y8kgLnS|ISQ z<7!7MVXFC_|7m6fOTMp%ZzplXic$D^_N`Yy?EB)o^_jE}Rar^bz~OdS@{nmj2O?mS z!R&EHS_v%Idvib8^oCXT5TwKK5 zr28lijXOffdzeVy{|GPN3LT~sU(8H#(9k2ieDA&y6c_Wq_9m^b9KP6jBwH*Cx~}6M z>$*il9ea|csz3weilkkP%>BK+W{(^^12y;C3^Ya*XXcFy~VahE_39V{8PQTjIdM z7f#j1LDn zkaPa0g!wgJw40(|N165`8a~nHsOK+=n($OUbu^v`$5CxtdEqU3TchziDBuoyvE!6v z%Q1R%cj4lfL5utU%vB0IDkgvlU;>x`CV&ZG0+;|MfC*p%n83eX0Cj{I9jDx*jq17A z1`qGvjmmZzIBVQbMyYM%9}|xu6enC|ne?Cp`4H07COGe+FDQ*8(M1crow_&D`FsWW z588gcOP_~Klx}D|p!$lm-dGvc9Y27C!W1rlfASF5%)+a9T4oon)6}e}-)a$89%zN= zzmDRiLywp zCGZLu+?mN1K|lAqr-|84K*?bBqsgl}kTuCT{Kl;oUdH|I9Gs2=k1K}XmDB3MI>!Hm z)^=e~Q(#MePCpL4gKZ@@pFe=szWu=PgBB{{#T_mfO+iX|=bN9_AK=wq_c%e)zDwTI z21DB>TwwOi75Y&9NSLI}yRh+X6$U=;L9TSIqL&jkS-^!-Jtyn z2v69H7vBv6K|OeI@IVvHbA&CRHES58jen~edz>SAo#;kOH-T zCv{sTC8A2Cd7S(|n`>3BFeALWy3Lvv#&y=BruZI17iA8wLmBBldtHOa*2CCI_x1aJ z(U8>zR_-JxDdA{fQT9n&>r^bvmYmYD_OF8Bkk$Gyo;sL+P+Yv*Z50T6Pwr`#ON3=l zjk^+eSzu`)Zno?V4)7*v@`oB9z}VWCH|Oc8VAfS;>8F+hENn73dvgB!V{s8I zrR{xr{LwhzbEzuRf{(%YM%$HbRGKh5GPbkc;t(vl?7x`sY$p(^cZ_;IA$4H&swENZ z&Vc{GFLZ)!4~%zh9O#Rt0{k=Hw+f_v%L#F@hn1=H4(BN=6?(0?sE z?^XT?EK{C%Tyzo-%O76%Pxi`@jvIK;*HRb8sT#A4uit<{$zkdd(I3!c?q|dMXBXff zGJ4!NdlY6mRr8+gaD>ry*Nw>A>(G)DN`HS$5x#O4pZfmk73AIWl9Kdng#OsjKN*hG z(0=ag9_DAIP~~0C6vZ|G=`ls?6;Gc+T*vWGbms2hlPH1zvyuY^ODyr7ly#6)7W-Un zqXVA3H)^YTx`CV&b2GXkhB?@3sI z(pOY-d(RJz5eZacsW$10Z$e2L7j@=RG|2V`}(&=vo;R?Vj0k$Q)5(-`9;#D7^M*;KJVD9TL#|hPx+ztiAVw6z=SD7W>GpeQ<915=&xRBZ%aRFVG!74-CNt z*Pe(!MeU0$cIh)isAQIFsK>zsiIwu8y+=>OQ-7@s%cbeyx~MGY{UI5QMm6F%MYlji zOO%UZgb~Y29POz+ULGgfa8Jk@Jq%-!`hjY0?)GKdM)gM*hH2*Ptc3}<7 zWtR*4R_}pQ*RA-umQDEfvpPwH+X9+wPKZfd_JuF+>e$!}gCWt@b%V7f2cj>wMoU_j z!M$CxxX~NeV46D+_IG;2Sli7}1Nw)!?9#fsBa+HB2I^nWr zT~}D-9SC+Lg7nD9f(;VLEmc7T0PI zpUC`4>X#I9K7S_7f6?w#d9U&vCT)2+u6g&t2vM`HcS04~TDG_=4@;2lv$vzYFOIbC zO^Jr?rL{8^$xY1HP)lud~eqX3YyPB$DQ5MgnZlr%iRhbcbh1$nQ+jJd*hEk(fnTykT^# zm)8gIQC^R<&|#Rxb)2I;8U~}@GF<05wP5Ci+@6vUTENQ;*G)}Vz+!cZT1Jf?X`bu; z-V5DZF#AR3r+-BYj9$A{vVW}+=3Yz)=W5)8#e8q&p`~gdT&J@ud^Q94$7lLl2>W2B z`_yEN{VEJUmh>sn`~(YiF0XYb-UA`KZ+;`3fwbPy;eF|rJ6FbYSUNP1MZU+#6=+5s<2zVB|9EdtMr>;{^%5|BF@{ydv%01{+_ zhs+u5Am~PQ*8QJ6U^!dhD(RRC`U479KP6^Ba!Vz>!ZQ|ZPvHjTT{+;=O|RPz_zgf> zd9gyN^eIr(YfOyEbD@O?fxqv`siU;xyJrFtnbEJ#M@}?*dr|k;jwAEGLQoF>+x}lg zX~@i$S`l)jkR<-qzVL`B9G`hdfO(WZ>OK5J-v3Mrs>xX7apj3Zg;V!hGx`CV&ZG0{?aa)O4C6 zdkQayD))%@>?j{Zg?F5upVIC^Z!BeWws^Op2%Z{tqWym4;m>315SEEP3}$+5pE`?T ziQ9cb1ycmV(Y`9ai)$I*AT`qYIAxri+{Ax*D;X(}wHz_My;v zDuVkWE1kC8=Qr-DzS$4jBtM*M$>Zx>*Tr#)^jeo*1xN#|UAf%q_5lum=?~CJ^M-8- zcc+}{%TU>Qfjon2lBD&F2Ya*6svxl~ZP)njet7iZGFLQn4&3Tqnew#`1#OcO&v$1k z;gE@fnY#65pjjCI(Me~A+8>5$;*|-Ix2#tOBc~xzrm21hr49sl>qWOlTEdOO9oo_C zSHK|JdG;AD`@WlH8?@j2u*T#(4_{m2%qKV)p(u#yJLBoQ@WNPdK0os|1W%am z)RlV;PC{aLn*W7O~*utr2FAHz6fKj9fI);g>n{rEOdDCNrm}OLc^RCmx~+)6btaDhzDrF zoTbJ4k}3ea>HxZUXaMH!`kU_?lY~*m$JGsarqJi_e9*(o66(84JUzmoRnI=}n3&M0Yp+y3Ysr80srB{Lt^y+#4Ex9_qg z??EuPXfU?M-Xd}vDsrYG{e+3u6}{mNdW zmC(8X(@)MZL}zcn#H!)w>%3y<|NP@#+-ozK+}Yf#xa}Ow$Q4K)2{wh<->3LlicZ7y zOKsP(=~pnZ^l@6{{1Wuv{XFYTtb%C@3+laJPr#gl=Y^eab1?5uo2=ro3DX*^L3~ye zFhOTDW?$e9J=uz>@63u|HpI=iow^n9%3Lb#yM3&WE)P0B zfsCm!spvzB z5cA&uREgMAc&u@n9iJKqMv8|RD+7f<-JVT_^5F~!9GysJ8%%-gzwC2#zp=x)`wl*8 zoTovE>b-*a=L$p^a}w*!mPb9fn??8eJj+#eXaf$-Oy7nOtq{1w_i`O^Tz}*0ZafBzyvS>OaK$W1TXSL+d8UC|u>TRquXVd7*zQ=s@#jMx`nr=hh*1n6%g((hAcYoQG3du8h{%FprSs}hzG*Pi zuqXKVhJp^|G(0bif#dl_SI6%1LF49+sHi|`C?5z=V{YVyJh^8!D-N*`ap^`Ye~mKu z<%iW(GwFeK!xe&~m=g?12=Ygzv_cQ<+`5_Hham4l@4%-Y zrZ6!c8Fo9+7N#7B1mY3_CaLc!Hr3&vZ#bBu(f*Ib(He~3`@!l} z{s1NyePzmmPQjFgq1-8>Ef_Uvrj6Q{2?Kq*N4H(HgjTHqX(#+s7=80ovuC(BAi=X!xkj(Xe#`Ci-NKDac-jN!^62BCMe>=69JHl$fD2%;JGgSTQu)wmzrG{sW&A zp1kIhHG`3r?gwt~vtgjDrcaOSDRgvCbKRttgfFKXH-&^7p`ho1$1#&b5VuQ)KH}*M zXxX<^BAQ1Hm5*LNO})qf1?busb6pKY5ng&ni|9kZ`Xrp883B7n_a*(RN=WLs>UfR? zAbfE-bw#TO9$4IeeOaUmbQ_+{+?6VZGrywQcDx7!?i4rqPM>FRwU+UK*Mo0xI*!J_ z*}4dLdqgi9#Pp%ri;uQ)yy{V#Us9@Wgcj1gc&3B_Z;z&P>R)FOeNj09eG`;-LlN>l z+Rq2faGWi_2(xnEaVJtE52HU`xc%}pUNsF(mIfC*p%m;fe#319-4049J5U;_Vk z0fbXc5^_l;qI~A6KA(vqlzb*)eY*jmfc(k*H346d=g!LaP0Z@ZtZw})d!;8zk$hgn z$dHTz-$l6S&F)3^&HV3E3@VUf-rD@jkb6kXjiOc0A{$W!PgrtzzQ+x_UE8+mcNkZ1 zbSEb%um_i|Gw8&&`UmH}JZ)zbaSCU4)WR;)>M`z!8pE@p&ELRpj=$j`EDls@S!piT z)M&hvvivT77kYDE>E{KpaAcW5QM(eDj^nhUy|R1aA>1M~ZqMy*0-Y_>`)5C`g0v*3 z!oi(6u&wTEko_$^G*!tvY|7kL2a^nd|bD|%{yXUD1jL+ zaF~8mm$e5p^fOsmodMX_BrZ7;+n{{*ImdE+F%;y;KH@&0g{U2Lf4*sUl(H|oe|FsF4;ehL{%G&>{y*vG;di??bu5zVhrlh!JN`)k2 z&UedHsVm_UkulRL!!0S2;Y1?yEOX|eh>ZC@=6NbIo{VvfDI`k#{0+ag?yGzLfM>6@ zKQH!+z4o&=)S9jouMU|&X8bPASmq;;U@+7^mh==zVLt*|mKh8mB3LoI%mP&!la>*%ilNJUj!uNB+i(|vh=UG^{-={_%i@7iq`Zu~9Y z&2$I4?KEY22g0HG*=RO<)T2|gpuB?fL*nlFk*$X+p{M_AIq}E zXy+QdZwM5r;GKrrUUu!}JO>!eZ{(S_I0593H{!;{KEkJzFvnkBIWVBCn7i)*C-epg zU09rDgl4uEZvq+GVSwE+!O>_Ah82HFsV;^9*-ltR@HrUjHXQMVkNjTe>xyZi1y@O=VI6{@ zhgPw@@MS=~Ug zc1YgF@GUSrc)EUG*a$S-AAEUyVFo0=(d9}$p#v6%Xzc)#BUrb_6SsE4b*wPF``rbd zC5-Jc*)ue@6YDu#WS2iuhGmc6=m}S}#qJdaHZRfG;_~!E(_--(xMYsrj6;tazE?r! zl%Qri)<6s%?BeagiX_()O^nZADFS>`588fWUKn{wfy*4b8&q#9_oM*Rns_xs*WmeI zucy@fsRC31ssL4hDnJ#W3Qz^80#pI209D}M5x@#Y&q-fBgRpe(7MGmiVJt@F!)fUj zgt^D9`yc!+g*h!&#*u_*FkM#;J&nV=u-Lsrv|k$@V;(lF{lw}p%q;Qx%q`;qOiF&Z zMl;|ZCa}9Ub4$;Wu(9M@GarzTcTLXT)E|C;SANaNztVXfPdRfg;%TicZl`D}Bg&A9 z>nu`;vmxU6k?jocM9!OV_+EU`)YU0$v%qfI*G~x>WYjOL$W>4mjb480Zx1IHJ`U&SAHaU_+>i7)a1R@ob}Hbe_rW5n zCbOgVFhE%SwVGZU2k;Db3i_rp2R0*%)vbTof->)KQ~nTbkmA{8Ai*vOEMJS_c^qFr z@$p3b#;xCw8P!K{u?T}G3s;3fwkP1s;+`Ab#|$=Xo9edF@8I%@+x=(K%b=0gwBvK} zUZ~k^oB1x)6N(qu9G(l6zzYtgZcYUk2pLpY=G0My`=?)}OS$Gl$Cf(Xl!P3#d$F+C zlWU>zxMYjgtE*77swwxLoCCRfx*V|E86uBdkXGN>x73xRx29&z0^NQ22b zuwvEGfO=MUIX=r@@K)5q|D?7Ew26iI_L9iZITtT;}hu=v++8C>!6IZ#r978{26BP1Sr%et8X0 zbt=QQ@4XhZbdEUTD`C*#@nemNQ4YFPdQ;7e%Ark(XkLCj5t<4$ z2s_=m{(4dhcIy*6|28@c*h@B+j{-a(pwvcoJ;VsK*)E@ca&%xVA8JF2!hd3~1KzV= zE%=6uO8an%1c+d*=g9PL#BO3~{+4Be-U^s=h{e;W1}H8vKSsDvnAGtz>QME| zinXce%YLl%v*ET7zJ{e|%dSQYeaFHBM=Q>kGGceht&G~FQ+JpoyX*RJ zFy*ibhGllR(q(92^mp>&^W%zf4zy%rcY_GVQDajY@cIvuZxq&xdn-3fo$F+td6ZjO6cGhtaL2k=wMZZe=w zs#@S~n$`3_L>Qj6q&GWkg|93^qVC?W_+b3iYZ94r_}dpnw=$DgaDxHbLi_$D%)Eg4 zhwW{KD$1h`F+K+)#HUOAJ5<~T@io4GbDn1jF$@`a{fuwKKXv+QKa6{YH{T!nll*)D z^X{5_CT5WX7QrW+ws`jeOY3-^{%|ak4f-KT%IZVBXlvG#Xn~jua~gvJGVn=pwaddy z9uPrcNXjuf2A&1U>SAveK>x0`wffjPQklDV*^Y|?DV=yX$?qwL1mwuIX9b-gU-^5r zbbtuFJkj}#q$&ZSTsHGEYc6nY=7ZDd$~=;v$tjQ}Y9Uom&*w68B2eOadcu||8j9S4 z%zPMUAUotQC4TGz_&>T7YQwT~7jcTcUETZxVsk&4?KhbW<-wFyM(!~vze|~HJHNd1 zU#+xIg@YAR6^|4}YJ2bW*L)PS+%Lkt15Gw-n!li&K#(f96b=<7C$BJdSV9@8DeUY- zDCBK39D2=(Lt0qjmmaMH@cbDTY5c<-N)w&?v}@y_JiF;wfRZVcwURD=ugHNy%zx`s z#4_Y~3a{=SS%#=YgU{AY8cXPA;56fTJd4G-*vJP(HE zV!53=kFKg}U$%OoBz3Tk){3wbH&JBja4nQw3(zFFyoSQzCEDCq^pGcg>qhWM5X5%X zEhv=|p-gH5zn$L<6@UIbPuY42WiwlfQGF~>5HfOnV2Ba2K6kj8WyC`SJ9kRUUnWqV z#&hN6N&-~GdU_Ps0hB(N;ust3gseejPnQpdkX*?Sux}EFC#-!N-2AdoMtq)P_ydQM zZmip;XB-MTuiQ~pl7^_^q@b3zbnpxN0hbpQ;5t*%@BNfsC{*RII(g<5WX-GwWqI!O zqqN_v%LLSettfx#w-57hPI4=GuFe=;u+$`NDYrv3=XBgMzqVoOkt z$ni=-yVV?*DNAB_?`vVUE$%MFHhHFF)HxIFripUB9&Cnx?gr_$>AQHw;LTdcZB^W; z=ly{fQuC(@Pz9(0Q~|00Re&l$6`%@G1*ig4fqzE;_Yo|864-MY_fQSVy78VD zcj7oxbTqvMzee}MS(wKSSH?3P^z%1yKIKuZ(;+``dx0zai}k8;J?rB?Xk8d^xkML( zQ1>r5-LYLhy7;B4m5GM}Lw*KT^@*IFV`t;A{P9mQ*XY%D_C&X>oMtV>+#Y5aysC7- zuq|!^#~(?UU{z>&fd?~TTBN$+6s<7+Y29MAn@$)n=9jvdg_q*qjUvWDPok<;osY4V zbtz!`(!?|4B1)@jQfNPGV2Vgm-Z6l7pCw{rpzLANxrHx$&{G?ge2k|)KI#(FFpYas z!c~+mlwy*FGqS0*N{GliGBmcKgmi6tR;PKnkX$Ocd)ws>qUFri679c%f0eE>zxnDa z{;u8n#Cwlw6zuuaR-@w;^6ILM^UaAvcP3O{dk=g-szj@0loX7l$ie4YUYa0=T(_Tp zP|{IElq|jM3py0*OksR;Y5|2D?_(8CI) z6Z@5BQFJ|T<0DlMl&r=y{bGwbHYix zO=NMvTtltP1f^^bGwJ6kq9mQ%cd4(_QHb!2^1&mlP?y2rpxnv{CBt9t@EDXq^s_mw z-z^#_Id6SY>YN!$+54`LqDw-N_Nuxr+G0>I>6V^M;|b;FvpF7i-jFi)V49$8h!Ttk z>TZ}tq2%}q>12LR6m3lJX?L9+>V=Bt(sufJ6kn z8!os%kf1}+>~wB_zl(yp0|ebZc>yS%;jP}D+yz134JaR+Vo{1yT1YKEj*>?fSzjs0 zqVTT*EFo<_p{klt@P_skq_@4W&z_w{L8QElAp2I7BJvD(0w_LyXW zKd+Xc_!oR$-wsuyNM-M=V#|Ewdi>K;glHbJuRlu1j(H=kp#2}lRF+Xl-*H;MW9o?X zPDoCDCLcMj(P{)9^hOs}l%;B}Cn4GJic5TjcM!|`>60}v&d6+QTSk8*09`T~zA+lp zj83IS(~2L;!B=~%t?d`R@G*w|R;$uDJX^rN;JH{F+V`Z`OglOUpUMnTqiZ{gSF9(N z8*%)`%@?jz_-AF|0)dvsO4y#NnV94K?)rQ1t1qD6@(3elVE8;n@$UspMf!x|?Jrsw zJn4KHQKpQ9g(WIl$22WcOHrFjg_XU)!m_|V(ClGl=7XGY zN-a%L%4f7HBAQw*@mADEdksD8shN)k7@H!k?pA`J0t4D#A^KZqeG9QCkIFFH?V8Q$`=G1-H`ty$&iuIMFpgOCE!3X;P=?v5 zCEsh)vNgNQIBtB8etevkuGuXPEqSu$$Tp5&t#92sKEGm;X4CZZ^j+VzjB|{wTgQGU zm)Wfk1A_GJue^+NJLy|Di{?yqSaV(09J{{ji|OUd%9NuYOf}m~7A@D6VSLubZMXW8 z>WJ%X?Cax@OtLpxg2v0*F*pT1Q0*~0R#|0009ILK;TjZjOS5`?`5}$iQ8)HMOZ*+>%+u<3l~D+b@?oUvNGG2q1s} z0tg_000IagfB*srAbx6eJ>>)>jz7G>j!tr8sGZCeB$xZ*AG$;iuQ{-GZUF2 zfB*srAb#OlF=&O z#2X^qRgXwz^v0Hz+Er2=l;=3L;jmN}Z+idv9t~1?A*sju$fLyLLp`Y5FY3%pWQqU+ z2q1s}0tg_000IagfPh~>s-mae`q6DSO4YARTe`=WN=?LT3w!i^Q0l9rdbik5N<-oC z)fI1o0W?Ngyn(QE{UHiB(!61>$o>}^$6n|WsQ(|Efe(`rcBLomY009ILKmY**5I_I{1k@1_@08-06YoAI-t%|1 zUfnZEDrZHl>D_CFREH(L8c|px)dfFayYv~CR5od+@4a#h@%T^=>h_B|GZUF2fB*sr zAbV$2cwH)?h>zQe&x!s z+hou0!{!~`7D7Be)PuVH;_rM$2q1s}0tg_000IagfB*srs3RcT4wu~E`6XDkUzhf+ zcWaewKa?=>{1^MBqB+-cVb_bY(_GSg#~)p#eEfv#13u|bJU-Ney8WWg%tWRLAbJ+n|F;Gv3HPoZkgTNZM|PS<#8J~ z_3k5^D?9^2cZ3s<5A~pKzxX?!5dsJxfB*srAbaeH>!e5>$YiAxwd3{chtlc_#UBg$apC%-Dq9c{SGNSH8T09 zuFGY~drue2$#mlJp&r!j7k}q7LI42-5I_I{1Q0*~0R#|0Kpg?e8xi{U+jE~3N9e$( zhE8l2=is=>k;`Vt?0zSH7%}=wnQeL6a;~;Y+}m?pZJjEJ$A@}Qw_ntmnaC6Y1Q0*~ z0R#|0009ILKmY;1fZVrg(87@sDU!JNfj1lD3uQule)Nvh0W!ItYv_ literal 0 HcmV?d00001 diff --git a/test/mains/unit/Unit_Test/Generate_OP.f90 b/test/mains/unit/Unit_Test/Generate_OP.f90 new file mode 100644 index 00000000..c28a5902 --- /dev/null +++ b/test/mains/unit/Unit_Test/Generate_OP.f90 @@ -0,0 +1,372 @@ +! +! Generate_OP +! +! Utility program to generate user-defined aerosol/cloud/total optical +! profile (AOP/COP/TOP) netCDF files for a single test profile, using the +! same atmosphere/surface data as test_OP.f90. The resulting TOP file is +! the one read back by test_OP.f90 via OP_Input_ReadFile. + + + +PROGRAM Generate_OP + + ! ============================================================================ + ! **** ENVIRONMENT SETUP FOR RTM USAGE **** + ! + ! Module usage + USE CRTM_Module + ! ...Additional modules needed to compute AtmOptics directly (not + ! re-exported by CRTM_Module) + USE CRTM_AtmOptics_Define, ONLY: CRTM_AtmOptics_type , & + CRTM_AtmOptics_Create , & + CRTM_AtmOptics_Destroy, & + CRTM_AtmOptics_Zero + USE CRTM_GeometryInfo_Define, ONLY: CRTM_GeometryInfo_type, & + CRTM_GeometryInfo_SetValue + USE CRTM_GeometryInfo, ONLY: CRTM_GeometryInfo_Compute + USE CRTM_CloudScatter, ONLY: CRTM_Compute_CloudScatter + USE CRTM_AerosolScatter, ONLY: CRTM_Compute_AerosolScatter + USE CSvar_Define, ONLY: CSvar_type, CSvar_Create, CSvar_Destroy + USE ASvar_Define, ONLY: ASvar_type, ASvar_Create, ASvar_Destroy + USE CRTM_CloudCoeff, ONLY: CloudC + USE CRTM_RTSolution, ONLY: CRTM_Compute_nStreams + USE CRTM_Atmosphere, ONLY: CRTM_Atmosphere_AddLayers + ! Disable all implicit typing + IMPLICIT NONE + ! ========================================================================== + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'Generate_OP' + CHARACTER(*), PARAMETER :: COEFFICIENTS_PATH = './testinput/' + CHARACTER(*), PARAMETER :: AOP_FILE = 'AOP_SingleProfile.nc' + CHARACTER(*), PARAMETER :: COP_FILE = 'COP_SingleProfile.nc' + CHARACTER(*), PARAMETER :: TOP_FILE = 'TOP_SingleProfile.nc' + + ! ============================================================================ + ! 0. **** SOME SET UP PARAMETERS FOR THIS TEST **** + ! + ! Profile dimensions... must match test_OP.f90 + INTEGER, PARAMETER :: N_PROFILES = 1 + INTEGER, PARAMETER :: N_LAYERS = 92 + INTEGER, PARAMETER :: N_ABSORBERS = 2 + INTEGER, PARAMETER :: N_CLOUDS = 1 + INTEGER, PARAMETER :: N_AEROSOLS = 1 + ! ...but only ONE Sensor at a time + INTEGER, PARAMETER :: N_SENSORS = 1 + + ! Test GeometryInfo angles. The test scan angle is based + ! on the default Re (earth radius) and h (satellite height) + REAL(fp), PARAMETER :: ZENITH_ANGLE = 30.0_fp + REAL(fp), PARAMETER :: SCAN_ANGLE = 26.37293341421_fp + + ! ============================================================================ + + ! --------- + ! Variables + ! --------- + CHARACTER(256) :: Message + CHARACTER(256) :: Version + CHARACTER(256) :: Sensor_Id + INTEGER :: Error_Status + INTEGER :: n_Channels + INTEGER :: n_Phase_Elements + INTEGER :: n_Legendre_Terms_OP + INTEGER :: n_Full_Streams + INTEGER :: SensorIndex, ChannelIndex + INTEGER :: l + TYPE(CRTM_RTSolution_type) :: RTS_Dummy + + ! ============================================================================ + ! 1. **** DEFINE THE CRTM INTERFACE STRUCTURES **** + ! + TYPE(CRTM_ChannelInfo_type) :: ChannelInfo(N_SENSORS) + TYPE(CRTM_Geometry_type) :: Geometry(N_PROFILES) + TYPE(CRTM_Atmosphere_type) :: Atm(N_PROFILES) + ! CRTM_Forward_Module internally extends the user's profile above its top + ! level with a climatological reference atmosphere (CRTM_Atmosphere_AddLayers) + ! before computing cloud/aerosol scattering, so Atm_x (not Atm) is what must + ! be used for the scattering calls below - otherwise Atm_x%n_Layers ends up + ! LARGER than N_LAYERS, and CRTM_Forward_Module reads opt%AOP/COP/TOP out of + ! bounds for the added layers when it later consumes these OP_Input files. + TYPE(CRTM_Atmosphere_type) :: Atm_x(N_PROFILES) + TYPE(CRTM_Surface_type) :: Sfc(N_PROFILES) + TYPE(CRTM_GeometryInfo_type) :: GeometryInfo(N_PROFILES) + + ! Per-channel scattering optics and their internal (Jacobian) variables + TYPE(CRTM_AtmOptics_type) :: AtmOptics_Cloud + TYPE(CRTM_AtmOptics_type) :: AtmOptics_Aerosol + TYPE(CRTM_AtmOptics_type) :: AtmOptics_Total + TYPE(CSvar_type) :: CSvar + TYPE(ASvar_type) :: ASvar + + ! Output optical profile objects (aerosol-only, cloud-only, combined) + TYPE(OP_Input_type) :: AOP + TYPE(OP_Input_type) :: COP + TYPE(OP_Input_type) :: TOP + ! ============================================================================ + + + ! Program header + ! -------------- + CALL CRTM_Version( Version ) + CALL Program_Message( PROGRAM_NAME, & + 'Program to generate user-defined aerosol/cloud/total optical profile (AOP/COP/TOP) files.', & + 'CRTM Version: '//TRIM(Version) ) + + ! Sensor_Id + Sensor_Id = 'v.abi_gr' + WRITE( *,'(//5x,"Running CRTM for ",a," sensor...")' ) TRIM(Sensor_Id) + ! ============================================================================ + ! 2. **** INITIALIZE THE CRTM **** + ! + WRITE( *,'(/5x,"Initializing the CRTM...")' ) + Error_Status = CRTM_Init( (/Sensor_Id/), & + ChannelInfo, & + File_Path=COEFFICIENTS_PATH) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error initializing CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! Determine the total number of channels + n_Channels = SUM(CRTM_ChannelInfo_n_Channels(ChannelInfo)) + ! ============================================================================ + + ! ============================================================================ + ! 3. **** ALLOCATE STRUCTURE ARRAYS **** + ! + CALL CRTM_Atmosphere_Create( Atm, N_LAYERS, N_ABSORBERS, N_CLOUDS, N_AEROSOLS ) + IF ( ANY(.NOT. CRTM_Atmosphere_Associated(Atm)) ) THEN + Message = 'Error allocating CRTM Atmosphere structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + + ! ============================================================================ + ! 4. **** ASSIGN INPUT DATA **** + ! + ! 4a. Atmosphere and Surface input + ! -------------------------------- + CALL Load_Atm_Data_SingleProfile() + CALL Load_Sfc_Data_SingleProfile() + + ! ...Extend the profile above its top level, exactly as CRTM_Forward does + ! internally, so the scattering computed below lines up with the number + ! of layers CRTM_Forward_Module will actually use. + Error_Status = CRTM_Atmosphere_AddLayers( Atm(1), Atm_x(1) ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error adding extra layers to the CRTM Atmosphere structure' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 4b. GeometryInfo input + ! ---------------------- + ! All profiles are given the same value. The Sensor_Scan_Angle is optional. + CALL CRTM_Geometry_SetValue( Geometry, & + Sensor_Zenith_Angle = ZENITH_ANGLE, & + Sensor_Scan_Angle = SCAN_ANGLE ) + CALL CRTM_GeometryInfo_SetValue( GeometryInfo, Geometry=Geometry ) + CALL CRTM_GeometryInfo_Compute( GeometryInfo ) + ! ============================================================================ + + + ! ============================================================================ + ! 5. **** COMPUTE THE AEROSOL/CLOUD/TOTAL OPTICAL PROFILES **** + ! + ! Dimensions of the scattering coefficient tables. The same + ! n_Phase_Elements is used for cloud, aerosol, and total optics so that + ! their AtmOptics objects share the same array shapes and can be added + ! together directly (this mirrors CRTM_Forward_Module, which accumulates + ! cloud and aerosol contributions into a single shared AtmOptics object). + n_Phase_Elements = CloudC%N_PHASE_ELEMENTS + ! OP_Input%pcoeff stores the Legendre index 0:n_Full_Streams shifted by + ! one (see Pack_AtmOptics below), so its Legendre dimension is one larger + ! than the largest per-channel AtmOptics%n_Legendre_Terms can be. + n_Legendre_Terms_OP = MAX_N_STREAMS + 1 + + ! Allocate the OP_Input objects that will hold all channels' worth of + ! aerosol-only (AOP), cloud-only (COP), and combined (TOP) optics. The + ! layer dimension must match the EXTENDED atmosphere (Atm_x), not the + ! user-supplied N_LAYERS, since that is what CRTM_Forward_Module will + ! actually loop over when it reads these files back via Options. + CALL OP_Input_Create( AOP, n_Channels, Atm_x(1)%n_Layers, n_Phase_Elements, n_Legendre_Terms_OP ) + CALL OP_Input_Create( COP, n_Channels, Atm_x(1)%n_Layers, n_Phase_Elements, n_Legendre_Terms_OP ) + CALL OP_Input_Create( TOP, n_Channels, Atm_x(1)%n_Layers, n_Phase_Elements, n_Legendre_Terms_OP ) + IF ( .NOT. ( OP_Input_Associated(AOP) .AND. OP_Input_Associated(COP) .AND. OP_Input_Associated(TOP) ) ) THEN + Message = 'Error allocating OP_Input structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + SensorIndex = 1 + Channel_Loop: DO l = 1, n_Channels + ChannelIndex = l + + ! Number of RT streams to use for this channel's scattering computation. + ! Fixed at 16 (the maximum CRTM supports) to match Options%n_Streams=16 + ! forced in test_OP.f90 for the default/AOP/COP/TOP calls alike - the + ! stream count selects AtmOptics%n_Legendre_Terms and hence the lOffset + ! slice of the Legendre-coefficient lookup table (see CRTM_Compute_CloudScatter/ + ! AerosolScatter), so it must be identical on the generating side (here) + ! and the consuming side (test_OP.f90) or the phase coefficients come + ! from the wrong table slice. + ! + ! CRTM_Compute_nStreams would instead pick 4 or 6 per channel here (the + ! same choice CRTM_Forward_Module makes when Options%Use_n_Streams is + ! left off) - kept below, commented out, in case a dynamic-stream-count + ! version of this program is needed again. + ! n_Full_Streams = CRTM_Compute_nStreams( Atm_x(1), SensorIndex, ChannelIndex, RTS_Dummy ) + n_Full_Streams = MAX_N_STREAMS + + ! 2. Cloud optical properties (COP) + ! ---------------------------------- + ! CRTM_AtmOptics_Create's internal Zero-before-allocation-flag-is-set is a + ! no-op the first time an object is (re)created after CRTM_AtmOptics_Destroy + ! (which never deallocates, only flips Is_Allocated to .FALSE.), so without + ! this explicit Zero, Phase_Coefficient etc. would silently retain values + ! left over from the previous channel's computation. + CALL CRTM_AtmOptics_Create( AtmOptics_Cloud, Atm_x(1)%n_Layers, n_Full_Streams, n_Phase_Elements ) + CALL CRTM_AtmOptics_Zero( AtmOptics_Cloud ) + AtmOptics_Cloud%Include_Scattering = .TRUE. + IF ( Atm_x(1)%n_Clouds > 0 ) THEN + CALL CSvar_Create( CSvar, n_Full_Streams, n_Phase_Elements, Atm_x(1)%n_Layers, Atm_x(1)%n_Clouds ) + Error_Status = CRTM_Compute_CloudScatter( Atm_x(1) , & ! Input + GeometryInfo(1), & ! Input + SensorIndex , & ! Input + ChannelIndex , & ! Input + AtmOptics_Cloud, & ! Output + CSvar ) ! Internal variable output + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error computing CloudScatter for channel ",i0)' ) l + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + CALL CSvar_Destroy( CSvar ) + END IF + + ! 1. Aerosol optical properties (AOP) + ! ------------------------------------ + CALL CRTM_AtmOptics_Create( AtmOptics_Aerosol, Atm_x(1)%n_Layers, n_Full_Streams, n_Phase_Elements ) + CALL CRTM_AtmOptics_Zero( AtmOptics_Aerosol ) + AtmOptics_Aerosol%Include_Scattering = .TRUE. + IF ( Atm_x(1)%n_Aerosols > 0 ) THEN + CALL ASvar_Create( ASvar, n_Full_Streams, n_Phase_Elements, Atm_x(1)%n_Layers, Atm_x(1)%n_Aerosols ) + Error_Status = CRTM_Compute_AerosolScatter( Atm_x(1) , & ! Input + SensorIndex , & ! Input + ChannelIndex , & ! Input + AtmOptics_Aerosol, & ! Output + ASvar ) ! Internal variable output + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error computing AerosolScatter for channel ",i0)' ) l + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + CALL ASvar_Destroy( ASvar ) + END IF + + ! 3. Combine AOP + COP into TOP + ! ------------------------------ + CALL CRTM_AtmOptics_Create( AtmOptics_Total, Atm_x(1)%n_Layers, n_Full_Streams, n_Phase_Elements ) + CALL CRTM_AtmOptics_Zero( AtmOptics_Total ) + AtmOptics_Total%Include_Scattering = .TRUE. + AtmOptics_Total%Optical_Depth = AtmOptics_Cloud%Optical_Depth + AtmOptics_Aerosol%Optical_Depth + AtmOptics_Total%Single_Scatter_Albedo = AtmOptics_Cloud%Single_Scatter_Albedo + AtmOptics_Aerosol%Single_Scatter_Albedo + AtmOptics_Total%Backscat_Coefficient = AtmOptics_Cloud%Backscat_Coefficient + AtmOptics_Aerosol%Backscat_Coefficient + AtmOptics_Total%Phase_Coefficient = AtmOptics_Cloud%Phase_Coefficient + AtmOptics_Aerosol%Phase_Coefficient + + ! Pack this channel's optics into the three OP_Input objects + CALL Pack_AtmOptics( AtmOptics_Cloud, ChannelIndex, COP ) + CALL Pack_AtmOptics( AtmOptics_Aerosol, ChannelIndex, AOP ) + CALL Pack_AtmOptics( AtmOptics_Total, ChannelIndex, TOP ) + + CALL CRTM_AtmOptics_Destroy( AtmOptics_Cloud ) + CALL CRTM_AtmOptics_Destroy( AtmOptics_Aerosol ) + CALL CRTM_AtmOptics_Destroy( AtmOptics_Total ) + + END DO Channel_Loop + ! ============================================================================ + + + ! ============================================================================ + ! 6. **** WRITE THE AOP/COP/TOP DATA TO SEPARATE NETCDF FILES **** + ! + WRITE( *, '( /5x, "Writing optical profile files..." )' ) + + Error_Status = OP_Input_WriteFile( AOP_FILE, AOP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing AOP file '//AOP_FILE + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + Error_Status = OP_Input_WriteFile( COP_FILE, COP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing COP file '//COP_FILE + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + Error_Status = OP_Input_WriteFile( TOP_FILE, TOP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing TOP file '//TOP_FILE + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + + ! ============================================================================ + ! 7. **** DESTROY THE CRTM **** + ! + WRITE( *, '( /5x, "Destroying the CRTM..." )' ) + Error_Status = CRTM_Destroy( ChannelInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error destroying CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + ! ============================================================================ + ! 8. **** CLEAN UP **** + ! + CALL CRTM_Atmosphere_Destroy(Atm) + CALL CRTM_Atmosphere_Destroy(Atm_x) + ! ============================================================================ + +CONTAINS + + INCLUDE 'Load_Atm_Data_SingleProfile.inc' + INCLUDE 'Load_Sfc_Data_SingleProfile.inc' + + ! Copy one channel's computed AtmOptics into the corresponding channel + ! slice of an OP_Input object. The Legendre index in Phase_Coefficient is + ! 0-based (0:n_Legendre_Terms) while OP_Input%pcoeff's Legendre dimension + ! is 1-based, hence the ileg+1 shift - this matches the convention used + ! when CRTM_Forward_Module reads Options%TOP/COP/AOP back into AtmOptics. + SUBROUTINE Pack_AtmOptics( AO, ChannelIndex, OP ) + TYPE(CRTM_AtmOptics_type), INTENT(IN) :: AO + INTEGER, INTENT(IN) :: ChannelIndex + TYPE(OP_Input_type), INTENT(INOUT) :: OP + INTEGER :: ilay, iphas, ileg, ileg1 + + DO ilay = 1, AO%n_Layers + OP%tau(ChannelIndex,ilay) = AO%Optical_Depth(ilay) + OP%bs(ChannelIndex,ilay) = AO%Single_Scatter_Albedo(ilay) + OP%kb(ChannelIndex,ilay) = AO%Backscat_Coefficient(ilay) + DO iphas = 1, AO%n_Phase_Elements + DO ileg = 0, AO%n_Legendre_Terms + ileg1 = ileg + 1 + OP%pcoeff(ChannelIndex,ilay,iphas,ileg1) = AO%Phase_Coefficient(ileg,iphas,ilay) + END DO + END DO + END DO + END SUBROUTINE Pack_AtmOptics + +END PROGRAM Generate_OP diff --git a/test/mains/unit/Unit_Test/TOP_SingleProfile.nc b/test/mains/unit/Unit_Test/TOP_SingleProfile.nc index 1d56a3a000698082fb462941c43fc30e4752ab2f..827db503c4e313d8ef658e298a34093341fc380b 100644 GIT binary patch literal 96812 zcmeF)2{6^||M-7fh>%K&LMcnhmaWqJdKZ;awnPhw5VB;8cG`$gktO?*rLwO{B4ppm zzGUC`Hlg3^efZA&X8tq(&u9Msx##!0XWq@Yiyki5d7jfbb6@j1=O`#1rKVc`#RR|6 z!3UG2o`Q+KrKOR%E#)uh;lGTQdMEX77}*eCF@%q`mU?O?`nE=TN6d{Zj4bVluM_LQ z*H0Q`aKiTV-!)O4-zkqa!|t zKQrkaH8nTa(l@uKY=MfnY}9#Pa_}4F7ks`h4}P2od`4rieEI*|z3?yZ<+_!*y@e5< z?PYyCJ0lxY%PV}Bt&EI~O)r~5C*p_v|J)nL7_qmj2EWYoN1)q?`MM=@CS1#_65GMBXU-lJx z2bTUCB@FRxl-mMv9sjqjMVBwnHR3kNXKZhInYdB>@1bq^jIC_`=VC5jkN@AhQ)78l zR0qt7jgr5}0%QTQ09k-6Ko%eikOjyBWC60k|A_*4!pT1xXI2&933(?H=Ktj3iL?8@ zoYr;5Q!Y&u9gQ@`Qzm*`%4TKoB-@*2hCAp;|DXGuKG^$&=$ZIgp^NBQOf7YS($jS# z{65j+N+g&r}#{33yOD{eMafOP{ly;4_BuXe)8zHbA+FF zqzNMYz#WBp!k5H7K128?FTV^^e3?!wo^Xmr?7@z1@G7|p25R6BO#Tt<1wY9{m*hzJ zeECDOgm*e7c^>>WQ(XTNc;iEn%&WmG`|sH?1%AePyZZ+4{eo{9EWzLMTHII)-fDHb zrv~`=L1$AZ@Q*DwUZKZR^l7UUSdN09NzT(s1Ao6J=mb0X*72=Le0V}WzkX=d9q@m= z{Z8%!FKNv;qJgJOa<6kw?gbyLekOz#Pf*#@b?w*1Qmk4-ArC+q8 z;B^RO_jo=aRO-f@Cy5Jj=$3k+zr!9DSih~dFG#}K&lk7Ig@y7;$ zeI#0?aM!kz;3uP2GZO39N=8gufzLN)xsd?=umyXg6Zo5_UW9!H-?pLiVH^1F zmMNhi@HL(aYXiX-J&N@(1h4U)$LAV&gWQ|gRq%NZlN)Bh7d(#bFauw38lSlgKKq(l z>rL>gl5WEh;MEy%Uo-IWB7u>b;1l$AKidsH%i`#!Xz)pV=aQa)Kh~t377YFjZGtg1 z_~aWdRY$<5GE4k<2|l}dI&=hligjYO4*282J4!s!z;6wUDC-(DIQ}wKR?7tq%eSU` zu04lF#S69`IlUW=dPsUC{ux6f!&O)3R-2(A-Fg40ejhaK@gslIKLCx=J2Hx`Uya6I zWLFQgH>0tKfKAu9;Gn%44e*?>vnYOv1`dhDs6M@idPDniOHYQOZ)2VD z-x%6ZYg^!Pk9=;_{!PNp`lcUh-<6`(JNyK-m>B9RckrV+T0erjdMU3cU87*vR5y6>tNN4ZKl7JE}(pu|AVpPoBHQA~H`&vTrQkl$jjXNRt;x=-KeS@s1PtB}h|FUh?t|gwn~q}*77K0K7kK|qJSLDolPo|MAPbNM z$O2>mvH)3tEI<|@3;f?$fH)7?Yj)^4aUQ~?jv-?UCvcG)^I-XZCaj5 zEDKM%+{!HJ;XwNT+($~ef|KaUyt#9V((|`N2c_q)?i-Yz^1}})Jyq+9h@Sfm%|Z#! za%t=Y;Ugl0Zd3d$E1Zi!f3Xlm@yI@q@Ris5))QW{XiF~P^BQi85}t9$bt~Zy#!(-l z_}j;EI4`1J6kRwDUS-41hc@8FOY}2S34f7$-44Rr%dn;po{u^v3_M@yd-+=MMi!C6 zlHhTz-^@PXxideiN`s%R=eW)WzD*$2BpJN7hPYDzON@N1>l#1bm}rqag#Fx9~YHjlBUs@#~;4vHuI(wW`Iy3o8_~%7I@vH@02~ z&SykjeU8q8_pJFdVhQIn*BYd(PJs`TRnqzl{;HiVK8Pn7N_e=oz&Vl1rF%wFA>gZS z<_5ri<_a6dMlOJFYu(YB5B@D(N*h0TYfhAS6udbP&8{Z!9S={kGlFlwt(Gwh{wM97 zSMYs374>^USA!3pyAcfMbt<}29$avF^DB4jt---p2rQ=0fd3x4QFk5q8Zn)uui)bk zr_cWYuPEduVF^C@;|GRH@Ckbw)`Wl`S~F671bpGAE5|#)#~~HVdGL}(2FJF557DVg zvI6fvX>sBe_>N89yB>hgzUVji6MT5d_Q|c_Wz>sBJHbc1{WPeag%V`J^+MMX5?n!4#PZi9wj&#%jr^+o;l;m#ln&{5k6OY_{ zf2W0M=Ofz#y?yh^!pJmNwIxrK6=`lr^gY4Yfi6g^?T!)=N6OgMf!~kvkla&}(`Mt?}A&NV|p+o4)_z5!GcHY+-6+XyV&-*mTS3C~?b=*ihNTrqdixu?~mr z)51dYSd)BuP5Aj+SfRK=v&M&^{~I4O$UTt-$O2>mvH)3tEI<|@3y=lK0%QTQ09k-6 zKo%eikOjyBWC5}OS%54+79b0d1;_$q0kQyDfGj{3_$Lcs6%uOW3SY;u5;I5Vp&<>d zNF=1`%Mx&}qhrS>c;lqg=oh z7p`a62bHtYA_8?-N~VI=r3xl2phhW2@IehyIOL-yjlD&Zfl-DoFEbJELsKPfPgm^s zrDX4#$12$HIOnsZD`&CKmNW9rFD20}!F3~D)J^D`;DP?lZrn&;&O^X>VK+LuDVFv8 z+U-dG<>VcapX<<$YA#`u>pxILx!|49*+VGs^2v}@X$k0gdhDNx zBIud5;atCZ2r5_HW2o}^2r8@kzD6v)2bC~&M3hWdp}b-NKefRiltbIzh_6;a$$~nc zo8uEuy|hM{);1Z`aMJ9|+}1UyfnW5<7t<;kU}+;tKab-#SEu%M2< zYJN%-ui1>6kI_4QllDd}mk%yFoY;z*Z+ftBRlh+^`#3l(E{>tPZ{bn<2HvA4*0{Sq zM&+nQHuS7+jt6S(NMgd9#!*{W)=rk052($i&tgOjzW=R`K_pBhk8~_7cXl58L~#|6AP+O?yqX7q(+TTGW<5F)}pVIE;spXDp2#} z`;>+C9H_<8=iyjM7itlYTHWyG6KY(UziL{UziM8YziM5XziL~VziM5Xzxui|f7QG) zf7QA&f7QM+f7QM+f7P-wfAw``{;FkV{;G9l{;G9l{;FkV{;F|h{;FYR{;F|h{_5+> z{8jzR{8jDB{8ib?{8h!u{8jnN{8j17{8j$S{ME;m`Ky$b`K!#8`Kz>*`KyGL`K!>C z`76Jb`74)|`K#wE^H+~o=C5w9%wJtznZG)>GJmDGGJmDKGJkboW&TQNW&VnBdHxDp zSed{2wlaS;wlaV9ZDszdd1d~pa%KLicxC=7jhw&wC-0}pwaEfx0kQyDfGj{3APbNM z$O2@6e_sJSWaasTAuG=x45d6jt{;zBdH!Go<@tk|co^mRgV#y_pZiG7a`xiTli61@ z5Qm--n%A}wJ?YukP2ogORi-9NPwn16L{E7M10BM%xNaGwc=JUjO8?f&3>44pl1T9~ zL07>q>}39Qh49t`=bH%srBYRs@QjX4-Go1QSm`FkpQn0=hn!-VUgdZfyt*KVVFh@} z&6gLa34gPNii_~hj}uJ^&ui~F2mVN#ZL9_*x}gDl@6~>3eLN(etyAVtI`~4VZ7(FjV{YM6&Ui!*OYbYg9`J)NH!ug{Au69L z0`~91Lq1at*DXfip>wIu$^5L~1K%l2Jp`|-#Nx<_hZ%0(`Bgd%4^h3hpn0kX{7B0C zu3kL!djb7^i4r{G;;sU=!=d2&qsu>7f`8Z}c3Kwv;Q5I;K0KtrPU?8=FFf>z!^DF1 z8t}17zvrM&?^W!`g-JZjX!X3g#2ENryDZ9U!9SZY>k;88hjs{Yf~rqG!br& z-Qdk!x7N*qubcn!`vZ8BIOk9q@NOx_%9Vr{_8G_opKGHz{v5nV{M@;V;Db)N{1^hi zJKdh)BKYG`?mW-HmtI{x{snyO?Td$S@GkLdj&B2hyq7m#x=o<)g7x8wAfXETU0CS<$+oOK9-C zs65>dcz$5yJ@2|lzG&3F*wfPd4;tSz^mxnHQ8YGjG^$G@4vl1)3~>zYL4!l{?F$)G zXoPdjZ}$Kz8g<&qbm1DjuGapTyEH=!#nEjSH*`x<^?yF?ReWn;9jV!Vqw4vaHvo2*Ce?tZtK^s-RP z!&B4;+`>@p^WMR=h0dswF7A7A(K(bas_dh!wiA_T={YjVq@coeUtH2GH=&Qmgg$38 zUO?|G+uOdVrl6=SuZ2$=rqGLzK@xlZ_@l6}{?~&l#mMLT3Fp}?4dg;Cel@uBGcr%m zyr0_8i1ep}`#M;UpksHG!&s{Fk(Roz5RLgSq_}?f?9WD5BzExjIe$?V#K635tR~bS z`^AyZb7{k7tnr;t$7BJr09k-6Ko%eikOjyBWC5}OS>T^3fTwd+ySExwgfriraIeJOy`Rv?LqNhj0jYAY4Qg(>qyV8GBJZt4!inmicP4RbyhX`L# z;Vnh@{$EXtgdeO+cusgB{DL*%lc+YEQ2cXERq%BU=l^zsFLu+}Ko4H-UFVLEggZw_qa1>e^h%YOrW!+J~Vci{28&f715cckS~7X}~ire7UN_z(N^jPP{s zOv9xaQT5yEBKqnA`EWe6W3A+=YfwIYuda9&q!SJLhb1`JX?OV-u@O1 z`~%g#&KC@8z-KXE*u4S#R~I=hS@2!SAEbYSKmF?icNKW+cyApi@IJhA7BYC|ZRVqe zHzmNg(cUz-0Y833eV*`^Wg~y}!AIuK7Nml&RNGc80bXV2;94c{hcuUi0qi^72MXuXTg3tOIF5eCw4P9i@2LD{W@V6HD64L=VU(CFHr9hNj0Q_6A z(^Z4ub3~r*I}cvLa;_4(%llZBPqu+C7h_L52;TJRaX$?-o?>ntTW5i$!Z(#|FAqo4 ze~%T`-dTlaeg=si`Ivxas(9lMDnCHe7f$w_XJJ882Y#%hjysNK*7NV3@x{>W$u4bf zhrMX_hFJc$1U)n};h^rC7J;S$lQh^I`_WWc@n*@0{b=T7cCo1R4K&jh)}`Qi98J5{ zS{yU>MN@W-MswI&G@`%p@s8jFXuLLhG2Lq;nkcksxm&jpjr%B2YX_&J!Lb59+b7zn ze@k=p11ewCvFiz2@31oJz42`*`dkd^*{i80AiW!P(f9B1qLV@OpK>zUYfqu-WbO<; zZC#X~`go0CbUdp3go$0bu8oS%zfoOcE<||(jx+8j=Fq#ZQgVqgdML`Q;@rg#9_aa9 zrZb0?3{b?@F*>HdKhevO>yPMjUZcmhmtWTe`yjJb3mv=s2hk;}9XnO!9FbzGY(TAd zD>}3FTmE|)4RlyS$x0-K3hjR7a5q@b2GPyzU>2Lw!hXDuP@TE%k2M8pTu#&D#pVJB zI39kyfDL$tp1st)5o`N?VoNjs9jqd~HEP%4R;(!FeXoS|D=hi(rGgSZu7BoUpIntJ zKo%eikOjyBWC5}OS%54+79b1!`wHNnEO&@7natvOCwR8n7o5ZMg=1%48L{AnG}bnw zG1YisXx!(AY^8Yq;%T;M-g?si7kz9UE>U`hynjmRnSDHz(sOBU4W*~IMiHfFd}k!l za}TSP=(3;hqWBo0trS1OGEMQ1EKQgD+a4smirS9Xgy)a@Yft#O8+saqx8;5FjpF^s zu2X!hTo8DHh`?qO!e@kZodF*wnWiU7cqfjs=Y%hP7vx8H_RDl@z{_x%3-f^IFPdT$ z2mg-VS%?n2&Bg2+^x)rUG`1jWg;}*dWcpJ!I;BRo3s+xiq{&8=kH260f+l!xp z-+Q6v_YLs<_@s5Etp(r}cHUI*!3$|=HVVJL z2wuXhPxvJGy!`UpMc~=K?QvWJAHAOWoF#bdbEoty_|@gc+s=cR&w6+0BKW!!i`={6 z^8TdRxShB?_(w@hJAjw;6dN!GPuD-yy%YTY%+04#!8bP4uPy;UM3d314F1{HvsH%R zg)7U>!1YA4l&WwRZbxC#&Dj~>!PnQn`I-WLRIrKnCiv$g+c&9#-<>cS?+WWv318v- z1YVZ4Li!2#1_z0n4`@_dS*&qV08M5u>|95ail%cqJc3x1&`kDaRvCt2G^08vens;; znmY6JmZ(A`ny8y_nhu#j)3K=*;e(QBc2{=(<(}(krmuMG`&w@_!)O%4@!>d{u(n?( z9FEY`W6z71Y5LKOOD_HJf ze#;3_T`YY_|D=k(8Wu)h)tJOc`|o>1A$Lp`APbNM$O2>mvH)3tEI<|@3y=l=nF4r$ zu+E-F@ojj)@8>gXWZ&UMTLWC#cB|&wWIh z49zG#r4H6pdWw{uB6@Ps)V!heEI4mO>3OIDBYKMRUZ|t^?Hpkg&tcO<=|B6}hT=1? z4p6*2{d&U7wrKhg{=3qd(-c4Gl0jLY)?yXK=Xh>i_PZy*>#k*eqz3+lcJTCH!Y9(7 zK23POl7$??hfAxOQ2g8)cJP;9_-!u)?|U>?uM>P=hU>L7!pDooaT0#^@zO!U|CUni z0e`bgLi8y3m>wJdN$@cSDiuTE1&zvu8^Dk753YL${*dU0rrqFU_f&+e0$-ExRn{GR z$=NkZ(%|-T&m3I2V}M|Q%u6jJ|=0>5Jye>e2xIUsbV(*b;u+^UfS;P30& zR+WR#k0`uS3clt`_J<1aTw2|U#Qr5dI!Mic&!b+Fr6ty1k7yzZpKcph2EHzC%PBkX zTg*p~o&dkMGGgQ#_xgFWk7)|e{6SO9YaA4E+2K6PN};IWF`BF8uu_VgLqDjk4n8lwhvryz zM0Z=Mq8WR}^0;YvH0E2q?X0OVnl)*-E8*#Z<|bD;J)dnvb9a`Uqzk*zl>UxGuXR<> zSnr+I7JEI^r@m>2)MsNfy{fY<&EyiAvR?|>`#cqmz4<9uv?UVt9vfHJ{&f#^P1uL< zxLiT?M;msCscWI$VPB4(wo9n{Wrjt0Mk;Dv@X5Vtt$u z`KphOa@>tUE^KnK)v`a4om%mPf~GH0KPwRKHphhyx3C#=gk3}1+G1H)JA}}o4Ok7o z9s?5W;Nf%Jrh?XNx+%g)$Bwo1(r|BSAHu$57VXjgXpaSIy>Z#)xE34K5IOnI=pfc~ zqqipeP8?Qt?Uhk&t}K?xP=9~Ttr9FrcTFRUP8a4o`-th3e*8akuTQQ@79b0d1;_$q z0kQyDfGj{3APbNM{(S|A^M-`h2k!V6x+kLN%sBAk1FePbW?Fc;I^%|?ul4Z?X}7DQ zhF|cKRFC}PE*;YU=RS$d`wmlj-l5N=^o;uKPU#uo$42QXM<+w+Ss}DU^h{ipEK2c4 zlg1S9#rTQhJ(LHQ`xjCz_y6&f@M-*=>Vy|-=Cq;su8o%{{@K-WiWl3Sx$N_{f{#`F zR&b5*=Fxkt3E%26`ke5a`Y!Dvym_U#JK;aG(_aQ3uVnkk7yQ!$@BLcAw@Z9GQ%HEz zuq%l0uN?S;2w$1;+5~)l^wB4~z`uIX-hTvq-@H|e6?kTE6PUZIkbW9-BuEpy=Yzp* zY2e4hJ!Rg5|CB8o{{t_Ur<(d>I|Y7oZSd=4@P7Q)#twn^R;zIqf%6#N?iBfG@IPcu zYN>*kGzho91^xgJOG-HSlq*g9kAsgCtFeCte%~Ei;WYfqDn3p6gbwgV7I}1E!J8CI z4A+Bi!?s861fM5zVYf4Q*%RvT`N8kz!rxGVcRCt0mjvGHx{OvRULixRP$_#Be7E_Q z2Q%P>&OVnHBGy0Le9V#XJV!f=!H37M6H^4gv1TgM6#P#|AG-SOPI~Jkw z2lRYu4pV5_Bld$h6C0Y%ICtcXge#ggEfi|HCx&LWx=HFqE~2rEhBV5_*=TC6pm}lA zdo=sn@9iRcHJY2}Zr9UiLo@CNy{_#)i>4CjBlu2=qoMN*apm6iXvXTuQP%Y_X!aMo zt?7GDG^>_Tw8o1Qjs4}=(&M~XBoh3w#5>x|$rhj2AC@y(e|rFsYr zm#z7se6bpJB^>78xk!y#PKUhxcrFlC+=wWB_1PTtT=|@+#l8)7P<>c?!PgEoIG1W3 z{!oGnOwccuN1IR%!+9}!8+R1jcR}lX`B_wmSAPoK&xW$MpI7|$BLT(xKA7*tg3yaG zn=ae(MC1~XOHCDb3R&tL#ZH~QguHT^Jw|Y9bk~Aw?W1p;$fU^VXEogybogcmyVSnd zXfJn3l|Xv{Vyn8gp+C6_?Jchs9mWdAyD#zPnDMQ6?g-Q~dQ5!=M&yEm|+Q+w#Vt;ewBsF^1lt|Vfy4_&Qs^9bzO znGa#@iEjVCM-+0$WC5}OS%54+79b0d1;_$q0kQyD;GZdg7bVX}gjvwwUwqqjwr`!s zi_@;n4>C&PDGwd+>Ilo|1bK~?$}4^sp!Alb4izm(lhRO z52a_T{7p(vUb+XAp1BLO6u(>S9HswoTGw*_#fQuNOVXG7510}DwWjL{ivQxSN%%k1 zFU%-D_@@iS*EYOd_R;6S|5?rP?Kj~cRBYP}-kM>$-JbB}`iqAM?;rL4EyW*@5(fX5 z)>;YXb$mNtI3xrSeyUL>mGBGA``!^gbz7q+;Uz4e#Nb6K?CGU7v*1TUvr4MKJAMjf zc>sPwm~U1Od;lwLZX4ml9*G!(M{=!3srVN^*08*F{NSJak59mPPSx*yDoys_!&+Il zcY%LBkn7eD-oeGUsR{gXJbV3D@CCPMd3NIE)f>G}v4?@rEZ}^Y4L*5kbIUMzKN$s8 zI1lu@8LC>71b#tfRlPHKMHUyaF7Ta?VrjU*m&NaBCHC)s(=uWQc(;uWb3to52Nzz>_f4j|TdyIC8Q2>!m(jAJ_ZZ6E%`Mu2~8qS!S7e%m^~ zfF`_@hh|gSRa5Xc!;1Tz!P|VaZ@2({-faY6&P{khpa ztx+2n+m35-1!!6*<9EUE0Gd1(&lkSm91T@mi?fT|joJ>o(@nBvp@xxH=ZcOEq9TvV zG_zB$P!IoXsvo?5eCx1Q*3}S%YGd-^>0PYQ#}M~8(d{EB?P*21Ov(=w)+pGpg-(rvM%Jga}d|^cTzjETV*VH2y5%!Mz zcLtGN%-#6p=R8R7#9{tDVNOV@GV}oBdmXeRuFz}vl@zw5e4oQ&=Mv0aIhXksjG#3~ z@|!MA9mhuV(|=!>E5}kEx(%58)Wd=v4z_I+=f#XFccvOUy~lcF3jcck{)yF22h&{; zt-%TeetguKG{WMye6bmDwZtMlxvj6>c!If#^3C3g7X4@L^~qJq0%QTQ09k-6Ko%ei zkOjyBWC60kzpnsZ#1iLmz2O61)LMe9B~RmD@~*$L-tU8#J+3&m$VLrw9J_T-ZBN6C z+h&?8+~EJmN&g@FM6IEw^n7+lo6_@9q&Cr0X;pp9gs+tN_e9~?KOlq z-+eWg@NJ{@;^04u3(LUs09)(*EFQiFf7|52t_kp!Uk_0cb59~lFaNlMpWRZ@@g4k- zRNbr{_&KgO4T9jG+uV?j1^-oe&)dh~B?dpYEQ0@jjD{`=FJk2>j6VGnFKQFfI}xq} z{!_#udpqzG-&%BuIYC8h#gqf!mku2gxC&lATcil)s@im37~O+&qr9KgDtHcF=E9kO zrlu3T@%*8-&vpnsM{4LwOlLf(FSi7__AAGEFz0PXzM`hUr3W@z6EtDz; ze|n1^Qy6&m$bxV0z+c*P^C|=Qb^x!mbT~c~Jfol3lK}9# z1-4E?gr7Y6Ldi?BGJ;KOK!#NV&wt!uu58haCk4@$g2Q#(9N&dTgT<1FIe zobEhA1ByP8W~Hmp*C$SmMOFT&CfS{C?L|BEsoRS_il!cQhjyebguOvc{;#9jUooS~ zU5lduQYTURl!f=xWBMrmkd;yBUU}rZG3uh_^Hb>KMeL*fbxo9{EqG}--v@=}tT!{I zkw#9NTn3^wN|DWzUa_#p!$|Yg%ZC9|R>;YEop`~jt>`KXxA_ivQ>4+iNl$XOJ=(cA zMJK@b0&N(OKXFCR5gS(NHtJx?L)_}|FYCKrVvBKaj(n_0!CKwAex4m&z=9W_opRrv zhCOnW8N1iE15?nLx0yb+fOT6`1o(FcW7YF)eeC6RSl)|1$&<1rSd7u*XM*qKun_C6 zOLeRUO2CUp2HFjL{HmQ9)=X}dAWw-F+Z3yg8mKi`zgMkvt+ryoeRaQ zyTj`*!S!`#=?KM(3;(3}TIYO<@BMmq*&m%HeB|+WiiCevH~_D|?rSR0xdEQ1So0`T z{c#TAeYt6wD1P*A26$Sosy+l>IqfaqLBhX~zAjAo(zAEqd2}|MA;X#WgwF_H1+RxD z!=70Y!~y>F?~m7RgSQ9{y>Sox#3X5+&_^tQXu0!CfuXq{tg15PI%+3gWT!hW8ooEvii?=h+*3(tF0-Zb;#{s-_k8bU+gfp2~hW3&XGPN}Iu1N?@E z>>CQe`-khCCxZcKV>15v)fL|;VUljm;z1JppXTqmP^ugSlvd~1Ms|T8V6x`()#fN4t zyg0FWDG1HBetNX@0bYkHFQ>76TOFEokSoWyy-`1l{)0EMIcU1fna_368O?3>WNTva zL~|~e8+Mkkqshsnznn*v(MY%2)tE_1)U9;FTgP@Inkils`1vpo%| zPS`6nu<`R)ALfLieXBDHoMD@1DMO`vS_!+8OM8%o%m5HV7q($D>Ar+y|QWzNmC_l+iJPa+JI$R`o`Q zDT)@vO~U6_BQLfs8bVyo=)K8Uz+bV?=uLcKpfI&J^4HM2JCO7kT|ci}+Fa6&Ohz0^ z^;Q?7&jrIlEIoZ zMpJ|sH4yuW*O?NVIkD-d0Z($=w_ugx3x^!DZedRiPA@UVF=95U+2Nz#A7N{$+cXqb zzsI_yYpyxXJ1;_$q0kQyDfGj{3APbNM$O2@6e_sJS?@Xx3;KvJi-h%Wj`?}M3zQgvg&FkTP z*Eml2Z+#Yl7rOu0_}s}3&u=vvJF+^F^#8ff9@bWNO3&SUk5hUI^TPY_K~Mfi+?1X# zjm9ZGkDkq@^!%v@(zZ%}3j_4nryxf27X^Jm>BS-j|A$53vJ=hO} z%TJ2uK4?Sn&s^jvUUA%>@TX2oh!B2p<60%cM`Y5bQvA7)T#AqDe!INBVLAA4$!}k7 zgO~YYT{TJgVdd*<2_F%Vr$~723mY{EKh9EQ2tGcr>~0nKgXWrL2f*)~?btMRJ)+s}Zn8*-N+_M;txo>_sH#!uXT2VPC-Mb;(ozXSL*;e9Y$uP|l1 zc;R_ktD;p${lU9!ZdHNz8FbLuc*tP{ya8j~H#i@BO3xA=6$jq@z`784UqdZ^i}Z&z z;ImYnsNsDQ9lV%yO5l9~IUc^f*dzgd8~^rH;`V%V7p(x??zMJKH5F@sFXj6&TM0f1 z-%Jbd6Up)R*z~0+@CpW3npwbmeSfV+?1$^2j`cq91&0ef;QbaIGAxctn}aX7i#H8` z*JZd_#s&U0lW0gacozP$;9&3>KBck!;1gcm?wbK$rV=bmtbgUDYt5;sIMV*3uhFv~?VH)6DOjmwsg)JtCxf6>4gb?oh8=ob5h zDlb1ae(7A~1C1*Q|^UwVG+06}w){AB{UA~SUMo5nRok>Dz zlk3A8=t@ykUZCIc`Fiv`;X-X;kUcW*pNc!3Q;IG&$8kx1NJsJ|((7#YRUqpE|5HK* zZ_qgnKIW&lFCxtFzJ=~U24eczz&j96js3j%OyO->B9{FD=SWa-L$n!!f4|sY$G$Ce z=N)|HfMq-BwW7FHn609?(L@LfcKWFmx_{+#Et$7BJr09k-6Ko%eikOjyB zWC5}OS>T^3fWN;aGJWM9C!U>hM(!8hg@3qxU56>F9RCzpDI6+-;dy+I@?RZG#y>3W ze^8&yMEd`tPr~v2M9+PK600aZ1$j6qJ>xWtDLsRqmQZ>&mVc!5yx+Y@@zkp_DW2ub zk>&ory3749KV0trA(QY^J;7Hg*H<7DC*dy)#{HuBK&nuR53m$k_74QX@8LhO6A}Jc zP0Lrp>*ZK!Q~XHZQ;Ltx!Iyo0F?jLA>aIV)Yq_-B`4PU{YxEf5<&G&-627p~E1K{R zvooKAKT_$9#KG(5841A8y?v`-H(fCJDy8#97T_PV-e-ME_?Ww{C&9Zm-({-=|BS^T zToJr4V|`68_^)~`amT^Cy8E1W052~Uaq<`V{_pt?P2fih<<%#_w_TEw=K??XUfA;; zcyHRRCTZXmU5B4r)U(!VGkE8M3aL%t*~1@mjDtUS z+;QYF_y<32rL(}l?!9f{2mTu}+wq#A zE4p^*Nd!Cgr{TUemvH)3tEI<|@3;g>E;K|hyJPE%T@l-D3-n^s&Jhke8`a(w; zo-uvRa53vCo~a)(E%lckPdlZ;P1Phs`v0QO@NH&F&w)lkqNm1sZF!=n(JJ*;O3!`8 zS(KhMs;?+L3melYzBv9NrT@~fCZ+!pLmI_P3q~*Z?+hXQ)*q|*Dc;~sD#dq1c~ktn zMIOcPO~sadCOhG=C=CO`kA;P}5?+(eLy)o`o|7#Uj}3Dy`ym1FQTFG#+rVG>>~!oW z;r(t^mlEE*(WQ^@a~dBWQT&NoBk<{K>GGApU!xLySp*)f8GIH6-kK}Eelz$;RnM|_ zgcrN;nFsu6{^N?H;C=4@b#w=>(YdC+8T|Dem(&~JqvP}bCWBYq6WQ5_C)ezMvx8L; zeD?zbE++79c6#?Wg7wZ_{pe&H}Bv)=ZL3r?=ta_um;~8IWk}h zK3Ctez%1^8ozCYRg6XY6(N`2qgehdm5b;00D|zIOr7So>N~ z7raOew(}796W$BVbKpNR^%O;eKXGd3XZZKaEtGF?0`^tSytj(pgjiqp$whC%ThZ+k z2cNTQ>h>HOq&8&O@I@Mp9K5Hp%6bxnwh6?xi*Jir}pbr}cCNu5cqo|NkALh~&RG*!?%g>u1mGnLQ zRNULB$8(Uf-#Jo^LXVt&GBv9Tio(sg5gpGteXD%Znrb1eg6e;%?}{ z$-|q+V%*UMoR_u0eHT);44pl)ScRj6<`zf)Km|&;XFz{n$>sW5fb05{iGIK=F zA8flKDLwVis8V`5A4#C}OmY#S^jtS9PV`h|==@IU-{Ch&@%XRz%l-TEm;0Yx_G|MT z2!AT`%LK(As6IpSYv^HJxW29(ETH(9^&6M3uZPNAc08 zxhOt8D|Ol5c?q7kOUC#P_%tQzD9ZZpN;jtxey7a!V#3ECIm%D*CZ*Bf_vKvZasr>X zaHre}*8e!ib>krT8=~@O)xqzTt2w=y@W%_y?ZH1gT735;`1vb8!+(Hp&%X466TEYQ zP^}JlxicQh9^ey;zZml3(Pvq@c{C&OSQpzP)Gw;=xVKUf`_e_gzh1>~JQBQWlc421 z_^g|jf0w}Pp7Gkk2!8k=L#G}1WZMmLzTl@9diBM@Ke=)Z&jVjqQfTQ3-po~0>>eKL z%0-(t7>CEbW6Yi|U5h6Os&aHVz|To*;h#48ioeOEdL;U>1H2}yu@en=_D+G-S>SnG z^Q~IIdv4UCd4(sWZ@wYEjR(AV@{CCgcp1!bl>zMMhsJHzDDZ5bN-RRaM~ok3;sr00 z=kaF*yxQuEfzQD6AKJjw1-|F;7{|G!da2E7UIUZ%Smy!@JC7jy6zm}q-ZS;9N>E$z*Ua=Y7J`mHjAVF zzKPkl+-j)D#;j6IlL>Xb^OSviw+_|s;(O)t#tQYxSve*(wx9uX@jm|%5i}sT<>jod zChDfiFlYXC4YhO#oKC+%kILVxbCoX{qrO%-k%RjTP`_rl&K?dg)bscpJ37RU8lD;6 z(Rh}Hs?2Nrs1yI958pJ96b4jq|CL*eDho=(bbHuKi_y!eSI)kBw9u2E{Ya6q z8(FempVTTWKvDHN*Ob;H^kQNIbW0qz!n6_@eFQ z8y-GKIwh>!PItbd!=a2WRi>GUzgbLG+rJeXR=vNJ$K8}jf^j5=8sVe5Mj9FrX zNoB$DvyZU+DeSADyglYE->mM}uAjT5`p?wxfgicjF+SU{zfQTE0WoE_T^1`J~Q3=YakQd0lSy*{}rS%54+ z79b0d1;_$q0kQyDfGj{3`1cjS18CQsxJ0dv2Zma->K|T@2Xky!=JeLW!wu>#1>K~< z!;=(Wmxk-(Aw8;$&;1fe|6lZJ;q9UHjDI3P>8Y^gE~RJ0z#mG_%KMusJ-utjDLtQ> zI8nS6r!K{BvEW|rpHsEm|FiOP|A_B|S2B6)O!yX0<0FJW(J~%L@d1HF6kp<5zU;4T zA-ug{D-YrO)BOhtf9l!Z35tIk%1`lS3)IX0mLhnLk{ix3;H{XB9d9ChWIx>r!W&kN zz9xK(bbTnr2akJ#-+QQk{}u4J4=;|r1~2&b&hu@AZ&|f?f$+U9KJN&>{c#yJ_;5eY z<}UDgfyWFUfj@rOTVD$N*QsYbJHa25R~)1RujaVTNp)2o;7w+5fC zk+FXf{P03>30&@^(;Ar!wcyXzvFLh(FXLTvJ{1oPU#;`!dnF#cQP-rTyw@_1+N9v>L2vpyB_BLnfP4wjzAMaW=W7PglN9h37 zThw)s-KUVZ8+Eig%Z=@)Mh#5jS~k&as9M{Nk<}2+n+)oy99jiX`)@bT$CLX|d+~X> zUzHB1X|`PCHe(7Z(K$aKm2ZslwXWvA&*{1F% z2tDlTv8w8=-bx1%5ow(yTarf8|5}T%fEAfyXt!4JpaM$C;YEC@7RdMhv zmh4@VbL{jaw(f4b)AN8TtbTK2PVwN&%eW2q9qLiBVcv2cFAe#i28%o%I%-_L1)*?JaUl6#nh zsr4ib(HA-W`yNrq9g_vf0%QTQ09k-6Ko%eikOjyBWPyLC0PYeP{4&Jl9{%L(gPEQ1 zK4|WzwXc5XmBpXEi#2_{Mhbs6dPr}Q-WT`Cz55IwzC!x{+{bsP^Epb-TW6+-p5{BF z+bBKX+00OS&fZ@|>8arOhSIafZ!g75E!9){|9)J#-2WW+a(|Ja<^DhP2=5)HG)(yE zBSkMMK1u61#fKNhQv5hPKap~MC7Tew#3gSK{6nfcP6~v#(!QTY@t@98E$`=1{<81f z2R__qY5!XAk2G^jX9(XEdp(-)R_3NHgg4+wtDtx@BT?`LJcpSD!TUJ-wtN7u8=2%~ zM)>)lpVEYXcbWMQ;ZwG&h2kzjSgX&?^Wb|<-Nj?UKa?Ey83rF8U+BOEUeQ3s>oRz! z!-E;E;1}E88kONsntV7veenUmRN)%v55C||e>+_6QH_1lN^ikGiS?JK#$AH%+*tZv zhd*gPNh_e9g}ZCMpJY!v4F1>tj>%i#9oP7YZ2%wprTX+7c>e<|qmAH0ioep*zOllg9miwSw(}1 zM@|vmf@<4e@Jj>!4=lkO9rzL4jVjpaT}Ah|q3V+DC?ND4s&NR{wyA1IW&Yb4thceD zFBkl83=ego_qw!He?<_g`ufGFaO+D{GyD8u5xj0y%{>!^4SUSc7mqIrtCl8E{>RrU z;a#05IokdAEbAXseL1Nj-H-`Yrzl#FmEK2XWj&L|gVX54yT{q)k<2KyL|^yr9vc*9 zA7pLM)r(5T1(R=&$fLrbxWVB0V>*ZM`$nNP75Wq#Q!XnqLZRFpI z`0?`go10h=U7SP5{Dw-bwC?k>RPT8#(Y_9tX%ASi@l$&AJ zj{EyD`)8M3e2X}9cgVd{`Dvq*yYt0fA<3iYk-v6Q4{{W5`UB0f-O^Ghp+$DQj zB|9^gge1pNDIwaHkVq?02W^VVCAYNh5v${R+AJ$GLav>X`nq-&aMC#Dhwhyp|bq5x5VC_oe-3J?W|0z`p- zUjZb5s!&`Ub`d$NuWpFbjj6eGt?$*xGS=I9vJLVyI*f2DtFtVfs+&YYW3vzv&nGMF#dFZ|c!1_LUW4FI|TFJGHO?_dy+yD()Sg^lFJb<=LMi zzp$}QywBWc-0MnfJO|!jPNKmL_bT3Rj^cixCD$7F?jz%2xMyz4y#%~6lU5mu&#$F- z-v!>V&rr=0_ou1WJ8@4+2%zBJ$74_dc)E3;kOaKF;DW#w_??C`+YEsp_MWN^0REy| zrj8r%etl%sJmBY_I7es!-~6&TQwI2;hxIfQ;3qr+1`pxB(Pu*~@V-O%_fP>)a9MS} z9CB9Cld{R12E4E{I>ieK)>0X0_bdTE#YQSo3g1U}=|Qj$R9K`}YX^K|H81ua5@;OO z&n}Du{z8lLU^MVu)6!KZfoDZL_ALTFFCv^D0eo-&)Jg&H{P@($BH*77q(~e_f={Z= zM^asZ=Uh8)a2ELM$9a1a1OAcbhIVt{dA_f} zf1ttIOAGYl?f`#WVRJ4G_)e}Aw+gN#zd?PAn_>Q@d9zVrE?hY#G)?JLfXm_qTHU>J zFlXqGQ1|?FIBAt~PRo8bxGGQ8Hg`G$=HCeqL5cU%}-TTWWNTN?^{|Oe`lHypM8tVM)2s0H4y{!u!}U4)5MB%zj_*g6*Z-v4pgz z@a;7t1<~XEFl&G8)#Y4O*!4Zq9WQ?yv&htwirMOgnWYyRsBA32NDD6Gq`)HBao4NJ zYYtB_5_7WYbwmnAUc89mIx>K*%%CORkI2F#_W1uj`avIkRl0ShQ29Bw@~zPy{mcSP zVo^$nQ=B_G)DG`x8wo`7dtB@M7c9_YFJH+1{>v;X-5XB7tq_Xl$%UoztPIdgN}s#K zv|Uhpwez|VWPvU%@G0MIH(Aqoen->5cn_6p;W^V#5DjHCxAIFB)S+u+g<1JS6zB}& z&@H;q1o|oAQe<^x998(3&XV0uM-+~?}li!r=sZpSJaQBQpvZ&6RpQ4LYgQxy)Po?cr!@t)V3;|)dqvra)GUzpw? z?r&Nu@@E@W#Qini;y$h_sS)=D-*3s|UguU7S>%yoOOa<5JBhvXW!&4^9}L1hyE*TwVG-iy!gnJGflcvP1Fca-Ps+?j(ULDR2y*a z#*q*^iZDA@{}b@ul9A`!fWM-3z>|FU`7YdK;^rVoF!1wFS$jxlE^5J#mC zWOMmnf%lqPrt==L%BPg1mrWx!sG0T&zY*XCeM*B(h$AVN)i_!W{I>S2uXDi5E|kti zB34B-&4T)J#HK-=^Wd@%I9~0~dUc===_hKJS_|U1HgSlzFBEaGO!Xg;Ye%d~dJ@Zy z>mW8wRp}CqRK(82({qtb74WX?4SSt{_tJdbT@AeXSB=pc#H#e98oTi= zcHhuU1(u$+IpU*IEtX8X%;D0Du@J34KO|`vVSWuN%T_^`G5c8Qjsf$(vG`7{B~faY z80!&fr{!2N=0Cf{CT8trZ0|IU{MacAGfw1NZ!SNLDU2KHK2Bv~?!pDiVZjZ|`dFWH ze`+(PclY)Z1Eu@u%u7#CzsU%6K&Gpe!DFL^>V9Q6_1T!z6|TF(?fd9(LHwR&Z7L}L zb7s}C)!$K%30wYk4hL0_p}QcEWX)KrR@bG&lIVdnxQo6)4mxu5W~%AI3CMhhj;ZgI zJtXJ+-x>X=LF#P4u4Akb2DKs3Zl76F9vbudO9*$BG8%Sn*miW*67`9U=xQ)sj#~EA f^6gKQqsDhbavjK5QF%c(rI7#f$K3V*|Ed22dcQzw literal 48812 zcmeI*bx_o8|LAc-DUmXek_PDz1c~owDN#Z~q!bhhQ9?;6ML`8YEJ~D;5CsVVDQQJg z0cixJ8%YrfJ=gBdnK?6O<~+~LnR$NCAIr?%y71z=*S>dgXRiCRU)0o(k&^uLL4*F- zfi5)8=hW=2oSkhQ-3VWxK>ww3KBr^lZR?8vj19UlIG@wEw{o*Rr{QSpWb5pX|2+OU z=<_4MATKP~O{XzIZ*O@BO&55FGWEcLq|Nrhh_8=M_f} zCtEHzYb$qmTh~j@7rCsj*xK1$vc7~m;cw*sb8Y)(@oRIqfIrl~-HHF7wOz2XcDQEc zYV-eC-T%ElL0wySS6eqOHx~~pS6dsdtG2FO4woFSTy(W^;yUDHDJ|}B(NauG2)~|x zv+tod$WmM-gu#Cs;kkf+jQ`!%;{V*AtN7<2mz{^RHU3HQe};DBvb*B?zwhQhkK_MG z_dpy8iK3&j&+H+QXt7xA>X5V+d(S83-mjj_VNaH^aw>|`p6w5@a8c&A>2(Xt%w*Pl zgp67Fv1(O7)Js$Brcv>Cx1k*66&u>S$MCA*wy3Tn~mZ-`!qi zhsPGMTr1qFq)9zyB2tOFl(vA)Tbn4cZ?<72Hxku#U4LUw!2Hf(lQAro^oXE^0t?oZ zj^mK@X~I0jNdw*`j$mt)T6ZhWGO-WZzG@>}x3HLI!yp$sD(o%ouQwzu4SEHAIQ3-o^B1e2z z?qdC%(T1CMDX?;A`{5Gu1DhJOR_*!Y3(S548v@^lun+qvzb_b&g2#Z_KT|8boLt9SWCC`rQsde zm*mT#Irl}ejpIDuC9-wk&{6@Jr59lB_FJ+X3`M}f=)A$pYmQBA>}#3(^AKwfcFSD~ zI|yV-;a^)!lt8jlD7LRs8T;nm`dIshG;q-mMUqz^#C}*=r?**$W4(#REHZM>fl?~^ zYJQCZ$lA)^Yv@qIhQeH_W!_{1Z!o+d7hu5_BOc{vhTCC-y^Mz|BxYdOpyhiPgK{|9 zG=Kf(*=lS|)N|~YZV~XO8W|KY=VB`?3Vkonr(>fTR`Z8L#(;tT#fuK66QKO*#ETI# zA8gWj;|SA*9UySpzM`I<0b8w&b-(HoicPky=|>6w0wxaDFy5F~fU6U^o6&Uvo4I#q z#dPi{2=rx-74MP5e!o_B;&_{g%|)<;^BGCP-u=v@6-OgM^~vH*d9GmWhgXQ-iGU_J zln}3%xM75Crb~bJXSj$hKIH2QeDxIe)2NBL*4Kc#(Yqw;h_Bef8!45H*!LjZDloPh zos0c#mvOpSuoGJuIU&@)W(Ws%xlc+4J%wXD%$wZlI@l8b`Tbe7OCVy(HE?c15J;oX z=!D4AVrwml*Q6~bft9&Rc9N_CG&dzP%Xo*d<<|-?Bpx<^$jhr|oOLUKT+d}|q`sv^4fpDKYlv-VP9bmETDj%ndtPZyFx0EdY`!OB^Uo-Oi-yg3 z2gO^^b){oJq9uu~@m}@0cytTIAAF{~DqROuqrb*jU$Ov&snt20c zeOYz!ls_04ODvJaKF2n1(TVJw836gO=6f$z?123~nxj2)xxl{sd#dvTE$|2n_LTT= zf`0#z`O8>8wozJr#YyWSDEQDWP-Z;^<_{qqja==(d5`1V@oSdAtzIRPeH}esv|3$4 zRSVd<-MF2JP%0?NM@ltP`T)!R>lZBBe*rgVj&Ol}A8>JxUl>~Sf|I1#Io27h92kPUSSQ4=~N2=m~!t zI5gxmcp8rYe|U1}RVNi-HfDaGZYBa6?>;`eJynk_b_nFUm3;(kb(Q~aLmeEfUd|q^-RHyr*vMOnfZ{lC-M>R?Q!Q>2&A5)?o_3wNFyzzwp6kp6Hps zdJqaag@R7rE&zPu%-jVUjUYwE{>gtj2KEFGetQ~g4Jt#6(!4b;*xV`BeY5@jpkJdl zrj*42{4}2amPw=_y@T^!+hRBDlk3eld}9D=XS2ptuBc)2pLXO-Pp^XE&Q^|bn=imW zn>ycIunN+D_2-|;@c}c5nV@bORmIa@i=q-is|R3$oS!UH~JL@9sGs=yl-rk*pr~HIN;{9z7R33d|2A z3ws;BfChW71*M1@wy3q==tH6>7#&w!EF!f8p*V7LlCNZNq)Yem$6@qy@BVg4rHmKU zXdi90>^zUnGtK(%d5wYLYJmm)-z*T0Af5T#@D1cDH0^{oT!CqHfpMvRC*U5qf`M!^ zHr*L*Jz;nS3=F8|WP8Iv7Ajh43F>Q1z1-(~|(2OVeu1OcQ(e9P2*57J%fTOwAfY2yAFoaU%LeC+O%F z2lM~s2eIg}O0ue0P&m~%wnoJP6h33YI876fmd#|#pP|G0j*T<#l+pyxG= zQS(XRYkn~<$h3F<1Xsq zxQ%Ua^9c*lTLF&+mxIpQMXbK$jDnp&A)K}64p*oW1j*St-t0~#Q0`N{rgh&B`_=nG z@?qmJa9k^F6Xd{Q9~@_sYYo-md~ESUqpv?f%3Dd4tX2=OidQ-j*wb>Tesjq z=KbPRby8TlL@9SDUo=>`QLnbnNPslui=g=ca)9Jts`qrAu%8lD7P0IKu*GLw5I6P8C0ofmq<$pK<){G&NQWWzx5@xFN{X?0)JpKgfEgUH)ix0aWjw zFBI}RjLXv5Fn&d`hRdqds*JsEkIP;@`l){16qkE`S$D2y9GClJIPSZYJTAx0=g}?y zM+Co?+=us7^BWBWKY8jC@+*B>G4*&KfBjeu-aig6=EHjvWk(jguU=B0!u#4?0~yG# zUZVQ&7Vi@{x*PERN!}Atg1;_1i}xQ|AzI|06zG$bk1rDPHt=A0zA4g!ku`bV%{OQHb6X@9Udd7?J3Q48Vy k9$ZPM_w9Uf%$%!6eT&@-A$2=Os`cvcltnfbef{HONOPB1(xr_Kd zCwtg?KOnETRC##~dGd)+(-i#i`!~W`@IKGMDi?X~tEZM$kheRVe$X6w?dK*N>&R29 zM7ND1Kc>MS--NvH$I_ld$X{VRlyw#PEOHV34CL>+_0Pv=l~sMk<+$&4GhUNwF1%pc@^j0N;Hk^go$jFboY!S7L5hLB%05K~9b|M{AqC|e&^0!Pf@+D7(^OKR+b8{*zN8W(Z>Bu_rnY#Mp!^mgZ zaZtWQeju60QWW_dwTe8{$Ne~~OE44ir+16mUPS)w^OiqJ$mi|hB~?Ry%roQMSLAb} zD9t#KKQY{+z7NKK&#P)bQih57j@SJA=wV9P(Kftv02ZE*+P>eB2s4lSYd7`-OfLg1WrTmf_rY{g;wYrzHV_boB{eIMgqLX zNucMlqm28<2QVD0ZzEo!1z*g}-5T`mkvYdf!F+MuUnvV zQRC)8n>M&IeBxThuXwO)J}uSAWd#PbWc_1#|lDa1qe#O*rFv zV+_oe5_UVd%K^*j(RQQ5)SzH-ir@P23R*~yJm!^(_f{1V$lkjig|1|GhCv+V;ZN=p?B>O;f;92L2`zJ6zYWh@rDFoO^ zM$OLrz7I!N`7#r~j{yHw<$(5{6VS=>{_ueJ5@`PVF{GSb59Zd!IUn5x(Eb|ngIIuA zfLMT7fLMT7fLMT7fLMT7fLP#vqyT@0Pe z!{rVwD$z(3;c~2dcS(m`Bl>^cM@GAe8Q*gk%fJGm=kIF+gq~}IzJ#7iQ@05{^}g2N zdn(vmM*BLITD#BBYTA}?8IRhW+Oka)(Kk>!r4kA66TqoJPLGsKbT=?YD5<`ZJr3{EszdA^iH!@EA8s zAupu%p%?9!T5p=o?m_!wC&hy!jx8bopk-s)8ST$pZI`)n68S{A~2CZl1V~51_S>(U<@}d2^+~JHJx!-t^cR2vr$B=hCNG9Bg zeE)47Mk?g{{PYV}kpD$~{h0;wO>JTc)X2xJc*oTvZy^)LitcaKXOVNXIOLlIw%#ox z|1)8~#a`rFB+lk^BA==HZhaMb^+O?2Xg{;+ZP|Ou&&X$qwbLdbKS?`XtBL%_ii;=u zk$(**ozcG4Nom^)nrz6&pZ$_^1^K7*PFl~A?`IAdzJq*;W%SA~|u$Hmm<|3LnGU-9V6HIL_n_a)^1mkm03a#?WVTv-w{M`KnnD**uW!chz>EJx(zc^Qz zN?m6vl#7J1wz*eIMh!4(9+j*3`!I}E>uBfejKDbAKBJPyhA`qd)0iz=2t%cR%j{Ip z{*}FpY-q|c=o6F(ww(J0-v$!JK&Ue>a$m)xvh)RMs z<}m*IP8G;IoV#CW-v|e|o(eu(TmagK>?$TLRM=v`lRG5VWZ34y{)FrddTg=hREnf? zIX2nwgZb3HP^|wN&!W(wb*xM2UCRq|U+kl#TDRf*$^VfT1>%ho3lIws3lIws3lIws z3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3lIws3;Yij zz?!7==hQl9vAWA%wMPAM4Sn=6$(N{<9uuKizafy0aY-2J- zE@)Q?HhGHb$Fh(Q)*&BrF^Dw`dwvRDR4 zKTojH46oF&RujtGf_&_Og{<`QdM&N5^6|(pI2}zBD*Atd;@Z4G_erJ9rJbw3T zEi-`(u0Nuf*1zQp?nUO(MV*&6HPL?z9b?8OP z(eYyFqI-QK!nO%|<+D_J8C-||G1ZAJ{yT+n5G-U3e$A@EH`PeMk4_S3Ipu#cpVOJNBjhGZ}Q;D~M*+YlY7FARjK* zM(Ca|&fVOz4|<#h|;s=-8gW>e`;a>fWBe>fN5d`nElP)w?}^)ww-? z)xAA`)w?}^)wex=)wex=)w4Z+)ww-?)w4Z+)w?}^)w?}^)w4Z+)v-N))xJG{)v-N) z)ww-?)wVr<)w(@@)v!H()wDf-)wn%>RlhxdRkb~TRkl5UmAgHERk%HWmA^fIm9;&8 zm9Ra36}>%w6|_Bn^>};!>hAXZmCyG4mG$=gmD%?EmHPJlmG<`hmE!jN)uHYAE2@9y zudvPS`KzJr`K#IO`KzJr`K#{j`K!;{^H;Uo^H=%A`K$lIf5wS7O)NkxKrBEkKrBEk zKrBEkKrBEk@LyN}7r*`f!T9a>4<-=aA2*Im+J66F65;)Wg}6k*`v*OV{$KZzY51m# zLp^u-4c6dL&m@gWc6?6?x}i)QzNc>UTS8BhB4&I~CAsAiyx$#M`iI~hTWtybdrbog zp6zBV!5@j`Kz>t5{^cazyM??|!~0rILruJ=xATJ2&IK-=3yBcpt#G{}|qLKFXs9RjY7U!a@D^Ud931sO)f5Jm`=dz{0j0D z)qD0o!o{Bqsy+In8Toj<0y+0lDftEX6uOhG7OwEe-J+=Mf zNyz^xSMxyqEkov1Ys+y-BgPDY=)7Brwxm|eru&fBI!y6A5$|8R(a+-&R(B56F`_P( zIbtsQddP>)TQc21{`9J*Bzj!+Bua-k1CY-X=(*;Cj^9qwZSffS#Ji3KX#FF1-P%fo zk$1wS1mcfR*>Bl4jeH=T&2wx>NE50>xLro z*4zoxw~%)!n5M}>{*vyR!ZqX#C%cY_qT`=@zm}(f{1SuwlR4xsbJguWg1q;Xlbtg1 z&V2E)H;^|ediu*6dBddp?&o2!g_+fX>>&(mD5$wldBMn7ef{T8wlE>X^n;&!8YV>* zA6~R&gUNd5PZp1`E%mR5aTPl3@wPwQlo85mzStX%Eugvsg}uRPlzn6wa@QT6qPG3}tj&1bzZ zbnwoF`Gi|Aa$wBnB^4WtD({%Szd-}TWsw7XENn2OFt+rkXBK+i$}>NDDF8h_pKO_~ zwL`Di`b>Vj9CYjY3T;wZLaTwi({avbXzE};^QGMksx<6wsBE}H?VhJrd4mJ+;a>E! z2PQ61w&TyRyRR#}NjqDgK|TU0i>^G}e@)=Y7T1?QWOpGkn8aD*Y&%3Uac8N_q(YDe z#j3-NRdCw1w;(Tp4lW4Lj8P4@fo4YD)VQQR7{^tsgy5z@{q)Syn&JB(@uZ)Ii6#>$ zCAQv)QZQp{($0}1Iv25y;;<5r=u&LiKCg+|Bn=xQFNn#g`GNHu9JDESDZ^@|XuSo5 zd9cd&WFCrBb=WJl<{YtWgcHL57rtx|mqaW;EI=$kEI=$kEI=$kEI=$kEI=&qA1{E* z6>#9;jg`XX(a1W^e~`fCbCGWbU);hKp4_W^xOoCs_?wkX*D(Z_|1CNzZ7GWA|BXHY zw}kLLop2Vegr1){l?gqqkF^ncx~CcwdX~LG=ld3L;Nx;PCHVBFL;rYmUVD81V~iFA zZ+23Q;4@0ldC>(N&Ss(WAfe;mA={`xe#cHqJ#DMRD2hCXE86oCgjhAoOwEj{He{Em$b+i1ygtj;Bp0bY?Ph-f&AdU z(z{H^=Uq8khVPTEw`FXGe1c=4N(=JKNw>Vykl&k@;AeyUY8`{t67t==K5`n!&-mQ= zBZT~fR@uffF27G%y7dhQ-t$)%Ga~=9xHXC=k$&cX**Qu|u4)`E{ zweBUa7V^{;W={)|pB&wzY>IrNj3Wy#I{t>fhUhuuDdUe%SRsEi-6OCB-QP_sNA&vw z@@RT)J{%TBzNk$CotLce@04tX5{`13cf9f*^TAy5@b{^>AMis)lg}@d8)j=*$dwbTVeGu& z&j&~QVbUh#cFt{9nAww$o4B$cW+zf78r;KRR^ixibN@I@9#}cZp+p0t)RiE1@F$E1 z3PpGa`@=+$t0Xt|Js9&CGz$!ggAu>+70KK6&?nw_h!m#{{oO4Q0TnqgaPtwWqKORj`AI-fzADNksYQGWAo`5{y-R$a}D`2h_s*S`FEKLRx~UtaeXNkYZ5B;m;& z1(4~;d|^8JIHZz{KRqTi0Z%w~1!}jB!HXUymi^}35IIv_Vl&SLLA*68krv!=c~oKN zKAT=R@2hwqm9YXe_HVMmo4;^+pjteEjTuziWF2Of)j{;E$6}Xs5bRW}l??8W$5xj) zk5)vfV_kU;4h@vwu%)-Z?0%%2$3~0H9M0^n#d<|0`m)cR#u}?`%e|)a#cE{Lgwv?J zu(y{u=d|KP{^KtQ#2X|QAQm7NAQm7NAQm7NAQm7NAQm7N_%AJh%gbU*V_;&!z4Hjq z`a#i!E9BLgh@@-5m5kI#Njgd6-ls@Eu6`SaD>@LU`YqCf=>LsA$9z@rJ+nEw=?Oh6 zbOs1LPbTOQdVb4$L+CkWJdf}BifVF=;1!qAejz&kn|U^Zml-c3_!<>Ag6}&VhWCwP zi{^M=DxDyM_cKvxdITSzrbX~S&|DY(@%p}!k37dZU(gcr5d-vv%gF0q=BT#DdmU|g zNxV<=;pD^nW7b?t$P4St+nOOCSF`?f0C~e&zIXWJ*U~%P-X|m-)ka=3 z*uTCX`4St7lh2U9%*^i)fP9-$Uvd=kN>Skq&d3LOKV|1b-ZoFmRUP?}hW)MS$UkNO zocjd%wY#jE%*damGx;8g{Ii4CVyTh8>YvRWg8b$upCNtZt2u_WC2%F9lJd6um5_hp z^(Ea1`5Lcu#uVfo_N$qQA;00#ymAQn&uNzqBp`1(Rh_eee06k!3={I}m2WAYAb;LU z;I$y~bLR0CY{*yEF5F*1{@g@|!=RC-2+=cwUESmG|P~YNopHlk(v^+AI>7v^W9oAhL z(zlJ_`}Z6B@5b=L(1Rrt-@AM;5*1ZpD83HOd@nh3Lc*b4FuIzwv>hrwsys`M;6dqdG3gJWdRKQB0pL05efrmD2M2Gvck8?>`A+| zX=t|)F8G$y3||KsMZWIRfcEr&A5va{(3UZy;_bZ*jqaTB`mUPr>FhP>?A6^+%vkwi zU3UnoGrN`#dWu3tpzf)y;dCg-RvruU4uBLjF}5Cw8HnYVE0SUEhr70s1zqxM5c72P z#qXFq@F1M#L-;N&xRLsS_A-4WoMX}%PcLl%gZ>Lig(fC&Sc7I@des56-&1dVW4;Em zvBqn29xTA_QhZo1ga=z7dnn5`pN|bhF80UWd4Uzuj&qC7p2J2A7gQauL}Bd;+2_N# zvamXDX#>@-0a#H|#zuFbI+pAFS2wPq2aB!7lC}nY|4Uysh|3}tAQm7NAQm7NAQm7N zAQm7NAQm7N_>ULBz0t2$S>`~$pNxukG;O*G_cnERkmu@qT>iT{TJ_C2+&itYoE+|X zTyExiK#JA_qW{-@RF593CG`B{8A|B+IJk_^)5KSg(6d7KpPp}AHSj%EM?;Pfe8c-J zg1?!K=73QDW6#0~{w?+0fBFX~;Jtkg#~R+xnCsQz{XPBLCkWmt0qs+v$E!Rrkl<5g zdy)V6lf%>wdA5XdhLbFFWBYPqtk(Vr_Ie&zQ%(*56c$^8{~1p?k(KNyK2d5 zpF`fhtiC1``9tGp)1D!(s?f`d=F+m%g_|=Lk(W`6``v)Nqg-^PIr26YQQc^+sz54b z=5ieJ`o%}$(C=T&I;)~mqlP@MnjFO&+LV`Ch*#_Q;E{gdg-rUiaHw{yyZb zMU8l*kl)KPi}n|DsLXdtxdtPz_v;UP3G!U2>(4}yS5IMi&V>9q|FpBx$nR<>)fYzo zw1{n@8}eEzuPl;~XBlH(M*E`L80Ao#I`ZbVv6(E$@Ae$qXNJ77&^@~hM-H%e+ z>2zqJrx^3?cFBSUW(&c~OQz8BeviX}E56WvdT~>%kr#T(hu2Jao1wSpozMFw{NCw40#tf(ELnnDA&f zXtc@d^!p_b^(^*xhkW{>GM&uxt)2>$l$u>Koq7hDln-e*6gr@=YZuMS`_hniSGYnr zsR%NTZ(Uw})NM8)B;To>=c5 zWozC)4Os1t%yoT7TI_j?c7Q0GDb`{0+4L=QGxmvnf3f=@Emrb8n@TZd1xsI28nB&L z$5Ir#N^YfwVh^))rOQtG{KsDqh&Md>3_xJ0%na_a?hToV0fzo5}yxYW93A)6P`xR(K>GCHH1xD+}a7IXDYqW?GgsQ!LT z=;_kcOXwLntVQT~<@F+=r!f~Nq35}ae+fMcbiNS$wZ2h;57QGMc-uftg4eaq{inZ; z3*Mi|IaGxAlutW{@c#OnOU?xEC!I#{M(Fkkk5}3j^6B4iPe$7i*Cw@)Z;oF1HGubx%RCS8K5`^w3-4t=>IWiU zzkA3d68V(tSBt8V?>0Fn{Ra6p`5J?D3D&e{CN`$`oxtJiq1+j8qR@+;N_CTKnNY)qWGKal5V zzu0ykd7H1t-X2E&8LuUTBA+;7BZJQWL_fR9aM2ifLH5{&-^j~;rtwHd-uu+PnKb0R ze735qkqcus*F6f<64y^@;qs3 zD}Rx{>AV#{hrBtH=HtD{dj>GPc0j&#H zIZ0l4{n7H(_z)-LIw$58_^QHt)m|WHF);ue`Jx~zfl zKKeAti*IgF!mmX&{EH7ls6S6IEr~-~n@y9tOabJb3604vWr6~ybEW5;lpw!f!Svx= zJY+qk%U^Wuf>cLrcSc z`=<+cz>b1T^t_H z2H&%inv-G+?MKBY7B{i-R}2Z)Oa-xY88?u+U0ez=m%KpQj7Is zASo7WTDiHoIg33^-K%G%{|F1l)|%A)#4)$`I!-3-PXDDZ8^mQ13lIws3lIws3lIws z3lIws3lIws3;f3m;QZ9>f86fR!`+PLmbIK%!39j5lYC(3jtjbxP4&El4;Snbc{&3Z zj=L+K{C9)Pjp+Y%pLrK_-g11;bgwl+&-ebKgr4d2ri7k(YPp1-o4h9oJ$>563EpbD zkl-I(@g?|JVY+|%duIL9pDz~gJ65-zca$lKAxs8b@J8E7lugnanDQJ;IrCoNo! z@W%ORSVTVTH5f-CAG2UpdmH(Z3n@+Z$UkjT-5-Pe3xzBab)26jGt;&3XSkbB zML#qvbKwFenYH-}U6KD)JyZPw`ReL@-{z3d5_gn+it{^eD{Ra57Wpo571u80i^gqO zmT*D-ms8x?-EhIKT%4a{nUNnX(WfcF`JIqG^j6apcQZ!2^ZXSTT)>q4PTfDP$d8!( zk=I22fxy9pINV(c@xO&hmyq`|`Xk?my!R-7P$u&3LD%`@a6vbvd*Zrz3ab&fI`ZRAh7GtNH31-p?P6FN46e5}6%eKGR#p}VdN zBX7^m!G8vMxA3h%^z(RA--Rsm2=WvL3+FtLe|7b?*9GKNpW_bKBku_IYIyG%f#p{s zZ$MXdEEDhPGEO-m|FV9Rx)<6RZzyOTd<0)Vul>Y{dO*w4?B7q_@1Q=0eG0||;FHt~ zd-v=RC~FF|IM#Lt+DWyuuS#^lS1ZrUI@DdzvOmvKq$>zMxx4!FTAzmMLh-xg3~O+Iq?T4L{+wq>|>ViVi5C?R8Wb zdjpwPf)fmLPz=db?O83BK76< zr|wY4+Nza5p?%1>%ob4YTi017U++||A$u#}?g$T-J70d=XFd~q(f=V)g4YXsd`}=l mAw&vuU03Se%hiV2kav2nMCD-O&lY}Xvj+XgUl9Jq4gN1$jeisX diff --git a/test/mains/unit/Unit_Test/test_OP.f90 b/test/mains/unit/Unit_Test/test_OP.f90 index 36c22da5..964f7104 100644 --- a/test/mains/unit/Unit_Test/test_OP.f90 +++ b/test/mains/unit/Unit_Test/test_OP.f90 @@ -1,7 +1,12 @@ ! ! test_OP ! -! Test program for the CRTM Forward function with user defined input optical profiles +! Test program for the CRTM Forward function with user defined input optical +! profiles. It checks that supplying externally-computed aerosol-only (AOP), +! cloud-only (COP), and combined (TOP) optical profiles via CRTM_Options +! produces RTSolution results identical to the default CRTM_Forward +! calculation, which computes the cloud/aerosol scattering internally. +! The AOP/COP/TOP netCDF input files are produced by Generate_OP.f90. @@ -19,9 +24,11 @@ PROGRAM test_OP ! ---------- ! Parameters ! ---------- - CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'test_OP' + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'test_OP' CHARACTER(*), PARAMETER :: COEFFICIENTS_PATH = './testinput/' - CHARACTER(*), PARAMETER :: RESULTS_PATH = './results/unit/' + CHARACTER(*), PARAMETER :: RESULTS_PATH = './results/unit/' + CHARACTER(*), PARAMETER :: AOP_FILE = 'AOP_SingleProfile.nc' + CHARACTER(*), PARAMETER :: COP_FILE = 'COP_SingleProfile.nc' CHARACTER(*), PARAMETER :: TOP_FILE = 'TOP_SingleProfile.nc' ! ============================================================================ @@ -49,16 +56,15 @@ PROGRAM test_OP CHARACTER(256) :: Message CHARACTER(256) :: Version CHARACTER(256) :: Sensor_Id + CHARACTER(256) :: op_File INTEGER :: Error_Status INTEGER :: Allocate_Status - INTEGER :: n_Channels, n_Stokes - INTEGER :: l, m - ! Declarations for RTSolution comparison - INTEGER :: n_l, n_m, n_k, n_s - CHARACTER(256) :: rts_File - CHARACTER(256) :: op_File - TYPE(CRTM_RTSolution_type), ALLOCATABLE :: rts(:,:) - TYPE(OP_Input_type), ALLOCATABLE :: OP + INTEGER :: n_Channels + + ! Optical profiles read back from the netCDF files produced by Generate_OP.f90 + TYPE(OP_Input_type), ALLOCATABLE :: OP_AOP + TYPE(OP_Input_type), ALLOCATABLE :: OP_COP + TYPE(OP_Input_type), ALLOCATABLE :: OP_TOP ! ============================================================================ ! 1. **** DEFINE THE CRTM INTERFACE STRUCTURES **** @@ -67,11 +73,22 @@ PROGRAM test_OP TYPE(CRTM_Geometry_type) :: Geometry(N_PROFILES) TYPE(CRTM_Atmosphere_type) :: Atm(N_PROFILES) TYPE(CRTM_Surface_type) :: Sfc(N_PROFILES) - TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution(:,:) - TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution_OP(:,:) - ! Define Options - TYPE(CRTM_Options_type) :: Options(N_PROFILES) + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution(:,:) ! Default (no Options) + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution_AOP(:,:) ! Options%AOP + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution_COP(:,:) ! Options%COP + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution_TOP(:,:) ! Options%TOP + + ! Define Options: one set per optical-profile source, so each carries its + ! own Use_*_OP flag independently of the others. Options_Default carries + ! only the fixed n_Streams=16 setting (no Use_*_OP flags), so the "default" + ! run below uses the SAME stream count as the AOP/COP/TOP runs and as + ! Generate_OP.f90 - all four calculations must agree on n_Streams for the + ! comparison in section 6 to be meaningful. + TYPE(CRTM_Options_type) :: Options_Default(N_PROFILES) + TYPE(CRTM_Options_type) :: Options_AOP(N_PROFILES) + TYPE(CRTM_Options_type) :: Options_COP(N_PROFILES) + TYPE(CRTM_Options_type) :: Options_TOP(N_PROFILES) ! ============================================================================ @@ -79,7 +96,7 @@ PROGRAM test_OP ! -------------- CALL CRTM_Version( Version ) CALL Program_Message( PROGRAM_NAME, & - 'Test program for the CRTM Forward function with user defined aerosol optical profiles.', & + 'Test program for the CRTM Forward function with user defined aerosol/cloud/total optical profiles.', & 'CRTM Version: '//TRIM(Version) ) ! Sensor_Id @@ -111,13 +128,11 @@ PROGRAM test_OP ! ! 3a. Allocate the ARRAYS ! ----------------------- - ALLOCATE( RTSolution( n_Channels, N_PROFILES ), STAT=Allocate_Status ) - IF ( Allocate_Status /= 0 ) THEN - Message = 'Error allocating structure arrays' - CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - STOP 1 - END IF - ALLOCATE( RTSolution_OP( n_Channels, N_PROFILES ), STAT=Allocate_Status ) + ALLOCATE( RTSolution( n_Channels, N_PROFILES ), & + RTSolution_AOP( n_Channels, N_PROFILES ), & + RTSolution_COP( n_Channels, N_PROFILES ), & + RTSolution_TOP( n_Channels, N_PROFILES ), & + STAT=Allocate_Status ) IF ( Allocate_Status /= 0 ) THEN Message = 'Error allocating structure arrays' CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) @@ -125,21 +140,21 @@ PROGRAM test_OP END IF ! 3a-2. Allocate N_Layers for layered outputs - CALL CRTM_RTSolution_Create( RTSolution, N_LAYERS ) - IF ( ANY(.NOT. CRTM_RTSolution_Associated(RTSolution)) ) THEN - Message = 'Error allocating CRTM RTSolution structures' - CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - STOP 1 - END IF - CALL CRTM_RTSolution_Create( RTSolution_OP, N_LAYERS ) - IF ( ANY(.NOT. CRTM_RTSolution_Associated(RTSolution)) ) THEN + CALL CRTM_RTSolution_Create( RTSolution, N_LAYERS ) + CALL CRTM_RTSolution_Create( RTSolution_AOP, N_LAYERS ) + CALL CRTM_RTSolution_Create( RTSolution_COP, N_LAYERS ) + CALL CRTM_RTSolution_Create( RTSolution_TOP, N_LAYERS ) + IF ( ANY(.NOT. CRTM_RTSolution_Associated(RTSolution)) .OR. & + ANY(.NOT. CRTM_RTSolution_Associated(RTSolution_AOP)) .OR. & + ANY(.NOT. CRTM_RTSolution_Associated(RTSolution_COP)) .OR. & + ANY(.NOT. CRTM_RTSolution_Associated(RTSolution_TOP)) ) THEN Message = 'Error allocating CRTM RTSolution structures' CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) STOP 1 END IF - ! 3b. Allocate the Structures - ! --------------------------- + ! 3b. Allocate the Atmosphere structure + ! -------------------------------------- CALL CRTM_Atmosphere_Create( Atm, N_LAYERS, N_ABSORBERS, N_CLOUDS, N_AEROSOLS ) IF ( ANY(.NOT. CRTM_Atmosphere_Associated(Atm)) ) THEN Message = 'Error allocating CRTM Atmosphere structures' @@ -147,13 +162,20 @@ PROGRAM test_OP STOP 1 END IF - CALL CRTM_Options_Create( Options, n_Channels ) - IF ( ANY(.NOT. CRTM_Options_Associated(Options)) ) THEN + ! 3c. Allocate the Options structures + ! ------------------------------------- + CALL CRTM_Options_Create( Options_Default, n_Channels ) + CALL CRTM_Options_Create( Options_AOP, n_Channels ) + CALL CRTM_Options_Create( Options_COP, n_Channels ) + CALL CRTM_Options_Create( Options_TOP, n_Channels ) + IF ( ANY(.NOT. CRTM_Options_Associated(Options_Default)) .OR. & + ANY(.NOT. CRTM_Options_Associated(Options_AOP)) .OR. & + ANY(.NOT. CRTM_Options_Associated(Options_COP)) .OR. & + ANY(.NOT. CRTM_Options_Associated(Options_TOP)) ) THEN Message = 'Error allocating CRTM Options structures' CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) STOP 1 END IF - ! ============================================================================ @@ -174,164 +196,165 @@ PROGRAM test_OP Sensor_Zenith_Angle = ZENITH_ANGLE, & Sensor_Scan_Angle = SCAN_ANGLE ) - ! 4c. Optional varibles - CALL CRTM_Options_SetValue( Options, & - n_Streams = 6 , & - Use_Total_OP = .TRUE. ) - op_File = COEFFICIENTS_PATH//TOP_FILE + ! Fix the "default" run's stream count at 16 (the maximum CRTM supports) + ! instead of letting CRTM_Compute_nStreams pick 4/6 per channel, so it can + ! be compared against the AOP/COP/TOP runs below, which were generated by + ! Generate_OP.f90 using that same fixed 16-stream setting. + CALL CRTM_Options_SetValue( Options_Default, & + n_Streams = 16 ) - !op_File = '/Users/dangch/Documents/CRTM/CRTM_dev/crtm_code_review/CRTMv3_ITF/teST/mains/unit/Unit_Test/top_test.nc' - print *, 'start reading optical profile from file : ', op_File - Error_Status = OP_Input_ReadFile(op_File, OP) + + ! 4c. Load the aerosol-only optical profile (AOP) + ! ------------------------------------------------- + op_File = COEFFICIENTS_PATH//AOP_FILE + PRINT *, 'Reading optical profile from file : ', op_File + Error_Status = OP_Input_ReadFile(op_File, OP_AOP) IF ( Error_Status /= SUCCESS ) THEN - Message = 'Error reading OP file' + Message = 'Error reading AOP file' CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) STOP 1 END IF - - ! ...set total op values - Options(1)%TOP%tau = OP%tau - Options(1)%TOP%bs = OP%bs - Options(1)%TOP%kb = OP%kb - Options(1)%TOP%pcoeff = OP%pcoeff - - !PRINT *, 'RT_Algorithm_Id', Options(1)%RT_Algorithm_Id - !print*, 'TOP%n_Legendre_Terms', OP%n_Legendre_Terms - - !PRINT *, Options(1)%TOP%tau - !PRINT *, Options(1)%n_Stokes - - - ! ============================================================================ - + Options_AOP(1)%AOP%n_Channels = OP_AOP%n_Channels + Options_AOP(1)%AOP%n_Layers = OP_AOP%n_Layers + Options_AOP(1)%AOP%n_Phase_Elements = OP_AOP%n_Phase_Elements + Options_AOP(1)%AOP%n_Legendre_Terms = OP_AOP%n_Legendre_Terms + Options_AOP(1)%AOP%tau = OP_AOP%tau + Options_AOP(1)%AOP%bs = OP_AOP%bs + Options_AOP(1)%AOP%kb = OP_AOP%kb + Options_AOP(1)%AOP%pcoeff = OP_AOP%pcoeff + ! n_Streams=16 matches Options_Default above and Generate_OP.f90's fixed + ! stream count - all runs being compared must agree on this value. + CALL CRTM_Options_SetValue( Options_AOP, & + n_Streams = 16 , & + Use_Aerosol_OP = .TRUE. ) + + ! 4d. Load the cloud-only optical profile (COP) + ! ------------------------------------------------- + op_File = COEFFICIENTS_PATH//COP_FILE + PRINT *, 'Reading optical profile from file : ', op_File + Error_Status = OP_Input_ReadFile(op_File, OP_COP) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading COP file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + Options_COP(1)%COP%n_Channels = OP_COP%n_Channels + Options_COP(1)%COP%n_Layers = OP_COP%n_Layers + Options_COP(1)%COP%n_Phase_Elements = OP_COP%n_Phase_Elements + Options_COP(1)%COP%n_Legendre_Terms = OP_COP%n_Legendre_Terms + Options_COP(1)%COP%tau = OP_COP%tau + Options_COP(1)%COP%bs = OP_COP%bs + Options_COP(1)%COP%kb = OP_COP%kb + Options_COP(1)%COP%pcoeff = OP_COP%pcoeff + CALL CRTM_Options_SetValue( Options_COP, & + n_Streams = 16 , & + Use_Cloud_OP = .TRUE. ) + + ! 4e. Load the combined total optical profile (TOP) + ! ------------------------------------------------- + op_File = COEFFICIENTS_PATH//TOP_FILE + PRINT *, 'Reading optical profile from file : ', op_File + Error_Status = OP_Input_ReadFile(op_File, OP_TOP) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading TOP file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + Options_TOP(1)%TOP%n_Channels = OP_TOP%n_Channels + Options_TOP(1)%TOP%n_Layers = OP_TOP%n_Layers + Options_TOP(1)%TOP%n_Phase_Elements = OP_TOP%n_Phase_Elements + Options_TOP(1)%TOP%n_Legendre_Terms = OP_TOP%n_Legendre_Terms + Options_TOP(1)%TOP%tau = OP_TOP%tau + Options_TOP(1)%TOP%bs = OP_TOP%bs + Options_TOP(1)%TOP%kb = OP_TOP%kb + Options_TOP(1)%TOP%pcoeff = OP_TOP%pcoeff + CALL CRTM_Options_SetValue( Options_TOP, & + n_Streams = 16 , & + Use_Total_OP = .TRUE. ) ! ============================================================================ - ! 5. **** CALL THE CRTM FORWARD MODEL **** - ! - ! CRTM Default Interface - Error_Status = CRTM_Forward( Atm , & - Sfc , & - Geometry , & - ChannelInfo, & - RTSolution ) - IF ( Error_Status /= SUCCESS ) THEN - Message = 'Error in CRTM Forward Model' - CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - STOP 1 - END IF - ! n_Stokes = RTSolution(1,1)%n_Stokes+1 - PRINT *, 'FINISH CRTM Default Interface' - - ! CRTM TOP Interface - Error_Status = CRTM_Forward( Atm , & - Sfc , & - Geometry , & - ChannelInfo, & - RTSolution_OP, & - Options ) - IF ( Error_Status /= SUCCESS ) THEN - Message = 'Error in CRTM Forward Model with Options' - CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - STOP 1 - END IF - ! n_Stokes = RTSolution_OP(1,1)%n_Stokes+1 - PRINT *, 'CRTM TOP Interface' - - ! ============================================================================ ! ============================================================================ - ! 8. **** COMPARE RTSolution RESULTS TO SAVED VALUES **** - ! - WRITE( *, '( /5x, "Comparing calculated results with saved ones..." )' ) - - ! ! 8a. Create the output file if it does not exist - ! ! ----------------------------------------------- - ! ! ...Generate a filename - ! rts_File = RESULTS_PATH//TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.RTSolution.nc' - ! ! ...Check if the file exists - ! IF ( .NOT. File_Exists(rts_File) ) THEN - ! Message = 'RTSolution save file does not exist. Creating...' - ! CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) - ! ! ...File not found, so write RTSolution structure to file - ! Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution, NetCDF=.TRUE., Quiet=.TRUE. ) - ! IF ( Error_Status /= SUCCESS ) THEN - ! Message = 'Error creating RTSolution save file' - ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - ! STOP 1 - ! END IF - ! END IF - - - ! 8b. Inquire the saved file - ! ! -------------------------- - ! Error_Status = CRTM_RTSolution_InquireFile( rts_File, & - ! NetCDF=.TRUE., & - ! n_Profiles = n_m, & - ! n_Layers = n_k, & - ! n_Channels = n_l, & - ! n_Stokes = n_s ) - ! IF ( Error_Status /= SUCCESS ) THEN - ! Message = 'Error inquiring RTSolution save file' - ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - ! STOP 1 - ! END IF - - ! 8c. Compare the dimensions - ! -------------------------- - ! IF ( n_l /= n_Channels .OR. n_m /= N_PROFILES .OR. n_k /= n_Layers .OR. n_s /= n_Stokes ) THEN - ! Message = 'Dimensions of saved data different from that calculated!' - ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - ! STOP 1 - ! END IF - - - ! 8d. Allocate the structure to read in saved data - ! ------------------------------------------------ - ! ALLOCATE( rts( n_l, n_m ), STAT=Allocate_Status ) - ! IF ( Allocate_Status /= 0 ) THEN - ! Message = 'Error allocating RTSolution saved data array' - ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - ! STOP 1 - ! END IF - ! CALL CRTM_RTSolution_Create( rts, n_k ) - ! IF ( ANY(.NOT. CRTM_RTSolution_Associated(rts)) ) THEN - ! Message = 'Error allocating CRTM RTSolution structures' - ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - ! STOP 1 - ! END IF - ! + ! 5. **** CALL THE CRTM FORWARD MODEL **** ! - ! ! 8e. Read the saved data - ! ! ----------------------- - ! Error_Status = CRTM_RTSolution_ReadFile( rts_File, rts, NetCDF=.TRUE., Quiet=.TRUE. ) - ! IF ( Error_Status /= SUCCESS ) THEN - ! Message = 'Error reading RTSolution save file' - ! CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - ! STOP 1 - ! END IF - - - ! 8f. Compare the structures - ! -------------------------- - IF ( ALL(CRTM_RTSolution_Compare(RTSolution, RTSolution_OP)) ) THEN - Message = 'RTSolution results are the same!' - CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) - ELSE - Message = 'RTSolution results are different!' + ! 5a. Default CRTM interface: cloud/aerosol scattering computed internally, + ! but with the stream count fixed at 16 via Options_Default so it can + ! be compared against the AOP/COP/TOP runs below. + ! ---------------------------------------------------------------------------- + Error_Status = CRTM_Forward( Atm , & + Sfc , & + Geometry , & + ChannelInfo , & + RTSolution , & + Options_Default ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Forward Model' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + PRINT *, 'FINISH CRTM Default Interface' + + ! 5b. User-defined aerosol-only optical profile (AOP) + ! Cloud scattering is still computed internally. + ! ---------------------------------------------------------------------------- + Error_Status = CRTM_Forward( Atm , & + Sfc , & + Geometry , & + ChannelInfo , & + RTSolution_AOP, & + Options_AOP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Forward Model with Options%AOP' CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - ! Write the current RTSolution results to file - rts_File = TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.RTSolution.nc' - Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution, NetCDF=.TRUE., Quiet=.TRUE. ) - IF ( Error_Status /= SUCCESS ) THEN - Message = 'Error creating temporary RTSolution save file for failed comparison' - CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) - END IF STOP 1 END IF + PRINT *, 'FINISH CRTM AOP Interface' + + ! 5c. User-defined cloud-only optical profile (COP) + ! Aerosol scattering is still computed internally. + ! ---------------------------------------------------------------------------- + Error_Status = CRTM_Forward( Atm , & + Sfc , & + Geometry , & + ChannelInfo , & + RTSolution_COP, & + Options_COP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Forward Model with Options%COP' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + PRINT *, 'FINISH CRTM COP Interface' + + ! 5d. User-defined combined total optical profile (TOP) + ! Neither cloud nor aerosol scattering is computed internally. + ! ---------------------------------------------------------------------------- + Error_Status = CRTM_Forward( Atm , & + Sfc , & + Geometry , & + ChannelInfo , & + RTSolution_TOP, & + Options_TOP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Forward Model with Options%TOP' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + PRINT *, 'FINISH CRTM TOP Interface' + ! ============================================================================ + + ! ============================================================================ + ! 6. **** COMPARE RTSolution RESULTS TO THE DEFAULT FORWARD CALCULATION **** + ! + WRITE( *, '( /5x, "Comparing AOP/COP/TOP results with the default forward calculation..." )' ) + CALL Compare_And_Report( RTSolution, RTSolution_AOP, 'AOP' ) + CALL Compare_And_Report( RTSolution, RTSolution_COP, 'COP' ) + CALL Compare_And_Report( RTSolution, RTSolution_TOP, 'TOP' ) ! ============================================================================ + ! ============================================================================ ! 7. **** DESTROY THE CRTM **** ! @@ -345,15 +368,15 @@ PROGRAM test_OP ! ============================================================================ ! ============================================================================ - ! 9. **** CLEAN UP **** + ! 8. **** CLEAN UP **** ! - ! 9a. Deallocate the structures + ! 8a. Deallocate the structures ! ----------------------------- CALL CRTM_Atmosphere_Destroy(Atm) - ! 9b. Deallocate the arrays + ! 8b. Deallocate the arrays ! ------------------------- - DEALLOCATE(RTSolution, RTSolution_OP, STAT=Allocate_Status) + DEALLOCATE(RTSolution, RTSolution_AOP, RTSolution_COP, RTSolution_TOP, STAT=Allocate_Status) ! ============================================================================ ! Signal the completion of the program. It is not a necessary step for running CRTM. @@ -363,4 +386,30 @@ PROGRAM test_OP INCLUDE 'Load_Atm_Data_SingleProfile.inc' INCLUDE 'Load_Sfc_Data_SingleProfile.inc' + ! Compare a test RTSolution array against the reference (default) one and + ! report the outcome. On mismatch, the test RTSolution is written to a + ! netCDF file (named after Label) for offline inspection. + SUBROUTINE Compare_And_Report( rts_Ref, rts_Test, Label ) + TYPE(CRTM_RTSolution_type), INTENT(IN) :: rts_Ref(:,:), rts_Test(:,:) + CHARACTER(*), INTENT(IN) :: Label + CHARACTER(256) :: local_Message + CHARACTER(256) :: local_File + + IF ( ALL(CRTM_RTSolution_Compare(rts_Ref, rts_Test)) ) THEN + local_Message = Label//': RTSolution results are the same as the default calculation!' + CALL Display_Message( PROGRAM_NAME, local_Message, INFORMATION ) + ELSE + local_Message = Label//': RTSolution results are different from the default calculation!' + CALL Display_Message( PROGRAM_NAME, local_Message, FAILURE ) + ! Write the mismatching RTSolution results to file + local_File = TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.'//Label//'.RTSolution.nc' + Error_Status = CRTM_RTSolution_WriteFile( local_File, rts_Test, NetCDF=.TRUE., Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + local_Message = 'Error creating temporary RTSolution save file for failed '//Label//' comparison' + CALL Display_Message( PROGRAM_NAME, local_Message, FAILURE ) + END IF + STOP 1 + END IF + END SUBROUTINE Compare_And_Report + END PROGRAM test_OP From 1c1374f1bb5813263b910b33a2d35b28aea64a5d Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Mon, 13 Jul 2026 18:44:34 -0600 Subject: [PATCH 06/10] Initial version with subchannel index --- src/CRTM_Forward_Module.f90 | 47 ++++--- src/Options/OP_Input/OP_Input_Define.f90 | 121 +++++++++++++++++- .../mains/unit/Unit_Test/AOP_SingleProfile.nc | Bin 96812 -> 96980 bytes .../mains/unit/Unit_Test/COP_SingleProfile.nc | Bin 96812 -> 96980 bytes test/mains/unit/Unit_Test/Generate_OP.f90 | 5 + .../mains/unit/Unit_Test/TOP_SingleProfile.nc | Bin 96812 -> 96980 bytes test/mains/unit/Unit_Test/test_OP.f90 | 3 + 7 files changed, 159 insertions(+), 17 deletions(-) diff --git a/src/CRTM_Forward_Module.f90 b/src/CRTM_Forward_Module.f90 index 8ec0aee4..3045d06c 100644 --- a/src/CRTM_Forward_Module.f90 +++ b/src/CRTM_Forward_Module.f90 @@ -102,7 +102,8 @@ MODULE CRTM_Forward_Module OP_Input_Create , & OP_Input_WriteFile , & OP_Input_ReadFile , & - OP_Input_Associated + OP_Input_Associated, & + OP_Input_Channel_Position ! Internal variable definition modules ! ...AtmOptics @@ -449,6 +450,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) INTEGER :: iFOV INTEGER :: n, l ! sensor index, channel index INTEGER :: ilay, iphas, ileg, ileg1 + INTEGER :: pos ! column position of ChannelIndex within opt%TOP/COP/AOP INTEGER :: SensorIndex INTEGER :: ChannelIndex INTEGER :: ln, nc, ks @@ -1001,17 +1003,26 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END IF ! Optical properties of clouds and aerosols - IF ( Options_Present .AND. opt%Use_Total_OP ) THEN + ! + ! pos maps ChannelIndex to the column of opt%TOP/COP/AOP holding this + ! channel's data. It is 0 (not found) whenever the corresponding + ! Use_*_OP flag is off, or when it's on but this particular channel + ! isn't covered by the supplied OP_Input (e.g. a single-channel + ! OP_Input in a multi-channel run) - either way, fall through to the + ! usual internal computation for this channel (see CRTMv3 issue #327). + pos = 0 + IF ( Options_Present .AND. opt%Use_Total_OP ) pos = OP_Input_Channel_Position( opt%TOP, ChannelIndex ) + IF ( pos >= 1 ) THEN AtmOptics(nt)%Include_Scattering = .TRUE. DO ilay = 1, Atm%n_Layers - AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%TOP%tau(ChannelIndex, ilay) - AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%TOP%bs(ChannelIndex, ilay) - AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%TOP%kb(ChannelIndex, ilay) + AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%TOP%tau(pos, ilay) + AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%TOP%bs(pos, ilay) + AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%TOP%kb(pos, ilay) DO iphas = 1, 1 DO ileg = 0, AtmOptics(nt)%n_Legendre_Terms ileg1 = ileg + 1 AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) = AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) + & - opt%TOP%pcoeff(ChannelIndex,ilay,iphas,ileg1) + opt%TOP%pcoeff(pos,ilay,iphas,ileg1) END DO END DO END DO @@ -1019,18 +1030,20 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) ELSE ! ...Clouds - IF ( Options_Present .AND. opt%Use_Cloud_OP ) THEN + pos = 0 + IF ( Options_Present .AND. opt%Use_Cloud_OP ) pos = OP_Input_Channel_Position( opt%COP, ChannelIndex ) + IF ( pos >= 1 ) THEN ! Use user-defined cloud optical profiles AtmOptics(nt)%Include_Scattering = .TRUE. DO ilay = 1, Atm%n_Layers - AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%COP%tau(ChannelIndex, ilay) - AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%COP%bs(ChannelIndex, ilay) - AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%COP%kb(ChannelIndex, ilay) + AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%COP%tau(pos, ilay) + AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%COP%bs(pos, ilay) + AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%COP%kb(pos, ilay) DO iphas = 1, 1 DO ileg = 0, AtmOptics(nt)%n_Legendre_Terms ileg1 = ileg + 1 AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) = AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) + & - opt%COP%pcoeff(ChannelIndex,ilay,iphas,ileg1) + opt%COP%pcoeff(pos,ilay,iphas,ileg1) END DO END DO END DO @@ -1051,18 +1064,20 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END IF ! ...Aerosols - IF ( Options_Present .AND. opt%Use_Aerosol_OP ) THEN + pos = 0 + IF ( Options_Present .AND. opt%Use_Aerosol_OP ) pos = OP_Input_Channel_Position( opt%AOP, ChannelIndex ) + IF ( pos >= 1 ) THEN ! Use user-defined aerosol optical profiles AtmOptics(nt)%Include_Scattering = .TRUE. DO ilay = 1, Atm%n_Layers - AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%AOP%tau(ChannelIndex, ilay) - AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%AOP%bs(ChannelIndex, ilay) - AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%AOP%kb(ChannelIndex, ilay) + AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%AOP%tau(pos, ilay) + AtmOptics(nt)%Single_Scatter_Albedo(ilay) = AtmOptics(nt)%Single_Scatter_Albedo(ilay) + opt%AOP%bs(pos, ilay) + AtmOptics(nt)%Backscat_Coefficient(ilay) = AtmOptics(nt)%Backscat_Coefficient(ilay) + opt%AOP%kb(pos, ilay) DO iphas = 1, 1 DO ileg = 0, AtmOptics(nt)%n_Legendre_Terms ileg1 = ileg + 1 AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) = AtmOptics(nt)%Phase_Coefficient(ileg,iphas,ilay) + & - opt%AOP%pcoeff(ChannelIndex,ilay,iphas,ileg1) + opt%AOP%pcoeff(pos,ilay,iphas,ileg1) END DO END DO END DO diff --git a/src/Options/OP_Input/OP_Input_Define.f90 b/src/Options/OP_Input/OP_Input_Define.f90 index be03cd80..206d3c5a 100644 --- a/src/Options/OP_Input/OP_Input_Define.f90 +++ b/src/Options/OP_Input/OP_Input_Define.f90 @@ -40,6 +40,7 @@ MODULE OP_Input_Define PUBLIC :: OP_Input_InquireFile PUBLIC :: OP_Input_ReadFile PUBLIC :: OP_Input_WriteFile + PUBLIC :: OP_Input_Channel_Position ! ------------------- ! Procedure overloads @@ -52,7 +53,10 @@ MODULE OP_Input_Define ! Module parameters ! ----------------- ! Release and version - INTEGER, PARAMETER :: OP_INPUT_RELEASE = 1 ! This determines structure and file formats. + INTEGER, PARAMETER :: OP_INPUT_RELEASE = 2 ! This determines structure and file formats. + ! ...Release 2 added Channel_Index, mapping each column of tau/bs/kb/pcoeff to the + ! SpcCoeff ChannelIndex it was computed for, so a caller can supply optical profile + ! data for a subset of a sensor's channels (see CRTMv3 issue #327). ! Close status for write errors CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' ! Literal constants @@ -75,6 +79,7 @@ MODULE OP_Input_Define CHARACTER(*), PARAMETER :: BS_VARNAME = 'bs' CHARACTER(*), PARAMETER :: PCOEFF_VARNAME = 'pcoeff' CHARACTER(*), PARAMETER :: KB_VARNAME = 'kb' + CHARACTER(*), PARAMETER :: CHANNEL_INDEX_VARNAME = 'channel_index' ! Variable description attribute. CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' @@ -82,6 +87,8 @@ MODULE OP_Input_Define CHARACTER(*), PARAMETER :: BS_DESCRIPTION = 'Layer volume scattering coefficient' CHARACTER(*), PARAMETER :: PCOEFF_DESCRIPTION = 'Layer phase function coefficients for scatters' CHARACTER(*), PARAMETER :: KB_DESCRIPTION = 'Layer backward scattering coefficient' + CHARACTER(*), PARAMETER :: CHANNEL_INDEX_DESCRIPTION = & + 'SpcCoeff ChannelIndex that each tau/bs/kb/pcoeff column was computed for' ! Variable units attribute. @@ -97,6 +104,7 @@ MODULE OP_Input_Define ! Variable types INTEGER, PARAMETER :: FLOAT_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: INT_TYPE = NF90_INT !-------------------- ! Structure defintion @@ -125,6 +133,12 @@ MODULE OP_Input_Define REAL(fp), ALLOCATABLE :: kb(:,:) ! K * L REAL(fp), ALLOCATABLE :: pcoeff(:,:,:,:) ! K * L * Il * Ip + ! SpcCoeff ChannelIndex each column of tau/bs/kb/pcoeff was computed for. + ! Lets a caller supply optical profile data for a subset of a sensor's + ! channels; use OP_Input_Channel_Position to map a ChannelIndex to the + ! corresponding column position. 0 in this array means "unset". + INTEGER, ALLOCATABLE :: Channel_Index(:) ! K + END TYPE OP_Input_type !:tdoc-: @@ -423,6 +437,19 @@ FUNCTION OP_Input_WriteFile( & ' - '//TRIM(NF90_STRERROR( NF90_Status )) CALL Write_Cleanup(); RETURN END IF + ! ...channel_index variable + NF90_Status = NF90_INQ_VARID( FileId,CHANNEL_INDEX_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//CHANNEL_INDEX_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,OP%Channel_Index ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//CHANNEL_INDEX_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF ! Close the file NF90_Status = NF90_CLOSE( FileId ) @@ -536,6 +563,7 @@ FUNCTION OP_Input_ReadFile( & INTEGER :: Release LOGICAL :: noisy REAL(fp), ALLOCATABLE :: tau(:,:), bs(:,:), kb(:,:),pcoeff(:,:,:,:) + INTEGER, ALLOCATABLE :: channel_index(:) ! Set up @@ -571,6 +599,7 @@ FUNCTION OP_Input_ReadFile( & n_Layers , & n_Phase_Elements , & n_Legendre_Terms ), & + channel_index( n_Channels ), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN @@ -639,6 +668,19 @@ FUNCTION OP_Input_ReadFile( & ' - '//TRIM(NF90_STRERROR( NF90_Status )) CALL Read_Cleanup(); RETURN END IF + ! ...channel_index variable + NF90_Status = NF90_INQ_VARID( FileId,CHANNEL_INDEX_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//CHANNEL_INDEX_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarID,channel_index ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//CHANNEL_INDEX_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF ! Assign variables ALLOCATE(OP) @@ -650,6 +692,7 @@ FUNCTION OP_Input_ReadFile( & OP%bs = bs OP%kb = kb OP%pcoeff = pcoeff + OP%Channel_Index = channel_index ! Close the file NF90_Status = NF90_CLOSE( FileId ); Close_File = .FALSE. @@ -977,6 +1020,7 @@ ELEMENTAL SUBROUTINE OP_Input_Create( & n_Layers , & n_Phase_Elements , & n_Legendre_Terms ), & + OP%Channel_Index( n_Channels ) , & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN @@ -992,12 +1036,71 @@ ELEMENTAL SUBROUTINE OP_Input_Create( & OP%bs = ZERO OP%kb = ZERO OP%pcoeff = ZERO + OP%Channel_Index = 0 ! Set allocationindicator OP%Is_Allocated = .TRUE. END SUBROUTINE OP_Input_Create +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! OP_Input_Channel_Position +! +! PURPOSE: +! Function to map a SpcCoeff ChannelIndex to the column position within +! an OP_Input object's tau/bs/kb/pcoeff arrays that holds the data for +! that channel. Allows an OP_Input object to cover only a subset of a +! sensor's channels (e.g. a single-channel optical profile) rather than +! requiring one column per channel in ChannelIndex order. +! +! CALLING SEQUENCE: +! pos = OP_Input_Channel_Position( OP, ChannelIndex ) +! +! OBJECTS: +! OP: OP_Input object whose Channel_Index array is searched. +! UNITS: N/A +! TYPE: OP_Input_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! INPUTS: +! ChannelIndex: The SpcCoeff channel index to look up. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! FUNCTION RESULT: +! pos: 1-based column position of ChannelIndex within OP's +! tau/bs/kb/pcoeff arrays, or 0 if ChannelIndex is not +! covered by this OP_Input object. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + FUNCTION OP_Input_Channel_Position( OP, ChannelIndex ) RESULT( pos ) + TYPE(OP_Input_type), INTENT(IN) :: OP + INTEGER, INTENT(IN) :: ChannelIndex + INTEGER :: pos + INTEGER :: i + + pos = 0 + IF ( .NOT. OP_Input_Associated(OP) ) RETURN + DO i = 1, OP%n_Channels + IF ( OP%Channel_Index(i) == ChannelIndex ) THEN + pos = i + RETURN + END IF + END DO + + END FUNCTION OP_Input_Channel_Position + !################################################################################ !################################################################################ !## ## @@ -1161,6 +1264,22 @@ FUNCTION CreateFile( & msg = 'Error writing '//PCOEFF_VARNAME//' variable attributes to '//TRIM(Filename) CALL Create_Cleanup(); RETURN END IF + ! ...channel_index variable + NF90_Status = NF90_DEF_VAR( FileID, & + CHANNEL_INDEX_VARNAME, & + INT_TYPE, & + dimIDs=(/n_Channels_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//CHANNEL_INDEX_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME ,CHANNEL_INDEX_DESCRIPTION) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//CHANNEL_INDEX_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF ! Take netCDF file out of define mode NF90_Status = NF90_ENDDEF( FileId ) diff --git a/test/mains/unit/Unit_Test/AOP_SingleProfile.nc b/test/mains/unit/Unit_Test/AOP_SingleProfile.nc index ffc0e74e641c2ba64408021e13a5d4edb5c1bf92..e8c7d595bafadc8ddc04cdce0bdd9b770ab03920 100644 GIT binary patch delta 218 zcmZ4Uh4so;)(Op=ObiSR+(67av8S7H&twV4SsY?DKt5A;(quVC-O0}x`%*#v7iOCtqL`5A_HxNOsOoO-oa7hA8(0sa7b- zNGwrEO-#;EC`l~UPb${WPSP((2CGZX&neB#Qz%a?R!GjzEhsHXO;Je8F9Mp#0>lyw lj8%I!CyGAcZRQc&&LhaEkSPJO42VJQX9i-BGFBjF0|5LTH)j9< delta 67 zcmccem37S*)(Op=j0_A6+(67Sv8S6+XR-w2EDq5(Kt5A;(quVC-O0}x`Os-(s W%$T$Jqv!+P<~f4f=Lj+?WC8%O3l&2E diff --git a/test/mains/unit/Unit_Test/COP_SingleProfile.nc b/test/mains/unit/Unit_Test/COP_SingleProfile.nc index 5a102e9cc3f7971eb97fce98484583068454239a..1cf234a791ed64e3629402791df9b1cc1daf8b6b 100644 GIT binary patch delta 218 zcmZ4Uh4so;)(Op=ObiSR+(67av8S7H&twV4SsY?DKt5A;(quVC-O0}x`%*#v7iOCtqL`5A_HxNOsOoO-oa7hA8(0sa7b- zNGwrEO-#;EC`l~UPb${WPSP((2CGZX&neB#Qz%a?R!GjzEhsHXO;Je8F9Mp#0>lyw lj8%I!Zxo)u)4Yd&`yPJAf-DJ;Wk3vaKQj=6l(7Oa8vrlAIS~K= delta 67 zcmccem37S*)(Op=j0_A6+(67Sv8S6+XR-w2EDq5(Kt5A;(quVC-O0}x`Os-(s V%$T#;QDg#7vyZ@b9|6XKEC8V!6Yu~4 diff --git a/test/mains/unit/Unit_Test/Generate_OP.f90 b/test/mains/unit/Unit_Test/Generate_OP.f90 index c28a5902..a14f8446 100644 --- a/test/mains/unit/Unit_Test/Generate_OP.f90 +++ b/test/mains/unit/Unit_Test/Generate_OP.f90 @@ -356,6 +356,11 @@ SUBROUTINE Pack_AtmOptics( AO, ChannelIndex, OP ) TYPE(OP_Input_type), INTENT(INOUT) :: OP INTEGER :: ilay, iphas, ileg, ileg1 + ! Record which SpcCoeff ChannelIndex this column corresponds to, so + ! CRTM_Forward_Module's OP_Input_Channel_Position lookup can find it + ! (see CRTMv3 issue #327). + OP%Channel_Index(ChannelIndex) = ChannelIndex + DO ilay = 1, AO%n_Layers OP%tau(ChannelIndex,ilay) = AO%Optical_Depth(ilay) OP%bs(ChannelIndex,ilay) = AO%Single_Scatter_Albedo(ilay) diff --git a/test/mains/unit/Unit_Test/TOP_SingleProfile.nc b/test/mains/unit/Unit_Test/TOP_SingleProfile.nc index 827db503c4e313d8ef658e298a34093341fc380b..7d9ccaa9351663585542d6e47f7e398246dbe8e8 100644 GIT binary patch delta 218 zcmZ4Uh4so;)(Op=ObiSR+(67av8S7H&twV4SsY?DKt5A;(quVC-O0}x`%*#v7iOCtqL`5A_HxNOsOoO-oa7hA8(0sa7b- zNGwrEO-#;EC`l~UPb${WPSP((2CGZX&neB#Qz%a?R!GjzEhsHXO;Je8F9Mp#0>lyw lj8%I!CyGwsY2L%XeGfllL6!u_G9U)IpBacj%2Os-(s V%$T$Jqv!;lW*>p=J_3vdSpcdR6rlhB diff --git a/test/mains/unit/Unit_Test/test_OP.f90 b/test/mains/unit/Unit_Test/test_OP.f90 index 964f7104..94a22810 100644 --- a/test/mains/unit/Unit_Test/test_OP.f90 +++ b/test/mains/unit/Unit_Test/test_OP.f90 @@ -218,6 +218,7 @@ PROGRAM test_OP Options_AOP(1)%AOP%n_Layers = OP_AOP%n_Layers Options_AOP(1)%AOP%n_Phase_Elements = OP_AOP%n_Phase_Elements Options_AOP(1)%AOP%n_Legendre_Terms = OP_AOP%n_Legendre_Terms + Options_AOP(1)%AOP%Channel_Index = OP_AOP%Channel_Index Options_AOP(1)%AOP%tau = OP_AOP%tau Options_AOP(1)%AOP%bs = OP_AOP%bs Options_AOP(1)%AOP%kb = OP_AOP%kb @@ -242,6 +243,7 @@ PROGRAM test_OP Options_COP(1)%COP%n_Layers = OP_COP%n_Layers Options_COP(1)%COP%n_Phase_Elements = OP_COP%n_Phase_Elements Options_COP(1)%COP%n_Legendre_Terms = OP_COP%n_Legendre_Terms + Options_COP(1)%COP%Channel_Index = OP_COP%Channel_Index Options_COP(1)%COP%tau = OP_COP%tau Options_COP(1)%COP%bs = OP_COP%bs Options_COP(1)%COP%kb = OP_COP%kb @@ -264,6 +266,7 @@ PROGRAM test_OP Options_TOP(1)%TOP%n_Layers = OP_TOP%n_Layers Options_TOP(1)%TOP%n_Phase_Elements = OP_TOP%n_Phase_Elements Options_TOP(1)%TOP%n_Legendre_Terms = OP_TOP%n_Legendre_Terms + Options_TOP(1)%TOP%Channel_Index = OP_TOP%Channel_Index Options_TOP(1)%TOP%tau = OP_TOP%tau Options_TOP(1)%TOP%bs = OP_TOP%bs Options_TOP(1)%TOP%kb = OP_TOP%kb From 5a4bb1cc5ec68a37c9ae51bcd535f4f845efa788 Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Mon, 13 Jul 2026 18:58:53 -0600 Subject: [PATCH 07/10] Add unit test for OP_Subset --- test/CMakeLists.txt | 19 +- test/mains/unit/Unit_Test/AOP_Subset.nc | Bin 0 -> 32964 bytes test/mains/unit/Unit_Test/COP_Subset.nc | Bin 0 -> 32964 bytes .../unit/Unit_Test/Generate_OP_Subset.f90 | 401 +++++++++++++++ test/mains/unit/Unit_Test/TOP_Subset.nc | Bin 0 -> 32964 bytes test/mains/unit/Unit_Test/test_OP_Subset.f90 | 458 ++++++++++++++++++ 6 files changed, 875 insertions(+), 3 deletions(-) create mode 100644 test/mains/unit/Unit_Test/AOP_Subset.nc create mode 100644 test/mains/unit/Unit_Test/COP_Subset.nc create mode 100644 test/mains/unit/Unit_Test/Generate_OP_Subset.f90 create mode 100644 test/mains/unit/Unit_Test/TOP_Subset.nc create mode 100644 test/mains/unit/Unit_Test/test_OP_Subset.f90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 7b49bfb5..1d560dde 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -341,14 +341,24 @@ set_tests_properties(test_Unit_Aerosol_Bypass_k_matrix PROPERTIES ENVIRONMENT " add_executable(Unit_OP_TEST mains/unit/Unit_Test/test_OP.f90) target_link_libraries(Unit_OP_TEST PRIVATE crtm) -add_test(NAME test_Unit_OP_TEST +add_test(NAME test_Unit_OP COMMAND $) -set_tests_properties(test_Unit_OP_TEST PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") +set_tests_properties(test_Unit_OP PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") # Utility to (re)generate the AOP/COP/TOP_SingleProfile.nc files used by Unit_OP_TEST add_executable(Generate_OP mains/unit/Unit_Test/Generate_OP.f90) target_link_libraries(Generate_OP PRIVATE crtm) +add_executable(Unit_OP_Subset_TEST mains/unit/Unit_Test/test_OP_Subset.f90) +target_link_libraries(Unit_OP_Subset_TEST PRIVATE crtm) +add_test(NAME test_Unit_OP_Subset + COMMAND $) +set_tests_properties(test_Unit_OP_Subset PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") + +# Utility to (re)generate the AOP/COP/TOP_Subset.nc files used by Unit_OP_Subset_TEST +add_executable(Generate_OP_Subset mains/unit/Unit_Test/Generate_OP_Subset.f90) +target_link_libraries(Generate_OP_Subset PRIVATE crtm) + #SpcCoeff utilities list (APPEND SCoeff_Utils SpcCoeff_Edit @@ -701,7 +711,10 @@ CREATE_SYMLINK_FILENAME( ${CRTM_TEST_ROOT}/mains/unit/Unit_Test ${CMAKE_CURRENT_BINARY_DIR}/testinput AOP_SingleProfile.nc COP_SingleProfile.nc - TOP_SingleProfile.nc ) + TOP_SingleProfile.nc + AOP_Subset.nc + COP_Subset.nc + TOP_Subset.nc ) # Symlink all CRTM files # Version 3 diff --git a/test/mains/unit/Unit_Test/AOP_Subset.nc b/test/mains/unit/Unit_Test/AOP_Subset.nc new file mode 100644 index 0000000000000000000000000000000000000000..0e172da610f428dbe731f2af6ab50b6de0ba63cf GIT binary patch literal 32964 zcmeI5c{Ei2|M){m$`*yRplFeVMB+XPl~PHvr0gSO&k{-5DQhCTkYtO55E}cQJ=u50 z&X^fXLf_GQKIiv6=l46m^EsdIKi^Yx&w07`zV6&R&*$Sluj?`H+$$%4k!s6713hW9 zmDK1hbmWZnEG$rFHoq58lYY`!=qTwuLRoM27?K*Zg^seZo()Pz!3<@NvasFk-`ozV zUkP;|WnpNI(oscOn{W2BklHTt^6e@pGZbk(((Lc|+FWOI`#VW(8>!LQ>e-P-zx)0b z*XFu3q_)!#Wn*BCwz5TATKwxZtiPk;wj^~L=$UaFqO5FD zX3LhnPNdiv4E{MXbkG)tCh$t0D+9UBGTa=w z42-!+buXlEBV?*C^bZwME~GND;I`MZAx)ZF+1ZlFlTspWfAbin+p@)FvqmWcg#d*B zg~0zx0!Zg1P3Nrrex$vi>&R(!9puLjKgIje8wgewDf2(63l|1tb2r{A!)Z3cu_=B{ za6uX(5iMSLa1FV|nz<9wUM4dsKD-9;EnU?Xfu2y)$P;C`OoZ~|xH3HjLFn158mXSv z2c74VpL9?w!)U};f$u{rFsj~^R+p>}6ScAX&<*A=iTNDDnnMSZ(<*q4!XlWy*K;TJ zBQ;FYYD)xtWPqs$=e~YS^M>)efwI9oEHDwhO?@Ls9VryRg3b3*#lWzDqL+^%@c#(th%F$L+*B$jU9cIl^&AWK1IBzW2Tta3Sigq4%pi5b{7@ zRu6avE=SLgar$t<0||eAqcs6YGf;ZHEhhuwKP9iE$5KO0OvsUnoC8q4(`Gf@I1{=X z7k3GL8ir2#zBe@sjWDWYa+`Qy7mOZ0rBH=lf{9DCE<<9$FlivYZhz$fOp3>9+$-{j zslH5lnT}bQ5Mh4Ca-I_=JMVO#u9N`mZ6qi(9=ynuZ>)b?2J z0gOG*4P(F20@!(PM{et{FwVqZoW?azI^XOVVPuSfiOK|-mAxpKdWiCvcsB);+avDi z_`QZHhxQiEb$J*oQ@Wa?GzwViJ*ovkD$vs(*Ee&19lFk%oULn_gbEH{W%`CNz;J4M zM^n>5Xy)8tiC{YTg#O5hQ!j<9h$;4mX9-A{>iFdu*CPvEx89z%_<~H-&9UFw>u4^|L7w7M>p9&+R6U$o$Md=WdEoo`$rDh zKQhSv;YIcjN3wsMC;P`SvVRPb{iBoOAAih2LrH`}fI{Fm0i6r~MEs538^PPrNwURd` ze31}`%o5ceXF*MY6C(>J8p^Wn2u-G?Ly!4#^--e)=)6wLLLKr5#WaDk!kI%bCC>dOju#En%gk->=uj|0{Gk!2O!~ZO@Y%;|nM@dG z&>#%?*T6(4XXibQNf;}(E)&L*TOqc+c5vE=E=(Vf_02>vmc(cL{uyJZK(mU3m z*Eh_GUMC;AJg!ll_lbjw-BsQ>7VPll(y_7vIxPrUyy8m8R{?LT)21=~WgyQgKv-^n z213$Kn&GFeBV%8}pK04>Azcj}*hAu**N;#J3IPfM3V}a@0Mf}BI2DZokQNi2e3iR5L41#7I3v6O?g#S1+WYh2ah|sc`}t#lPIjkz`Q;M4f6i7D z;O+-;NsR)PDpt^N_LLoudI?l4x4jGg77s&cUuWs(xzLB!-Zfx(4`$>rmbSyxFcqrS zw8+m53$FzqJ(tOXh0>SIiv~G>w>KK=l2`$P#V4jyAmI<5)g)>yaRKh= z@rS-w+hD<+EmEC18Rm4Cv**6s0nWuwMsP|9=ITGOK8?u%T>j$w9UNJJi)XLnt&fL= zUzaLco@@g=>tRuRC;|kf0d+2WQNSw|RG$)i1o)n~0l5H0n5(evdfK`dW<%tt)MGxu zu&AmsznB0F(2fZPZaoXtcT#U`?5uzieh0ko6(YQP{m_%PC=tAD3=*4TLg0e%Wy_OE zTRi}WmB+248i$sbWPlq4twCC^Z;<2zU{8|H{~#fPa~2XUZD@a}s;L-rtUencX|5 zx0Uz8;8Y6D*r81537)qp6VHZnTnW?huYyo;XwEVDXFj|*q+LL}-2|T2RzKM?xd>+# zc%{^Ir-93Jz>z=d7SbD=zdxi;7HRfQm>7F>pHg%b0u%xi0)GktVq3_Yo>_MtTXSeZMG$|%F3Nw<{+>3B5KT<|0Xsk4eiwP3{ml)9nhK_NgPKp{Z-KZo+%NP;RvqdSk(l~%N@q~7Vm-u!V|*n;5{&3$L6&g%K>>(=W{6EIn~Yw0S< zv--9aGHZp}!Z+7i)eD6+P{4aferPEJ(nH->N04ZEYQB%zbBF_sD^bf$TdROmMwm1D zU@fxRr+p#bHyUXJra6PBkC4i1f?I`8eZ@316vfg{{ z=FNkrUn-jqsPaIOx8UvM0!R3;dvK3}hC6ieUSDPNXo2P%G&W~`dcyQMzIA)5YcLwO zeVbDfKM-nAxoX8cuwY`)g`RDP#RiGaB4-I$j0rv0F?S4zUm|y^-$KI@2X6=??P&tV{zoC(V`QGx{*Py0D@8X&x4H1?wU0Si^>HYa3)NM3Uy>}v83AlOFs`&SOa z;-yg&`_>v*G*zKdm3aV5Qtl3c5!0|JDs%bn-Mv8g`q}+(nhVTprgO(jn!&_Zs}$P= z0qCAo%Qt-u(2`V=PU~$6Ilm-yT70D-@z-5ls#rg;O?sOCG3X%ZT)A*qFwO;bDU^2T z;uMkT(oa9Mi1kRzLd;gJQ_V;@|I(Mc^Z(ot;ZG?ZN*)vf6as%W0i@|Fjm!G>ZluDv z{4$#64U*>UFtt5y4SC_qm8CT-h_s&-R$Kisk9o1DEc(O#WwsL?9@T8DZo1sE+~oK0X%iU znBX!O5Jt>!+ggtSVdLY;t)qfKY&$Z;eA*ZYSc0}rE;HZ_CAs7p(J;$!ddTI8Ct&46 z5=?5hK}UGv+uq2X&~RdXI^v8HWU3$4oh%K3*dkUFG_@F*GH{t4kwSyYD7%h`fE}`) zlB)3KYZlV&Gq9{Ny@oWcGL5p-w<0AkM@5vxYyRqDqa;ruKq2r)5kMN8&!u9@gOReR z*2X9a6q3~V@^(_KGvXKj3Rj}cg~=JIr{Q1BzscQKO(4Kh-8-Ahkwf!A|i0!|$R zZf^vr_yiAw>BfnD8(oQz)o-#To^1!j&-#3zJ<ECP8^%2G^S1r8J z88G;2Tdqea07_0Hs=HT ztV!2t(exJ>ZwG>5n{I3RBH#iTQ3slp0k3%#CRjuO*CaM>y>12gkPV}s9{zyWdU=I& zBN_K zB_avf$AjO(@Q8PxS(W3?EX+4uy}X|LbC^=!`^e6!Avm++=T!6R7GRrqOZiUc1CD0w z!45hBpsy7E-nBRo(#IGFUfb0`WbE3vzVTRS?q&yul^swPCv16L3kzdAvaYXwCqi!_ zn~1_37I0Vn`}(*VV0zz+S!59ncvMl5kgO3bWdB-UtgwZJl%*RQdu#yzDDkZk-eow#)os)iPf+1}$N$u_>7FhTc(=*m}9_Byz9`Hn|!o;^rSeT^rx->gMZGwXTm;UJ12ME z^;05f4JpO$7utXn#;&@T2W{b1w5!mil?rGu5j!oS=?TT}YdJVH{9(Ao*p26>GIYt( z>$Y|Cz^o@#e0drgCaw-XkbQB0Z7rXNO9rAt|7qG0AyFLL8hFHAXl8|)nxh3Ujk>GM)UFmv1@i;n3G zOgcDnB<@CFY8_p75oTe0G|QF4NdqQ7Ebb6dz77-Tb3~8%>%!!kBp++u1(=d{zP`Y;+<+U|jRPtr!0=3?Gx?Zt&!Uu2ZUa zQ>(3@X4IqDMQ;NN4yaI1RvSQghPPzVX&-P`y1+S;SW|w2_*WMjC3y+~3V}b00D@6_G=H~X1o`+i zfJaZg2MImnT-rZ=4S6&w_*UQjHKw(_UXp8L8z#TI%u-$95^x>P*gx2O23Z+1K7L5| z1E6^ECYm{6a7DjEXJ#}Tq8Zep;swuvSGhIu_>pla?R~Du^7Sxeoewg>TSh_Wjnv_-#} zoAWe`jm{C$xRgovcRxKEK6MhX68m2f?y160l?)k84;inJ_829WoeFRtr|75-7hLrI20fI{G}CV*tKRCIfc<{^pl z!OPU@fcU--wz)mYhFCQ6WxP`_!_;X#%6#kFiTR+?_ke@=3uu$mlWox3k&!Q3OC4u+ zfy#!i)5QWJoE66!{XQa?rIXJ0_C3BTMCzh3AGquujP1r5D9S7l6GVxTXW z#-Sr92KrgEPo5Zh32XG^D=(BPB08;^hoo!;fL1=+CP1u7Ln0JP$`08*W zDMMOq!BS|%Hru~uehV7O7G8O+b58_`Kg>PmP`~X?p|GbCwJoCA)TeKq)mk zspyRhau?tX@* z8eWKq)r4mIcy;T>UT7u+c~r(tK(n*49GjpCG-b&@n5lJxy1L*5Cml`4%j!3K134vXsh_By33+VXl;~Bw=!C{&DUPpEY*qUPBx60Ol zy!A26KjJ2d*u60D4z1)s5>v#9A>E5eu>U}TY#zfORXmhrC^CJf{w#8}2h6^mYu9;t$M4+b3WW8iu8*^z|{$_Zg97flf?U^o^TBNmH0lQQ4@Z zI6^UZRZEuaf%)Q{-I}he(N(})H}qb;C!$z9U|HBb`8&8|#$6Q5ngMkimHQV5S0Ld; z<8ya;Aqe6yo<6%|5800c^gJ0RAmzn186M;ke6|@Msh7n=PG{anIW`t3$Q4jxY%qj; z_v)8thJ)a9N;R*qj4tHYxnEu^NQHdwy?PUGf*}9!`{#&^390|}(J{_4$iL}(-QE5J z={{Afvf~>GkUy~@75beS3L;#bbIJko9LCrNyBZ<48EH0d8-mP6C3AThF-V>u1|++X z&KD{z7ti`ufcv!oukEDgVQEjvbiQB=E9SGCt?qRVEf%HPVx)~7ET-NP>ZlQ@hZ$`K zv3jfx<_Y^sr}Oc97-e320R)jpyhWLp7}d@qmPTqph8vQ9b+J*Brx2hJ_@fA5oaJ96 zYqcE2JYW;a-k(^DQM-R^d8_?SjKphu%^=cwCBmnkaGE6#dHm>|W=5eUCWlA#axx|l z<5qR_UVukv@$Q}DG>o@Un3+~Jg#qEG#j5BwBK9ChvBaC+=3n;a#jZ_dkzT2h#pc8E zAKW@yizDpD8M02!6u&t3orOP^w>YfgV3m`+b8(ykBi3o&0s=J@ZR~W3#nA<}xSLfT z@IjX;M!;mP*kG6b6@?}p$nBXkKcJZpVb72F+Sb6>VF55bydB-nY>h=sGCw4;0Y)%>DY&)hjzH|{|>gn21A+`NK LD4xyd#nb#39NL3c literal 0 HcmV?d00001 diff --git a/test/mains/unit/Unit_Test/COP_Subset.nc b/test/mains/unit/Unit_Test/COP_Subset.nc new file mode 100644 index 0000000000000000000000000000000000000000..e1005d7102b01ac3dafb232f590a8024e27e8273 GIT binary patch literal 32964 zcmeI*L1-Lh6bJBalcsT-V%pH6LhKL;8mb9K>bADx!)VcMtF7Bc3N_2@?6=v;&dyF| zW|ImnD1x-+prRJ6)GG8)C8W|?DVoBTG^teW!Gnij>7lf}=)shN#vFX#Y=Q+v7CuIX z@*nsz^S+sR`{wt)VPP-nd1mvXSapl@uAWESPWR+>+ZL7=oLJ0%8}0N~{Z--0nJkZH zJH0)xdm{a;C5poK<-E+p^IJu~u(Pg6?-XuP&adFnG=F~SOTrR-ABVwb$$Mn}WjvPf zsPpwQ?}E97y5zleJeFmJXSk;0nhm~q4Qjcv zZOBD&JG7_eO76mAR{N;nK0vY9>U~_>a-;fYq)j_3_VNU8x7RC=|81Qd)`oSD4~tIOXL)`k&M)85##rn%xkj-; z00I!GNr1*G$+6i#D|F)KhN;vmuOn9Ts0kexK>z{}xB~>__eH#SL zJnn!cfk%J<1Rwwb2tWV=5P$##AOHafKmY=f5}=Rgf3G~1IDLL( zpck>4N2HpIVjutk2!tp=Q-^-u)7Cmm7ru06Z!~rzR`Uq4RY(m12tXiG0yH`O?Nfu@ zDVnMbjSfEXK4LYGNHrJ5KmY;|2vLA0eoel0z*$S@51DP7emIL*%_GECAvFXb0D(ve zP-Sl2%@r$CbZ)rqlY3kG5UY7as<|iz0uX>ehywKW$zAJzrz`Z$zM(zwGv6Ur^9Zq3 zNDTo9Kp;{Abn3p`)yfwWbn4Q^9dnm2B3AQ=RC7@b1Rwx`5C!P?nxw_W7Bf zC&wQ{tmYA7tB@K35P(3W1n8rq#cBQN7CN%3ZOc9H^&(dDh*Wb?3Bhgi)cQq4s%5P$## kLKL9n_?BbeC*GkK5 0 ) THEN + CALL CSvar_Create( CSvar, n_Full_Streams, n_Phase_Elements, Atm_x(1)%n_Layers, Atm_x(1)%n_Clouds ) + Error_Status = CRTM_Compute_CloudScatter( Atm_x(1) , & ! Input + GeometryInfo(1), & ! Input + SensorIndex , & ! Input + ChannelIndex , & ! Input + AtmOptics_Cloud, & ! Output + CSvar ) ! Internal variable output + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error computing CloudScatter for channel ",i0)' ) ChannelIndex + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + CALL CSvar_Destroy( CSvar ) + END IF + + ! 1. Aerosol optical properties (AOP) + ! ------------------------------------ + CALL CRTM_AtmOptics_Create( AtmOptics_Aerosol, Atm_x(1)%n_Layers, n_Full_Streams, n_Phase_Elements ) + CALL CRTM_AtmOptics_Zero( AtmOptics_Aerosol ) + AtmOptics_Aerosol%Include_Scattering = .TRUE. + IF ( Atm_x(1)%n_Aerosols > 0 ) THEN + CALL ASvar_Create( ASvar, n_Full_Streams, n_Phase_Elements, Atm_x(1)%n_Layers, Atm_x(1)%n_Aerosols ) + Error_Status = CRTM_Compute_AerosolScatter( Atm_x(1) , & ! Input + SensorIndex , & ! Input + ChannelIndex , & ! Input + AtmOptics_Aerosol, & ! Output + ASvar ) ! Internal variable output + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error computing AerosolScatter for channel ",i0)' ) ChannelIndex + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + CALL ASvar_Destroy( ASvar ) + END IF + + ! 3. Combine AOP + COP into TOP + ! ------------------------------ + CALL CRTM_AtmOptics_Create( AtmOptics_Total, Atm_x(1)%n_Layers, n_Full_Streams, n_Phase_Elements ) + CALL CRTM_AtmOptics_Zero( AtmOptics_Total ) + AtmOptics_Total%Include_Scattering = .TRUE. + AtmOptics_Total%Optical_Depth = AtmOptics_Cloud%Optical_Depth + AtmOptics_Aerosol%Optical_Depth + AtmOptics_Total%Single_Scatter_Albedo = AtmOptics_Cloud%Single_Scatter_Albedo + AtmOptics_Aerosol%Single_Scatter_Albedo + AtmOptics_Total%Backscat_Coefficient = AtmOptics_Cloud%Backscat_Coefficient + AtmOptics_Aerosol%Backscat_Coefficient + AtmOptics_Total%Phase_Coefficient = AtmOptics_Cloud%Phase_Coefficient + AtmOptics_Aerosol%Phase_Coefficient + + ! Pack this channel's optics into the three OP_Input objects, at + ! storage position l (NOT ChannelIndex - AOP/COP/TOP only have + ! N_CHANNEL_SUBSET columns). + CALL Pack_AtmOptics( AtmOptics_Cloud, l, ChannelIndex, COP ) + CALL Pack_AtmOptics( AtmOptics_Aerosol, l, ChannelIndex, AOP ) + CALL Pack_AtmOptics( AtmOptics_Total, l, ChannelIndex, TOP ) + + CALL CRTM_AtmOptics_Destroy( AtmOptics_Cloud ) + CALL CRTM_AtmOptics_Destroy( AtmOptics_Aerosol ) + CALL CRTM_AtmOptics_Destroy( AtmOptics_Total ) + + END DO Channel_Loop + ! ============================================================================ + + + ! ============================================================================ + ! 6. **** WRITE THE AOP/COP/TOP DATA TO SEPARATE NETCDF FILES **** + ! + WRITE( *, '( /5x, "Writing optical profile files..." )' ) + + Error_Status = OP_Input_WriteFile( AOP_FILE, AOP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing AOP file '//AOP_FILE + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + Error_Status = OP_Input_WriteFile( COP_FILE, COP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing COP file '//COP_FILE + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + Error_Status = OP_Input_WriteFile( TOP_FILE, TOP ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing TOP file '//TOP_FILE + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + + ! ============================================================================ + ! 7. **** DESTROY THE CRTM **** + ! + WRITE( *, '( /5x, "Destroying the CRTM..." )' ) + Error_Status = CRTM_Destroy( ChannelInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error destroying CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + ! ============================================================================ + ! 8. **** CLEAN UP **** + ! + CALL CRTM_Atmosphere_Destroy(Atm) + CALL CRTM_Atmosphere_Destroy(Atm_x) + ! ============================================================================ + +CONTAINS + + INCLUDE 'Load_Atm_Data_SingleProfile.inc' + INCLUDE 'Load_Sfc_Data_SingleProfile.inc' + + ! Copy one channel's computed AtmOptics into the corresponding storage + ! position within an OP_Input object, and record which absolute + ! ChannelIndex that position corresponds to (via OP%Channel_Index) so + ! CRTM_Forward_Module's OP_Input_Channel_Position lookup can find it (see + ! CRTMv3 issue #327). The Legendre index in Phase_Coefficient is 0-based + ! (0:n_Legendre_Terms) while OP_Input%pcoeff's Legendre dimension is + ! 1-based, hence the ileg+1 shift - this matches the convention used when + ! CRTM_Forward_Module reads Options%TOP/COP/AOP back into AtmOptics. + SUBROUTINE Pack_AtmOptics( AO, Position, ChannelIndex, OP ) + TYPE(CRTM_AtmOptics_type), INTENT(IN) :: AO + INTEGER, INTENT(IN) :: Position + INTEGER, INTENT(IN) :: ChannelIndex + TYPE(OP_Input_type), INTENT(INOUT) :: OP + INTEGER :: ilay, iphas, ileg, ileg1 + + OP%Channel_Index(Position) = ChannelIndex + + DO ilay = 1, AO%n_Layers + OP%tau(Position,ilay) = AO%Optical_Depth(ilay) + OP%bs(Position,ilay) = AO%Single_Scatter_Albedo(ilay) + OP%kb(Position,ilay) = AO%Backscat_Coefficient(ilay) + DO iphas = 1, AO%n_Phase_Elements + DO ileg = 0, AO%n_Legendre_Terms + ileg1 = ileg + 1 + OP%pcoeff(Position,ilay,iphas,ileg1) = AO%Phase_Coefficient(ileg,iphas,ilay) + END DO + END DO + END DO + END SUBROUTINE Pack_AtmOptics + +END PROGRAM Generate_OP_Subset diff --git a/test/mains/unit/Unit_Test/TOP_Subset.nc b/test/mains/unit/Unit_Test/TOP_Subset.nc new file mode 100644 index 0000000000000000000000000000000000000000..fd9ee974d2823a6d2518aa07fe3f2a629225bd97 GIT binary patch literal 32964 zcmeI*2{4uK-#>6$k|nfTinOT6n&n&E*BvQak}O}PPL?D4E-H#7McERvCS)mEtRYLt zQnplHW{KG*#|pL5K0=FFjZ;2<3wyH z#)0kX(c(^T4XCS90#P-B90-(XMyW7xY9crI>QZR+rQ>T z97_*Z78A0gv4gptlew+UzwWb|GAn*t*l28M#cx8kb220LEpxUpr%VcdC&p(W47bdr zgXUINx`tNHlqt|K!ZzCC09m-9T)>Ptlq&$y8U6S9|C70F`8k)fwpPy8WPV3uLnkM) zgSpKaeq&p*sj0cKIpjnX`5(@0#XK=LOCw^af1J~{pK~)ZG`4gxbTIjU%y_#&A-F?l!S=onNz#PcM|jYhxu~I!F?I+D8Uei zQF?)RjETqUpJXla^L*@x9^^N5wlOA};@^XIsD=xm(~gH0#`8ZfwRs zpBW@`8xyiCY=FzZ&zJc9|JJ9<$Lx$1i8kP0dTOZ<$MZXx89MQk4UNtCq3=bF97QdS zM1Q6N=K^hH!|!6~2)|m}IXgk}a7r*f@f>BMq46MklzO2iKuv&}z&}a=PcK$YpZi{n zKbrjO<*}2Vzr&ASD0UL{Dronp67`<)?pC2V$KIOooGV=v;a+#eMzBUzvQ{C=?>!`)d2G5%T3Dl6^(`%uQ>AP3TBuRPohe z1FcUySLC<;qb8uKLQc`{vS4)MGn6 ztV;M^e3Tnu?Q-5i!o_dhM8Fzrwq0=mi&YxtWPr)m@jE5Jxb8QW5b#5fq)iBXzK(B! zc)jQMTpUgXkIc&NgyT#6>%R}$!0Wr++da02!L{cL@4)@1%HD|%o&dLBQRid=x4CI% zPl9WNNUS*c_4b9V3GkEW`O9m->AT;u#(-lCY9HHz!$+-EBf$3(i{|6N(RV5`zo0($ z?L`lGMp1v%itd#wqfvi(JU+XQj0Vq=uk_y^L<7t394Fm~L4&UE8n_k?pq>}%YMJVv zQ7_$E?Ytl@^r7Q!`|!R6)FN#mUEMH%$~O3EGS`HmLN0xuC^{w-`gr7H@$NL_8~QEt zu3iaJ!z_Ehc^4yDOVW)Tvsc)7%drG8o99@6^~m~TYj6AqEkQkmngBHcY68>*s0mOL zpe8^~fSSPnngp;)3s=wnel4tAIHpM_@i^9hjA>+Y=Xva%?42_{+<{0UGQq^>b`IjZ zVy>*`e+}6Q?(5<5wEk#aT7R@Gtv_0q)*tVd)*tVe z)*r8y)*n?%>yON(^+)>B`s3=-`s4i4`eWbH`eVn^`s35m`lFe;{`g<>q@kV&HG%(6 z6ToAZ-oJ{aynog6JIoTQ9f?D|d)juJiF$0;c>5@}T3{w@-+R1?@XMMb+Tf#tYfWB* zCAf?i#=#eJn(Ar5NBD%k2jej%>>bkIv%qD0HU~@KF)wHa-Yne1W2Z7apKMtP9(?+& zvm1|{E@j*+UWvz)I_*(un8jmfTt?>YS;2uL7M)_?G%pLE`(U#a&sb@&?^9E?8n957 z^YT+*l?1;{fneI%^agVRhgQroy5j{puv%#H>$_`6RNhTL zTtoxwc^-c4l+#nJrKYKuPlovX2=ziufSLd`fnSmUp7pT2wmX`PXQ#__MzFg64%Z!^ zPo&iAXB#H!)x}irr?@lgE8(8mrUk-%Z_*7{Rg+JGMRtzg=xZ`w)yvdJ3Gt zv(jkx;XcV=!@B+Ycfm(_P}os$n)fO+15O%l;$p?KAF&2&-q;N8e3CEq4SZ}ipQjf5 zMd|1qVVml~ABMz!8fkh3u&LZuBN=ez{tJxUU`>whCj;Qz_i=JP$y&0?f?d9RB=4@$RbM_D&Foo;io!!U-Eg1EA+a1sp?ig39YO>)3`{bT<={c#=kVOo{9d5ilmX&UOF)C8yr zP!oUz@M6_X8=Xt_@sgd%6A@&#-{P2OHz@V;RAMRhV&*z2PTH}N@RpPx&V;AVk+cYB z$8_p|QzSA;BH%6MV@zV;hm4*(7{D?%=4xxed6L`Zv%sgq8Vufm+v%Q3=YntWEjCEw zCA(O?9@Resr)mjQ1cD_`)PFk%e!QxxwG^zl?Yv?L`2K1ZeH$?LqC;vD9G)OP?gEzZ z7wt6#2X6ek)&#t>rdlTm95g7f{s>qoeKhSF8qJ&Ewu&wTjTf}vjABzp4yMre@I6K!ZjCy= zkjX%$W5w({U++eFd?V+RzvrSrzEgRO%Pr8wstR|SfoZg7TtH6u^bq3l?mWLe@)*_@ zo68&0z8|aiiSO?@cZS;J)C8yrP!sr73E-vQf+kpH9^&O2?_6WwcI3Bsk9;Ggo^aJ+ zNq0`|4=GOiAh&W#SxyzmjFt63nK~=D1&Aq`- zXrkBux@_fUG*u#b*v@erO*O2wRgRxRGqkqyK^2$K)aWvgpviY=%6-v8s_Y{gb6$** z49Y;msb6KwdE?Q?+u7EyvNKTg0$*u?V?HYG;!MA{CKhFSE?08N2}C~ZvdMKaUy+k$ z#fYMIC=zVn#P7OU1F^0@FU-Wii8Y<;uFrE%!K&>d$PI-uzp8Jj<5Cl#CO}O9f5~uN zMBid9Ua_yW%+Esix7eLAhf*)$g&(CJdDN8R0Hz|sqRkr|DDGT$ny}SMR_u5GkAp@&DeLxG4PDEy6zFMgi)OH1^neQ zer?9|b}-qxnBhHGh#OC(0ec*bntDv^S7<)uN_f-3jtVe`F5Q9#*l~E(mMAde-T~nQ zV2jfimeGTmbRS$c1Y6k~IXj^7o5}fN%{2H1}412J^S%;?Pc-lyYuzi-( z(fpY|n$*lLXARhZMm~8mXw>zifoj$nwNrJdohF~-M5q&b>sh6(kY9=N1dbp0G?R|f zLcQj?u_$!Wnw!J>(*|T#PX1cQ@Dg$1;#^Uis<65CQwni@QCK5lA2Ggo4l6&ro8gxI zFtx*}2~ZQDCh)5gz+Z;883=5g!z(iF=K7cw|LbSa8US{ z5qP~1Q^E6AzXz9Ipx?9&d_ML_{bTUF#u zCqbJKNmXIX?zIsv@AwG!D&9K&B0pM7Y* zH{`cC&|QyG&pTd^QqOgjIK_@?Un!1^$)?y=rj4*(>bgn78P(6#!BsV;d&|KtYM%qH zfg8iDuOx!q%)EAufTy@q-wJ|*9L`B4Et@G7oGNv#JQ{m+)@B^+XVSjF-fG7t9%7`U&3W`=Gq2kQNJO3KPA4 z2duVn<#jlp66O#V^%*ol=ijsYD-W9Nwi;XZW(S&Fd?L*7c{iGB+&au5W`-tvCr^>G zInad3ULM6-bM%Ex?30JPH|jkQ5^qtp3^j!(CbUJcpqgC^LwEM5qsMxJrw2+xP;9|! z3v)UtWXZ;3wN=g>X?|a;{}v~Xk}36$mEgl9y131Vw$`r051z$zM_AbIJh@8QP2R)w)=gm9Jo0+ ziM$AAP;Ppw1+Ja@euo>5|2`c0dJ){fAoHLUyihH+><*eZ5vcx=C%Gb!kQXCt*^X=cS=Lv9H-@!Iba1syutGD1sMK+o(;N(hK zzT;>tHnLkeOc#y!|2;X|;f*Fl|B?^3C`1$Il5`CYaia08=np+D`_Skkzm48xZPfqv z(9>)5cIeYrr@0WDEYE|~ic*$g)kf7D7iuc7XT1{N&l;HI@iy}xLeCU4&XzECQ}5DgAwGm1L^4rOYr?*lBI zjvLR**l)N@V;;|Um(5?P&Z0`S=F9a<8VX~mHj`=9$_OF{JcHY`yZCV_o>9B+=zM$iZ*lKCL86}4YCSnh zy^6Fel=_PU+7uh5W>DOoaEtKp-I!~HwHa>0aolHKcpUmlIP5}Q71)kO@OC*EvGxTf zfI}|-aP3<*Ml&=h ze@SDR^B@}XS&^vZvVevaHz~d05JE%K0&CdsXQ07PB95ep5Y(st(CO;-F4VO{j=#nm zzAr^Y+aR^V4pn}>QsiN{i1IdS(G64>qwsW}y#->v$V**;YdFadDZANTQQ=iUyBO2u z#q(ca6>|4ihK_h+cYH6pPD@#1rBW-;KDtzcJ>4j-f1rQrk8W=2$x{=cCh$uWz>}{& zoqpr~2v14PRg^D~{2iWQ-xW`(XQ*?8Qm;L1lwy4L8O8hRbSP$JOb2Jsn`l2LeDJur zEI3n{Hi5GLVHH;fxOm?El?Uv9KE-`b9z1vEYupUDE$?*j20YovQHeIV7EgJw=iXmg z!r%e<iIk}`G7|g^;(I24j&Xo zy|TQwCr@gl9_=`T-D?9-*HwK^w4W2T6<4(CZ1P2oO?{ipmP?}2%MrdwN7zs%cCw4J zssaU%j3-TKHY0Zvw`l#{Wk?~G$*0yl2W@E86`szg||to~-ab!iNJTN5Hnshg6yf$M-O(g54Arh7-Yp58Q(` zgNq{%8F_YeL)j$>ES~faP-2}-)5q%wU7p%tv}VIMWGN)X(kQhGiH7)b}w}rpQ_0`-T-Q3iZrzSv6;Fl(V zUw`j4u}!ra_dBL%In5{YTYN!hjHqX|?fwT!y*-PKl=|PU)({?7D!)zfV_g;S6&iOB zMZ&gvmovfM+J#jUgqxDj-Uo+xhPLE`PsTqEumE=*zKAD-uSg7p4B*$BLN*k=3;{2` zz7`pdUvE~Y-+nX~_tSnh%9*JEj;Z+M5Qh8dD0$;WG~n>T+(rwqO~ZrDsbGi5zE}6COMOtEC{N!>F!O0NshzNA)godJeU1sD3i&O8MP> zRDa1#am{WERQL3N{czP~R9)RQYT7rB%A!)<#YAoj)jW@q019JXKDJk-Id2~ZRGqZ7a#I7Hq5Iy#O!N=s<--9GhOe8#kjQcse- znNn|mj5NiY^(qLvMRaviOe3O6`0N{OBVn!b)*WDxuXJT3!n_t;$BF&LCe8Q2Vjsi= z4uUm1&UL7RWyPjM#lV$~X)!F|vstAIdvOQOGtzt(3gE@}*F(*~FY|N!6LCkGOPvuZ z0pQlokyRbwyuk3>hu~_i2j_|Xh4b25^T0VHv33{0ng0Dd6~G08JoSp;9ILnPx8ZxL z=Jxk3#-rT+MY+)T94POO$ED0tgmPSa)_iQKMcMUOy;b$b=d#va`-;_Q-gSO;L5O~ZO&gR+B`#xBxz|(PxXE*qN52t|9604;pciJ z^{Usg(0%=E^QE093pE8?gfQ#?<|D~5vr<jY1mL>y?8f%_cX5hjJI#lQx(^c zvR^q_Aq+moKWVlc*N`;nnOBE;h5L6J+w_7vKCJ&#fvc8nNzS-z3FGaY6@CHZS3HZN zdnu1=>^*aahUFQqTDia#=c0sb>>H~Xy>Jx#T7V>H4}MsU_8vu<{hNw^bkidLY5l%8 z_IFU?t4N!afq^1_uZQ>jZK{jB5c7tnQjemzy`h^F-56ea#kang_oRq)ca-*7Fv3HHkHXO{|}mn_ Date: Tue, 14 Jul 2026 17:52:48 -0600 Subject: [PATCH 08/10] Code clean up --- src/CRTM_Forward_Module.f90 | 28 +++++++----------- src/Options/OP_Input/OP_Input_Define.f90 | 12 +++----- test/CMakeLists.txt | 11 +++---- .../mains/unit/Unit_Test/AOP_SingleProfile.nc | Bin 96980 -> 96988 bytes test/mains/unit/Unit_Test/AOP_Subset.nc | Bin 32964 -> 32972 bytes .../mains/unit/Unit_Test/COP_SingleProfile.nc | Bin 96980 -> 96988 bytes test/mains/unit/Unit_Test/COP_Subset.nc | Bin 32964 -> 32972 bytes test/mains/unit/Unit_Test/Generate_OP.f90 | 1 - .../mains/unit/Unit_Test/TOP_SingleProfile.nc | Bin 96980 -> 96988 bytes test/mains/unit/Unit_Test/TOP_Subset.nc | Bin 32964 -> 32972 bytes 10 files changed, 18 insertions(+), 34 deletions(-) diff --git a/src/CRTM_Forward_Module.f90 b/src/CRTM_Forward_Module.f90 index 10cfecf8..8ff8b77e 100644 --- a/src/CRTM_Forward_Module.f90 +++ b/src/CRTM_Forward_Module.f90 @@ -100,12 +100,7 @@ MODULE CRTM_Forward_Module USE CRTM_CloudCover_Define, ONLY: CRTM_CloudCover_type USE CRTM_Active_Sensor, ONLY: CRTM_Compute_Reflectivity, & Calculate_Cloud_Water_Density - USE OP_Input_Define, ONLY: OP_Input_type , & - OP_Input_Create , & - OP_Input_WriteFile , & - OP_Input_ReadFile , & - OP_Input_Associated, & - OP_Input_Channel_Position + USE OP_Input_Define, ONLY: OP_Input_Channel_Position ! Internal variable definition modules ! ...AtmOptics @@ -476,7 +471,6 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) INTEGER :: nt, start_ch, end_ch, chunk_ch, n_sensor_channels INTEGER :: n_inactive_channels(n_channel_threads+1) - TYPE(OP_Input_type) :: TOP ! Local atmosphere structure for extra layering TYPE(CRTM_Atmosphere_type) :: Atm ! Clear sky structures @@ -1031,17 +1025,17 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END IF END IF - ! Optical properties of clouds and aerosols + ! Get or compute cloud particle absorption/scattering properties ! ! pos maps ChannelIndex to the column of opt%TOP/COP/AOP holding this ! channel's data. It is 0 (not found) whenever the corresponding ! Use_*_OP flag is off, or when it's on but this particular channel ! isn't covered by the supplied OP_Input (e.g. a single-channel ! OP_Input in a multi-channel run) - either way, fall through to the - ! usual internal computation for this channel (see CRTMv3 issue #327). + ! usual internal computation for this channel. pos = 0 IF ( Options_Present .AND. opt%Use_Total_OP ) pos = OP_Input_Channel_Position( opt%TOP, ChannelIndex ) - IF ( pos >= 1 ) THEN + IF ( pos >= 1 ) THEN ! use total optical properties from user-defined OP_Input AtmOptics(nt)%Include_Scattering = .TRUE. DO ilay = 1, Atm%n_Layers AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%TOP%tau(pos, ilay) @@ -1058,10 +1052,10 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) ELSE - ! ...Clouds, if opt%Use_Cloud_OP + ! ...Clouds pos = 0 IF ( Options_Present .AND. opt%Use_Cloud_OP ) pos = OP_Input_Channel_Position( opt%COP, ChannelIndex ) - IF ( pos >= 1 ) THEN + IF ( pos >= 1 ) THEN ! use cloud optical properties from user-defined OP_Input ! Use user-defined cloud optical profiles AtmOptics(nt)%Include_Scattering = .TRUE. DO ilay = 1, Atm%n_Layers @@ -1076,7 +1070,8 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END DO END DO END DO - ELSEIF( Atm%n_Clouds > 0 ) THEN + ELSEIF( Atm%n_Clouds > 0 ) THEN ! else compute, CRTM default + ! Compute the cloud particle absorption/scattering properties Err_Thread = CRTM_Compute_CloudScatter( Atm , & ! Input GeometryInfo , & ! Input SensorIndex , & ! Input @@ -1095,8 +1090,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) ! ...Aerosols pos = 0 IF ( Options_Present .AND. opt%Use_Aerosol_OP ) pos = OP_Input_Channel_Position( opt%AOP, ChannelIndex ) - IF ( pos >= 1 ) THEN - ! Use user-defined aerosol optical profiles + IF ( pos >= 1 ) THEN ! use aerosol optical properties from user-defined OP_Input AtmOptics(nt)%Include_Scattering = .TRUE. DO ilay = 1, Atm%n_Layers AtmOptics(nt)%Optical_Depth(ilay) = AtmOptics(nt)%Optical_Depth(ilay) + opt%AOP%tau(pos, ilay) @@ -1110,7 +1104,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END DO END DO END DO - ELSEIF ( Atm%n_Aerosols > 0 ) THEN + ELSEIF ( Atm%n_Aerosols > 0 ) THEN ! else, CRTM default ! Compute the aerosol absorption/scattering properties Err_Thread = CRTM_Compute_AerosolScatter( Atm , & ! Input SensorIndex , & ! Input @@ -1132,8 +1126,6 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) CALL CRTM_AtmOptics_Combine( AtmOptics(nt), AOvar(nt) ) END IF - - ! ...Save vertically integrated scattering optical depth for output RTSolution(ln,m)%SOD = AtmOptics(nt)%Scattering_Optical_Depth diff --git a/src/Options/OP_Input/OP_Input_Define.f90 b/src/Options/OP_Input/OP_Input_Define.f90 index 206d3c5a..a09662f6 100644 --- a/src/Options/OP_Input/OP_Input_Define.f90 +++ b/src/Options/OP_Input/OP_Input_Define.f90 @@ -53,10 +53,7 @@ MODULE OP_Input_Define ! Module parameters ! ----------------- ! Release and version - INTEGER, PARAMETER :: OP_INPUT_RELEASE = 2 ! This determines structure and file formats. - ! ...Release 2 added Channel_Index, mapping each column of tau/bs/kb/pcoeff to the - ! SpcCoeff ChannelIndex it was computed for, so a caller can supply optical profile - ! data for a subset of a sensor's channels (see CRTMv3 issue #327). + INTEGER, PARAMETER :: OP_INPUT_RELEASE = 1 ! Close status for write errors CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' ! Literal constants @@ -83,8 +80,8 @@ MODULE OP_Input_Define ! Variable description attribute. CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' - CHARACTER(*), PARAMETER :: TAU_DESCRIPTION = 'Layer optical depth' - CHARACTER(*), PARAMETER :: BS_DESCRIPTION = 'Layer volume scattering coefficient' + CHARACTER(*), PARAMETER :: TAU_DESCRIPTION = 'Layer extinction optical depth' + CHARACTER(*), PARAMETER :: BS_DESCRIPTION = 'Layer scattering optical depth' CHARACTER(*), PARAMETER :: PCOEFF_DESCRIPTION = 'Layer phase function coefficients for scatters' CHARACTER(*), PARAMETER :: KB_DESCRIPTION = 'Layer backward scattering coefficient' CHARACTER(*), PARAMETER :: CHANNEL_INDEX_DESCRIPTION = & @@ -237,11 +234,10 @@ FUNCTION OP_Input_IsValid( op ) RESULT( IsValid ) CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'OP_Input_IsValid' CHARACTER(ML) :: msg + ! Placeholder for now, more test needed ! Setup IsValid = .TRUE. - ! CD: placeholder for now - END FUNCTION OP_Input_IsValid diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 0fbbaa86..abb2081a 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -358,7 +358,6 @@ add_executable(Unit_Aerosol_Bypass_k_matrix mains/unit/Unit_Test/test_Aerosol_By target_link_libraries(Unit_Aerosol_Bypass_k_matrix PRIVATE crtm) add_test(NAME test_Unit_Aerosol_Bypass_k_matrix COMMAND $) -set_tests_properties(test_Unit_Aerosol_Bypass_k_matrix PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") # MW land surface Jacobian validation (issue #281): analytic LAI / Vegetation_Fraction # Jacobians (K-matrix adjoint and tangent-linear) vs finite differences. @@ -400,17 +399,15 @@ add_executable(Unit_OP_TEST mains/unit/Unit_Test/test_OP.f90) target_link_libraries(Unit_OP_TEST PRIVATE crtm) add_test(NAME test_Unit_OP COMMAND $) -set_tests_properties(test_Unit_OP PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") - -# Utility to (re)generate the AOP/COP/TOP_SingleProfile.nc files used by Unit_OP_TEST -add_executable(Generate_OP mains/unit/Unit_Test/Generate_OP.f90) -target_link_libraries(Generate_OP PRIVATE crtm) add_executable(Unit_OP_Subset_TEST mains/unit/Unit_Test/test_OP_Subset.f90) target_link_libraries(Unit_OP_Subset_TEST PRIVATE crtm) add_test(NAME test_Unit_OP_Subset COMMAND $) -set_tests_properties(test_Unit_OP_Subset PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") + +# Utility to (re)generate the AOP/COP/TOP_SingleProfile.nc files used by Unit_OP_TEST +add_executable(Generate_OP mains/unit/Unit_Test/Generate_OP.f90) +target_link_libraries(Generate_OP PRIVATE crtm) # Utility to (re)generate the AOP/COP/TOP_Subset.nc files used by Unit_OP_Subset_TEST add_executable(Generate_OP_Subset mains/unit/Unit_Test/Generate_OP_Subset.f90) diff --git a/test/mains/unit/Unit_Test/AOP_SingleProfile.nc b/test/mains/unit/Unit_Test/AOP_SingleProfile.nc index e8c7d595bafadc8ddc04cdce0bdd9b770ab03920..e76f6c975fc3dfcd88de87330bd892fecebd0655 100644 GIT binary patch delta 139 zcmccemG#b7)(Opwj1ya|736#pD^rUUQY%U_^O8$4^Yaw)3raGR6LS<&QVU8l7$)a4 zIx{gJnJmF*3{zX2oLEwlT9lcWj;Yp#y@i2+fhjv_vK*uC_GA7=4VcauWh0&N-86sPj zpHrHfI{6=?^u)*ZOky>Y_b?u2w3*z%w28_3&twzke#SkU8O0v(HZKv}zC@7GA`<|x COeP2b diff --git a/test/mains/unit/Unit_Test/AOP_Subset.nc b/test/mains/unit/Unit_Test/AOP_Subset.nc index 0e172da610f428dbe731f2af6ab50b6de0ba63cf..bf723ebd5dc3e618d82f847f5c448f7b989e3c40 100644 GIT binary patch delta 135 zcmX@o$aJQWX+kq2hROMi z&P>clCQC3H!_*chCzh0?7G>t8V^Pb&#lpbAz?7XdS&mV6@^i)sj4qQam^L%EOx9uU RXFRg`BIg2@%`qGq6#!B*EqDL` delta 95 zcmX@p$aJKUX+kq2)5I2Q5n-Ri%G4r-{DP9ql+=QfjEVPM823z8VKnAdhRBxX x=alBAPX5OzJ@K(U6X&1Fdl(Nh+DvX>+RRup*@U^DanI(5oC{bsr*LFc005svBlQ3P diff --git a/test/mains/unit/Unit_Test/COP_SingleProfile.nc b/test/mains/unit/Unit_Test/COP_SingleProfile.nc index 1cf234a791ed64e3629402791df9b1cc1daf8b6b..977672c2e68b5ea1658ca22e0d686fefec0f8872 100644 GIT binary patch delta 139 zcmccemG#b7)(Opwj1ya|736#pD^rUUQY%U_^O8$4^Yaw)3raGR6LS<&QVU8l7$)a4 zIx{gJnJmF*3{zX2oLEwlT9lcWj;Yp#y@i2+fhjv_vK*uCdR delta 100 zcmccfmG#P3)(OpwOcPtIMTC74D^rUU@(W5blM{0kQc?>_GA7=4VcauWh0&N-86sPj zpHrHfI{6=?^u)*ZOky>Y_b?u2w3*z%w28_3&twzke#SkU14SnAG=~Um4-sJO$N~VZ CP$jeg diff --git a/test/mains/unit/Unit_Test/COP_Subset.nc b/test/mains/unit/Unit_Test/COP_Subset.nc index e1005d7102b01ac3dafb232f590a8024e27e8273..094aea33b86aa03dea85e83f4ee73b0cc66f50a2 100644 GIT binary patch delta 135 zcmX@o$aJQWX+kq2hROMi z&P>clCQC3H!_*chCzh0?7G>t8V^Pb&#lpbAz?7XdS&mV6@^i)sj4qQam^L%EOx9uU RXFRgmk<)->^BeXX6#z{zEq4F_ delta 95 zcmX@p$aJKUX+kq2)5I2Q5n-Ri%G4r-{DP9ql+=QfjEVPM823z8VKnAdhRBxX x=alBAPX5OzJ@K(U6X&1Fdl(Nh+DvX>+RRup*@U^DanI&JP6L+BU)XO{005dnBlG|O diff --git a/test/mains/unit/Unit_Test/Generate_OP.f90 b/test/mains/unit/Unit_Test/Generate_OP.f90 index a14f8446..56e4d490 100644 --- a/test/mains/unit/Unit_Test/Generate_OP.f90 +++ b/test/mains/unit/Unit_Test/Generate_OP.f90 @@ -358,7 +358,6 @@ SUBROUTINE Pack_AtmOptics( AO, ChannelIndex, OP ) ! Record which SpcCoeff ChannelIndex this column corresponds to, so ! CRTM_Forward_Module's OP_Input_Channel_Position lookup can find it - ! (see CRTMv3 issue #327). OP%Channel_Index(ChannelIndex) = ChannelIndex DO ilay = 1, AO%n_Layers diff --git a/test/mains/unit/Unit_Test/TOP_SingleProfile.nc b/test/mains/unit/Unit_Test/TOP_SingleProfile.nc index 7d9ccaa9351663585542d6e47f7e398246dbe8e8..f61d89b7827615e7323f496b2a473ec9704723b2 100644 GIT binary patch delta 139 zcmccemG#b7)(Opwj1ya|736#pD^rUUQY%U_^O8$4^Yaw)3raGR6LS<&QVU8l7$)a4 zIx{gJnJmF*3{zX2oLEwlT9lcWj;Yp#y@i2+fhjv_vK*uC_GA7=4VcauWh0&N-86sPj zpHrHfI{6=?^u)*ZOky>Y_b?u2w3*z%w28_3&twzke#SkU8O0{>G=~Um4-sJO$N~VV CSS4lv diff --git a/test/mains/unit/Unit_Test/TOP_Subset.nc b/test/mains/unit/Unit_Test/TOP_Subset.nc index fd9ee974d2823a6d2518aa07fe3f2a629225bd97..2fad883aa186b039bb5cba60f0aca93baa19947b 100644 GIT binary patch delta 135 zcmX@o$aJQWX+kq2hROMi z&P>clCQC3H!_*chCzh0?7G>t8V^Pb&#lpbAz?7XdS&mV6@^i)sj4qQam^L%EOx9uU RXFRg`BBue%<~Qs&DgaVIE(ZVr delta 95 zcmX@p$aJKUX+kq2)5I2Q5n-Ri%G4r-{DP9ql+=QfjEVPM823z8VKnAdhRBxX x=alBAPX5OzJ@K(U6X&1Fdl(Nh+DvX>+RRup*@U^DanI(5oCYkLzp&q^005s+B!mC} From ed6ff790eb67d66f3775519dc8129ff40b5867a9 Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Tue, 14 Jul 2026 19:42:24 -0600 Subject: [PATCH 09/10] Code format --- src/Options/OP_Input/OP_Input_Define.f90 | 41 ++++++++----------- test/mains/unit/Unit_Test/Generate_OP.f90 | 4 +- .../unit/Unit_Test/Generate_OP_Subset.f90 | 6 +-- test/mains/unit/Unit_Test/test_OP.f90 | 4 +- 4 files changed, 22 insertions(+), 33 deletions(-) diff --git a/src/Options/OP_Input/OP_Input_Define.f90 b/src/Options/OP_Input/OP_Input_Define.f90 index a09662f6..8114c3a1 100644 --- a/src/Options/OP_Input/OP_Input_Define.f90 +++ b/src/Options/OP_Input/OP_Input_Define.f90 @@ -63,7 +63,7 @@ MODULE OP_Input_Define ! NetCDF attributes ! Global attribute names. Case sensitive - CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' ! Dimension names CHARACTER(*), PARAMETER :: CHANNEL_DIMNAME = 'n_Channels' @@ -119,12 +119,6 @@ MODULE OP_Input_Define INTEGER :: n_Phase_Elements = 0 ! Ip dimension INTEGER :: n_Legendre_Terms = 0 ! Il dimension - ! Scalar components - ! LOGICAL :: Include_Scattering = .TRUE. - ! INTEGER :: lOffset = 0 ! Start position in array for Legendre coefficients - ! REAL(fp) :: Scattering_Optical_Depth = ZERO - ! REAL(fp) :: depolarization = 0.0279_fp - REAL(fp), ALLOCATABLE :: tau(:,:) ! K * L REAL(fp), ALLOCATABLE :: bs(:,:) ! K * L REAL(fp), ALLOCATABLE :: kb(:,:) ! K * L @@ -371,7 +365,7 @@ FUNCTION OP_Input_WriteFile( & OP%n_Phase_Elements , & ! Input OP%n_Legendre_Terms , & ! Input OP%Release , & ! Input - FileId ) ! Output + FileId ) ! Output IF ( err_stat /= SUCCESS ) THEN msg = 'Error creating output file '//TRIM(Filename) CALL Write_Cleanup(); RETURN @@ -594,7 +588,7 @@ FUNCTION OP_Input_ReadFile( & pcoeff( n_Channels , & n_Layers , & n_Phase_Elements , & - n_Legendre_Terms ), & + n_Legendre_Terms ), & channel_index( n_Channels ), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN @@ -986,7 +980,7 @@ END SUBROUTINE OP_Input_Info !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE OP_Input_Create( & - OP , & + OP , & n_Channels , & n_Layers , & n_Phase_Elements, & @@ -1013,10 +1007,10 @@ ELEMENTAL SUBROUTINE OP_Input_Create( & OP%bs( n_Channels, n_Layers ), & OP%kb( n_Channels, n_Layers ), & OP%pcoeff( n_Channels , & - n_Layers , & - n_Phase_Elements , & - n_Legendre_Terms ), & - OP%Channel_Index( n_Channels ) , & + n_Layers , & + n_Phase_Elements , & + n_Legendre_Terms ), & + OP%Channel_Index( n_Channels ), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN @@ -1082,7 +1076,7 @@ END SUBROUTINE OP_Input_Create FUNCTION OP_Input_Channel_Position( OP, ChannelIndex ) RESULT( pos ) TYPE(OP_Input_type), INTENT(IN) :: OP - INTEGER, INTENT(IN) :: ChannelIndex + INTEGER, INTENT(IN) :: ChannelIndex INTEGER :: pos INTEGER :: i @@ -1310,15 +1304,14 @@ ELEMENTAL FUNCTION OP_Input_Equal(x, y) RESULT(is_equal) ! Setup is_equal = .FALSE. - is_equal = (x%n_Layers == y%n_Layers ) .AND. & - (x%n_Phase_Elements == y%n_Phase_Elements ) .AND. & - (x%n_Legendre_Terms == y%n_Legendre_Terms ) !.AND. & - ! ALL(x%Optical_Depth .EqualTo. y%Optical_Depth ) .AND. & - ! ALL(x%Single_Scatter_Albedo .EqualTo. y%Single_Scatter_Albedo) .AND. & - ! ALL(x%Asymmetry_Factor .EqualTo. y%Asymmetry_Factor ) .AND. & - ! ALL(x%Backscat_Coefficient .EqualTo. y%Backscat_Coefficient ) .AND. & - ! ALL(x%Delta_Truncation .EqualTo. y%Delta_Truncation ) .AND. & - ! ALL(x%Phase_Coefficient .EqualTo. y%Phase_Coefficient ) + is_equal = (x%n_Channels == y%n_Channels ) .AND. & + (x%n_Layers == y%n_Layers ) .AND. & + (x%n_Phase_Elements == y%n_Phase_Elements) .AND. & + (x%n_Legendre_Terms == y%n_Legendre_Terms) .AND. & + ALL(x%tau .EqualTo. y%tau ) .AND. & + ALL(x%kb .EqualTo. y%kb ) .AND. & + ALL(x%bs .EqualTo. y%bs ) .AND. & + ALL(x%pcoeff .EqualTo. y%pcoeff) END FUNCTION OP_Input_Equal END MODULE OP_Input_Define diff --git a/test/mains/unit/Unit_Test/Generate_OP.f90 b/test/mains/unit/Unit_Test/Generate_OP.f90 index 56e4d490..12a7469d 100644 --- a/test/mains/unit/Unit_Test/Generate_OP.f90 +++ b/test/mains/unit/Unit_Test/Generate_OP.f90 @@ -236,7 +236,7 @@ PROGRAM Generate_OP AtmOptics_Cloud%Include_Scattering = .TRUE. IF ( Atm_x(1)%n_Clouds > 0 ) THEN CALL CSvar_Create( CSvar, n_Full_Streams, n_Phase_Elements, Atm_x(1)%n_Layers, Atm_x(1)%n_Clouds ) - Error_Status = CRTM_Compute_CloudScatter( Atm_x(1) , & ! Input + Error_Status = CRTM_Compute_CloudScatter( Atm_x(1) , & ! Input GeometryInfo(1), & ! Input SensorIndex , & ! Input ChannelIndex , & ! Input @@ -257,7 +257,7 @@ PROGRAM Generate_OP AtmOptics_Aerosol%Include_Scattering = .TRUE. IF ( Atm_x(1)%n_Aerosols > 0 ) THEN CALL ASvar_Create( ASvar, n_Full_Streams, n_Phase_Elements, Atm_x(1)%n_Layers, Atm_x(1)%n_Aerosols ) - Error_Status = CRTM_Compute_AerosolScatter( Atm_x(1) , & ! Input + Error_Status = CRTM_Compute_AerosolScatter( Atm_x(1) , & ! Input SensorIndex , & ! Input ChannelIndex , & ! Input AtmOptics_Aerosol, & ! Output diff --git a/test/mains/unit/Unit_Test/Generate_OP_Subset.f90 b/test/mains/unit/Unit_Test/Generate_OP_Subset.f90 index ecedd618..1bdd1529 100644 --- a/test/mains/unit/Unit_Test/Generate_OP_Subset.f90 +++ b/test/mains/unit/Unit_Test/Generate_OP_Subset.f90 @@ -4,11 +4,7 @@ ! Utility program to generate user-defined aerosol/cloud/total optical ! profile (AOP/COP/TOP) netCDF files that cover only a SUBSET of a sensor's ! channels (channels 2 and 3 of 'v.abi_gr' here), rather than every channel -! the sensor has. Otherwise identical to Generate_OP.f90 - same atmosphere/ -! surface data, same fixed 16-stream setup. The resulting files exercise the -! OP_Input%Channel_Index / OP_Input_Channel_Position channel-mapping fix for -! CRTMv3 issue #327 (https://github.com/JCSDA/CRTMv3/issues/327), and are -! read back by test_OP_Subset.f90. +! the sensor has. Otherwise identical to Generate_OP.f90 diff --git a/test/mains/unit/Unit_Test/test_OP.f90 b/test/mains/unit/Unit_Test/test_OP.f90 index 94a22810..1b6576ba 100644 --- a/test/mains/unit/Unit_Test/test_OP.f90 +++ b/test/mains/unit/Unit_Test/test_OP.f90 @@ -218,7 +218,7 @@ PROGRAM test_OP Options_AOP(1)%AOP%n_Layers = OP_AOP%n_Layers Options_AOP(1)%AOP%n_Phase_Elements = OP_AOP%n_Phase_Elements Options_AOP(1)%AOP%n_Legendre_Terms = OP_AOP%n_Legendre_Terms - Options_AOP(1)%AOP%Channel_Index = OP_AOP%Channel_Index + Options_AOP(1)%AOP%Channel_Index = OP_AOP%Channel_Index Options_AOP(1)%AOP%tau = OP_AOP%tau Options_AOP(1)%AOP%bs = OP_AOP%bs Options_AOP(1)%AOP%kb = OP_AOP%kb @@ -266,7 +266,7 @@ PROGRAM test_OP Options_TOP(1)%TOP%n_Layers = OP_TOP%n_Layers Options_TOP(1)%TOP%n_Phase_Elements = OP_TOP%n_Phase_Elements Options_TOP(1)%TOP%n_Legendre_Terms = OP_TOP%n_Legendre_Terms - Options_TOP(1)%TOP%Channel_Index = OP_TOP%Channel_Index + Options_TOP(1)%TOP%Channel_Index = OP_TOP%Channel_Index Options_TOP(1)%TOP%tau = OP_TOP%tau Options_TOP(1)%TOP%bs = OP_TOP%bs Options_TOP(1)%TOP%kb = OP_TOP%kb From a94c77d3bdc5380bbc3b0cc15045d9c0d7ca0c4f Mon Sep 17 00:00:00 2001 From: Cheng Dang Date: Mon, 20 Jul 2026 10:48:59 -0600 Subject: [PATCH 10/10] Revert "Update JEDI CI action with build cache (#321)" This reverts commit 82c746009c27585e5cd323365286d6f57d65db0d. --- .github/workflows/start-jedi-ci.yaml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/start-jedi-ci.yaml b/.github/workflows/start-jedi-ci.yaml index f5538204..33eadb8b 100644 --- a/.github/workflows/start-jedi-ci.yaml +++ b/.github/workflows/start-jedi-ci.yaml @@ -38,12 +38,15 @@ jobs: aws-region: us-east-2 - name: Run JEDI CI - uses: JCSDA-internal/jedi-ci@v2 + uses: JCSDA-internal/jedi-ci@develop with: container_version: latest target_project_name: crtm + test_dependencies: ioda ioda-data oops gsw ufo ufo-data + test_strategy: ALL test_script: run_tests.sh unittest_tag: CRTM_Tests bundle_repository: https://github.com/JCSDA/jedi-bundle.git + target_repo_dir: target_repository bundle_branch: develop jedi_ci_token: ${{ steps.generate-token.outputs.token }}