Skip to content

Commit

Permalink
Merge pull request #123 from JCSDA/feature/btj_test_emissivity_or_ref…
Browse files Browse the repository at this point in the history 
…lectivity_cap

Ensuring that surface: reflectivity, direct_reflectivity, and emissivity are bounded from [0:1], inclusive.
  • Loading branch information
@BenjaminTJohnson
BenjaminTJohnson authored Apr 4, 2024
2 parents 5471d95 + c3ee5a7 commit 1010c09
Show file tree
Hide file tree
Showing 16 changed files with 546 additions and 2,102 deletions.
70 changes: 50 additions & 20 deletions src/CRTM_Adjoint_Module.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1006,27 +1006,57 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status )
SfcOptics%Compute = .TRUE.
SfcOptics_Clear%Compute = .TRUE.
IF ( Opt%Use_Emissivity ) THEN
SfcOptics%Compute = .FALSE.
SfcOptics%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
ELSE
SfcOptics%Direct_Reflectivity(1,1) = SfcOptics%Reflectivity(1,1,1,1)
END IF
! ...Repeat for fractional clear-sky case
IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag) ) THEN
SfcOptics_Clear%Compute = .FALSE.
SfcOptics_Clear%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics_Clear%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics_Clear%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
ELSE
SfcOptics_Clear%Direct_Reflectivity(1,1) = SfcOptics%Reflectivity(1,1,1,1)
END IF
END IF
SfcOptics%Compute = .FALSE.
IF (Opt%Emissivity(ln) > ONE) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics%Emissivity(1,1) = ONE
ELSEIF (Opt%Emissivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivity less than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics%Emissivity(1,1) = ZERO
ELSE
SfcOptics%Emissivity(1,1) = Opt%Emissivity(ln)
END IF
SfcOptics%Reflectivity(1,1,1,1) = ONE - SfcOptics%Emissivity(1,1)

IF ( Opt%Use_Direct_Reflectivity ) THEN
IF ( Opt%Direct_Reflectivity(ln) > ONE) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )

SfcOptics%Direct_Reflectivity(1,1) = ONE
ELSEIF ( Opt%Direct_Reflectivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivity less than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics%Direct_Reflectivity(1,1) = ZERO
ELSE
SfcOptics%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
END IF
ELSE
SfcOptics%Direct_Reflectivity(1,1) = SfcOptics%Reflectivity(1,1,1,1)
END IF
! ...Repeat for fractional clear-sky case
IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag) ) THEN
SfcOptics_Clear%Compute = .FALSE.
SfcOptics_Clear%Emissivity(1,1) = SfcOptics%Emissivity(1,1)
SfcOptics_Clear%Reflectivity(1,1,1,1) = ONE - SfcOptics%Emissivity(1,1)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics_Clear%Direct_Reflectivity(1,1) = SfcOptics%Direct_Reflectivity(1,1)
ELSE
SfcOptics_Clear%Direct_Reflectivity(1,1) = SfcOptics%Reflectivity(1,1,1,1)
END IF
END IF
END IF

