! Template for running CRTM for forward calculations !This is just one example/template for running CRTM forward calculations. !For example if all profiles are the same number of layers the do loop is !not necessary. ! David Groff 8/18/2008 PROGRAM Run_Forward ! ------------ ! Module usage ! ------------ ! -- Utility modules USE Type_Kinds USE Message_Handler use File_utility USE List_File_Utility ! module holding CRTM parameters USE CRTM_Parameters ! module holding CRTM Atm structure USE CRTM_Atmosphere_Define ! CRTM surface structure USE CRTM_Surface_Define ! CRTM GeometryInfo structure USE CRTM_GeometryInfo_Define ! CRTM channel info structure USE CRTM_ChannelInfo_Define ! CRTM options structure USE CRTM_Options_Define ! CRTM sfcoptics USE CRTM_SfcOptics ! CRTM sfcoptics structure USE CRTM_SfcOptics_Define ! CRTM contains function for initializing CRTM ! (i.e filling channelinfo structure) USE CRTM_LifeCycle ! Routine to load TauCoeff (used in CRTM_Init) ! USE CRTM_TauCoeff ! Routine to load SpcCoeff (used in CRTM_Init function) ! USE CRTM_SpcCoeff ! RTSolution structure (structure holding final result of CRTM forward call) USE CRTM_RTSolution_Define ! CRTM RTSolution and forward modules USE CRTM_RTSolution USE CRTM_Forward_Module ! -- Modules to read in Atmosphere and Surface data USE CRTM_Atmosphere_Binary_IO USE CRTM_Surface_Binary_IO ! --------------------------- ! Disable all implicit typing ! --------------------------- IMPLICIT NONE ! ---------- ! Parameters ! ---------- CHARACTER(*), PARAMETER :: ATMOSPHERE_FILENAME = 'Your.Atmosphere.bin.Big_Endian' CHARACTER(*), PARAMETER :: SURFACE_FILENAME = 'Your.Surface.bin.Big_Endian' ! --------- ! Variables ! --------- INTEGER :: Error_Status INTEGER :: Allocate_Status ! Variables used in CRTM_Init call CHARACTER( 256 ) :: Sensor_Id ! To make calculations for 1 sensor TYPE( CRTM_ChannelInfo_type ), DIMENSION(1) :: ChannelInfo TYPE( CRTM_Atmosphere_type ), DIMENSION( YOUR_N_PROFILES ) :: Atmosphere TYPE( CRTM_Surface_type ), DIMENSION( YOUR_N_PROFILES ) :: Surface TYPE( CRTM_GeometryInfo_type ), DIMENSION( YOUR_N_PROFILES ) :: GeometryInfo TYPE( CRTM_Options_type ), DIMENSION( YOUR_N_PROFILES ) :: Options TYPE( CRTM_RTSolution_type ), ALLOCATABLE, DIMENSION( :, : ) :: CRTMSolution ! Read in a sensor id from the command line (i.e hirs4_n18) WRITE( *, FMT = '( /5x, "Enter the Sensor ID: ")', & ADVANCE = 'NO' ) READ( *, '(a)' ) Sensor_Id Sensor_Id = ADJUSTL( Sensor_ID ) ! At this point you have a sensor_id that will ! be used to fill the channelinfo structure ! Now fill the channelinfo structure which is a required ! rank-1 argument for the CRTM_Forward call. In this ! case we just want calculations for one sensor ! so the array is 1 element long. !# The ChannelInfo is populated during the initialization WRITE( *, '( /5x, "Initializing the CRTM..." )' ) Error_Status = CRTM_Init( ChannelInfo, & SensorId=(/Sensor_Id/) ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error initializing CRTM', & Error_Status) STOP END IF ! Read your Atmosphere data into an array of CRTM atmospheres. ! The array of CRTM atmospheres is YOUR_N_PROFILES long. ! The Atmosphere structure is a required rank-1 argument ! for the CRTM_Forward call. ! For what you are trying to do it will be necessary to ! read in the non-CRTM formatted atmosphere data first. ! You have two options. ! 1) Read the non-CRTM formatted data and create a CRTM ! atmosphere binary file (in a separate routine). Then read ! in the newly created CRTM formatted file. ! 2) read in the non-CRTM formatted atmosphere ! data and fill the CRTM atmosphere structure (bypassing the need to ! create a CRTM atmosphere file). ! Read Atmosphere binary information and fill Atmosphere data structure array WRITE( *, '( /5x, "Reading the Atmosphere structure file..." )' ) Error_Status = CRTM_Read_Atmosphere_Binary( ATMOSPHERE_FILENAME, & Atmosphere ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error reading Atmosphere structure file '//& ATMOSPHERE_FILENAME, & Error_Status ) STOP END IF ! Read Surface binary information and fill the surface data structure array. ! For the non-CRTM formatted surface data the same options described ! for filling the atmosphere are available. WRITE( *, '( /5x, "Reading the Surface structure file..." )' ) Error_Status = CRTM_Read_Surface_Binary( SURFACE_FILENAME, & Surface ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error reading Surface structure file '//& SURFACE_FILENAME, & Error_Status ) STOP END IF ! Allocate for CRTMSolution (This is the ouput 2-D structure array ! from the CRTM_Forward call) ALLOCATE( CRTMSolution( N_CRTM_CHANNELS, YOUR_N_PROFILES), & STAT = Error_Status ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error Allocating CRTMSolution Structures.', & Error_Status ) STOP END IF ! For each profile allocate the number of layers within the ! RTSolution structures (CRTMSolution) DO m = 1, N_PROFILES ! Allocate the RTSolution structures Error_Status = CRTM_Allocate_RTSolution( Atmosphere(m)%n_Layers, & ! Input CRTMSolution(:,m) ) ! Output IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error Allocating CRTMSolution Structure.', & Error_Status ) STOP END IF ! Also fill your Geometryinfo for each profile here. ! You will need to read your geometryinfo from your ! non-CRTM formatted data first and then make calculations ! to fill the GeometryInfo fileds. ! (i.e GeometryInfo(m)%Sensor_Zenith_Angle) END DO ! Now you should be able to call the CRTM_Forward_Module Error_Status = CRTM_Forward( Atmosphere, & ! Input Surface, & ! Input GeometryInfo, & ! Input ChannelInfo, & ! Input CRTMSolution(:,:) ) ! Output ! The options could also be used in the forward call to set ! the sfc emissivity (etc.) as we discussed before ! ## CRTMSolution should hold the CRTM forward calculations ## ! Now destroy and deallocate used structures Error_Status = CRTM_Destroy_RTSolution( CRTMSolution(:,:) ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error deallocating CRTMSolution structures', & Error_Status ) STOP END IF ! ! Deallocate CRTMSolution DEALLOCATE( CRTMSolution, & STAT = Error_Status ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error DEAllocating CRTMSolution Structure.', & Error_Status ) STOP END IF ! Destroy the Surface structure Error_Status = CRTM_Destroy_Surface( Surface ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error deallocating Surface structure', & Error_Status ) STOP END IF ! The Atm structure Error_Status = CRTM_Destroy_Atmosphere( Atmosphere ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error deallocating Atmosphere structure', & Error_Status ) STOP END IF ! Destroying the CRTM Error_Status = CRTM_Destroy( ChannelInfo ) IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( PROGRAM_NAME, & 'Error destroying CRTM', & WARNING ) END IF END PROGRAM Run_Forward