!------------------------------------------------------------------- ! a conceptual way that might work for ecm ! ! make each lut be 3d and alloctable. ! 1d arrays have Nbins_Y = Nbins_Z = 1 !------------------------------------------------------------------- ! ! To compile: ! gfortran -o run -L/home/dbotambekov/lib/netcdf4_gcc//lib/ ! -I/home/dbotambekov/lib/netcdf4_gcc//include/ -lnetcdf -lnetcdff ! fortran_test.f90 ! ! To debug compile: ! gfortran -o run -L/home/dbotambekov/lib/netcdf4_gcc//lib/ ! -I/home/dbotambekov/lib/netcdf4_gcc//include/ -lnetcdf -lnetcdff -Og -C -g ! -Wall -ffast-math -funroll-loops -ffree-line-length-200 ! -fno-range-check -Warray-bounds -fbounds-check fortran_test.f90 ! ! To run: ! ./run ! !------------------------------------------------------------------- module NB_CLOUD_MASK_LUT_MODULE use NB_CLOUD_MASK_SERVICES use NB_CLOUD_MASK_NETCDF_READ_MODULE, only: & OPEN_NETCDF & , CLOSE_NETCDF & , READ_NETCDF_2D_CHAR & , READ_NETCDF_1D_REAL & , READ_NETCDF_1D_INT & , READ_NETCDF_2D_REAL & , READ_NETCDF_3D_REAL & , READ_NETCDF_4D_REAL & , GET_GROUP_ID & , READ_NETCDF_GLOBAL_ATTRIBUTE_I4 & , READ_NETCDF_GLOBAL_ATTRIBUTE_R4 & , READ_NETCDF_GLOBAL_ATTRIBUTE_CHAR implicit none public NB_CLOUD_MASK_LUT_READ contains subroutine NB_CLOUD_MASK_LUT_READ(Lut_File_Full_Path, Lut, N_Classifier) character(len=*), intent(in) :: Lut_File_Full_Path type(Classifier), dimension(:), allocatable, intent(out) :: Lut integer, intent(out) :: N_Classifier integer :: Ncid, Group_Id integer :: Class_Idx integer :: N_Class_Length integer, dimension(2) :: Start_Read_2d, Count_Read_2d integer, dimension(3) :: Start_Read_3d, Count_Read_3d integer, dimension(4) :: Start_Read_4d, Count_Read_4d real, dimension(:,:), allocatable :: Buffer_2d real, dimension(:,:,:), allocatable :: Buffer_3d real, dimension(:,:,:,:), allocatable :: Buffer_4d real, parameter :: MISSING = -999.0 character(len=100) :: Attr_Name character(len=100) :: Var_Name !character(len=30), dimension(:), allocatable :: Classifier_Names !--- open file call OPEN_NETCDF(trim(Lut_File_Full_Path), Ncid) !--- read number and name of classifiers from file Attr_Name = 'nclassifiers' call READ_NETCDF_GLOBAL_ATTRIBUTE_I4(Ncid, trim(Attr_Name), N_Classifier) !---- allocate main structure based on number of classifiers allocate(Lut(N_Classifier)) ! --- read classifier names Var_Name = 'classifier_names' N_Class_Length = 30 allocate(Classifier_Names(N_Classifier)) call READ_NETCDF_2D_CHAR(Ncid, (/1,1/), Var_Name, Classifier_Names) ! --- read tut/rut thresh allocate(Rut_Clear_Prob_Clear_Thresh(7)) allocate(Tut_Clear_Prob_Clear_Thresh(7)) call READ_NETCDF_1D_REAL(Ncid, (/1/), (/1/), (/7/), 'rut_clear_prob_clear_thresh', Rut_Clear_Prob_Clear_Thresh) call READ_NETCDF_1D_REAL(Ncid, (/1/), (/1/), (/7/), 'tut_clear_prob_clear_thresh', Tut_Clear_Prob_Clear_Thresh) ! --- loop over classifiers do Class_Idx = 1, N_Classifier ! --- open group call GET_GROUP_ID(Ncid, trim(Classifier_Names(Class_Idx)), Group_Id) ! --- read in group attributes call READ_NETCDF_GLOBAL_ATTRIBUTE_I4(Group_Id, 'rank', Lut(Class_Idx)%Rank) call READ_NETCDF_GLOBAL_ATTRIBUTE_I4(Group_Id, 'nchan_used', Lut(Class_Idx)%Nchan_Used) call READ_NETCDF_GLOBAL_ATTRIBUTE_I4(Group_Id, 'nsfc', Lut(Class_Idx)%N_Sfc) call READ_NETCDF_GLOBAL_ATTRIBUTE_CHAR(Group_Id, 'x_name', Lut(Class_Idx)%Class_Xname) call READ_NETCDF_GLOBAL_ATTRIBUTE_I4(Group_Id, 'nbins_x', Lut(Class_Idx)%Nbins_X) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'x_min', Lut(Class_Idx)%X_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'x_bin', Lut(Class_Idx)%X_Bin) call READ_NETCDF_GLOBAL_ATTRIBUTE_CHAR(Group_Id, 'y_name', Lut(Class_Idx)%Class_Yname) call READ_NETCDF_GLOBAL_ATTRIBUTE_I4(Group_Id, 'nbins_y', Lut(Class_Idx)%Nbins_Y) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'y_min', Lut(Class_Idx)%Y_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'y_bin', Lut(Class_Idx)%Y_Bin) call READ_NETCDF_GLOBAL_ATTRIBUTE_CHAR(Group_Id, 'z_name', Lut(Class_Idx)%Class_Zname) call READ_NETCDF_GLOBAL_ATTRIBUTE_I4(Group_Id, 'nbins_z', Lut(Class_Idx)%Nbins_Z) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'z_min', Lut(Class_Idx)%Z_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'z_bin', Lut(Class_Idx)%Z_Bin) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'zenith_minimum', Lut(Class_Idx)%Zen_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'zenith_maximum', Lut(Class_Idx)%Zen_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solar_zenith_minimum', Lut(Class_Idx)%Solzen_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solar_zenith_maximum', Lut(Class_Idx)%Solzen_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solar_glint_zenith_minimum', Lut(Class_Idx)%Solglintzen_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solar_glint_zenith_maximum', Lut(Class_Idx)%Solglintzen_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solglint_mask_minimum', Lut(Class_Idx)%Solglint_Mask_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solglint_mask_maximum', Lut(Class_Idx)%Solglint_Mask_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'surface_elevation_minimum', Lut(Class_Idx)%Zsfc_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'surface_elevation_maximum', Lut(Class_Idx)%Zsfc_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'surface_temperature_minimum', Lut(Class_Idx)%Tsfc_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'surface_temperature_maximum', Lut(Class_Idx)%Tsfc_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'total_precipitable_water_minimum', Lut(Class_Idx)%Tpw_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'total_precipitable_water_maximum', Lut(Class_Idx)%Tpw_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'snow_class_minimum', Lut(Class_Idx)%Snow_Class_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'snow_class_maximum', Lut(Class_Idx)%Snow_Class_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'lunar_zenith_minimum', Lut(Class_Idx)%Lunzen_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'lunar_zenith_maximum', Lut(Class_Idx)%Lunzen_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'lunar_glint_zenith_minimum', Lut(Class_Idx)%Lunglintzen_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'lunar_glint_zenith_maximum', Lut(Class_Idx)%Lunglintzen_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solar_scattering_angle_minimum', Lut(Class_Idx)%Solscatang_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'solar_scattering_angle_maximum', Lut(Class_Idx)%Solscatang_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'coast_mask_minimum', Lut(Class_Idx)%Coast_Mask_Min) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'coast_mask_maximum', Lut(Class_Idx)%Coast_Mask_Max) call READ_NETCDF_GLOBAL_ATTRIBUTE_R4(Group_Id, 'rut_solzen_thresh', Lut(Class_Idx)%Rut_Solzen_Thresh) ! --- read wave length allocate(Lut(Class_Idx)%Wvl(Lut(Class_Idx)%Nchan_Used)) call READ_NETCDF_1D_INT(Group_Id, (/1/), (/1/), (/Lut(Class_Idx)%Nchan_Used/), 'channel_wvl', Lut(Class_Idx)%Wvl) ! --- read on_flag allocate(Lut(Class_Idx)%On_Flag(Lut(Class_Idx)%N_Sfc)) call READ_NETCDF_1D_INT(Group_Id, (/1/), (/1/), (/Lut(Class_Idx)%N_Sfc/), 'on_flag', Lut(Class_Idx)%On_Flag) ! --- allocatable based on sizes in attributes if (Lut(Class_Idx)%Rank == 1) then allocate(Lut(Class_Idx)%Clear_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%N_Sfc,1,1)) allocate(Lut(Class_Idx)%Water_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%N_Sfc,1,1)) allocate(Lut(Class_Idx)%Ice_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%N_Sfc,1,1)) allocate(Lut(Class_Idx)%Obs_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%N_Sfc,1,1)) allocate(Buffer_2d(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%N_Sfc)) ! --- read in lut tables Start_Read_2d = 1 Count_Read_2d(1) = Lut(Class_Idx)%Nbins_X Count_Read_2d(2) = Lut(Class_Idx)%N_Sfc call READ_NETCDF_2D_REAL(Group_Id, Start_Read_2d, (/1,1/), Count_Read_2d, 'clear_table', Buffer_2d) Lut(Class_Idx)%Clear_Table(:,:,1,1) = Buffer_2d(:,:) call READ_NETCDF_2D_REAL(Group_Id, Start_Read_2d, (/1,1/), Count_Read_2d, 'water_table', Buffer_2d) Lut(Class_Idx)%Water_Table(:,:,1,1) = Buffer_2d(:,:) call READ_NETCDF_2D_REAL(Group_Id, Start_Read_2d, (/1,1/), Count_Read_2d, 'ice_table', Buffer_2d) Lut(Class_Idx)%Ice_Table(:,:,1,1) = Buffer_2d(:,:) call READ_NETCDF_2D_REAL(Group_Id, Start_Read_2d, (/1,1/), Count_Read_2d, 'obs_table', Buffer_2d) Lut(Class_Idx)%Obs_Table(:,:,1,1) = Buffer_2d(:,:) elseif (Lut(Class_Idx)%Rank == 2) then allocate(Lut(Class_Idx)%Clear_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%N_Sfc,1)) allocate(Lut(Class_Idx)%Water_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%N_Sfc,1)) allocate(Lut(Class_Idx)%Ice_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%N_Sfc,1)) allocate(Lut(Class_Idx)%Obs_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%N_Sfc,1)) allocate(Buffer_3d(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y,Lut(Class_Idx)%N_Sfc)) ! --- read in lut tables Start_Read_3d = 1 Count_Read_3d(1) = Lut(Class_Idx)%Nbins_X Count_Read_3d(2) = Lut(Class_Idx)%Nbins_Y Count_Read_3d(3) = Lut(Class_Idx)%N_Sfc call READ_NETCDF_3D_REAL(Group_Id, Start_Read_3d, (/1,1,1/), Count_Read_3d, 'clear_table', Buffer_3d) Lut(Class_Idx)%Clear_Table(:,:,:,1) = Buffer_3d(:,:,:) call READ_NETCDF_3D_REAL(Group_Id, Start_Read_3d, (/1,1,1/), Count_Read_3d, 'water_table', Buffer_3d) Lut(Class_Idx)%Water_Table(:,:,:,1) = Buffer_3d(:,:,:) call READ_NETCDF_3D_REAL(Group_Id, Start_Read_3d, (/1,1,1/), Count_Read_3d, 'ice_table', Buffer_3d) Lut(Class_Idx)%Ice_Table(:,:,:,1) = Buffer_3d(:,:,:) call READ_NETCDF_3D_REAL(Group_Id, Start_Read_3d, (/1,1,1/), Count_Read_3d, 'obs_table', Buffer_3d) Lut(Class_Idx)%Obs_Table(:,:,:,1) = Buffer_3d(:,:,:) elseif (Lut(Class_Idx)%Rank == 3) then allocate(Lut(Class_Idx)%Clear_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%Nbins_Z,Lut(Class_Idx)%N_Sfc)) allocate(Lut(Class_Idx)%Water_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%Nbins_Z,Lut(Class_Idx)%N_Sfc)) allocate(Lut(Class_Idx)%Ice_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%Nbins_Z,Lut(Class_Idx)%N_Sfc)) allocate(Lut(Class_Idx)%Obs_Table(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%Nbins_Z,Lut(Class_Idx)%N_Sfc)) allocate(Buffer_4d(Lut(Class_Idx)%Nbins_X,Lut(Class_Idx)%Nbins_Y, & Lut(Class_Idx)%Nbins_Z, Lut(Class_Idx)%N_Sfc)) ! --- read in lut tables Start_Read_4d = 1 Count_Read_4d(1) = Lut(Class_Idx)%Nbins_X Count_Read_4d(2) = Lut(Class_Idx)%Nbins_Y Count_Read_4d(3) = Lut(Class_Idx)%Nbins_Z Count_Read_4d(4) = Lut(Class_Idx)%N_Sfc call READ_NETCDF_4D_REAL(Group_Id, Start_Read_4d, (/1,1,1,1/), Count_Read_4d, 'clear_table', Buffer_4d) Lut(Class_Idx)%Clear_Table(:,:,:,:) = Buffer_4d(:,:,:,:) call READ_NETCDF_4D_REAL(Group_Id, Start_Read_4d, (/1,1,1,1/), Count_Read_4d, 'water_table', Buffer_4d) Lut(Class_Idx)%Water_Table(:,:,:,:) = Buffer_4d(:,:,:,:) call READ_NETCDF_4D_REAL(Group_Id, Start_Read_4d, (/1,1,1,1/), Count_Read_4d, 'ice_table', Buffer_4d) Lut(Class_Idx)%Ice_Table(:,:,:,:) = Buffer_4d(:,:,:,:) call READ_NETCDF_4D_REAL(Group_Id, Start_Read_4d, (/1,1,1,1/), Count_Read_4d, 'obs_table', Buffer_4d) Lut(Class_Idx)%Obs_Table(:,:,:,:) = Buffer_4d(:,:,:,:) else print *,'Rank is > 3, Stopping' stop endif ! --- deallocate buffer if (allocated(Buffer_2d)) deallocate(Buffer_2d) if (allocated(Buffer_3d)) deallocate(Buffer_3d) if (allocated(Buffer_4d)) deallocate(Buffer_4d) enddo ! loop over n class ! --- allocate prob/conf clear/cloudy thresholes allocate(Conf_Clear_Prob_Clear_Thresh(Lut(1)%N_Sfc)) allocate(Prob_Clear_Prob_Cloudy_Thresh(Lut(1)%N_Sfc)) allocate(Prob_Cloudy_Conf_Cloudy_Thresh(Lut(1)%N_Sfc)) ! --- set to missing Conf_Clear_Prob_Clear_Thresh = MISSING Prob_Clear_Prob_Cloudy_Thresh = MISSING Prob_Cloudy_Conf_Cloudy_Thresh = MISSING ! --- read prob/conf clear/cloudy thresholes call READ_NETCDF_1D_REAL(Ncid, (/1/), (/1/),(/Lut(1)%N_Sfc/), & 'conf_clear_prob_clear_thresh', Conf_Clear_Prob_Clear_Thresh) call READ_NETCDF_1D_REAL(Ncid, (/1/), (/1/),(/Lut(1)%N_Sfc/), & 'prob_clear_prob_cloud_thresh', Prob_Clear_Prob_Cloudy_Thresh) call READ_NETCDF_1D_REAL(Ncid, (/1/), (/1/),(/Lut(1)%N_Sfc/), & 'prob_cloud_conf_cloud_thresh', Prob_Cloudy_Conf_Cloudy_Thresh) !--- close file call CLOSE_NETCDF(Ncid) !deallocate(Classifier_Names) if (allocated(Buffer_2d)) deallocate(Buffer_2d) if (allocated(Buffer_2d)) deallocate(Buffer_3d) if (allocated(Buffer_2d)) deallocate(Buffer_4d) end subroutine NB_CLOUD_MASK_LUT_READ end module NB_CLOUD_MASK_LUT_MODULE