! non scattering case, this condition may be changed for future surface reflectance
IF( .not.RTSolution(ln,m)%Scattering_FLAG .or. .not.AtmOptics%Include_Scattering ) RTV%n_Azi = 0
!!! IF( .not. RTV%Scattering_RT ) RTV%n_Azi = 0
Expand Down
43 changes: 37 additions & 6 deletions src/CRTM_Forward_Module.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -994,20 +994,51 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status )
IF ( Opt%Use_Emissivity ) THEN
! ...Cloudy/all-sky case
SfcOptics(nt)%Compute = .FALSE.
SfcOptics(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics(nt)%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
IF (Opt%Emissivity(ln) > ONE ) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Emissivity(1,1) = ONE
ELSEIF (Opt%Emissivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivity less than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )

SfcOptics(nt)%Emissivity(1,1) = ZERO
ELSE
SfcOptics(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
END IF

SfcOptics(nt)%Reflectivity(1,1,1,1) = ONE - SfcOptics(nt)%Emissivity(1,1)

IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
IF(Opt%Direct_Reflectivity(ln) > ONE) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Direct_Reflectivity(1,1) = ONE
ELSEIF (Opt%Direct_Reflectivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivity less than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Direct_Reflectivity(1,1) = ZERO
ELSE
SfcOptics(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
END IF
ELSE
SfcOptics(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
! ...Repeat for fractional clear-sky case
IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag) ) THEN
SfcOptics_Clear(nt)%Compute = .FALSE.
SfcOptics_Clear(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics_Clear(nt)%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
SfcOptics_Clear(nt)%Emissivity(1,1) = SfcOptics(nt)%Emissivity(1,1)
SfcOptics_Clear(nt)%Reflectivity(1,1,1,1) = ONE - SfcOptics(nt)%Emissivity(1,1)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Direct_Reflectivity(1,1)
ELSE
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
Expand Down
48 changes: 41 additions & 7 deletions src/CRTM_K_Matrix_Module.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1187,20 +1187,54 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status )
SfcOptics_Clear(nt)%Compute = .TRUE.
IF ( Opt%Use_Emissivity ) THEN
SfcOptics(nt)%Compute = .FALSE.
SfcOptics(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics(nt)%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
IF (Opt%Emissivity(ln) > ONE) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Emissivity(1,1) = ONE
ELSEIF (Opt%Emissivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivityless than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Emissivity(1,1) = ZERO
ELSE
SfcOptics(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
END IF
SfcOptics(nt)%Reflectivity(1,1,1,1) = ONE - SfcOptics(nt)%Emissivity(1,1)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
IF (Opt%Direct_Reflectivity(ln) > ONE) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Direct_Reflectivity(1,1) = ONE
ELSEIF (Opt%Direct_Reflectivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivityless than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Direct_Reflectivity(1,1) = ZERO
ELSE
SfcOptics(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
END IF
ELSE
SfcOptics(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
SfcOptics(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
! ...Repeat for fractional clear-sky case
IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag) ) THEN
SfcOptics_Clear(nt)%Compute = .FALSE.
SfcOptics_Clear(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics_Clear(nt)%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
SfcOptics_Clear(nt)%Emissivity(1,1) = SfcOptics(nt)%Emissivity(1,1)
SfcOptics_Clear(nt)%Reflectivity(1,1,1,1) = ONE - SfcOptics(nt)%Emissivity(1,1)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
IF (Opt%Direct_Reflectivity(ln) > ONE) THEN
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = ONE
ELSEIF (Opt%Direct_Reflectivity(ln) < ZERO) THEN
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = ZERO
ELSE
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
END IF
ELSE
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
Expand Down
70 changes: 49 additions & 21 deletions src/CRTM_Tangent_Linear_Module.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1149,28 +1149,56 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status )
SfcOptics(nt)%Compute = .TRUE.
SfcOptics_Clear(nt)%Compute = .TRUE.
IF ( Opt%Use_Emissivity ) THEN
! ...Cloudy/all-sky case
SfcOptics(nt)%Compute = .FALSE.
SfcOptics(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics(nt)%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
ELSE
SfcOptics(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
! ...Repeat for fractional clear-sky case
IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag) ) THEN
SfcOptics_Clear(nt)%Compute = .FALSE.
SfcOptics_Clear(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
SfcOptics_Clear(nt)%Reflectivity(1,1,1,1) = ONE - Opt%Emissivity(ln)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
ELSE
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
END IF
! ...Cloudy/all-sky case
SfcOptics(nt)%Compute = .FALSE.
IF (Opt%Emissivity(ln) > ONE) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Emissivity(1,1) = ONE
ELSEIF (Opt%Emissivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Emissivity less than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Emissivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Emissivity(1,1) = ZERO
ELSE
SfcOptics(nt)%Emissivity(1,1) = Opt%Emissivity(ln)
END IF
SfcOptics(nt)%Reflectivity(1,1,1,1) = ONE - SfcOptics(nt)%Emissivity(1,1)
IF ( Opt%Use_Direct_Reflectivity ) THEN
IF (Opt%Direct_Reflectivity(ln) > ONE) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivity greater than 1.0: (",G12.3,"). Setting to 1.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Direct_Reflectivity(1,1) = ONE
ELSEIF (Opt%Direct_Reflectivity(ln) < ZERO) THEN
Error_Status = WARNING
WRITE( Message,'("Warning Opt%Direct_Reflectivity less than 0.0: (",G12.3,"). Setting to 0.0.")') &
Opt%Direct_Reflectivity(ln)
CALL Display_Message( ROUTINE_NAME, Message, Error_Status )
SfcOptics(nt)%Direct_Reflectivity(1,1) = ZERO
ELSE
SfcOptics(nt)%Direct_Reflectivity(1,1) = Opt%Direct_Reflectivity(ln)
END IF
ELSE
SfcOptics(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
! ...Repeat for fractional clear-sky case
IF ( CRTM_Atmosphere_IsFractional(cloud_coverage_flag) ) THEN
SfcOptics_Clear(nt)%Compute = .FALSE.
SfcOptics_Clear(nt)%Emissivity(1,1) = SfcOptics(nt)%Emissivity(1,1)
SfcOptics_Clear(nt)%Reflectivity(1,1,1,1) = ONE - SfcOptics(nt)%Emissivity(1,1)
IF ( Opt%Use_Direct_Reflectivity ) THEN
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Direct_Reflectivity(1,1)
ELSE
SfcOptics_Clear(nt)%Direct_Reflectivity(1,1) = SfcOptics(nt)%Reflectivity(1,1,1,1)
END IF
END IF
END IF

! non scattering case, this condition may be changed for future surface reflectance
IF( .not.RTSolution(ln,m)%Scattering_FLAG .or. .not.AtmOptics(nt)%Include_Scattering ) RTV(nt)%n_Azi = 0

Expand Down
Loading

0 comments on commit 1010c09

Please sign in to comment.