! ! CloudCoeff_Define ! ! Module defining the CloudCoeff data structure and containing routines to ! manipulate it. ! ! ! CREATION HISTORY: ! Written by: Yong Han, NOAA/NESDIS; Yong.Han@noaa.gov ! Quanhua Liu, QSS Group, Inc; Quanhua.Liu@noaa.gov ! Paul van Delst, CIMSS/SSEC; paul.vandelst@ssec.wisc.edu ! MODULE CloudCoeff_Define ! ------------------ ! Environment set up ! ------------------ ! Module use USE Type_Kinds, ONLY: Long, Double USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message USE Compare_Float_Numbers, ONLY: OPERATOR(.EqualTo.) ! Disable implicit typing IMPLICIT NONE ! ------------ ! Visibilities ! ------------ ! Everything private by default PRIVATE ! Datatypes PUBLIC :: CloudCoeff_type ! Operators PUBLIC :: OPERATOR(==) ! Procedures PUBLIC :: CloudCoeff_Associated PUBLIC :: CloudCoeff_Destroy PUBLIC :: CloudCoeff_Create PUBLIC :: CloudCoeff_Inspect PUBLIC :: CloudCoeff_ValidRelease PUBLIC :: CloudCoeff_Info PUBLIC :: CloudCoeff_DefineVersion ! --------------------- ! Procedure overloading ! --------------------- INTERFACE OPERATOR(==) MODULE PROCEDURE CloudCoeff_Equal END INTERFACE OPERATOR(==) ! ----------------- ! Module parameters ! ----------------- ! Version Id for the module CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & '$Id: CloudCoeff_Define.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $' ! CloudCoeff init values REAL(Double), PARAMETER :: ZERO = 0.0_Double ! Keyword set value INTEGER, PARAMETER :: SET = 1 ! Current valid release and version numbers INTEGER, PARAMETER :: CLOUDCOEFF_RELEASE = 3 ! This determines structure and file formats. INTEGER, PARAMETER :: CLOUDCOEFF_VERSION = 1 ! This is just the data version for the release. ! Meggage string length INTEGER, PARAMETER :: ML = 256 ! Number of stream angle definitions in the data set INTEGER, PARAMETER :: DEF_N_STREAM_SETS = 5 INTEGER, PARAMETER :: DEF_N_STREAMS(DEF_N_STREAM_SETS) = [2, 4, 6, 8, 16] ! ...This defines the offset in the "n_Legendre_Terms" ! ...dimension of the phase coefficient arrays for the ! ...various stream angle sets. INTEGER, PARAMETER :: DEF_LEGENDRE_OFFSET(DEF_N_STREAM_SETS) = [0, 0, 5, 12, 21] ! -------------------------------- ! CloudCoeff data type definition, ! MW: Microwave ! IR: Infrared ! Reff: Effective radius ! ke: Extinction coefficient ! w: Single scatter albedo ! g: Asymmetry parameter ! L: Liquid phase ! S: Solid phase ! -------------------------------- !:tdoc+: TYPE :: CloudCoeff_type ! Release and version information INTEGER(Long) :: Release = CLOUDCOEFF_RELEASE INTEGER(Long) :: Version = CLOUDCOEFF_VERSION ! Allocation indicator LOGICAL :: Is_Allocated = .FALSE. ! Dataset parameter definitions (eventually stored in the datafile) INTEGER :: n_Stream_Sets = DEF_N_STREAM_SETS INTEGER :: n_Streams(DEF_N_STREAM_SETS) = DEF_N_STREAMS INTEGER :: Legendre_Offset(DEF_N_STREAM_SETS) = DEF_LEGENDRE_OFFSET ! Array dimensions INTEGER(Long) :: n_MW_Frequencies = 0 ! I1 dimension INTEGER(Long) :: n_MW_Radii = 0 ! I2 dimension INTEGER(Long) :: n_IR_Frequencies = 0 ! I3 dimension INTEGER(Long) :: n_IR_Radii = 0 ! I4 dimension INTEGER(Long) :: n_Temperatures = 0 ! I5 dimension INTEGER(Long) :: n_Densities = 0 ! I6 dimension INTEGER(Long) :: Max_Legendre_Terms = 0 ! I7 dimension INTEGER(Long) :: n_Legendre_Terms = 0 INTEGER(Long) :: Max_Phase_Elements = 0 ! I8 dimension INTEGER(Long) :: n_Phase_Elements = 0 ! LUT dimension vectors REAL(Double), ALLOCATABLE :: Frequency_MW(:) ! I1 REAL(Double), ALLOCATABLE :: Frequency_IR(:) ! I3 REAL(Double), ALLOCATABLE :: Reff_MW(:) ! I2 REAL(Double), ALLOCATABLE :: Reff_IR(:) ! I4 REAL(Double), ALLOCATABLE :: Temperature(:) ! I5 REAL(Double), ALLOCATABLE :: Density(:) ! I6 ! Microwave data for liquid phase clouds REAL(Double), ALLOCATABLE :: ke_L_MW(:,:,:) ! I1 x I2 x I5 REAL(Double), ALLOCATABLE :: w_L_MW(:,:,:) ! I1 x I2 x I5 REAL(Double), ALLOCATABLE :: g_L_MW(:,:,:) ! I1 x I2 x I5 REAL(Double), ALLOCATABLE :: pcoeff_L_MW(:,:,:,:,:) ! I1 x I2 x I5 x I7 x I8 ! Microwave data for solid phase clouds REAL(Double), ALLOCATABLE :: ke_S_MW(:,:,:) ! I1 x I2 x I6 REAL(Double), ALLOCATABLE :: w_S_MW(:,:,:) ! I1 x I2 x I6 REAL(Double), ALLOCATABLE :: g_S_MW(:,:,:) ! I1 x I2 x I6 REAL(Double), ALLOCATABLE :: pcoeff_S_MW(:,:,:,:,:) ! I1 x I2 x I6 x I7 x I8 ! Infrared data. Note that the 0'th element in the I6 dimension ! of these data correspond to the liquid phase component. The ! remaining elements in this dimension are for the solid phase ! component REAL(Double), ALLOCATABLE :: ke_IR(:,:,:) ! I3 x I4 x 0:I6 REAL(Double), ALLOCATABLE :: w_IR(:,:,:) ! I3 x I4 x 0:I6 REAL(Double), ALLOCATABLE :: g_IR(:,:,:) ! I3 x I4 x 0:I6 REAL(Double), ALLOCATABLE :: pcoeff_IR(:,:,:,:) ! I3 x I4 x 0:I6 x I7 END TYPE CloudCoeff_type !:tdoc-: CONTAINS !################################################################################ !################################################################################ !## ## !## ## PUBLIC MODULE ROUTINES ## ## !## ## !################################################################################ !################################################################################ !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCoeff_Associated ! ! PURPOSE: ! Elemental function to test the status of the allocatable components ! of a CloudCoeff object. ! ! CALLING SEQUENCE: ! Status = CloudCoeff_Associated( CloudCoeff ) ! ! OBJECTS: ! CloudCoeff: CloudCoeff object which is to have its member's ! status tested. ! UNITS: N/A ! TYPE: TYPE(CloudCoeff_type) ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! Status: The return value is a logical value indicating the ! status of the CloudCoeff members. ! .TRUE. - if ANY of the CloudCoeff allocatable or ! pointer members are in use. ! .FALSE. - if ALL of the CloudCoeff allocatable or ! pointer members are not in use. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Same as input CloudCoeff argument ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL FUNCTION CloudCoeff_Associated( CloudCoeff ) RESULT( Status ) TYPE(CloudCoeff_type), INTENT(IN) :: CloudCoeff LOGICAL :: Status Status = CloudCoeff%Is_Allocated END FUNCTION CloudCoeff_Associated !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCoeff_Destroy ! ! PURPOSE: ! Elemental subroutine to re-initialize CloudCoeff objects. ! ! CALLING SEQUENCE: ! CALL CloudCoeff_Destroy( CloudCoeff ) ! ! OBJECTS: ! CloudCoeff: Re-initialized CloudCoeff object. ! UNITS: N/A ! TYPE: TYPE(CloudCoeff_type) ! DIMENSION: Scalar OR any rank ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE CloudCoeff_Destroy( CloudCoeff ) TYPE(CloudCoeff_type), INTENT(OUT) :: CloudCoeff CloudCoeff%Is_Allocated = .FALSE. CloudCoeff%n_MW_Frequencies = 0 CloudCoeff%n_MW_Radii = 0 CloudCoeff%n_IR_Frequencies = 0 CloudCoeff%n_IR_Radii = 0 CloudCoeff%n_Temperatures = 0 CloudCoeff%n_Densities = 0 CloudCoeff%Max_Legendre_Terms = 0 CloudCoeff%n_Legendre_Terms = 0 CloudCoeff%Max_Phase_Elements = 0 CloudCoeff%n_Phase_Elements = 0 END SUBROUTINE CloudCoeff_Destroy !-------------------------------------------------------------------------------- ! ! NAME: ! CloudCoeff_Create ! ! PURPOSE: ! Elemental subroutine to create an instance of a CloudCoeff object. ! ! CALLING SEQUENCE: ! CALL CloudCoeff_Create( CloudCoeff , & ! n_MW_Frequencies, & ! n_MW_Radii , & ! n_IR_Frequencies, & ! n_IR_Radii , & ! n_Temperatures , & ! n_Densities , & ! n_Legendre_Terms, & ! n_Phase_Elements ) ! ! OBJECTS: ! CloudCoeff: CloudCoeff object. ! UNITS: N/A ! TYPE: TYPE(CloudCoeff_type) ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! n_MW_Frequencies: The number of microwave frequencies in ! the look-up table (LUT) ! The "I1" dimension. Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! n_MW_Radii: The number of discrete effective radii ! for MW scatterers in the LUT. ! The "I2" dimension. Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! n_IR_Frequencies: The number of infrared frequencies in ! the LUT ! The "I3" dimension. Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! n_IR_Radii: The number of discrete effective radii ! for IR scatterers in the LUT. ! The "I4" dimension. Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! n_Temperatures: The number of discrete layer temperatures ! in the LUT. ! The "I5" dimension. Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! n_Densities: The number of fixed densities for snow, graupel, ! and hail/ice in the LUT. ! The "I6" dimension. Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! n_Legendre_Terms: The maximum number of Legendre polynomial ! terms in the LUT. ! The "I7" dimension. Can be = 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! n_Phase_Elements: The maximum number of phase elements in the LUT. ! The "I8" dimension. Must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !-------------------------------------------------------------------------------- ELEMENTAL SUBROUTINE CloudCoeff_Create( & CloudCoeff , & n_MW_Frequencies, & n_MW_Radii , & n_IR_Frequencies, & n_IR_Radii , & n_Temperatures , & n_Densities , & n_Legendre_Terms, & n_Phase_Elements ) ! Arguments TYPE(CloudCoeff_type) , INTENT(OUT) :: CloudCoeff INTEGER, INTENT(IN) :: n_MW_Frequencies INTEGER, INTENT(IN) :: n_MW_Radii INTEGER, INTENT(IN) :: n_IR_Frequencies INTEGER, INTENT(IN) :: n_IR_Radii INTEGER, INTENT(IN) :: n_Temperatures INTEGER, INTENT(IN) :: n_Densities INTEGER, INTENT(IN) :: n_Legendre_Terms INTEGER, INTENT(IN) :: n_Phase_Elements ! Local parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CloudCoeff_Create' ! Local variables INTEGER :: alloc_stat(4) ! Check input IF ( n_MW_Frequencies < 1 .OR. & n_MW_Radii < 1 .OR. & n_IR_Frequencies < 1 .OR. & n_IR_Radii < 1 .OR. & n_Temperatures < 1 .OR. & n_Densities < 1 .OR. & n_Legendre_Terms < 0 .OR. & n_Phase_Elements < 1 ) RETURN ! Perform the allocation. The allocations were ! split across several calls for clarity only. ! ...Allocate the dimension vectors ALLOCATE( CloudCoeff%Frequency_MW(n_MW_Frequencies), & CloudCoeff%Frequency_IR(n_IR_Frequencies), & CloudCoeff%Reff_MW(n_MW_Radii), & CloudCoeff%Reff_IR(n_IR_Radii), & CloudCoeff%Temperature(n_Temperatures), & CloudCoeff%Density(n_Densities), & STAT = alloc_stat(1) ) ! ...Allocate the microwave liquid phase arrays ALLOCATE( CloudCoeff%ke_L_MW(n_MW_Frequencies, n_MW_Radii, n_Temperatures), & CloudCoeff%w_L_MW(n_MW_Frequencies , n_MW_Radii, n_Temperatures), & CloudCoeff%g_L_MW(n_MW_Frequencies , n_MW_Radii, n_Temperatures), & CloudCoeff%pcoeff_L_MW(n_MW_Frequencies , & n_MW_Radii , & n_Temperatures , & 0:n_Legendre_Terms, & n_Phase_Elements ), & STAT = alloc_stat(2) ) ! ...Allocate the microwave solid phase arrays ALLOCATE( CloudCoeff%ke_S_MW(n_MW_Frequencies, n_MW_Radii, n_Densities), & CloudCoeff%w_S_MW(n_MW_Frequencies , n_MW_Radii, n_Densities), & CloudCoeff%g_S_MW(n_MW_Frequencies , n_MW_Radii, n_Densities), & CloudCoeff%pcoeff_S_MW(n_MW_Frequencies , & n_MW_Radii , & n_Densities , & 0:n_Legendre_Terms, & n_Phase_Elements ), & STAT = alloc_stat(3) ) ! ...Allocate the infrared arrays ALLOCATE( CloudCoeff%ke_IR(n_IR_Frequencies, n_IR_Radii, 0:n_Densities), & CloudCoeff%w_IR(n_IR_Frequencies , n_IR_Radii, 0:n_Densities), & CloudCoeff%g_IR(n_IR_Frequencies , n_IR_Radii, 0:n_Densities), & CloudCoeff%pcoeff_IR(n_IR_Frequencies , & n_IR_Radii , & 0:n_Densities , & 0:n_Legendre_Terms ), & STAT = alloc_stat(4) ) IF ( ANY(alloc_stat /= 0) ) RETURN ! Initialise ! ...Dimensions CloudCoeff%n_MW_Frequencies = n_MW_Frequencies CloudCoeff%n_MW_Radii = n_MW_Radii CloudCoeff%n_IR_Frequencies = n_IR_Frequencies CloudCoeff%n_IR_Radii = n_IR_Radii CloudCoeff%n_Temperatures = n_Temperatures CloudCoeff%n_Densities = n_Densities CloudCoeff%Max_Legendre_Terms = n_Legendre_Terms CloudCoeff%n_Legendre_Terms = n_Legendre_Terms CloudCoeff%Max_Phase_Elements = n_Phase_Elements CloudCoeff%n_Phase_Elements = n_Phase_Elements ! ...Arrays CloudCoeff%Frequency_MW = ZERO CloudCoeff%Frequency_IR = ZERO CloudCoeff%Reff_MW = ZERO CloudCoeff%Reff_IR = ZERO CloudCoeff%Temperature = ZERO CloudCoeff%Density = ZERO CloudCoeff%ke_L_MW = ZERO CloudCoeff%w_L_MW = ZERO CloudCoeff%g_L_MW = ZERO CloudCoeff%pcoeff_L_MW = ZERO CloudCoeff%ke_S_MW = ZERO CloudCoeff%w_S_MW = ZERO CloudCoeff%g_S_MW = ZERO CloudCoeff%pcoeff_S_MW = ZERO CloudCoeff%ke_IR = ZERO CloudCoeff%w_IR = ZERO CloudCoeff%g_IR = ZERO CloudCoeff%pcoeff_IR = ZERO ! Set allocationindicator CloudCoeff%Is_Allocated = .TRUE. END SUBROUTINE CloudCoeff_Create !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCoeff_Inspect ! ! PURPOSE: ! Subroutine to print the contents of a CloudCoeff object to stdout. ! ! CALLING SEQUENCE: ! CALL CloudCoeff_Inspect( CloudCoeff ) ! ! INPUTS: ! CloudCoeff: CloudCoeff object to display. ! UNITS: N/A ! TYPE: TYPE(CloudCoeff_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE CloudCoeff_Inspect( CloudCoeff, Pause ) ! Arguments TYPE(CloudCoeff_type), INTENT(IN) :: CloudCoeff LOGICAL, OPTIONAL, INTENT(IN) :: Pause ! Variables INTEGER :: i, j, k, l, m INTEGER :: kidx LOGICAL :: wait wait = .FALSE. IF ( PRESENT(Pause) ) wait = Pause WRITE(*,'(1x,"CloudCoeff OBJECT")') ! Dimensions WRITE(*,'(3x,"n_MW_Frequencies :",1x,i0)') CloudCoeff%n_MW_Frequencies WRITE(*,'(3x,"n_MW_Radii :",1x,i0)') CloudCoeff%n_MW_Radii WRITE(*,'(3x,"n_IR_Frequencies :",1x,i0)') CloudCoeff%n_IR_Frequencies WRITE(*,'(3x,"n_IR_Radii :",1x,i0)') CloudCoeff%n_IR_Radii WRITE(*,'(3x,"n_Temperatures :",1x,i0)') CloudCoeff%n_Temperatures WRITE(*,'(3x,"n_Densities :",1x,i0)') CloudCoeff%n_Densities WRITE(*,'(3x,"n_Legendre_Terms :",1x,i0)') CloudCoeff%n_Legendre_Terms WRITE(*,'(3x,"n_Phase_Elements :",1x,i0)') CloudCoeff%n_Phase_Elements IF ( .NOT. CloudCoeff_Associated(CloudCoeff) ) RETURN ! Dimensional vectors WRITE(*,'(/3x,"Dimensional vectors...")') WRITE(*,'(5x,"CloudCoeff Frequency_MW:")') WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%Frequency_MW WRITE(*,'(5x,"CloudCoeff Frequency_IR:")') WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%Frequency_IR WRITE(*,'(5x,"CloudCoeff Reff_MW :")') WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%Reff_MW WRITE(*,'(5x,"CloudCoeff Reff_IR :")') WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%Reff_IR WRITE(*,'(5x,"CloudCoeff Temperature :")') WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%Temperature WRITE(*,'(5x,"CloudCoeff Density :")') WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%Density ! Microwave data WRITE(*,'(/3x,"Microwave data...")') ! ...Liquid phase data IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the microwave liquid phase mass extinction coefficients")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Temperatures WRITE(*,'(5x,"Microwave liquid phase mass extinction coefficients:")') WRITE(*,'(7x,"Temperature : ",es13.6)') CloudCoeff%Temperature(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%ke_L_MW(:,i,j) END DO END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the microwave liquid phase single scatter albedo")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Temperatures WRITE(*,'(5x,"Microwave liquid phase single scatter albedo:")') WRITE(*,'(7x,"Temperature : ",es13.6)') CloudCoeff%Temperature(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%w_L_MW(:,i,j) END DO END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the microwave liquid phase asymmetry parameter")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Temperatures WRITE(*,'(5x,"Microwave liquid phase asymmetry parameter:")') WRITE(*,'(7x,"Temperature : ",es13.6)') CloudCoeff%Temperature(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%g_L_MW(:,i,j) END DO END DO DO m = 1, CloudCoeff%n_Stream_Sets IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the ",i0,"-stream microwave liquid ",& &"phase phase coefficients")') CloudCoeff%n_Streams(m) READ(*,*) END IF WRITE(*,'(5x,i0,"-stream microwave liquid phase phase coefficients:")') CloudCoeff%n_Streams(m) DO l = 1, CloudCoeff%n_Phase_Elements WRITE(*,'(7x,"Phase element: ",i0)') l DO k = 1, CloudCoeff%n_Streams(m) WRITE(*,'(7x,"Legendre term: ",i0)') k kidx = k + CloudCoeff%Legendre_Offset(m) DO j = 1, CloudCoeff%n_Temperatures WRITE(*,'(7x,"Temperature : ",es13.6)') CloudCoeff%Temperature(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%pcoeff_L_MW(:,i,j,kidx,l) END DO END DO END DO END DO END DO ! ...Solid phase data IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the microwave solid phase mass extinction coefficients")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Densities WRITE(*,'(5x,"Microwave solid phase mass extinction coefficients:")') WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%ke_S_MW(:,i,j) END DO END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the microwave solid phase single scatter albedo")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Densities WRITE(*,'(5x,"Microwave solid phase single scatter albedo:")') WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%w_S_MW(:,i,j) END DO END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the microwave solid phase asymmetry parameter")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Densities WRITE(*,'(5x,"Microwave solid phase asymmetry parameter:")') WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%g_S_MW(:,i,j) END DO END DO DO m = 1, CloudCoeff%n_Stream_Sets IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the ",i0,"-stream microwave solid ",& &"phase phase coefficients")') CloudCoeff%n_Streams(m) READ(*,*) END IF WRITE(*,'(5x,i0,"-stream microwave solid phase phase coefficients:")') CloudCoeff%n_Streams(m) DO l = 1, CloudCoeff%n_Phase_Elements WRITE(*,'(7x,"Phase element: ",i0)') l DO k = 1, CloudCoeff%n_Streams(m) WRITE(*,'(7x,"Legendre term: ",i0)') k kidx = k + CloudCoeff%Legendre_Offset(m) DO j = 1, CloudCoeff%n_Densities WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_MW_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_MW(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%pcoeff_S_MW(:,i,j,kidx,l) END DO END DO END DO END DO END DO ! Infrared data WRITE(*,'(/3x,"Infrared data...")') ! ...Liquid phase data IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the infrared liquid phase mass extinction coefficients")') READ(*,*) END IF WRITE(*,'(5x,"Infrared liquid phase mass extinction coefficients:")') DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%ke_IR(:,i,0) END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the infrared liquid phase single scatter albedo")') READ(*,*) END IF WRITE(*,'(5x,"Infrared liquid phase single scatter albedo:")') DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%w_IR(:,i,0) END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the infrared liquid phase asymmetry parameter")') READ(*,*) END IF WRITE(*,'(5x,"Infrared liquid phase asymmetry parameter:")') DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%g_IR(:,i,0) END DO DO m = 1, CloudCoeff%n_Stream_Sets IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the ",i0,"-stream infrared liquid ",& &"phase phase coefficients")') CloudCoeff%n_Streams(m) READ(*,*) END IF WRITE(*,'(5x,i0,"-stream infrared liquid phase phase coefficients:")') CloudCoeff%n_Streams(m) DO k = 1, CloudCoeff%n_Streams(m) WRITE(*,'(7x,"Legendre term: ",i0)') k kidx = k + CloudCoeff%Legendre_Offset(m) DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%pcoeff_IR(:,i,0,kidx) END DO END DO END DO ! ...Solid phase data IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the infrared solid phase mass extinction coefficients")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Densities WRITE(*,'(5x,"Infrared solid phase mass extinction coefficients:")') WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%ke_IR(:,i,j) END DO END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the infrared solid phase single scatter albedo")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Densities WRITE(*,'(5x,"Infrared solid phase single scatter albedo:")') WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%w_IR(:,i,j) END DO END DO IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the infrared solid phase asymmetry parameter")') READ(*,*) END IF DO j = 1, CloudCoeff%n_Densities WRITE(*,'(5x,"Infrared solid phase asymmetry parameter:")') WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%g_IR(:,i,j) END DO END DO DO m = 1, CloudCoeff%n_Stream_Sets IF ( wait ) THEN WRITE(*,'(/5x,"Press to view the ",i0,"-stream infrared solid ",& &"phase phase coefficients")') CloudCoeff%n_Streams(m) READ(*,*) END IF WRITE(*,'(5x,i0,"-stream infrared solid phase phase coefficients:")') CloudCoeff%n_Streams(m) DO k = 1, CloudCoeff%n_Streams(m) WRITE(*,'(7x,"Legendre term: ",i0)') k kidx = k + CloudCoeff%Legendre_Offset(m) DO j = 1, CloudCoeff%n_Densities WRITE(*,'(7x,"Density : ",es13.6)') CloudCoeff%Density(j) DO i = 1, CloudCoeff%n_IR_Radii WRITE(*,'(7x,"Effective radius: ",es13.6)') CloudCoeff%Reff_IR(i) WRITE(*,'(5(1x,es13.6,:))') CloudCoeff%pcoeff_IR(:,i,j,kidx) END DO END DO END DO END DO END SUBROUTINE CloudCoeff_Inspect !---------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCoeff_ValidRelease ! ! PURPOSE: ! Function to check the CloudCoeff Release value. ! ! CALLING SEQUENCE: ! IsValid = CloudCoeff_ValidRelease( CloudCoeff ) ! ! INPUTS: ! CloudCoeff: CloudCoeff object for which the Release component ! is to be checked. ! UNITS: N/A ! TYPE: TYPE(CloudCoeff_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! IsValid: Logical value defining the release validity. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! !---------------------------------------------------------------------------------- FUNCTION CloudCoeff_ValidRelease( CloudCoeff ) RESULT( IsValid ) ! Arguments TYPE(CloudCoeff_type), INTENT(IN) :: CloudCoeff ! Function result LOGICAL :: IsValid ! Local parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CloudCoeff_ValidRelease' ! Local variables CHARACTER(ML) :: msg ! Set up IsValid = .TRUE. ! Check release is not too old IF ( CloudCoeff%Release < CloudCoeff_RELEASE ) THEN IsValid = .FALSE. WRITE( msg,'("A CloudCoeff data update is needed. ", & &"CloudCoeff release is ",i0, & &". Valid release is ",i0,"." )' ) & CloudCoeff%Release, CLOUDCOEFF_RELEASE CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ) RETURN END IF ! Check release is not too new IF ( CloudCoeff%Release > CloudCoeff_RELEASE ) THEN IsValid = .FALSE. WRITE( msg,'("A CloudCoeff software update is needed. ", & &"CloudCoeff release is ",i0, & &". Valid release is ",i0,"." )' ) & CloudCoeff%Release, CLOUDCOEFF_RELEASE CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ) RETURN END IF END FUNCTION CloudCoeff_ValidRelease !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCoeff_Info ! ! PURPOSE: ! Subroutine to return a string containing version and dimension ! information about a CloudCoeff object. ! ! CALLING SEQUENCE: ! CALL CloudCoeff_Info( CloudCoeff, Info ) ! ! INPUTS: ! CloudCoeff: CloudCoeff object about which info is required. ! UNITS: N/A ! TYPE: TYPE(CloudCoeff_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OUTPUTS: ! Info: String containing version and dimension information ! about the passed CloudCoeff object. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE CloudCoeff_Info( CloudCoeff, Info ) ! Arguments TYPE(CloudCoeff_type), INTENT(IN) :: CloudCoeff CHARACTER(*), INTENT(OUT) :: Info ! Parameters INTEGER, PARAMETER :: CARRIAGE_RETURN = 13 INTEGER, PARAMETER :: LINEFEED = 10 ! Local variables CHARACTER(2000) :: Long_String ! Write the required data to the local string WRITE( Long_String, & '( a,1x,"CloudCoeff RELEASE.VERSION: ", i2, ".", i2.2, 2x, & &"N_FREQUENCIES(MW)=",i4,2x,& &"N_FREQUENCIES(IR)=",i4,2x,& &"N_RADII(MW)=",i2,2x,& &"N_RADII(IR)=",i2,2x,& &"N_TEMPERATURES=",i2,2x,& &"N_DENSITIES=",i2,2x,& &"N_LEGENDRE_TERMS=",i2,2x,& &"N_PHASE_ELEMENTS=",i2 )' ) & ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), & CloudCoeff%Release, CloudCoeff%Version, & CloudCoeff%n_MW_Frequencies, & CloudCoeff%n_IR_Frequencies, & CloudCoeff%n_MW_Radii , & CloudCoeff%n_IR_Radii , & CloudCoeff%n_Temperatures , & CloudCoeff%n_Densities , & CloudCoeff%n_Legendre_Terms, & CloudCoeff%n_Phase_Elements ! Trim the output based on the ! dummy argument string length Info = Long_String(1:MIN(LEN(Info), LEN_TRIM(Long_String))) END SUBROUTINE CloudCoeff_Info !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! CloudCoeff_DefineVersion ! ! PURPOSE: ! Subroutine to return the module version information. ! ! CALLING SEQUENCE: ! CALL CloudCoeff_DefineVersion( Id ) ! ! OUTPUTS: ! Id: Character string containing the version Id information ! for the module. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE CloudCoeff_DefineVersion( Id ) CHARACTER(*), INTENT(OUT) :: Id Id = MODULE_VERSION_ID END SUBROUTINE CloudCoeff_DefineVersion !################################################################################## !################################################################################## !## ## !## ## PRIVATE MODULE ROUTINES ## ## !## ## !################################################################################## !################################################################################## !------------------------------------------------------------------------------ ! ! NAME: ! CloudCoeff_Equal ! ! PURPOSE: ! Elemental function to test the equality of two CloudCoeff objects. ! Used in OPERATOR(==) interface block. ! ! CALLING SEQUENCE: ! is_equal = CloudCoeff_Equal( x, y ) ! ! or ! ! IF ( x == y ) THEN ! ... ! END IF ! ! OBJECTS: ! x, y: Two CloudCoeff objects to be compared. ! UNITS: N/A ! TYPE: TYPE(CloudCoeff_type) ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! is_equal: Logical value indicating whether the inputs are equal. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Same as inputs. ! !------------------------------------------------------------------------------ ELEMENTAL FUNCTION CloudCoeff_Equal( x, y ) RESULT( is_equal ) TYPE(CloudCoeff_type), INTENT(IN) :: x, y LOGICAL :: is_equal ! Set up is_equal = .FALSE. ! Check the object association status IF ( (.NOT. CloudCoeff_Associated(x)) .OR. & (.NOT. CloudCoeff_Associated(y)) ) RETURN ! Check contents ! ...Dimensions IF ( (x%n_MW_Frequencies /= y%n_MW_Frequencies) .OR. & (x%n_IR_Frequencies /= y%n_IR_Frequencies) .OR. & (x%n_MW_Radii /= y%n_MW_Radii ) .OR. & (x%n_IR_Radii /= y%n_IR_Radii ) .OR. & (x%n_Temperatures /= y%n_Temperatures ) .OR. & (x%n_Densities /= y%n_Densities ) .OR. & (x%n_Legendre_Terms /= y%n_Legendre_Terms) .OR. & (x%n_Phase_Elements /= y%n_Phase_Elements) ) RETURN ! ...Data IF ( ALL(x%Frequency_MW .EqualTo. y%Frequency_MW ) .AND. & ALL(x%Frequency_IR .EqualTo. y%Frequency_IR ) .AND. & ALL(x%Reff_MW .EqualTo. y%Reff_MW ) .AND. & ALL(x%Reff_IR .EqualTo. y%Reff_IR ) .AND. & ALL(x%Temperature .EqualTo. y%Temperature ) .AND. & ALL(x%Density .EqualTo. y%Density ) .AND. & ALL(x%ke_L_MW .EqualTo. y%ke_L_MW ) .AND. & ALL(x%w_L_MW .EqualTo. y%w_L_MW ) .AND. & ALL(x%g_L_MW .EqualTo. y%g_L_MW ) .AND. & ALL(x%pcoeff_L_MW .EqualTo. y%pcoeff_L_MW ) .AND. & ALL(x%ke_S_MW .EqualTo. y%ke_S_MW ) .AND. & ALL(x%w_S_MW .EqualTo. y%w_S_MW ) .AND. & ALL(x%g_S_MW .EqualTo. y%g_S_MW ) .AND. & ALL(x%pcoeff_S_MW .EqualTo. y%pcoeff_S_MW ) .AND. & ALL(x%ke_IR .EqualTo. y%ke_IR ) .AND. & ALL(x%w_IR .EqualTo. y%w_IR ) .AND. & ALL(x%g_IR .EqualTo. y%g_IR ) .AND. & ALL(x%pcoeff_IR .EqualTo. y%pcoeff_IR ) ) & is_equal = .TRUE. END FUNCTION CloudCoeff_Equal END MODULE CloudCoeff_Define