!----------------------------------------------------------------------------- ! Input Structure !----------------------------------------------------------------------------- module NB_CLOUD_MASK_SERVICES !use CONSTANTS_MOD, only: int1, int2, int4, int8, real4, real8, & ! MISSING_VALUE_REAL4, MISSING_VALUE_INT1, dtor, pi implicit none include 'nb_cloud_mask.inc' !---- CONSTANTS_MOD integer, parameter, public:: int1 = selected_int_kind(1) integer, parameter, public:: int2 = selected_int_kind(3) integer, parameter, public:: int4 = selected_int_kind(8) integer, parameter, public:: int8 = selected_int_kind(10) integer, parameter, public:: real4 = selected_real_kind(6,37) integer, parameter, public:: real8 = selected_real_kind(15,307) real (kind=real4), parameter, public:: Missing_Value_Real4 = -999.0 integer(kind=int1), parameter, public:: Missing_Value_Int1 = -128 real (kind=real4), parameter, public:: pi = 3.14159265 real (kind=real4), parameter, public:: dtor = pi/180.0 type, public :: mask_input integer :: Num_Elem !x-dimension of data arrays integer :: Num_Line !number of lines of arrays with data integer :: Num_Line_Max !y-dimension of data arrays integer(kind=int1) :: Invalid_Data_Mask !bad data mask (0=good,1=bad) integer :: Chan_On_041um !flag if 0.41um channel on (0=no,1=yes) integer :: Chan_On_063um !flag if 0.63um channel on (0=no,1=yes) integer :: Chan_On_086um !flag if 0.86um channel on (0=no,1=yes) integer :: Chan_On_138um !flag if 1.38um channel on (0=no,1=yes) integer :: Chan_On_160um !flag if 1.60um channel on (0=no,1=yes) integer :: Chan_On_213um !flag if 2.13um channel on (0=no,1=yes) integer :: Chan_On_375um !flag if 3.75um channel on (0=no,1=yes) integer :: Chan_On_67um !flag if 6.7um channel on (0=no,1=yes) integer :: Chan_On_85um !flag if 8.5um channel on (0=no,1=yes) integer :: Chan_On_10um !flag if 10.0um channel on (0=no,1=yes) integer :: Chan_On_11um !flag if 11.0um channel on (0=no,1=yes) integer :: Chan_On_12um !flag if 12.0um channel on (0=no,1=yes) integer :: Chan_On_I1_064um !flag if I1 0.64um channel on (0=no,1=yes) integer :: Chan_On_I4_374um !flag if I4 3.74um channel on (0=no,1=yes) integer :: Chan_On_I5_114um !flag if I5 11.4um channel on (0=no,1=yes) integer :: Chan_On_DNB !flag if DNB channel on (0=no,1=yes) integer :: Use_Sounder_11um !flag for IFF files where both imager and sounder 11um are available integer(kind=int1) :: Snow_Class !Snow Classification integer(kind=int1) :: Land_Class !Land Classification integer(kind=int1) :: Oceanic_Glint_Mask !Mask of oceanic solar glint (0=no,1=yes) integer(kind=int1) :: Lunar_Oceanic_Glint_Mask !Mask of oceanic lunar glint (0=no,1=yes) integer(kind=int1) :: Coastal_Mask !binary coast mask (0=no,1=yes) integer(kind=int1) :: Scat_Mask !binary scattering mask (0=no,1=yes) real(kind=real4) :: Glintzen !Glint zenith angle (degrees) real(kind=real4) :: Solzen !Solar zenith angle (degrees) real(kind=real4) :: Scatzen !Solar Scattering angle (degrees) real(kind=real4) :: Lunscatzen !Lunar Scattering angle (degrees) real(kind=real4) :: Senzen !Sensor viewing zenith angle (degrees) real(kind=real4) :: Lunzen !Lunar viewing zenith angle (degrees) real(kind=real4) :: Lat !Latitude (degrees) real(kind=real4) :: Lon !Longitude (degrees) real(kind=real4) :: Ref_041um !0.41 um toa reflectance (%) real(kind=real4) :: Ref_063um !0.63 um toa reflectance (%) real(kind=real4) :: Ref_063um_Clear !0.63 um toa reflectance for clear-sky (%) real(kind=real4) :: Ref_063um_Std !0.63 um toa reflectance 3x3 Std. Dev. (%) real(kind=real4) :: Ref_063um_Min !Min 0.63 um toa reflectance over 3x3 (%) real(kind=real4) :: Ref_086um !0.86 um toa reflectance (%) real(kind=real4) :: Ref_138um !1.38 um toa reflectance (%) real(kind=real4) :: Ref_160um !1.60 um toa reflectance (%) real(kind=real4) :: Ref_160um_Clear !1.60 um toa reflectance for clear-sky (%) real(kind=real4) :: Ref_375um !3.75 um toa reflectance (%) real(kind=real4) :: Ref_375um_Clear !3.75 um toa reflectance for clear-sky (%) real(kind=real4) :: Ref_213um !2.13 um toa reflectance (%) real(kind=real4) :: Bt_375um !3.75 um toa brightness temp (K) real(kind=real4) :: Bt_375um_Clear !3.75 um toa brightness temp (K) real(kind=real4) :: Bt_375um_Std !3.75 um toa brightness temp 3x3 Std. Dev. (K) real(kind=real4) :: Emiss_375um !3.75 um pseudo toa emissivity real(kind=real4) :: Emiss_375um_Clear !3.75 um pseudo toa emissivity clear-sky real(kind=real4) :: Bt_67um !6.7 um toa brightness temperature (K) real(kind=real4) :: Bt_85um !8.5 um toa brightness temperature (K) real(kind=real4) :: Bt_10um !10 um toa brightness temperature (K) real(kind=real4) :: Bt_11um !11 um toa brightness temperature (K) real(kind=real4) :: Bt_11um_Sounder !11 um toa brightness temp from sounder (K) real(kind=real4) :: Bt_11um_Std !11 um toa brightness temp 3x3 Std Dev (K) real(kind=real4) :: Bt_11um_Max !11 um toa brightness temp 3x3 Max (K) real(kind=real4) :: Bt_11um_Clear !11 um toa brightness temperature (K) real(kind=real4) :: Emiss_11um_Tropo !11 um tropo emiss real(kind=real4) :: Bt_12um !12 um toa brightness temperature (K) real(kind=real4) :: Bt_12um_Clear !12 um toa bright temp clear-sky (K) real(kind=real4) :: Bt_11um_Bt_67um_Covar !covariance of 11 and 6.7 um bright temp. real(kind=real4) :: Sst_Anal_Uni !3x3 std of background sst field (K) real(kind=real4) :: Emiss_Sfc_375um !the surface emissivity at 3.75 um real(kind=real4) :: Rad_Lunar !Lunar toa radiance from DNB real(kind=real4) :: Ref_Lunar !Lunar reflectance from DNB (%) real(kind=real4) :: Ref_Lunar_Min !Min lunar reflectance over 3x3 (%) real(kind=real4) :: Ref_Lunar_Std !3x3 std dev of lunar ref from DNB (%) real(kind=real4) :: Ref_Lunar_Clear !Lunar reflectance for clear-skies (%) real(kind=real4) :: Zsfc !surface altitude (km) integer :: Num_Segments !number of segments in this data integer(kind=int1) :: Solar_Contamination_Mask !binary mask of solar contamination (0=no,1=yes) integer(kind=int1) :: Sfc_Type !surface type based on UMD classification real(kind=real4) :: Sfc_Temp !surface temperature from ancillary sources real(kind=real4) :: Path_Tpw !TPW along IR path from ancillary sources real(kind=real4) :: Prior !Prior from a precomputed source end type mask_input !----------------------------------------------------------------------------- ! Output Structure !----------------------------------------------------------------------------- type, public :: mask_output integer(kind=int1), dimension(NUMBER_OF_FLAG_BYTES) :: Cld_Flags_Packed !array of packed results integer(kind=int1) :: Cld_Mask_Bayes !Derived 4-level cloud mask integer(kind=int1) :: Cld_Mask_Binary !Derived 2-level cloud mask integer(kind=int1) :: Cld_Mask_Bayes_IR !Derived 4-level cloud mask integer(kind=int1) :: Cld_Mask_Binary_IR !Derived 2-level cloud mask integer :: Cloud_Mask_Bayesian_Flag !flag to tell if code should run real(kind=real4) :: Posterior_Cld_Probability !posterior cloud probability (0-1) real(kind=real4) :: Posterior_Cld_Probability_IR !posterior cloud probability (0-1) integer(kind=int1) :: Dust_Mask integer(kind=int1) :: Smoke_Mask integer(kind=int1) :: Fire_Mask integer(kind=int1) :: Thin_Cirr_Mask integer(kind=int1) :: Cld_Mask_QF ! Quality Flag 0=good, 1=bad end type mask_output !----------------------------------------------------------------------------- ! Diagnostic Output Structure !----------------------------------------------------------------------------- type, public :: diag_output real(kind=real4) :: Array_1 !first diagnostic array real(kind=real4) :: Array_2 !first diagnostic array real(kind=real4) :: Array_3 !first diagnostic array end type diag_output !----------------------------------------------------------------------------- ! Symbol Structure !----------------------------------------------------------------------------- type, public :: symbol_naive_bayesian integer(kind=int1) :: CLOUDY integer(kind=int1) :: PROB_CLOUDY integer(kind=int1) :: PROB_CLEAR integer(kind=int1) :: CLEAR integer(kind=int1) :: CLOUDY_BINARY integer(kind=int1) :: CLEAR_BINARY integer(kind=int1) :: NO integer(kind=int1) :: YES integer(kind=int1) :: WATER_SFC integer(kind=int1) :: EVERGREEN_NEEDLE_SFC integer(kind=int1) :: EVERGREEN_BROAD_SFC integer(kind=int1) :: DECIDUOUS_NEEDLE_SFC integer(kind=int1) :: DECIDUOUS_BROAD_SFC integer(kind=int1) :: MIXED_FORESTS_SFC integer(kind=int1) :: WOODLANDS_SFC integer(kind=int1) :: WOODED_GRASS_SFC integer(kind=int1) :: CLOSED_SHRUBS_SFC integer(kind=int1) :: OPEN_SHRUBS_SFC integer(kind=int1) :: GRASSES_SFC integer(kind=int1) :: CROPLANDS_SFC integer(kind=int1) :: BARE_SFC integer(kind=int1) :: URBAN_SFC integer(kind=int1) :: SHALLOW_OCEAN integer(kind=int1) :: LAND integer(kind=int1) :: COASTLINE integer(kind=int1) :: SHALLOW_INLAND_WATER integer(kind=int1) :: EPHEMERAL_WATER integer(kind=int1) :: DEEP_INLAND_WATER integer(kind=int1) :: MODERATE_OCEAN integer(kind=int1) :: DEEP_OCEAN integer(kind=int1) :: NO_SNOW integer(kind=int1) :: SEA_ICE integer(kind=int1) :: SNOW end type symbol_naive_bayesian !----------------------------------------------------------------------------- ! Level2 structure !----------------------------------------------------------------------------- type, public :: Level2 integer :: Nx integer :: Ny integer :: Year integer :: Doy integer :: Month integer :: Dom integer, dimension(:,:), allocatable :: Buffer_2D_I1 real, dimension(:,:), allocatable :: Bad_Pixel_Mask real, dimension(:,:), allocatable :: Latitude real, dimension(:,:), allocatable :: Longitude real, dimension(:,:), allocatable :: Land_Class real, dimension(:,:), allocatable :: Snow_Class real, dimension(:,:), allocatable :: Coast_Mask real, dimension(:,:), allocatable :: Zsfc real, dimension(:,:), allocatable :: Zsfcstd real, dimension(:,:), allocatable :: Tsfc real, dimension(:,:), allocatable :: Tpw real, dimension(:,:), allocatable :: Zen real, dimension(:,:), allocatable :: Solzen real, dimension(:,:), allocatable :: Solglintzen real, dimension(:,:), allocatable :: Solscatang real, dimension(:,:), allocatable :: Lunzen real, dimension(:,:), allocatable :: Lunglintzen real, dimension(:,:), allocatable :: Solglint_Mask real, dimension(:,:), allocatable :: Sfc_Type_Mask real, dimension(:,:), allocatable :: Topa real, dimension(:,:), allocatable :: Zopa real, dimension(:,:), allocatable :: Emiss3810 real, dimension(:,:), allocatable :: Emiss3811 real, dimension(:,:), allocatable :: Emiss_Tropo_10 real, dimension(:,:), allocatable :: Emiss_Tropo_11 real, dimension(:,:), allocatable :: Bt10 real, dimension(:,:), allocatable :: Bt10Std real, dimension(:,:), allocatable :: Logbt10Std real, dimension(:,:), allocatable :: Bt11 real, dimension(:,:), allocatable :: Bt11Max real, dimension(:,:), allocatable :: Bt11minsub real, dimension(:,:), allocatable :: Bt11maxsub real, dimension(:,:), allocatable :: Dbt11max real, dimension(:,:), allocatable :: Dbt11maxsub real, dimension(:,:), allocatable :: Bt11Std real, dimension(:,:), allocatable :: Bt11_Clr real, dimension(:,:), allocatable :: Logbt11std real, dimension(:,:), allocatable :: Bt12 real, dimension(:,:), allocatable :: Bt12_Clr real, dimension(:,:), allocatable :: Btd8511 real, dimension(:,:), allocatable :: Btd3810 real, dimension(:,:), allocatable :: Btd3811 real, dimension(:,:), allocatable :: Btd1112 real, dimension(:,:), allocatable :: Rgct real, dimension(:,:), allocatable :: Fmft real, dimension(:,:), allocatable :: Ndsi real, dimension(:,:), allocatable :: Ref047 real, dimension(:,:), allocatable :: Ref065 real, dimension(:,:), allocatable :: Ref065Std real, dimension(:,:), allocatable :: Ref065_Clr real, dimension(:,:), allocatable :: Ref065_Min real, dimension(:,:), allocatable :: Ref065_Min_Sub real, dimension(:,:), allocatable :: Ref065_Max_Sub real, dimension(:,:), allocatable :: Dref065_Clr real, dimension(:,:), allocatable :: Dref065_Min real, dimension(:,:), allocatable :: Dref065_Min_Sub real, dimension(:,:), allocatable :: Ref086 real, dimension(:,:), allocatable :: Ref138 real, dimension(:,:), allocatable :: Ref160 real, dimension(:,:), allocatable :: Refrat086065 real, dimension(:,:), allocatable :: Refrat138065 real, dimension(:,:), allocatable :: Bt38 real, dimension(:,:), allocatable :: Bt85 real, dimension(:,:), allocatable :: Bt6711Covar real, dimension(:,:), allocatable :: Logref065Std real, dimension(:,:), allocatable :: Logcod065 real, dimension(:,:), allocatable :: Logcod138 real, dimension(:,:), allocatable :: Logcod160 real, dimension(:,:), allocatable :: Cmask real, dimension(:,:), allocatable :: Cmask_Aux end type Level2 !----------------------------------------------------------------------------- ! Classifier Structure !----------------------------------------------------------------------------- type, public :: Classifier !--- lookup tables real, dimension(:,:,:,:), allocatable :: Clear_Table real, dimension(:,:,:,:), allocatable :: Water_Table real, dimension(:,:,:,:), allocatable :: Ice_Table real, dimension(:,:,:,:), allocatable :: Obs_Table real, dimension(:), allocatable :: Observation_Count real, dimension(:), allocatable :: Cloud_Fraction real, dimension(:), allocatable :: Ice_Fraction real, dimension(:), allocatable :: Water_Fraction integer, dimension(:), allocatable :: Wvl integer, dimension(:), allocatable :: On_Flag !--- attributes integer :: Rank integer :: Nchan_Used integer :: N_Sfc integer :: Nbins_X, Nbins_Y, Nbins_Z real :: X_Min, Y_Min, Z_Min real :: X_Bin, Y_Bin, Z_Bin real :: Zen_Min, Zen_Max real :: Solzen_Min, Solzen_Max real :: Solglintzen_Min, Solglintzen_Max real :: Solglint_Mask_Min, Solglint_Mask_Max real :: Lunzen_Min, Lunzen_Max real :: Lunglintzen_Min, Lunglintzen_Max real :: Solscatang_Min, Solscatang_Max real :: Tsfc_Min, Tsfc_Max real :: Zsfc_Min, Zsfc_Max real :: Tpw_Min, Tpw_Max real :: Snow_Class_Min, Snow_Class_Max real :: Coast_Mask_Min, Coast_Mask_Max real :: Rut_Solzen_Thresh character(len=30) :: Class_Xname, Class_Yname, Class_Zname end type Classifier character(len=30), dimension(:), allocatable :: Classifier_Names real, dimension(:), allocatable :: Conf_Clear_Prob_Clear_Thresh real, dimension(:), allocatable :: Prob_Clear_Prob_Cloudy_Thresh real, dimension(:), allocatable :: Prob_Cloudy_Conf_Cloudy_Thresh real, dimension(:), allocatable :: Rut_Clear_Prob_Clear_Thresh real, dimension(:), allocatable :: Tut_Clear_Prob_Clear_Thresh end module NB_CLOUD_MASK_SERVICES