! ! CRTM_CloudCover_Define ! ! Module defining the CRTM Cloud Cover object and its methods. ! ! ! CREATION HISTORY: ! Written by: Paul van Delst, 16-Sep-2015 ! paul.vandelst@noaa.gov ! MODULE CRTM_CloudCover_Define ! ----------------- ! Environment setup ! ----------------- ! Intrinsic modules USE ISO_Fortran_Env , ONLY: OUTPUT_UNIT ! Module use USE Type_Kinds , ONLY: fp USE File_Utility , ONLY: File_Open USE Message_Handler , ONLY: SUCCESS, FAILURE, WARNING, INFORMATION, Display_Message USE Compare_Float_Numbers , ONLY: DEFAULT_N_SIGFIG, & OPERATOR(.EqualTo.), & Compares_Within_Tolerance USE CRTM_Parameters , ONLY: ZERO, ONE, & WATER_CONTENT_THRESHOLD USE CRTM_Atmosphere_Define, ONLY: CRTM_Atmosphere_type, & CRTM_Atmosphere_Associated USE CRTM_Cloud_Define , ONLY: OPERATOR(==), & OPERATOR(+), & CRTM_Cloud_type, & CRTM_Cloud_Associated, & CRTM_Cloud_Zero ! Disable implicit typing IMPLICIT NONE ! ------------ ! Visibilities ! ------------ ! Everything private by default PRIVATE ! Parameters PUBLIC :: DEFAULT_OVERLAP_ID ! Datatypes PUBLIC :: CRTM_CloudCover_type ! "Class" methods PUBLIC :: CloudCover_Maximum_Overlap PUBLIC :: CloudCover_Random_Overlap PUBLIC :: CloudCover_MaxRan_Overlap PUBLIC :: CloudCover_Average_Overlap PUBLIC :: CloudCover_Overcast_Overlap PUBLIC :: CloudCover_Overlap_IsValid PUBLIC :: CloudCover_Overlap_Name ! ----------------- ! Module parameters ! ----------------- CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & '$Id: CRTM_CloudCover_Define.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $' ! The valid cloud categories and names ! INTEGER, PARAMETER :: N_OVERLAPS = 4 INTEGER, PARAMETER :: N_OVERLAPS = 5 INTEGER, PARAMETER :: INVALID_OVERLAP_ID = 0 INTEGER, PARAMETER :: MAXIMUM_OVERLAP_ID = 1 INTEGER, PARAMETER :: RANDOM_OVERLAP_ID = 2 INTEGER, PARAMETER :: MAXRAN_OVERLAP_ID = 3 INTEGER, PARAMETER :: AVERAGE_OVERLAP_ID = 4 INTEGER, PARAMETER :: OVERCAST_OVERLAP_ID =5 CHARACTER(*), PARAMETER :: OVERLAP_NAMES(0:N_OVERLAPS) = & [ 'Invalid ', & 'Maximum ', & 'Random ', & 'Maximum-random', & 'Average ', & 'Overcast ' ] INTEGER, PARAMETER :: DEFAULT_OVERLAP_ID = AVERAGE_OVERLAP_ID ! Message string length INTEGER, PARAMETER :: ML = 256 ! File status on close after write error CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' ! ----------------------------- ! CloudCover object definitions ! ----------------------------- ! Private object for intermediate results ! Only used and acessible in this module TYPE, PRIVATE :: iVar_type ! Housekeeping LOGICAL :: Is_Allocated = .FALSE. ! Allocation indicator INTEGER :: n_Layers = 0 ! K dimension. INTEGER :: n_Clouds = 0 ! N dimension. ! Data REAL(fp), ALLOCATABLE :: prod(:) ! 0:K. Product across layers REAL(fp), ALLOCATABLE :: lwc(:) ! 1:K. Total layer water content for ALL clouds REAL(fp), ALLOCATABLE :: wc_sum(:) ! 0:K. Cumulative sum of lwc at each layer REAL(fp), ALLOCATABLE :: cwc_sum(:) ! 0:K. Cumulative sum of the weighted lwc at each layer REAL(fp), ALLOCATABLE :: wc(:,:) ! 1:N 1:K. layer water content for each cloud type REAL(fp), ALLOCATABLE :: maxcov(:) ! 1:K. Max cloud fraction between two layers CONTAINS PROCEDURE, PASS(self) :: Is_Usable => iVar_Is_Usable PROCEDURE, PASS(self) :: Destroy => iVar_Destroy PROCEDURE, PASS(self) :: Create => iVar_Create PROCEDURE, PASS(self) :: Inspect => iVar_Inspect PROCEDURE, PASS(self) :: Set_To_Zero => iVar_Set_To_Zero PROCEDURE :: iVar_Equal PROCEDURE :: iVar_NotEqual PROCEDURE :: iVar_Compare GENERIC :: OPERATOR(==) => iVar_Equal GENERIC :: OPERATOR(/=) => iVar_NotEqual GENERIC :: OPERATOR(.Compare.) => iVar_Compare END TYPE iVar_type ! The main object definition !:tdoc+: TYPE :: CRTM_CloudCover_type ! Housekeeping LOGICAL :: Is_Allocated = .FALSE. ! Allocation indicator INTEGER :: n_Layers = 0 ! K dimension. ! Data INTEGER :: Overlap = DEFAULT_OVERLAP_ID ! Overlap type identifier REAL(fp) :: Total_Cloud_Cover = ZERO ! Cloud cover used in RT REAL(fp), ALLOCATABLE :: Cloud_Fraction(:) ! K. The physical cloud fraction REAL(fp), ALLOCATABLE :: Cloud_Cover(:) ! K. The overlap cloud cover ! Intermediate results TYPE(iVar_type) :: iVar ! FWD results for TL/AD CONTAINS PRIVATE PROCEDURE, PUBLIC, PASS(self) :: Overlap_Id PROCEDURE, PUBLIC, PASS(self) :: Overlap_Name PROCEDURE, PUBLIC, PASS(self) :: Compute_CloudCover PROCEDURE, PUBLIC, PASS(self_TL) :: Compute_CloudCover_TL PROCEDURE, PUBLIC, PASS(self_AD) :: Compute_CloudCover_AD PROCEDURE, PUBLIC, PASS(self) :: Is_Usable PROCEDURE, PUBLIC, PASS(self) :: Destroy PROCEDURE, PUBLIC, PASS(self) :: Create PROCEDURE, PUBLIC, PASS(self) :: Inspect PROCEDURE, PUBLIC, PASS(self) :: Set_To_Zero PROCEDURE :: Equal PROCEDURE :: NotEqual PROCEDURE :: Compare_ GENERIC, PUBLIC :: OPERATOR(==) => Equal GENERIC, PUBLIC :: OPERATOR(/=) => NotEqual GENERIC, PUBLIC :: OPERATOR(.Compare.) => Compare_ END TYPE CRTM_CloudCover_type !:tdoc-: CONTAINS !################################################################################ !################################################################################ !## ## !## ## PUBLIC MODULE PROCEDURES ## ## !## ## !################################################################################ !################################################################################ !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCover_Maximum_Overlap ! CloudCover_Random_Overlap ! CloudCover_MaxRan_Overlap ! CloudCover_Average_Overlap ! CloudCover_Overcast_Overlap ! ! PURPOSE: ! Group of pure functions to supply the overlap methodology indicator. ! ! CALLING SEQUENCE: ! id = CloudCover_Maximum_Overlap() ! id = CloudCover_Random_Overlap() ! id = CloudCover_MaxRan_Overlap() ! id = CloudCover_Average_Overlap() ! id = CloudCover_Overcast_Overlap() ! ! FUNCTION RESULT: ! id: The return value is an integer defining the overlap methodology. ! The actual number value of these integers in a CRTM release can ! change at any time based upon code updates. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- PURE FUNCTION CloudCover_Maximum_Overlap() RESULT(id) INTEGER :: id id = MAXIMUM_OVERLAP_ID END FUNCTION CloudCover_Maximum_Overlap PURE FUNCTION CloudCover_Random_Overlap() RESULT(id) INTEGER :: id id = RANDOM_OVERLAP_ID END FUNCTION CloudCover_Random_Overlap PURE FUNCTION CloudCover_MaxRan_Overlap() RESULT(id) INTEGER :: id id = MAXRAN_OVERLAP_ID END FUNCTION CloudCover_MaxRan_Overlap PURE FUNCTION CloudCover_Average_Overlap() RESULT(id) INTEGER :: id id = AVERAGE_OVERLAP_ID END FUNCTION CloudCover_Average_Overlap PURE FUNCTION CloudCover_Overcast_Overlap() RESULT(id) INTEGER :: id id = OVERCAST_OVERLAP_ID END FUNCTION CloudCover_Overcast_Overlap !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCover_Overlap_IsValid ! ! PURPOSE: ! Pure function to test if an overlap methodology identifier is valid. ! ! CALLING SEQUENCE: ! is_valid = CloudCover_Overlap_IsValid( id ) ! ! INPUTS: ! id: The overlap methodology identifier. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! is_valid: Logical variable indicating whether or not the input overlap ! methodology identifier is valid. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- PURE FUNCTION CloudCover_Overlap_IsValid(id) RESULT(is_valid) INTEGER, INTENT(IN) :: id LOGICAL :: is_valid is_valid = (id >= 1 .AND. id <= N_OVERLAPS) END FUNCTION CloudCover_Overlap_IsValid !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCover_Overlap_Name ! ! PURPOSE: ! Pure function to return a string description of the overlap methodology ! given its identifier. ! ! CALLING SEQUENCE: ! name = CloudCover_Overlap_Name( id ) ! ! INPUTS: ! id: The overlap methodology identifier. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! name: Character variable containing a short descriptor of the overlap ! methodology. If the input identifier is invalid, the returned ! string is "Invalid". ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- PURE FUNCTION CloudCover_Overlap_Name(id) RESULT(name) INTEGER, INTENT(IN) :: id CHARACTER(LEN(OVERLAP_NAMES(1))) :: name IF ( CloudCover_Overlap_IsValid(id) ) THEN name = OVERLAP_NAMES(id) ELSE name = OVERLAP_NAMES(INVALID_OVERLAP_ID) END IF END FUNCTION CloudCover_Overlap_Name !################################################################################ !################################################################################ !## ## !## ## PUBLIC MODULE METHODS ## ## !## ## !################################################################################ !################################################################################ !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Overlap_Id ! ! PURPOSE: ! Function method to return the overlap methodology identifier of a ! CloudCover object. ! ! CALLING SEQUENCE: ! id = cc_obj%Overlap_Id() ! ! OBJECTS: ! cc_obj: Cloud cover object for which the overlap methodology identifier ! is required. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! ! FUNCTION RESULT: ! id: The return value is an integer defining the overlap methodology. ! The actual number value of these integers in a CRTM release can ! change at any time based upon code updates. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- PURE FUNCTION Overlap_Id(self) RESULT(id) CLASS(CRTM_CloudCover_type), INTENT(IN) :: self INTEGER :: id id = self%Overlap IF ( id < 1 .OR. id > N_OVERLAPS ) id = INVALID_OVERLAP_ID END FUNCTION Overlap_Id !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Overlap_Name ! ! PURPOSE: ! Function method to return a string description of the overlap methodology ! that has been set for a CloudCover object. ! ! CALLING SEQUENCE: ! name = cc_obj%Overlap_Name() ! ! OBJECTS: ! cc_obj: Cloud cover object for which the overlap methodology descriptor ! is required. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! name: Character variable containing a short descriptor of the overlap ! methodology. If the object's overlap methodology identifier is ! invalid, the returned string is "Invalid". ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- PURE FUNCTION Overlap_Name(self) RESULT(name) CLASS(CRTM_CloudCover_type), INTENT(IN) :: self CHARACTER(LEN(OVERLAP_NAMES(1))) :: name name = OVERLAP_NAMES(self%Overlap_Id()) END FUNCTION Overlap_Name !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Compute_CloudCover ! ! PURPOSE: ! Function method to compute the cloud cover profile given a supplied ! Atmosphere object, and populate the CloudCover object with the ! results. ! ! CALLING SEQUENCE: ! err_stat = cc_obj%Compute_CloudCover( & ! atmosphere , & ! Overlap = overlap ) ! ! OBJECTS: ! cc_obj: Cloud cover object which is to be populated with cloud ! cover results. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! atmosphere: Atmopshere object containing the layer cloud fraction ! profile, and the actual cloud profiles for when cloud ! water content averaging of the cloud cover is selected. ! UNITS: N/A ! TYPE: CRTM_Atmosphere_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL INPUTS: ! overlap: Set this argument to a flag defining the cloud coverage ! algorithm used. Supplied module functions providing valid flag ! output are: ! CloudCover_Maximum_Overlap(): Use maximum overlap method. ! CloudCover_Random_Overlap() : Use random overlap method. ! CloudCover_MaxRan_Overlap() : Use maximum-random overlap method. ! CloudCover_Average_Overlap(): Use cloud content weighted averaged method. [DEFAULT] ! CloudCover_Overcast_Overlap():Overcast. [Test] ! If not specified, the default is the cloud content weighted ! averaged method ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! FUNCTION RESULT: ! err_stat: The return value is an integer defining the error status. ! The error codes are defined in the Message_Handler module. ! If == SUCCESS, the computation was successful ! == FAILURE, an unrecoverable error occurred. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- FUNCTION Compute_CloudCover( & self , & ! Output atm , & ! In/Output overlap) & ! Optional input RESULT(err_stat) ! Arguments CLASS(CRTM_CloudCover_type), INTENT(OUT) :: self TYPE(CRTM_Atmosphere_type) , INTENT(INOUT):: atm INTEGER, OPTIONAL, INTENT(IN) :: overlap ! Function result INTEGER :: err_stat ! Local parameters CHARACTER(*), PARAMETER :: PROCEDURE_NAME = 'CRTM_CloudCover_Define::Compute_CloudCover' REAL(fp), PARAMETER :: MIN_COVERAGE_THRESHOLD = 1.0e-06_fp REAL(fp), PARAMETER :: MAX_COVERAGE_THRESHOLD = ONE - MIN_COVERAGE_THRESHOLD ! Local variables CHARACTER(ML) :: err_msg INTEGER :: overlap_method INTEGER :: n_layers INTEGER :: n_clouds INTEGER :: n ! Check input err_stat = SUCCESS IF ( .NOT. CRTM_Atmosphere_Associated(atm) ) THEN err_msg = 'Input atmosphere is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF ! ...Overlap keyword overlap_method = DEFAULT_OVERLAP_ID IF ( PRESENT(overlap) ) overlap_method = overlap ! ...and check it. IF ( .NOT. CloudCover_Overlap_IsValid(overlap_method) ) THEN err_msg = 'Invalid overlap assumption' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF ! Create the output object n_layers = Atm%n_Layers n_clouds = Atm%n_Clouds ! CALL self%Create(n_layers, Forward = .TRUE., Error_Message = err_msg) CALL self%Create(n_layers, n_clouds, Forward = .TRUE., Error_Message = err_msg) IF ( .NOT. self%Is_Usable() ) THEN err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF ! Set the object quantities self%Overlap = overlap_method self%Cloud_Fraction = atm%Cloud_Fraction(1:atm%n_Layers) DO n = 1, n_clouds self%iVar%wc(n,1:n_layers) = atm%Cloud(n)%Water_Content(1:n_layers) ! save for TL/AD END DO ! Compute the cloud cover SELECT CASE (self%Overlap) CASE (MAXIMUM_OVERLAP_ID); CALL Compute_Maximum_Overlap() CASE (RANDOM_OVERLAP_ID) ; CALL Compute_Random_Overlap() CASE (MAXRAN_OVERLAP_ID) ; CALL Compute_MaxRan_Overlap() CASE (AVERAGE_OVERLAP_ID); CALL Compute_Average_Overlap() CASE (OVERCAST_OVERLAP_ID);CALL Compute_Overcast_Overlap() END SELECT ! Add cloud scaling here! ! Partition all hydrometeors into cloudy column IF (self%Total_Cloud_Cover > MIN_COVERAGE_THRESHOLD) then DO n = 1, n_clouds ! scaled cloud water content atm%Cloud(n)%Water_Content(1:n_layers) = atm%Cloud(n)%Water_Content(1:n_layers) / self%Total_Cloud_Cover END DO END IF CONTAINS SUBROUTINE Compute_Maximum_Overlap() INTEGER :: k self%Cloud_Cover(1) = self%Cloud_Fraction(1) DO k = 2, n_layers IF ( self%Cloud_Fraction(k) > self%Cloud_Cover(k-1) ) THEN self%Cloud_Cover(k) = self%Cloud_Fraction(k) ELSE self%Cloud_Cover(k) = self%Cloud_Cover(k-1) END IF END DO self%Total_Cloud_Cover = self%Cloud_Cover(n_layers) END SUBROUTINE Compute_Maximum_Overlap ! SUBROUTINE Compute_Random_Overlap() ! INTEGER :: k ! REAL(fp) :: prod ! prod = ONE ! self%iVar%prod(0) = prod ! DO k = 1, n_layers ! prod = prod * (ONE - self%Cloud_Fraction(k)) ! self%Cloud_Cover(k) = ONE - prod ! self%iVar%prod(k) = prod ! Save for TL/AD ! END DO ! self%Total_Cloud_Cover = self%Cloud_Cover(n_layers) ! END SUBROUTINE Compute_Random_Overlap SUBROUTINE Compute_Random_Overlap() INTEGER :: k REAL(fp) :: prod(0:n_layers) prod(0) = ONE self%iVar%prod(0) = prod(0) DO k = 1, n_layers if (self%Cloud_Fraction(k) > MIN_COVERAGE_THRESHOLD) then prod(k) = prod(k-1) * (ONE - self%Cloud_Fraction(k)) else prod(k) = prod(k-1) endif self%Cloud_Cover(k) = ONE - prod(k) self%iVar%prod(k) = prod(k) ! Save for TL/AD END DO self%Total_Cloud_Cover = self%Cloud_Cover(n_layers) END SUBROUTINE Compute_Random_Overlap ! SUBROUTINE Compute_MaxRan_Overlap() ! INTEGER :: k ! REAL(fp) :: prod ! prod = ONE - self%Cloud_Fraction(1) ! self%iVar%prod(1) = prod ! self%Cloud_Cover(1) = ONE - prod ! DO k = 2, n_layers ! IF ( self%Cloud_Fraction(k) > self%Cloud_Fraction(k-1) ) THEN ! prod = prod * (ONE - self%Cloud_Fraction(k)) / (ONE - self%Cloud_Fraction(k-1)) ! END IF ! self%Cloud_Cover(k) = ONE - prod ! self%iVar%prod(k) = prod ! Save for TL/AD ! END DO ! self%Total_Cloud_Cover = self%Cloud_Cover(n_layers) ! END SUBROUTINE Compute_MaxRan_Overlap SUBROUTINE Compute_MaxRan_Overlap() INTEGER :: k REAL(fp) :: prod, maxcov prod = ONE - self%Cloud_Fraction(1) self%Cloud_Cover(1) = ONE - prod self%iVar%prod(1) = prod self%iVar%maxcov(1) = ONE - self%Cloud_Fraction(1) DO k= 2, n_layers maxcov = (ONE - MAX(self%Cloud_Fraction(k-1), self%Cloud_Fraction(k))) prod = prod * maxcov / (one - self%Cloud_Fraction(k-1)) self%iVar%maxcov(k) = maxcov self%iVar%prod(k) = prod self%Cloud_Cover(k) = ONE - prod ENDDO self%Total_Cloud_Cover = self%Cloud_Cover(n_layers) END SUBROUTINE Compute_MaxRan_Overlap SUBROUTINE Compute_Average_Overlap() INTEGER :: k, n ! Give the variables shorter names ASSOCIATE( lwc => self%iVar%lwc , & wc_sum => self%iVar%wc_sum , & cwc_sum => self%iVar%cwc_sum , & cf => self%Cloud_Fraction, & cc => self%Cloud_Cover , & cloud => atm%Cloud ) ! The total layer water content lwc = ZERO DO n = 1, SIZE(cloud) WHERE (cloud(n)%Water_Content > WATER_CONTENT_THRESHOLD ) & lwc = lwc + cloud(n)%Water_Content(1:n_layers) END DO ! The cloud cover profile wc_sum(0) = ZERO cwc_sum(0) = ZERO DO k = 1, n_layers wc_sum(k) = wc_sum(k-1) + lwc(k) cwc_sum(k) = cwc_sum(k-1) + (cf(k) * lwc(k)) IF ( wc_sum(k) > ZERO ) cc(k) = cwc_sum(k)/wc_sum(k) END DO END ASSOCIATE ! Extract out the total cloud cover self%Total_Cloud_Cover = self%Cloud_Cover(n_layers) END SUBROUTINE Compute_Average_Overlap SUBROUTINE Compute_Overcast_Overlap() self%Total_Cloud_Cover = ONE END SUBROUTINE Compute_Overcast_Overlap END FUNCTION Compute_CloudCover !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Compute_CloudCover_TL ! ! PURPOSE: ! Function method to compute the tangent-linear cloud cover profile for ! supplied forward model results and a Atmosphere perturbation, and populate ! the tangent-linear CloudCover object with the results. ! ! CALLING SEQUENCE: ! err_stat = cc_obj_TL%Compute_CloudCover_TL( & ! cc_FWD , & ! atmosphere , & ! atmosphere_TL ) ! ! OBJECTS: ! cc_obj_TL: The tangent-linear cloud cover object which is to be ! populated with perturbed cloud cover results. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! cc_FWD: The forward model cloud cover object. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! atmosphere: Atmopshere object containing the layer cloud fraction ! profile, and the actual cloud profiles for when cloud ! water content averaging of the cloud cover is selected. ! UNITS: N/A ! TYPE: CRTM_Atmosphere_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! atmosphere_TL: The tangent-linear atmosphere object containing the layer ! cloud fraction perturbation profile, and the cloud amount ! perturbation profiles for when cloud water content averaging ! of the cloud cover is selected. ! UNITS: N/A ! TYPE: CRTM_Atmosphere_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! err_stat: The return value is an integer defining the error status. ! The error codes are defined in the Message_Handler module. ! If == SUCCESS, the computation was successful ! == FAILURE, an unrecoverable error occurred. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- FUNCTION Compute_CloudCover_TL( & self_TL, & ! Output cc_FWD , & ! Input atm , & ! Input atm_TL ) & ! In/Outupt RESULT(err_stat) ! Arguments CLASS(CRTM_CloudCover_type), INTENT(OUT) :: self_TL CLASS(CRTM_CloudCover_type), INTENT(IN) :: cc_FWD TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: atm TYPE(CRTM_Atmosphere_type) , INTENT(INOUT):: atm_TL ! Function result INTEGER :: err_stat ! Local parameters CHARACTER(*), PARAMETER :: PROCEDURE_NAME = 'CRTM_CloudCover_Define::Compute_CloudCover_TL' REAL(fp), PARAMETER :: MIN_COVERAGE_THRESHOLD = 1.0e-06_fp REAL(fp), PARAMETER :: MAX_COVERAGE_THRESHOLD = ONE - MIN_COVERAGE_THRESHOLD ! Local variables CHARACTER(ML) :: err_msg INTEGER :: n_layers INTEGER :: n_clouds INTEGER :: n ! Check inputs err_stat = SUCCESS IF ( .NOT. cc_FWD%Is_Usable( Include_iVar=.TRUE. ) ) THEN err_msg = 'Input forward cloud cover object is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF IF ( .NOT. CRTM_Atmosphere_Associated(atm) ) THEN err_msg = 'Input atmosphere object is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF IF ( .NOT. CRTM_Atmosphere_Associated(atm_TL) ) THEN err_msg = 'Input tangent-linear atmosphere object is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF ! Create the output object n_layers = Atm_TL%n_Layers n_clouds = Atm_TL%n_Clouds ! CALL self_TL%Create(n_layers, Error_Message = err_msg) CALL self_TL%Create(n_layers, n_clouds, Error_Message = err_msg) IF ( .NOT. self_TL%Is_Usable() ) THEN err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF ! Set the object quantities self_TL%Overlap = cc_FWD%Overlap self_TL%Cloud_Fraction = atm_TL%Cloud_Fraction(1:atm_TL%n_Layers) ! Compute the cloud cover SELECT CASE (self_TL%Overlap) CASE (MAXIMUM_OVERLAP_ID); CALL Compute_Maximum_Overlap_TL() CASE (RANDOM_OVERLAP_ID) ; CALL Compute_Random_Overlap_TL() CASE (MAXRAN_OVERLAP_ID) ; CALL Compute_MaxRan_Overlap_TL() CASE (AVERAGE_OVERLAP_ID); CALL Compute_Average_Overlap_TL() CASE (OVERCAST_OVERLAP_ID);CALL Compute_Overcast_Overlap_TL() END SELECT ! Add TL of cloud scaling here! ! Partition all hydrometeors into cloudy column IF (cc_FWD%Total_Cloud_Cover > MIN_COVERAGE_THRESHOLD) then DO n = 1, n_clouds atm_TL%Cloud(n)%Water_Content(1:n_layers) = & atm_TL%Cloud(n)%Water_Content(1:n_layers) / cc_FWD%Total_Cloud_Cover & - self_TL%Total_Cloud_Cover * cc_FWD%iVar%wc(n,1:n_layers) / (cc_FWD%Total_Cloud_Cover**2) END DO END IF CONTAINS SUBROUTINE Compute_Maximum_Overlap_TL() INTEGER :: k self_TL%Cloud_Cover(1) = self_TL%Cloud_Fraction(1) DO k = 2, n_layers IF ( cc_FWD%Cloud_Fraction(k) > cc_FWD%Cloud_Cover(k-1) ) THEN self_TL%Cloud_Cover(k) = self_TL%Cloud_Fraction(k) ELSE self_TL%Cloud_Cover(k) = self_TL%Cloud_Cover(k-1) END IF END DO self_TL%Total_Cloud_Cover = self_TL%Cloud_Cover(n_layers) END SUBROUTINE Compute_Maximum_Overlap_TL ! SUBROUTINE Compute_Random_Overlap_TL() ! INTEGER :: k ! REAL(fp) :: prod_TL ! prod_TL = ZERO ! DO k = 1, n_layers ! prod_TL = (ONE - cc_FWD%Cloud_Fraction(k))*prod_TL - & ! cc_FWD%iVar%prod(k-1)*self_TL%Cloud_Fraction(k) ! self_TL%Cloud_Cover(k) = -prod_TL ! END DO ! self_TL%Total_Cloud_Cover = self_TL%Cloud_Cover(n_layers) ! END SUBROUTINE Compute_Random_Overlap_TL SUBROUTINE Compute_Random_Overlap_TL() INTEGER :: k REAL(fp) :: prod_TL(0:n_layers) prod_TL = ZERO prod_TL(0) = ZERO DO k = 1, n_layers if (cc_FWD%Cloud_Fraction(k) > MIN_COVERAGE_THRESHOLD) then prod_TL(k) = (ONE - cc_FWD%Cloud_Fraction(k))*prod_TL(k-1) - & cc_FWD%iVar%prod(k-1)*self_TL%Cloud_Fraction(k) else prod_TL(k) = prod_TL(k-1) endif self_TL%Cloud_Cover(k) = -prod_TL(k) END DO self_TL%Total_Cloud_Cover = self_TL%Cloud_Cover(n_layers) END SUBROUTINE Compute_Random_Overlap_TL ! SUBROUTINE Compute_MaxRan_Overlap_TL() ! INTEGER :: k ! REAL(fp) :: prod_TL, denom ! ! ! Give the variables shorter names ! ASSOCIATE( prod => cc_FWD%iVar%prod , & ! cf => cc_FWD%Cloud_Fraction , & ! cf_TL => self_TL%Cloud_Fraction, & ! cc_TL => self_TL%Cloud_Cover ) ! ! ! The cloud cover profile ! prod_TL = -cf_TL(1) ! cc_TL(1) = -prod_TL ! == self_TL%Cloud_Fraction(1) ! DO k = 2, n_layers ! IF ( cf(k) > cf(k-1) ) THEN ! !>>orig ! denom = ONE/(ONE - cf(k-1)) ! prod_TL = ((ONE - cf(k)) * denom * prod_TL) - & ! (prod(k-1) * denom * cf_TL(k) ) + & ! (prod(k-1) * (ONE - cf(k)) * denom**2 * cf_TL(k-1)) ! !<>test ! ! prod_TL = ( ((ONE - cf(k)) / (ONE - cf(k-1))) * prod_TL ) - & ! ! ( (prod(k-1) / (ONE - cf(k-1))) * cf_TL(k) ) + & ! ! ( ((prod(k-1) * (ONE - cf(k))) / (ONE - cf(k-1))**2) * cf_TL(k-1) ) ! !< cc_FWD%Cloud_Fraction(k))) THEN maxcov_TL = -self_TL%Cloud_Fraction(k-1) ELSE IF ((cc_FWD%Cloud_Fraction(k-1) < cc_FWD%Cloud_Fraction(k))) THEN maxcov_TL = -self_TL%Cloud_Fraction(k) ELSE IF ((CC_FWD%Cloud_Fraction(k-1) == cc_FWD%Cloud_Fraction(k))) THEN maxcov_TL = -self_TL%Cloud_Fraction(k) ENDIF prod_TL = prod_TL * cc_FWD%iVar%maxcov(k) / (one - cc_FWD%Cloud_Fraction(k-1)) + & & self_TL%Cloud_Fraction(k-1) * cc_FWD%iVar%prod(k-1) * cc_FWD%iVar%maxcov(k) / & & (one - cc_FWD%Cloud_Fraction(k-1)) ** 2 + & & maxcov_TL * cc_FWD%iVar%prod(k-1) / (one - cc_FWD%Cloud_Fraction(k-1)) self_TL%Cloud_Cover(k) = -prod_TL ENDDO self_TL%Total_Cloud_Cover = self_TL%Cloud_Cover(n_layers) END SUBROUTINE Compute_MaxRan_Overlap_TL SUBROUTINE Compute_Average_Overlap_TL() INTEGER :: k, n REAL(fp) :: lwc_TL(n_Layers), wc_sum_TL(0:n_Layers), cwc_sum_TL(0:n_Layers) REAL(fp) :: denom ! Give the variables shorter names ASSOCIATE( lwc => cc_FWD%iVar%lwc , & wc_sum => cc_FWD%iVar%wc_sum , & cwc_sum => cc_FWD%iVar%cwc_sum , & cf => cc_FWD%Cloud_Fraction , & cc => cc_FWD%Cloud_Cover , & ! cloud => atm%Cloud , & !orig cloud => cc_FWD%iVar%wc , & cf_TL => self_TL%Cloud_Fraction, & cc_TL => self_TL%Cloud_Cover , & cloud_TL => atm_TL%Cloud ) ! The total layer water content lwc_TL = ZERO DO n = 1, atm_TL%n_Clouds ! WHERE (cloud(n)%Water_Content(1:n_layers) > WATER_CONTENT_THRESHOLD ) & !orig WHERE (cloud(n,1:n_layers) > WATER_CONTENT_THRESHOLD ) & lwc_TL = lwc_TL + cloud_TL(n)%Water_Content(1:n_layers) END DO ! The cloud cover profile wc_sum_TL(0) = ZERO cwc_sum_TL(0) = ZERO DO k = 1, n_layers wc_sum_TL(k) = wc_sum_TL(k-1) + lwc_TL(k) cwc_sum_TL(k) = cwc_sum_TL(k-1) + (cf(k) * lwc_TL(k)) + (lwc(k) * cf_TL(k)) IF ( wc_sum(k) > ZERO ) THEN denom = ONE/wc_sum(k) cc_TL(k) = (denom * cwc_sum_TL(k)) - & (denom**2 * cwc_sum(k) * wc_sum_TL(k) ) END IF END DO END ASSOCIATE ! Extract out the tangent-linear total cloud cover self_TL%Total_Cloud_Cover = self_TL%Cloud_Cover(n_layers) END SUBROUTINE Compute_Average_Overlap_TL SUBROUTINE Compute_Overcast_Overlap_TL() self_TL%Total_Cloud_Cover = ZERO END SUBROUTINE Compute_Overcast_Overlap_TL END FUNCTION Compute_CloudCover_TL !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Compute_CloudCover_AD ! ! PURPOSE: ! Function method to compute the adjoint cloud cover profile for supplied ! forward model results and populate the Atmosphere adjoint object ! with the results. ! ! CALLING SEQUENCE: ! err_stat = cc_obj_AD%Compute_CloudCover_AD( & ! cc_FWD , & ! atmosphere , & ! atmosphere_AD ) ! ! OBJECTS: ! cc_obj_AD: The adjoint cloud cover object. This object contains ! data on input, but is zeroed out upon output. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! ! INPUTS: ! cc_FWD: The forward model cloud cover object. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! atmosphere: Atmopshere object containing the layer cloud fraction ! profile, and the actual cloud profiles for when cloud ! water content averaging of the cloud cover is selected. ! UNITS: N/A ! TYPE: CRTM_Atmosphere_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OUTPUTS: ! atmosphere_AD: The adjoint atmosphere object containing the results of the ! adjoint calculation. The adjoint cloud fraction profile ! will be modified on output. For the weighted average cloud ! clover method, the adjoint cloud water amounts will also be ! modified. ! UNITS: N/A ! TYPE: CRTM_Atmosphere_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! ! FUNCTION RESULT: ! err_stat: The return value is an integer defining the error status. ! The error codes are defined in the Message_Handler module. ! If == SUCCESS, the computation was successful ! == FAILURE, an unrecoverable error occurred. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !-------------------------------------------------------------------------------- FUNCTION Compute_CloudCover_AD( & self_AD, & ! Input, but modified on output cc_FWD , & ! Input atm , & ! Input atm_AD ) & ! Output, but contains information on input RESULT(err_stat) ! Arguments CLASS(CRTM_CloudCover_type), INTENT(IN OUT) :: self_AD CLASS(CRTM_CloudCover_type), INTENT(IN) :: cc_FWD TYPE(CRTM_Atmosphere_type) , INTENT(IN) :: atm TYPE(CRTM_Atmosphere_type) , INTENT(IN OUT) :: atm_AD ! Function result INTEGER :: err_stat ! Local parameters CHARACTER(*), PARAMETER :: PROCEDURE_NAME = 'CRTM_CloudCover_Define::Compute_CloudCover_AD' REAL(fp), PARAMETER :: MIN_COVERAGE_THRESHOLD = 1.0e-06_fp REAL(fp), PARAMETER :: MAX_COVERAGE_THRESHOLD = ONE - MIN_COVERAGE_THRESHOLD ! Local variables CHARACTER(ML) :: err_msg INTEGER :: n_layers INTEGER :: n_clouds INTEGER :: n REAL(fp):: sum_wc ! Check inputs err_stat = SUCCESS IF ( .NOT. self_AD%Is_Usable() ) THEN err_msg = 'In/output adjoint cloud cover object is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF IF ( .NOT. cc_FWD%Is_Usable( Include_iVar=.TRUE. ) ) THEN err_msg = 'Input forward cloud cover object is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF IF ( .NOT. CRTM_Atmosphere_Associated(atm) ) THEN err_msg = 'Input atmosphere object is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF IF ( .NOT. CRTM_Atmosphere_Associated(atm_AD) ) THEN err_msg = 'In/output adjoint atmosphere object is not usable' err_stat = FAILURE CALL Display_Message(PROCEDURE_NAME, err_msg, err_stat); RETURN END IF ! Set the object quantities n_layers = atm_AD%n_Layers n_clouds = atm_AD%n_Clouds self_AD%Overlap = cc_FWD%Overlap ! Add AD of cloud scaling here! ! Partition all hydrometeors into cloudy column IF (cc_FWD%Total_Cloud_Cover > MIN_COVERAGE_THRESHOLD) then sum_wc = ZERO DO n = 1, n_clouds sum_wc = sum_wc & + SUM(atm_AD%Cloud(n)%Water_Content(1:n_layers) * cc_FWD%iVar%wc(n,1:n_layers)) ENDDO sum_wc = sum_wc / (cc_FWD%Total_Cloud_Cover**2) !>>test ! sum_wc = ZERO ! DO n = 1, n_clouds ! sum_wc = sum_wc & ! + SUM( (atm_AD%Cloud(n)%Water_Content(1:n_layers) / cc_FWD%Total_Cloud_Cover) & ! * (cc_FWD%iVar%wc(n,1:n_layers) / cc_FWD%Total_Cloud_Cover) ) ! ENDDO !< cc_FWD%Cloud_Cover(k-1) ) THEN self_AD%Cloud_Fraction(k) = self_AD%Cloud_Fraction(k) + self_AD%Cloud_Cover(k) ELSE self_AD%Cloud_Cover(k-1) = self_AD%Cloud_Cover(k-1) + self_AD%Cloud_Cover(k) END IF self_AD%Cloud_Cover(k) = ZERO END DO self_AD%Cloud_Fraction(1) = self_AD%Cloud_Fraction(1) + self_AD%Cloud_Cover(1) self_AD%Cloud_Cover(1) = ZERO END SUBROUTINE Compute_Maximum_Overlap_AD ! SUBROUTINE Compute_Random_Overlap_AD() ! INTEGER :: k ! REAL(fp) :: prod_AD ! prod_AD = ZERO ! self_AD%Cloud_Cover(n_layers) = self_AD%Cloud_Cover(n_layers) + self_AD%Total_Cloud_Cover ! self_AD%Total_Cloud_Cover = ZERO ! DO k = n_layers, 1, -1 ! prod_AD = prod_AD - self_AD%Cloud_Cover(k) ! self_AD%Cloud_Cover(k) = ZERO ! self_AD%Cloud_Fraction(k) = self_AD%Cloud_Fraction(k) - (cc_FWD%iVar%prod(k-1)*prod_AD) ! prod_AD = (ONE - cc_FWD%Cloud_Fraction(k))*prod_AD ! END DO ! prod_AD = ZERO ! END SUBROUTINE Compute_Random_Overlap_AD SUBROUTINE Compute_Random_Overlap_AD() INTEGER :: k REAL(fp) :: prod_AD(0:n_layers) prod_AD = ZERO prod_AD(n_layers) = ZERO self_AD%Cloud_Cover(n_layers) = self_AD%Cloud_Cover(n_layers) + self_AD%Total_Cloud_Cover self_AD%Total_Cloud_Cover = ZERO DO k = n_layers, 1, -1 prod_AD(k) = prod_AD(k) - self_AD%Cloud_Cover(k) self_AD%Cloud_Cover(k) = ZERO if (cc_FWD%Cloud_Fraction(k) > MIN_COVERAGE_THRESHOLD) then self_AD%Cloud_Fraction(k) = self_AD%Cloud_Fraction(k) - (cc_FWD%iVar%prod(k-1)*prod_AD(k)) prod_AD(k-1) = prod_AD(k-1)+(ONE - cc_FWD%Cloud_Fraction(k))*prod_AD(k) prod_AD(k) = ZERO else prod_AD(k-1) = prod_AD(k-1)+ prod_AD(k) prod_AD(k) = ZERO endif END DO prod_AD(0) = ZERO END SUBROUTINE Compute_Random_Overlap_AD ! SUBROUTINE Compute_MaxRan_Overlap_AD() ! INTEGER :: k ! REAL(fp) :: prod_AD, denom ! prod_AD = ZERO ! self_AD%Cloud_Cover(n_layers) = self_AD%Cloud_Cover(n_layers) + self_AD%Total_Cloud_Cover ! self_AD%Total_Cloud_Cover = ZERO ! DO k = n_layers, 2, -1 ! prod_AD = prod_AD - self_AD%Cloud_Cover(k) ! self_AD%Cloud_Cover(k) = ZERO ! IF ( cc_FWD%Cloud_Fraction(k) > cc_FWD%Cloud_Fraction(k-1) ) THEN ! denom = ONE/(ONE - cc_FWD%Cloud_Fraction(k-1)) ! self_AD%Cloud_Fraction(k-1) = self_AD%Cloud_Fraction(k-1) + & ! (cc_FWD%iVar%prod(k-1) * (ONE - cc_FWD%Cloud_Fraction(k)) * denom**2 * prod_AD) ! self_AD%Cloud_Fraction(k) = self_AD%Cloud_Fraction(k) - & ! (cc_FWD%iVar%prod(k-1) * denom * prod_AD) ! prod_AD = (ONE - cc_FWD%Cloud_Fraction(k)) * denom * prod_AD ! END IF ! END DO ! prod_AD = prod_AD - self_AD%Cloud_Cover(1) ! self_AD%Cloud_Cover(1) = ZERO ! self_AD%Cloud_Fraction(1) = self_AD%Cloud_Fraction(1) - prod_AD ! prod_AD = ZERO ! END SUBROUTINE Compute_MaxRan_Overlap_AD SUBROUTINE Compute_MaxRan_Overlap_AD() INTEGER :: k REAL(fp) :: prod_AD REAL(fp) :: maxcov_AD prod_AD = ZERO maxcov_AD = ZERO self_AD%Cloud_Cover(n_layers) = self_AD%Cloud_Cover(n_layers) + self_AD%Total_Cloud_Cover self_AD%Total_Cloud_Cover = ZERO DO k = n_layers, 2, - 1 prod_AD = prod_AD - self_AD%Cloud_Cover(k) self_AD%Cloud_Cover(k) = ZERO self_AD%Cloud_Fraction(k-1) = self_AD%Cloud_Fraction(k-1) + & & prod_AD * cc_FWD%iVar%prod(k-1) * cc_FWD%iVar%maxcov(k) / (one - cc_FWD%Cloud_Fraction(k-1)) ** 2 maxcov_AD = & & maxcov_AD + prod_AD * cc_FWD%iVar%prod(k-1) / (one - cc_FWD%Cloud_Fraction(k-1)) prod_AD = & & prod_AD * cc_FWD%iVar%maxcov(k) / (one - cc_FWD%Cloud_Fraction(k-1)) IF ((cc_FWD%Cloud_Fraction(k-1) > cc_FWD%Cloud_Fraction(k))) THEN self_AD%Cloud_Fraction(k-1) = self_AD%Cloud_Fraction(k-1) - maxcov_AD maxcov_AD = zero ELSE IF ((cc_FWD%Cloud_Fraction(k-1) < cc_FWD%Cloud_Fraction(k))) THEN self_AD%Cloud_Fraction(k) = self_AD%Cloud_Fraction(k) - maxcov_AD maxcov_AD = zero ELSE IF ((cc_FWD%Cloud_Fraction(k-1) == cc_FWD%Cloud_Fraction(k))) THEN self_AD%Cloud_Fraction(k) = self_AD%Cloud_Fraction(k) - maxcov_AD maxcov_AD = ZERO ENDIF ENDDO prod_AD = prod_AD - maxcov_AD self_AD%Cloud_Cover(1) = ZERO self_AD%Cloud_Fraction(1) = self_AD%Cloud_Fraction(1) - prod_AD prod_AD = ZERO END SUBROUTINE Compute_MaxRan_Overlap_AD SUBROUTINE Compute_Average_Overlap_AD() INTEGER :: k, n REAL(fp) :: lwc_AD(n_Layers), wc_sum_AD(0:n_Layers), cwc_sum_AD(0:n_Layers) REAL(fp) :: denom ! Initialise local adjoint variables lwc_AD = ZERO wc_sum_AD = ZERO cwc_sum_AD = ZERO ! Adjoint of the total cloud cover self_AD%Cloud_Cover(n_layers) = self_AD%Cloud_Cover(n_layers) + self_AD%Total_Cloud_Cover self_AD%Total_Cloud_Cover = ZERO ! Adjoint of the cloud cover profile ASSOCIATE( lwc => cc_FWD%iVar%lwc , & wc_sum => cc_FWD%iVar%wc_sum , & cwc_sum => cc_FWD%iVar%cwc_sum , & cf => cc_FWD%Cloud_Fraction , & ! cloud => atm%Cloud , & !orig cloud => cc_FWD%iVar%wc , & cf_AD => self_AD%Cloud_Fraction, & cc_AD => self_AD%Cloud_Cover , & cloud_AD => atm_AD%Cloud ) DO k = n_layers, 1, -1 IF ( wc_sum(k) > ZERO ) THEN denom = ONE/wc_sum(k) wc_sum_AD(k) = wc_sum_AD(k) - (denom**2 * cwc_sum(k) * cc_AD(k)) cwc_sum_AD(k) = cwc_sum_AD(k) + (denom * cc_AD(k)) cc_AD(k) = ZERO END IF cf_AD(k) = cf_AD(k) + (lwc(k) * cwc_sum_AD(k)) lwc_AD(k) = lwc_AD(k) + (cf(k) * cwc_sum_AD(k)) cwc_sum_AD(k-1) = cwc_sum_AD(k-1) + cwc_sum_AD(k) cwc_sum_AD(k) = ZERO lwc_AD(k) = lwc_AD(k) + wc_sum_AD(k) wc_sum_AD(k-1) = wc_sum_AD(k-1) + wc_sum_AD(k) wc_sum_AD(k) = ZERO END DO wc_sum_AD(0) = ZERO cwc_sum_AD(0) = ZERO ! Adjoint of the total layer water content DO n = 1, SIZE(cloud_AD) ! WHERE (cloud(n)%Water_Content(1:n_layers) > WATER_CONTENT_THRESHOLD ) & !orig WHERE (cloud(n,1:n_layers) > WATER_CONTENT_THRESHOLD ) & cloud_AD(n)%Water_Content(1:n_layers) = cloud_AD(n)%Water_Content(1:n_layers) + lwc_AD END DO lwc_AD = ZERO END ASSOCIATE END SUBROUTINE Compute_Average_Overlap_AD SUBROUTINE Compute_Overcast_Overlap_AD() self_AD%Total_Cloud_Cover = ZERO END SUBROUTINE Compute_Overcast_Overlap_AD END FUNCTION Compute_CloudCover_AD !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Is_Usable ! ! PURPOSE: ! Elemental function method to test the status of CloudCover objects to ! determien if they are usable. ! ! CALLING SEQUENCE: ! status = cc_obj%Is_Usable( Include_iVar = Include_iVar ) ! ! OBJECTS: ! cc_obj: Cloud cover object which is to have its usability tested. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL INPUTS: ! Include_iVar: Set this optional logical flag to alos check the status ! of the intermediate variable sub-object. ! IF .FALSE. - the subobject is NOT tested [DEFAULT] ! .TRUE. - the subobject is tested ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Conformable with object. ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! FUNCTION RESULT: ! status: The return value is a logical value indicating the ! usable status of the object. ! .TRUE. - if the object is usable. ! .FALSE. - if the object is NOT usable. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Same as object ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL FUNCTION Is_Usable( self, Include_iVar ) RESULT( status ) CLASS(CRTM_CloudCover_type), INTENT(IN) :: self LOGICAL, OPTIONAL , INTENT(IN) :: Include_iVar LOGICAL :: status status = self%Is_Allocated IF ( PRESENT(Include_iVar) ) THEN IF ( Include_iVar ) status = status .AND. self%iVar%Is_Usable() END IF END FUNCTION Is_Usable ELEMENTAL FUNCTION iVar_Is_Usable( self ) RESULT( status ) CLASS(iVar_type), INTENT(IN) :: self LOGICAL :: status status = self%Is_Allocated END FUNCTION iVar_Is_Usable !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Destroy ! ! PURPOSE: ! Elemental subroutine method to re-initialize CloudCover objects. ! ! CALLING SEQUENCE: ! CALL cc_obj%Destroy() ! ! OBJECTS: ! cc_obj: Re-initialized cloud cover object(s). ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE Destroy( self ) CLASS(CRTM_CloudCover_type), INTENT(INOUT) :: self self%Is_Allocated = .FALSE. END SUBROUTINE Destroy ELEMENTAL SUBROUTINE iVar_Destroy( self ) CLASS(iVar_type), INTENT(INOUT) :: self self%Is_Allocated = .FALSE. END SUBROUTINE iVar_Destroy ! SUBROUTINE Cleanup(self) ! TYPE(CRTM_CloudCover_type) :: self ! CALL self%Destroy() ! END SUBROUTINE Cleanup !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Create ! ! PURPOSE: ! Elemental subroutine method to create instances of CloudCover objects. ! ! CALLING SEQUENCE: ! CALL cc_obj%Create( n_Layers, & ! n_Clouds, & ! Forward = Forward, & ! Error_Message = Error_Message ) ! ! OBJECTS: ! cc_obj: Cloud cover object ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! n_Layers: Number of layers for which there is cloud data. ! Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Conformable with object. ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL INPUTS: ! Forward: Set this optional logical flag to allocate the sub-object to ! hold the intermediate forward model results. ! IF .FALSE. - the subobject is NOT allocated [DEFAULT] ! .TRUE. - the subobject is allocated ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Conformable with object. ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! OPTIONAL OUTPUTS: ! Error_Message: If an error occurred creating the object, this ! argument will contain error information. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Conformable with object. ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE Create( & self , & n_Layers , & n_Clouds , & Forward , & Error_Message ) ! Arguments CLASS(CRTM_CloudCover_type), INTENT(INOUT) :: self INTEGER , INTENT(IN) :: n_Layers INTEGER , INTENT(IN) :: n_Clouds LOGICAL, OPTIONAL, INTENT(IN) :: Forward CHARACTER(*), OPTIONAL, INTENT(OUT) :: Error_Message ! Local variables CHARACTER(ML) :: alloc_msg INTEGER :: alloc_stat LOGICAL :: allocate_ivar ! Check input IF ( n_Layers < 1 ) THEN IF ( PRESENT(Error_Message) ) Error_Message = 'Invalid dimension inputs' RETURN END IF allocate_ivar = .FALSE. IF ( PRESENT(Forward) ) allocate_ivar = Forward ! Intermediate variable object IF ( allocate_ivar ) THEN ! CALL self%iVar%Create(n_Layers, Error_Message = Error_Message) CALL self%iVar%Create(n_Layers, n_Clouds, Error_Message = Error_Message) IF ( .NOT. self%iVar%Is_Usable() ) RETURN END IF ! Main object ! ...Perform the allocations ALLOCATE( self%Cloud_Fraction( n_Layers ), & self%Cloud_Cover( n_Layers ), & STAT = alloc_stat ) !STAT = alloc_stat, ERRMSG = alloc_msg ) IF ( alloc_stat /= 0 ) THEN IF ( PRESENT(Error_Message) ) Error_Message = alloc_msg RETURN END IF ! ...Initialise self%n_Layers = n_Layers self%Cloud_Fraction = ZERO self%Cloud_Cover = ZERO ! ...Set allocation indicator self%Is_Allocated = .TRUE. END SUBROUTINE Create ELEMENTAL SUBROUTINE iVar_Create( & self , & n_Layers , & n_Clouds , & Error_Message ) ! Arguments CLASS(iVar_type) , INTENT(INOUT) :: self INTEGER , INTENT(IN) :: n_Layers INTEGER , INTENT(IN) :: n_Clouds CHARACTER(*), OPTIONAL, INTENT(OUT) :: Error_Message ! Local variables CHARACTER(ML) :: alloc_msg INTEGER :: alloc_stat ! Check input IF ( n_Layers < 1 ) THEN IF ( PRESENT(Error_Message) ) Error_Message = 'iVar: Invalid dimension input' RETURN END IF ! Perform the allocations ALLOCATE( self%prod( 0:n_Layers ), & self%lwc( 1:n_Layers ), & self%wc_sum( 0:n_Layers ), & self%wc( 1:n_Clouds, 1:n_Layers ), & self%maxcov( 1:n_Layers ), & self%cwc_sum( 0:n_Layers ), & STAT = alloc_stat ) !STAT = alloc_stat, ERRMSG = alloc_msg ) IF ( alloc_stat /= 0 ) THEN IF ( PRESENT(Error_Message) ) Error_Message = 'iVar: '//TRIM(alloc_msg) RETURN END IF ! Initialise self%n_Layers = n_Layers self%n_Clouds = n_Clouds self%prod = ZERO self%lwc = ZERO self%wc = ZERO self%maxcov = ZERO self%wc_sum = ZERO self%cwc_sum = ZERO ! Set allocation indicator self%Is_Allocated = .TRUE. END SUBROUTINE iVar_Create !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Inspect ! ! PURPOSE: ! Subroutine method to display the contents of a CloudCover object. ! ! CALLING SEQUENCE: ! CALL cc_obj%Inspect( Hires=hires, Unit=unit, Verbose=Verbose ) ! ! OBJECTS: ! cc_obj: Cloud cover object ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL INPUTS: ! Hires: Set this logical argument to output object contents with ! more significant digits. ! If == .FALSE., output format is 'es13.6' [DEFAULT]. ! == .TRUE., output format is 'es22.15' ! If not specified, default is .FALSE. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! Unit: Unit number for an already open file to which the output ! will be written. ! If the argument is specified and the file unit is not ! connected, the output goes to stdout. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! Verbose: Set this logical argument to output the intermediate variable ! sub-object contents if they are available. ! If == .FALSE., the intermediate variables are NOT output [DEFAULT]. ! == .TRUE., the intermediate variables are output if available ! If not specified, default is .FALSE. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE Inspect( self, Hires, Unit, Verbose ) ! Arguments CLASS(CRTM_CloudCover_type), INTENT(IN) :: self LOGICAL, OPTIONAL, INTENT(IN) :: Hires INTEGER, OPTIONAL, INTENT(IN) :: Unit LOGICAL, OPTIONAL, INTENT(IN) :: Verbose ! Local variables INTEGER :: fid CHARACTER(20) :: fmtstring LOGICAL :: verbose_inspect ! Setup fmtstring = 'es13.6' IF ( PRESENT(Hires) ) THEN IF ( Hires ) fmtstring = 'es22.15' END IF fid = OUTPUT_UNIT IF ( PRESENT(Unit) ) THEN IF ( File_Open(Unit) ) fid = Unit END IF verbose_inspect = .FALSE. IF ( PRESENT(Verbose) ) verbose_inspect = Verbose ! The inspection output WRITE(fid,'(1x,"CLOUDCOVER OBJECT")') WRITE(fid,'(3x,"n_Layers :",1x,i0)') self%n_Layers WRITE(fid,'(3x,"Overlap :",1x,a )') self%Overlap_Name() WRITE(fid,'(3x,"Total cloud cover :",1x,'//TRIM(fmtstring)//')') self%Total_Cloud_Cover IF ( .NOT. self%Is_Usable() ) RETURN WRITE(fid,'(3x,"Cloud_Fraction:")') WRITE(fid,'(5(1x,'//TRIM(fmtstring)//',:))') self%Cloud_Fraction WRITE(fid,'(3x,"Cloud_Cover:")') WRITE(fid,'(5(1x,'//TRIM(fmtstring)//',:))') self%Cloud_Cover ! The intermediate variable sub-object IF ( verbose_inspect ) CALL self%iVar%Inspect() END SUBROUTINE Inspect SUBROUTINE iVar_Inspect(self, Hires, Unit ) ! Arguments CLASS(iVar_Type) , INTENT(IN) :: self LOGICAL, OPTIONAL, INTENT(IN) :: Hires INTEGER, OPTIONAL, INTENT(IN) :: Unit ! Local variables INTEGER :: fid CHARACTER(20) :: fmtstring ! Setup fmtstring = 'es13.6' IF ( PRESENT(Hires) ) THEN IF ( Hires ) fmtstring = 'es22.15' END IF fid = OUTPUT_UNIT IF ( PRESENT(Unit) ) THEN IF ( File_Open(Unit) ) fid = Unit END IF ! The inspection output WRITE(fid,'(3x,"CLOUDCOVER iVar SUB-OBJECT")') WRITE(fid,'(5x,"n_Layers :",1x,i0)') self%n_Layers WRITE(fid,'(7x,"Layer-to-layer product:")') WRITE(fid,'(5(1x,'//TRIM(fmtstring)//',:))') self%prod WRITE(fid,'(7x,"Layer water content for all clouds:")') WRITE(fid,'(5(1x,'//TRIM(fmtstring)//',:))') self%lwc WRITE(fid,'(7x,"Cumulative layer water content for all clouds:")') WRITE(fid,'(5(1x,'//TRIM(fmtstring)//',:))') self%wc_sum WRITE(fid,'(7x,"Cumulative cloud fraction weighted layer water content for all clouds:")') WRITE(fid,'(5(1x,'//TRIM(fmtstring)//',:))') self%cwc_sum END SUBROUTINE iVar_Inspect !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! Set_To_Zero ! ! PURPOSE: ! Elemental subroutine method to zero out the data arrays in a ! CloudCover object. ! ! CALLING SEQUENCE: ! CALL cc_obj%Set_To_Zero() ! ! OBJECTS: ! cc_obj: Cloud cover object ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN OUT) ! ! COMMENTS: ! - The dimension components of the object are *NOT* set to zero. ! - The overlap methodology identifier component is *NOT* reset. ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE Set_To_Zero( self ) CLASS(CRTM_CloudCover_type), INTENT(IN OUT) :: self ! Do nothing if structure is unused IF ( .NOT. self%Is_Usable() ) RETURN ! Only zero out the data self%Total_Cloud_Cover = ZERO self%Cloud_Fraction = ZERO self%Cloud_Cover = ZERO ! The intermediate variable sub-object CALL self%iVar%Set_To_Zero() END SUBROUTINE Set_To_Zero ELEMENTAL SUBROUTINE iVar_Set_To_Zero( self ) CLASS(iVar_type), INTENT(IN OUT) :: self ! Do nothing if structure is unused IF ( .NOT. self%Is_Usable() ) RETURN ! Only zero out the data self%prod = ZERO self%lwc = ZERO self%wc_sum = ZERO self%cwc_sum = ZERO END SUBROUTINE iVar_Set_To_Zero !################################################################################## !################################################################################## !## ## !## ## OPERATOR METHODS ## ## !## ## !################################################################################## !################################################################################## !------------------------------------------------------------------------------ !:sdoc+: ! ! NAME: ! == ! ! PURPOSE: ! Operator method to test the equality of two CloudCover objects. ! ! CALLING SEQUENCE: ! IF ( x == y ) THEN ! ... ! END IF ! ! OBJECTS: ! x, y: Two cloud cover object to be compared. ! UNITS: N/A ! TYPE: CRTM_CloudCover_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !------------------------------------------------------------------------------ ELEMENTAL FUNCTION Equal( x, y ) RESULT( is_equal ) CLASS(CRTM_CloudCover_type), INTENT(IN) :: x, y LOGICAL :: is_equal ! Set up is_equal = .FALSE. ! Check the object association status IF ( x%Is_Usable() .NEQV. y%Is_Usable() ) RETURN ! Check contents ! ...Dimensions IF ( x%n_Layers /= y%n_Layers ) RETURN ! ...Scalars IF ( .NOT. ((x%Overlap == y%Overlap ) .AND. & (x%Total_Cloud_Cover .EqualTo. y%Total_Cloud_Cover)) ) RETURN ! ...Arrays IF ( x%Is_Usable() .AND. y%Is_Usable() ) THEN IF ( .NOT. (ALL(x%Cloud_Fraction .EqualTo. y%Cloud_Fraction) .AND. & ALL(x%Cloud_Cover .EqualTo. y%Cloud_Cover )) ) RETURN ! Intermediate variable subobject IF ( .NOT. (x%iVar == y%iVar) ) RETURN END IF ! If we get here, then... is_equal = .TRUE. END FUNCTION Equal ELEMENTAL FUNCTION iVar_Equal( x, y ) RESULT( is_equal ) CLASS(iVar_type), INTENT(IN) :: x, y LOGICAL :: is_equal ! Set up is_equal = .FALSE. ! Check the object association status IF ( x%Is_Usable() .NEQV. y%Is_Usable() ) RETURN ! Check contents ! ...Dimensions IF ( x%n_Layers /= y%n_Layers ) RETURN ! ...Arrays IF ( x%Is_Usable() .AND. y%Is_Usable() ) THEN IF ( .NOT. (ALL(x%prod .EqualTo. y%prod ) .AND. & ALL(x%lwc .EqualTo. y%lwc ) .AND. & ALL(x%wc_sum .EqualTo. y%wc_sum ) .AND. & ALL(x%cwc_sum .EqualTo. y%cwc_sum)) ) RETURN END IF ! If we get here, then... is_equal = .TRUE. END FUNCTION iVar_Equal !------------------------------------------------------------------------------ !:sdoc+: ! ! NAME: ! /= ! ! PURPOSE: ! Operator method to test the inequality of two CloudCover objects. ! ! CALLING SEQUENCE: ! IF ( x /= y ) THEN ! ... ! END IF ! ! OBJECTS: ! x, y: Two cloud cover objects to be compared. ! UNITS: N/A ! TYPE: CRTM_CloudCover_type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !------------------------------------------------------------------------------ ELEMENTAL FUNCTION NotEqual( x, y ) RESULT( not_equal ) CLASS(CRTM_CloudCover_type), INTENT(IN) :: x, y LOGICAL :: not_equal not_equal = .NOT. (x == y) END FUNCTION NotEqual ELEMENTAL FUNCTION iVar_NotEqual( x, y ) RESULT( not_equal ) CLASS(iVar_type), INTENT(IN) :: x, y LOGICAL :: not_equal not_equal = .NOT. (x == y) END FUNCTION iVar_NotEqual !------------------------------------------------------------------------------ !:sdoc+: ! ! NAME: ! .Compare. ! ! PURPOSE: ! Operator method to compare two CloudCover objects. ! ! This procedure performs similarly to the == operator, but is non-elemental ! to allow for informational output when a difference is found between the ! two objects being compared. ! ! Mostly used for debugging. ! ! CALLING SEQUENCE: ! IF ( x .Compare. y ) THEN ! ... ! END IF ! ! OBJECTS: ! x, y: The cloud cover objects to compare. ! UNITS: N/A ! CLASS: CRTM_CloudCover_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !------------------------------------------------------------------------------ FUNCTION Compare_( x, y ) RESULT( is_equal ) CLASS(CRTM_CloudCover_type), INTENT(IN) :: x, y LOGICAL :: is_equal ! Local parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_CloudCover_Define::Compare' ! Local variable CHARACTER(ML) :: msg ! Set up is_equal = .TRUE. ! Check the object association status IF ( x%Is_Usable() .NEQV. y%Is_Usable() ) THEN msg = 'Object association statuses are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF ! Check contents ! ...Dimensions IF ( x%n_Layers /= y%n_Layers ) THEN msg = 'Object dimensions are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF ! Scalars IF ( x%Overlap /= y%Overlap ) THEN msg = 'Object overlap assumptions are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF IF ( .NOT. (x%Total_Cloud_Cover .EqualTo. y%Total_Cloud_Cover) ) THEN msg = 'Object Total_Cloud_Cover values are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF ! ...Arrays and sub-objects IF ( x%Is_Usable() .AND. y%Is_Usable() ) THEN IF ( .NOT. ALL(x%Cloud_Fraction .EqualTo. y%Cloud_Fraction) ) THEN msg = 'Object Cloud_Fraction data are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF IF ( .NOT. ALL(x%Cloud_Cover .EqualTo. y%Cloud_Cover) ) THEN msg = 'Object Cloud_Cover data are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF IF ( .NOT. (x%iVar .Compare. y%iVar) ) THEN msg = 'Object iVar subobject data are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF END IF END FUNCTION Compare_ FUNCTION iVar_Compare( x, y ) RESULT( is_equal ) CLASS(iVar_type), INTENT(IN) :: x, y LOGICAL :: is_equal ! Local parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_CloudCover_Define::iVar_Compare' ! Local variable CHARACTER(ML) :: msg ! Set up is_equal = .TRUE. ! Check the object association status IF ( x%Is_Usable() .NEQV. y%Is_Usable() ) THEN msg = 'Object association statuses are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF ! Check contents ! ...Dimensions IF ( x%n_Layers /= y%n_Layers ) THEN msg = 'Object dimensions are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF ! ...Arrays IF ( x%Is_Usable() .AND. y%Is_Usable() ) THEN IF ( .NOT. ALL(x%prod .EqualTo. y%prod) ) THEN msg = 'Object prod data are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF IF ( .NOT. ALL(x%lwc .EqualTo. y%lwc) ) THEN msg = 'Object lwc data are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF IF ( .NOT. ALL(x%wc_sum .EqualTo. y%wc_sum) ) THEN msg = 'Object wc_sum data are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF IF ( .NOT. ALL(x%cwc_sum .EqualTo. y%cwc_sum) ) THEN msg = 'Object cwc_sum data are different' CALL Display_Message(ROUTINE_NAME, msg, FAILURE) is_equal = .FALSE. END IF END IF END FUNCTION iVar_Compare END MODULE CRTM_CloudCover_Define