Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add R_Clear TB_Clear to K_matrix RTS #135

Open
wants to merge 1 commit into
base: develop
Choose a base branch
from
Open

Add R_Clear TB_Clear to K_matrix RTS #135

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 15 additions & 7 deletions src/CRTM_K_Matrix_Module.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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, &
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
81 changes: 62 additions & 19 deletions test/mains/regression/k_matrix/test_Simple/test_Simple.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
!
!
! test_Simple
!
! Test program for the CRTM K-Matrix function including clouds and aerosols.
Expand Down Expand Up @@ -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
Expand All @@ -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(:,:)
Expand Down Expand Up @@ -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 ), &
Expand Down Expand Up @@ -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 )
Expand All @@ -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
! ----------------------
Expand Down Expand Up @@ -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, &
Expand All @@ -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
! ============================================================================


Expand Down