diff --git a/src/CRTM_K_Matrix_Module.f90 b/src/CRTM_K_Matrix_Module.f90 index acecdb6..4645772 100644 --- a/src/CRTM_K_Matrix_Module.f90 +++ b/src/CRTM_K_Matrix_Module.f90 @@ -1083,7 +1083,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) ! (2) If aerosol/cloud and MieParameter < 0.01_fp, AtmOptics(nt)%n_Legendre_Terms == 4 ! Follow the legacy code, make sure RTSolution(ln,m)%n_Full_Streams == 6 for visible channels ! Rayleigh phase function has 0, 1, 2 components. - IF( AtmOptics(nt)%n_Legendre_Terms <= 4 ) THEN + IF( AtmOptics(nt)%n_Legendre_Terms <= 4 ) THEN AtmOptics(nt)%n_Legendre_Terms = 4 AtmOptics_K(nt)%n_Legendre_Terms = AtmOptics(nt)%n_Legendre_Terms RTSolution(ln,m)%Scattering_FLAG = .TRUE. @@ -1315,6 +1315,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) ChannelIndex, SensorIndex, & compute_antenna_correction, GeometryInfo) + !======= Active sensor ======= ! Calculate reflectivity for active instruments IF ( SC(SensorIndex)%Is_Active_Sensor .AND. AtmOptics(nt)%Include_Scattering) THEN @@ -1326,12 +1327,13 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) RTSolution(ln,m)) ! Input/Output ENDIF !============================= - - IF ( SpcCoeff_IsInfraredSensor( SC(SensorIndex) ) .OR. & - SpcCoeff_IsMicrowaveSensor( SC(SensorIndex) ) ) THEN + + ! IF ( SpcCoeff_IsInfraredSensor( SC(SensorIndex) ) .OR. & + ! SpcCoeff_IsMicrowaveSensor( SC(SensorIndex) ) ) THEN ! Perform clear-sky post and pre-processing IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag) ) THEN + ! Radiance post-processing CALL Post_Process_RTSolution(Opt, RTSolution_Clear(nt), & NLTE_Predictor, & @@ -1360,9 +1362,15 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END IF + !** output Tb_clear in the case of n_clouds = 0 (note this is NOT aerosol cleared) + IF (Atm%n_Clouds == 0 .OR. CloudCover%Total_Cloud_Cover < MIN_COVERAGE_THRESHOLD) THEN + RTSolution(ln,m)%Tb_clear = RTSolution(ln,m)%Brightness_Temperature + RTSolution(ln,m)%R_clear = RTSolution(ln,m)%Radiance + END IF + END IF - END IF + !END IF IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag).and.RTV(nt)%mth_Azi==0 ) THEN ! The adjoint of the clear sky radiative transfer for fractionally cloudy atmospheres @@ -1418,8 +1426,8 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) END IF ! Calculate the adjoint for the active sensor reflectivity IF ( SC(SensorIndex)%Is_Active_Sensor .AND. AtmOptics(nt)%Include_Scattering) THEN - CALL CRTM_Compute_Reflectivity_AD(Atm , & ! Input - AtmOptics(nt) , & ! Input + CALL CRTM_Compute_Reflectivity_AD(Atm , & ! Input + AtmOptics(nt) , & ! Input RTSolution(ln,m), & ! Input GeometryInfo , & ! Input SensorIndex , & ! Input diff --git a/test/mains/regression/k_matrix/test_Simple/test_Simple.f90 b/test/mains/regression/k_matrix/test_Simple/test_Simple.f90 index e79beb1..9aad3a7 100644 --- a/test/mains/regression/k_matrix/test_Simple/test_Simple.f90 +++ b/test/mains/regression/k_matrix/test_Simple/test_Simple.f90 @@ -1,4 +1,5 @@ ! +! ! test_Simple ! ! Test program for the CRTM K-Matrix function including clouds and aerosols. @@ -53,7 +54,7 @@ PROGRAM test_Simple INTEGER :: Error_Status INTEGER :: Allocate_Status INTEGER :: n_Channels - INTEGER :: l, m + INTEGER :: l, m, nc ! Declarations for Jacobian comparisons INTEGER :: n_la, n_ma INTEGER :: n_ls, n_ms @@ -73,6 +74,8 @@ PROGRAM test_Simple 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_forward(:,:) + ! Define the K-MATRIX variables TYPE(CRTM_Atmosphere_type), ALLOCATABLE :: Atmosphere_K(:,:) @@ -133,6 +136,7 @@ PROGRAM test_Simple ! 3a. Allocate the ARRAYS ! ----------------------- ALLOCATE( RTSolution( n_Channels, N_PROFILES ), & + RTSolution_forward( n_Channels, N_PROFILES ), & atm_K( n_Channels, N_PROFILES ), & Atmosphere_K( n_Channels, N_PROFILES ), & Surface_K( n_Channels, N_PROFILES ), & @@ -160,7 +164,7 @@ PROGRAM test_Simple Message = 'Error allocating CRTM Atmosphere_K structure' CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) STOP 1 - END IF + END IF ! Deleted in V2.4.1 ! The comparative K-MATRIX structure inside the results file !CALL CRTM_Atmosphere_Create( atm_K, N_LAYERS, N_ABSORBERS, N_CLOUDS, N_AEROSOLS ) @@ -183,6 +187,11 @@ PROGRAM test_Simple CALL Load_Atm_Data() CALL Load_Sfc_Data() + DO m = 1, 2 + DO nc = 1, atm(m)%n_Clouds + WHERE(atm(m)%Cloud(nc)%Water_Content > ZERO) atm(m)%Cloud_Fraction = 0.5 + END DO + END DO ! 4b. GeometryInfo input ! ---------------------- @@ -226,7 +235,20 @@ PROGRAM test_Simple ! ============================================================================ ! 6. **** CALL THE CRTM K-MATRIX MODEL **** - ! + + ! ============================================================================ + ! Temporary test CRTM forward versus k_matrix + Error_Status = CRTM_Forward( Atm , & + Sfc , & + Geometry , & + ChannelInfo, & + RTSolution_forward ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Forward Model' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + Error_Status = CRTM_K_Matrix( Atm , & Sfc , & RTSolution_K, & @@ -240,27 +262,48 @@ PROGRAM test_Simple CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) STOP 1 END IF - ! ============================================================================ - - + ! Compare the RT structures + ! -------------------------- + IF ( ALL(CRTM_RTSolution_Compare(RTSolution, RTSolution_forward)) ) THEN + Message = 'RTSolution results are the same! (Forward vs. K_Matrix)' + CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + ELSE + Message = 'RTSolution results are different!' + CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + STOP 1 + END IF ! ============================================================================ ! 7. **** OUTPUT THE RESULTS TO SCREEN **** ! - DO m = 1, N_PROFILES - WRITE( *,'(//7x,"Profile ",i0," output for ",a )') m, TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id) - DO l = 1, n_Channels - WRITE( *, '(/5x,"Channel ",i0," results")') RTSolution(l,m)%Sensor_Channel - ! FWD output - WRITE( *, '(/3x,"FORWARD OUTPUT")') - CALL CRTM_RTSolution_Inspect(RTSolution(l,m)) - ! K-MATRIX output - WRITE( *, '(/3x,"K-MATRIX OUTPUT")') - CALL CRTM_Surface_Inspect(Surface_K(l,m)) - CALL CRTM_Atmosphere_Inspect(Atmosphere_K(l,m)) - END DO - END DO + ! DO m = 1, N_PROFILES + ! WRITE( *,'(//7x,"Profile ",i0," output for ",a )') m, TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id) + ! DO l = 1, n_Channels + ! WRITE( *, '(/5x,"Channel ",i0," results")') RTSolution(l,m)%Sensor_Channel + ! ! FWD output + ! WRITE( *, '(/3x,"FORWARD OUTPUT")') + ! CALL CRTM_RTSolution_Inspect(RTSolution(l,m)) + ! ! K-MATRIX output + ! WRITE( *, '(/3x,"K-MATRIX OUTPUT")') + ! CALL CRTM_Surface_Inspect(Surface_K(l,m)) + ! CALL CRTM_Atmosphere_Inspect(Atmosphere_K(l,m)) + ! END DO + ! END DO + ! + ! DO m = 1, N_PROFILES + ! WRITE( *,'(//7x,"Profile ",i0," output for ",a )') m, TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id) + ! DO l = 1, n_Channels + ! WRITE( *, '(/5x,"Channel ",i0," results")') RTSolution_forward(l,m)%Sensor_Channel + ! ! FWD output + ! WRITE( *, '(/3x,"FORWARD OUTPUT")') + ! CALL CRTM_RTSolution_Inspect(RTSolution_forward(l,m)) + ! ! K-MATRIX output + ! WRITE( *, '(/3x,"K-MATRIX OUTPUT")') + ! CALL CRTM_Surface_Inspect(Surface_K(l,m)) + ! CALL CRTM_Atmosphere_Inspect(Atmosphere_K(l,m)) + ! END DO + ! END DO ! ============================================================================