diff --git a/Get_CRTM_Binary_Files.sh b/Get_CRTM_Binary_Files.sh index 3a559f2..56b6949 100755 --- a/Get_CRTM_Binary_Files.sh +++ b/Get_CRTM_Binary_Files.sh @@ -1,4 +1,5 @@ -foldername="fix_REL-3.0.0_20230303" +#https://bin.ssec.wisc.edu/pub/s4/CRTM/fix_REL-3.0.0_20230802.tgz +foldername="fix_REL-3.0.0_20230802" filename="${foldername}.tgz" if test -f "$filename"; then @@ -7,15 +8,22 @@ if test -f "$filename"; then else #untar the file and move directory to fix tar -zxvf $filename - mv $foldername fix + cd $foldername/ + mv fix .. + cd .. + rmdir $foldername echo "fix/ directory created from existing $filename file." fi else #download, untar, move - echo "downloading $filename, please wait about 5 minutes (3.3 GB tar file)" - wget ftp://ftp.ssec.wisc.edu/pub/s4/CRTM/$filename # CRTM binary files, add "-q" to suppress output. - tar -zxvf $filename - mv $foldername fix + echo "Downloading $filename, please wait about 5 minutes (4 GB tar file)" + wget https://bin.ssec.wisc.edu/pub/s4/CRTM/$filename # CRTM binary files, add "-q" to suppress output. + + tar -zxvf $filename + cd $foldername/ + mv fix .. + cd .. + rmdir $foldername echo "fix/ directory created from downloaded $filename." fi echo "Completed." diff --git a/src/Build/libsrc/make.dependencies b/src/Build/libsrc/make.dependencies index 4d8732f..f8f86cd 100644 --- a/src/Build/libsrc/make.dependencies +++ b/src/Build/libsrc/make.dependencies @@ -30,7 +30,7 @@ CRTM_AtmOptics.o : CRTM_AtmOptics.f90 AOvar_Define.o CRTM_AtmOptics_Define.o CRT CRTM_Atmosphere_Define.o : CRTM_Atmosphere_Define.f90 CRTM_Relative_Humidity.o CRTM_Aerosol_Define.o CRTM_Cloud_Define.o CRTM_Parameters.o Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o CRTM_Atmosphere.o : CRTM_Atmosphere.f90 iAtm_Define.o CRTM_Model_Profiles.o CRTM_Atmosphere_Define.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o CRTM_Hypsometric.o CRTM_ChannelInfo_Define.o : CRTM_ChannelInfo_Define.f90 Sort_Utility.o SensorInfo_Parameters.o CRTM_Parameters.o File_Utility.o Message_Handler.o -CRTM_CloudCoeff.o : CRTM_CloudCoeff.f90 CloudCoeff_IO.o CloudCoeff_Define.o Message_Handler.o +CRTM_CloudCoeff.o : CRTM_CloudCoeff.f90 CloudCoeff_IO.o CloudCoeff_Define.o Message_Handler.o CRTM_CloudCover_Define.o : CRTM_CloudCover_Define.f90 CRTM_Cloud_Define.o CRTM_Atmosphere_Define.o CRTM_Parameters.o Compare_Float_Numbers.o Message_Handler.o File_Utility.o Type_Kinds.o CRTM_Cloud_Define.o : CRTM_Cloud_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o CRTM_CloudScatter.o : CRTM_CloudScatter.f90 CSvar_Define.o CRTM_AtmOptics_Define.o CRTM_Interpolation.o CRTM_GeometryInfo_Define.o CRTM_Atmosphere_Define.o CRTM_CloudCoeff.o CRTM_SpcCoeff.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o @@ -43,14 +43,15 @@ CRTM_GeometryInfo_Define.o : CRTM_GeometryInfo_Define.f90 CRTM_Geometry_Define.o CRTM_GeometryInfo.o : CRTM_GeometryInfo.f90 CRTM_GeometryInfo_Define.o CRTM_Parameters.o Date_Utility.o Message_Handler.o Type_Kinds.o CRTM_Hypsometric.o : CRTM_Hypsometric.f90 Type_Kinds.o Message_Handler.o Fundamental_Constants.o CRTM_Parameters.o CRTM_Atmosphere_Define.o CRTM_Interpolation.o : CRTM_Interpolation.f90 Type_Kinds.o -CRTM_IRiceCoeff.o : CRTM_IRiceCoeff.f90 SEcategory_Define.o Message_Handler.o +CRTM_IRiceCoeff.o : CRTM_IRiceCoeff.f90 SEcategory_Define.o SEcategory_IO.o Message_Handler.o CRTM_IR_Ice_SfcOptics.o : CRTM_IR_Ice_SfcOptics.f90 CRTM_IRiceCoeff.o CRTM_SEcategory.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Spectral_Units_Conversion.o Message_Handler.o Type_Kinds.o -CRTM_IRlandCoeff.o : CRTM_IRlandCoeff.f90 SEcategory_Define.o Message_Handler.o +CRTM_IRlandCoeff.o : CRTM_IRlandCoeff.f90 SEcategory_Define.o SEcategory_IO.o Message_Handler.o CRTM_IR_Land_SfcOptics.o : CRTM_IR_Land_SfcOptics.f90 CRTM_IRlandCoeff.o CRTM_SEcategory.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o -CRTM_IRsnowCoeff.o : CRTM_IRsnowCoeff.f90 SEcategory_Define.o Message_Handler.o -CRTM_IR_Snow_SfcOptics.o : CRTM_IR_Snow_SfcOptics.f90 CRTM_IRsnowCoeff.o CRTM_SEcategory.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Spectral_Units_Conversion.o Message_Handler.o Type_Kinds.o +CRTM_IRSnowEM.o : CRTM_IRSnowEM.f90 IRsnowCoeff_Define.o CRTM_Interpolation.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o +CRTM_IRsnowCoeff.o : CRTM_IRsnowCoeff.f90 SEcategory_Define.o SEcategory_IO.o IRsnowCoeff_Define.o IRsnowCoeff_IO.o Message_Handler.o +CRTM_IR_Snow_SfcOptics.o : CRTM_IR_Snow_SfcOptics.f90 CRTM_IRsnowCoeff.o CRTM_SEcategory.o CRTM_IRSnowEM.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Spectral_Units_Conversion.o Message_Handler.o Type_Kinds.o CRTM_IRSSEM.o : CRTM_IRSSEM.f90 IRwaterCoeff_Define.o CRTM_Interpolation.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o -CRTM_IRwaterCoeff.o : CRTM_IRwaterCoeff.f90 IRwaterCoeff_Define.o Message_Handler.o +CRTM_IRwaterCoeff.o : CRTM_IRwaterCoeff.f90 IRwaterCoeff_Define.o IRwaterCoeff_IO.o Message_Handler.o CRTM_IR_Water_SfcOptics.o : CRTM_IR_Water_SfcOptics.f90 CRTM_IRwaterCoeff.o CRTM_IRSSEM.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o CRTM_K_Matrix_Module.o : CRTM_K_Matrix_Module.f90 RTV_Define.o ASvar_Define.o CSvar_Define.o AOvar_Define.o CRTM_CloudCover_Define.o CRTM_Planck_Functions.o NLTECoeff_Define.o ACCoeff_Define.o CRTM_NLTECorrection.o CRTM_AerosolCoeff.o CRTM_CloudCoeff.o CRTM_AncillaryInput_Define.o CRTM_MoleculeScatter.o CRTM_AntennaCorrection.o CRTM_RTSolution.o CRTM_SfcOptics.o CRTM_SfcOptics_Define.o CRTM_AtmOptics.o CRTM_CloudScatter.o CRTM_AerosolScatter.o CRTM_AtmOptics_Define.o CRTM_AtmAbsorption.o CRTM_Predictor.o CRTM_Predictor_Define.o CRTM_GeometryInfo.o CRTM_GeometryInfo_Define.o CRTM_Atmosphere.o CRTM_Options_Define.o CRTM_RTSolution_Define.o CRTM_ChannelInfo_Define.o CRTM_Geometry_Define.o CRTM_Surface_Define.o CRTM_Atmosphere_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o CRTM_LifeCycle.o : CRTM_LifeCycle.f90 CRTM_MWwaterCoeff.o CRTM_VISiceCoeff.o CRTM_VISsnowCoeff.o CRTM_VISlandCoeff.o CRTM_VISwaterCoeff.o CRTM_IRiceCoeff.o CRTM_IRsnowCoeff.o CRTM_IRlandCoeff.o CRTM_IRwaterCoeff.o CRTM_CloudCoeff.o CRTM_AerosolCoeff.o CRTM_TauCoeff.o CRTM_SpcCoeff.o CRTM_ChannelInfo_Define.o Message_Handler.o @@ -80,13 +81,13 @@ CRTM_Surface_Define.o : CRTM_Surface_Define.f90 CRTM_SensorData_Define.o Binary_ CRTM_Tangent_Linear_Module.o : CRTM_Tangent_Linear_Module.f90 RTV_Define.o ASvar_Define.o CSvar_Define.o AOvar_Define.o CRTM_CloudCover_Define.o CRTM_Planck_Functions.o NLTECoeff_Define.o ACCoeff_Define.o CRTM_NLTECorrection.o CRTM_AerosolCoeff.o CRTM_CloudCoeff.o CRTM_AncillaryInput_Define.o CRTM_MoleculeScatter.o CRTM_AntennaCorrection.o CRTM_RTSolution.o CRTM_SfcOptics.o CRTM_SfcOptics_Define.o CRTM_AtmOptics.o CRTM_CloudScatter.o CRTM_AerosolScatter.o CRTM_AtmOptics_Define.o CRTM_AtmAbsorption.o CRTM_Predictor.o CRTM_Predictor_Define.o CRTM_GeometryInfo.o CRTM_GeometryInfo_Define.o CRTM_Atmosphere.o CRTM_Options_Define.o CRTM_RTSolution_Define.o CRTM_ChannelInfo_Define.o CRTM_Geometry_Define.o CRTM_Surface_Define.o CRTM_Atmosphere_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o CRTM_TauCoeff.o : CRTM_TauCoeff.f90 CRTM_SensorInfo.o ODZeeman_TauCoeff.o TauCoeff_Define.o ODSSU_Define.o ODSSU_TauCoeff.o ODPS_Define.o ODPS_TauCoeff.o ODAS_Define.o ODAS_TauCoeff.o CRTM_Parameters.o Message_Handler.o Binary_File_Utility.o File_Utility.o Type_Kinds.o CRTM_Utility.o : CRTM_Utility.f90 CRTM_Parameters.o Message_Handler.o Type_Kinds.o -CRTM_VISiceCoeff.o : CRTM_VISiceCoeff.f90 SEcategory_Define.o Message_Handler.o +CRTM_VISiceCoeff.o : CRTM_VISiceCoeff.f90 SEcategory_Define.o SEcategory_IO.o Message_Handler.o CRTM_VIS_Ice_SfcOptics.o : CRTM_VIS_Ice_SfcOptics.f90 CRTM_VISiceCoeff.o CRTM_SEcategory.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Spectral_Units_Conversion.o Message_Handler.o Type_Kinds.o -CRTM_VISlandCoeff.o : CRTM_VISlandCoeff.f90 SEcategory_Define.o Message_Handler.o +CRTM_VISlandCoeff.o : CRTM_VISlandCoeff.f90 SEcategory_Define.o SEcategory_IO.o Message_Handler.o CRTM_VIS_Land_SfcOptics.o : CRTM_VIS_Land_SfcOptics.f90 CRTM_VISlandCoeff.o CRTM_SEcategory.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Spectral_Units_Conversion.o Message_Handler.o Type_Kinds.o -CRTM_VISsnowCoeff.o : CRTM_VISsnowCoeff.f90 SEcategory_Define.o Message_Handler.o +CRTM_VISsnowCoeff.o : CRTM_VISsnowCoeff.f90 SEcategory_Define.o SEcategory_IO.o Message_Handler.o CRTM_VIS_Snow_SfcOptics.o : CRTM_VIS_Snow_SfcOptics.f90 CRTM_VISsnowCoeff.o CRTM_SEcategory.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Spectral_Units_Conversion.o Message_Handler.o Type_Kinds.o -CRTM_VISwaterCoeff.o : CRTM_VISwaterCoeff.f90 SEcategory_Define.o Message_Handler.o +CRTM_VISwaterCoeff.o : CRTM_VISwaterCoeff.f90 SEcategory_Define.o SEcategory_IO.o Message_Handler.o CRTM_VIS_Water_SfcOptics.o : CRTM_VIS_Water_SfcOptics.f90 CRTM_VISwaterCoeff.o CRTM_SEcategory.o CRTM_SfcOptics_Define.o CRTM_GeometryInfo_Define.o CRTM_Surface_Define.o CRTM_SpcCoeff.o CRTM_Parameters.o Spectral_Units_Conversion.o Message_Handler.o Type_Kinds.o CSvar_Define.o : CSvar_Define.f90 CRTM_Interpolation.o Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o DateTime_Utility.o : DateTime_Utility.f90 Date_Utility.o Type_Kinds.o @@ -102,7 +103,13 @@ Fundamental_Constants.o : Fundamental_Constants.f90 Type_Kinds.o Guillou.o : Guillou.f90 Fundamental_Constants.o Type_Kinds.o Hyperbolic_Step.o : Hyperbolic_Step.f90 Type_Kinds.o iAtm_Define.o : iAtm_Define.f90 CRTM_Parameters.o Message_Handler.o Type_Kinds.o -IRwaterCoeff_Define.o : IRwaterCoeff_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_Define.o : IRwaterCoeff_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_netCDF_IO.o : IRwaterCoeff_netCDF_IO.f90 IRwaterCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_IO.o : IRwaterCoeff_IO.f90 IRwaterCoeff_netCDF_IO.o IRwaterCoeff_Define.o File_Utility.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_Define.o : IRsnowCoeff_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_Binary_IO.o : IRsnowCoeff_Binary_IO.f90 IRsnowCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_netCDF_IO.o : IRsnowCoeff_netCDF_IO.f90 IRsnowCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_IO.o : IRsnowCoeff_IO.f90 IRsnowCoeff_netCDF_IO.o IRsnowCoeff_Binary_IO.o IRsnowCoeff_Define.o File_Utility.o Message_Handler.o Type_Kinds.o Large_Scale_Correction_Module.o : Large_Scale_Correction_Module.f90 CRTM_Interpolation.o FitCoeff_Define.o Type_Kinds.o Liu.o : Liu.f90 Fundamental_Constants.o Type_Kinds.o LSEatlas_Define.o : LSEatlas_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o @@ -165,6 +172,8 @@ Reflection_Correction_Module.o : Reflection_Correction_Module.f90 FitCoeff_Defin RTV_Define.o : RTV_Define.f90 CRTM_SfcOptics.o SensorInfo_Parameters.o CRTM_Parameters.o Message_Handler.o Type_Kinds.o Search_Utility.o : Search_Utility.f90 Message_Handler.o Type_Kinds.o SEcategory_Define.o : SEcategory_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o +SEcategory_netCDF_IO.o : SEcategory_netCDF_IO.f90 SEcategory_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +SEcategory_IO.o : SEcategory_IO.f90 SEcategory_netCDF_IO.o SEcategory_Define.o File_Utility.o Message_Handler.o Type_Kinds.o SensorInfo_Parameters.o : SensorInfo_Parameters.f90 Slope_Variance.o : Slope_Variance.f90 Hyperbolic_Step.o Type_Kinds.o Small_Scale_Correction_Module.o : Small_Scale_Correction_Module.f90 FitCoeff_Define.o Type_Kinds.o diff --git a/src/Build/libsrc/make.filelist b/src/Build/libsrc/make.filelist index 75eb56f..dd77366 100644 --- a/src/Build/libsrc/make.filelist +++ b/src/Build/libsrc/make.filelist @@ -33,8 +33,9 @@ FSRC_FILES = \ AerosolCoeff_Define.f90 AerosolCoeff_Binary_IO.f90 AerosolCoeff_netCDF_IO.f90 AerosolCoeff_IO.f90 \ CRTM_Options_Define.f90 \ CRTM_AOD_Module.f90 \ - IRwaterCoeff_Define.f90 \ - SEcategory_Define.f90 \ + IRwaterCoeff_Define.f90 IRwaterCoeff_IO.f90 IRwaterCoeff_netCDF_IO.f90 \ + IRsnowCoeff_Define.f90 IRsnowCoeff_IO.f90 IRsnowCoeff_netCDF_IO.f90 IRsnowCoeff_Binary_IO.f90 \ + SEcategory_Define.f90 SEcategory_IO.f90 SEcategory_netCDF_IO.f90\ LSEatlas_Define.f90 \ MWwaterCoeff_Define.f90 \ FitCoeff_Define.f90 \ @@ -88,7 +89,7 @@ FSRC_FILES = \ CRTM_SfcOptics.f90 \ CRTM_IR_Land_SfcOptics.f90 CRTM_IR_Water_SfcOptics.f90 CRTM_IR_Snow_SfcOptics.f90 CRTM_IR_Ice_SfcOptics.f90 \ CRTM_MW_Land_SfcOptics.f90 CRTM_MW_Water_SfcOptics.f90 CRTM_MW_Snow_SfcOptics.f90 CRTM_MW_Ice_SfcOptics.f90 \ - CRTM_VIS_Land_SfcOptics.f90 CRTM_VIS_Water_SfcOptics.f90 CRTM_VIS_Snow_SfcOptics.f90 CRTM_VIS_Ice_SfcOptics.f90 \ + CRTM_VIS_Land_SfcOptics.f90 CRTM_VIS_Water_SfcOptics.f90 CRTM_VIS_Snow_SfcOptics.f90 CRTM_VIS_Ice_SfcOptics.f90 \ CRTM_SEcategory.f90 \ CRTM_LowFrequency_MWSSEM.f90 \ CRTM_Fastem1.f90 \ @@ -100,6 +101,7 @@ FSRC_FILES = \ Guillou.f90 Ellison.f90 Liu.f90 \ Fresnel.f90 \ CRTM_IRSSEM.f90 \ + CRTM_IRSnowEM.f90 \ CRTM_AtmOptics.f90 CRTM_AtmOptics_Define.f90 AOvar_Define.f90 \ CRTM_Planck_Functions.f90 \ RTV_Define.f90 \ diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index bdf94c5..559848d 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -66,9 +66,17 @@ list( APPEND crtm_src_files Coefficients/CRTM_VISwaterCoeff.f90 Coefficients/EmisCoeff/IR_Land/LSEatlas/LSEatlas_Define.f90 Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Define.f90 + Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_IO.f90 + Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_netCDF_IO.f90 + Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Define.f90 + Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_IO.f90 + Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Binary_IO.f90 + Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_netCDF_IO.f90 Coefficients/EmisCoeff/MW_Water/MWwaterCoeff_Define.f90 Coefficients/EmisCoeff/MW_Water/MWwaterLUT/MWwaterLUT_Define.f90 Coefficients/EmisCoeff/SEcategory/SEcategory_Define.f90 + Coefficients/EmisCoeff/SEcategory/SEcategory_IO.f90 + Coefficients/EmisCoeff/SEcategory/SEcategory_netCDF_IO.f90 Coefficients/FitCoeff/FitCoeff_Define.f90 Coefficients/FitCoeff/FitCoeff_Destroy.inc Coefficients/FitCoeff/FitCoeff_Equal.inc @@ -141,6 +149,7 @@ list( APPEND crtm_src_files SfcOptics/CRTM_VIS_Snow_SfcOptics.f90 SfcOptics/CRTM_VIS_Water_SfcOptics.f90 SfcOptics/IR_Water/IRSSEM/CRTM_IRSSEM.f90 + SfcOptics/IR_Snow/CRTM_IRSnowEM.f90 SfcOptics/MW_Water/FASTEM_MWSSEM/Azimuth_Emissivity_F6_Module.f90 SfcOptics/MW_Water/FASTEM_MWSSEM/Azimuth_Emissivity_Module.f90 SfcOptics/MW_Water/FASTEM_MWSSEM/CRTM_Fastem1.f90 diff --git a/src/CRTM_LifeCycle.f90 b/src/CRTM_LifeCycle.f90 index 6671a57..aa3118b 100644 --- a/src/CRTM_LifeCycle.f90 +++ b/src/CRTM_LifeCycle.f90 @@ -21,7 +21,11 @@ ! 2021-07-26 Patrick Stegmann Add optional format input for ! TauCoeff files. ! +! 2022-03-09 Cheng Dang Add optional format input for +! EmisCoeff files. ! +! 2022-05-27 Cheng Dang Add optional input file for +! Snow Emissivity files. MODULE CRTM_LifeCycle @@ -128,6 +132,13 @@ MODULE CRTM_LifeCycle ! VISsnowCoeff_File = VISsnowCoeff_File , & ! VISiceCoeff_File = VISiceCoeff_File , & ! MWwaterCoeff_File = MWwaterCoeff_File , & +! IRwaterCoeff_Format = IRwaterCoeff_Format , & +! IRlandCoeff_Format = IRlandCoeff_Format , & +! IRiceCoeff_Format = IRiceCoeff_Format , & +! VISwaterCoeff_Format= VISwaterCoeff_Format, & +! VISlandCoeff_Format = VISlandCoeff_Format , & +! VISsnowCoeff_Format = VISsnowCoeff_Format , & +! VISiceCoeff_Format = VISiceCoeff_Format , & ! File_Path = File_Path , & ! NC_File_Path = NC_File_Path , & ! Quiet = Quiet , & @@ -303,6 +314,7 @@ MODULE CRTM_LifeCycle ! - NPOESS.IRsnow.EmisCoeff.bin [DEFAULT] ! - IGBP.IRsnow.EmisCoeff.bin ! - USGS.IRsnow.EmisCoeff.bin +! - Nalli.IRsnow.EmisCoeff.bin ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar @@ -363,6 +375,78 @@ MODULE CRTM_LifeCycle ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! IRwaterCoeff_Format: Format of the CRTM IRwater coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! IRlandCoeff_Format: Format of the CRTM IRland coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! IRsnowCoeff_Format: Format of the CRTM IRsnow coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! IRiceCoeff_Format: Format of the CRTM IRice coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! VISwaterCoeff_Format: Format of the CRTM VISwater coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! VISlandCoeff_Format: Format of the CRTM VISland coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! VISsnowCoeff_Format: Format of the CRTM VISsnow coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! VISiceCoeff_Format: Format of the CRTM VISice coefficients +! Available options +! - Binary [DEFAULT] +! - netCDF +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! File_Path: Character string specifying a file path for the ! input data files in Binary format. If not specified, ! the current directory is the default. @@ -454,6 +538,15 @@ FUNCTION CRTM_Init( & VISsnowCoeff_File , & ! Optional input VISiceCoeff_File , & ! Optional input MWwaterCoeff_File , & ! Optional input + IRwaterCoeff_Format , & ! Optional input + IRlandCoeff_Format , & ! Optional input + IRsnowCoeff_Format , & ! Optional input + IRiceCoeff_Format , & ! Optional input + VISwaterCoeff_Format, & ! Optional input + VISlandCoeff_Format , & ! Optional input + VISsnowCoeff_Format , & ! Optional input + VISiceCoeff_Format , & ! Optional input + IRsnow_Model , & ! Optional input File_Path , & ! Optional input NC_File_Path , & ! Optional input Load_CloudCoeff , & ! Optional input @@ -483,6 +576,15 @@ FUNCTION CRTM_Init( & CHARACTER(*), OPTIONAL, INTENT(IN) :: VISsnowCoeff_File CHARACTER(*), OPTIONAL, INTENT(IN) :: VISiceCoeff_File CHARACTER(*), OPTIONAL, INTENT(IN) :: MWwaterCoeff_File + CHARACTER(*), OPTIONAL, INTENT(IN) :: IRwaterCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: IRlandCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: IRsnowCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: IRiceCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: VISwaterCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: VISlandCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: VISsnowCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: VISiceCoeff_Format + CHARACTER(*), OPTIONAL, INTENT(IN) :: IRsnow_Model CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path CHARACTER(*), OPTIONAL, INTENT(IN) :: NC_File_Path LOGICAL , OPTIONAL, INTENT(IN) :: Load_CloudCoeff @@ -506,6 +608,7 @@ FUNCTION CRTM_Init( & CHARACTER(SL) :: Default_TauCoeff_Format CHARACTER(SL) :: Default_IRwaterCoeff_File CHARACTER(SL) :: Default_IRlandCoeff_File + CHARACTER(SL) :: Default_IRsnow_Model CHARACTER(SL) :: Default_IRsnowCoeff_File CHARACTER(SL) :: Default_IRiceCoeff_File CHARACTER(SL) :: Default_VISwaterCoeff_File @@ -513,13 +616,22 @@ FUNCTION CRTM_Init( & CHARACTER(SL) :: Default_VISsnowCoeff_File CHARACTER(SL) :: Default_VISiceCoeff_File CHARACTER(SL) :: Default_MWwaterCoeff_File + CHARACTER(SL) :: Default_IRwaterCoeff_Format + CHARACTER(SL) :: Default_IRlandCoeff_Format + CHARACTER(SL) :: Default_IRsnowCoeff_Format + CHARACTER(SL) :: Default_IRsnowCoeff_Model + CHARACTER(SL) :: Default_IRiceCoeff_Format + CHARACTER(SL) :: Default_VISwaterCoeff_Format + CHARACTER(SL) :: Default_VISlandCoeff_Format + CHARACTER(SL) :: Default_VISsnowCoeff_Format + CHARACTER(SL) :: Default_VISiceCoeff_Format CHARACTER(SL) :: Default_File_Path INTEGER :: l, n, n_Sensors LOGICAL :: Local_Load_CloudCoeff LOGICAL :: Local_Load_AerosolCoeff - LOGICAL :: netCDF + LOGICAL :: netCDF, isSEcategory ! ****** ! TEMPORARY UNTIL LOAD ROUTINE INTERFACES HAVE BEEN MODIFIED INTEGER :: iQuiet @@ -571,6 +683,7 @@ FUNCTION CRTM_Init( & Default_CloudCoeff_File = 'CloudCoeff.bin' Default_IRwaterCoeff_File = 'Nalli.IRwater.EmisCoeff.bin' Default_IRlandCoeff_File = 'NPOESS.IRland.EmisCoeff.bin' + Default_IRsnow_Model = 'SEcategory' Default_IRsnowCoeff_File = 'NPOESS.IRsnow.EmisCoeff.bin' Default_IRiceCoeff_File = 'NPOESS.IRice.EmisCoeff.bin' Default_VISwaterCoeff_File = 'NPOESS.VISwater.EmisCoeff.bin' @@ -583,14 +696,21 @@ FUNCTION CRTM_Init( & Default_CloudCoeff_Format = 'Binary' Default_SpcCoeff_Format = 'Binary' Default_TauCoeff_Format = 'Binary' - ! ...Were other coefficient schemes specified? + Default_IRwaterCoeff_Format = 'Binary' + Default_IRlandCoeff_Format = 'Binary' + Default_IRsnowCoeff_Format = 'Binary' + Default_IRiceCoeff_Format = 'Binary' + Default_VISwaterCoeff_Format= 'Binary' + Default_VISlandCoeff_Format = 'Binary' + Default_VISsnowCoeff_Format = 'Binary' + Default_VISiceCoeff_Format = 'Binary' + ! ...Were coefficient models specified? IF ( PRESENT(Aerosol_Model ) ) Default_Aerosol_Model = TRIM(ADJUSTL(Aerosol_Model)) IF ( PRESENT(Cloud_Model ) ) Default_Cloud_Model = TRIM(ADJUSTL(Cloud_Model)) + IF ( PRESENT(IRsnow_Model ) ) Default_IRsnow_Model = TRIM(ADJUSTL(IRsnow_Model)) ! ...Were other filenames specified? IF ( PRESENT(AerosolCoeff_File ) ) Default_AerosolCoeff_File = TRIM(ADJUSTL(AerosolCoeff_File)) IF ( PRESENT(CloudCoeff_File ) ) Default_CloudCoeff_File = TRIM(ADJUSTL(CloudCoeff_File)) - IF ( PRESENT(SpcCoeff_Format ) ) Default_SpcCoeff_Format = TRIM(ADJUSTL(SpcCoeff_Format)) - IF ( PRESENT(TauCoeff_Format ) ) Default_TauCoeff_Format = TRIM(ADJUSTL(TauCoeff_Format)) IF ( PRESENT(IRwaterCoeff_File ) ) Default_IRwaterCoeff_File = TRIM(ADJUSTL(IRwaterCoeff_File)) IF ( PRESENT(IRlandCoeff_File ) ) Default_IRlandCoeff_File = TRIM(ADJUSTL(IRlandCoeff_File)) IF ( PRESENT(IRsnowCoeff_File ) ) Default_IRsnowCoeff_File = TRIM(ADJUSTL(IRsnowCoeff_File)) @@ -603,25 +723,25 @@ FUNCTION CRTM_Init( & ! ...Were data formats specificed? IF ( PRESENT(AerosolCoeff_Format ) ) Default_AerosolCoeff_Format = TRIM(ADJUSTL(AerosolCoeff_Format)) IF ( PRESENT(CloudCoeff_Format ) ) Default_CloudCoeff_Format = TRIM(ADJUSTL(CloudCoeff_Format)) + IF ( PRESENT(SpcCoeff_Format ) ) Default_SpcCoeff_Format = TRIM(ADJUSTL(SpcCoeff_Format)) + IF ( PRESENT(TauCoeff_Format ) ) Default_TauCoeff_Format = TRIM(ADJUSTL(TauCoeff_Format)) + IF ( PRESENT(IRwaterCoeff_Format ) ) Default_IRwaterCoeff_Format = TRIM(ADJUSTL(IRwaterCoeff_Format)) + IF ( PRESENT(IRlandCoeff_Format ) ) Default_IRlandCoeff_Format = TRIM(ADJUSTL(IRlandCoeff_Format)) + IF ( PRESENT(IRsnowCoeff_Format ) ) Default_IRsnowCoeff_Format = TRIM(ADJUSTL(IRsnowCoeff_Format)) + IF ( PRESENT(IRiceCoeff_Format ) ) Default_IRiceCoeff_Format = TRIM(ADJUSTL(IRiceCoeff_Format)) + IF ( PRESENT(VISwaterCoeff_Format) ) Default_VISwaterCoeff_Format = TRIM(ADJUSTL(VISwaterCoeff_Format)) + IF ( PRESENT(VISlandCoeff_Format ) ) Default_VISlandCoeff_Format = TRIM(ADJUSTL(VISlandCoeff_Format)) + IF ( PRESENT(VISsnowCoeff_Format ) ) Default_VISsnowCoeff_Format = TRIM(ADJUSTL(VISsnowCoeff_Format)) + IF ( PRESENT(VISiceCoeff_Format ) ) Default_VISiceCoeff_Format = TRIM(ADJUSTL(VISiceCoeff_Format)) ! ...Was a path specified? IF ( PRESENT(File_Path) ) THEN - Default_IRwaterCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_IRwaterCoeff_File) - Default_IRlandCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_IRlandCoeff_File) - Default_IRsnowCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_IRsnowCoeff_File) - Default_IRiceCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_IRiceCoeff_File) - Default_VISwaterCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_VISwaterCoeff_File) - Default_VISlandCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_VISlandCoeff_File) - Default_VISsnowCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_VISsnowCoeff_File) - Default_VISiceCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_VISiceCoeff_File) Default_MWwaterCoeff_File = TRIM(ADJUSTL(File_Path)) // TRIM(Default_MWwaterCoeff_File) END IF ! Load the spectral coefficients netCDF = .FALSE. - IF ( PRESENT(SpcCoeff_Format) ) THEN - IF ( TRIM(SpcCoeff_Format) == 'netCDF' ) THEN + IF (Default_SpcCoeff_Format == 'netCDF' ) THEN netCDF = .TRUE. - END IF END IF IF (PRESENT(Quiet) .AND. (.NOT. Quiet)) THEN WRITE(*,*) "Loading"//SpcCoeff_Format//" spectral coefficients." @@ -641,10 +761,8 @@ FUNCTION CRTM_Init( & ! Load the transmittance model coefficients netCDF = .FALSE. - IF ( PRESENT(TauCoeff_Format) ) THEN - IF ( TRIM(TauCoeff_Format) == 'netCDF' ) THEN + IF (Default_TauCoeff_Format == 'netCDF' ) THEN netCDF = .TRUE. - END IF END IF IF (PRESENT(Quiet) .AND. (.NOT. Quiet)) THEN WRITE(*,*) "Loading "//TauCoeff_Format//" transmittance coefficients." @@ -700,7 +818,6 @@ FUNCTION CRTM_Init( & netCDF = .FALSE. IF ( PRESENT(File_Path) ) Default_File_Path = File_Path END IF - ! Default_AerosolCoeff_File = TRIM(ADJUSTL(Default_File_Path)) // TRIM(Default_AerosolCoeff_File) IF (PRESENT(Quiet) .AND. (.NOT. Quiet)) THEN WRITE(*, '("Loading aerosol coefficients: ", a) ') TRIM(Default_AerosolCoeff_File) END IF @@ -724,8 +841,18 @@ FUNCTION CRTM_Init( & ! ...Infrared Infrared_Sensor: IF ( ANY(SpcCoeff_IsInfraredSensor(SC)) ) THEN ! ...IR land + IF ( Default_IRlandCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + WRITE(*, '("Loading IR land emissivity coefficients: ", a) ') TRIM(Default_IRlandCoeff_File) err_stat = CRTM_IRlandCoeff_Load( & Default_IRlandCoeff_File, & + File_Path = Default_File_Path, & + netCDF = netCDF , & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -735,8 +862,18 @@ FUNCTION CRTM_Init( & RETURN END IF ! ...IR Water + IF ( Default_IRwaterCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + WRITE(*, '("Loading IR water emissivity coefficients: ", a) ') TRIM(Default_IRwaterCoeff_File) err_stat = CRTM_IRwaterCoeff_Load( & Default_IRwaterCoeff_File, & + netCDF = netCDF , & + File_Path = Default_File_Path, & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -746,8 +883,24 @@ FUNCTION CRTM_Init( & RETURN END IF ! ...IR snow + IF ( Default_IRsnowCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + IF (Default_IRsnow_Model == 'SEcategory') THEN + isSEcategory = .TRUE. + ELSE + isSEcategory = .FALSE. + END IF + WRITE(*, '("Loading IR snow emissivity coefficients: ", a) ') TRIM(Default_IRsnowCoeff_File) err_stat = CRTM_IRsnowCoeff_Load( & Default_IRsnowCoeff_File, & + netCDF = netCDF , & + isSEcategory = isSEcategory , & + File_Path = Default_File_Path, & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -757,8 +910,18 @@ FUNCTION CRTM_Init( & RETURN END IF ! ...IR ice + IF ( Default_IRiceCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + WRITE(*, '("Loading IR ice emissivity coefficients: ", a) ') TRIM(Default_IRiceCoeff_File) err_stat = CRTM_IRiceCoeff_Load( & Default_IRiceCoeff_File, & + netCDF = netCDF , & + File_Path = Default_File_Path, & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -772,8 +935,18 @@ FUNCTION CRTM_Init( & ! ...Visible Visible_Sensor: IF ( ANY(SpcCoeff_IsVisibleSensor(SC)) ) THEN ! ...VIS land + IF ( Default_VISlandCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + WRITE(*, '("Loading VIS land emissivity coefficients: ", a) ') TRIM(Default_VISlandCoeff_File) err_stat = CRTM_VISlandCoeff_Load( & Default_VISlandCoeff_File, & + netCDF = netCDF , & + File_Path = Default_File_Path, & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -783,8 +956,18 @@ FUNCTION CRTM_Init( & RETURN END IF ! ...VIS water + IF ( Default_VISwaterCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + WRITE(*, '("Loading VIS water emissivity coefficients: ", a) ') TRIM(Default_VISwaterCoeff_File) err_stat = CRTM_VISwaterCoeff_Load( & Default_VISwaterCoeff_File, & + netCDF = netCDF , & + File_Path = Default_File_Path, & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -794,8 +977,18 @@ FUNCTION CRTM_Init( & RETURN END IF ! ...VIS snow + IF ( Default_VISsnowCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + WRITE(*, '("Loading VIS snow emissivity coefficients: ", a) ') TRIM(Default_VISsnowCoeff_File) err_stat = CRTM_VISsnowCoeff_Load( & Default_VISsnowCoeff_File, & + netCDF = netCDF , & + File_Path = Default_File_Path, & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -805,8 +998,18 @@ FUNCTION CRTM_Init( & RETURN END IF ! ...VIS ice + IF ( Default_VISiceCoeff_Format == 'netCDF' ) THEN + netCDF = .TRUE. + IF ( PRESENT(NC_File_Path) ) Default_File_Path = NC_File_Path + ELSE + netCDF = .FALSE. + IF ( PRESENT(File_Path) ) Default_File_Path = File_Path + END IF + WRITE(*, '("Loading VIS ice emissivity coefficients: ", a) ') TRIM(Default_VISiceCoeff_File) err_stat = CRTM_VISiceCoeff_Load( & Default_VISiceCoeff_File, & + netCDF = netCDF , & + File_Path = Default_File_Path, & Quiet = Quiet , & Process_ID = Process_ID , & Output_Process_ID = Output_Process_ID ) @@ -818,6 +1021,7 @@ FUNCTION CRTM_Init( & END IF Visible_Sensor ! ...Microwave + WRITE(*, '("Loading MW water emissivity coefficients: ", a) ') TRIM(Default_MWwaterCoeff_File) Microwave_Sensor: IF ( ANY(SpcCoeff_IsMicrowaveSensor(SC)) ) THEN ! ...MW water err_stat = CRTM_MWwaterCoeff_Load( & diff --git a/src/Coefficients/CRTM_IRiceCoeff.f90 b/src/Coefficients/CRTM_IRiceCoeff.f90 index a015f0f..e144c7d 100644 --- a/src/Coefficients/CRTM_IRiceCoeff.f90 +++ b/src/Coefficients/CRTM_IRiceCoeff.f90 @@ -2,7 +2,7 @@ ! CRTM_IRiceCoeff ! ! Module containing the shared CRTM infrared ice surface emissivity -! data and their load/destruction routines. +! data and their load/destruction routines. ! ! PUBLIC DATA: ! IRiceC: Data structure containing the infrared ice surface @@ -19,7 +19,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 20-Jan-2012 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add SEcategory_ReadFile_IO for netCDF I/O MODULE CRTM_IRiceCoeff @@ -30,8 +32,8 @@ MODULE CRTM_IRiceCoeff USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message USE SEcategory_Define, ONLY: SEcategory_type, & SEcategory_Associated, & - SEcategory_Destroy, & - SEcategory_ReadFile + SEcategory_Destroy + USE SEcategory_IO, ONLY: SEcategory_ReadFile_IO ! Disable all implicit typing IMPLICIT NONE @@ -79,6 +81,7 @@ MODULE CRTM_IRiceCoeff ! Error_Status = CRTM_IRiceCoeff_Load( & ! Filename, & ! File_Path = File_Path , & +! netCDF = netCDF , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -100,6 +103,15 @@ MODULE CRTM_IRiceCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -123,7 +135,7 @@ MODULE CRTM_IRiceCoeff ! Output_Process_ID: Set this argument to the MPI process ID in which ! all INFORMATION messages are to be output. If ! the passed Process_ID value agrees with this value -! the INFORMATION messages are output. +! the INFORMATION messages are output. ! This argument is ignored if the Quiet argument ! is set. ! UNITS: N/A @@ -151,6 +163,7 @@ MODULE CRTM_IRiceCoeff FUNCTION CRTM_IRiceCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -158,7 +171,8 @@ FUNCTION CRTM_IRiceCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path - LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID ! Function result @@ -169,8 +183,10 @@ FUNCTION CRTM_IRiceCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: IRiceCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary - ! Setup + ! Setup err_stat = SUCCESS ! ...Assign the filename to local variable IRiceCoeff_File = ADJUSTL(Filename) @@ -189,12 +205,16 @@ FUNCTION CRTM_IRiceCoeff_Load( & ELSE pid_msg = '' END IF - - + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Read the IR ice SEcategory file - err_stat = SEcategory_ReadFile( & + err_stat = SEcategory_ReadFile_IO( & IRiceC, & IRiceCoeff_File, & + netCDF = .NOT. Binary, & Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading IRiceCoeff SEcategory file '//TRIM(IRiceCoeff_File)//TRIM(pid_msg) @@ -203,7 +223,7 @@ FUNCTION CRTM_IRiceCoeff_Load( & CONTAINS - + SUBROUTINE Load_CleanUp() CALL SEcategory_Destroy( IRiceC ) err_stat = FAILURE @@ -283,7 +303,7 @@ FUNCTION CRTM_IRiceCoeff_Destroy( Process_ID ) RESULT( err_stat ) END FUNCTION CRTM_IRiceCoeff_Destroy - + !------------------------------------------------------------------------------ !:sdoc+: ! diff --git a/src/Coefficients/CRTM_IRlandCoeff.f90 b/src/Coefficients/CRTM_IRlandCoeff.f90 index daa5a53..36d7b49 100644 --- a/src/Coefficients/CRTM_IRlandCoeff.f90 +++ b/src/Coefficients/CRTM_IRlandCoeff.f90 @@ -19,7 +19,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 19-Aug-2011 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add SEcategory_ReadFile_IO for netCDF I/O MODULE CRTM_IRlandCoeff @@ -30,8 +32,8 @@ MODULE CRTM_IRlandCoeff USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message USE SEcategory_Define, ONLY: SEcategory_type, & SEcategory_Associated, & - SEcategory_Destroy, & - SEcategory_ReadFile + SEcategory_Destroy + USE SEcategory_IO, ONLY: SEcategory_ReadFile_IO ! Disable all implicit typing IMPLICIT NONE @@ -80,6 +82,7 @@ MODULE CRTM_IRlandCoeff ! Error_Status = CRTM_IRlandCoeff_Load( & ! Filename, & ! File_Path = File_Path , & +! netCDF = netCDF , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -101,6 +104,15 @@ MODULE CRTM_IRlandCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -152,6 +164,7 @@ MODULE CRTM_IRlandCoeff FUNCTION CRTM_IRlandCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -159,6 +172,7 @@ FUNCTION CRTM_IRlandCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID @@ -170,6 +184,8 @@ FUNCTION CRTM_IRlandCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: IRlandCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary ! Setup err_stat = SUCCESS @@ -190,12 +206,16 @@ FUNCTION CRTM_IRlandCoeff_Load( & ELSE pid_msg = '' END IF + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF ! Read the IR land SEcategory file - err_stat = SEcategory_ReadFile( & + err_stat = SEcategory_ReadFile_IO( & IRlandC, & IRlandCoeff_File, & + netCDF = .NOT. Binary, & Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading IRlandCoeff SEcategory file '//TRIM(IRlandCoeff_File)//TRIM(pid_msg) diff --git a/src/Coefficients/CRTM_IRsnowCoeff.f90 b/src/Coefficients/CRTM_IRsnowCoeff.f90 index a32d123..38c4294 100644 --- a/src/Coefficients/CRTM_IRsnowCoeff.f90 +++ b/src/Coefficients/CRTM_IRsnowCoeff.f90 @@ -2,7 +2,7 @@ ! CRTM_IRsnowCoeff ! ! Module containing the shared CRTM infrared snow surface emissivity -! data and their load/destruction routines. +! data and their load/destruction routines. ! ! PUBLIC DATA: ! IRsnowC: Data structure containing the infrared snow surface @@ -19,7 +19,12 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 20-Jan-2012 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add SEcategory_ReadFile_IO for netCDF I/O +! Modified by: Cheng Dang, 31-May-2022 +! dangch@ucar.edu +! Add IRsnowCoeff modules MODULE CRTM_IRsnowCoeff @@ -27,11 +32,15 @@ MODULE CRTM_IRsnowCoeff ! Environment setup ! ----------------- ! Module use - USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message - USE SEcategory_Define, ONLY: SEcategory_type, & - SEcategory_Associated, & - SEcategory_Destroy, & - SEcategory_ReadFile + USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message + USE SEcategory_Define, ONLY: SEcategory_type, & + SEcategory_Associated, & + SEcategory_Destroy + USE SEcategory_IO, ONLY: SEcategory_ReadFile_IO + USE IRsnowCoeff_Define, ONLY: IRsnowCoeff_type, & + IRsnowCoeff_Associated, & + IRsnowCoeff_Destroy + USE IRsnowCoeff_IO, ONLY: IRsnowCoeff_ReadFile ! Disable all implicit typing IMPLICIT NONE @@ -42,11 +51,12 @@ MODULE CRTM_IRsnowCoeff ! Everything private by default PRIVATE ! The shared data - PUBLIC :: IRsnowC + PUBLIC :: IRsnowC_SE, IRsnowC ! Procedures PUBLIC :: CRTM_IRsnowCoeff_Load PUBLIC :: CRTM_IRsnowCoeff_Destroy PUBLIC :: CRTM_IRsnowCoeff_IsLoaded + PUBLIC :: CRTM_IRsnowCoeff_SE_IsLoaded ! ----------------- @@ -59,7 +69,8 @@ MODULE CRTM_IRsnowCoeff ! ------------------------------------------------ ! The shared infrared snow surface emissivity data ! ------------------------------------------------ - TYPE(SEcategory_type), SAVE :: IRsnowC + TYPE(SEcategory_type), SAVE :: IRsnowC_SE + TYPE(IRsnowCoeff_type), SAVE :: IRsnowC CONTAINS @@ -79,6 +90,8 @@ MODULE CRTM_IRsnowCoeff ! Error_Status = CRTM_IRsnowCoeff_Load( & ! Filename, & ! File_Path = File_Path , & +! netCDF = netCDF , & +! isSEcategory = isSEcategory , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -100,6 +113,25 @@ MODULE CRTM_IRsnowCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! isSEcategory: Set this logical argument to specify emissivity +! classification. +! If == .TRUE., SEcategory [DEFAULT]. +! == .False., Nalli +! If not specified, default is .TRUE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -123,7 +155,7 @@ MODULE CRTM_IRsnowCoeff ! Output_Process_ID: Set this argument to the MPI process ID in which ! all INFORMATION messages are to be output. If ! the passed Process_ID value agrees with this value -! the INFORMATION messages are output. +! the INFORMATION messages are output. ! This argument is ignored if the Quiet argument ! is set. ! UNITS: N/A @@ -151,6 +183,8 @@ MODULE CRTM_IRsnowCoeff FUNCTION CRTM_IRsnowCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input + isSEcategory , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -158,7 +192,9 @@ FUNCTION CRTM_IRsnowCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path - LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: isSEcategory + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID ! Function result @@ -169,8 +205,11 @@ FUNCTION CRTM_IRsnowCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: IRsnowCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary + LOGICAL :: SEcategory - ! Setup + ! Setup err_stat = SUCCESS ! ...Assign the filename to local variable IRsnowCoeff_File = ADJUSTL(Filename) @@ -189,23 +228,39 @@ FUNCTION CRTM_IRsnowCoeff_Load( & ELSE pid_msg = '' END IF - - - ! Read the IR snow SEcategory file - err_stat = SEcategory_ReadFile( & - IRsnowC, & - IRsnowCoeff_File, & - Quiet = .NOT. noisy ) + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + ! ...Check SEcategory argument + SEcategory = .TRUE. + IF ( PRESENT(isSEcategory) ) SEcategory = isSEcategory + + ! Read IR snow emissivity file + IF ( SEcategory ) THEN + ! SEcategory + err_stat = SEcategory_ReadFile_IO( & + IRsnowC_SE, & + IRsnowCoeff_File, & + netCDF = .NOT. Binary, & + Quiet = .NOT. noisy ) + ELSE + ! Other classifications + err_stat = IRsnowCoeff_ReadFile( & + IRsnowC, & + IRsnowCoeff_File, & + netCDF = .NOT. Binary, & + Quiet = .NOT. noisy ) + END IF IF ( err_stat /= SUCCESS ) THEN - msg = 'Error reading IRsnowCoeff SEcategory file '//TRIM(IRsnowCoeff_File)//TRIM(pid_msg) - CALL Load_Cleanup(); RETURN + msg = 'Error reading IRsnowCoeff file '//TRIM(IRsnowCoeff_File)//TRIM(pid_msg) + CALL Load_Cleanup(); RETURN END IF - CONTAINS - + SUBROUTINE Load_CleanUp() - CALL SEcategory_Destroy( IRsnowC ) + CALL SEcategory_Destroy( IRsnowC_SE ) + CALL IRsnowCoeff_Destroy( IRsnowC ) err_stat = FAILURE CALL Display_Message( ROUTINE_NAME, msg, err_stat ) END SUBROUTINE Load_CleanUp @@ -273,9 +328,17 @@ FUNCTION CRTM_IRsnowCoeff_Destroy( Process_ID ) RESULT( err_stat ) pid_msg = '' END IF - ! Destroy the structure - CALL SEcategory_Destroy( IRsnowC ) - IF ( SEcategory_Associated( IRsnowC ) ) THEN + ! Destroy the data structure + ! ...SEcategory + CALL SEcategory_Destroy( IRsnowC_SE ) + IF ( SEcategory_Associated( IRsnowC_SE ) ) THEN + err_stat = FAILURE + msg = 'Error deallocating IRsnowCoeff_SE shared data structure'//TRIM(pid_msg) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ); RETURN + END IF + ! ...Other classifications + CALL IRsnowCoeff_Destroy( IRsnowC ) + IF ( IRsnowCoeff_Associated( IRsnowC ) ) THEN err_stat = FAILURE msg = 'Error deallocating IRsnowCoeff shared data structure'//TRIM(pid_msg) CALL Display_Message( ROUTINE_NAME, msg, err_stat ); RETURN @@ -283,7 +346,7 @@ FUNCTION CRTM_IRsnowCoeff_Destroy( Process_ID ) RESULT( err_stat ) END FUNCTION CRTM_IRsnowCoeff_Destroy - + !------------------------------------------------------------------------------ !:sdoc+: ! @@ -295,14 +358,39 @@ END FUNCTION CRTM_IRsnowCoeff_Destroy ! been loaded into the public data structure IRsnowC. ! ! CALLING SEQUENCE: -! status = CRTM_IRsnowCoeff_IsLoaded() +! status = CRTM_IRsnowCoeff_IsLoaded ! !:sdoc-: !------------------------------------------------------------------------------ FUNCTION CRTM_IRsnowCoeff_IsLoaded() RESULT( IsLoaded ) LOGICAL :: IsLoaded - IsLoaded = SEcategory_Associated( IRsnowC ) + + IsLoaded = IRsnowCoeff_Associated( IRsnowC ) + END FUNCTION CRTM_IRsnowCoeff_IsLoaded +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! CRTM_IRsnowCoeff_SE_IsLoaded +! +! PURPOSE: +! Function to test if infrared snow surface emissivity data has +! been loaded into the public data structure IRsnowC_SE. +! +! CALLING SEQUENCE: +! status = CRTM_IRsnowCoeff_SE_IsLoaded +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION CRTM_IRsnowCoeff_SE_IsLoaded() RESULT( IsLoaded ) + LOGICAL :: IsLoaded + + IsLoaded = SEcategory_Associated( IRsnowC_SE ) + + END FUNCTION CRTM_IRsnowCoeff_SE_IsLoaded + END MODULE CRTM_IRsnowCoeff diff --git a/src/Coefficients/CRTM_IRwaterCoeff.f90 b/src/Coefficients/CRTM_IRwaterCoeff.f90 index 6aa919d..c4f8871 100644 --- a/src/Coefficients/CRTM_IRwaterCoeff.f90 +++ b/src/Coefficients/CRTM_IRwaterCoeff.f90 @@ -19,7 +19,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 04-May-2012 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add IRwaterCoeff_ReadFile_IO for netCDF I/O MODULE CRTM_IRwaterCoeff @@ -30,8 +32,8 @@ MODULE CRTM_IRwaterCoeff USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message USE IRwaterCoeff_Define, ONLY: IRwaterCoeff_type, & IRwaterCoeff_Associated, & - IRwaterCoeff_Destroy, & - IRwaterCoeff_ReadFile + IRwaterCoeff_Destroy + USE IRwaterCoeff_IO , ONLY: IRwaterCoeff_ReadFile_IO ! Disable all implicit typing IMPLICIT NONE @@ -47,6 +49,7 @@ MODULE CRTM_IRwaterCoeff PUBLIC :: CRTM_IRwaterCoeff_Load PUBLIC :: CRTM_IRwaterCoeff_Destroy PUBLIC :: CRTM_IRwaterCoeff_IsLoaded + PUBLIC :: CRTM_IRwaterCoeff_Classification ! ----------------- @@ -100,6 +103,15 @@ MODULE CRTM_IRwaterCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -151,6 +163,7 @@ MODULE CRTM_IRwaterCoeff FUNCTION CRTM_IRwaterCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -158,6 +171,7 @@ FUNCTION CRTM_IRwaterCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID @@ -169,6 +183,8 @@ FUNCTION CRTM_IRwaterCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: IRwaterCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary ! Setup err_stat = SUCCESS @@ -189,13 +205,17 @@ FUNCTION CRTM_IRwaterCoeff_Load( & ELSE pid_msg = '' END IF + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF ! Read the IR water IRwaterCoeff file - err_stat = IRwaterCoeff_ReadFile( & + err_stat = IRwaterCoeff_ReadFile_IO( & IRwaterC, & IRwaterCoeff_File, & - Quiet = .NOT. noisy ) + netCDF = .NOT. Binary, & + Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading IRwaterCoeff IRwaterCoeff file '//TRIM(IRwaterCoeff_File)//TRIM(pid_msg) CALL Load_Cleanup(); RETURN @@ -282,6 +302,32 @@ FUNCTION CRTM_IRwaterCoeff_Destroy( Process_ID ) RESULT( err_stat ) END FUNCTION CRTM_IRwaterCoeff_Destroy +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! CRTM_IRwaterCoeff_Classification +! +! PURPOSE: +! Function to return the classification name of the public +! IRwaterC structure +! +! CALLING SEQUENCE: +! Classification = CRTM_IRwaterCoeff_Classification() +! +! FUNCTION RESULT: +! Classification: The classification name field of IRwaterC +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + PURE FUNCTION CRTM_IRwaterCoeff_Classification() RESULT( Classification ) + CHARACTER(LEN(IRwaterC%Classification_Name)) :: Classification + Classification = IRwaterC%Classification_Name + END FUNCTION !------------------------------------------------------------------------------ !:sdoc+: diff --git a/src/Coefficients/CRTM_VISiceCoeff.f90 b/src/Coefficients/CRTM_VISiceCoeff.f90 index 85b095d..6ee613a 100644 --- a/src/Coefficients/CRTM_VISiceCoeff.f90 +++ b/src/Coefficients/CRTM_VISiceCoeff.f90 @@ -2,7 +2,7 @@ ! CRTM_VISiceCoeff ! ! Module containing the shared CRTM visible ice surface emissivity -! data and their load/destruction routines. +! data and their load/destruction routines. ! ! PUBLIC DATA: ! VISiceC: Data structure containing the visible ice surface @@ -19,7 +19,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 20-Jan-2012 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add SEcategory_ReadFile_IO for netCDF I/O MODULE CRTM_VISiceCoeff @@ -30,8 +32,8 @@ MODULE CRTM_VISiceCoeff USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message USE SEcategory_Define, ONLY: SEcategory_type, & SEcategory_Associated, & - SEcategory_Destroy, & - SEcategory_ReadFile + SEcategory_Destroy + USE SEcategory_IO, ONLY: SEcategory_ReadFile_IO ! Disable all implicit typing IMPLICIT NONE @@ -79,6 +81,7 @@ MODULE CRTM_VISiceCoeff ! Error_Status = CRTM_VISiceCoeff_Load( & ! Filename, & ! File_Path = File_Path , & +! netCDF = netCDF , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -100,6 +103,15 @@ MODULE CRTM_VISiceCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -123,7 +135,7 @@ MODULE CRTM_VISiceCoeff ! Output_Process_ID: Set this argument to the MPI process ID in which ! all INFORMATION messages are to be output. If ! the passed Process_ID value agrees with this value -! the INFORMATION messages are output. +! the INFORMATION messages are output. ! This argument is ignored if the Quiet argument ! is set. ! UNITS: N/A @@ -151,6 +163,7 @@ MODULE CRTM_VISiceCoeff FUNCTION CRTM_VISiceCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -158,7 +171,8 @@ FUNCTION CRTM_VISiceCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path - LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID ! Function result @@ -169,8 +183,10 @@ FUNCTION CRTM_VISiceCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: VISiceCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary - ! Setup + ! Setup err_stat = SUCCESS ! ...Assign the filename to local variable VISiceCoeff_File = ADJUSTL(Filename) @@ -189,12 +205,16 @@ FUNCTION CRTM_VISiceCoeff_Load( & ELSE pid_msg = '' END IF - - + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Read the VIS ice SEcategory file - err_stat = SEcategory_ReadFile( & + err_stat = SEcategory_ReadFile_IO( & VISiceC, & VISiceCoeff_File, & + netCDF = .NOT. Binary, & Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading VISiceCoeff SEcategory file '//TRIM(VISiceCoeff_File)//TRIM(pid_msg) @@ -203,7 +223,7 @@ FUNCTION CRTM_VISiceCoeff_Load( & CONTAINS - + SUBROUTINE Load_CleanUp() CALL SEcategory_Destroy( VISiceC ) err_stat = FAILURE @@ -283,7 +303,7 @@ FUNCTION CRTM_VISiceCoeff_Destroy( Process_ID ) RESULT( err_stat ) END FUNCTION CRTM_VISiceCoeff_Destroy - + !------------------------------------------------------------------------------ !:sdoc+: ! diff --git a/src/Coefficients/CRTM_VISlandCoeff.f90 b/src/Coefficients/CRTM_VISlandCoeff.f90 index 577ad44..9cbbe9c 100644 --- a/src/Coefficients/CRTM_VISlandCoeff.f90 +++ b/src/Coefficients/CRTM_VISlandCoeff.f90 @@ -2,7 +2,7 @@ ! CRTM_VISlandCoeff ! ! Module containing the shared CRTM visible land surface emissivity -! data and their load/destruction routines. +! data and their load/destruction routines. ! ! PUBLIC DATA: ! VISlandC: Data structure containing the visible land surface @@ -19,7 +19,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 20-Jan-2012 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add SEcategory_ReadFile_IO for netCDF I/O MODULE CRTM_VISlandCoeff @@ -30,8 +32,8 @@ MODULE CRTM_VISlandCoeff USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message USE SEcategory_Define, ONLY: SEcategory_type, & SEcategory_Associated, & - SEcategory_Destroy, & - SEcategory_ReadFile + SEcategory_Destroy + USE SEcategory_IO, ONLY: SEcategory_ReadFile_IO ! Disable all implicit typing IMPLICIT NONE @@ -79,6 +81,7 @@ MODULE CRTM_VISlandCoeff ! Error_Status = CRTM_VISlandCoeff_Load( & ! Filename, & ! File_Path = File_Path , & +! netCDF = netCDF , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -100,6 +103,15 @@ MODULE CRTM_VISlandCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -123,7 +135,7 @@ MODULE CRTM_VISlandCoeff ! Output_Process_ID: Set this argument to the MPI process ID in which ! all INFORMATION messages are to be output. If ! the passed Process_ID value agrees with this value -! the INFORMATION messages are output. +! the INFORMATION messages are output. ! This argument is ignored if the Quiet argument ! is set. ! UNITS: N/A @@ -151,6 +163,7 @@ MODULE CRTM_VISlandCoeff FUNCTION CRTM_VISlandCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -158,7 +171,8 @@ FUNCTION CRTM_VISlandCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path - LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID ! Function result @@ -169,8 +183,10 @@ FUNCTION CRTM_VISlandCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: VISlandCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary - ! Setup + ! Setup err_stat = SUCCESS ! ...Assign the filename to local variable VISlandCoeff_File = ADJUSTL(Filename) @@ -189,12 +205,15 @@ FUNCTION CRTM_VISlandCoeff_Load( & ELSE pid_msg = '' END IF - - + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + ! Read the VIS land SEcategory file - err_stat = SEcategory_ReadFile( & + err_stat = SEcategory_ReadFile_IO( & VISlandC, & VISlandCoeff_File, & + netCDF = .NOT. Binary, & Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading VISlandCoeff SEcategory file '//TRIM(VISlandCoeff_File)//TRIM(pid_msg) @@ -203,7 +222,7 @@ FUNCTION CRTM_VISlandCoeff_Load( & CONTAINS - + SUBROUTINE Load_CleanUp() CALL SEcategory_Destroy( VISlandC ) err_stat = FAILURE @@ -283,7 +302,7 @@ FUNCTION CRTM_VISlandCoeff_Destroy( Process_ID ) RESULT( err_stat ) END FUNCTION CRTM_VISlandCoeff_Destroy - + !------------------------------------------------------------------------------ !:sdoc+: ! diff --git a/src/Coefficients/CRTM_VISsnowCoeff.f90 b/src/Coefficients/CRTM_VISsnowCoeff.f90 index 1bca761..18df6cb 100644 --- a/src/Coefficients/CRTM_VISsnowCoeff.f90 +++ b/src/Coefficients/CRTM_VISsnowCoeff.f90 @@ -2,7 +2,7 @@ ! CRTM_VISsnowCoeff ! ! Module containing the shared CRTM visible snow surface emissivity -! data and their load/destruction routines. +! data and their load/destruction routines. ! ! PUBLIC DATA: ! VISsnowC: Data structure containing the visible snow surface @@ -19,7 +19,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 20-Jan-2012 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add SEcategory_ReadFile_IO for netCDF I/O MODULE CRTM_VISsnowCoeff @@ -30,8 +32,8 @@ MODULE CRTM_VISsnowCoeff USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message USE SEcategory_Define, ONLY: SEcategory_type, & SEcategory_Associated, & - SEcategory_Destroy, & - SEcategory_ReadFile + SEcategory_Destroy + USE SEcategory_IO, ONLY: SEcategory_ReadFile_IO ! Disable all implicit typing IMPLICIT NONE @@ -79,6 +81,7 @@ MODULE CRTM_VISsnowCoeff ! Error_Status = CRTM_VISsnowCoeff_Load( & ! Filename, & ! File_Path = File_Path , & +! netCDF = netCDF , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -100,6 +103,15 @@ MODULE CRTM_VISsnowCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -123,7 +135,7 @@ MODULE CRTM_VISsnowCoeff ! Output_Process_ID: Set this argument to the MPI process ID in which ! all INFORMATION messages are to be output. If ! the passed Process_ID value agrees with this value -! the INFORMATION messages are output. +! the INFORMATION messages are output. ! This argument is ignored if the Quiet argument ! is set. ! UNITS: N/A @@ -151,6 +163,7 @@ MODULE CRTM_VISsnowCoeff FUNCTION CRTM_VISsnowCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -158,7 +171,8 @@ FUNCTION CRTM_VISsnowCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path - LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID ! Function result @@ -169,8 +183,10 @@ FUNCTION CRTM_VISsnowCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: VISsnowCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary - ! Setup + ! Setup err_stat = SUCCESS ! ...Assign the filename to local variable VISsnowCoeff_File = ADJUSTL(Filename) @@ -189,12 +205,16 @@ FUNCTION CRTM_VISsnowCoeff_Load( & ELSE pid_msg = '' END IF - - + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Read the VIS snow SEcategory file - err_stat = SEcategory_ReadFile( & + err_stat = SEcategory_ReadFile_IO( & VISsnowC, & VISsnowCoeff_File, & + netCDF = .NOT. Binary, & Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading VISsnowCoeff SEcategory file '//TRIM(VISsnowCoeff_File)//TRIM(pid_msg) @@ -203,7 +223,7 @@ FUNCTION CRTM_VISsnowCoeff_Load( & CONTAINS - + SUBROUTINE Load_CleanUp() CALL SEcategory_Destroy( VISsnowC ) err_stat = FAILURE @@ -283,7 +303,7 @@ FUNCTION CRTM_VISsnowCoeff_Destroy( Process_ID ) RESULT( err_stat ) END FUNCTION CRTM_VISsnowCoeff_Destroy - + !------------------------------------------------------------------------------ !:sdoc+: ! diff --git a/src/Coefficients/CRTM_VISwaterCoeff.f90 b/src/Coefficients/CRTM_VISwaterCoeff.f90 index 55bcaa6..4aa28c9 100644 --- a/src/Coefficients/CRTM_VISwaterCoeff.f90 +++ b/src/Coefficients/CRTM_VISwaterCoeff.f90 @@ -2,7 +2,7 @@ ! CRTM_VISwaterCoeff ! ! Module containing the shared CRTM visible water surface emissivity -! data and their load/destruction routines. +! data and their load/destruction routines. ! ! PUBLIC DATA: ! VISwaterC: Data structure containing the visible water surface @@ -19,7 +19,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 20-Jan-2012 ! paul.vandelst@noaa.gov -! +! Modified by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Add SEcategory_ReadFile_IO for netCDF I/O MODULE CRTM_VISwaterCoeff @@ -30,8 +32,8 @@ MODULE CRTM_VISwaterCoeff USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message USE SEcategory_Define, ONLY: SEcategory_type, & SEcategory_Associated, & - SEcategory_Destroy, & - SEcategory_ReadFile + SEcategory_Destroy + USE SEcategory_IO, ONLY: SEcategory_ReadFile_IO ! Disable all implicit typing IMPLICIT NONE @@ -79,6 +81,7 @@ MODULE CRTM_VISwaterCoeff ! Error_Status = CRTM_VISwaterCoeff_Load( & ! Filename, & ! File_Path = File_Path , & +! netCDF = netCDF , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -100,6 +103,15 @@ MODULE CRTM_VISwaterCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to specify file format. +! If == .FALSE., Binary [DEFAULT]. +! == .TRUE., netCDF +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. @@ -123,7 +135,7 @@ MODULE CRTM_VISwaterCoeff ! Output_Process_ID: Set this argument to the MPI process ID in which ! all INFORMATION messages are to be output. If ! the passed Process_ID value agrees with this value -! the INFORMATION messages are output. +! the INFORMATION messages are output. ! This argument is ignored if the Quiet argument ! is set. ! UNITS: N/A @@ -151,6 +163,7 @@ MODULE CRTM_VISwaterCoeff FUNCTION CRTM_VISwaterCoeff_Load( & Filename , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -158,7 +171,8 @@ FUNCTION CRTM_VISwaterCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Filename CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path - LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID ! Function result @@ -169,8 +183,10 @@ FUNCTION CRTM_VISwaterCoeff_Load( & CHARACTER(ML) :: msg, pid_msg CHARACTER(ML) :: VISwaterCoeff_File LOGICAL :: noisy + ! Function variables + LOGICAL :: Binary - ! Setup + ! Setup err_stat = SUCCESS ! ...Assign the filename to local variable VISwaterCoeff_File = ADJUSTL(Filename) @@ -189,12 +205,16 @@ FUNCTION CRTM_VISwaterCoeff_Load( & ELSE pid_msg = '' END IF - - + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Read the VIS water SEcategory file - err_stat = SEcategory_ReadFile( & + err_stat = SEcategory_ReadFile_IO( & VISwaterC, & VISwaterCoeff_File, & + netCDF = .NOT. Binary, & Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading VISwaterCoeff SEcategory file '//TRIM(VISwaterCoeff_File)//TRIM(pid_msg) @@ -203,7 +223,7 @@ FUNCTION CRTM_VISwaterCoeff_Load( & CONTAINS - + SUBROUTINE Load_CleanUp() CALL SEcategory_Destroy( VISwaterC ) err_stat = FAILURE @@ -283,7 +303,7 @@ FUNCTION CRTM_VISwaterCoeff_Destroy( Process_ID ) RESULT( err_stat ) END FUNCTION CRTM_VISwaterCoeff_Destroy - + !------------------------------------------------------------------------------ !:sdoc+: ! diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_Binary_IO.f90 b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_Binary_IO.f90 similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_Binary_IO.f90 rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_Binary_IO.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_Define.f90 b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_Define.f90 similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_Define.f90 rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_Define.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/EmisCoeff_NC2BIN.f90 b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/EmisCoeff_NC2BIN.f90 similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/EmisCoeff_NC2BIN.f90 rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/EmisCoeff_NC2BIN.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/Makefile b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/Makefile similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/Makefile rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/Makefile diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/make.dependencies b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/make.dependencies similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/make.dependencies rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/make.dependencies diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN.sh b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN.sh similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN.sh rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_NC2BIN/run_EmisCoeff_NC2BIN.sh diff --git a/src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_netCDF_IO.f90 b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_netCDF_IO.f90 similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/EmisCoeff_netCDF_IO.f90 rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/EmisCoeff_netCDF_IO.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Water/Test_EmisCoeff/Makefile b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/Test_EmisCoeff/Makefile similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/Test_EmisCoeff/Makefile rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/Test_EmisCoeff/Makefile diff --git a/src/Coefficients/EmisCoeff/IR_Water/Test_EmisCoeff/Test_EmisCoeff.f90 b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/Test_EmisCoeff/Test_EmisCoeff.f90 similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/Test_EmisCoeff/Test_EmisCoeff.f90 rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/Test_EmisCoeff/Test_EmisCoeff.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Water/Test_EmisCoeff/make.dependencies b/src/Coefficients/EmisCoeff/EmisCoeff_legacy/Test_EmisCoeff/make.dependencies similarity index 100% rename from src/Coefficients/EmisCoeff/IR_Water/Test_EmisCoeff/make.dependencies rename to src/Coefficients/EmisCoeff/EmisCoeff_legacy/Test_EmisCoeff/make.dependencies diff --git a/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Binary_IO.f90 b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Binary_IO.f90 new file mode 100644 index 0000000..c844303 --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Binary_IO.f90 @@ -0,0 +1,807 @@ +! +! +! IRsnowCoeff_Binary_IO +! +! Module containing routines to read and write Binary format +! IRsnowCoeff files. +! +! +! CREATION HISTORY: +! Written by: Cheng Dang, 27-Jun-2022 +! dangch@ucar.edu +! + +MODULE IRsnowCoeff_Binary_IO + + ! ------------------ + ! Environment set up + ! ------------------ + ! Module use + USE File_Utility , ONLY: File_Open, File_Exists + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE Binary_File_Utility, ONLY: Open_Binary_File , & + WriteGAtts_Binary_File, & + ReadGAtts_Binary_File + USE IRsnowCoeff_Define , ONLY: IRsnowCoeff_type , & + IRsnowCoeff_Associated , & + IRsnowCoeff_Destroy , & + IRsnowCoeff_Create , & + IRsnowCoeff_ValidRelease, & + IRsnowCoeff_Info + + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + PUBLIC :: IRsnowCoeff_Binary_InquireFile + PUBLIC :: IRsnowCoeff_Binary_ReadFile + PUBLIC :: IRsnowCoeff_Binary_WriteFile + + + ! ----------------- + ! Module parameters + ! ----------------- + CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' + ! Default message length + INTEGER, PARAMETER :: ML = 256 + + +CONTAINS + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Binary_InquireFile +! +! PURPOSE: +! Function to inquire a IRsnowCoeff object container file. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_Binary_InquireFile( & +! Filename , & +! n_Angles = n_Angles , & +! n_Frequencies = n_Frequencies, & +! n_Grain_Sizes = n_Grain_Sizes, & +! n_Temperature = n_Temperature, & +! Release = Release , & +! Version = Version , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! data file to inquire. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL OUTPUTS: +! n_Angles: Number of angles for which there are +! emissivity data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_Frequencies: Number of spectral frequencies for which there are +! emissivity data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_Grain_Sizes: Number of Grain Sizes for which there are +! emissivity data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_Temperature: Number of temperature for which there are +! emissivity data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Release: The data/file release number. Used to check +! for data/software mismatch. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The data/file version number. Used for +! purposes only in identifying the dataset for +! a particular release. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string containing a succinct description +! of what is in the dataset. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string containing dataset creation +! history. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string containing any comments about +! the dataset. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error +! status. The error codes are defined in the +! Message_Handler module. +! If == SUCCESS the file inquire was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_Binary_InquireFile( & + Filename , & ! Input + n_Angles , & ! Optional output + n_Frequencies, & ! Optional output + n_Grain_Sizes, & ! Optional output + n_Temperature, & ! Optional output + Release , & ! Optional output + Version , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies + INTEGER , OPTIONAL, INTENT(OUT) :: n_Grain_Sizes + INTEGER , OPTIONAL, INTENT(OUT) :: n_Temperature + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_InquireFile' + ! Function variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: io_msg + INTEGER :: io_stat + INTEGER :: fid + TYPE(IRsnowCoeff_type) :: IRsnowCoeff + + + ! Setup + err_stat = SUCCESS + ! ...Check that the file exists + IF ( .NOT. File_Exists( Filename ) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Open the file + err_stat = Open_Binary_File( Filename, fid ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error opening '//TRIM(Filename) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Read the release and version + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Release, & + IRsnowCoeff%Version + IF ( io_stat /= 0 ) THEN + msg = 'Error reading Release/Version - '//TRIM(io_msg) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Read the dimensions + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%n_Angles , & + IRsnowCoeff%n_Frequencies, & + IRsnowCoeff%n_Grain_Sizes, & + IRsnowCoeff%n_Temperature + IF ( io_stat /= 0 ) THEN + msg = 'Error reading dimension values from '//TRIM(Filename)//' - '//TRIM(io_msg) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Read the global attributes + err_stat = ReadGAtts_Binary_File( & + fid, & + Title = Title , & + History = History, & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes' + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Close the file + CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) + IF ( io_stat /= 0 ) THEN + msg = 'Error closing '//TRIM(Filename)//' - '//TRIM(io_msg) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Assign the return arguments + IF ( PRESENT(n_Angles ) ) n_Angles = IRsnowCoeff%n_Angles + IF ( PRESENT(n_Frequencies) ) n_Frequencies = IRsnowCoeff%n_Frequencies + IF ( PRESENT(n_Grain_Sizes) ) n_Grain_Sizes = IRsnowCoeff%n_Grain_Sizes + IF ( PRESENT(n_Temperature) ) n_Temperature = IRsnowCoeff%n_Temperature + IF ( PRESENT(Release ) ) Release = IRsnowCoeff%Release + IF ( PRESENT(Version ) ) Version = IRsnowCoeff%Version + + CONTAINS + + SUBROUTINE Inquire_CleanUp() + ! Close file if necessary + IF ( File_Open(fid) ) THEN + CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) + IF ( io_stat /= 0 ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//TRIM(io_msg) + END IF + ! Set error status and print error message + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION IRsnowCoeff_Binary_InquireFile + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Binary_ReadFile +! +! PURPOSE: +! Function to read IRsnowCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_Binary_ReadFile( & +! IRsnowCoeff , & +! Filename , & +! No_Close = No_Close, & +! Quiet = Quiet , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! OBJECTS: +! IRsnowCoeff: Object containing the data read from file. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! INPUTS: +! Filename: Character string specifying the name of the +! data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! No_Close: Set this logical argument to *NOT* close the datafile +! upon exiting this routine. This option is required if +! the IRsnowCoeff data is embedded within another file. +! If == .FALSE., File is closed upon function exit [DEFAULT]. +! == .TRUE., File is NOT closed upon function exit +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! Title: Character string containing a succinct description +! of what is in the dataset. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string containing dataset creation +! history. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string containing any comments about +! the dataset. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file read was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_Binary_ReadFile( & + IRsnowCoeff , & ! Output + Filename , & ! Input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment , & ! Optional output + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type), INTENT(OUT) :: IRsnowCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL , OPTIONAL, INTENT(IN) :: No_Close + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + LOGICAL , OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_Binary_ReadFile' + ! Function variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: io_msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: io_stat + INTEGER :: fid + TYPE(IRsnowCoeff_type) :: dummy + + + ! Setup + err_stat = SUCCESS + ! ...Check No_Close argument + close_file = .TRUE. + IF ( PRESENT(No_Close) ) close_file = .NOT. No_Close + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + ! ...Override Quiet settings if debug set. + IF ( PRESENT(Debug) ) THEN + IF ( Debug ) noisy = .TRUE. + END IF + + + ! Check if the file is open. + IF ( File_Open( Filename ) ) THEN + ! ...Inquire for the logical unit number + INQUIRE( FILE=Filename, NUMBER=fid ) + ! ...Ensure it's valid + IF ( fid < 0 ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for its FileID' + CALL Read_CleanUp(); RETURN + END IF + ELSE + ! ...Open the file if it exists + IF ( File_Exists( Filename ) ) THEN + err_stat = Open_Binary_File( Filename, fid ) + IF ( err_Stat /= SUCCESS ) THEN + msg = 'Error opening '//TRIM(Filename) + CALL Read_CleanUp(); RETURN + END IF + ELSE + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_CleanUp(); RETURN + END IF + END IF + + + ! Read and check the release and version + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + dummy%Release, & + dummy%Version + IF ( io_stat /= 0 ) THEN + msg = 'Error reading Release/Version - '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF + IF ( .NOT. IRsnowCoeff_ValidRelease( dummy ) ) THEN + msg = 'IRsnowCoeff Release check failed.' + CALL Read_Cleanup(); RETURN + END IF + + + ! Read the dimensions + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + dummy%n_Angles , & + dummy%n_Frequencies, & + dummy%n_Grain_Sizes, & + dummy%n_Temperature + IF ( io_stat /= 0 ) THEN + msg = 'Error reading dimension values from '//TRIM(Filename)//' - '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF + ! ...Create the return object + CALL IRsnowCoeff_Create( & + IRsnowCoeff , & + dummy%n_Angles , & + dummy%n_Frequencies, & + dummy%n_Grain_Sizes, & + dummy%n_Temperature ) + IF ( .NOT. IRsnowCoeff_Associated( IRsnowCoeff ) ) THEN + msg = 'IRsnowCoeff object creation failed.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Explicitly assign the version number + IRsnowCoeff%Version = dummy%Version + + + ! Read the global attributes + err_stat = ReadGAtts_Binary_File( & + fid, & + Title = Title , & + History = History, & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes' + CALL Read_Cleanup(); RETURN + END IF + + ! ...Read the classification name + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Classification_Name + IF ( io_stat /= 0 ) THEN + msg = 'Error reading classification name - '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF + + ! Read the coefficient data + ! ...Read the dimensional vectors + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Angle , & + IRsnowCoeff%Frequency , & + IRsnowCoeff%Grain_Size , & + IRsnowCoeff%Temperature , & + IRsnowCoeff%Emissivity + IF ( io_stat /= 0 ) THEN + msg = 'Error reading dimensional vectors - '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF + ! ...Read the emissivity data + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Emissivity + IF ( io_stat /= 0 ) THEN + msg = 'Error reading emissivity data - '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF + + ! Close the file + IF ( close_file ) THEN + CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) + IF ( io_stat /= 0 ) THEN + msg = 'Error closing '//TRIM(Filename)//' - '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF + END IF + + ! Output an info message + IF ( noisy ) THEN + CALL IRsnowCoeff_Info( IRsnowCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( File_Open(Filename) ) THEN + CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) + IF ( io_stat /= 0 ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//TRIM(io_msg) + END IF + CALL IRsnowCoeff_Destroy( IRsnowCoeff ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION IRsnowCoeff_Binary_ReadFile + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Binary_WriteFile +! +! PURPOSE: +! Function to write IRsnowCoeff object container files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_Binary_WriteFile( & +! IRsnowCoeff , & +! Filename , & +! No_Close = No_Close, & +! Quiet = Quiet , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! OBJECTS: +! IRsnowCoeff: Object containing the data to write to file. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! INPUTS: +! Filename: Character string specifying the name of the +! data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! No_Close: Set this logical argument to *NOT* close the datafile +! upon exiting this routine. This option is required if +! the IRsnowCoeff data is to be embedded within another file. +! If == .FALSE., File is closed upon function exit [DEFAULT]. +! == .TRUE., File is NOT closed upon function exit +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Title: Character string containing a succinct description +! of what is in the dataset. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string containing dataset creation +! history. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string containing any comments about +! the dataset. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file write was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_Binary_WriteFile( & + IRsnowCoeff , & ! Input + Filename , & ! Input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment , & ! Optional input + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type), INTENT(IN) :: IRsnowCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL , OPTIONAL, INTENT(IN) :: No_Close + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + LOGICAL , OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_Binary_WriteFile' + ! Function variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: io_msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: io_stat + INTEGER :: fid + + + ! Setup + err_stat = SUCCESS + ! ...Check No_Close argument + close_file = .TRUE. + IF ( PRESENT(No_Close) ) close_file = .NOT. No_Close + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + ! ...Override Quiet settings if debug set. + IF ( PRESENT(Debug) ) THEN + IF ( Debug ) noisy = .TRUE. + END IF + ! ...Check there is data to write + IF ( .NOT. IRsnowCoeff_Associated( IRsnowCoeff ) ) THEN + msg = 'IRsnowCoeff object is empty.' + CALL Write_Cleanup(); RETURN + END IF + + + ! Check if the file is open. + IF ( File_Open( FileName ) ) THEN + ! ...Inquire for the logical unit number + INQUIRE( FILE=Filename, NUMBER=fid ) + ! ...Ensure it's valid + IF ( fid < 0 ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for its FileID' + CALL Write_CleanUp(); RETURN + END IF + ELSE + ! ...Open the file for output + err_stat = Open_Binary_File( Filename, fid, For_Output=.TRUE. ) + IF ( err_Stat /= SUCCESS ) THEN + msg = 'Error opening '//TRIM(Filename) + CALL Write_CleanUp(); RETURN + END IF + END IF + + + ! Write the release and version + WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Release, & + IRsnowCoeff%Version + IF ( io_stat /= 0 ) THEN + msg = 'Error writing Release/Version - '//TRIM(io_msg) + CALL Write_Cleanup(); RETURN + END IF + + + ! Write the dimensions + WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%n_Angles , & + IRsnowCoeff%n_Frequencies, & + IRsnowCoeff%n_Grain_Sizes, & + IRsnowCoeff%n_Temperature + IF ( io_stat /= 0 ) THEN + msg = 'Error writing dimension values to '//TRIM(Filename)//' - '//TRIM(io_msg) + CALL Write_Cleanup(); RETURN + END IF + + + ! Write the global attributes + err_stat = WriteGAtts_Binary_File( & + fid, & + Write_Module = 'Unknown', & + Title = Title , & + History = History, & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing global attributes' + CALL Write_Cleanup(); RETURN + END IF + + + ! Write the surface classification name + WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Classification_Name + IF ( io_stat /= 0 ) THEN + msg = 'Error writing classification name - '//TRIM(io_msg) + CALL Write_Cleanup(); RETURN + END IF + + + ! Write the coefficient data + ! ...Write the dimensional vectors + WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Angle , & + IRsnowCoeff%Frequency , & + IRsnowCoeff%Grain_Size , & + IRsnowCoeff%Temperature , & + IRsnowCoeff%Emissivity + IF ( io_stat /= 0 ) THEN + msg = 'Error writing dimensional vectors - '//TRIM(io_msg) + CALL Write_Cleanup(); RETURN + END IF + ! ...Write the emissivity data + WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRsnowCoeff%Emissivity + IF ( io_stat /= 0 ) THEN + msg = 'Error writing emissivity data - '//TRIM(io_msg) + CALL Write_Cleanup(); RETURN + END IF + + + ! Close the file + IF ( close_file ) THEN + CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) + IF ( io_stat /= 0 ) THEN + msg = 'Error closing '//TRIM(Filename)//' - '//TRIM(io_msg) + CALL Write_Cleanup(); RETURN + END IF + END IF + + + ! Output an info message + IF ( noisy ) THEN + CALL IRsnowCoeff_Info( IRsnowCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( File_Open(Filename) ) THEN + CLOSE( fid, STATUS=WRITE_ERROR_STATUS, IOSTAT=io_stat, IOMSG=io_msg ) + IF ( io_stat /= 0 ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//TRIM(io_msg) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION IRsnowCoeff_Binary_WriteFile + +END MODULE IRsnowCoeff_Binary_IO diff --git a/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Define.f90 b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Define.f90 new file mode 100644 index 0000000..18e988c --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_Define.f90 @@ -0,0 +1,548 @@ +! +! IRsnowCoeff_Define +! +! Module defining the IRsnowCoeff object to hold coefficient +! data for the infrared snow surface emissivity and reflectivity models. +! +! +! CREATION HISTORY: +! Written by: Cheng Dang, 18-May-2022 +! dangch@ucar.edu + +MODULE IRsnowCoeff_Define + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp, Long, Double + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE Compare_Float_Numbers, ONLY: OPERATOR(.EqualTo.) + USE File_Utility , ONLY: File_Open, File_Exists + USE Binary_File_Utility , ONLY: Open_Binary_File , & + WriteGAtts_Binary_File, & + ReadGAtts_Binary_File + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Datatypes + PUBLIC :: IRsnowCoeff_type + ! Operators + PUBLIC :: OPERATOR(==) + ! Procedures + PUBLIC :: IRsnowCoeff_Associated + PUBLIC :: IRsnowCoeff_Destroy + PUBLIC :: IRsnowCoeff_Create + PUBLIC :: IRsnowCoeff_Inspect + PUBLIC :: IRsnowCoeff_ValidRelease + PUBLIC :: IRsnowCoeff_Info + + + ! --------------------- + ! Procedure overloading + ! --------------------- + INTERFACE OPERATOR(==) + MODULE PROCEDURE IRsnowCoeff_Equal + END INTERFACE OPERATOR(==) + + + ! ----------------- + ! Module parameters + ! ----------------- + ! Current valid release and version + INTEGER, PARAMETER :: IRsnowCOEFF_RELEASE = 1 ! This determines structure and file formats. + INTEGER, PARAMETER :: IRsnowCOEFF_VERSION = 1 ! This is just the default data version. + ! Close status for write errors + CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' + ! Literal constants + REAL(fp), PARAMETER :: ZERO = 0.0_fp + REAL(fp), PARAMETER :: ONE = 1.0_fp + ! String lengths + INTEGER, PARAMETER :: ML = 256 ! Message length + + + ! ---------------------------------- + ! IRsnowCoeff data type definitions + ! ---------------------------------- + !:tdoc+: + TYPE :: IRsnowCoeff_type + ! Allocation indicator + LOGICAL :: Is_Allocated = .FALSE. + ! Release and version information + INTEGER(Long) :: Release = IRsnowCOEFF_RELEASE + INTEGER(Long) :: Version = IRsnowCOEFF_VERSION + ! Surface classification name + CHARACTER(ML) :: Classification_Name = '' + ! Dimensions + INTEGER(Long) :: n_Angles = 0 ! I dimension + INTEGER(Long) :: n_Frequencies = 0 ! L dimension + INTEGER(Long) :: n_Grain_Sizes = 0 ! G dimension + INTEGER(Long) :: n_Temperature = 0 ! T dimension + ! Dimensional vectors + REAL(Double), ALLOCATABLE :: Angle(:) ! I + REAL(Double), ALLOCATABLE :: Frequency(:) ! L + REAL(Double), ALLOCATABLE :: Grain_Size(:) ! G + REAL(Double), ALLOCATABLE :: Temperature(:) ! T + ! Emissivity LUT data + REAL(Double), ALLOCATABLE :: Emissivity(:,:,:,:) ! I x L x G x T + END TYPE IRsnowCoeff_type + !:tdoc-: + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Associated +! +! PURPOSE: +! Elemental function to test the status of the allocatable components +! of the IRsnowCoeff structure. +! +! CALLING SEQUENCE: +! Status = IRsnowCoeff_Associated( IRsnowCoeff ) +! +! OBJECTS: +! IRsnowCoeff: Structure which is to have its member's +! status tested. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar or any rank +! ATTRIBUTES: INTENT(IN) +! +! FUNCTION RESULT: +! Status: The return value is a logical value indicating the +! status of the NLTE members. +! .TRUE. - if ANY of the IRsnowCoeff allocatable members +! are in use. +! .FALSE. - if ALL of the IRsnowCoeff allocatable members +! are not in use. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Same as input +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + ELEMENTAL FUNCTION IRsnowCoeff_Associated( self ) RESULT( Status ) + TYPE(IRsnowCoeff_type), INTENT(IN) :: self + LOGICAL :: Status + Status = self%Is_Allocated + END FUNCTION IRsnowCoeff_Associated + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Destroy +! +! PURPOSE: +! Elemental subroutine to re-initialize IRsnowCoeff objects. +! +! CALLING SEQUENCE: +! CALL IRsnowCoeff_Destroy( IRsnowCoeff ) +! +! OBJECTS: +! IRsnowCoeff: Re-initialized IRsnowCoeff structure. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar or any rank +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + ELEMENTAL SUBROUTINE IRsnowCoeff_Destroy( self ) + TYPE(IRsnowCoeff_type), INTENT(OUT) :: self + self%Is_Allocated = .FALSE. + END SUBROUTINE IRsnowCoeff_Destroy + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Create +! +! PURPOSE: +! Elemental subroutine to create an instance of an IRsnowCoeff object. +! +! CALLING SEQUENCE: +! CALL IRsnowCoeff_Create( IRsnowCoeff , & +! n_Angles , & +! n_Frequencies, & +! n_Grain_Sizes, & +! n_Temperature ) +! +! OBJECTS: +! IRsnowCoeff: IRsnowCoeff object structure. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar or any rank +! ATTRIBUTES: INTENT(OUT) +! +! INPUTS: +! n_Angles: Number of angles dimension. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Conformable with the IRsnowCoeff object +! ATTRIBUTES: INTENT(IN) +! +! n_Frequencies: Number of frequencies dimension. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Conformable with the IRsnowCoeff object +! ATTRIBUTES: INTENT(IN) +! +! n_Grain_Sizes: Number of Grain Sizes dimension. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Conformable with the IRsnowCoeff object +! ATTRIBUTES: INTENT(IN) +! +! n_Temperature: Number oftemperature dimension. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Conformable with the IRsnowCoeff object +! ATTRIBUTES: INTENT(IN) +!:sdoc-: +!-------------------------------------------------------------------------------- + + ELEMENTAL SUBROUTINE IRsnowCoeff_Create( & + self , & ! Output + n_Angles , & ! Input + n_Frequencies, & ! Input + n_Grain_Sizes, & ! Input + n_Temperature ) ! Input + ! Arguments + TYPE(IRsnowCoeff_type) , INTENT(OUT) :: self + INTEGER , INTENT(IN) :: n_Angles + INTEGER , INTENT(IN) :: n_Frequencies + INTEGER , INTENT(IN) :: n_Grain_Sizes + INTEGER , INTENT(IN) :: n_Temperature + ! Local variables + INTEGER :: alloc_stat + + ! Check input + IF ( self%Is_Allocated .OR. & + n_Angles < 1 .OR. & + n_Frequencies < 1 .OR. & + n_Grain_Sizes < 1 .OR. & + n_Temperature < 1) RETURN + + ! Perform the allocation + ALLOCATE( self%Angle( n_Angles ), & + self%Frequency( n_Frequencies ), & + self%Grain_Size( n_Grain_Sizes ), & + self%Temperature( n_Temperature ), & + self%Emissivity( n_Angles, n_Frequencies, n_Grain_Sizes, n_Temperature), & + STAT = alloc_stat ) + IF ( alloc_stat /= 0 ) RETURN + + + ! Initialise + ! ...Dimensions + self%n_Angles = n_Angles + self%n_Frequencies = n_Frequencies + self%n_Grain_Sizes = n_Grain_Sizes + self%n_Temperature = n_Temperature + ! ...Arrays + self%Angle = ZERO + self%Frequency = ZERO + self%Grain_Size = ZERO + self%Temperature = ZERO + self%Emissivity = ZERO + + ! Set allocation indicator + self%Is_Allocated = .TRUE. + + END SUBROUTINE IRsnowCoeff_Create + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Inspect +! +! PURPOSE: +! Subroutine to print the contents of a IRsnowCoeff object to stdout. +! +! CALLING SEQUENCE: +! CALL IRsnowCoeff_Inspect( IRsnowCoeff ) +! +! OBJECTS: +! IRsnowCoeff: IRsnowCoeff object to display. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + SUBROUTINE IRsnowCoeff_Inspect( self ) + TYPE(IRsnowCoeff_type), INTENT(IN) :: self + INTEGER :: i2, i3, i4 + WRITE(*,'(1x,"IRsnowCoeff OBJECT")') + ! Release/version info + WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version + ! Surface classification name + WRITE(*,'(3x,"Classification_Name :",1x,a)') TRIM(self%Classification_Name) + ! Dimensions + WRITE(*,'(3x,"n_Angles :",1x,i0)') self%n_Angles + WRITE(*,'(3x,"n_Frequencies :",1x,i0)') self%n_Frequencies + WRITE(*,'(3x,"n_Grain_Sizes :",1x,i0)') self%n_Grain_Sizes + WRITE(*,'(3x,"n_Temperature :",1x,i0)') self%n_Temperature + IF ( .NOT. IRsnowCoeff_Associated(self) ) RETURN + ! Dimension arrays + WRITE(*,'(3x,"Angle :")') + WRITE(*,'(5(1x,es22.15,:))') self%Angle + WRITE(*,'(3x,"Frequency :")') + WRITE(*,'(5(1x,es22.15,:))') self%Frequency + WRITE(*,'(3x,"Grain_Size :")') + WRITE(*,'(5(1x,es22.15,:))') self%Grain_Size + WRITE(*,'(3x,"Temperature :")') + WRITE(*,'(5(1x,es22.15,:))') self%Temperature + ! Emissivity array + WRITE(*,'(3x,"Emissivity :")') + DO i4 = 1, self%n_Temperature + WRITE(*,'(5x,"TEMPERATURE :",es22.15)') self%Temperature(i4) + DO i3 = 1, self%n_Grain_Sizes + WRITE(*,'(5x,"Grain_Size :",es22.15)') self%Grain_Size(i3) + DO i2 = 1, self%n_Frequencies + WRITE(*,'(5x,"FREQUENCY :",es22.15)') self%Frequency(i2) + WRITE(*,'(5(1x,es22.15,:))') self%Emissivity(:,i2,i3,i4) + END DO + END DO + END DO + END SUBROUTINE IRsnowCoeff_Inspect + + + +!---------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_ValidRelease +! +! PURPOSE: +! Function to check the IRsnowCoeff Release value. +! +! CALLING SEQUENCE: +! IsValid = IRsnowCoeff_ValidRelease( IRsnowCoeff ) +! +! INPUTS: +! IRsnowCoeff: IRsnowCoeff object for which the Release component +! is to be checked. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! FUNCTION RESULT: +! IsValid: Logical value defining the release validity. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! +!:sdoc-: +!---------------------------------------------------------------------------------- + + FUNCTION IRsnowCoeff_ValidRelease( self ) RESULT( IsValid ) + ! Arguments + TYPE(IRsnowCoeff_type), INTENT(IN) :: self + ! Function result + LOGICAL :: IsValid + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_ValidRelease' + ! Local variables + CHARACTER(ML) :: msg + + ! Set up + IsValid = .TRUE. + + + ! Check release is not too old + IF ( self%Release < IRsnowCOEFF_RELEASE ) THEN + IsValid = .FALSE. + WRITE( msg,'("An IRsnowCoeff data update is needed. ", & + &"IRsnowCoeff release is ",i0,". Valid release is ",i0,"." )' ) & + self%Release, IRsnowCOEFF_RELEASE + CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ); RETURN + END IF + + + ! Check release is not too new + IF ( self%Release > IRsnowCOEFF_RELEASE ) THEN + IsValid = .FALSE. + WRITE( msg,'("An IRsnowCoeff software update is needed. ", & + &"IRsnowCoeff release is ",i0,". Valid release is ",i0,"." )' ) & + self%Release, IRsnowCOEFF_RELEASE + CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ); RETURN + END IF + + END FUNCTION IRsnowCoeff_ValidRelease + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Info +! +! PURPOSE: +! Subroutine to return a string containing version and dimension +! information about a IRsnowCoeff object. +! +! CALLING SEQUENCE: +! CALL IRsnowCoeff_Info( IRsnowCoeff, Info ) +! +! OBJECTS: +! IRsnowCoeff: IRsnowCoeff object about which info is required. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! Info: String containing version and dimension information +! about the IRsnowCoeff object. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + SUBROUTINE IRsnowCoeff_Info( self, Info ) + ! Arguments + TYPE(IRsnowCoeff_type), INTENT(IN) :: self + 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,"IRsnowCoeff RELEASE.VERSION: ", i2, ".", i2.2,a,3x, & + &"CLASSIFICATION: ",a,",",2x,& + &"N_ANGLES=",i3,2x,& + &"N_FREQUENCIES=",i5,2x,& + &"n_Grain_Sizes=",i3,2x,& + &"N_TEMPERATURE=",i3 )' ) & + ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), & + self%Release, self%Version, & + ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), & + TRIM(self%Classification_Name), & + self%n_Angles, & + self%n_Frequencies, & + self%n_Grain_Sizes, & + self%n_Temperature + + ! Trim the output based on the + ! dummy argument string length + Info = Long_String(1:MIN(LEN(Info), LEN_TRIM(Long_String))) + + END SUBROUTINE IRsnowCoeff_Info + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + +!------------------------------------------------------------------------------ +! +! NAME: +! IRsnowCoeff_Equal +! +! PURPOSE: +! Elemental function to test the equality of two IRsnowCoeff objects. +! Used in OPERATOR(==) interface block. +! +! CALLING SEQUENCE: +! is_equal = IRsnowCoeff_Equal( x, y ) +! +! or +! +! IF ( x == y ) THEN +! ... +! END IF +! +! OBJECTS: +! x, y: Two IRsnowCoeff objects to be compared. +! UNITS: N/A +! TYPE: IRsnowCoeff_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 IRsnowCoeff_Equal( x, y ) RESULT( is_equal ) + TYPE(IRsnowCoeff_type), INTENT(IN) :: x, y + LOGICAL :: is_equal + + ! Set up + is_equal = .FALSE. + + ! Check the object association status + IF ( (.NOT. IRsnowCoeff_Associated(x)) .OR. & + (.NOT. IRsnowCoeff_Associated(y)) ) RETURN + + ! Check contents + ! ...Release/version info + IF ( (x%Release /= y%Release) .OR. & + (x%Version /= y%Version) ) RETURN + ! ...Classification name + IF ( (x%Classification_Name /= y%Classification_Name) ) RETURN + ! ...Dimensions + IF ( (x%n_Angles /= y%n_Angles ) .OR. & + (x%n_Frequencies /= y%n_Frequencies ) .OR. & + (x%n_Grain_Sizes /= y%n_Grain_Sizes ) .OR. & + (x%n_Temperature /= y%n_Temperature ) ) RETURN + ! ...Arrays + IF ( ALL(x%Angle .EqualTo. y%Angle ) .AND. & + ALL(x%Frequency .EqualTo. y%Frequency ) .AND. & + ALL(x%Grain_Size .EqualTo. y%Grain_Size ) .AND. & + ALL(x%Temperature .EqualTo. y%Temperature ) .AND. & + ALL(x%Emissivity .EqualTo. y%Emissivity ) ) & + is_equal = .TRUE. + + END FUNCTION IRsnowCoeff_Equal + +END MODULE IRsnowCoeff_Define diff --git a/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_IO.f90 b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_IO.f90 new file mode 100644 index 0000000..9e0b515 --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_IO.f90 @@ -0,0 +1,764 @@ +! +! IRsnowCoeff_IO +! +! Container module for Binary and netCDF IRsnowCoeff I/O modules. +! All Binary related modules are placeholder for now. +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 23-May-2022 +! dangch@ucar.edu + +MODULE IRsnowCoeff_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE Compare_Float_Numbers , ONLY: OPERATOR(.EqualTo.) + USE File_Utility , ONLY: File_Exists + USE IRsnowCoeff_Define , ONLY: IRsnowCoeff_type, & + OPERATOR(==), & + IRsnowCoeff_Associated + USE IRsnowCoeff_Binary_IO , ONLY: IRsnowCoeff_Binary_InquireFile , & + IRsnowCoeff_Binary_ReadFile , & + IRsnowCoeff_Binary_WriteFile + USE IRsnowCoeff_netCDF_IO , ONLY: IRsnowCoeff_netCDF_InquireFile , & + IRsnowCoeff_netCDF_ReadFile , & + IRsnowCoeff_netCDF_WriteFile + ! Disable implicit typing + IMPLICIT NONE + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + PUBLIC :: IRsnowCoeff_InquireFile + PUBLIC :: IRsnowCoeff_ReadFile + PUBLIC :: IRsnowCoeff_WriteFile + PUBLIC :: IRsnowCoeff_netCDF_to_Binary + PUBLIC :: IRsnowCoeff_Binary_to_netCDF + + CONTAINS + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_InquireFile +! +! PURPOSE: +! Function to inquire IRsnowCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_InquireFile( & +! Filename, & +! netCDF = netCDF , & +! n_Angles = n_Angles , & +! n_Frequencies = n_Frequencies , & +! n_Grain_Sizes = n_Grain_Sizes , & +! n_Temperature = n_Temperature , & +! Release = Release , & +! Version = Version , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRsnowCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! IRsnowCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! n_Angles: The number of angles in the look-up +! table (LUT). Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Frequencies: The number of frequencies in the LUT. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Grain_Sizes: The number of grain size in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! n_Temperature: The number of temperature in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Release: The release number of the IRsnowCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the IRsnowCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_InquireFile( & + Filename , & ! Input + netCDF , & ! Optional input + n_Angles , & ! Optional output + n_Frequencies , & ! Optional output + n_Grain_Sizes , & ! Optional output + n_Temperature , & ! Optional output + Release , & ! Optional output + Version , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies + INTEGER , OPTIONAL, INTENT(OUT) :: n_Grain_Sizes + INTEGER , OPTIONAL, INTENT(OUT) :: n_Temperature + LOGICAL , OPTIONAL, INTENT(IN) :: netCDF + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + + ! Call the appropriate function + IF ( Binary ) THEN + err_stat = IRsnowCoeff_Binary_InquireFile( & + Filename , & + n_Angles = n_Angles , & + n_Frequencies = n_Frequencies , & + n_Grain_Sizes = n_Grain_Sizes , & + n_Temperature = n_Temperature , & + Release = Release , & + Version = Version ) + ELSE + err_stat = IRsnowCoeff_netCDF_InquireFile( & + Filename , & + n_Angles = n_Angles , & + n_Frequencies = n_Frequencies , & + n_Grain_Sizes = n_Grain_Sizes , & + n_Temperature = n_Temperature , & + Release = Release , & + Version = Version , & + Title = Title , & + History = History , & + Comment = Comment ) + END IF + + END FUNCTION IRsnowCoeff_InquireFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_ReadFile +! +! PURPOSE: +! Function to read IRsnowCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_ReadFile( & +! IRsnowCoeff, & +! Filename, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRsnowCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! IRsnowCoeff: Object containing the IRsnow coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRsnowCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! IRsnowCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! Title: Character string written into the TITLE global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION IRsnowCoeff_ReadFile( & + IRsnowCoeff , & ! Output + Filename , & ! Input + netCDF , & ! Optional input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment , & ! Optional output + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type), INTENT(OUT) :: IRsnowCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: No_Close + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Call the appropriate function + IF ( Binary ) THEN + err_stat = IRsnowCoeff_Binary_ReadFile( & + IRsnowCoeff , & + Filename , & + No_Close , & + Quiet ) + ELSE + err_stat = IRsnowCoeff_netCDF_ReadFile( & + IRsnowCoeff , & + Filename , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + END IF + + END FUNCTION IRsnowCoeff_ReadFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_WriteFile +! +! PURPOSE: +! Function to write IRsnowCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_WriteFile( & +! IRsnowCoeff, & +! Filename, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! IRsnowCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! IRsnowCoeff: Object containing the IRsnow coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRsnowCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! IRsnowCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! No_Close: Set this logical argument to *NOT* close the datafile +! upon exiting this routine. This option is required if +! the IRsnowCoeff data is embedded within another file. +! If == .FALSE., File is closed upon function exit [DEFAULT]. +! == .TRUE., File is NOT closed upon function exit +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_WriteFile( & + IRsnowCoeff, & ! Input + Filename , & ! Input + netCDF , & ! Optional input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment , & ! Optional input + Debug ) & ! Optional input (Debug output control) + RESULT ( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type), INTENT(IN) :: IRsnowCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: No_Close + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Local variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Call the appropriate function + IF ( Binary ) THEN + err_stat = IRsnowCoeff_Binary_WriteFile( & + IRsnowCoeff, & + Filename , & + No_Close , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + ELSE + err_stat = IRsnowCoeff_netCDF_WriteFile( & + IRsnowCoeff, & + Filename , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + END IF + + END FUNCTION IRsnowCoeff_WriteFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_netCDF_to_Binary +! +! PURPOSE: +! Function to convert a netCDF IRsnowCoeff file to Binary format. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_netCDF_to_Binary( & +! NC_Filename , & +! BIN_Filename , & +! Quiet = Quiet ) +! +! INPUTS: +! NC_Filename: Character string specifying the name of the +! netCDF format IRsnowCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! BIN_Filename: Character string specifying the name of the +! Binary format IRsnowCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the file conversion was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! - If the output file already exists, it is overwritten. +! - If an error occurs, the output file is deleted before +! returning to the calling routine. +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_netCDF_to_Binary( & + NC_Filename , & ! Input + BIN_Filename, & ! Input + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + CHARACTER(*), INTENT(IN) :: BIN_Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_netCDF_to_Binary' + ! Function variables + CHARACTER(256) :: msg + TYPE(IRsnowCoeff_type) :: cc, cc_copy + + ! Set up + err_stat = SUCCESS + + ! Read the netCDF file + err_stat = IRsnowCoeff_ReadFile(cc, NC_Filename, Quiet = Quiet, netCDF = .TRUE. ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(NC_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Write the Binary file + err_stat = IRsnowCoeff_WriteFile(cc, BIN_Filename, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing Binary file '//TRIM(BIN_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Check the write was successful + ! ...Read the Binary file + err_stat = IRsnowCoeff_ReadFile(cc_copy, BIN_Filename, Quiet = Quiet) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary file '//TRIM(BIN_Filename)//' for test' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! ...Compare the IRsnowCoeff objects + IF ( .NOT. (cc == cc_copy) ) THEN + msg = 'IRsnowCoeff object comparison failed.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + END FUNCTION IRsnowCoeff_netCDF_to_Binary + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_Binary_to_netCDF +! +! PURPOSE: +! Function to convert a binary IRsnowCoeff file to Binary format. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_Binary_to_netCDF( & +! BIN_Filename , & +! NC_Filename , & +! Quiet = Quiet ) +! +! INPUTS: +! BIN_Filename: Character string specifying the name of the +! Binary format IRsnowCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! NC_Filename: Character string specifying the name of the +! netCDF format IRsnowCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the file conversion was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! - If the output file already exists, it is overwritten. +! - If an error occurs, the output file is deleted before +! returning to the calling routine. +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_Binary_to_netCDF( & + BIN_Filename, & ! Input + NC_Filename , & ! Input + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: BIN_Filename + CHARACTER(*), INTENT(IN) :: NC_Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_Binary_to_NetCDF' + ! Function variables + CHARACTER(256) :: msg + TYPE(IRsnowCoeff_type) :: cc, cc_copy + + ! Set up + err_stat = SUCCESS + + ! Read the binary file + err_stat = IRsnowCoeff_ReadFile(cc, BIN_Filename, Quiet = Quiet) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary file '//TRIM(BIN_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Write the netCDF file + err_stat = IRsnowCoeff_WriteFile(cc, NC_Filename, Quiet = Quiet, netCDF = .TRUE.) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing netCDF file '//TRIM(NC_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Check the write was successful + ! ...Read the netCDF file + err_stat = IRsnowCoeff_ReadFile(cc_copy, NC_Filename, Quiet = Quiet, netCDF = .TRUE.) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(NC_Filename)//' for test' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! ...Compare the IRsnowCoeff objects + IF ( .NOT. (cc == cc_copy) ) THEN + msg = 'IRsnowCoeff object comparison failed.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + END FUNCTION IRsnowCoeff_Binary_to_netCDF + +END MODULE IRsnowCoeff_IO diff --git a/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/IRsnowCoeff_NC2BIN.f90 b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/IRsnowCoeff_NC2BIN.f90 new file mode 100644 index 0000000..0a5c9c7 --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/IRsnowCoeff_NC2BIN.f90 @@ -0,0 +1,74 @@ +! +! ! IRsnowCoeff_NC2BIN +! +! Program to convert a CRTM IRsnowCoeff data file +! from netCDF to Binary format +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu + +PROGRAM IRsnowCoeff_NC2BIN + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module usage + USE Message_Handler , ONLY: SUCCESS, FAILURE, Program_Message, Display_Message + USE SignalFile_Utility , ONLY: Create_SignalFile + USE IRsnowCoeff_Define , ONLY: IRsnowCoeff_type + USE IRsnowCoeff_IO , ONLY: IRsnowCoeff_netCDF_to_Binary + ! Disable implicit typing + IMPLICIT NONE + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'IRsnowCoeff_NC2BIN' + + ! --------- + ! Variables + ! --------- + INTEGER :: err_stat + CHARACTER(256) :: NC_Filename, BIN_Filename + + ! Program header + CALL Program_Message( PROGRAM_NAME, & + 'Program to convert a CRTM IRsnowCoeff data file '//& + 'from netCDF to Binary format.', & + '$Revision$') + ! Get the filenames + WRITE(*,FMT='(/5x,"Enter the INPUT netCDF IRsnowCoeff filename : ")', ADVANCE='NO') + READ(*,'(a)') NC_Filename + NC_Filename = ADJUSTL(NC_Filename) + WRITE(*,FMT='(/5x,"Enter the OUTPUT Binary IRsnowCoeff filename: ")', ADVANCE='NO') + READ(*,'(a)') BIN_Filename + BIN_Filename = ADJUSTL(BIN_Filename) + ! ...Sanity check that they're not the same + IF ( BIN_Filename == NC_Filename ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'IRsnowCoeff netCDF and Binary filenames are the same!', & + FAILURE ) + STOP + END IF + + ! Perform the conversion + err_stat = IRsnowCoeff_netCDF_to_Binary( NC_Filename, BIN_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'IRsnowCoeff netCDF -> Binary conversion failed!', & + FAILURE ) + STOP + END IF + + ! Create a signal file indicating success + err_stat = Create_SignalFile( BIN_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'Error creating signal file for '//TRIM(BIN_Filename), & + FAILURE ) + END IF + +END PROGRAM IRsnowCoeff_NC2BIN diff --git a/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/Makefile b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/Makefile new file mode 100644 index 0000000..6c2f7ad --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/Makefile @@ -0,0 +1,61 @@ +#============================================================================== +# +# Makefile for IRwaterCoeff_Inspect program +# +#============================================================================== + +# Define macros +include $(CRTM_SOURCE_ROOT)/make.macros + +# This makefile +MAKE_FILE = Makefile + +# Executable files +EXE_FILE = IRsnowCoeff_NC2BIN +SCRIPT_FILE = run_$(EXE_FILE).sh + +# Source files to link +SRC_FILES = Type_Kinds.f90 \ + File_Utility.f90 \ + Message_Handler.f90 \ + Compare_Float_Numbers.f90 \ + Binary_File_Utility.f90 \ + Endian_Utility.f90 \ + String_Utility.f90 \ + Fundamental_Constants.f90 \ + SignalFile_Utility.f90 \ + IRsnowCoeff_Define.f90 \ + IRsnowCoeff_IO.f90 \ + IRsnowCoeff_Binary_IO.f90 \ + IRsnowCoeff_netCDF_IO.f90 \ + +# Obj files used in link phase +OBJ_FILES = ${SRC_FILES:.f90=.o} \ + $(EXE_FILE).o + +# Include and library definitions +INCLUDES = -I$(NC4_DIR)/include \ + -I$(HDF_DIR)/include +LIBRARIES = -L$(NC4_DIR)/lib -lnetcdf -lnetcdff \ + -L$(HDF_DIR)/lib -lhdf5 + +# Define common make targets (all, build, clean, install) +include $(CRTM_SOURCE_ROOT)/make.common_targets + +# Source link creation and removal +create_links:: + @$(LINK_SCRIPT) $(CRTM_SOURCE_ROOT) $(SRC_FILES) + +remove_links:: + @$(UNLINK_SCRIPT) $(SRC_FILES) + +# Script install target +install_script:: + @$(COPY) $(SCRIPT_FILE) ${HOME}/bin + +# Source dependency lists +include make.dependencies + +# Define default rules +include $(CRTM_SOURCE_ROOT)/make.rules + diff --git a/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/make.dependencies b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/make.dependencies new file mode 100644 index 0000000..b25dbe4 --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_NC2BIN/make.dependencies @@ -0,0 +1,14 @@ +RsnowCoeff_Define.o : IRsnowCoeff_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_Binary_IO.o : IRsnowCoeff_Binary_IO.f90 IRsnowCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_netCDF_IO.o : IRsnowCoeff_netCDF_IO.f90 IRsnowCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_IO.o : IRsnowCoeff_IO.f90 IRsnowCoeff_Binary_IO.o IRsnowCoeff_netCDF_IO.o IRsnowCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRsnowCoeff_NC2BIN.o : IRsnowCoeff_NC2BIN.f90 IRsnowCoeff_IO.o IRsnowCoeff_Define.o SignalFile_Utility.o Message_Handler.o +Binary_File_Utility.o : Binary_File_Utility.f90 Endian_Utility.o Message_Handler.o File_Utility.o Type_Kinds.o +Compare_Float_Numbers.o : Compare_Float_Numbers.f90 Type_Kinds.o +Endian_Utility.o : Endian_Utility.f90 Type_Kinds.o +File_Utility.o : File_Utility.f90 +Fundamental_Constants.o : Fundamental_Constants.f90 Type_Kinds.o +Message_Handler.o : Message_Handler.f90 File_Utility.o +SignalFile_Utility.o : SignalFile_Utility.f90 Message_Handler.o File_Utility.o +String_Utility.o : String_Utility.f90 +Type_Kinds.o : Type_Kinds.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_netCDF_IO.f90 b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_netCDF_IO.f90 new file mode 100644 index 0000000..a2e450b --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Snow/IRsnowCoeff_netCDF_IO.f90 @@ -0,0 +1,1367 @@ +! +! IRsnowCoeff_netCDF_IO +! +! Module containing routines to read and write IRsnowCoeff netCDF +! format files. +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 23-May-2022 +! dangch@ucar.edu + +MODULE IRsnowCoeff_netCDF_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp, Double, Long + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE String_Utility , ONLY: StrClean + USE IRsnowCoeff_Define , ONLY: IRsnowCoeff_type, & + IRsnowCoeff_Associated, & + IRsnowCoeff_Create, & + IRsnowCoeff_Inspect, & + IRsnowCoeff_Destroy, & + IRsnowCoeff_ValidRelease, & + IRsnowCoeff_Info + USE netcdf + ! Disable implicit typing + IMPLICIT NONE + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Procedures + PUBLIC :: IRsnowCoeff_netCDF_InquireFile + PUBLIC :: IRsnowCoeff_netCDF_ReadFile + PUBLIC :: IRsnowCoeff_netCDF_WriteFile + + ! ----------------- + ! Module parameters + ! ----------------- + ! Default msg string length + INTEGER, PARAMETER :: ML = 1024 + ! Literal constants + REAL(fp), PARAMETER :: FILL_FLOAT = -999.0_fp + REAL(fp), PARAMETER :: ONE = 1.0_fp + + ! Global attribute names. Case sensitive + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + CHARACTER(*), PARAMETER :: VERSION_GATTNAME = 'Version' + CHARACTER(*), PARAMETER :: DATA_SOURCE_GATTNAME = 'Data_Source' + CHARACTER(*), PARAMETER :: TITLE_GATTNAME = 'Title' + CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'History' + CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'Comment' + CHARACTER(*), PARAMETER :: CLASSIFICATION_NAME_GATTNAME = 'Classification_Name' + + ! Dimension names + CHARACTER(*), PARAMETER :: TNSL_DIMNAME = 'String_Length' + CHARACTER(*), PARAMETER :: FREQUENCY_DIMNAME = 'n_Frequencies' + CHARACTER(*), PARAMETER :: ANGLE_DIMNAME = 'n_Angles' + CHARACTER(*), PARAMETER :: GRAINSIZE_DIMNAME = 'n_Grain_Sizes' + CHARACTER(*), PARAMETER :: TEMPERATURE_DIMNAME = 'n_Temperature' + + ! Variable names + CHARACTER(*), PARAMETER :: ANGLE_VARNAME = 'Angle' + CHARACTER(*), PARAMETER :: FREQUENCY_VARNAME = 'Frequency' + CHARACTER(*), PARAMETER :: GRAINSIZE_VARNAME = 'Grain_Size' + CHARACTER(*), PARAMETER :: TEMPERATURE_VARNAME = 'Temperature' + CHARACTER(*), PARAMETER :: EMISSIVITY_VARNAME = 'Emissivity' + + ! Variable long name attribute. + CHARACTER(*), PARAMETER :: LONGNAME_ATTNAME = 'long_name' + CHARACTER(*), PARAMETER :: ANGLE_LONGNAME = 'Angle' + CHARACTER(*), PARAMETER :: FREQUENCY_LONGNAME = 'Frequency' + CHARACTER(*), PARAMETER :: GRAINSIZE_LONGNAME = 'Grain Size' + CHARACTER(*), PARAMETER :: TEMPERATURE_LONGNAME = 'Temperature' + CHARACTER(*), PARAMETER :: EMISSIVITY_LONGNAME = 'Emissivity' + + ! Variable description attribute. + CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' + CHARACTER(*), PARAMETER :: ANGLE_DESCRIPTION = 'Angle dimension values for emissivity data' + CHARACTER(*), PARAMETER :: FREQUENCY_DESCRIPTION = 'Frequency dimension values for emissivity data' + CHARACTER(*), PARAMETER :: GRAINSIZE_DESCRIPTION = 'Grain Size dimension values for emissivity data' + CHARACTER(*), PARAMETER :: TEMPERATURE_DESCRIPTION = 'Temperature dimension values for emissivity data' + CHARACTER(*), PARAMETER :: EMISSIVITY_DESCRIPTION = 'Spectral water surface emissivity data' + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + CHARACTER(*), PARAMETER :: ANGLE_UNITS = 'degrees from vertical' + CHARACTER(*), PARAMETER :: FREQUENCY_UNITS = 'inverse centimeters (cm^-1)' + CHARACTER(*), PARAMETER :: GRAINSIZE_UNITS = 'effective radius in microns (um)' + CHARACTER(*), PARAMETER :: TEMPERATURE_UNITS = 'Kelvins' + CHARACTER(*), PARAMETER :: EMISSIVITY_UNITS = 'N/A' + + ! Variable _FillValue attribute. + CHARACTER(*), PARAMETER :: FILLVALUE_ATTNAME = '_FillValue' + REAL(Double), PARAMETER :: ANGLE_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: FREQUENCY_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: GRAINSIZE_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: TEMPERATURE_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: EMISSIVITY_FILLVALUE = FILL_FLOAT + + ! Variable types + INTEGER, PARAMETER :: ANGLE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: FREQUENCY_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: GRAINSIZE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: TEMPERATURE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: EMISSIVITY_TYPE = NF90_DOUBLE + + +CONTAINS + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_netCDF_InquireFile +! +! PURPOSE: +! Function to inquire IRsnowCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_netCDF_InquireFile( & +! Filename, & +! n_Angles = n_Angles , & +! n_Frequencies = n_Frequencies , & +! n_Grain_Sizes = n_Grain_Sizes , & +! n_Temperature = n_Temperature , & +! Release = Release , & +! Version = Version , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRsnowCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL OUTPUTS: +! n_Angles: The number of angles in the look-up +! table (LUT). Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Frequencies: The number of frequencies in the LUT. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Grain_Sizes: The number of grain size in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Grain_Sizes: The number of temperature in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Release: The release number of the IRsnowCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the IRsnowCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRsnowCoeff_netCDF_InquireFile( & + Filename , & ! Input + n_Angles , & ! Optional output + n_Frequencies, & ! Optional output + n_Grain_Sizes, & ! Optional output + n_Temperature, & ! Optional output + Release , & ! Optional output + Version , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies + INTEGER , OPTIONAL, INTENT(OUT) :: n_Grain_Sizes + INTEGER , OPTIONAL, INTENT(OUT) :: n_Temperature + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_netCDF_InquireFile' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: DimId + TYPE(IRsnowCoeff_type) :: IRsnowCoeff + + ! Setup + err_stat = SUCCESS + Close_File = .FALSE. + + ! Open the file + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Get the dimensions + ! ...n_Angles dimension + NF90_Status = NF90_INQ_DIMID( FileId,ANGLE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRsnowCoeff%n_Angles ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Frequencies dimension + NF90_Status = NF90_INQ_DIMID( FileId,FREQUENCY_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//FREQUENCY_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRsnowCoeff%n_Frequencies ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//FREQUENCY_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Grain_Sizes dimension + NF90_Status = NF90_INQ_DIMID( FileId,GRAINSIZE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//GRAINSIZE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRsnowCoeff%n_Grain_Sizes ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//GRAINSIZE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Temperature dimension + NF90_Status = NF90_INQ_DIMID( FileId,TEMPERATURE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//TEMPERATURE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRsnowCoeff%n_Temperature ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//TEMPERATURE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Get the global attributes + err_stat = ReadGAtts( Filename, & + FileId , & + Release = IRsnowCoeff%Release, & + Version = IRsnowCoeff%Version, & + Title = Title , & + History = History, & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes from '//TRIM(Filename) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing input file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Set the return values + IF ( PRESENT(n_Angles ) ) n_Angles = IRsnowCoeff%n_Angles + IF ( PRESENT(n_Frequencies) ) n_Frequencies = IRsnowCoeff%n_Frequencies + IF ( PRESENT(n_Grain_Sizes) ) n_Grain_Sizes = IRsnowCoeff%n_Grain_Sizes + IF ( PRESENT(n_Temperature) ) n_Temperature = IRsnowCoeff%n_Temperature + IF ( PRESENT(Release ) ) Release = IRsnowCoeff%Release + IF ( PRESENT(Version ) ) Version = IRsnowCoeff%Version + + CONTAINS + + SUBROUTINE Inquire_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup.' + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION IRsnowCoeff_netCDF_InquireFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_netCDF_WriteFile +! +! PURPOSE: +! Function to write IRsnowCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_netCDF_WriteFile( & +! IRsnowCoeff, & +! Filename, & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment, & +! Debug ) +! +! INPUTS: +! IRsnowCoeff: Object containing the IRsnow coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRsnowCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Filename: Character string specifying the name of the +! IRsnowCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION IRsnowCoeff_netCDF_WriteFile( & + IRsnowCoeff , & ! Input + Filename , & ! Input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment , & ! Optional input + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type), INTENT(IN) :: IRsnowCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + LOGICAL , OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_netCDF_WriteFile' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + LOGICAL :: Noisy + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: VarId + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check structure pointer association status + IF ( .NOT. IRsnowCoeff_Associated( IRsnowCoeff ) ) THEN + msg = 'IRsnowCoeff structure is empty. Nothing to do!' + CALL Write_CleanUp(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. IRsnowCoeff_ValidRelease( IRsnowCoeff ) ) THEN + msg = 'IRsnowCoeff Release check failed.' + CALL Write_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + Noisy = .TRUE. + IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet + + ! Create the output file + err_stat = CreateFile( & + Filename , & ! Input + IRsnowCoeff%n_Angles , & ! Input + IRsnowCoeff%n_Frequencies , & ! Input + IRsnowCoeff%n_Grain_Sizes , & ! Input + IRsnowCoeff%n_Temperature , & ! Input + FileId , & ! Input + Release = IRsnowCoeff%Release , & ! Optional input + Version = IRsnowCoeff%Version , & ! Optional input + Classification_Name = IRsnowCoeff%Classification_Name , & ! Optional input + Title = Title , & ! Optional input + History = History , & ! Optional input + Comment = Comment ) ! Optional input + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error creating output file '//TRIM(Filename) + CALL Write_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Write the data items + ! ...Angle variable + NF90_Status = NF90_INQ_VARID( FileId,ANGLE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRsnowCoeff%Angle ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//ANGLE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_INQ_VARID( FileId,FREQUENCY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRsnowCoeff%Frequency ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Grain Size variable + NF90_Status = NF90_INQ_VARID( FileId,GRAINSIZE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//GRAINSIZE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRsnowCoeff%Grain_Size ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//GRAINSIZE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Temperature variable + NF90_Status = NF90_INQ_VARID( FileId,TEMPERATURE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TEMPERATURE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRsnowCoeff%Temperature ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//TEMPERATURE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Emissivity variable + NF90_Status = NF90_INQ_VARID( FileId,EMISSIVITY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//EMISSIVITY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRsnowCoeff%Emissivity ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//EMISSIVITY_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( Noisy ) THEN + CALL IRsnowCoeff_Info( IRsnowCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing output file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION IRsnowCoeff_netCDF_WriteFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRsnowCoeff_netCDF_ReadFile +! +! PURPOSE: +! Function to read IRsnowCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRsnowCoeff_netCDF_ReadFile( & +! IRsnowCoeff, & +! Filename, & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRsnowCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! IRsnowCoeff: Object containing the IRsnow coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRsnowCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! Title: Character string written into the TITLE global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRsnowCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION IRsnowCoeff_netCDF_ReadFile( & + IRsnowCoeff , & ! Output + Filename , & ! Input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment , & ! Optional output + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type) , INTENT(OUT) :: IRsnowCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + LOGICAL , OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_netCDF_ReadFile' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + LOGICAL :: Noisy + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: n_Angles + INTEGER :: n_Frequencies + INTEGER :: n_Grain_Sizes + INTEGER :: n_Temperature + INTEGER :: VarId + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check that the file exists + IF ( .NOT. File_Exists(Filename) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + Noisy = .TRUE. + IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet + + ! Inquire the file to get the dimensions + err_stat = IRsnowCoeff_netCDF_InquireFile( & + Filename , & + n_Angles = n_Angles , & + n_Frequencies = n_Frequencies , & + n_Grain_Sizes = n_Grain_Sizes , & + n_Temperature = n_Temperature ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error obtaining IRsnowCoeff dimensions from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + + ! Allocate the output structure + CALL IRsnowCoeff_Create( & + IRsnowCoeff , & + n_Angles , & + n_Frequencies , & + n_Grain_Sizes , & + n_Temperature ) + IF ( .NOT. IRsnowCoeff_Associated( IRsnowCoeff ) ) THEN + msg = 'IRsnowCoeff object allocation failed.' + CALL Read_Cleanup(); RETURN + END IF + + ! Open the file for reading + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '//& + TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Read the global attributes + err_stat = ReadGAtts( Filename, & + FileID , & + Release = IRsnowCoeff%Release , & + Version = IRsnowCoeff%Version , & + Classification_Name = IRsnowCoeff%Classification_Name , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attribute from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. IRsnowCoeff_ValidRelease( IRsnowCoeff ) ) THEN + msg = 'IRsnowCoeff Release check failed.' + CALL Read_Cleanup(); RETURN + END IF + + ! Read the IRsnowCoeff data + ! ...Angle variable + NF90_Status = NF90_INQ_VARID( FileId,ANGLE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRsnowCoeff%Angle ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//ANGLE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_INQ_VARID( FileId,FREQUENCY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRsnowCoeff%Frequency ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//FREQUENCY_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Grain Size variable + NF90_Status = NF90_INQ_VARID( FileId,GRAINSIZE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//GRAINSIZE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRsnowCoeff%Grain_Size ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//GRAINSIZE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Temperature variable + NF90_Status = NF90_INQ_VARID( FileId,TEMPERATURE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TEMPERATURE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRsnowCoeff%Temperature ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//TEMPERATURE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Emissivity variable + NF90_Status = NF90_INQ_VARID( FileId,EMISSIVITY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//EMISSIVITY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRsnowCoeff%Emissivity ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//EMISSIVITY_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ); Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( Noisy ) THEN + CALL IRsnowCoeff_Info( IRsnowCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup- '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + CALL IRsnowCoeff_Destroy( IRsnowCoeff ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION IRsnowCoeff_netCDF_ReadFile + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + + ! Function to write the global attributes to a IRsnowCoeff data file. + + FUNCTION WriteGAtts( & + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional input + Version , & ! Optional input + Classification_Name , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Release + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_WriteGAtts(netCDF)' + CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME = 'write_module_history' + CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: GAttName + CHARACTER(8) :: cdate + CHARACTER(10) :: ctime + CHARACTER(5) :: czone + CHARACTER(ML) :: CLSname + INTEGER :: Ver + INTEGER :: NF90_Status + TYPE(IRsnowCoeff_type) :: IRsnowCoeff + + ! Set up + err_stat = SUCCESS + msg = ' ' + + ! Mandatory global attributes + ! ...Software ID + !GAttName = WRITE_MODULE_HISTORY_GATTNAME + !NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),MODULE_VERSION_ID ) + !IF ( NF90_Status /= NF90_NOERR ) THEN + ! CALL WriteGAtts_Cleanup(); RETURN + !END IF + ! ...Creation date + CALL DATE_AND_TIME( cdate, ctime, czone ) + GAttName = CREATION_DATE_AND_TIME_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName), & + cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// & + ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// & + czone//'UTC' ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + + ! Optional global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + GAttName = RELEASE_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),IRsnowCoeff%Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + + ! ...The Version + IF ( PRESENT(Version) ) THEN + Ver = Version + ELSE + Ver = IRsnowCoeff%Version + END IF + GAttName = VERSION_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),Ver ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Classification_Name + IF ( PRESENT(Classification_Name) ) THEN + CLSname = Classification_Name + ELSE + CLSname = IRsnowCoeff%Classification_Name + END IF + GAttName = CLASSIFICATION_NAME_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),CLSname ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + GAttName = TITLE_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),title ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + GAttName = HISTORY_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),history ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + GAttName = COMMENT_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),comment ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + + CONTAINS + + SUBROUTINE WriteGAtts_CleanUp() + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = '; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status ) ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TRIM(GAttName)//' attribute to '//& + TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( NF90_Status ) )//TRIM(msg), & + err_stat ) + END SUBROUTINE WriteGAtts_CleanUp + + END FUNCTION WriteGAtts + + ! Function to read the global attributes from a IRsnowCoeff data file. + + FUNCTION ReadGAtts( & + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional output + Version , & ! Optional output + Classification_Name , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_ReadGAtts(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(256) :: GAttName + CHARACTER(5000) :: GAttString + INTEGER :: NF90_Status + + ! Set up + err_stat = SUCCESS + + ! The global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + GAttName = RELEASE_GATTNAME + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Version + IF ( PRESENT(Version) ) THEN + GAttName = VERSION_GATTNAME + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Version ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Classification Name + IF ( PRESENT(Classification_Name) ) THEN + GAttName = CLASSIFICATION_NAME_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + Classification_Name = GAttString(1:MIN(LEN(Classification_Name), LEN_TRIM(GAttString))) + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + GAttName = TITLE_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + title = GAttString(1:MIN(LEN(title), LEN_TRIM(GAttString))) + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + GAttName = HISTORY_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + history = GAttString(1:MIN(LEN(history), LEN_TRIM(GAttString))) + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + GAttName = COMMENT_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + comment = GAttString(1:MIN(LEN(comment), LEN_TRIM(GAttString))) + END IF + + CONTAINS + + SUBROUTINE ReadGAtts_CleanUp() + err_stat = FAILURE + msg = 'Error reading '//TRIM(GAttName)//' attribute from '//TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( NF90_Status ) ) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE ReadGAtts_CleanUp + + END FUNCTION ReadGAtts + + FUNCTION CreateFile( & + Filename , & ! Input + n_Angles , & ! Input + n_Frequencies , & ! Input + n_Grain_Sizes , & ! Input + n_Temperature , & ! Input + FileId , & ! Output + Release , & ! Optional input + Version , & ! Optional input + Classification_Name , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: n_Angles + INTEGER , INTENT(IN) :: n_Frequencies + INTEGER , INTENT(IN) :: n_Grain_Sizes + INTEGER , INTENT(IN) :: n_Temperature + INTEGER , INTENT(OUT) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Release + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRsnowCoeff_CreateFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + INTEGER :: NF90_Status + INTEGER :: n_Angles_DimID + INTEGER :: n_Frequencies_DimID + INTEGER :: n_Grain_Sizes_DimID + INTEGER :: n_Temperature_DimID + INTEGER :: varID + INTEGER :: Put_Status(4) + TYPE(IRsnowCoeff_type) :: dummy + + ! Setup + err_stat = SUCCESS + Close_File = .FALSE. + + ! Create the data file + NF90_Status = NF90_CREATE( Filename,NF90_CLOBBER,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Define the dimensions + ! ...Number of angles + NF90_Status = NF90_DEF_DIM( FileID,ANGLE_DIMNAME,n_Angles,n_Angles_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//ANGLE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of frequencies + NF90_Status = NF90_DEF_DIM( FileID,FREQUENCY_DIMNAME,n_Frequencies,n_Frequencies_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//FREQUENCY_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of Grain Size + NF90_Status = NF90_DEF_DIM( FileID,GRAINSIZE_DIMNAME,n_Grain_Sizes,n_Grain_Sizes_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//GRAINSIZE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of temperature + NF90_Status = NF90_DEF_DIM( FileID,TEMPERATURE_DIMNAME,n_Temperature,n_Temperature_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TEMPERATURE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + CALL IRsnowCoeff_Destroy(dummy) + + ! Write the global attributes + err_stat = WriteGAtts( Filename, & + FileId , & + Release = Release , & + Version = Version , & + Classification_Name = Classification_Name , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing global attribute to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + ! Define the variables + ! ...Angle variable + NF90_Status = NF90_DEF_VAR( FileID, & + ANGLE_VARNAME, & + ANGLE_TYPE, & + dimIDs=(/n_Angles_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//ANGLE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,ANGLE_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,ANGLE_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,ANGLE_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,ANGLE_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//ANGLE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_DEF_VAR( FileID, & + FREQUENCY_VARNAME, & + FREQUENCY_TYPE, & + dimIDs=(/n_Frequencies_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//FREQUENCY_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,FREQUENCY_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,FREQUENCY_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,FREQUENCY_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,FREQUENCY_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Grain Size variable + NF90_Status = NF90_DEF_VAR( FileID, & + GRAINSIZE_VARNAME, & + GRAINSIZE_TYPE, & + dimIDs=(/n_Grain_Sizes_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//GRAINSIZE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,GRAINSIZE_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,GRAINSIZE_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,GRAINSIZE_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,GRAINSIZE_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//GRAINSIZE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Temperature variable + NF90_Status = NF90_DEF_VAR( FileID, & + TEMPERATURE_VARNAME, & + TEMPERATURE_TYPE, & + dimIDs=(/n_Temperature_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TEMPERATURE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,TEMPERATURE_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,TEMPERATURE_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,TEMPERATURE_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,TEMPERATURE_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//TEMPERATURE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Emissivity variable + NF90_Status = NF90_DEF_VAR( FileID, & + EMISSIVITY_VARNAME, & + EMISSIVITY_TYPE, & + dimIDs=(/n_Angles_DimID, n_Frequencies_DimID, n_Grain_Sizes_DimID, n_Temperature_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//EMISSIVITY_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,EMISSIVITY_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,EMISSIVITY_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,EMISSIVITY_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,EMISSIVITY_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//EMISSIVITY_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + ! Take netCDF file out of define mode + NF90_Status = NF90_ENDDEF( FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error taking file '//TRIM(Filename)// & + ' out of define mode - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE Create_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileID ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Create_CleanUp + + END FUNCTION CreateFile + + END MODULE IRsnowCoeff_netCDF_IO diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/IRWaterCoeff_NC2BIN.f90 b/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/IRWaterCoeff_NC2BIN.f90 new file mode 100644 index 0000000..ef0aedd --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/IRWaterCoeff_NC2BIN.f90 @@ -0,0 +1,74 @@ +! +! ! IRwaterCoeff_NC2BIN +! +! Program to convert a CRTM IRwaterCoeff data file +! from netCDF to Binary format +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu + +PROGRAM IRwaterCoeff_NC2BIN + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module usage + USE Message_Handler , ONLY: SUCCESS, FAILURE, Program_Message, Display_Message + USE SignalFile_Utility , ONLY: Create_SignalFile + USE IRwaterCoeff_Define , ONLY: IRwaterCoeff_type + USE IRwaterCoeff_IO , ONLY: IRwaterCoeff_netCDF_to_Binary + ! Disable implicit typing + IMPLICIT NONE + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'IRwaterCoeff_NC2BIN' + + ! --------- + ! Variables + ! --------- + INTEGER :: err_stat + CHARACTER(256) :: NC_Filename, BIN_Filename + + ! Program header + CALL Program_Message( PROGRAM_NAME, & + 'Program to convert a CRTM IRwaterCoeff data file '//& + 'from netCDF to Binary format.', & + '$Revision$') + ! Get the filenames + WRITE(*,FMT='(/5x,"Enter the INPUT netCDF IRwaterCoeff filename : ")', ADVANCE='NO') + READ(*,'(a)') NC_Filename + NC_Filename = ADJUSTL(NC_Filename) + WRITE(*,FMT='(/5x,"Enter the OUTPUT Binary IRwaterCoeff filename: ")', ADVANCE='NO') + READ(*,'(a)') BIN_Filename + BIN_Filename = ADJUSTL(BIN_Filename) + ! ...Sanity check that they're not the same + IF ( BIN_Filename == NC_Filename ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'IRwaterCoeff netCDF and Binary filenames are the same!', & + FAILURE ) + STOP + END IF + + ! Perform the conversion + err_stat = IRwaterCoeff_netCDF_to_Binary( NC_Filename, BIN_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'IRwaterCoeff netCDF -> Binary conversion failed!', & + FAILURE ) + STOP + END IF + + ! Create a signal file indicating success + err_stat = Create_SignalFile( BIN_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'Error creating signal file for '//TRIM(BIN_Filename), & + FAILURE ) + END IF + +END PROGRAM IRwaterCoeff_NC2BIN diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/Makefile b/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/Makefile new file mode 100644 index 0000000..5e612a8 --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/Makefile @@ -0,0 +1,60 @@ +#============================================================================== +# +# Makefile for IRwaterCoeff_Inspect program +# +#============================================================================== + +# Define macros +include $(CRTM_SOURCE_ROOT)/make.macros + +# This makefile +MAKE_FILE = Makefile + +# Executable files +EXE_FILE = IRwaterCoeff_NC2BIN +SCRIPT_FILE = run_$(EXE_FILE).sh + +# Source files to link +SRC_FILES = Type_Kinds.f90 \ + File_Utility.f90 \ + Message_Handler.f90 \ + Compare_Float_Numbers.f90 \ + Binary_File_Utility.f90 \ + Endian_Utility.f90 \ + String_Utility.f90 \ + Fundamental_Constants.f90 \ + SignalFile_Utility.f90 \ + IRwaterCoeff_Define.f90 \ + IRwaterCoeff_IO.f90 \ + IRwaterCoeff_netCDF_IO.f90 + +# Obj files used in link phase +OBJ_FILES = ${SRC_FILES:.f90=.o} \ + $(EXE_FILE).o + +# Include and library definitions +INCLUDES = -I$(NC4_DIR)/include \ + -I$(HDF_DIR)/include +LIBRARIES = -L$(NC4_DIR)/lib -lnetcdf -lnetcdff \ + -L$(HDF_DIR)/lib -lhdf5 + +# Define common make targets (all, build, clean, install) +include $(CRTM_SOURCE_ROOT)/make.common_targets + +# Source link creation and removal +create_links:: + @$(LINK_SCRIPT) $(CRTM_SOURCE_ROOT) $(SRC_FILES) + +remove_links:: + @$(UNLINK_SCRIPT) $(SRC_FILES) + +# Script install target +install_script:: + @$(COPY) $(SCRIPT_FILE) ${HOME}/bin + +# Source dependency lists +include make.dependencies + +# Define default rules +include $(CRTM_SOURCE_ROOT)/make.rules + diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/make.dependencies b/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/make.dependencies new file mode 100644 index 0000000..c90f74c --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRWaterCoeff_NC2BIN/make.dependencies @@ -0,0 +1,13 @@ +IRwaterCoeff_Define.o : IRwaterCoeff_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_netCDF_IO.o : IRwaterCoeff_netCDF_IO.f90 IRwaterCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_IO.o : IRwaterCoeff_IO.f90 IRwaterCoeff_netCDF_IO.o IRwaterCoeff_Define.o File_Utility.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_NC2BIN.o : IRwaterCoeff_NC2BIN.f90 IRwaterCoeff_IO.o IRwaterCoeff_Define.o SignalFile_Utility.o Message_Handler.o +Binary_File_Utility.o : Binary_File_Utility.f90 Endian_Utility.o Message_Handler.o File_Utility.o Type_Kinds.o +Compare_Float_Numbers.o : Compare_Float_Numbers.f90 Type_Kinds.o +Endian_Utility.o : Endian_Utility.f90 Type_Kinds.o +File_Utility.o : File_Utility.f90 +Fundamental_Constants.o : Fundamental_Constants.f90 Type_Kinds.o +Message_Handler.o : Message_Handler.f90 File_Utility.o +SignalFile_Utility.o : SignalFile_Utility.f90 Message_Handler.o File_Utility.o +String_Utility.o : String_Utility.f90 +Type_Kinds.o : Type_Kinds.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/IRwaterCoeff_BIN2NC.f90 b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/IRwaterCoeff_BIN2NC.f90 new file mode 100644 index 0000000..8a8ee0b --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/IRwaterCoeff_BIN2NC.f90 @@ -0,0 +1,74 @@ +! +! IRwaterCoeff_BIN2NC +! +! Program to convert a CRTM IRwaterCoeff data file +! from netCDF to Binary format +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu + +PROGRAM IRwaterCoeff_BIN2NC + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module usage + USE Message_Handler , ONLY: SUCCESS, FAILURE, Program_Message, Display_Message + USE SignalFile_Utility , ONLY: Create_SignalFile + USE IRwaterCoeff_Define , ONLY: IRwaterCoeff_type + USE IRwaterCoeff_IO , ONLY: IRwaterCoeff_Binary_to_netCDF + ! Disable implicit typing + IMPLICIT NONE + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'IRwaterCoeff_BIN2NC' + + ! --------- + ! Variables + ! --------- + INTEGER :: err_stat + CHARACTER(256) :: NC_Filename, BIN_Filename + + ! Program header + CALL Program_Message( PROGRAM_NAME, & + 'Program to convert a CRTM IRwaterCoeff data file '//& + 'from Binary to netCDF format.', & + '$Revision$') + ! Get the filenames + WRITE(*,FMT='(/5x,"Enter the INPUT Binary IRwaterCoeff filename : ")', ADVANCE='NO') + READ(*,'(a)') BIN_Filename + BIN_Filename = ADJUSTL(BIN_Filename) + WRITE(*,FMT='(/5x,"Enter the OUTPUT netCDF IRwaterCoeff filename: ")', ADVANCE='NO') + READ(*,'(a)') NC_Filename + NC_Filename = ADJUSTL(NC_Filename) + ! ...Sanity check that they're not the same + IF ( BIN_Filename == NC_Filename ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'IRwaterCoeff netCDF and Binary filenames are the same!', & + FAILURE ) + STOP + END IF + + ! Perform the conversion + err_stat = IRwaterCoeff_Binary_to_netCDF( BIN_Filename, NC_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'IRwaterCoeff Binary -> netCDF conversion failed!', & + FAILURE ) + STOP + END IF + + ! Create a signal file indicating success + err_stat = Create_SignalFile( NC_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'Error creating signal file for '//TRIM(NC_Filename), & + FAILURE ) + END IF + + END PROGRAM IRwaterCoeff_BIN2NC diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/Makefile b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/Makefile new file mode 100644 index 0000000..4cee2de --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/Makefile @@ -0,0 +1,60 @@ +#============================================================================== +# +# Makefile for IRwaterCoeff_Inspect program +# +#============================================================================== + +# Define macros +include $(CRTM_SOURCE_ROOT)/make.macros + +# This makefile +MAKE_FILE = Makefile + +# Executable files +EXE_FILE = IRwaterCoeff_BIN2NC +SCRIPT_FILE = run_$(EXE_FILE).sh + +# Source files to link +SRC_FILES = Type_Kinds.f90 \ + File_Utility.f90 \ + Message_Handler.f90 \ + Compare_Float_Numbers.f90 \ + Binary_File_Utility.f90 \ + Endian_Utility.f90 \ + String_Utility.f90 \ + Fundamental_Constants.f90 \ + SignalFile_Utility.f90 \ + IRwaterCoeff_Define.f90 \ + IRwaterCoeff_IO.f90 \ + IRwaterCoeff_netCDF_IO.f90 + +# Obj files used in link phase +OBJ_FILES = ${SRC_FILES:.f90=.o} \ + $(EXE_FILE).o + +# Include and library definitions +INCLUDES = -I$(NC4_DIR)/include \ + -I$(HDF_DIR)/include +LIBRARIES = -L$(NC4_DIR)/lib -lnetcdf -lnetcdff \ + -L$(HDF_DIR)/lib -lhdf5 + +# Define common make targets (all, build, clean, install) +include $(CRTM_SOURCE_ROOT)/make.common_targets + +# Source link creation and removal +create_links:: + @$(LINK_SCRIPT) $(CRTM_SOURCE_ROOT) $(SRC_FILES) + +remove_links:: + @$(UNLINK_SCRIPT) $(SRC_FILES) + +# Script install target +install_script:: + @$(COPY) $(SCRIPT_FILE) ${HOME}/bin + +# Source dependency lists +include make.dependencies + +# Define default rules +include $(CRTM_SOURCE_ROOT)/make.rules + diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/make.dependencies b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/make.dependencies new file mode 100644 index 0000000..2a49358 --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_BIN2NC/make.dependencies @@ -0,0 +1,13 @@ +IRwaterCoeff_Define.o : IRwaterCoeff_Define.f90 Binary_File_Utility.o File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_netCDF_IO.o : IRwaterCoeff_netCDF_IO.f90 IRwaterCoeff_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_IO.o : IRwaterCoeff_IO.f90 IRwaterCoeff_netCDF_IO.o IRwaterCoeff_Define.o File_Utility.o Message_Handler.o Type_Kinds.o +IRwaterCoeff_BIN2NC.o : IRwaterCoeff_BIN2NC.f90 IRwaterCoeff_IO.o IRwaterCoeff_Define.o SignalFile_Utility.o Message_Handler.o +Binary_File_Utility.o : Binary_File_Utility.f90 Endian_Utility.o Message_Handler.o File_Utility.o Type_Kinds.o +Compare_Float_Numbers.o : Compare_Float_Numbers.f90 Type_Kinds.o +Endian_Utility.o : Endian_Utility.f90 Type_Kinds.o +File_Utility.o : File_Utility.f90 +Fundamental_Constants.o : Fundamental_Constants.f90 Type_Kinds.o +Message_Handler.o : Message_Handler.f90 File_Utility.o +SignalFile_Utility.o : SignalFile_Utility.f90 Message_Handler.o File_Utility.o +String_Utility.o : String_Utility.f90 +Type_Kinds.o : Type_Kinds.f90 diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Define.f90 b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Define.f90 index 715dc46..84577e3 100644 --- a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Define.f90 +++ b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Define.f90 @@ -8,7 +8,10 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 19-Aug-2011 ! paul.vandelst@noaa.gov - +! Modified by: Cheng Dang, 18-Mar-2022 +! dangch@ucar.edu +! Add temperature dimension + MODULE IRwaterCoeff_Define ! ----------------- @@ -59,7 +62,7 @@ MODULE IRwaterCoeff_Define ! Module parameters ! ----------------- ! Current valid release and version - INTEGER, PARAMETER :: IRWATERCOEFF_RELEASE = 3 ! This determines structure and file formats. + INTEGER, PARAMETER :: IRWATERCOEFF_RELEASE = 4 ! This determines structure and file formats. INTEGER, PARAMETER :: IRWATERCOEFF_VERSION = 2 ! This is just the default data version. ! Close status for write errors CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' @@ -71,6 +74,7 @@ MODULE IRwaterCoeff_Define REAL(fp), PARAMETER :: DEGREES_TO_RADIANS = PI / 180.0_fp ! String lengths INTEGER, PARAMETER :: ML = 256 ! Message length + INTEGER, PARAMETER :: SL = 80 ! String length ! ---------------------------------- @@ -83,16 +87,20 @@ MODULE IRwaterCoeff_Define ! Release and version information INTEGER(Long) :: Release = IRWATERCOEFF_RELEASE INTEGER(Long) :: Version = IRWATERCOEFF_VERSION + ! Surface classification name + CHARACTER(SL) :: Classification_Name = '' ! Dimensions INTEGER(Long) :: n_Angles = 0 ! I dimension INTEGER(Long) :: n_Frequencies = 0 ! L dimension INTEGER(Long) :: n_Wind_Speeds = 0 ! N dimension + INTEGER(Long) :: n_Temperature = 0 ! T dimension ! Dimensional vectors - REAL(Double), ALLOCATABLE :: Angle(:) ! I - REAL(Double), ALLOCATABLE :: Frequency(:) ! L - REAL(Double), ALLOCATABLE :: Wind_Speed(:) ! N + REAL(Double), ALLOCATABLE :: Angle(:) ! I + REAL(Double), ALLOCATABLE :: Frequency(:) ! L + REAL(Double), ALLOCATABLE :: Wind_Speed(:) ! N + REAL(Double), ALLOCATABLE :: Temperature(:) ! T ! Emissivity LUT data - REAL(Double), ALLOCATABLE :: Emissivity(:,:,:) ! I x L x N + REAL(Double), ALLOCATABLE :: Emissivity(:,:,:,:) ! I x L x N x T ! Transformed dimensional vectors REAL(Double), ALLOCATABLE :: Secant_Angle(:) ! I END TYPE IRwaterCoeff_type @@ -151,7 +159,7 @@ ELEMENTAL FUNCTION IRwaterCoeff_Associated( self ) RESULT( Status ) Status = self%Is_Allocated END FUNCTION IRwaterCoeff_Associated - + !-------------------------------------------------------------------------------- !:sdoc+: ! @@ -193,7 +201,8 @@ END SUBROUTINE IRwaterCoeff_Destroy ! CALL IRwaterCoeff_Create( IRwaterCoeff , & ! n_Angles , & ! n_Frequencies, & -! n_Wind_Speeds ) +! n_Wind_Speeds, & +! n_Temperature ) ! ! OBJECTS: ! IRwaterCoeff: IRwaterCoeff object structure. @@ -224,6 +233,12 @@ END SUBROUTINE IRwaterCoeff_Destroy ! DIMENSION: Conformable with the IRwaterCoeff object ! ATTRIBUTES: INTENT(IN) ! +! n_Temperature: Number oftemperature dimension. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Conformable with the IRwaterCoeff object +! ATTRIBUTES: INTENT(IN) !:sdoc-: !-------------------------------------------------------------------------------- @@ -231,26 +246,29 @@ ELEMENTAL SUBROUTINE IRwaterCoeff_Create( & self , & ! Output n_Angles , & ! Input n_Frequencies, & ! Input - n_Wind_Speeds ) ! Input + n_Wind_Speeds, & ! Input + n_Temperature ) ! Input ! Arguments TYPE(IRwaterCoeff_type), INTENT(OUT) :: self - INTEGER , INTENT(IN) :: n_Angles - INTEGER , INTENT(IN) :: n_Frequencies - INTEGER , INTENT(IN) :: n_Wind_Speeds + INTEGER , INTENT(IN) :: n_Angles + INTEGER , INTENT(IN) :: n_Frequencies + INTEGER , INTENT(IN) :: n_Wind_Speeds + INTEGER , INTENT(IN) :: n_Temperature ! Local variables INTEGER :: alloc_stat ! Check input IF ( n_Angles < 1 .OR. & n_Frequencies < 1 .OR. & - n_Wind_Speeds < 1 ) RETURN + n_Wind_Speeds < 1 .OR. & + n_Temperature < 1) RETURN - ! Perform the allocation ALLOCATE( self%Angle( n_Angles ), & self%Frequency( n_Frequencies ), & self%Wind_Speed( n_Wind_Speeds ), & - self%Emissivity( n_Angles, n_Frequencies, n_Wind_Speeds ), & + self%Temperature( n_Temperature ), & + self%Emissivity( n_Angles, n_Frequencies, n_Wind_Speeds, n_Temperature), & self%Secant_Angle( n_Angles ), & STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN @@ -258,13 +276,15 @@ ELEMENTAL SUBROUTINE IRwaterCoeff_Create( & ! Initialise ! ...Dimensions - self%n_Angles = n_Angles + self%n_Angles = n_Angles self%n_Frequencies = n_Frequencies self%n_Wind_Speeds = n_Wind_Speeds + self%n_Temperature = n_Temperature ! ...Arrays self%Angle = ZERO self%Frequency = ZERO self%Wind_Speed = ZERO + self%Temperature = ZERO self%Emissivity = ZERO self%Secant_Angle = ZERO @@ -298,29 +318,37 @@ END SUBROUTINE IRwaterCoeff_Create SUBROUTINE IRwaterCoeff_Inspect( self ) TYPE(IRwaterCoeff_type), INTENT(IN) :: self - INTEGER :: i2, i3 + INTEGER :: i2, i3, i4 WRITE(*,'(1x,"IRwaterCoeff OBJECT")') ! Release/version info WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version + ! Surface classification name + WRITE(*,'(3x,"Classification_Name :",1x,a)') TRIM(self%Classification_Name) ! Dimensions - WRITE(*,'(3x,"n_Angles :",1x,i0)') self%n_Angles + WRITE(*,'(3x,"n_Angles :",1x,i0)') self%n_Angles WRITE(*,'(3x,"n_Frequencies :",1x,i0)') self%n_Frequencies WRITE(*,'(3x,"n_Wind_Speeds :",1x,i0)') self%n_Wind_Speeds + WRITE(*,'(3x,"n_Temperature :",1x,i0)') self%n_Temperature IF ( .NOT. IRwaterCoeff_Associated(self) ) RETURN ! Dimension arrays WRITE(*,'(3x,"Angle :")') - WRITE(*,'(5(1x,es22.15,:))') self%Angle + WRITE(*,'(5(1x,es22.15,:))') self%Angle WRITE(*,'(3x,"Frequency :")') - WRITE(*,'(5(1x,es22.15,:))') self%Frequency + WRITE(*,'(5(1x,es22.15,:))') self%Frequency WRITE(*,'(3x,"Wind_Speed :")') WRITE(*,'(5(1x,es22.15,:))') self%Wind_Speed + WRITE(*,'(3x,"Temperature :")') + WRITE(*,'(5(1x,es22.15,:))') self%Temperature ! Emissivity array WRITE(*,'(3x,"Emissivity :")') - DO i3 = 1, self%n_Wind_Speeds - WRITE(*,'(5x,"WIND_SPEED :",es22.15)') self%Wind_Speed(i3) - DO i2 = 1, self%n_Frequencies - WRITE(*,'(5x,"FREQUENCY :",es22.15)') self%Frequency(i2) - WRITE(*,'(5(1x,es22.15,:))') self%Emissivity(:,i2,i3) + DO i4 = 1, self%n_Temperature + WRITE(*,'(5x,"TEMPERATURE :",es22.15)') self%Temperature(i4) + DO i3 = 1, self%n_Wind_Speeds + WRITE(*,'(5x,"WIND_SPEED :",es22.15)') self%Wind_Speed(i3) + DO i2 = 1, self%n_Frequencies + WRITE(*,'(5x,"FREQUENCY :",es22.15)') self%Frequency(i2) + WRITE(*,'(5(1x,es22.15,:))') self%Emissivity(:,i2,i3,i4) + END DO END DO END DO END SUBROUTINE IRwaterCoeff_Inspect @@ -435,23 +463,28 @@ SUBROUTINE IRwaterCoeff_Info( self, Info ) ! Write the required data to the local string WRITE( Long_String, & - '( a,1x,"IRwaterCoeff RELEASE.VERSION: ", i2, ".", i2.2, 2x, & + '( a,1x,"IRwaterCoeff RELEASE.VERSION: ", i2, ".", i2.2,a,3x, & + &"CLASSIFICATION: ",a,",",2x,& &"N_ANGLES=",i3,2x,& &"N_FREQUENCIES=",i5,2x,& - &"N_WIND_SPEEDS=",i3 )' ) & + &"N_WIND_SPEEDS=",i3,2x,& + &"N_TEMPERATURE=",i3 )' ) & ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), & self%Release, self%Version, & + ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), & + TRIM(self%Classification_Name), & self%n_Angles, & self%n_Frequencies, & - self%n_Wind_Speeds - + self%n_Wind_Speeds, & + self%n_Temperature + ! Trim the output based on the ! dummy argument string length Info = Long_String(1:MIN(LEN(Info), LEN_TRIM(Long_String))) END SUBROUTINE IRwaterCoeff_Info - - + + !------------------------------------------------------------------------------ !:sdoc+: ! @@ -467,6 +500,7 @@ END SUBROUTINE IRwaterCoeff_Info ! n_Angles = n_Angles , & ! n_Frequencies = n_Frequencies, & ! n_Wind_Speeds = n_Wind_Speeds, & +! n_Temperature = n_Temperature, & ! Release = Release , & ! Version = Version , & ! Title = Title , & @@ -503,6 +537,13 @@ END SUBROUTINE IRwaterCoeff_Info ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! +! n_Temperature: Number of temperature for which there are +! emissivity data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! ! Release: The data/file release number. Used to check ! for data/software mismatch. ! UNITS: N/A @@ -557,6 +598,7 @@ FUNCTION IRwaterCoeff_InquireFile( & n_Angles , & ! Optional output n_Frequencies, & ! Optional output n_Wind_Speeds, & ! Optional output + n_Temperature, & ! Optional output Release , & ! Optional output Version , & ! Optional output Title , & ! Optional output @@ -565,14 +607,15 @@ FUNCTION IRwaterCoeff_InquireFile( & RESULT( err_stat ) ! Arguments CHARACTER(*), INTENT(IN) :: Filename - INTEGER , OPTIONAL, INTENT(OUT) :: n_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_Angles INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies INTEGER , OPTIONAL, INTENT(OUT) :: n_Wind_Speeds + INTEGER , OPTIONAL, INTENT(OUT) :: n_Temperature INTEGER , OPTIONAL, INTENT(OUT) :: Release INTEGER , OPTIONAL, INTENT(OUT) :: Version - CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title - CHARACTER(*), OPTIONAL, INTENT(OUT) :: History - CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment ! Function result INTEGER :: err_stat ! Function parameters @@ -584,7 +627,7 @@ FUNCTION IRwaterCoeff_InquireFile( & INTEGER :: fid TYPE(IRwaterCoeff_type) :: IRwaterCoeff - + ! Setup err_stat = SUCCESS ! ...Check that the file exists @@ -616,7 +659,8 @@ FUNCTION IRwaterCoeff_InquireFile( & READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & IRwaterCoeff%n_Angles , & IRwaterCoeff%n_Frequencies, & - IRwaterCoeff%n_Wind_Speeds + IRwaterCoeff%n_Wind_Speeds, & + IRwaterCoeff%n_Temperature IF ( io_stat /= 0 ) THEN msg = 'Error reading dimension values from '//TRIM(Filename)//' - '//TRIM(io_msg) CALL Inquire_Cleanup(); RETURN @@ -644,14 +688,15 @@ FUNCTION IRwaterCoeff_InquireFile( & ! Assign the return arguments - IF ( PRESENT(n_Angles ) ) n_Angles = IRwaterCoeff%n_Angles + IF ( PRESENT(n_Angles ) ) n_Angles = IRwaterCoeff%n_Angles IF ( PRESENT(n_Frequencies) ) n_Frequencies = IRwaterCoeff%n_Frequencies - IF ( PRESENT(n_Wind_Speeds) ) n_Wind_Speeds = IRwaterCoeff%n_Wind_Speeds + IF ( PRESENT(n_Wind_Speeds) ) n_Wind_Speeds = IRwaterCoeff%n_Wind_Speeds + IF ( PRESENT(n_Temperature) ) n_Temperature = IRwaterCoeff%n_Temperature IF ( PRESENT(Release ) ) Release = IRwaterCoeff%Release IF ( PRESENT(Version ) ) Version = IRwaterCoeff%Version - + CONTAINS - + SUBROUTINE Inquire_CleanUp() ! Close file if necessary IF ( File_Open(fid) ) THEN @@ -663,7 +708,7 @@ SUBROUTINE Inquire_CleanUp() err_stat = FAILURE CALL Display_Message( ROUTINE_NAME, msg, err_stat ) END SUBROUTINE Inquire_CleanUp - + END FUNCTION IRwaterCoeff_InquireFile @@ -788,7 +833,7 @@ FUNCTION IRwaterCoeff_ReadFile( & INTEGER :: io_stat INTEGER :: fid TYPE(IRwaterCoeff_type) :: dummy - + ! Setup err_stat = SUCCESS @@ -803,7 +848,7 @@ FUNCTION IRwaterCoeff_ReadFile( & IF ( Debug ) noisy = .TRUE. END IF - + ! Check if the file is open. IF ( File_Open( Filename ) ) THEN ! ...Inquire for the logical unit number @@ -846,7 +891,8 @@ FUNCTION IRwaterCoeff_ReadFile( & READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & dummy%n_Angles , & dummy%n_Frequencies, & - dummy%n_Wind_Speeds + dummy%n_Wind_Speeds, & + dummy%n_Temperature IF ( io_stat /= 0 ) THEN msg = 'Error reading dimension values from '//TRIM(Filename)//' - '//TRIM(io_msg) CALL Read_Cleanup(); RETURN @@ -854,17 +900,18 @@ FUNCTION IRwaterCoeff_ReadFile( & ! ...Create the return object CALL IRwaterCoeff_Create( & IRwaterCoeff , & - dummy%n_Angles , & - dummy%n_Frequencies, & - dummy%n_Wind_Speeds ) + dummy%n_Angles , & + dummy%n_Frequencies, & + dummy%n_Wind_Speeds, & + dummy%n_Temperature ) IF ( .NOT. IRwaterCoeff_Associated( IRwaterCoeff ) ) THEN msg = 'IRwaterCoeff object creation failed.' CALL Read_Cleanup(); RETURN END IF ! ...Explicitly assign the version number IRwaterCoeff%Version = dummy%Version - - + + ! Read the global attributes err_stat = ReadGAtts_Binary_File( & fid, & @@ -876,13 +923,21 @@ FUNCTION IRwaterCoeff_ReadFile( & CALL Read_Cleanup(); RETURN END IF + ! ...Read the classification name + READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRwaterCoeff%Classification_Name + IF ( io_stat /= 0 ) THEN + msg = 'Error reading classification name - '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF ! Read the coefficient data ! ...Read the dimensional vectors READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & - IRwaterCoeff%Angle , & - IRwaterCoeff%Frequency , & - IRwaterCoeff%Wind_Speed + IRwaterCoeff%Angle , & + IRwaterCoeff%Frequency , & + IRwaterCoeff%Wind_Speed , & + IRwaterCoeff%Temperature IF ( io_stat /= 0 ) THEN msg = 'Error reading dimensional vectors - '//TRIM(io_msg) CALL Read_Cleanup(); RETURN @@ -914,7 +969,7 @@ FUNCTION IRwaterCoeff_ReadFile( & END IF CONTAINS - + SUBROUTINE Read_CleanUp() IF ( File_Open(Filename) ) THEN CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) @@ -1048,7 +1103,7 @@ FUNCTION IRwaterCoeff_WriteFile( & LOGICAL :: noisy INTEGER :: io_stat INTEGER :: fid - + ! Setup err_stat = SUCCESS @@ -1068,7 +1123,7 @@ FUNCTION IRwaterCoeff_WriteFile( & CALL Write_Cleanup(); RETURN END IF - + ! Check if the file is open. IF ( File_Open( FileName ) ) THEN ! ...Inquire for the logical unit number @@ -1102,7 +1157,8 @@ FUNCTION IRwaterCoeff_WriteFile( & WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & IRwaterCoeff%n_Angles , & IRwaterCoeff%n_Frequencies, & - IRwaterCoeff%n_Wind_Speeds + IRwaterCoeff%n_Wind_Speeds, & + IRwaterCoeff%n_Temperature IF ( io_stat /= 0 ) THEN msg = 'Error writing dimension values to '//TRIM(Filename)//' - '//TRIM(io_msg) CALL Write_Cleanup(); RETURN @@ -1121,13 +1177,21 @@ FUNCTION IRwaterCoeff_WriteFile( & CALL Write_Cleanup(); RETURN END IF + ! Write the surface classification name + WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + IRwaterCoeff%Classification_Name + IF ( io_stat /= 0 ) THEN + msg = 'Error writing classification name - '//TRIM(io_msg) + CALL Write_Cleanup(); RETURN + END IF ! Write the coefficient data ! ...Write the dimensional vectors WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) & IRwaterCoeff%Angle , & IRwaterCoeff%Frequency , & - IRwaterCoeff%Wind_Speed + IRwaterCoeff%Wind_Speed , & + IRwaterCoeff%Temperature IF ( io_stat /= 0 ) THEN msg = 'Error writing dimensional vectors - '//TRIM(io_msg) CALL Write_Cleanup(); RETURN @@ -1140,7 +1204,7 @@ FUNCTION IRwaterCoeff_WriteFile( & CALL Write_Cleanup(); RETURN END IF - + ! Close the file IF ( close_file ) THEN CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) @@ -1158,7 +1222,7 @@ FUNCTION IRwaterCoeff_WriteFile( & END IF CONTAINS - + SUBROUTINE Write_CleanUp() IF ( File_Open(Filename) ) THEN CLOSE( fid, STATUS=WRITE_ERROR_STATUS, IOSTAT=io_stat, IOMSG=io_msg ) @@ -1219,7 +1283,7 @@ ELEMENTAL FUNCTION IRwaterCoeff_Equal( x, y ) RESULT( is_equal ) ! Set up is_equal = .FALSE. - + ! Check the object association status IF ( (.NOT. IRwaterCoeff_Associated(x)) .OR. & (.NOT. IRwaterCoeff_Associated(y)) ) RETURN @@ -1229,17 +1293,21 @@ ELEMENTAL FUNCTION IRwaterCoeff_Equal( x, y ) RESULT( is_equal ) ! ...Release/version info IF ( (x%Release /= y%Release) .OR. & (x%Version /= y%Version) ) RETURN + ! ...Classification name + IF ( (x%Classification_Name /= y%Classification_Name) ) RETURN ! ...Dimensions IF ( (x%n_Angles /= y%n_Angles ) .OR. & (x%n_Frequencies /= y%n_Frequencies ) .OR. & - (x%n_Wind_Speeds /= y%n_Wind_Speeds ) ) RETURN + (x%n_Wind_Speeds /= y%n_Wind_Speeds ) .OR. & + (x%n_Temperature /= y%n_Temperature ) ) RETURN ! ...Arrays - IF ( ALL(x%Angle .EqualTo. y%Angle ) .AND. & - ALL(x%Frequency .EqualTo. y%Frequency ) .AND. & - ALL(x%Wind_Speed .EqualTo. y%Wind_Speed ) .AND. & - ALL(x%Emissivity .EqualTo. y%Emissivity ) ) & + IF ( ALL(x%Angle .EqualTo. y%Angle ) .AND. & + ALL(x%Frequency .EqualTo. y%Frequency ) .AND. & + ALL(x%Wind_Speed .EqualTo. y%Wind_Speed ) .AND. & + ALL(x%Temperature .EqualTo. y%Temperature ) .AND. & + ALL(x%Emissivity .EqualTo. y%Emissivity ) ) & is_equal = .TRUE. - + END FUNCTION IRwaterCoeff_Equal END MODULE IRwaterCoeff_Define diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_IO.f90 b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_IO.f90 new file mode 100644 index 0000000..55c8dfe --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_IO.f90 @@ -0,0 +1,766 @@ +! +! IRwaterCoeff_IO +! +! Container module for Binary and netCDF IRwaterCoeff I/O modules. +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Modified by: Cheng Dang, 18-Mar-2022 +! dangch@ucar.edu +! Add temperature dimension +! + +MODULE IRwaterCoeff_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE IRwaterCoeff_Define , ONLY: IRwaterCoeff_type, & + OPERATOR(==), & + IRwaterCoeff_InquireFile , & + IRwaterCoeff_ReadFile , & + IRwaterCoeff_WriteFile + USE IRwaterCoeff_netCDF_IO , ONLY: IRwaterCoeff_netCDF_InquireFile , & + IRwaterCoeff_netCDF_ReadFile , & + IRwaterCoeff_netCDF_WriteFile + ! Disable implicit typing + IMPLICIT NONE + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + PUBLIC :: IRwaterCoeff_InquireFile_IO + PUBLIC :: IRwaterCoeff_ReadFile_IO + PUBLIC :: IRwaterCoeff_WriteFile_IO + PUBLIC :: IRwaterCoeff_netCDF_to_Binary + PUBLIC :: IRwaterCoeff_Binary_to_netCDF + + CONTAINS + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_InquireFile_IO +! +! PURPOSE: +! Function to inquire IRwaterCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_InquireFile_IO( & +! Filename, & +! netCDF = netCDF , & +! n_Angles = n_Angles , & +! n_Frequencies = n_Frequencies , & +! n_Wind_Speeds = n_Wind_Speeds , & +! n_Temperature = n_Temperature , & +! Release = Release , & +! Version = Version , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRwaterCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! IRwaterCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! n_Angles: The number of angles in the look-up +! table (LUT). Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Frequencies: The number of frequencies in the LUT. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Wind_Speeds: The number of wind speeds in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! n_Temperature: The number of temperature in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Release: The release number of the IRwaterCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the IRwaterCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRwaterCoeff_InquireFile_IO( & + Filename , & ! Input + netCDF , & ! Optional input + n_Angles , & ! Optional output + n_Frequencies , & ! Optional output + n_Wind_Speeds , & ! Optional output + n_Temperature , & ! Optional output + Release , & ! Optional output + Version , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies + INTEGER , OPTIONAL, INTENT(OUT) :: n_Wind_Speeds + INTEGER , OPTIONAL, INTENT(OUT) :: n_Temperature + LOGICAL , OPTIONAL, INTENT(IN) :: netCDF + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + + ! Call the appropriate function + IF ( Binary ) THEN + err_stat = IRwaterCoeff_InquireFile( & + Filename , & + n_Angles = n_Angles , & + n_Frequencies = n_Frequencies , & + n_Wind_Speeds = n_Wind_Speeds , & + n_Temperature = n_Temperature , & + Release = Release , & + Version = Version ) + ELSE + err_stat = IRwaterCoeff_netCDF_InquireFile( & + Filename , & + n_Angles = n_Angles , & + n_Frequencies = n_Frequencies , & + n_Wind_Speeds = n_Wind_Speeds , & + n_Temperature = n_Temperature , & + Release = Release , & + Version = Version , & + Title = Title , & + History = History , & + Comment = Comment ) + END IF + + END FUNCTION IRwaterCoeff_InquireFile_IO + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_ReadFile_IO +! +! PURPOSE: +! Function to read IRwaterCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_ReadFile_IO( & +! IRwaterCoeff, & +! Filename, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRwaterCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! IRwaterCoeff: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRwaterCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! IRwaterCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! Title: Character string written into the TITLE global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION IRwaterCoeff_ReadFile_IO( & + IRwaterCoeff, & ! Output + Filename , & ! Input + netCDF , & ! Optional input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment , & ! Optional output + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRwaterCoeff_type), INTENT(OUT) :: IRwaterCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: No_Close + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + !Call the appropriate function + IF ( Binary ) THEN + err_stat = IRwaterCoeff_ReadFile( & + IRwaterCoeff, & + Filename , & + No_Close , & + Quiet ) + ELSE + err_stat = IRwaterCoeff_netCDF_ReadFile( & + IRwaterCoeff, & + Filename , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + END IF + + END FUNCTION IRwaterCoeff_ReadFile_IO + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_WriteFile_IO +! +! PURPOSE: +! Function to write IRwaterCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_WriteFile_IO( & +! IRwaterCoeff, & +! Filename, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! IRwaterCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! IRwaterCoeff: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRwaterCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! IRwaterCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! No_Close: Set this logical argument to *NOT* close the datafile +! upon exiting this routine. This option is required if +! the IRwaterCoeff data is embedded within another file. +! If == .FALSE., File is closed upon function exit [DEFAULT]. +! == .TRUE., File is NOT closed upon function exit +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRwaterCoeff_WriteFile_IO( & + IRwaterCoeff, & ! Input + Filename , & ! Input + netCDF , & ! Optional input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment , & ! Optional input + Debug ) & ! Optional input (Debug output control) + RESULT ( err_stat ) + ! Arguments + TYPE(IRwaterCoeff_type), INTENT(IN) :: IRwaterCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: No_Close + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Local variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Call the appropriate function + IF ( Binary ) THEN + err_stat = IRwaterCoeff_WriteFile( & + IRwaterCoeff, & + Filename , & + No_Close , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + ELSE + err_stat = IRwaterCoeff_netCDF_WriteFile( & + IRwaterCoeff, & + Filename , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + END IF + + END FUNCTION IRwaterCoeff_WriteFile_IO + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_netCDF_to_Binary +! +! PURPOSE: +! Function to convert a netCDF IRwaterCoeff file to Binary format. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_netCDF_to_Binary( & +! NC_Filename , & +! BIN_Filename , & +! Quiet = Quiet ) +! +! INPUTS: +! NC_Filename: Character string specifying the name of the +! netCDF format IRwaterCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! BIN_Filename: Character string specifying the name of the +! Binary format IRwaterCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the file conversion was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! - If the output file already exists, it is overwritten. +! - If an error occurs, the output file is deleted before +! returning to the calling routine. +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRwaterCoeff_netCDF_to_Binary( & + NC_Filename , & ! Input + BIN_Filename, & ! Input + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + CHARACTER(*), INTENT(IN) :: BIN_Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_netCDF_to_Binary' + ! Function variables + CHARACTER(256) :: msg + TYPE(IRwaterCoeff_type) :: cc, cc_copy + + ! Set up + err_stat = SUCCESS + + ! Read the netCDF file + err_stat = IRwaterCoeff_ReadFile_IO(cc, NC_Filename, Quiet = Quiet, netCDF = .TRUE. ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(NC_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Write the Binary file + err_stat = IRwaterCoeff_WriteFile_IO(cc, BIN_Filename, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing Binary file '//TRIM(BIN_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Check the write was successful + ! ...Read the Binary file + err_stat = IRwaterCoeff_ReadFile_IO(cc_copy, BIN_Filename, Quiet = Quiet) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary file '//TRIM(BIN_Filename)//' for test' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! ...Compare the IRwaterCoeff objects + IF ( .NOT. (cc == cc_copy) ) THEN + msg = 'IRwaterCoeff object comparison failed.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + END FUNCTION IRwaterCoeff_netCDF_to_Binary + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_Binary_to_netCDF +! +! PURPOSE: +! Function to convert a binary IRwaterCoeff file to Binary format. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_Binary_to_netCDF( & +! BIN_Filename , & +! NC_Filename , & +! Quiet = Quiet ) +! +! INPUTS: +! BIN_Filename: Character string specifying the name of the +! Binary format IRwaterCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! NC_Filename: Character string specifying the name of the +! netCDF format IRwaterCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the file conversion was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! - If the output file already exists, it is overwritten. +! - If an error occurs, the output file is deleted before +! returning to the calling routine. +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRwaterCoeff_Binary_to_netCDF( & + BIN_Filename, & ! Input + NC_Filename , & ! Input + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: BIN_Filename + CHARACTER(*), INTENT(IN) :: NC_Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_Binary_to_NetCDF' + ! Function variables + CHARACTER(256) :: msg + TYPE(IRwaterCoeff_type) :: cc, cc_copy + + ! Set up + err_stat = SUCCESS + + ! Read the netCDF file + err_stat = IRwaterCoeff_ReadFile_IO(cc, BIN_Filename, Quiet = Quiet) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary file '//TRIM(BIN_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Write the Binary file + err_stat = IRwaterCoeff_WriteFile_IO(cc, NC_Filename, Quiet = Quiet, netCDF = .TRUE.) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing netCDF file '//TRIM(NC_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Check the write was successful + ! ...Read the Binary file + err_stat = IRwaterCoeff_ReadFile_IO(cc_copy, NC_Filename, Quiet = Quiet, netCDF = .TRUE.) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(NC_Filename)//' for test' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! ...Compare the IRwaterCoeff objects + IF ( .NOT. (cc == cc_copy) ) THEN + msg = 'IRwaterCoeff object comparison failed.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + END FUNCTION IRwaterCoeff_Binary_to_netCDF + +END MODULE IRwaterCoeff_IO diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Inspect/IRwaterCoeff_Inspect.f90 b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Inspect/IRwaterCoeff_Inspect.f90 index 94a9f6f..6645afa 100644 --- a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Inspect/IRwaterCoeff_Inspect.f90 +++ b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_Inspect/IRwaterCoeff_Inspect.f90 @@ -28,7 +28,7 @@ PROGRAM IRwaterCoeff_Inspect ! Parameters ! ---------- CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'IRwaterCoeff_Inspect' - CHARACTER(*), PARAMETER :: PROGRAM_VERSION_ID = & + !CHARACTER(*), PARAMETER :: PROGRAM_VERSION_ID = & ! --------- ! Variables diff --git a/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_netCDF_IO.f90 b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_netCDF_IO.f90 new file mode 100644 index 0000000..76a982d --- /dev/null +++ b/src/Coefficients/EmisCoeff/IR_Water/IRwaterCoeff_netCDF_IO.f90 @@ -0,0 +1,1377 @@ +! +! +! IRwaterCoeff_netCDF_IO +! +! Module containing routines to read and write IRwaterCoeff netCDF +! format files. +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 05-Mar-2022 +! dangch@ucar.edu +! Modified by: Cheng Dang, 18-Mar-2022 +! dangch@ucar.edu +! Add temperature dimension +! + +MODULE IRwaterCoeff_netCDF_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp, Double, Long + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE String_Utility , ONLY: StrClean + USE IRwaterCoeff_Define, ONLY: IRwaterCoeff_type, & + IRwaterCoeff_Associated, & + IRwaterCoeff_Create, & + IRwaterCoeff_Inspect, & + IRwaterCoeff_Destroy, & + IRwaterCoeff_ValidRelease, & + IRwaterCoeff_Info + USE netcdf + ! Disable implicit typing + IMPLICIT NONE + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Procedures + PUBLIC :: IRwaterCoeff_netCDF_InquireFile + PUBLIC :: IRwaterCoeff_netCDF_ReadFile + PUBLIC :: IRwaterCoeff_netCDF_WriteFile + + ! ----------------- + ! Module parameters + ! ----------------- + ! Default msg string length + INTEGER, PARAMETER :: ML = 1024 + ! Literal constants + REAL(fp), PARAMETER :: FILL_FLOAT = -999.0_fp + REAL(fp), PARAMETER :: ONE = 1.0_fp + ! Conversion constants + REAL(fp), PARAMETER :: PI = 3.141592653589793238462643383279_fp + REAL(fp), PARAMETER :: DEGREES_TO_RADIANS = PI / 180.0_fp + + ! Global attribute names. Case sensitive + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + CHARACTER(*), PARAMETER :: VERSION_GATTNAME = 'Version' + CHARACTER(*), PARAMETER :: DATA_SOURCE_GATTNAME = 'Data_Source' + CHARACTER(*), PARAMETER :: TITLE_GATTNAME = 'Title' + CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'History' + CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'Comment' + CHARACTER(*), PARAMETER :: CLASSIFICATION_NAME_GATTNAME = 'Classification_Name' + + ! Dimension names + CHARACTER(*), PARAMETER :: TNSL_DIMNAME = 'String_Length' + CHARACTER(*), PARAMETER :: FREQUENCY_DIMNAME = 'n_Frequencies' + CHARACTER(*), PARAMETER :: ANGLE_DIMNAME = 'n_Angles' + CHARACTER(*), PARAMETER :: WINDSPEED_DIMNAME = 'n_Wind_Speeds' + CHARACTER(*), PARAMETER :: TEMPERATURE_DIMNAME = 'n_Temperature' + + ! Variable names + CHARACTER(*), PARAMETER :: ANGLE_VARNAME = 'Angle' + CHARACTER(*), PARAMETER :: FREQUENCY_VARNAME = 'Frequency' + CHARACTER(*), PARAMETER :: WINDSPEED_VARNAME = 'Wind_Speed' + CHARACTER(*), PARAMETER :: TEMPERATURE_VARNAME = 'Temperature' + CHARACTER(*), PARAMETER :: EMISSIVITY_VARNAME = 'Emissivity' + + ! Variable long name attribute. + CHARACTER(*), PARAMETER :: LONGNAME_ATTNAME = 'long_name' + CHARACTER(*), PARAMETER :: ANGLE_LONGNAME = 'Angle' + CHARACTER(*), PARAMETER :: FREQUENCY_LONGNAME = 'Frequency' + CHARACTER(*), PARAMETER :: WINDSPEED_LONGNAME = 'Wind Speed' + CHARACTER(*), PARAMETER :: TEMPERATURE_LONGNAME = 'Temperature' + CHARACTER(*), PARAMETER :: EMISSIVITY_LONGNAME = 'Emissivity' + + ! Variable description attribute. + CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' + CHARACTER(*), PARAMETER :: ANGLE_DESCRIPTION = 'Angle dimension values for emissivity data' + CHARACTER(*), PARAMETER :: FREQUENCY_DESCRIPTION = 'Frequency dimension values for emissivity data' + CHARACTER(*), PARAMETER :: WINDSPEED_DESCRIPTION = 'Wind speed dimension values for emissivity data' + CHARACTER(*), PARAMETER :: TEMPERATURE_DESCRIPTION = 'Temperature dimension values for emissivity data' + CHARACTER(*), PARAMETER :: EMISSIVITY_DESCRIPTION = 'Spectral water surface emissivity data' + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + CHARACTER(*), PARAMETER :: ANGLE_UNITS = 'degrees from vertical' + CHARACTER(*), PARAMETER :: FREQUENCY_UNITS = 'inverse centimeters (cm^-1)' + CHARACTER(*), PARAMETER :: WINDSPEED_UNITS = 'meters per second (m.s^-1)' + CHARACTER(*), PARAMETER :: TEMPERATURE_UNITS = 'Kelvins' + CHARACTER(*), PARAMETER :: EMISSIVITY_UNITS = 'N/A' + + ! Variable _FillValue attribute. + CHARACTER(*), PARAMETER :: FILLVALUE_ATTNAME = '_FillValue' + REAL(Double), PARAMETER :: ANGLE_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: FREQUENCY_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: WINDSPEED_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: TEMPERATURE_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: EMISSIVITY_FILLVALUE = FILL_FLOAT + + ! Variable types + INTEGER, PARAMETER :: ANGLE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: FREQUENCY_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: WINDSPEED_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: TEMPERATURE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: EMISSIVITY_TYPE = NF90_DOUBLE + + +CONTAINS + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_netCDF_InquireFile +! +! PURPOSE: +! Function to inquire IRwaterCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_netCDF_InquireFile( & +! Filename, & +! n_Angles = n_Angles , & +! n_Frequencies = n_Frequencies , & +! n_Wind_Speeds = n_Wind_Speeds , & +! n_Temperature = n_Temperature , & +! Release = Release , & +! Version = Version , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRwaterCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL OUTPUTS: +! n_Angles: The number of angles in the look-up +! table (LUT). Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Frequencies: The number of frequencies in the LUT. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Wind_Speeds: The number of wind speeds in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Wind_Speeds: The number of temperature in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Release: The release number of the IRwaterCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the IRwaterCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION IRwaterCoeff_netCDF_InquireFile( & + Filename , & ! Input + n_Angles , & ! Optional output + n_Frequencies, & ! Optional output + n_Wind_Speeds, & ! Optional output + n_Temperature, & ! Optional output + Release , & ! Optional output + Version , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies + INTEGER , OPTIONAL, INTENT(OUT) :: n_Wind_Speeds + INTEGER , OPTIONAL, INTENT(OUT) :: n_Temperature + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_netCDF_InquireFile' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: DimId + TYPE(IRwaterCoeff_type) :: IRwaterCoeff + + ! Setup + err_stat = SUCCESS + Close_File = .FALSE. + + ! Open the file + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Get the dimensions + ! ...n_Angles dimension + NF90_Status = NF90_INQ_DIMID( FileId,ANGLE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRwaterCoeff%n_Angles ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Frequencies dimension + NF90_Status = NF90_INQ_DIMID( FileId,FREQUENCY_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//FREQUENCY_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRwaterCoeff%n_Frequencies ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//FREQUENCY_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Wind_Speeds dimension + NF90_Status = NF90_INQ_DIMID( FileId,WINDSPEED_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//WINDSPEED_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRwaterCoeff%n_Wind_Speeds ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//WINDSPEED_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Temperature dimension + NF90_Status = NF90_INQ_DIMID( FileId,TEMPERATURE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//TEMPERATURE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=IRwaterCoeff%n_Temperature ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//TEMPERATURE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Get the global attributes + err_stat = ReadGAtts( Filename, & + FileId , & + Release = IRwaterCoeff%Release, & + Version = IRwaterCoeff%Version, & + Title = Title , & + History = History, & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes from '//TRIM(Filename) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing input file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Set the return values + IF ( PRESENT(n_Angles ) ) n_Angles = IRwaterCoeff%n_Angles + IF ( PRESENT(n_Frequencies) ) n_Frequencies = IRwaterCoeff%n_Frequencies + IF ( PRESENT(n_Wind_Speeds) ) n_Wind_Speeds = IRwaterCoeff%n_Wind_Speeds + IF ( PRESENT(n_Temperature) ) n_Temperature = IRwaterCoeff%n_Temperature + IF ( PRESENT(Release ) ) Release = IRwaterCoeff%Release + IF ( PRESENT(Version ) ) Version = IRwaterCoeff%Version + + CONTAINS + + SUBROUTINE Inquire_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup.' + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION IRwaterCoeff_netCDF_InquireFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_netCDF_WriteFile +! +! PURPOSE: +! Function to write IRwaterCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_netCDF_WriteFile( & +! IRwaterCoeff, & +! Filename, & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment, & +! Debug ) +! +! INPUTS: +! IRwaterCoeff: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRwaterCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Filename: Character string specifying the name of the +! IRwaterCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION IRwaterCoeff_netCDF_WriteFile( & + IRwaterCoeff, & ! Input + Filename , & ! Input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment , & ! Optional input + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRwaterCoeff_type), INTENT(IN) :: IRwaterCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + LOGICAL , OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_netCDF_WriteFile' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + LOGICAL :: Noisy + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: VarId + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check structure pointer association status + IF ( .NOT. IRwaterCoeff_Associated( IRwaterCoeff ) ) THEN + msg = 'IRwaterCoeff structure is empty. Nothing to do!' + CALL Write_CleanUp(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. IRwaterCoeff_ValidRelease( IRwaterCoeff ) ) THEN + msg = 'IRwaterCoeff Release check failed.' + CALL Write_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + Noisy = .TRUE. + IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet + + ! Create the output file + err_stat = CreateFile( & + Filename , & ! Input + IRwaterCoeff%n_Angles , & ! Input + IRwaterCoeff%n_Frequencies , & ! Input + IRwaterCoeff%n_Wind_Speeds , & ! Input + IRwaterCoeff%n_Temperature , & ! Input + FileId , & ! Output + Release = IRwaterCoeff%Release , & ! Optional input + Version = IRwaterCoeff%Version , & ! Optional input + Classification_Name = IRwaterCoeff%Classification_Name , & ! Optional input + Title = Title , & ! Optional input + History = History , & ! Optional input + Comment = Comment ) ! Optional input + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error creating output file '//TRIM(Filename) + CALL Write_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Write the data items + ! ...Angle variable + NF90_Status = NF90_INQ_VARID( FileId,ANGLE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRwaterCoeff%Angle ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//ANGLE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_INQ_VARID( FileId,FREQUENCY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRwaterCoeff%Frequency ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Wind speed variable + NF90_Status = NF90_INQ_VARID( FileId,WINDSPEED_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//WINDSPEED_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRwaterCoeff%Wind_Speed ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//WINDSPEED_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Temperature variable + NF90_Status = NF90_INQ_VARID( FileId,TEMPERATURE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TEMPERATURE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRwaterCoeff%Temperature ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//TEMPERATURE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Emissivity variable + NF90_Status = NF90_INQ_VARID( FileId,EMISSIVITY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//EMISSIVITY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,IRwaterCoeff%Emissivity ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//EMISSIVITY_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( Noisy ) THEN + CALL IRwaterCoeff_Info( IRwaterCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing output file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION IRwaterCoeff_netCDF_WriteFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! IRwaterCoeff_netCDF_ReadFile +! +! PURPOSE: +! Function to read IRwaterCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = IRwaterCoeff_netCDF_ReadFile( & +! IRwaterCoeff, & +! Filename, & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! IRwaterCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! IRwaterCoeff: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(IRwaterCoeff_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! Title: Character string written into the TITLE global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the IRwaterCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION IRwaterCoeff_netCDF_ReadFile( & + IRwaterCoeff, & ! Output + Filename , & ! Input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment , & ! Optional output + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(IRwaterCoeff_type), INTENT(OUT) :: IRwaterCoeff + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL , OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + LOGICAL , OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_netCDF_ReadFile' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + LOGICAL :: Noisy + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: n_Angles + INTEGER :: n_Frequencies + INTEGER :: n_Wind_Speeds + INTEGER :: n_Temperature + INTEGER :: VarId + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check that the file exists + IF ( .NOT. File_Exists(Filename) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + Noisy = .TRUE. + IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet + + ! Inquire the file to get the dimensions + err_stat = IRwaterCoeff_netCDF_InquireFile( & + Filename , & + n_Angles = n_Angles , & + n_Frequencies = n_Frequencies , & + n_Wind_Speeds = n_Wind_Speeds , & + n_Temperature = n_Temperature ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error obtaining IRwaterCoeff dimensions from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + + ! Allocate the output structure + CALL IRwaterCoeff_Create( & + IRwaterCoeff , & + n_Angles , & + n_Frequencies , & + n_Wind_Speeds , & + n_Temperature ) + IF ( .NOT. IRwaterCoeff_Associated( IRwaterCoeff ) ) THEN + msg = 'IRwaterCoeff object allocation failed.' + CALL Read_Cleanup(); RETURN + END IF + + ! Open the file for reading + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '//& + TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Read the global attributes + err_stat = ReadGAtts( Filename, & + FileID , & + Release = IRwaterCoeff%Release , & + Version = IRwaterCoeff%Version , & + Classification_Name = IRwaterCoeff%Classification_Name , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attribute from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. IRwaterCoeff_ValidRelease( IRwaterCoeff ) ) THEN + msg = 'IRwaterCoeff Release check failed.' + CALL Read_Cleanup(); RETURN + END IF + + ! Read the IRwaterCoeff data + ! ...Angle variable + NF90_Status = NF90_INQ_VARID( FileId,ANGLE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRwaterCoeff%Angle ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//ANGLE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Compute the transformed dimensional vectors + IRwaterCoeff%Secant_Angle = ONE/COS(DEGREES_TO_RADIANS*IRwaterCoeff%Angle) + + ! ...Frequency variable + NF90_Status = NF90_INQ_VARID( FileId,FREQUENCY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRwaterCoeff%Frequency ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//FREQUENCY_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Wind speed variable + NF90_Status = NF90_INQ_VARID( FileId,WINDSPEED_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//WINDSPEED_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRwaterCoeff%Wind_Speed ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//WINDSPEED_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Temperature variable + NF90_Status = NF90_INQ_VARID( FileId,TEMPERATURE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TEMPERATURE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRwaterCoeff%Temperature ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//TEMPERATURE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Emissivity variable + NF90_Status = NF90_INQ_VARID( FileId,EMISSIVITY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//EMISSIVITY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,IRwaterCoeff%Emissivity ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//EMISSIVITY_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ); Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( Noisy ) THEN + CALL IRwaterCoeff_Info( IRwaterCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup- '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + CALL IRwaterCoeff_Destroy( IRwaterCoeff ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION IRwaterCoeff_netCDF_ReadFile + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + + ! Function to write the global attributes to a IRwaterCoeff data file. + + FUNCTION WriteGAtts( & + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional input + Version , & ! Optional input + Classification_Name , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Release + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_WriteGAtts(netCDF)' + CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME = 'write_module_history' + CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: GAttName + CHARACTER(8) :: cdate + CHARACTER(10) :: ctime + CHARACTER(5) :: czone + CHARACTER(ML) :: CLSname + INTEGER :: Ver + INTEGER :: NF90_Status + TYPE(IRwaterCoeff_type) :: IRwaterCoeff + + ! Set up + err_stat = SUCCESS + msg = ' ' + + ! Mandatory global attributes + ! ...Software ID + !GAttName = WRITE_MODULE_HISTORY_GATTNAME + !NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),MODULE_VERSION_ID ) + !IF ( NF90_Status /= NF90_NOERR ) THEN + ! CALL WriteGAtts_Cleanup(); RETURN + !END IF + ! ...Creation date + CALL DATE_AND_TIME( cdate, ctime, czone ) + GAttName = CREATION_DATE_AND_TIME_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName), & + cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// & + ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// & + czone//'UTC' ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + + ! Optional global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + GAttName = RELEASE_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),IRwaterCoeff%Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Version + IF ( PRESENT(Version) ) THEN + Ver = Version + ELSE + Ver = IRwaterCoeff%Version + END IF + GAttName = VERSION_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),Ver ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Classification_Name + IF ( PRESENT(Classification_Name) ) THEN + CLSname = Classification_Name + ELSE + CLSname = IRwaterCoeff%Classification_Name + END IF + GAttName = CLASSIFICATION_NAME_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),CLSname ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + GAttName = TITLE_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),title ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + GAttName = HISTORY_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),history ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + GAttName = COMMENT_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),comment ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + + CONTAINS + + SUBROUTINE WriteGAtts_CleanUp() + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = '; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status ) ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TRIM(GAttName)//' attribute to '//& + TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( NF90_Status ) )//TRIM(msg), & + err_stat ) + END SUBROUTINE WriteGAtts_CleanUp + + END FUNCTION WriteGAtts + + ! Function to read the global attributes from a IRwaterCoeff data file. + + FUNCTION ReadGAtts( & + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional output + Version , & ! Optional output + Classification_Name , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_ReadGAtts(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(256) :: GAttName + CHARACTER(5000) :: GAttString + INTEGER :: NF90_Status + + ! Set up + err_stat = SUCCESS + + ! The global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + GAttName = RELEASE_GATTNAME + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Version + IF ( PRESENT(Version) ) THEN + GAttName = VERSION_GATTNAME + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Version ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Classification Name + IF ( PRESENT(Classification_Name) ) THEN + GAttName = CLASSIFICATION_NAME_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + Classification_Name = GAttString(1:MIN(LEN(Classification_Name), LEN_TRIM(GAttString))) + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + GAttName = TITLE_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + title = GAttString(1:MIN(LEN(title), LEN_TRIM(GAttString))) + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + GAttName = HISTORY_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + history = GAttString(1:MIN(LEN(history), LEN_TRIM(GAttString))) + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + GAttName = COMMENT_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + comment = GAttString(1:MIN(LEN(comment), LEN_TRIM(GAttString))) + END IF + + CONTAINS + + SUBROUTINE ReadGAtts_CleanUp() + err_stat = FAILURE + msg = 'Error reading '//TRIM(GAttName)//' attribute from '//TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( NF90_Status ) ) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE ReadGAtts_CleanUp + + END FUNCTION ReadGAtts + + FUNCTION CreateFile( & + Filename , & ! Input + n_Angles , & ! Input + n_Frequencies , & ! Input + n_Wind_Speeds , & ! Input + n_Temperature , & ! Input + FileId , & ! Output + Release , & ! Optional input + Version , & ! Optional input + Classification_Name , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: n_Angles + INTEGER , INTENT(IN) :: n_Frequencies + INTEGER , INTENT(IN) :: n_Wind_Speeds + INTEGER , INTENT(IN) :: n_Temperature + INTEGER , INTENT(OUT) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Release + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'IRwaterCoeff_CreateFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + INTEGER :: NF90_Status + INTEGER :: n_Angles_DimID + INTEGER :: n_Frequencies_DimID + INTEGER :: n_Wind_Speeds_DimID + INTEGER :: n_Temperature_DimID + INTEGER :: varID + INTEGER :: Put_Status(4) + TYPE(IRwaterCoeff_type) :: dummy + + ! Setup + err_stat = SUCCESS + Close_File = .FALSE. + + ! Create the data file + NF90_Status = NF90_CREATE( Filename,NF90_CLOBBER,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Define the dimensions + ! ...Number of angles + NF90_Status = NF90_DEF_DIM( FileID,ANGLE_DIMNAME,n_Angles,n_Angles_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//ANGLE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of frequencies + NF90_Status = NF90_DEF_DIM( FileID,FREQUENCY_DIMNAME,n_Frequencies,n_Frequencies_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//FREQUENCY_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of wind speed + NF90_Status = NF90_DEF_DIM( FileID,WINDSPEED_DIMNAME,n_Wind_Speeds,n_Wind_Speeds_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//WINDSPEED_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of temperature + NF90_Status = NF90_DEF_DIM( FileID,TEMPERATURE_DIMNAME,n_Temperature,n_Temperature_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TEMPERATURE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + CALL IRwaterCoeff_Destroy(dummy) + + ! Write the global attributes + err_stat = WriteGAtts( Filename, & + FileId , & + Release = Release , & + Version = Version , & + Classification_Name = Classification_Name , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing global attribute to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + ! Define the variables + ! ...Angle variable + NF90_Status = NF90_DEF_VAR( FileID, & + ANGLE_VARNAME, & + ANGLE_TYPE, & + dimIDs=(/n_Angles_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//ANGLE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,ANGLE_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,ANGLE_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,ANGLE_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,ANGLE_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//ANGLE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_DEF_VAR( FileID, & + FREQUENCY_VARNAME, & + FREQUENCY_TYPE, & + dimIDs=(/n_Frequencies_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//FREQUENCY_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,FREQUENCY_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,FREQUENCY_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,FREQUENCY_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,FREQUENCY_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Wind speed variable + NF90_Status = NF90_DEF_VAR( FileID, & + WINDSPEED_VARNAME, & + WINDSPEED_TYPE, & + dimIDs=(/n_Wind_Speeds_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//WINDSPEED_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,WINDSPEED_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,WINDSPEED_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,WINDSPEED_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,WINDSPEED_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//WINDSPEED_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Temperature variable + NF90_Status = NF90_DEF_VAR( FileID, & + TEMPERATURE_VARNAME, & + TEMPERATURE_TYPE, & + dimIDs=(/n_Temperature_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TEMPERATURE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,TEMPERATURE_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,TEMPERATURE_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,TEMPERATURE_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,TEMPERATURE_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//TEMPERATURE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Emissivity variable + NF90_Status = NF90_DEF_VAR( FileID, & + EMISSIVITY_VARNAME, & + EMISSIVITY_TYPE, & + dimIDs=(/n_Angles_DimID, n_Frequencies_DimID, n_Wind_Speeds_DimID, n_Temperature_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//EMISSIVITY_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,EMISSIVITY_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,EMISSIVITY_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,EMISSIVITY_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,EMISSIVITY_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//EMISSIVITY_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + ! Take netCDF file out of define mode + NF90_Status = NF90_ENDDEF( FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error taking file '//TRIM(Filename)// & + ' out of define mode - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE Create_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileID ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Create_CleanUp + + END FUNCTION CreateFile + + END MODULE IRwaterCoeff_netCDF_IO diff --git a/src/Coefficients/EmisCoeff/MW_Water/MWwaterCoeff_Inspect/MWwaterCoeff_Inspect.f90 b/src/Coefficients/EmisCoeff/MW_Water/MWwaterCoeff_Inspect/MWwaterCoeff_Inspect.f90 index 8af4919..366e584 100644 --- a/src/Coefficients/EmisCoeff/MW_Water/MWwaterCoeff_Inspect/MWwaterCoeff_Inspect.f90 +++ b/src/Coefficients/EmisCoeff/MW_Water/MWwaterCoeff_Inspect/MWwaterCoeff_Inspect.f90 @@ -28,7 +28,7 @@ PROGRAM MWwaterCoeff_Inspect ! Parameters ! ---------- CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'MWwaterCoeff_Inspect' - CHARACTER(*), PARAMETER :: PROGRAM_VERSION_ID = & + !CHARACTER(*), PARAMETER :: PROGRAM_VERSION_ID = & ! --------- ! Variables diff --git a/src/Coefficients/EmisCoeff/MW_Water/MWwaterLUT/MWwaterLUT_Inspect/MWwaterLUT_Inspect.f90 b/src/Coefficients/EmisCoeff/MW_Water/MWwaterLUT/MWwaterLUT_Inspect/MWwaterLUT_Inspect.f90 index 8f3fd0e..0cc7eec 100644 --- a/src/Coefficients/EmisCoeff/MW_Water/MWwaterLUT/MWwaterLUT_Inspect/MWwaterLUT_Inspect.f90 +++ b/src/Coefficients/EmisCoeff/MW_Water/MWwaterLUT/MWwaterLUT_Inspect/MWwaterLUT_Inspect.f90 @@ -28,7 +28,7 @@ PROGRAM MWwaterLUT_Inspect ! Parameters ! ---------- CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'MWwaterLUT_Inspect' - CHARACTER(*), PARAMETER :: PROGRAM_VERSION_ID = & + !CHARACTER(*), PARAMETER :: PROGRAM_VERSION_ID = & ! --------- ! Variables diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/Makefile b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/Makefile new file mode 100644 index 0000000..c148f0f --- /dev/null +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/Makefile @@ -0,0 +1,61 @@ +#============================================================================== +# +# Makefile for SEcategory_BIN2NC program +# +#============================================================================== + +# Define macros +include $(CRTM_SOURCE_ROOT)/make.macros + +# This makefile +MAKE_FILE = Makefile + +# Executable file +EXE_FILE = SEcategory_BIN2NC +SCRIPT_FILE = run_$(EXE_FILE).sh + +# Source files to link +SRC_FILES = Type_Kinds.f90 \ + File_Utility.f90 \ + Message_Handler.f90 \ + Compare_Float_Numbers.f90 \ + Endian_Utility.f90 \ + Binary_File_Utility.f90 \ + String_Utility.f90 \ + Fundamental_Constants.f90 \ + SignalFile_Utility.f90 \ + SEcategory_Define.f90 \ + SEcategory_IO.f90 \ + SEcategory_netCDF_IO.f90 + +# Obj files used in link phase +OBJ_FILES = ${SRC_FILES:.f90=.o} \ + $(EXE_FILE).o + +# Include and library definitions +INCLUDES = -I$(NC4_DIR)/include \ + -I$(HDF_DIR)/include +LIBRARIES = -L$(NC4_DIR)/lib -lnetcdf -lnetcdff \ + -L$(HDF_DIR)/lib -lhdf5 + + +# Define common make targets (all, build, clean, install) +include $(CRTM_SOURCE_ROOT)/make.common_targets + +# Source link creation and removal +create_links:: + @$(LINK_SCRIPT) $(CRTM_SOURCE_ROOT) $(SRC_FILES) + +remove_links:: + @$(UNLINK_SCRIPT) $(SRC_FILES) + +# Script install target +install_script: + @$(COPY) $(SCRIPT_FILE) ${HOME}/bin + +# Source dependency lists +include make.dependencies + +# Define default rules +include $(CRTM_SOURCE_ROOT)/make.rules + diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/SEcategory_BIN2NC.f90 b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/SEcategory_BIN2NC.f90 new file mode 100644 index 0000000..129a60f --- /dev/null +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/SEcategory_BIN2NC.f90 @@ -0,0 +1,73 @@ +! +! SEcategory_BIN2NC +! +! Program to convert a CRTM SEcategory data file +! from Binary to netCDF format +! +! +! CREATION HISTORY: +! Written by: Cheng Dang, 02-12-2022 +! dangch@ucar.edu + +PROGRAM SEcategory_BIN2NC + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module usage + USE Message_Handler , ONLY: SUCCESS, FAILURE, Program_Message, Display_Message + USE SignalFile_Utility , ONLY: Create_SignalFile + USE SEcategory_Define , ONLY: SEcategory_type + USE SEcategory_IO , ONLY: SEcategory_Binary_to_netCDF + ! Disable implicit typing + IMPLICIT NONE + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'SEcategory_BIN2NC' + + ! --------- + ! Variables + ! --------- + INTEGER :: err_stat + CHARACTER(256) :: NC_Filename, BIN_Filename + + ! Program header + CALL Program_Message( PROGRAM_NAME, & + 'Program to convert a CRTM SEcategory data file '//& + 'from Binary to netCDF format.', & + '$Revision$') + ! Get the filenames + WRITE(*,FMT='(/5x,"Enter the INPUT Binary SEcategory filename : ")', ADVANCE='NO') + READ(*,'(a)') BIN_Filename + BIN_Filename = ADJUSTL(BIN_Filename) + WRITE(*,FMT='(/5x,"Enter the OUTPUT netCDF SEcategory filename: ")', ADVANCE='NO') + READ(*,'(a)') NC_Filename + NC_Filename = ADJUSTL(NC_Filename) + ! ...Sanity check that they're not the same + IF ( BIN_Filename == NC_Filename ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'SEcategory netCDF and Binary filenames are the same!', & + FAILURE ) + STOP + END IF + + ! Perform the conversion + err_stat = SEcategory_Binary_to_netCDF( BIN_Filename, NC_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'SEcategory Binary -> netCDF conversion failed!', & + FAILURE ) + STOP + END IF + + ! Create a signal file indicating success + err_stat = Create_SignalFile( NC_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'Error creating signal file for '//TRIM(NC_Filename), & + FAILURE ) + END IF + +END PROGRAM SEcategory_BIN2NC diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/make.dependencies b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/make.dependencies new file mode 100644 index 0000000..c23209f --- /dev/null +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_BIN2NC/make.dependencies @@ -0,0 +1,13 @@ +SEcategory_Define.o : SEcategory_Define.f90 File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o Binary_File_Utility.o +SEcategory_netCDF_IO.o : SEcategory_netCDF_IO.f90 SEcategory_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +SEcategory_IO.o : SEcategory_IO.f90 SEcategory_netCDF_IO.o SEcategory_Define.o File_Utility.o Message_Handler.o Type_Kinds.o +SEcategory_BIN2NC.o : SEcategory_BIN2NC.f90 SEcategory_IO.o SEcategory_Define.o SignalFile_Utility.o Message_Handler.o +Binary_File_Utility.o : Binary_File_Utility.f90 Endian_Utility.o Message_Handler.o File_Utility.o Type_Kinds.o +Compare_Float_Numbers.o : Compare_Float_Numbers.f90 Type_Kinds.o +Endian_Utility.o : Endian_Utility.f90 Type_Kinds.o +File_Utility.o : File_Utility.f90 +Fundamental_Constants.o : Fundamental_Constants.f90 Type_Kinds.o +Message_Handler.o : Message_Handler.f90 File_Utility.o +SignalFile_Utility.o : SignalFile_Utility.f90 Message_Handler.o File_Utility.o +String_Utility.o : String_Utility.f90 +Type_Kinds.o : Type_Kinds.f90 diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Define.f90 b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Define.f90 index c4f748c..e1a669e 100644 --- a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Define.f90 +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Define.f90 @@ -1634,20 +1634,20 @@ ELEMENTAL FUNCTION SEcategory_Equal( x, y ) RESULT( is_equal ) ! Check the object association status IF ( (.NOT. SEcategory_Associated(x)) .OR. & (.NOT. SEcategory_Associated(y)) ) RETURN - - ! Check contents + ! Check contents ! ...Release/version info IF ( (x%Release /= y%Release) .OR. & (x%Version /= y%Version) ) RETURN - ! ...Classification name + !...Classification name IF ( (x%Classification_Name /= y%Classification_Name) ) RETURN ! ...Dimensions IF ( (x%n_Frequencies /= y%n_Frequencies ) .OR. & (x%n_Surface_Types /= y%n_Surface_Types ) ) RETURN ! ...Arrays - IF ( ALL(x%Frequency .EqualTo. y%Frequency ) .AND. & - ALL(x%Surface_Type == y%Surface_Type ) .AND. & - ALL(x%Reflectance .EqualTo. y%Reflectance ) ) & + IF ( ALL(x%Frequency .EqualTo. y%Frequency ) .AND. & + ALL(x%Surface_Type == y%Surface_Type ) .AND. & + ALL(x%Surface_Type_IsValid .EQV. y%Surface_Type_IsValid ) .AND. & + ALL(x%Reflectance .EqualTo. y%Reflectance ) ) & is_equal = .TRUE. END FUNCTION SEcategory_Equal diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_IO.f90 b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_IO.f90 new file mode 100644 index 0000000..6cdd28c --- /dev/null +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_IO.f90 @@ -0,0 +1,739 @@ +! +! SEcategory_IO +! +! Container module for Binary and netCDF SEcategory I/O modules. +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 12-Feb-2022 +! dangch@ucar.edu + +MODULE SEcategory_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE SEcategory_Define , ONLY: SEcategory_type, & + OPERATOR(==), & + SEcategory_InquireFile , & + SEcategory_ReadFile , & + SEcategory_WriteFile + USE SEcategory_netCDF_IO , ONLY: SEcategory_netCDF_InquireFile , & + SEcategory_netCDF_ReadFile , & + SEcategory_netCDF_WriteFile + ! Disable implicit typing + IMPLICIT NONE + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + PUBLIC :: SEcategory_InquireFile_IO + PUBLIC :: SEcategory_ReadFile_IO + PUBLIC :: SEcategory_WriteFile_IO + PUBLIC :: SEcategory_netCDF_to_Binary + PUBLIC :: SEcategory_Binary_to_netCDF + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_InquireFile_IO +! +! PURPOSE: +! Function to inquire SEcategory object files. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_InquireFile_IO( & +! Filename, & +! netCDF = netCDF , & +! n_Frequencies = n_Frequencies , & +! n_Surface_Types = n_Surface_Types , & +! Release = Release , & +! Version = Version , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! SEcategory data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SEcategory datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! n_Frequencies: The number of frequencies in the LUT. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Surface_Types: The number of surface types in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Release: The release number of the SEcategory file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the SEcategory file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SEcategory_InquireFile_IO( & + Filename , & ! Input + netCDF , & ! Optional input + n_Frequencies , & ! Optional output + n_Surface_Types, & ! Optional output + Release , & ! Optional output + Version , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies + INTEGER , OPTIONAL, INTENT(OUT) :: n_Surface_Types + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + + ! Call the appropriate function + IF ( Binary ) THEN + err_stat = SEcategory_InquireFile( & + Filename , & + n_Frequencies = n_Frequencies , & + n_Surface_Types = n_Surface_Types, & + Release = Release , & + Version = Version ) + ELSE + err_stat = SEcategory_netCDF_InquireFile( & + Filename , & + n_Frequencies = n_Frequencies , & + n_Surface_Types = n_Surface_Types, & + Release = Release , & + Version = Version , & + Title = Title , & + History = History , & + Comment = Comment ) + END IF + + END FUNCTION SEcategory_InquireFile_IO + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_ReadFile_IO +! +! PURPOSE: +! Function to read SEcategory object files. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_ReadFile_IO( & +! SEcategory, & +! Filename, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! SEcategory data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! SEcategory: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(SEcategory_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SEcategory datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! Title: Character string written into the TITLE global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION SEcategory_ReadFile_IO( & + SEcategory, & ! Output + Filename , & ! Input + netCDF , & ! Optional input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment , & ! Optional output + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(SEcategory_type), INTENT(OUT) :: SEcategory + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: No_Close + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + !Call the appropriate function + IF ( Binary ) THEN + err_stat = SEcategory_ReadFile( & + SEcategory, & + Filename , & + No_Close , & + Quiet ) + ELSE + err_stat = SEcategory_netCDF_ReadFile( & + SEcategory, & + Filename , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + END IF + + END FUNCTION SEcategory_ReadFile_IO + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_WriteFile_IO +! +! PURPOSE: +! Function to write SEcategory object files. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_WriteFile_IO( & +! SEcategory, & +! Filename, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! SEcategory data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SEcategory: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(SEcategory_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SEcategory datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! No_Close: Set this logical argument to *NOT* close the datafile +! upon exiting this routine. This option is required if +! the SEcategory data is embedded within another file. +! If == .FALSE., File is closed upon function exit [DEFAULT]. +! == .TRUE., File is NOT closed upon function exit +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION SEcategory_WriteFile_IO( & + SEcategory, & ! Input + Filename , & ! Input + netCDF , & ! Optional input + No_Close , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment , & ! Optional input + Debug ) & ! Optional input (Debug output control) + RESULT ( err_stat ) + ! Arguments + TYPE(SEcategory_type), INTENT(IN) :: SEcategory + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: No_Close + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Local variables + LOGICAL :: Binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + Binary = .TRUE. + IF ( PRESENT(netCDF) ) Binary = .NOT. netCDF + + ! Call the appropriate function + IF ( Binary ) THEN + err_stat = SEcategory_WriteFile( & + SEcategory, & + Filename , & + No_Close , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + ELSE + err_stat = SEcategory_netCDF_WriteFile( & + SEcategory, & + Filename , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) + END IF + + END FUNCTION SEcategory_WriteFile_IO + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_netCDF_to_Binary +! +! PURPOSE: +! Function to convert a netCDF SEcategory file to Binary format. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_netCDF_to_Binary( & +! NC_Filename , & +! BIN_Filename , & +! Quiet = Quiet ) +! +! INPUTS: +! NC_Filename: Character string specifying the name of the +! netCDF format SEcategory data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! BIN_Filename: Character string specifying the name of the +! Binary format SEcategory data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the file conversion was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! - If the output file already exists, it is overwritten. +! - If an error occurs, the output file is deleted before +! returning to the calling routine. +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SEcategory_netCDF_to_Binary( & + NC_Filename , & ! Input + BIN_Filename, & ! Input + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + CHARACTER(*), INTENT(IN) :: BIN_Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_netCDF_to_Binary' + ! Function variables + CHARACTER(256) :: msg + TYPE(SEcategory_type) :: cc, cc_copy + + ! Set up + err_stat = SUCCESS + + ! Read the netCDF file + err_stat = SEcategory_ReadFile_IO(cc, NC_Filename, Quiet = Quiet, netCDF = .TRUE. ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(NC_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Write the Binary file + err_stat = SEcategory_WriteFile_IO(cc, BIN_Filename, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing Binary file '//TRIM(BIN_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Check the write was successful + ! ...Read the Binary file + err_stat = SEcategory_ReadFile_IO(cc_copy, BIN_Filename, Quiet = Quiet) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary file '//TRIM(BIN_Filename)//' for test' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! ...Compare the SEcategory objects + IF ( .NOT. (cc == cc_copy) ) THEN + msg = 'SEcategory object comparison failed.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + END FUNCTION SEcategory_netCDF_to_Binary + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_Binary_to_netCDF +! +! PURPOSE: +! Function to convert a binary SEcategory file to Binary format. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_Binary_to_netCDF( & +! BIN_Filename , & +! NC_Filename , & +! Quiet = Quiet ) +! +! INPUTS: +! BIN_Filename: Character string specifying the name of the +! Binary format SEcategory data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! NC_Filename: Character string specifying the name of the +! netCDF format SEcategory data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the file conversion was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! - If the output file already exists, it is overwritten. +! - If an error occurs, the output file is deleted before +! returning to the calling routine. +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION SEcategory_Binary_to_netCDF( & + BIN_Filename, & ! Input + NC_Filename , & ! Input + Quiet ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: BIN_Filename + CHARACTER(*), INTENT(IN) :: NC_Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_Binary_to_NetCDF' + ! Function variables + CHARACTER(256) :: msg + TYPE(SEcategory_type) :: cc, cc_copy + + ! Set up + err_stat = SUCCESS + + ! Read the Binary file + err_stat = SEcategory_ReadFile_IO(cc, BIN_Filename, Quiet = Quiet) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary file '//TRIM(BIN_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Write the netCDF file + err_stat = SEcategory_WriteFile_IO(cc, NC_Filename, Quiet = Quiet, netCDF = .TRUE.) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing netCDF file '//TRIM(NC_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Check the write was successful + ! ...Read the netCDF file + err_stat = SEcategory_ReadFile_IO(cc_copy, NC_Filename, Quiet = Quiet, netCDF = .TRUE.) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(NC_Filename)//' for test' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! ...Compare the SEcategory objects + IF ( .NOT. (cc == cc_copy) ) THEN + msg = 'SEcategory object comparison failed.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + END FUNCTION SEcategory_Binary_to_netCDF + +END MODULE SEcategory_IO diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Inspect/SEcategory_Inspect.f90 b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Inspect/SEcategory_Inspect.f90 index 43ab00d..e19d70e 100644 --- a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Inspect/SEcategory_Inspect.f90 +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_Inspect/SEcategory_Inspect.f90 @@ -28,7 +28,7 @@ PROGRAM SEcategory_Inspect ! Parameters ! ---------- CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'SEcategory_Inspect' - CHARACTER(*), PARAMETER :: PROGRAM_RCS_ID = & + !CHARACTER(*), PARAMETER :: PROGRAM_RCS_ID = & ! --------- ! Variables diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_NC2BIN/SEcategory_NC2BIN.f90 b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_NC2BIN/SEcategory_NC2BIN.f90 new file mode 100644 index 0000000..e0889fe --- /dev/null +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_NC2BIN/SEcategory_NC2BIN.f90 @@ -0,0 +1,73 @@ +! +! SEcategory_NC2BIN +! +! Program to convert a CRTM SEcategory data file +! from netCDF to Binary format +! +! +! CREATION HISTORY: +! Written by: Cheng Dang, 12-Feb-2022 +! dangch@ucar.edu + +PROGRAM SEcategory_NC2BIN + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module usage + USE Message_Handler , ONLY: SUCCESS, FAILURE, Program_Message, Display_Message + USE SignalFile_Utility , ONLY: Create_SignalFile + USE SEcategory_Define , ONLY: SEcategory_type + USE SEcategory_IO , ONLY: SEcategory_netCDF_to_Binary + ! Disable implicit typing + IMPLICIT NONE + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'SEcategory_NC2BIN' + + ! --------- + ! Variables + ! --------- + INTEGER :: err_stat + CHARACTER(256) :: NC_Filename, BIN_Filename + + ! Program header + CALL Program_Message( PROGRAM_NAME, & + 'Program to convert a CRTM SEcategory data file '//& + 'from netCDF to Binary format.', & + '$Revision$') + ! Get the filenames + WRITE(*,FMT='(/5x,"Enter the INPUT netCDF SEcategory filename : ")', ADVANCE='NO') + READ(*,'(a)') NC_Filename + NC_Filename = ADJUSTL(NC_Filename) + WRITE(*,FMT='(/5x,"Enter the OUTPUT Binary SEcategory filename: ")', ADVANCE='NO') + READ(*,'(a)') BIN_Filename + BIN_Filename = ADJUSTL(BIN_Filename) + ! ...Sanity check that they're not the same + IF ( BIN_Filename == NC_Filename ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'SEcategory netCDF and Binary filenames are the same!', & + FAILURE ) + STOP + END IF + + ! Perform the conversion + err_stat = SEcategory_netCDF_to_Binary( NC_Filename, BIN_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'SEcategory netCDF -> Binary conversion failed!', & + FAILURE ) + STOP + END IF + + ! Create a signal file indicating success + err_stat = Create_SignalFile( BIN_Filename ) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( PROGRAM_NAME, & + 'Error creating signal file for '//TRIM(BIN_Filename), & + FAILURE ) + END IF + +END PROGRAM SEcategory_NC2BIN diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_NC2BIN/make.dependencies b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_NC2BIN/make.dependencies new file mode 100644 index 0000000..8a084a9 --- /dev/null +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_NC2BIN/make.dependencies @@ -0,0 +1,15 @@ +SEcategory_Define.o : SEcategory_Define.f90 File_Utility.o Compare_Float_Numbers.o Message_Handler.o Type_Kinds.o Binary_File_Utility.o +SEcategory_netCDF_IO.o : SEcategory_netCDF_IO.f90 SEcategory_Define.o String_Utility.o File_Utility.o Message_Handler.o Type_Kinds.o +SEcategory_IO.o : SEcategory_IO.f90 SEcategory_netCDF_IO.o SEcategory_Define.o File_Utility.o Message_Handler.o Type_Kinds.o +SEcategory_NC2BIN.o : SEcategory_NC2BIN.f90 SEcategory_IO.o SEcategory_Define.o SignalFile_Utility.o Message_Handler.o +SEcategory_BIN2NC.o : SEcategory_BIN2NC.f90 SEcategory_IO.o SEcategory_Define.o SignalFile_Utility.o Message_Handler.o +Binary_File_Utility.o : Binary_File_Utility.f90 Endian_Utility.o Message_Handler.o File_Utility.o Type_Kinds.o +Compare_Float_Numbers.o : Compare_Float_Numbers.f90 Type_Kinds.o +Endian_Utility.o : Endian_Utility.f90 Type_Kinds.o +File_Utility.o : File_Utility.f90 +Fundamental_Constants.o : Fundamental_Constants.f90 Type_Kinds.o +Message_Handler.o : Message_Handler.f90 File_Utility.o +SignalFile_Utility.o : SignalFile_Utility.f90 Message_Handler.o File_Utility.o +Fundamental_Constants.o Type_Kinds.o +String_Utility.o : String_Utility.f90 +Type_Kinds.o : Type_Kinds.f90 diff --git a/src/Coefficients/EmisCoeff/SEcategory/SEcategory_netCDF_IO.f90 b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_netCDF_IO.f90 new file mode 100644 index 0000000..76971f2 --- /dev/null +++ b/src/Coefficients/EmisCoeff/SEcategory/SEcategory_netCDF_IO.f90 @@ -0,0 +1,1306 @@ +! +! SEcategory_netCDF_IO +! +! Module containing routines to read and write SEcategory netCDF +! format files. +! +! +! CREATION HISTORY: +! +! Written by: Cheng Dang, 12-Feb-2022 +! dangch@ucar.edu + +MODULE SEcategory_netCDF_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp, Double, Long + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE String_Utility , ONLY: StrClean + USE SEcategory_Define , ONLY: SEcategory_type , & + SEcategory_Associated , & + SEcategory_Destroy , & + SEcategory_Create , & + SEcategory_Inspect , & + SEcategory_ValidRelease , & + SEcategory_Info , & + SEcategory_Name , & + SEcategory_Index + USE netcdf + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Procedures + PUBLIC :: SEcategory_netCDF_InquireFile + PUBLIC :: SEcategory_netCDF_ReadFile + PUBLIC :: SEcategory_netCDF_WriteFile + + ! ----------------- + ! Module parameters + ! ----------------- + ! Default msg string length + INTEGER, PARAMETER :: ML = 1024 + ! Literal constants + REAL(fp), PARAMETER :: FILL_FLOAT = -999.0_fp + INTEGER , PARAMETER :: INT_ZERO = 0 + INTEGER , PARAMETER :: INT_ONE = 1 + + ! Global attribute names. Case sensitive + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + CHARACTER(*), PARAMETER :: VERSION_GATTNAME = 'Version' + CHARACTER(*), PARAMETER :: DATA_SOURCE_GATTNAME = 'Data_Source' + CHARACTER(*), PARAMETER :: TITLE_GATTNAME = 'Title' + CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'History' + CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'Comment' + CHARACTER(*), PARAMETER :: DATATYPE_NAME_GATTNAME = 'Datatype_Name' + CHARACTER(*), PARAMETER :: CLASSIFICATION_NAME_GATTNAME = 'Classification_Name' + + + ! Dimension names + CHARACTER(*), PARAMETER :: TNSL_DIMNAME = 'String_Length' + CHARACTER(*), PARAMETER :: FREQUENCY_DIMNAME = 'n_Frequencies' + CHARACTER(*), PARAMETER :: TYPE_DIMNAME = 'n_Surface_Types' + + ! Variable names + CHARACTER(*), PARAMETER :: REFLECTANCE_VARNAME = 'Reflectance' + CHARACTER(*), PARAMETER :: FREQUENCY_VARNAME = 'Frequency' + CHARACTER(*), PARAMETER :: TYPE_VARNAME = 'Surface_Type' + CHARACTER(*), PARAMETER :: TYPE_ISVALID_VARNAME = 'Surface_Type_IsValid' + + ! Variable long name attribute. + CHARACTER(*), PARAMETER :: LONGNAME_ATTNAME = 'long_name' + CHARACTER(*), PARAMETER :: REFLECTANCE_LONGNAME = 'Reflectance' + CHARACTER(*), PARAMETER :: FREQUENCY_LONGNAME = 'Frequency' + CHARACTER(*), PARAMETER :: TYPE_LONGNAME = 'Surface Type' + CHARACTER(*), PARAMETER :: TYPE_ISVALID_LONGNAME = 'Surface Type IsValid' + + ! Variable description attribute. + CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' + CHARACTER(*), PARAMETER :: REFLECTANCE_DESCRIPTION = 'Reflectance' + CHARACTER(*), PARAMETER :: FREQUENCY_DESCRIPTION = 'Frequency' + CHARACTER(*), PARAMETER :: TYPE_DESCRIPTION = 'Surface Type' + CHARACTER(*), PARAMETER :: TYPE_ISVALID_DESCRIPTION = 'Surface Type IsValid' + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + CHARACTER(*), PARAMETER :: REFLECTANCE_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: FREQUENCY_UNITS = 'cm^-1' + CHARACTER(*), PARAMETER :: TYPE_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: TYPE_ISVALID_UNITS = 'N/A' + + ! Variable _FillValue attribute. + CHARACTER(*), PARAMETER :: FILLVALUE_ATTNAME = '_FillValue' + REAL(Double), PARAMETER :: REFLECTANCE_FILLVALUE = FILL_FLOAT + REAL(Double), PARAMETER :: FREQUENCY_FILLVALUE = FILL_FLOAT + CHARACTER(*), PARAMETER :: TYPE_FILLVALUE = NF90_FILL_CHAR + INTEGER , PARAMETER :: TYPE_ISVALID_FILLVALUE = INT_ZERO + + ! Variable types + INTEGER, PARAMETER :: REFLECTANCE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: FREQUENCY_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: TYPE_TYPE = NF90_CHAR + INTEGER, PARAMETER :: TYPE_ISVALID_TYPE = NF90_INT + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_netCDF_InquireFile +! +! PURPOSE: +! Function to inquire SEcategory object files. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_netCDF_InquireFile( & +! Filename, & +! netCDF = netCDF , & +! n_Frequencies = n_Frequencies , & +! n_Surface_Types = n_Surface_Types , & +! Release = Release , & +! Version = Version , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! SEcategory data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SEcategory datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! n_Frequencies: The number of frequencies in the LUT. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Surface_Types: The number of surface types in +! the LUT. Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Release: The release number of the SEcategory file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the SEcategory file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION SEcategory_netCDF_InquireFile( & + Filename , & ! Input + n_Frequencies , & ! Optional output + n_Surface_Types , & ! Optional output + Release , & ! Optional output + Version , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Frequencies + INTEGER , OPTIONAL, INTENT(OUT) :: n_Surface_Types + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_netCDF_InquireFile' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: DimId + TYPE(SEcategory_type) :: SEcategory + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + + ! Open the file + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Get the dimensions + ! ...n_Frequencies dimension + NF90_Status = NF90_INQ_DIMID( FileId,FREQUENCY_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//FREQUENCY_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=SEcategory%n_Frequencies ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//FREQUENCY_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Surface_Types dimension + NF90_Status = NF90_INQ_DIMID( FileId,TYPE_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//TYPE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=SEcategory%n_Surface_Types ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//TYPE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Get the global attributes + err_stat = ReadGAtts( Filename, & + FileId , & + Release = SEcategory%Release, & + Version = SEcategory%Version, & + Title = Title , & + History = History, & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes from '//TRIM(Filename) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing input file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + ! Set the return values + IF ( PRESENT(n_Frequencies ) ) n_Frequencies = SEcategory%n_Frequencies + IF ( PRESENT(n_Surface_Types ) ) n_Surface_Types = SEcategory%n_Surface_Types + IF ( PRESENT(Release ) ) Release = SEcategory%Release + IF ( PRESENT(Version ) ) Version = SEcategory%Version + + CONTAINS + + SUBROUTINE Inquire_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup.' + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION SEcategory_netCDF_InquireFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_netCDF_WriteFile +! +! PURPOSE: +! Function to write SEcategory object files. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_netCDF_WriteFile( & +! SEcategory, & +! Filename, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! SEcategory: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(SEcategory_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Filename: Character string specifying the name of the +! SEcategory data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SEcategory datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! No_Close: Set this logical argument to *NOT* close the datafile +! upon exiting this routine. This option is required if +! the SEcategory data is embedded within another file. +! If == .FALSE., File is closed upon function exit [DEFAULT]. +! == .TRUE., File is NOT closed upon function exit +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS the data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION SEcategory_netCDF_WriteFile( & + SEcategory, & + Filename , & + Quiet , & + Title , & + History , & + Comment , & + Debug ) & + RESULT( err_stat ) + ! Arguments + TYPE(SEcategory_type), INTENT(IN) :: SEcategory + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_netCDF_WriteFile' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + LOGICAL :: Noisy + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: VarId + INTEGER :: i + INTEGER :: AllocateStatus + INTEGER, ALLOCATABLE :: INT_Surface_Type_IsValid(:) + + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check structure pointer association status + IF ( .NOT. SEcategory_Associated( SEcategory ) ) THEN + msg = 'SEcategory structure is empty. Nothing to do!' + CALL Write_CleanUp(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. SEcategory_ValidRelease( SEcategory ) ) THEN + msg = 'SEcategory Release check failed.' + CALL Write_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + Noisy = .TRUE. + IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet + + ! Create the output file + err_stat = CreateFile( & + Filename , & ! Input + SEcategory%n_Frequencies , & ! Input + SEcategory%n_Surface_Types , & ! Input + FileId , & ! Output + Version = SEcategory%Version , & ! Optional input + Classification_Name = SEcategory%Classification_Name , & ! Optional input, required for IR land + Title = Title , & ! Optional input + History = History , & ! Optional input + Comment = Comment ) ! Optional input + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error creating output file '//TRIM(Filename) + CALL Write_Cleanup(); RETURN + END IF + + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Write the data items + ! ...Surface Type variable + NF90_Status = NF90_INQ_VARID( FileId,TYPE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TYPE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,SEcategory%Surface_Type ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//TYPE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_INQ_VARID( FileId,FREQUENCY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,SEcategory%Frequency ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Reflectance variable + NF90_Status = NF90_INQ_VARID( FileId,REFLECTANCE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//REFLECTANCE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,SEcategory%Reflectance ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//REFLECTANCE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + !...Surface Type IsValid variable + !...Convert LOGICAL variable to INTEGER for netCDF I/O + ALLOCATE(INT_Surface_Type_IsValid(SEcategory%n_Surface_Types)) + DO i = 1, SEcategory%n_Surface_Types + IF (SEcategory%Surface_Type_IsValid(i)) THEN + INT_Surface_Type_IsValid(i) = INT_ONE + ELSE + INT_Surface_Type_IsValid(i) = INT_ZERO + END IF + END DO + NF90_Status = NF90_INQ_VARID( FileId,TYPE_ISVALID_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TYPE_ISVALID_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarId,INT_Surface_Type_IsValid ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//TYPE_ISVALID_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + DEALLOCATE(INT_Surface_Type_IsValid) + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ) + Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( Noisy ) THEN + CALL SEcategory_Info( SEcategory, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing output file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION SEcategory_netCDF_WriteFile + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SEcategory_netCDF_ReadFile +! +! PURPOSE: +! Function to read SEcategory object files. +! +! CALLING SEQUENCE: +! Error_Status = SEcategory_netCDF_ReadFile( & +! SEcategory, & +! Filename, & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! SEcategory data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! SEcategory: Object containing the IRwater coefficient data. +! UNITS: N/A +! TYPE: TYPE(SEcategory_type) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUTS: +! Quiet: Set this logical argument to suppress INFORMATION +! messages being printed to stdout +! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. +! == .TRUE., INFORMATION messages are SUPPRESSED. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! Title: Character string written into the TITLE global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SEcategory file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! FUNCTION RESULT: +! Error_Status: The return value is an integer defining the error status. +! The error codes are defined in the Message_Handler module. +! If == SUCCESS, the file inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + FUNCTION SEcategory_netCDF_ReadFile( & + SEcategory , & ! Output + Filename , & ! Input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment , & ! Optional output + Debug ) & ! Optional input (Debug output control) + RESULT( err_stat ) + ! Arguments + TYPE(SEcategory_type), INTENT(OUT) :: SEcategory + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + LOGICAL, OPTIONAL, INTENT(IN) :: Debug + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_netCDF_ReadFile' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + LOGICAL :: Noisy + INTEGER :: NF90_Status + INTEGER :: FileId + INTEGER :: n_Frequencies + INTEGER :: n_Surface_Types + INTEGER :: VarId + INTEGER :: AllocateStatus + INTEGER :: i + INTEGER, ALLOCATABLE :: INT_Surface_Type_IsValid(:) + + ! Set up + err_stat = SUCCESS + Close_File = .FALSE. + ! ...Check that the file exists + IF ( .NOT. File_Exists(Filename) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + Noisy = .TRUE. + IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet + + ! Inquire the file to get the dimensions + err_stat = SEcategory_netCDF_InquireFile( & + Filename , & + n_Frequencies = n_Frequencies , & + n_Surface_Types = n_Surface_Types ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error obtaining SEcategory dimensions from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + + ! Allocate the output structure + CALL SEcategory_Create( & + SEcategory , & + n_Frequencies , & + n_Surface_Types ) + IF ( .NOT. SEcategory_Associated( SEcategory ) ) THEN + msg = 'SEcategory object allocation failed.' + CALL Read_Cleanup(); RETURN + END IF + + + ! Open the file for reading + NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '//& + TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Read the global attributes + err_stat = ReadGAtts( Filename, & + FileID , & + Release = SEcategory%Release , & + Version = SEcategory%Version , & + Classification_Name = SEcategory%Classification_Name, & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attribute from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. SEcategory_ValidRelease( SEcategory ) ) THEN + msg = 'SEcategory Release check failed.' + CALL Read_Cleanup(); RETURN + END IF + + ! Read the SEcategory data + ! ...Surface Type variable + NF90_Status = NF90_INQ_VARID( FileId,TYPE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TYPE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,SEcategory%Surface_Type ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//TYPE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_INQ_VARID( FileId,FREQUENCY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,SEcategory%Frequency ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//FREQUENCY_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Reflectance variable + NF90_Status = NF90_INQ_VARID( FileId,REFLECTANCE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//REFLECTANCE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,SEcategory%Reflectance ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//REFLECTANCE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + !...Surface Type IsValid variable + ALLOCATE(INT_Surface_Type_IsValid(SEcategory%n_Surface_Types)) + NF90_Status = NF90_INQ_VARID( FileId,TYPE_ISVALID_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//TYPE_ISVALID_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + NF90_Status = NF90_GET_VAR( FileId,VarId,INT_Surface_Type_IsValid ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading '//TYPE_ISVALID_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + !...Convert INTEGER to LOGICAL variable to INTEGER for SEcategory + DO i = 1, SEcategory%n_Surface_Types + IF (INT_Surface_Type_IsValid(i) == INT_ONE ) THEN + SEcategory%Surface_Type_IsValid(i) = .TRUE. + ELSE + SEcategory%Surface_Type_IsValid(i) = .FALSE. + END IF + END DO + DEALLOCATE(INT_Surface_Type_IsValid) + + ! Close the file + NF90_Status = NF90_CLOSE( FileId ); Close_File = .FALSE. + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Read_Cleanup(); RETURN + END IF + + ! Output an info message + IF ( Noisy ) THEN + CALL SEcategory_Info( SEcategory, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup- '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + CALL SEcategory_Destroy( SEcategory ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION SEcategory_netCDF_ReadFile + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + + ! Function to write the global attributes to a SEcategory data file. + + FUNCTION WriteGAtts( & + Filename , & ! Input + FileId , & ! Input + Version , & ! Optional input + Classification_Name , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_WriteGAtts(netCDF)' + CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME = 'write_module_history' + CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: GAttName + CHARACTER(8) :: cdate + CHARACTER(10) :: ctime + CHARACTER(5) :: czone + CHARACTER(ML) :: CLSname + INTEGER :: Ver + INTEGER :: NF90_Status + TYPE(SEcategory_type) :: SEcategory + + ! Set up + err_stat = SUCCESS + msg = ' ' + + ! Mandatory global attributes + ! ...Software ID + !GAttName = WRITE_MODULE_HISTORY_GATTNAME + !NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),MODULE_VERSION_ID ) + !IF ( NF90_Status /= NF90_NOERR ) THEN + ! CALL WriteGAtts_Cleanup(); RETURN + !END IF + ! ...Creation date + CALL DATE_AND_TIME( cdate, ctime, czone ) + GAttName = CREATION_DATE_AND_TIME_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName), & + cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// & + ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// & + czone//'UTC' ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Release + GAttName = RELEASE_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),SEcategory%Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + + ! Optional global attributes + ! ...The Version + IF ( PRESENT(Version) ) THEN + Ver = Version + ELSE + Ver = SEcategory%Version + END IF + GAttName = VERSION_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),Ver ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Classification_Name, required for IR land + IF ( PRESENT(Classification_Name) ) THEN + CLSname = Classification_Name + ELSE + CLSname = SEcategory%Classification_Name + END IF + GAttName = CLASSIFICATION_NAME_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),CLSname ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + GAttName = TITLE_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),title ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + GAttName = HISTORY_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),history ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + GAttName = COMMENT_GATTNAME + NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),comment ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + + CONTAINS + + SUBROUTINE WriteGAtts_CleanUp() + NF90_Status = NF90_CLOSE( FileId ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = '; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status ) ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TRIM(GAttName)//' attribute to '//& + TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( NF90_Status ) )//TRIM(msg), & + err_stat ) + END SUBROUTINE WriteGAtts_CleanUp + + END FUNCTION WriteGAtts + + ! Function to read the global attributes from a SEcategory data file. + + FUNCTION ReadGAtts(& + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional output + Version , & ! Optional output + Classification_Name , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_ReadGAtts(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(256) :: GAttName + CHARACTER(5000) :: GAttString + INTEGER :: NF90_Status + + ! Set up + err_stat = SUCCESS + + ! The global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + GAttName = RELEASE_GATTNAME + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Release ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Version + IF ( PRESENT(Version) ) THEN + GAttName = VERSION_GATTNAME + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Version ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Classification Name + IF ( PRESENT(Classification_Name) ) THEN + GAttName = CLASSIFICATION_NAME_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + Classification_Name = GAttString(1:MIN(LEN(Classification_Name), LEN_TRIM(GAttString))) + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + GAttName = TITLE_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + title = GAttString(1:MIN(LEN(title), LEN_TRIM(GAttString))) + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + GAttName = HISTORY_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + history = GAttString(1:MIN(LEN(history), LEN_TRIM(GAttString))) + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + GAttName = COMMENT_GATTNAME; GAttString = '' + NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString ) + IF ( NF90_Status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( GAttString ) + comment = GAttString(1:MIN(LEN(comment), LEN_TRIM(GAttString))) + END IF + + CONTAINS + + SUBROUTINE ReadGAtts_CleanUp() + err_stat = FAILURE + msg = 'Error reading '//TRIM(GAttName)//' attribute from '//TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( NF90_Status ) ) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE ReadGAtts_CleanUp + + END FUNCTION ReadGAtts + + FUNCTION CreateFile( & + Filename , & ! Input + n_Frequencies , & ! Input + n_Surface_Types , & ! Input + FileId , & ! Output + Version , & ! Optional input + Classification_Name , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: n_Frequencies + INTEGER , INTENT(IN) :: n_Surface_Types + INTEGER , INTENT(OUT) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Classification_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SEcategory_CreateFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: Close_File + INTEGER :: NF90_Status + INTEGER :: n_Frequencies_DimID + INTEGER :: n_Surface_Types_DimID + INTEGER :: tnsl_DimID + INTEGER :: varID + INTEGER :: Put_Status(4) + TYPE(SEcategory_type) :: dummy + + ! Setup + err_stat = SUCCESS + Close_File = .FALSE. + + ! Create the data file + NF90_Status = NF90_CREATE( Filename,NF90_CLOBBER,FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + Close_File = .TRUE. + + ! Define the dimensions + ! ...Number of frequencies + NF90_Status = NF90_DEF_DIM( FileID,FREQUENCY_DIMNAME,n_Frequencies,n_Frequencies_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//FREQUENCY_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of surface types + NF90_Status = NF90_DEF_DIM( FileID,TYPE_DIMNAME,n_Surface_Types,n_Surface_Types_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TYPE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Type_Name string length + CALL SEcategory_Create(dummy,0,1) ! Only n_Types dimension non-zero + NF90_Status = NF90_DEF_DIM( FileID,TNSL_DIMNAME,LEN(dummy%Surface_Type(1)),tnsl_DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TNSL_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + CALL SEcategory_Destroy(dummy) + + ! Write the global attributes + err_stat = WriteGAtts( Filename , & + FileId , & + Version = Version , & + Classification_Name = Classification_Name , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing global attribute to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + ! Define the variables + ! ...Surface Type variable + NF90_Status = NF90_DEF_VAR( FileID, & + TYPE_VARNAME, & + TYPE_TYPE, & + dimIDs=(/tnsl_DimID, n_Surface_Types_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TYPE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,TYPE_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,TYPE_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,TYPE_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,TYPE_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//TYPE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + !...Surface Type IsValid variable + NF90_Status = NF90_DEF_VAR( FileID, & + TYPE_ISVALID_VARNAME, & + TYPE_ISVALID_TYPE, & + dimIDs=(/n_Surface_Types_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//TYPE_ISVALID_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,TYPE_ISVALID_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,TYPE_ISVALID_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,TYPE_ISVALID_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,TYPE_ISVALID_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//TYPE_ISVALID_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_DEF_VAR( FileID, & + FREQUENCY_VARNAME, & + FREQUENCY_TYPE, & + dimIDs=(/n_Frequencies_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//FREQUENCY_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,FREQUENCY_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,FREQUENCY_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,FREQUENCY_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,FREQUENCY_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Reflectance variable + NF90_Status = NF90_DEF_VAR( FileID, & + REFLECTANCE_VARNAME, & + REFLECTANCE_TYPE, & + dimIDs=(/n_Frequencies_DimID, n_Surface_Types_DimID/), & + varID=VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error defining '//REFLECTANCE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME ,REFLECTANCE_LONGNAME ) + Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,REFLECTANCE_DESCRIPTION ) + Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME ,REFLECTANCE_UNITS ) + Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME ,REFLECTANCE_FILLVALUE ) + IF ( ANY(Put_Status /= NF90_NOERR) ) THEN + msg = 'Error writing '//REFLECTANCE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + ! Take netCDF file out of define mode + NF90_Status = NF90_ENDDEF( FileId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error taking file '//TRIM(Filename)// & + ' out of define mode - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Create_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE Create_CleanUp() + IF ( Close_File ) THEN + NF90_Status = NF90_CLOSE( FileID ) + IF ( NF90_Status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( NF90_Status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Create_CleanUp + + END FUNCTION CreateFile + +END MODULE SEcategory_netCDF_IO diff --git a/src/SfcOptics/CRTM_IR_Snow_SfcOptics.f90 b/src/SfcOptics/CRTM_IR_Snow_SfcOptics.f90 index a93d9bb..8665d5c 100644 --- a/src/SfcOptics/CRTM_IR_Snow_SfcOptics.f90 +++ b/src/SfcOptics/CRTM_IR_Snow_SfcOptics.f90 @@ -1,8 +1,8 @@ ! ! CRTM_IR_Snow_SfcOptics ! -! Module to compute the surface optical properties for ICE surfaces at -! infrared frequencies required for determining the ICE surface +! Module to compute the surface optical properties for snow surfaces at +! infrared frequencies required for determining the snow surface ! contribution to the radiative transfer. ! ! This module is provided to allow developers to "wrap" their existing @@ -14,6 +14,9 @@ ! Written by: Paul van Delst, 23-Jun-2005 ! paul.vandelst@noaa.gov ! +! Modified by: Cheng Dang, 31-May-2022 +! dangch@ucar.edu +! MODULE CRTM_IR_Snow_SfcOptics @@ -31,7 +34,14 @@ MODULE CRTM_IR_Snow_SfcOptics USE CRTM_SfcOptics_Define , ONLY: CRTM_SfcOptics_type USE CRTM_SEcategory , ONLY: SEVar_type => iVar_type, & SEcategory_Emissivity - USE CRTM_IRsnowCoeff , ONLY: IRsnowC + USE CRTM_IRsnowCoeff , ONLY: CRTM_IRsnowCoeff_IsLoaded, & + CRTM_IRsnowCoeff_SE_IsLoaded, & + IRsnowC, & + IRsnowC_SE + USE CRTM_IRSnowEM , ONLY: IRsnowVar_type => iVar_type, & + CRTM_Compute_IRSnowEM, & + CRTM_Compute_IRSnowEM_TL, & + CRTM_Compute_IRSnowEM_AD ! Disable implicit typing IMPLICIT NONE @@ -42,7 +52,7 @@ MODULE CRTM_IR_Snow_SfcOptics ! Everything private by default PRIVATE ! Data types - PUBLIC :: iVar_type + PUBLIC :: iVar_SE_type, iVar_type ! Science routines PUBLIC :: Compute_IR_Snow_SfcOptics PUBLIC :: Compute_IR_Snow_SfcOptics_TL @@ -60,12 +70,18 @@ MODULE CRTM_IR_Snow_SfcOptics ! Structure definition to hold forward ! variables across FWD, TL, and AD calls ! -------------------------------------- - TYPE :: iVar_type + TYPE :: iVar_SE_type PRIVATE TYPE(SEVar_type) :: sevar + END TYPE iVar_SE_type + + TYPE :: iVar_type + PRIVATE + TYPE(IRsnowVar_type) :: irsnowvar END TYPE iVar_type + CONTAINS @@ -155,6 +171,7 @@ FUNCTION Compute_IR_Snow_SfcOptics( & SensorIndex , & ! Input ChannelIndex, & ! Input SfcOptics , & ! Output + iVar_SE , & ! Internal variable output iVar ) & ! Internal variable output RESULT( err_stat ) ! Arguments @@ -162,6 +179,7 @@ FUNCTION Compute_IR_Snow_SfcOptics( & INTEGER, INTENT(IN) :: SensorIndex INTEGER, INTENT(IN) :: ChannelIndex TYPE(CRTM_SfcOptics_type), INTENT(IN OUT) :: SfcOptics + TYPE(iVar_SE_type), INTENT(IN OUT) :: iVar_SE TYPE(iVar_type), INTENT(IN OUT) :: iVar ! Function result INTEGER :: err_stat @@ -169,36 +187,65 @@ FUNCTION Compute_IR_Snow_SfcOptics( & CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Compute_IR_Snow_SfcOptics' ! Local variables CHARACTER(ML) :: msg - INTEGER :: j + INTEGER :: j, nZ REAL(fp) :: frequency, emissivity + LOGICAL :: isSEcategory, isIRsnowC ! Set up - err_stat = SUCCESS - frequency = SC(SensorIndex)%Wavenumber(ChannelIndex) + err_stat = SUCCESS + ! ...Retrieve frequency data from structures + frequency = SC(SensorIndex)%Wavenumber(ChannelIndex) + ! ...Short name for angle dimensions + nZ = SfcOptics%n_Angles + isSEcategory = CRTM_IRsnowCoeff_SE_IsLoaded() + isIRsnowC = CRTM_IRsnowCoeff_IsLoaded() ! Compute Lambertian surface emissivity - err_stat = SEcategory_Emissivity( & - IRsnowC , & ! Input - frequency , & ! Input - Surface%Snow_Type, & ! Input - emissivity , & ! Output - iVar%sevar ) ! Internal variable output - IF ( err_stat /= SUCCESS ) THEN - msg = 'Error occurred in SEcategory_Emissivity()' - CALL Display_Message( ROUTINE_NAME, msg, err_stat ); RETURN - END IF + IF ( isSEcategory ) THEN + err_stat = SEcategory_Emissivity( & + IRsnowC_SE , & ! Input + frequency , & ! Input + Surface%Snow_Type, & ! Input + emissivity , & ! Output + iVar_SE%sevar ) ! Internal variable output + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error occurred in SEcategory_Emissivity()' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ); RETURN + END IF + + ! Solar direct component + IF ( SpcCoeff_IsSolar(SC(SensorIndex), ChannelIndex=ChannelIndex) ) THEN + SfcOptics%Direct_Reflectivity(:,1) = ONE - emissivity + END IF + + ! Fill the return emissivity arrays + SfcOptics%Emissivity(1:SfcOptics%n_Angles,1) = emissivity + + ELSE IF ( isIRsnowC ) THEN + err_stat = CRTM_Compute_IRSnowEM(& + IRsnowC , & ! Input + Surface%Snow_Temperature , & ! Input + Surface%Snow_Grain_Size , & ! Input + frequency , & ! Input + SfcOptics%Angle(1:nZ) , & ! Input + iVar%irsnowvar , & ! Internal variable output + SfcOptics%Emissivity(1:nZ,1) ) ! Output + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error occurred in CRTM_Compute_IRSnowEM()' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ); RETURN + END IF + + ! Compute the solar direct BRDF + IF ( SpcCoeff_IsSolar(SC(SensorIndex), ChannelIndex=ChannelIndex) ) THEN + ! Cheng: placeholder for BRDF + SfcOptics%Direct_Reflectivity(1:nZ,1) = ZERO + END IF - - ! Solar direct component - IF ( SpcCoeff_IsSolar(SC(SensorIndex), ChannelIndex=ChannelIndex) ) THEN - SfcOptics%Direct_Reflectivity(:,1) = ONE - emissivity END IF - - ! Fill the return emissivity and reflectivity arrays - SfcOptics%Emissivity(1:SfcOptics%n_Angles,1) = emissivity - DO j = 1, SfcOptics%n_Angles + ! Fill the return reflectivity arrays + DO j = 1, nZ SfcOptics%Reflectivity(j,1,j,1) = ONE - SfcOptics%Emissivity(j,1) END DO @@ -217,11 +264,84 @@ END FUNCTION Compute_IR_Snow_SfcOptics ! ! This function is a wrapper for third party code. ! -! NB: CURRENTLY THIS IS A STUB FUNCTION AS THERE ARE NO TL -! COMPONENTS IN THE IR SNOW SFCOPTICS COMPUTATIONS. ! ! CALLING SEQUENCE: -! Error_Status = Compute_IR_Snow_SfcOptics_TL( SfcOptics_TL ) +! err_stat = Compute_IR_Snow_SfcOptics_TL( & +! Surface , & ! Input +! SfcOptics , & ! Input +! Surface_TL , & ! Input +! GeometryInfo, & ! Input +! SensorIndex , & ! Input +! ChannelIndex, & ! Input +! SfcOptics_TL, & ! Output +! iVar ) & ! Internal variable input +! +! OUTPUTS: +! SfcOptics_TL: CRTM_SfcOptics structure containing the tangent-linear +! surface optical properties required for the tangent- +! linear radiative transfer calculation. +! UNITS: N/A +! TYPE: CRTM_SfcOptics_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! INPUTS: +! Surface: CRTM_Surface structure containing the surface state +! data. +! UNITS: N/A +! TYPE: CRTM_Surface_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Surface_TL: CRTM_Surface structure containing the tangent-linear +! surface state data. +! UNITS: N/A +! TYPE: CRTM_Surface_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SfcOptics: CRTM_SfcOptics structure containing the surface +! optical properties required for the radiative +! transfer calculation. +! UNITS: N/A +! TYPE: CRTM_SfcOptics_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! GeometryInfo: CRTM_GeometryInfo structure containing the +! view geometry information. +! UNITS: N/A +! TYPE: CRTM_GeometryInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SensorIndex: Sensor index id. This is a unique index associated +! with a (supported) sensor used to access the +! shared coefficient data for a particular sensor. +! See the ChannelIndex argument. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! ChannelIndex: Channel index id. This is a unique index associated +! with a (supported) sensor channel used to access the +! shared coefficient data for a particular sensor's +! channel. +! See the SensorIndex argument. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! iVar: Structure containing internal variables required for +! subsequent tangent-linear or adjoint model calls. +! The contents of this structure are NOT accessible +! outside of the CRTM_IR_Water_SfcOptics module. +! UNITS: N/A +! TYPE: iVar_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) ! ! OUTPUTS: ! SfcOptics_TL: CRTM_SfcOptics structure containing the tangent-linear @@ -233,7 +353,7 @@ END FUNCTION Compute_IR_Snow_SfcOptics ! ATTRIBUTES: INTENT(IN OUT) ! ! FUNCTION RESULT: -! Error_Status: The return value is an integer defining the error status. +! 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 sucessful ! == FAILURE an unrecoverable error occurred @@ -249,26 +369,74 @@ END FUNCTION Compute_IR_Snow_SfcOptics !---------------------------------------------------------------------------------- FUNCTION Compute_IR_Snow_SfcOptics_TL( & - SfcOptics_TL ) & ! Output + Surface , & ! Input + SfcOptics , & ! Input + Surface_TL , & ! Input + GeometryInfo, & ! Input + SensorIndex , & ! Input + ChannelIndex, & ! Input + SfcOptics_TL, & ! Output + iVar ) & ! Internal variable input RESULT( err_stat ) ! Arguments - TYPE(CRTM_SfcOptics_type), INTENT(IN OUT) :: SfcOptics_TL + TYPE(CRTM_Surface_type), INTENT(IN) :: Surface + TYPE(CRTM_Surface_type), INTENT(IN) :: Surface_TL + TYPE(CRTM_SfcOptics_type), INTENT(IN) :: SfcOptics + TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeometryInfo + INTEGER, INTENT(IN) :: SensorIndex + INTEGER, INTENT(IN) :: ChannelIndex + TYPE(CRTM_SfcOptics_type), INTENT(IN OUT) :: SfcOptics_TL + TYPE(iVar_type), INTENT(IN) :: iVar ! Function result - INTEGER :: err_stat + INTEGER :: err_stat, j, nZ ! Local parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Compute_IR_Snow_SfcOptics_TL' ! Local variables - + LOGICAL :: isIRsnowC ! Set up - err_stat = SUCCESS - + err_stat = SUCCESS + ! ...Short name for angle dimensions + nZ = SfcOptics%n_Angles + ! ...Snow coefficient model + isIRsnowC = CRTM_IRsnowCoeff_IsLoaded() ! Compute the tangent-linear surface optical parameters - ! ***No TL models yet, so default TL output is zero*** - SfcOptics_TL%Reflectivity = ZERO - SfcOptics_TL%Direct_Reflectivity = ZERO - SfcOptics_TL%Emissivity = ZERO + IF ( isIRsnowC ) THEN + + ! Compute tangent-linear IR snow surface emissivity + err_stat = CRTM_Compute_IRSnowEM_TL( & + IRsnowC , & ! Input model coefficients + Surface_TL%Snow_Temperature , & ! Input + Surface_TL%Snow_Grain_Size , & ! Input + iVar%irsnowvar , & ! Internal variable input + SfcOptics_TL%Emissivity(1:nZ,1) ) ! Output + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error computing Tangent_linear IR snow surface emissivity', & + err_stat ) + RETURN + END IF + + ! Compute the tangent-linear solar direct BRDF + IF ( SpcCoeff_IsSolar(SC(SensorIndex), ChannelIndex=ChannelIndex) ) THEN + ! Cheng: placeholder for BRDF + SfcOptics_TL%Direct_Reflectivity(1:nZ,1) = ZERO + END IF + + ! Surface reflectance (currently assumed to be specular ALWAYS) + DO j = 1, nZ + SfcOptics_TL%Reflectivity(j,1,j,1) = -SfcOptics_TL%Emissivity(j,1) + END DO + + ELSE + + ! No TL component for SEcategory files + SfcOptics_TL%Reflectivity = ZERO + SfcOptics_TL%Direct_Reflectivity = ZERO + SfcOptics_TL%Emissivity = ZERO + + END IF END FUNCTION Compute_IR_Snow_SfcOptics_TL @@ -285,20 +453,82 @@ END FUNCTION Compute_IR_Snow_SfcOptics_TL ! ! This function is a wrapper for third party code. ! -! NB: CURRENTLY THIS IS A STUB FUNCTION AS THERE ARE NO AD -! COMPONENTS IN THE IR SNOW SFCOPTICS COMPUTATIONS. -! ! CALLING SEQUENCE: -! Error_Status = Compute_IR_Snow_SfcOptics_AD( SfcOptics_AD ) +! Error_Status = Compute_IR_Snow_SfcOptics_AD( & +! Surface , & +! SfcOptics , & +! SfcOptics_AD, & +! GeometryInfo, & +! SensorIndex , & +! ChannelIndex, & +! Surface_AD , & +! iVar ) ! ! INPUTS: -! SfcOptics_AD: Structure containing the adjoint surface optical -! properties required for the adjoint radiative +! Surface: CRTM_Surface structure containing the surface state +! data. +! UNITS: N/A +! TYPE: CRTM_Surface_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SfcOptics: CRTM_SfcOptics structure containing the surface +! optical properties required for the radiative ! transfer calculation. -! *** COMPONENTS MODIFIED UPON OUTPUT *** ! UNITS: N/A ! TYPE: CRTM_SfcOptics_type ! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SfcOptics_AD: CRTM_SfcOptics structure containing the adjoint +! surface optical properties required for the adjoint +! radiative transfer calculation. +! UNITS: N/A +! TYPE: CRTM_SfcOptics_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! GeometryInfo: CRTM_GeometryInfo structure containing the +! view geometry information. +! UNITS: N/A +! TYPE: CRTM_GeometryInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SensorIndex: Sensor index id. This is a unique index associated +! with a (supported) sensor used to access the +! shared coefficient data for a particular sensor. +! See the ChannelIndex argument. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! ChannelIndex: Channel index id. This is a unique index associated +! with a (supported) sensor channel used to access the +! shared coefficient data for a particular sensor's +! channel. +! See the SensorIndex argument. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! iVar: Structure containing internal variables required for +! subsequent tangent-linear or adjoint model calls. +! The contents of this structure are NOT accessible +! outside of the CRTM_IR_Water_SfcOptics module. +! UNITS: N/A +! TYPE: iVar_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! Surface_AD: CRTM_Surface structure containing the adjoint +! surface state data. +! UNITS: N/A +! TYPE: CRTM_Surface_type +! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! ! FUNCTION RESULT: @@ -310,6 +540,7 @@ END FUNCTION Compute_IR_Snow_SfcOptics_TL ! TYPE: INTEGER ! DIMENSION: Scalar ! +! ! COMMENTS: ! Note the INTENT on the input adjoint arguments are IN OUT regardless ! of their specification as "input" or "output". This is because these @@ -320,26 +551,75 @@ END FUNCTION Compute_IR_Snow_SfcOptics_TL !---------------------------------------------------------------------------------- FUNCTION Compute_IR_Snow_SfcOptics_AD( & - SfcOptics_AD ) & ! Input + Surface , & ! Input + SfcOptics , & ! Input + SfcOptics_AD, & ! Input + GeometryInfo, & ! Input + SensorIndex , & ! Input + ChannelIndex, & ! Input + Surface_AD , & ! Output + iVar ) & ! Internal variable input RESULT( err_stat ) ! Arguments - TYPE(CRTM_SfcOptics_type), INTENT(IN OUT) :: SfcOptics_AD + TYPE(CRTM_Surface_type), INTENT(IN) :: Surface + TYPE(CRTM_SfcOptics_type), INTENT(IN) :: SfcOptics + TYPE(CRTM_SfcOptics_type), INTENT(IN OUT) :: SfcOptics_AD + TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeometryInfo + INTEGER, INTENT(IN) :: SensorIndex + INTEGER, INTENT(IN) :: ChannelIndex + TYPE(CRTM_Surface_type), INTENT(IN OUT) :: Surface_AD + TYPE(iVar_type), INTENT(IN) :: iVar ! Function result - INTEGER :: err_stat + INTEGER :: err_stat, j, nZ ! Local parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Compute_IR_Snow_SfcOptics_AD' ! Local variables - + LOGICAL :: isIRsnowC ! Set up err_stat = SUCCESS - + ! ...Short name for angle dimensions + nZ = SfcOptics%n_Angles + ! ...Snow coefficient model + isIRsnowC = CRTM_IRsnowCoeff_IsLoaded() ! Compute the adjoint surface optical parameters - ! ***No AD models yet, so there is no impact on AD result*** - SfcOptics_AD%Reflectivity = ZERO - SfcOptics_AD%Direct_Reflectivity = ZERO - SfcOptics_AD%Emissivity = ZERO + IF ( isIRsnowC ) THEN + ! Surface reflectance (currently assumed to be specular ALWAYS) + DO j = nZ, 1, -1 + SfcOptics_AD%Emissivity(j,1) = SfcOptics_AD%Emissivity(j,1) - & + SfcOptics_AD%Reflectivity(j,1,j,1) + SfcOptics_AD%Reflectivity(j,1,j,1) = ZERO + END DO + + ! Compute the adjoint solar direct BRDF + IF ( SpcCoeff_IsSolar(SC(SensorIndex), ChannelIndex=ChannelIndex) ) THEN + ! Cheng: placeholder for BRDF + SfcOptics_AD%Direct_Reflectivity(1:nZ,1) = ZERO + END IF + + ! Compute sdjoint IRSSEM sea surface emissivity + err_stat = CRTM_Compute_IRSnowEM_AD( & + IRsnowC , & ! Input model coefficients + SfcOptics_AD%Emissivity(1:nZ,1), & ! Input + iVar%irsnowvar , & ! Internal Variable Input + Surface_AD%Snow_Grain_Size , & ! Output + Surface_AD%Snow_Temperature ) ! Output + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error computing Adjoint IR sea surface emissivity', & + err_stat ) + RETURN + END IF + + ELSE + + ! No AD component for SEcategory files + SfcOptics_AD%Reflectivity = ZERO + SfcOptics_AD%Direct_Reflectivity = ZERO + SfcOptics_AD%Emissivity = ZERO + + END IF END FUNCTION Compute_IR_Snow_SfcOptics_AD diff --git a/src/SfcOptics/CRTM_IR_Water_SfcOptics.f90 b/src/SfcOptics/CRTM_IR_Water_SfcOptics.f90 index fc1b3a1..e0e84b5 100644 --- a/src/SfcOptics/CRTM_IR_Water_SfcOptics.f90 +++ b/src/SfcOptics/CRTM_IR_Water_SfcOptics.f90 @@ -13,6 +13,9 @@ ! CREATION HISTORY: ! Written by: Paul van Delst, 25-Jun-2005 ! paul.vandelst@noaa.gov +! Modified by: Cheng Dang, 18-Mar-2022 +! dangch@ucar.edu +! Add water temperature ! MODULE CRTM_IR_Water_SfcOptics @@ -209,6 +212,7 @@ FUNCTION Compute_IR_Water_SfcOptics( & ! Compute IR sea surface emissivity Error_Status = CRTM_Compute_IRSSEM( & IRwaterC , & ! Input model coefficients + Surface%Water_Temperature , & ! Input Surface%Wind_Speed , & ! Input Frequency , & ! Input SfcOptics%Angle(1:nZ) , & ! Input @@ -221,6 +225,7 @@ FUNCTION Compute_IR_Water_SfcOptics( & RETURN END IF + ! Compute the solar direct BRDF IF ( SpcCoeff_IsSolar(SC(SensorIndex), ChannelIndex=ChannelIndex) ) THEN @@ -392,6 +397,7 @@ FUNCTION Compute_IR_Water_SfcOptics_TL( & ! Compute tangent-linear IR sea surface emissivity Error_Status = CRTM_Compute_IRSSEM_TL( & IRwaterC , & ! Input model coefficients + Surface_TL%Water_Temperature , & ! Input Surface_TL%Wind_Speed , & ! Input iVar%IRSSEM , & ! Internal variable input SfcOptics_TL%Emissivity(1:nZ,1) ) ! Output @@ -589,7 +595,6 @@ FUNCTION Compute_IR_Water_SfcOptics_AD( & brdf_AD = SUM(SfcOptics_AD%Direct_Reflectivity(1:nZ,1)) SfcOptics_AD%Direct_Reflectivity(1:nZ,1) = ZERO - CALL BRDF_Rough_Sea_AD(Surface%Wind_Speed, & brdf_AD, & Surface_AD%Wind_Speed, & @@ -597,13 +602,15 @@ FUNCTION Compute_IR_Water_SfcOptics_AD( & END IF SfcOptics_AD%Direct_Reflectivity(1:nZ,1) = ZERO - END IF + END IF + ! Compute sdjoint IRSSEM sea surface emissivity Error_Status = CRTM_Compute_IRSSEM_AD( & IRwaterC , & ! Input model coefficients SfcOptics_AD%Emissivity(1:nZ,1), & ! Input iVar%IRSSEM , & ! Internal Variable Input - Surface_AD%Wind_Speed ) ! Output + Surface_AD%Wind_Speed , & ! Output + Surface_AD%Water_Temperature ) ! Output IF ( Error_Status /= SUCCESS ) THEN CALL Display_Message( ROUTINE_NAME, & 'Error computing Adjoint IR sea surface emissivity', & diff --git a/src/SfcOptics/CRTM_SfcOptics.f90 b/src/SfcOptics/CRTM_SfcOptics.f90 index 2440044..ea3565c 100644 --- a/src/SfcOptics/CRTM_SfcOptics.f90 +++ b/src/SfcOptics/CRTM_SfcOptics.f90 @@ -17,10 +17,10 @@ ! Author: Date: Description: ! ======= ===== ============ ! Patrick Stegmann 2021-01-22 Added CONST_MIXED_POLARIZATION scheme. -! -! Patrick Stegmann 2021-08-31 Added PRA_POLARIZATION scheme for GEMS-1. ! +! Patrick Stegmann 2021-08-31 Added PRA_POLARIZATION scheme for GEMS-1. ! +! Cheng Dang 2022-05-31 Added IRsnowCoeff TL and AD modules MODULE CRTM_SfcOptics @@ -84,6 +84,7 @@ MODULE CRTM_SfcOptics Compute_IR_Water_SfcOptics_TL, & Compute_IR_Water_SfcOptics_AD USE CRTM_IR_Snow_SfcOptics, ONLY: IRSSOVar_type => iVar_type, & + IRSSOVar_SE_type => iVar_SE_type, & Compute_IR_Snow_SfcOptics, & Compute_IR_Snow_SfcOptics_TL, & Compute_IR_Snow_SfcOptics_AD @@ -146,10 +147,11 @@ MODULE CRTM_SfcOptics TYPE(MWSSOVar_type) :: MWSSOV ! Snow TYPE(MWISOVar_type) :: MWISOV ! Ice ! Infrared - TYPE(IRLSOVar_type) :: IRLSOV ! Land - TYPE(IRWSOVar_type) :: IRWSOV ! Water - TYPE(IRSSOVar_type) :: IRSSOV ! Snow - TYPE(IRISOVar_type) :: IRISOV ! Ice + TYPE(IRLSOVar_type) :: IRLSOV ! Land + TYPE(IRWSOVar_type) :: IRWSOV ! Water + TYPE(IRSSOVar_type) :: IRSSOV ! Snow + TYPE(IRSSOVar_SE_type) :: IRSSOV_SE ! Snow, SE category + TYPE(IRISOVar_type) :: IRISOV ! Ice ! Visible TYPE(VISLSOVar_type) :: VISLSOV ! Land TYPE(VISWSOVar_type) :: VISWSOV ! Water @@ -463,7 +465,7 @@ FUNCTION CRTM_Compute_SfcOptics( & INTEGER , INTENT(IN) :: SensorIndex INTEGER , INTENT(IN) :: ChannelIndex TYPE(CRTM_SfcOptics_type) , INTENT(IN OUT) :: SfcOptics - TYPE(iVar_type) , INTENT(IN OUT) :: iVar + TYPE(iVar_type) , INTENT(OUT) :: iVar ! Function result INTEGER :: Error_Status ! Local parameters @@ -635,6 +637,7 @@ FUNCTION CRTM_Compute_SfcOptics( & !# If the SfcOptics n_Stokes dimension == 1, the polarisations are # !# decoupled. # !#----------------------------------------------------------------------# + Decoupled_Polarization: IF( SfcOptics%n_Stokes == 1 ) THEN @@ -739,7 +742,7 @@ FUNCTION CRTM_Compute_SfcOptics( & ! ========== ! Leslie, V. (2020): TROPICS Polarization Description, 20 November 2020. ! (Personal Communication) - ! + ! CASE ( CONST_MIXED_POLARIZATION ) SIN2_Angle = (GeometryInfo%Distance_Ratio * & SIN(DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex)))**2 @@ -749,18 +752,18 @@ FUNCTION CRTM_Compute_SfcOptics( & SfcOptics%Reflectivity(i,1,i,1) = (Reflectivity(i,1,i,1)*SIN2_Angle) + & (Reflectivity(i,2,i,2)*(ONE-SIN2_Angle)) END DO - + ! ! Description: ! ============ - ! Polarization changing with a defined polarization rotation angle + ! Polarization changing with a defined polarization rotation angle ! as instrument zenith angle changes. Implemented for GEMS-1 SmallSat. ! CASE ( PRA_POLARIZATION ) DO i = 1, nZ ! Alias for the sensor scan angle: phi = GeometryInfo%Sensor_Scan_Radian - ! Instrument offset angle: + ! Instrument offset angle: theta_f = DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex) ph = SIN(phi) * ( COS(phi) + SIN(theta_f)*(1.0_fp - COS(phi)) ) & ! -------------------------------------------------------------- @@ -775,7 +778,7 @@ FUNCTION CRTM_Compute_SfcOptics( & SfcOptics%Reflectivity(i,1,i,1) = (Reflectivity(i,1,i,1)*SIN2_Angle) + & (Reflectivity(i,2,i,2)*(ONE-SIN2_Angle)) END DO - + ! Serious problem if we got to this points CASE DEFAULT Error_Status = FAILURE @@ -876,11 +879,12 @@ FUNCTION CRTM_Compute_SfcOptics( & ! Compute the surface optics Error_Status = Compute_IR_Snow_SfcOptics( & - Surface , & ! Input - SensorIndex , & ! Input - ChannelIndex, & ! Input - SfcOptics , & ! In/Output - iVar%IRSSOV ) ! Internal variable output + Surface , & ! Input + SensorIndex , & ! Input + ChannelIndex , & ! Input + SfcOptics , & ! In/Output + iVar%IRSSOV_SE, & ! Internal variable output + iVar%IRSSOV ) ! Internal variable output IF ( Error_Status /= SUCCESS ) THEN WRITE( Message,'("Error computing IR snow SfcOptics at ",& &"channel index ",i0)' ) ChannelIndex @@ -1512,14 +1516,14 @@ FUNCTION CRTM_Compute_SfcOptics_TL( & ! ! Description: ! ============ - ! Polarization changing with a defined polarization rotation angle + ! Polarization changing with a defined polarization rotation angle ! as instrument zenith angle changes. Implemented for GEMS-1 SmallSat. ! CASE ( PRA_POLARIZATION ) DO i = 1, nZ ! Alias for the sensor scan angle: phi = GeometryInfo%Sensor_Scan_Radian - ! Instrument offset angle: + ! Instrument offset angle: theta_f = DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex) ph = SIN(phi) * ( COS(phi) + SIN(theta_f)*(1.0_fp - COS(phi)) ) & ! -------------------------------------------------------------- @@ -1636,7 +1640,15 @@ FUNCTION CRTM_Compute_SfcOptics_TL( & Infrared_Snow: IF( Surface%Snow_Coverage > ZERO ) THEN ! Compute the surface optics - Error_Status = Compute_IR_Snow_SfcOptics_TL( SfcOptics_TL ) + Error_Status = Compute_IR_Snow_SfcOptics_TL( & + Surface , & ! Input + SfcOptics , & ! Input + Surface_TL , & ! Input + GeometryInfo, & ! Input + SensorIndex , & ! Input + ChannelIndex, & ! Input + SfcOptics_TL, & ! In/Output + iVar%IRSSOV ) ! Internal variable input IF ( Error_Status /= SUCCESS ) THEN WRITE( Message,'("Error computing IR snow SfcOptics_TL at ",& &"channel index ",i0)' ) ChannelIndex @@ -2052,14 +2064,14 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & ! ! Description: ! ============ - ! Polarization changing with a defined polarization rotation angle + ! Polarization changing with a defined polarization rotation angle ! as instrument zenith angle changes. Implemented for GEMS-1 SmallSat. ! CASE ( PRA_POLARIZATION ) DO i = 1, nZ ! Alias for the sensor scan angle: phi = GeometryInfo%Sensor_Scan_Radian - ! Instrument offset angle: + ! Instrument offset angle: theta_f = DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex) ph = SIN(phi) * ( COS(phi) + SIN(theta_f)*(1.0_fp - COS(phi)) ) & ! -------------------------------------------------------------- @@ -2089,7 +2101,8 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & RETURN END SELECT Polarization_Type - + + ELSE @@ -2232,12 +2245,12 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & ELSE IF ( SpcCoeff_IsInfraredSensor( SC(SensorIndex) ) ) THEN Reflectivity_AD(1:nZ,1,1:nZ,1:nL) = SfcOptics_AD%Reflectivity(1:nZ,1,1:nZ,1:nL) - SfcOptics_AD%Reflectivity = ZERO + SfcOptics_AD%Reflectivity = ZERO Emissivity_AD(1:nZ,1:nL) = SfcOptics_AD%Emissivity(1:nZ,1:nL) SfcOptics_AD%Emissivity = ZERO Direct_Reflectivity_AD(1:nZ,1) = SfcOptics_AD%Direct_Reflectivity(1:nZ,1) SfcOptics_AD%Direct_Reflectivity(1:nZ,1) = ZERO - + ! ------------------------------------ ! Infrared ICE emissivity/reflectivity ! ------------------------------------ @@ -2254,7 +2267,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Ice_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Ice_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Ice_Coverage) ! Compute the surface optics adjoints Error_Status = Compute_IR_Ice_SfcOptics_AD( SfcOptics_AD ) IF ( Error_Status /= SUCCESS ) THEN @@ -2283,9 +2296,17 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Snow_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Snow_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Snow_Coverage) ! Compute the surface optics adjoints - Error_Status = Compute_IR_Snow_SfcOptics_AD( SfcOptics_AD ) + Error_Status = Compute_IR_Snow_SfcOptics_AD( & + Surface , & ! Input + SfcOptics , & ! Input + SfcOptics_AD, & ! Input + GeometryInfo, & ! Input + SensorIndex , & ! Input + ChannelIndex, & ! Input + Surface_AD , & ! Output + iVar%IRSSOV ) ! Internal variable input IF ( Error_Status /= SUCCESS ) THEN WRITE( Message,'("Error computing IR snow SfcOptics_AD at ",& &"channel index ",i0)' ) ChannelIndex @@ -2312,7 +2333,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Water_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Water_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Water_Coverage) ! Compute the surface optics adjoints Error_Status = Compute_IR_Water_SfcOptics_AD( & Surface , & ! Input @@ -2349,7 +2370,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Land_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Land_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Land_Coverage) ! Compute the surface optics adjoints ! **STUB PROCEDURE** Error_Status = Compute_IR_Land_SfcOptics_AD( SfcOptics_AD ) diff --git a/src/SfcOptics/IR_Snow/CRTM_IRSnowEM.f90 b/src/SfcOptics/IR_Snow/CRTM_IRSnowEM.f90 new file mode 100644 index 0000000..4d96f5f --- /dev/null +++ b/src/SfcOptics/IR_Snow/CRTM_IRSnowEM.f90 @@ -0,0 +1,675 @@ +! +! CRTM_IRSnowEM +! +! Module containing function to invoke the CRTM Infrared +! Snow Emissivity Model. +! +! +! CREATION HISTORY: +! Written by: Cheng Dang, 31-May-2022 +! dangch@ucar.edu +! + +MODULE CRTM_IRSnowEM + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds, ONLY: fp + USE Message_Handler, ONLY: SUCCESS, FAILURE, Display_Message + USE CRTM_Parameters, ONLY: ZERO, ONE, DEGREES_TO_RADIANS + USE CRTM_Interpolation, ONLY: NPTS, & + LPoly, & + LPoly_type, & + Clear_LPoly, & + Find_Index, & + Interp_3D, & + Interp_4D, & + LPoly_TL, & + Interp_3D_TL, & + Interp_4D_TL, & + LPoly_AD, & + Interp_3D_AD, & + Interp_4D_AD + USE IRsnowCoeff_Define, ONLY: IRsnowCoeff_type + ! Disable implicit typing + IMPLICIT NONE + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Derived type + PUBLIC :: iVar_type + ! Procedures + PUBLIC :: CRTM_Compute_IRSnowEM + PUBLIC :: CRTM_Compute_IRSnowEM_TL + PUBLIC :: CRTM_Compute_IRSnowEM_AD + + + ! ----------------- + ! Module parameters + ! ----------------- + ! Version Id for the module + ! Message string length + INTEGER, PARAMETER :: ML = 256 + + + ! ------------------------------- + ! Structure definition to hold + ! forward interpolating variables + ! across fwd, tl and adjoint + ! ------------------------------- + ! The interpolation routine structure + TYPE :: Einterp_type + ! The dimensions + INTEGER :: n_Angles = 0 + INTEGER :: n_Pts = 0 + ! Allocation indicator + LOGICAL :: Is_Allocated = .FALSE. + ! The interpolating polynomials + TYPE(LPoly_type), ALLOCATABLE :: wlp(:) ! Angle + TYPE(LPoly_type) :: xlp ! Frequency + TYPE(LPoly_type) :: ylp ! Snow Grain Size + TYPE(LPoly_type) :: zlp ! Snow Temperature + ! The LUT interpolation indices + INTEGER, ALLOCATABLE :: i1(:) , i2(:) ! Angle + INTEGER :: j1 , j2 ! Frequency + INTEGER :: k1 , k2 ! Snow Grain Size + INTEGER :: l1 , l2 ! Snow Temperature + ! The LUT interpolation boundary check + LOGICAL, ALLOCATABLE :: a_outbound(:) ! Angle + LOGICAL :: f_outbound ! Frequency + LOGICAL :: r_outbound ! Snow Grain Size + LOGICAL :: t_outbound ! Snow Temperature + ! The interpolation input + REAL(fp), ALLOCATABLE :: a_int(:) ! Angle + REAL(fp) :: f_int ! Frequency + REAL(fp) :: r_int ! Snow Grain Size + REAL(fp) :: t_int ! Snow Temperature + ! The data to be interpolated + REAL(fp), ALLOCATABLE :: a(:,:) ! Angle + REAL(fp), ALLOCATABLE :: f(:) ! Frequency + REAL(fp), ALLOCATABLE :: r(:) ! Snow Grain Size + REAL(fp), ALLOCATABLE :: t(:) ! Snow Temperature + END TYPE Einterp_type + + ! The main internal variable structure + TYPE :: iVar_type + PRIVATE + ! The interpolation data + TYPE(Einterp_type) :: ei + END TYPE iVar_type + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! CRTM_Compute_IRSnowEM +! +! PURPOSE: +! Function to compute the CRTM infrared snow surface emissivity +! for input temperature, grain size, frequency, and angles. +! +! CALLING SEQUENCE: +! Error_Status = CRTM_Compute_IRSnowEM(IRsnowCoeff , & +! Snow_Temperature , & +! Snow_Grain_Size , & +! Frequency , & +! Angle , & +! iVar , & +! Emissivity ) +! +! INPUTS: +! IRsnowCoeff: Infrared snow emissivity model coefficient object. +! Load the object with the coefficients for the emissivity +! model to use. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Snow_Temperature: Snow temperature. +! UNITS: Kelvin (K) +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Snow_Grain_Size: Snow grain size. +! UNITS: microns (um) +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Frequency: Infrared frequency. +! UNITS: inverse centimetres (cm^-1) +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Angle: Surface zenith angle. +! UNITS: Degrees +! TYPE: REAL(fp) +! DIMENSION: Rank-1 (n_Angles) +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! iVar: Structure containing internal variables required for +! subsequent tangent-linear or adjoint model calls. +! The contents of this structure are NOT accessible +! outside of this module. +! UNITS: N/A +! TYPE: iVar_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! Emissivity: Snow surface emissivities for the +! requested Grain Size, frequency, and angles. +! UNITS: N/A +! TYPE: REAL(fp) +! DIMENSION: Same as input ANGLE argument. +! ATTRIBUTES: INTENT(OUT) +! +! FUNCTION RESULT: +! Error_Status: 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 CRTM_Compute_IRSnowEM( & + IRsnowCoeff , & ! Input model coefficients + Snow_Temperature , & ! Input + Snow_Grain_Size , & ! Input + Frequency , & ! Input + Angle , & ! Input + iVar , & ! Internal variable output + Emissivity ) & ! Output + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type) , INTENT(IN) :: IRsnowCoeff + REAL(fp) , INTENT(IN) :: Snow_Temperature ! t + REAL(fp) , INTENT(IN) :: Snow_Grain_Size ! r + REAL(fp) , INTENT(IN) :: Frequency ! f + REAL(fp) , INTENT(IN) :: Angle(:) ! a + TYPE(iVar_type) , INTENT(OUT) :: iVar + REAL(fp) , INTENT(OUT) :: Emissivity(:) + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Compute_IRsnowEM' + ! Local variables + CHARACTER(ML) :: msg + INTEGER :: n_Angles, i + + ! Set up + err_stat = SUCCESS + ! ...Check dimensions + n_Angles = SIZE(Angle) + IF ( SIZE(Emissivity) /= n_Angles ) THEN + err_stat = FAILURE + msg = 'Input Angle and output Emissivity array dimensions inconsistent.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + ! ...Allocate interpolation variable structure + CALL Einterp_Create( iVar%ei, NPTS, n_Angles ) + IF ( .NOT. Einterp_Associated( iVar%ei ) ) THEN + err_stat = FAILURE + msg = 'Error allocating interpolation variable structure.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + ! Compute the snow temperature interpolating polynomial + ! ...Find the LUT indices and check if input is out of bounds + iVar%ei%t_int = Snow_Temperature + CALL find_index(IRsnowCoeff%Temperature, & + iVar%ei%t_int, iVar%ei%l1, iVar%ei%l2, iVar%ei%t_outbound) + iVar%ei%t = IRsnowCoeff%Temperature(iVar%ei%l1:iVar%ei%l2) + ! ...Compute the polynomial + CALL LPoly( iVar%ei%t , & ! Input + iVar%ei%t_int, & ! Input + iVar%ei%zlp ) ! Output + + + ! Compute the grain size interpolating polynomial + ! ...Find the LUT indices and check if input is out of bounds + iVar%ei%r_int = Snow_Grain_Size + CALL find_index(IRsnowCoeff%Grain_Size, & + iVar%ei%r_int, iVar%ei%k1, iVar%ei%k2, iVar%ei%r_outbound) + iVar%ei%r = IRsnowCoeff%Grain_Size(iVar%ei%k1:iVar%ei%k2) + ! ...Compute the polynomial + CALL LPoly( iVar%ei%r , & ! Input + iVar%ei%r_int, & ! Input + iVar%ei%ylp ) ! Output + + + ! Compute the frequency interpolating polynomial + ! ...Find the LUT indices and check if input is out of bounds + iVar%ei%f_int = Frequency + CALL find_index(IRsnowCoeff%Frequency, & + iVar%ei%f_int, iVar%ei%j1, iVar%ei%j2, iVar%ei%f_outbound) + iVar%ei%f = IRsnowCoeff%Frequency(iVar%ei%j1:iVar%ei%j2) + ! ...Compute the polynomial + CALL LPoly( iVar%ei%f , & ! Input + iVar%ei%f_int, & ! Input + iVar%ei%xlp ) ! Output + + + ! Compute the angle interpolating polynomials + DO i = 1, n_Angles + + ! ...Find the LUT indices and check if input is out of bounds + iVar%ei%a_int(i) = ABS(Angle(i)) + CALL find_index(IRsnowCoeff%Angle, & + iVar%ei%a_int(i), iVar%ei%i1(i), iVar%ei%i2(i), iVar%ei%a_outbound(i)) + iVar%ei%a(:,i) = IRsnowCoeff%Angle(iVar%ei%i1(i):iVar%ei%i2(i)) + + ! ...Compute the polynomial + CALL LPoly( iVar%ei%a(:,i) , & ! Input + iVar%ei%a_int(i), & ! Input + iVar%ei%wlp(i) ) ! Output + + ! Compute the interpolated emissivity + CALL Interp_4D( IRsnowCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i) , & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + iVar%ei%l1 :iVar%ei%l2 ), & ! Input + iVar%ei%wlp(i), & ! Input + iVar%ei%xlp , & ! Input + iVar%ei%ylp , & ! Input + iVar%ei%zlp , & ! Input + Emissivity(i) ) ! Output + + END DO + + END FUNCTION CRTM_Compute_IRSnowEM + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! CRTM_Compute_IRSnowEM_TL +! +! PURPOSE: +! Function to compute the tangent-linear CRTM infrared snow +! emissivity for input temperature, grain size, frequency, +! and angles. +! +! This function must be called *after* the forward model function, +! CRTM_Compute_IRSnowEM, has been called. The forward model function +! populates the internal variable structure argument, iVar. +! +! CALLING SEQUENCE: +! Error_Status = CRTM_Compute_IRSnowEM_TL( IRsnowCoeff , & +! Snow_Temperature_TL , & +! Snow_Grain_Size_TL , & +! iVar , & +! Emissivity_TL ) +! INPUTS: +! IRsnowCoeff: Infrared snow emissivity model coefficient object. +! Load the object with the coefficients for the emissivity +! model to use. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Snow_Temperature_TL: The tangent-linear snow temperature. +! UNITS: Kelvin (K) +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Snow_Grain_Size_TL: The tangent-linear Grain Size. +! UNITS: metres per second (m.s^-1) +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! iVar: Structure containing internal variables required for +! subsequent tangent-linear or adjoint model calls. +! The contents of this structure are NOT accessible +! outside of this module. +! UNITS: N/A +! TYPE: iVar_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! Emissivity_TL: Tangent-linear snow surface emissivity. +! UNITS: N/A +! TYPE: REAL(fp) +! DIMENSION: Rank-1 (n_Angles) +! ATTRIBUTES: INTENT(OUT) +! +! FUNCTION RESULT: +! Error_Status: 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 CRTM_Compute_IRSnowEM_TL( & + IRsnowCoeff , & ! Input model coefficients + Snow_Temperature_TL , & ! Input + Snow_Grain_Size_TL , & ! Input + iVar , & ! Internal variable input + Emissivity_TL ) & ! Output + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type) , INTENT(IN) :: IRsnowCoeff + REAL(fp) , INTENT(IN) :: Snow_Temperature_TL + REAL(fp) , INTENT(IN) :: Snow_Grain_Size_TL + TYPE(iVar_type) , INTENT(IN) :: iVar + REAL(fp) , INTENT(OUT) :: Emissivity_TL(:) + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Compute_IRsnowEM_TL' + ! Local variables + CHARACTER(ML) :: msg + INTEGER :: i + REAL(fp) :: r_TL(NPTS), t_TL(NPTS) + REAL(fp) :: e_TL_3D(NPTS,NPTS,NPTS), e_TL_4D(NPTS,NPTS,NPTS,NPTS) + TYPE(LPoly_Type) :: ylp_TL, xlp_TL, wlp_TL, zlp_TL + + ! Set up + err_stat = SUCCESS + ! ...Check internal variable allocation + IF ( .NOT. Einterp_Associated( iVar%ei ) ) THEN + err_stat = FAILURE + msg = 'Internal structure ei is not allocated' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + ! ...Check dimensions + IF ( SIZE( Emissivity_TL ) /= iVar%ei%n_Angles ) THEN + err_stat = FAILURE + msg = 'Input Emissivity_TL array dimensions inconsistent with number of angles.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + ! ...No TL if snow temperature is out of bounds + IF (iVar%ei%t_outbound) THEN + Emissivity_TL = ZERO + RETURN + END IF + ! ...No TL if snow grain size is out of bounds + IF ( iVar%ei%r_outbound ) THEN + Emissivity_TL = ZERO + RETURN + END IF + ! ...Initialise local TL variables + t_TL = ZERO + r_TL = ZERO + e_TL_3D = ZERO + e_TL_4D = ZERO + CALL Clear_LPoly(wlp_TL) + CALL Clear_LPoly(xlp_TL) + + + ! Calculate the TL interpolating + ! polynomials for snow temperature + CALL LPoly_TL( iVar%ei%t, iVar%ei%t_int, & ! FWD Input + iVar%ei%zlp, & ! FWD Input + t_TL, Snow_Temperature_TL, & ! TL Input + zlp_TL ) ! TL Output + ! polynomials for snow grain size + CALL LPoly_TL( iVar%ei%r, iVar%ei%r_int, & ! FWD Input + iVar%ei%ylp, & ! FWD Input + r_TL, Snow_Grain_Size_TL, & ! TL Input + ylp_TL ) ! TL Output + + + ! Begin loop over angles + DO i = 1, iVar%ei%n_Angles + + ! Perform interpolation + CALL interp_4D_TL(IRsnowCoeff%Emissivity(iVar%ei%i1(i) :iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + iVar%ei%l1 :iVar%ei%l2 ), & ! FWD Emissivity input + iVar%ei%wlp(i), & ! FWD polynomial input + iVar%ei%xlp , & ! FWD polynomial input + iVar%ei%ylp , & ! FWD polynomial input + iVar%ei%zlp , & ! FWD polynomial input + e_TL_4D, wlp_TL, xlp_TL, ylp_TL, zlp_TL, & ! TL input + Emissivity_TL(i) ) ! Output + + END DO + + END FUNCTION CRTM_Compute_IRSnowEM_TL + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! CRTM_Compute_IRSnowEM_AD +! +! PURPOSE: +! Function to compute the adjoint of the CRTM infrared snow +! emissivity for input grain size, frequency, and angles. +! +! This function must be called *after* the forward model function, +! CRTM_Compute_IRSnowEM, has been called. The forward model function +! populates the internal variable structure argument, iVar. +! +! CALLING SEQUENCE: +! Error_Status = CRTM_Compute_IRSnowEM_AD(IRsnowCoeff , & +! Emissivity_AD , & +! iVar , & +! Snow_Grain_Size_AD , & +! Snow_Temperature_AD ) +! +! INPUTS: +! IRsnowCoeff: Infrared snow emissivity model coefficient object. +! Load the object with the coefficients for the emissivity +! model to use. +! UNITS: N/A +! TYPE: IRsnowCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Emissivity_AD: Adjoint snow surface emissivity. +! *** SET TO ZERO ON EXIT *** +! UNITS: N/A +! TYPE: REAL(fp) +! DIMENSION: Rank-1 (n_Angles) +! ATTRIBUTES: INTENT(IN OUT) +! +! iVar: Structure containing internal variables required for +! subsequent tangent-linear or adjoint model calls. +! The contents of this structure are NOT accessible +! outside of this module. +! UNITS: N/A +! TYPE: iVar_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! Snow_Grain_Size_AD: Adjoint snow grain size. +! *** MUST HAVE VALUE ON ENTRY *** +! UNITS: per microns (um)^-1 +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! Snow_Temperature_AD: Adjoint snow temperature. +! *** MUST HAVE VALUE ON ENTRY *** +! UNITS: per Kelvin, (K)^-1 +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! FUNCTION RESULT: +! Error_Status: 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 CRTM_Compute_IRSnowEM_AD( & + IRsnowCoeff , & ! Input model coefficients + Emissivity_AD , & ! Input + iVar , & ! Internal Variable Input + Snow_Grain_Size_AD , & ! Output + Snow_Temperature_AD ) & ! Output + RESULT( err_stat ) + ! Arguments + TYPE(IRsnowCoeff_type) , INTENT(IN) :: IRsnowCoeff + REAL(fp) , INTENT(IN OUT) :: Emissivity_AD(:) + TYPE(iVar_type) , INTENT(IN) :: iVar + REAL(fp) , INTENT(IN OUT) :: Snow_Grain_Size_AD + REAL(fp) , INTENT(IN OUT) :: Snow_Temperature_AD + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Compute_IRsnowEM_AD' + ! Local variables + CHARACTER(ML) :: msg + INTEGER :: i + REAL(fp) :: e_AD_3D(NPTS,NPTS,NPTS), e_AD_4D(NPTS,NPTS,NPTS,NPTS) + REAL(fp) :: r_AD(NPTS), t_AD(NPTS) + TYPE(LPoly_Type) :: wlp_AD, xlp_AD, ylp_AD, zlp_AD + + ! Set Up + err_stat = SUCCESS + e_AD_3D = ZERO + e_AD_4D = ZERO + r_AD = ZERO + t_AD = ZERO + ! ...Check internal variable allocation + IF ( .NOT. Einterp_Associated( iVar%ei ) ) THEN + err_stat = FAILURE + msg = 'Internal structure ei is not allocated' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + ! ...Check dimensions + IF ( SIZE(Emissivity_AD) /= iVar%ei%n_Angles ) THEN + err_stat = FAILURE + msg = 'Input Emissivity_AD array dimensions inconsistent with number of angles.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + ! ...No AD if snow temperature is out of bounds + IF (iVar%ei%t_outbound) RETURN + ! ...No AD if snow grain size is out of bounds + IF ( iVar%ei%r_outbound ) RETURN + ! ...Initialize local variables + CALL Clear_LPoly(wlp_AD) + CALL Clear_LPoly(xlp_AD) + CALL Clear_LPoly(ylp_AD) + CALL Clear_LPoly(zlp_AD) + + ! Loop over emissivity calculation angles + DO i = 1, iVar%ei%n_Angles + + ! Get the adjoint interpoalting polynomial for snow grain size and snow temperature + CALL Interp_4D_AD(IRsnowCoeff%Emissivity( iVar%ei%i1(i) :iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + iVar%ei%l1 :iVar%ei%l2 ), & ! FWD Input + iVar%ei%wlp(i) , & ! FWD Input + iVar%ei%xlp , & ! FWD Input + iVar%ei%ylp , & ! FWD Input + iVar%ei%zlp , & ! FWD Input + Emissivity_AD(i), & ! AD Input + e_AD_4D, wlp_AD, xlp_AD, ylp_AD, zlp_AD ) ! AD Output + ! Set adjoint emissivity to zero + Emissivity_AD(i) = ZERO + + END DO + + ! Compute the snow grain size adjoint + CALL Lpoly_AD(iVar%ei%r , & ! FWD Input + iVar%ei%r_int , & ! FWD Input + iVar%ei%ylp , & ! FWD Input + ylp_AD , & ! AD Input + r_AD , & ! AD Output + Snow_Grain_Size_AD ) ! AD Output + + ! Compute the snow temperature adjoint + CALL Lpoly_AD(iVar%ei%t , & ! FWD Input + iVar%ei%t_int , & ! FWD Input + iVar%ei%zlp , & ! FWD Input + zlp_AD , & ! AD Input + t_AD , & ! AD Output + Snow_Temperature_AD ) ! AD Output + + END FUNCTION CRTM_Compute_IRSnowEM_AD + + +!################################################################################ +!################################################################################ +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + + ! ---------------------------------------------- + ! Procedures to manipulate the Einterp structure + ! ---------------------------------------------- + ELEMENTAL FUNCTION Einterp_Associated( ei ) RESULT( Status ) + TYPE(Einterp_type), INTENT(IN) :: ei + LOGICAL :: Status + Status = ei%Is_Allocated + END FUNCTION Einterp_Associated + + ELEMENTAL SUBROUTINE Einterp_Create( ei, n_Pts, n_Angles ) + TYPE(Einterp_type), INTENT(OUT) :: ei + INTEGER, INTENT(IN) :: n_Pts + INTEGER, INTENT(IN) :: n_Angles + INTEGER :: alloc_stat + IF ( n_Pts < 1 .OR. n_Angles < 1 ) RETURN + ALLOCATE( ei%wlp(n_Angles) , & + ei%i1(n_Angles) , & + ei%i2(n_Angles) , & + ei%a_outbound(n_Angles), & + ei%a_int(n_Angles) , & + ei%a(n_Pts,n_Angles) , & + ei%f(n_Pts) , & + ei%r(n_Pts) , & + STAT = alloc_stat ) + IF ( alloc_stat /= 0 ) RETURN + ei%n_Angles = n_Angles + ei%n_Pts = n_Pts + ei%Is_Allocated = .TRUE. + END SUBROUTINE Einterp_Create + +END MODULE CRTM_IRSnowEM diff --git a/src/SfcOptics/IR_Water/IRSSEM/CRTM_IRSSEM.f90 b/src/SfcOptics/IR_Water/IRSSEM/CRTM_IRSSEM.f90 index d283f21..36e4cd6 100644 --- a/src/SfcOptics/IR_Water/IRSSEM/CRTM_IRSSEM.f90 +++ b/src/SfcOptics/IR_Water/IRSSEM/CRTM_IRSSEM.f90 @@ -9,6 +9,10 @@ ! Written by: Paul van Delst, 22-Jun-2005 ! paul.vandelst@noaa.gov ! +! Modified by: Cheng Dang, 18-Mar-2022 +! dangch@ucar.edu +! Add water temperature dimension +! MODULE CRTM_IRSSEM @@ -25,10 +29,13 @@ MODULE CRTM_IRSSEM Clear_LPoly, & Find_Index, & Interp_3D, & + Interp_4D, & LPoly_TL, & Interp_3D_TL, & + Interp_4D_TL, & LPoly_AD, & - Interp_3D_AD + Interp_3D_AD, & + Interp_4D_AD USE IRwaterCoeff_Define, ONLY: IRwaterCoeff_type ! Disable implicit typing IMPLICIT NONE @@ -70,22 +77,27 @@ MODULE CRTM_IRSSEM TYPE(LPoly_type), ALLOCATABLE :: wlp(:) ! Angle TYPE(LPoly_type) :: xlp ! Frequency TYPE(LPoly_type) :: ylp ! Wind Speed + TYPE(LPoly_type) :: zlp ! Water Temperature ! The LUT interpolation indices - INTEGER, ALLOCATABLE :: i1(:), i2(:) ! Angle + INTEGER, ALLOCATABLE :: i1(:) , i2(:) ! Angle INTEGER :: j1 , j2 ! Frequency INTEGER :: k1 , k2 ! Wind Speed + INTEGER :: l1 , l2 ! Water Temperature ! The LUT interpolation boundary check LOGICAL, ALLOCATABLE :: a_outbound(:) ! Angle LOGICAL :: f_outbound ! Frequency LOGICAL :: v_outbound ! Wind Speed + LOGICAL :: t_outbound ! Water Temperature ! The interpolation input REAL(fp), ALLOCATABLE :: a_int(:) ! Angle REAL(fp) :: f_int ! Frequency REAL(fp) :: v_int ! Wind Speed + REAL(fp) :: t_int ! Water Temperature ! The data to be interpolated REAL(fp), ALLOCATABLE :: a(:,:) ! Angle REAL(fp), ALLOCATABLE :: f(:) ! Frequency REAL(fp), ALLOCATABLE :: v(:) ! Wind Speed + REAL(fp), ALLOCATABLE :: t(:) ! Water Temperature END TYPE Einterp_type ! The main internal variable structure @@ -120,6 +132,7 @@ MODULE CRTM_IRSSEM ! ! CALLING SEQUENCE: ! Error_Status = CRTM_Compute_IRSSEM( IRwaterCoeff, & +! Water_Temperature , & ! Wind_Speed , & ! Frequency , & ! Angle , & @@ -135,6 +148,12 @@ MODULE CRTM_IRSSEM ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! +! Water_Temperature: Water_Temperature +! UNITS: Kelvin (K) +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! ! Wind_Speed: Wind speed. ! UNITS: metres per second (m.s^-1) ! TYPE: REAL(fp) @@ -183,18 +202,20 @@ MODULE CRTM_IRSSEM !-------------------------------------------------------------------------------- FUNCTION CRTM_Compute_IRSSEM( & - IRwaterCoeff, & ! Input model coefficients - Wind_Speed , & ! Input - Frequency , & ! Input - Angle , & ! Input - iVar , & ! Internal variable output - Emissivity ) & ! Output + IRwaterCoeff , & ! Input model coefficients + Water_Temperature , & ! Input + Wind_Speed , & ! Input + Frequency , & ! Input + Angle , & ! Input + iVar , & ! Internal variable output + Emissivity ) & ! Output RESULT( err_stat ) ! Arguments TYPE(IRwaterCoeff_type), INTENT(IN) :: IRwaterCoeff - REAL(fp) , INTENT(IN) :: Wind_Speed ! v - REAL(fp) , INTENT(IN) :: Frequency ! f - REAL(fp) , INTENT(IN) :: Angle(:) ! a + REAL(fp) , INTENT(IN) :: Water_Temperature ! t + REAL(fp) , INTENT(IN) :: Wind_Speed ! v + REAL(fp) , INTENT(IN) :: Frequency ! f + REAL(fp) , INTENT(IN) :: Angle(:) ! a TYPE(iVar_type) , INTENT(OUT) :: iVar REAL(fp) , INTENT(OUT) :: Emissivity(:) ! Function result @@ -227,6 +248,20 @@ FUNCTION CRTM_Compute_IRSSEM( & ! ...Convert angles to secants sec_angle = ONE/COS(DEGREES_TO_RADIANS*Angle) + ! Compute the water temperature interpolating polynomial + ! ...Required only for LUT "Nalli2" + ! ...Find the LUT indices and check if input is out of bounds + IF ( IRwaterCoeff%Classification_Name == "Nalli2" ) THEN + iVar%ei%t_int = Water_Temperature + CALL find_index(IRwaterCoeff%Temperature, & + iVar%ei%t_int, iVar%ei%l1, iVar%ei%l2, iVar%ei%t_outbound) + iVar%ei%t = IRwaterCoeff%Temperature(iVar%ei%l1:iVar%ei%l2) + ! ...Compute the polynomial + CALL LPoly( iVar%ei%t , & ! Input + iVar%ei%t_int, & ! Input + iVar%ei%zlp ) ! Output + END IF + ! Compute the wind speed interpolating polynomial ! ...Find the LUT indices and check if input is out of bounds @@ -272,16 +307,28 @@ FUNCTION CRTM_Compute_IRSSEM( & iVar%ei%a_int(i), & ! Input iVar%ei%wlp(i) ) ! Output - ! Compute the interpolated emissivity - CALL Interp_3D( IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), & - iVar%ei%j1 :iVar%ei%j2 , & - iVar%ei%k1 :iVar%ei%k2 ), & ! Input - iVar%ei%wlp(i), & ! Input - iVar%ei%xlp , & ! Input - iVar%ei%ylp , & ! Input - Emissivity(i) ) ! Output - + IF ( IRwaterCoeff%Classification_Name == "Nalli2" ) THEN + ! WRITE(*,*) 'Interp_4D', Interp_4D + CALL Interp_4D( IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + iVar%ei%l1 :iVar%ei%l2 ), & ! Input + iVar%ei%wlp(i), & ! Input + iVar%ei%xlp , & ! Input + iVar%ei%ylp , & ! Input + iVar%ei%zlp , & ! Input + Emissivity(i) ) ! Output + ELSE + CALL Interp_3D( IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + 1 ), & ! Input + iVar%ei%wlp(i), & ! Input + iVar%ei%xlp , & ! Input + iVar%ei%ylp , & ! Input + Emissivity(i) ) ! Output + END IF END DO END FUNCTION CRTM_Compute_IRSSEM @@ -295,7 +342,8 @@ END FUNCTION CRTM_Compute_IRSSEM ! ! PURPOSE: ! Function to compute the tangent-linear CRTM infrared sea surface -! emissivity (IRSSE) for input wind speed, frequency, and angles. +! emissivity (IRSSE) for input water temperature, wind speed, frequency, +! and angles. ! ! This function must be called *after* the forward model function, ! CRTM_Compute_IRSSEM, has been called. The forward model function @@ -303,6 +351,7 @@ END FUNCTION CRTM_Compute_IRSSEM ! ! CALLING SEQUENCE: ! Error_Status = CRTM_Compute_IRSSEM_TL( IRwaterCoeff , & +! Water_Temperature_TL, & ! Wind_Speed_TL, & ! iVar , & ! Emissivity_TL ) @@ -315,6 +364,12 @@ END FUNCTION CRTM_Compute_IRSSEM ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! +! Water_Temperature_TL: The tangent-linear water temperature. +! UNITS: Kelvin (K) +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! ! Wind_Speed_TL: The tangent-linear wind speed. ! UNITS: metres per second (m.s^-1) ! TYPE: REAL(fp) @@ -350,13 +405,15 @@ END FUNCTION CRTM_Compute_IRSSEM !-------------------------------------------------------------------------------- FUNCTION CRTM_Compute_IRSSEM_TL( & - IRwaterCoeff , & ! Input model coefficients - Wind_Speed_TL, & ! Input - iVar , & ! Internal variable input - Emissivity_TL) & ! Output + IRwaterCoeff , & ! Input model coefficients + Water_Temperature_TL, & ! Input + Wind_Speed_TL , & ! Input + iVar , & ! Internal variable input + Emissivity_TL ) & ! Output RESULT( err_stat ) ! Arguments TYPE(IRwaterCoeff_type), INTENT(IN) :: IRwaterCoeff + REAL(fp) , INTENT(IN) :: Water_Temperature_TL REAL(fp) , INTENT(IN) :: Wind_Speed_TL TYPE(iVar_type) , INTENT(IN) :: iVar REAL(fp) , INTENT(OUT) :: Emissivity_TL(:) @@ -367,9 +424,9 @@ FUNCTION CRTM_Compute_IRSSEM_TL( & ! Local variables CHARACTER(ML) :: msg INTEGER :: i - REAL(fp) :: v_TL(NPTS) - REAL(fp) :: e_TL(NPTS,NPTS,NPTS) - TYPE(LPoly_Type) :: ylp_TL, xlp_TL, wlp_TL + REAL(fp) :: v_TL(NPTS), t_TL(NPTS) + REAL(fp) :: e_TL_3D(NPTS,NPTS,NPTS), e_TL_4D(NPTS,NPTS,NPTS,NPTS) + TYPE(LPoly_Type) :: ylp_TL, xlp_TL, wlp_TL, zlp_TL ! Set up err_stat = SUCCESS @@ -387,19 +444,33 @@ FUNCTION CRTM_Compute_IRSSEM_TL( & CALL Display_Message( ROUTINE_NAME, msg, err_stat ) RETURN END IF + ! ...No TL if water temperature is out of bounds + IF (IRwaterCoeff%n_Temperature > 1 .AND. iVar%ei%t_outbound) THEN + Emissivity_TL = ZERO + RETURN + END IF ! ...No TL if wind speed is out of bounds IF ( iVar%ei%v_outbound ) THEN Emissivity_TL = ZERO RETURN END IF ! ...Initialise local TL variables + t_TL = ZERO v_TL = ZERO - e_TL = ZERO + e_TL_3D = ZERO + e_TL_4D = ZERO CALL Clear_LPoly(wlp_TL) CALL Clear_LPoly(xlp_TL) ! Calculate the TL interpolating + ! polynomials for water temperature + IF ( IRwaterCoeff%Classification_Name == "Nalli2" ) THEN + CALL LPoly_TL( iVar%ei%t, iVar%ei%t_int, & ! FWD Input + iVar%ei%zlp, & ! FWD Input + t_TL, Water_Temperature_TL, & ! TL Input + zlp_TL ) ! TL Output + END IF ! polynomials for wind speed CALL LPoly_TL( iVar%ei%v, iVar%ei%v_int, & ! FWD Input iVar%ei%ylp, & ! FWD Input @@ -411,14 +482,28 @@ FUNCTION CRTM_Compute_IRSSEM_TL( & DO i = 1, iVar%ei%n_Angles ! Perform interpolation - CALL interp_3D_TL(IRwaterCoeff%Emissivity(iVar%ei%i1(i):iVar%ei%i2(i), & - iVar%ei%j1 :iVar%ei%j2 , & - iVar%ei%k1 :iVar%ei%k2 ), & ! FWD Emissivity input - iVar%ei%wlp(i), & ! FWD polynomial input - iVar%ei%xlp , & ! FWD polynomial input - iVar%ei%ylp , & ! FWD polynomial input - e_TL, wlp_TL, xlp_TL, ylp_TL, & ! TL input - Emissivity_TL(i) ) ! Output + IF ( IRwaterCoeff%Classification_Name == "Nalli2" ) THEN + CALL interp_4D_TL(IRwaterCoeff%Emissivity(iVar%ei%i1(i):iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + iVar%ei%l1 :iVar%ei%l2 ), & ! FWD Emissivity input + iVar%ei%wlp(i), & ! FWD polynomial input + iVar%ei%xlp , & ! FWD polynomial input + iVar%ei%ylp , & ! FWD polynomial input + iVar%ei%zlp , & ! FWD polynomial input + e_TL_4D, wlp_TL, xlp_TL, ylp_TL, zlp_TL, & ! TL input + Emissivity_TL(i) ) ! Output + ELSE + CALL interp_3D_TL(IRwaterCoeff%Emissivity(iVar%ei%i1(i):iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + 1 ), & ! FWD Emissivity input + iVar%ei%wlp(i), & ! FWD polynomial input + iVar%ei%xlp , & ! FWD polynomial input + iVar%ei%ylp , & ! FWD polynomial input + e_TL_3D, wlp_TL, xlp_TL, ylp_TL, & ! TL input + Emissivity_TL(i) ) ! Output + END IF END DO @@ -440,10 +525,11 @@ END FUNCTION CRTM_Compute_IRSSEM_TL ! populates the internal variable structure argument, iVar. ! ! CALLING SEQUENCE: -! Error_Status = CRTM_Compute_IRSSEM_AD( IRwaterCoeff , & -! Emissivity_AD, & -! iVar , & -! Wind_Speed_AD ) +! Error_Status = CRTM_Compute_IRSSEM_AD( IRwaterCoeff , & +! Emissivity_AD , & +! iVar , & +! Wind_Speed_AD , & +! Water_Temperature_AD ) ! ! INPUTS: ! IRwaterCoeff: Infrared water emissivity model coefficient object. @@ -478,6 +564,13 @@ END FUNCTION CRTM_Compute_IRSSEM_TL ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! +! Water_Temperature_AD: Adjoint water temperature. +! *** MUST HAVE VALUE ON ENTRY *** +! UNITS: per Kelvin, (K)^-1 +! TYPE: REAL(fp) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! ! FUNCTION RESULT: ! Error_Status: The return value is an integer defining the error status. ! The error codes are defined in the Message_Handler module. @@ -491,16 +584,18 @@ END FUNCTION CRTM_Compute_IRSSEM_TL !-------------------------------------------------------------------------------- FUNCTION CRTM_Compute_IRSSEM_AD( & - IRwaterCoeff , & ! Input model coefficients - Emissivity_AD, & ! Input - iVar , & ! Internal Variable Input - Wind_Speed_AD) & ! Output + IRwaterCoeff , & ! Input model coefficients + Emissivity_AD , & ! Input + iVar , & ! Internal Variable Input + Wind_Speed_AD , & ! Output + Water_Temperature_AD ) & ! Output RESULT( err_stat ) ! Arguments TYPE(IRwaterCoeff_type), INTENT(IN) :: IRwaterCoeff REAL(fp) , INTENT(IN OUT) :: Emissivity_AD(:) TYPE(iVar_type) , INTENT(IN) :: iVar REAL(fp) , INTENT(IN OUT) :: Wind_Speed_AD + REAL(fp) , INTENT(IN OUT) :: Water_Temperature_AD ! Function result INTEGER :: err_stat ! Local parameters @@ -508,14 +603,16 @@ FUNCTION CRTM_Compute_IRSSEM_AD( & ! Local variables CHARACTER(ML) :: msg INTEGER :: i - REAL(fp) :: e_AD(NPTS,NPTS,NPTS) - REAL(fp) :: v_AD(NPTS) - TYPE(LPoly_Type) :: wlp_AD, xlp_AD, ylp_AD + REAL(fp) :: e_AD_3D(NPTS,NPTS,NPTS), e_AD_4D(NPTS,NPTS,NPTS,NPTS) + REAL(fp) :: v_AD(NPTS), t_AD(NPTS) + TYPE(LPoly_Type) :: wlp_AD, xlp_AD, ylp_AD, zlp_AD ! Set Up err_stat = SUCCESS - e_AD = ZERO + e_AD_3D = ZERO + e_AD_4D = ZERO v_AD = ZERO + t_AD = ZERO ! ...Check internal variable allocation IF ( .NOT. Einterp_Associated( iVar%ei ) ) THEN err_stat = FAILURE @@ -530,26 +627,42 @@ FUNCTION CRTM_Compute_IRSSEM_AD( & CALL Display_Message( ROUTINE_NAME, msg, err_stat ) RETURN END IF + ! ...No AD if water temperature is out of bounds + IF (IRwaterCoeff%n_Temperature > 1 .AND. iVar%ei%t_outbound) RETURN ! ...No AD if wind speed is out of bounds IF ( iVar%ei%v_outbound ) RETURN ! ...Initialize local variables CALL Clear_LPoly(wlp_AD) CALL Clear_LPoly(xlp_AD) CALL Clear_LPoly(ylp_AD) + CALL Clear_LPoly(zlp_AD) ! Loop over emissivity calculation angles DO i = 1, iVar%ei%n_Angles - - ! Get the adjoint interpoalting polynomial for wind speed - CALL Interp_3D_AD(IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), & - iVar%ei%j1 :iVar%ei%j2 , & - iVar%ei%k1 :iVar%ei%k2 ), & ! FWD Input - iVar%ei%wlp(i) , & ! FWD Input - iVar%ei%xlp , & ! FWD Input - iVar%ei%ylp , & ! FWD Input - Emissivity_AD(i), & ! AD Input - e_AD, wlp_AD, xlp_AD, ylp_AD ) ! AD Output - + IF ( IRwaterCoeff%Classification_Name == "Nalli2" ) THEN + ! Get the adjoint interpoalting polynomial for wind speed and water temperature + CALL Interp_4D_AD(IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + iVar%ei%l1 :iVar%ei%l2 ), & ! FWD Input + iVar%ei%wlp(i) , & ! FWD Input + iVar%ei%xlp , & ! FWD Input + iVar%ei%ylp , & ! FWD Input + iVar%ei%zlp , & ! FWD Input + Emissivity_AD(i), & ! AD Input + e_AD_4D, wlp_AD, xlp_AD, ylp_AD, zlp_AD ) ! AD Output + ELSE + ! Get the adjoint interpoalting polynomial for wind speed + CALL Interp_3D_AD(IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), & + iVar%ei%j1 :iVar%ei%j2 , & + iVar%ei%k1 :iVar%ei%k2 , & + 1 ), & ! FWD Input + iVar%ei%wlp(i) , & ! FWD Input + iVar%ei%xlp , & ! FWD Input + iVar%ei%ylp , & ! FWD Input + Emissivity_AD(i), & ! AD Input + e_AD_3D, wlp_AD, xlp_AD, ylp_AD ) ! AD Output + END IF ! Set adjoint emissivity to zero Emissivity_AD(i) = ZERO @@ -563,6 +676,16 @@ FUNCTION CRTM_Compute_IRSSEM_AD( & v_AD , & ! AD Output Wind_Speed_AD ) ! AD Output + ! Compute the water temperature adjoint + IF ( IRwaterCoeff%n_Temperature > 1 ) THEN + CALL Lpoly_AD(iVar%ei%t , & ! FWD Input + iVar%ei%t_int , & ! FWD Input + iVar%ei%zlp , & ! FWD Input + zlp_AD , & ! AD Input + t_AD , & ! AD Output + Water_Temperature_AD ) ! AD Output + END IF + END FUNCTION CRTM_Compute_IRSSEM_AD diff --git a/src/Surface/CRTM_Surface_Define.f90 b/src/Surface/CRTM_Surface_Define.f90 index 8292574..999eb2f 100644 --- a/src/Surface/CRTM_Surface_Define.f90 +++ b/src/Surface/CRTM_Surface_Define.f90 @@ -188,7 +188,7 @@ MODULE CRTM_Surface_Define REAL(fp), PARAMETER :: DEFAULT_SNOW_TEMPERATURE = 263.0_fp ! K REAL(fp), PARAMETER :: DEFAULT_SNOW_DEPTH = 50.0_fp ! mm REAL(fp), PARAMETER :: DEFAULT_SNOW_DENSITY = 0.2_fp ! g/cm^3 - REAL(fp), PARAMETER :: DEFAULT_SNOW_GRAIN_SIZE = 2.0_fp ! mm + REAL(fp), PARAMETER :: DEFAULT_SNOW_GRAIN_SIZE = 2.0e3_fp ! um (microns) ! ...Ice surface type data INTEGER, PARAMETER :: DEFAULT_ICE_TYPE = 1 ! First item in list REAL(fp), PARAMETER :: DEFAULT_ICE_TEMPERATURE = 263.0_fp ! K @@ -421,12 +421,12 @@ ELEMENTAL SUBROUTINE CRTM_Surface_NonVariableCopy( sfc, modified_sfc ) modified_sfc%Water_Coverage = sfc%Water_Coverage modified_sfc%Snow_Coverage = sfc%Snow_Coverage modified_sfc%Ice_Coverage = sfc%Ice_Coverage - + modified_sfc%Land_Type = sfc%Land_Type modified_sfc%Water_Type = sfc%Water_Type modified_sfc%Snow_Type = sfc%Snow_Type modified_sfc%Ice_Type = sfc%Ice_Type - + END SUBROUTINE CRTM_Surface_NonVariableCopy @@ -584,14 +584,14 @@ SUBROUTINE Scalar_Inspect( Sfc, Unit ) INTEGER, OPTIONAL, INTENT(IN) :: Unit ! Local variables INTEGER :: fid - + ! Setup fid = OUTPUT_UNIT IF ( PRESENT(Unit) ) THEN IF ( File_Open(Unit) ) fid = Unit END IF - + WRITE(fid,'(1x,"Surface OBJECT")') ! Surface coverage WRITE(fid,'(3x,"Land Coverage :",1x,f6.3)') Sfc%Land_Coverage @@ -1166,7 +1166,7 @@ SUBROUTINE Read_CleanUp() IF ( io_stat /= 0 ) & msg = TRIM(msg)//'; Error closing input file during error cleanup - '//TRIM(io_msg) END IF - IF ( ALLOCATED(Surface) ) THEN + IF ( ALLOCATED(Surface) ) THEN !DEALLOCATE(Surface, STAT=alloc_stat, ERRMSG=alloc_msg) DEALLOCATE(Surface, STAT=alloc_stat) IF ( alloc_stat /= 0 ) & @@ -1286,7 +1286,7 @@ SUBROUTINE Read_CleanUp() IF ( io_stat /= 0 ) & msg = TRIM(msg)//'; Error closing input file during error cleanup - '//TRIM(io_msg) END IF - IF ( ALLOCATED(Surface) ) THEN + IF ( ALLOCATED(Surface) ) THEN !DEALLOCATE(Surface, STAT=alloc_stat, ERRMSG=alloc_msg) DEALLOCATE(Surface, STAT=alloc_stat) IF ( alloc_stat /= 0 ) & @@ -2396,7 +2396,7 @@ FUNCTION Write_Record( & IF ( PRESENT(Debug) ) THEN IF ( Debug ) noisy = .TRUE. END IF - + ! Write the gross surface type coverage WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) & diff --git a/src/Surface/Create_Test_Surface/Create_Test_Surface.f90 b/src/Surface/Create_Test_Surface/Create_Test_Surface.f90 index 0cdf63d..3bc0a89 100644 --- a/src/Surface/Create_Test_Surface/Create_Test_Surface.f90 +++ b/src/Surface/Create_Test_Surface/Create_Test_Surface.f90 @@ -46,7 +46,7 @@ PROGRAM Create_Test_Surface INTEGER :: Error_Status TYPE(CRTM_Surface_type) :: Surface(N_PROFILES) - + ! Output header ! ------------- CALL Program_Message( PROGRAM_NAME, & @@ -80,7 +80,7 @@ PROGRAM Create_Test_Surface Surface(1)%Snow_Temperature = 270.0_fp Surface(1)%Snow_Depth = 20.0_fp Surface(1)%Snow_Density = 0.25_fp - Surface(1)%Snow_Grain_Size = 1.5_fp + Surface(1)%Snow_Grain_Size = 1.5e3_fp ! Profile 2: Mid-latitude summer @@ -109,7 +109,7 @@ PROGRAM Create_Test_Surface Surface(2)%Snow_Temperature = 270.0_fp Surface(2)%Snow_Depth = 20.0_fp Surface(2)%Snow_Density = 0.25_fp - Surface(2)%Snow_Grain_Size = 1.5_fp + Surface(2)%Snow_Grain_Size = 1.5e3_fp ! Profile 3: Mid-latitude winter @@ -138,7 +138,7 @@ PROGRAM Create_Test_Surface Surface(3)%Snow_Temperature = 265.0_fp Surface(3)%Snow_Depth = 100.0_fp Surface(3)%Snow_Density = 0.1_fp - Surface(3)%Snow_Grain_Size = 0.5_fp + Surface(3)%Snow_Grain_Size = 0.5e3_fp ! Ice surface type data Surface(3)%Ice_Type = FRESH_ICE Surface(3)%Ice_Temperature = 265.0_fp @@ -173,7 +173,7 @@ PROGRAM Create_Test_Surface Surface(4)%Snow_Temperature = 270.0_fp Surface(4)%Snow_Depth = 200.0_fp Surface(4)%Snow_Density = 0.18_fp - Surface(4)%Snow_Grain_Size = 1.0_fp + Surface(4)%Snow_Grain_Size = 1.0e3_fp ! Ice surface type data Surface(4)%Ice_Type = FRESH_ICE Surface(4)%Ice_Temperature = 260.0_fp @@ -208,7 +208,7 @@ PROGRAM Create_Test_Surface Surface(5)%Snow_Temperature = 265.0_fp Surface(5)%Snow_Depth = 400.0_fp Surface(5)%Snow_Density = 0.1_fp - Surface(5)%Snow_Grain_Size = 0.5_fp + Surface(5)%Snow_Grain_Size = 0.5e3_fp ! Ice surface type data Surface(5)%Ice_Type = FRESH_ICE Surface(5)%Ice_Temperature = 255.0_fp @@ -243,7 +243,7 @@ PROGRAM Create_Test_Surface Surface(6)%Snow_Temperature = 268.0_fp Surface(6)%Snow_Depth = 60.0_fp Surface(6)%Snow_Density = 0.2_fp - Surface(6)%Snow_Grain_Size = 1.0_fp + Surface(6)%Snow_Grain_Size = 1.0e3_fp ! Ice surface type data Surface(6)%Ice_Type = FRESH_ICE Surface(6)%Ice_Temperature = 265.0_fp diff --git a/src/Surface/Surface_ConvertFormat/CRTM_Surface_Define_old.f90 b/src/Surface/Surface_ConvertFormat/CRTM_Surface_Define_old.f90 index 4846d91..da06eea 100644 --- a/src/Surface/Surface_ConvertFormat/CRTM_Surface_Define_old.f90 +++ b/src/Surface/Surface_ConvertFormat/CRTM_Surface_Define_old.f90 @@ -328,7 +328,7 @@ MODULE CRTM_Surface_Define_old REAL(fp), PARAMETER :: DEFAULT_SNOW_TEMPERATURE = 263.0_fp ! K REAL(fp), PARAMETER :: DEFAULT_SNOW_DEPTH = 50.0_fp ! mm REAL(fp), PARAMETER :: DEFAULT_SNOW_DENSITY = 0.2_fp ! g/cm^3 - REAL(fp), PARAMETER :: DEFAULT_SNOW_GRAIN_SIZE = 2.0_fp ! mm + REAL(fp), PARAMETER :: DEFAULT_SNOW_GRAIN_SIZE = 2.0e3_fp ! um (microns) ! Ice surface type data INTEGER, PARAMETER :: DEFAULT_ICE_TYPE = FRESH_ICE REAL(fp), PARAMETER :: DEFAULT_ICE_TEMPERATURE = 263.0_fp ! K diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index eca78f8..04a0666 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -71,15 +71,15 @@ IF(EXISTS ${CMAKE_SOURCE_DIR}/fix) # Download CRTM coefficients else() set( CRTM_COEFFS_BRANCH_PREFIX "crtm" ) #preserves the structure of the paths that have been used in jedi previously vs the local path above - set( CRTM_COEFFS_BRANCH "3.0.0_skylab_4.0" ) #this version is the CRTM version, not the jedi / skylab version (again, following prior installations -- I'm not tied to this in any way) + set( CRTM_COEFFS_BRANCH "3.0.0_skylab_6.0" ) #this version is the CRTM version, not the jedi / skylab version (again, following prior installations -- I'm not tied to this in any way) # it is my intention is to not have any difference between jedi/ufo versions of CRTM and stand-alond versions of CRTM -- they should both work "out of the box" set( CRTM_COEFFS_PATH ${CMAKE_BINARY_DIR}/test_data/${REPO_VERSION}) #this is where the symlinks point to binary files for the testinput/* directory after ecbuild. file(MAKE_DIRECTORY ${CRTM_COEFFS_PATH}) -# set( ECBUILD_DOWNLOAD_BASE_URL https://gdex.ucar.edu/dataset/jedi-skylab ) - set( ECBUILD_DOWNLOAD_BASE_URL ftp://ftp.ssec.wisc.edu/pub/s4/CRTM ) + + set( ECBUILD_DOWNLOAD_BASE_URL https://bin.ssec.wisc.edu/pub/s4/CRTM ) message(STATUS "download CRTM coeffs files from: ${ECBUILD_DOWNLOAD_BASE_URL}/file to ${CRTM_COEFFS_PATH}") ecbuild_get_test_multidata( TARGET get_crtm_coeffs - NAMES crtm_coefficients_${CRTM_COEFFS_BRANCH}.tar.gz:9cf4b1cc57e20802e608a597d7f53073 #i'm assuming these are md5sums, this is the md5sum for crtm_coefficients_3.0.0_skylab_4.0.tar.gz as of March 8, 2023 that was sent to gdex + NAMES crtm_coefficients_${CRTM_COEFFS_BRANCH}.tar.gz:d7ecd29d696e076f68cd5db0d525c683 #12 Aug 2023 // crtm_coefficients_3.0.0_skylab_6.0.tar.gz DIRNAME file DIRLOCAL ${CRTM_COEFFS_PATH} EXTRACT ) @@ -355,32 +355,32 @@ ecbuild_add_test( #(CD) EmisCoeff I/O test -#ecbuild_add_executable ( -# TARGET "test_emis_coeff_io" -# SOURCES mains/unit/input_output/test_EmisCoeff/test_emis_coeff_io.f90 -# LIBS crtm -# NOINSTALL -# ) -#ecbuild_add_test( -# TARGET "Unit_test_emis_coeff_io" -# COMMAND "test_emis_coeff_io" -# OMP $ENV{OMP_NUM_THREADS} -# TEST_DEPENDS get_crtm_coeffs -# ) +ecbuild_add_executable ( + TARGET "test_emis_coeff_io" + SOURCES mains/unit/input_output/test_EmisCoeff/test_emis_coeff_io.f90 + LIBS crtm + NOINSTALL + ) +ecbuild_add_test( + TARGET "Unit_test_emis_coeff_io" + COMMAND "test_emis_coeff_io" + OMP $ENV{OMP_NUM_THREADS} + TEST_DEPENDS get_crtm_coeffs + ) #(CD) EmisCoeff netCDF I/O test -#ecbuild_add_executable ( -# TARGET "test_emis_coeff_io_nc" -# SOURCES mains/unit/input_output/test_EmisCoeff_NC/test_emis_coeff_io_nc.f90 -# LIBS crtm -# NOINSTALL -# ) -#ecbuild_add_test( -# TARGET "Unit_test_emis_coeff_io_nc" -# COMMAND "test_emis_coeff_io_nc" -# OMP $ENV{OMP_NUM_THREADS} -# TEST_DEPENDS get_crtm_coeffs -# ) +ecbuild_add_executable ( + TARGET "test_emis_coeff_io_nc" + SOURCES mains/unit/input_output/test_EmisCoeff_NC/test_emis_coeff_io_nc.f90 + LIBS crtm + NOINSTALL + ) +ecbuild_add_test( + TARGET "Unit_test_emis_coeff_io_nc" + COMMAND "test_emis_coeff_io_nc" + OMP $ENV{OMP_NUM_THREADS} + TEST_DEPENDS get_crtm_coeffs + ) #(PS) Hypsometric Equation test ecbuild_add_executable ( @@ -486,14 +486,26 @@ CloudCoeff/Little_Endian/CloudCoeff.bin CloudCoeff/netCDF/CloudCoeff.nc4 EmisCoeff/MW_Water/Little_Endian/FASTEM6.MWwater.EmisCoeff.bin EmisCoeff/IR_Ice/SEcategory/Little_Endian/NPOESS.IRice.EmisCoeff.bin +EmisCoeff/IR_Ice/SEcategory/netCDF/NPOESS.IRice.EmisCoeff.nc4 EmisCoeff/IR_Land/SEcategory/Little_Endian/NPOESS.IRland.EmisCoeff.bin +EmisCoeff/IR_Land/SEcategory/netCDF/NPOESS.IRland.EmisCoeff.nc4 EmisCoeff/IR_Snow/SEcategory/Little_Endian/NPOESS.IRsnow.EmisCoeff.bin +EmisCoeff/IR_Snow/SEcategory/netCDF/NPOESS.IRsnow.EmisCoeff.nc4 EmisCoeff/IR_Snow/Nalli/Little_Endian/Nalli.IRsnow.EmisCoeff.bin +EmisCoeff/IR_Snow/Nalli/netCDF/Nalli.IRsnow.EmisCoeff.nc4 +EmisCoeff/IR_Snow/Nalli/netCDF/Nalli2.IRsnow.EmisCoeff.nc4 EmisCoeff/VIS_Ice/SEcategory/Little_Endian/NPOESS.VISice.EmisCoeff.bin +EmisCoeff/VIS_Ice/SEcategory/netCDF/NPOESS.VISice.EmisCoeff.nc4 EmisCoeff/VIS_Land/SEcategory/Little_Endian/NPOESS.VISland.EmisCoeff.bin +EmisCoeff/VIS_Land/SEcategory/netCDF/NPOESS.VISland.EmisCoeff.nc4 EmisCoeff/VIS_Snow/SEcategory/Little_Endian/NPOESS.VISsnow.EmisCoeff.bin +EmisCoeff/VIS_Snow/SEcategory/netCDF/NPOESS.VISsnow.EmisCoeff.nc4 EmisCoeff/VIS_Water/SEcategory/Little_Endian/NPOESS.VISwater.EmisCoeff.bin +EmisCoeff/VIS_Water/SEcategory/netCDF/NPOESS.VISwater.EmisCoeff.nc4 EmisCoeff/IR_Water/Little_Endian/Nalli.IRwater.EmisCoeff.bin +EmisCoeff/IR_Water/Little_Endian/Nalli2.IRwater.EmisCoeff.bin +EmisCoeff/IR_Water/netCDF/Nalli.IRwater.EmisCoeff.nc4 +EmisCoeff/IR_Water/netCDF/Nalli2.IRwater.EmisCoeff.nc4 EmisCoeff/IR_Land/SEcategory/Little_Endian/USGS.IRland.EmisCoeff.bin EmisCoeff/VIS_Land/SEcategory/Little_Endian/USGS.VISland.EmisCoeff.bin SpcCoeff/Little_Endian/hirs4_metop-a.SpcCoeff.bin diff --git a/test/mains/unit/input_output/test_AerosolCoeff/test_aerosol_coeff_io.f90 b/test/mains/unit/input_output/test_AerosolCoeff/test_aerosol_coeff_io.f90 index 710c332..b782662 100644 --- a/test/mains/unit/input_output/test_AerosolCoeff/test_aerosol_coeff_io.f90 +++ b/test/mains/unit/input_output/test_AerosolCoeff/test_aerosol_coeff_io.f90 @@ -42,8 +42,8 @@ PROGRAM test_aerosol_coeff_io CHARACTER(*), PARAMETER :: Aerosol_Model = 'CRTM' CHARACTER(*), PARAMETER :: AerosolCoeff_File = 'AerosolCoeff.bin' CHARACTER(*), PARAMETER :: File_Path = './testinput/' - LOGICAL, PARAMETER :: Quiet = .TRUE. LOGICAL, PARAMETER :: netCDF = .FALSE. + LOGICAL, PARAMETER :: Quiet = .TRUE. INTEGER :: err_stat TYPE(UnitTest_type) :: ioTest LOGICAL :: testPassed diff --git a/test/mains/unit/input_output/test_AerosolCoeff_NC/test_aerosol_coeff_io_nc.f90 b/test/mains/unit/input_output/test_AerosolCoeff_NC/test_aerosol_coeff_io_nc.f90 index 97250df..5674c01 100644 --- a/test/mains/unit/input_output/test_AerosolCoeff_NC/test_aerosol_coeff_io_nc.f90 +++ b/test/mains/unit/input_output/test_AerosolCoeff_NC/test_aerosol_coeff_io_nc.f90 @@ -42,8 +42,8 @@ PROGRAM test_aerosol_coeff_io_nc CHARACTER(*), PARAMETER :: Aerosol_Model = 'CRTM' CHARACTER(*), PARAMETER :: AerosolCoeff_File = 'AerosolCoeff.nc4' CHARACTER(*), PARAMETER :: File_Path = './testinput/' - LOGICAL, PARAMETER :: Quiet = .TRUE. LOGICAL, PARAMETER :: netCDF = .TRUE. + LOGICAL, PARAMETER :: Quiet = .TRUE. INTEGER :: err_stat TYPE(UnitTest_type) :: ioTest LOGICAL :: testPassed diff --git a/test/mains/unit/input_output/test_EmisCoeff/test_emis_coeff_io.f90 b/test/mains/unit/input_output/test_EmisCoeff/test_emis_coeff_io.f90 new file mode 100644 index 0000000..da60c22 --- /dev/null +++ b/test/mains/unit/input_output/test_EmisCoeff/test_emis_coeff_io.f90 @@ -0,0 +1,225 @@ +!------------------------------------------------------- +! +! Description: +! Simple test program to inspect the CRTM Coeff files. +! +! Date: 2018-08-14 Author: P. Stegmann + +! MODIFICATION HISTORY: +! ===================== +! +! Author: Date: Description: +! ======= ===== ============ +! Patrick Stegmann 2021-02-05 Refactored as a CRTM +! unit test. +! Cheng Dang 2021-07-28 Modified for Aerosol +! Coeff look-up table +! Cheng Dang 2022-03-14 Modified for EmisCoeff +! look-up table (VIS,IR) +!------------------------------------------------------- + +PROGRAM test_emis_coeff_io + + ! ==================================================== + ! **** ENVIRONMENT SETUP FOR RTM USAGE **** + ! + + ! Module usage + USE UnitTest_Define, ONLY: UnitTest_type, & + UnitTest_Init, & + UnitTest_Setup, & + UnitTest_Assert, & + UnitTest_Passed + ! ...Infrared surface emissivities + USE CRTM_IRwaterCoeff , ONLY: CRTM_IRwaterCoeff_Load + USE CRTM_IRlandCoeff , ONLY: CRTM_IRlandCoeff_Load + USE CRTM_IRsnowCoeff , ONLY: CRTM_IRsnowCoeff_Load + USE CRTM_IRiceCoeff , ONLY: CRTM_IRiceCoeff_Load + ! ...Visible surface emissivities + USE CRTM_VISwaterCoeff , ONLY: CRTM_VISwaterCoeff_Load + USE CRTM_VISlandCoeff , ONLY: CRTM_VISlandCoeff_Load + USE CRTM_VISsnowCoeff , ONLY: CRTM_VISsnowCoeff_Load + USE CRTM_VISiceCoeff , ONLY: CRTM_VISiceCoeff_Load + USE Message_Handler , ONLY: SUCCESS, Display_Message + + ! Disable all implicit typing + IMPLICIT NONE + + ! Data dictionary: + CHARACTER(2000) :: info + CHARACTER(*), PARAMETER :: Default_IRwaterCoeff_File = 'Nalli.IRwater.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Default_IRlandCoeff_File = 'NPOESS.IRland.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Default_IRsnowCoeff_File = 'NPOESS.IRsnow.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Default_IRiceCoeff_File = 'NPOESS.IRice.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Default_VISwaterCoeff_File = 'NPOESS.VISwater.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Default_VISlandCoeff_File = 'NPOESS.VISland.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Default_VISsnowCoeff_File = 'NPOESS.VISsnow.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Default_VISiceCoeff_File = 'NPOESS.VISice.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Optional_IRwaterCoeff_File = 'Nalli2.IRwater.EmisCoeff.bin' + CHARACTER(*), PARAMETER :: Optional_IRsnowCoeff_File = 'Nalli.IRsnow.EmisCoeff.bin' + LOGICAL, PARAMETER :: netCDF = .FALSE. + CHARACTER(*), PARAMETER :: File_Path = './testinput/' + LOGICAL, PARAMETER :: Quiet = .TRUE. + INTEGER :: err_stat + TYPE(UnitTest_type) :: ioTest + LOGICAL :: testPassed + CHARACTER(*), PARAMETER :: Program_Name = 'Test_Emi_Coeff_io' + + ! Initialize Unit test: + CALL UnitTest_Init(ioTest, .TRUE.) + CALL UnitTest_Setup(ioTest, 'Emi_Coeff_IO_Test', Program_Name, .TRUE.) + + ! Greeting: + WRITE(*,*) 'HELLO, THIS IS A TEST CODE TO INSPECT EmisCoeff files in binary format.' + WRITE(*,*) 'test_emi_coeff_io' + WRITE(*,*) 'The following default EmisCoeff files are investigated: ' + + ! Load the default emissivity coefficient look-up table: + WRITE(*,*) '...loading: ', Default_IRlandCoeff_File + err_stat = 3 + err_stat = CRTM_IRlandCoeff_Load( & + Default_IRlandCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRlandCoeff_Load' ,'Error loading IRlandCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_IRwaterCoeff_File + err_stat = 3 + err_stat = CRTM_IRwaterCoeff_Load( & + Default_IRwaterCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRwaterCoeff_Load' ,'Error loading IRwaterCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_IRsnowCoeff_File + err_stat = 3 + err_stat = CRTM_IRsnowCoeff_Load( & + Default_IRsnowCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRsnowCoeff_Load' ,'Error loading IRsnowCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_IRiceCoeff_File + err_stat = 3 + err_stat = CRTM_IRiceCoeff_Load( & + Default_IRiceCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRiceCoeff_Load' ,'Error loading IRiceCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISlandCoeff_File + err_stat = 3 + err_stat = CRTM_VISlandCoeff_Load( & + Default_IRiceCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISlandCoeff_Load' ,'Error loading VISlandCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISwaterCoeff_File + err_stat = 3 + err_stat = CRTM_VISwaterCoeff_Load( & + Default_VISwaterCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISwaterCoeff_Load' ,'Error loading VISwaterCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISsnowCoeff_File + err_stat = 3 + err_stat = CRTM_VISsnowCoeff_Load( & + Default_VISsnowCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISsnowCoeff_Load' ,'Error loading VISsnowCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISiceCoeff_File + err_stat = 3 + err_stat = CRTM_VISiceCoeff_Load( & + Default_VISiceCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISiceCoeff_Load' ,'Error loading VISiceCoeff data', err_stat ) + STOP 1 + END IF + + ! Greeting: + WRITE(*,*) 'The following optional EmisCoeff files are investigated: ' + + ! Load the optional emissivity coefficient look-up table: + WRITE(*,*) '...loading: ', Optional_IRwaterCoeff_File + err_stat = 3 + err_stat = CRTM_IRwaterCoeff_Load( & + Optional_IRwaterCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRwaterCoeff_Load' ,'Error loading IRwaterCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Optional_IRsnowCoeff_File + err_stat = 3 + err_stat = CRTM_IRsnowCoeff_Load( & + Optional_IRsnowCoeff_File, & + netCDF = netCDF, & + isSEcategory = .FALSE., & + Quiet = Quiet, & + File_Path = File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRsnowCoeff_Load' ,'Error loading IRsnowCoeff data', err_stat ) + STOP 1 + END IF + STOP 0 + + +END PROGRAM test_emis_coeff_io diff --git a/test/mains/unit/input_output/test_EmisCoeff_NC/test_emis_coeff_io_nc.f90 b/test/mains/unit/input_output/test_EmisCoeff_NC/test_emis_coeff_io_nc.f90 new file mode 100644 index 0000000..7db2c96 --- /dev/null +++ b/test/mains/unit/input_output/test_EmisCoeff_NC/test_emis_coeff_io_nc.f90 @@ -0,0 +1,240 @@ +!------------------------------------------------------- +! +! Description: +! Simple test program to inspect the CRTM Coeff files. +! +! Date: 2018-08-14 Author: P. Stegmann + +! MODIFICATION HISTORY: +! ===================== +! +! Author: Date: Description: +! ======= ===== ============ +! Patrick Stegmann 2021-02-05 Refactored as a CRTM +! unit test. +! Cheng Dang 2021-07-28 Modified for Aerosol +! Coeff look-up table +! Cheng Dang 2022-03-14 Modified for EmisCoeff +! look-up table (VIS,IR) +!------------------------------------------------------- + +PROGRAM test_emis_coeff_io_nc + + ! ==================================================== + ! **** ENVIRONMENT SETUP FOR RTM USAGE **** + ! + + ! Module usage + USE UnitTest_Define, ONLY: UnitTest_type, & + UnitTest_Init, & + UnitTest_Setup, & + UnitTest_Assert, & + UnitTest_Passed + ! ...Infrared surface emissivities + USE CRTM_IRwaterCoeff , ONLY: CRTM_IRwaterCoeff_Load + USE CRTM_IRlandCoeff , ONLY: CRTM_IRlandCoeff_Load + USE CRTM_IRsnowCoeff , ONLY: CRTM_IRsnowCoeff_Load + USE CRTM_IRiceCoeff , ONLY: CRTM_IRiceCoeff_Load + ! ...Visible surface emissivities + USE CRTM_VISwaterCoeff , ONLY: CRTM_VISwaterCoeff_Load + USE CRTM_VISlandCoeff , ONLY: CRTM_VISlandCoeff_Load + USE CRTM_VISsnowCoeff , ONLY: CRTM_VISsnowCoeff_Load + USE CRTM_VISiceCoeff , ONLY: CRTM_VISiceCoeff_Load + USE Message_Handler , ONLY: SUCCESS, Display_Message + + ! Disable all implicit typing + IMPLICIT NONE + + ! Data dictionary: + CHARACTER(2000) :: info + CHARACTER(*), PARAMETER :: Default_IRwaterCoeff_File = 'Nalli.IRwater.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Default_IRlandCoeff_File = 'NPOESS.IRland.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Default_IRsnowCoeff_File = 'NPOESS.IRsnow.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Default_IRiceCoeff_File = 'NPOESS.IRice.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Default_VISwaterCoeff_File = 'NPOESS.VISwater.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Default_VISlandCoeff_File = 'NPOESS.VISland.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Default_VISsnowCoeff_File = 'NPOESS.VISsnow.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Default_VISiceCoeff_File = 'NPOESS.VISice.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Optional_IRwaterCoeff_File = 'Nalli2.IRwater.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Optional_IRsnowCoeff_File = 'Nalli.IRsnow.EmisCoeff.nc4' + CHARACTER(*), PARAMETER :: Optional_IRsnowCoeff_File_Nalli2 = 'Nalli2.IRsnow.EmisCoeff.nc4' + LOGICAL, PARAMETER :: netCDF = .TRUE. + CHARACTER(*), PARAMETER :: NC_File_Path = './testinput/' + LOGICAL, PARAMETER :: Quiet = .TRUE. + INTEGER :: err_stat + TYPE(UnitTest_type) :: ioTest + LOGICAL :: testPassed + CHARACTER(*), PARAMETER :: Program_Name = 'Test_Emi_Coeff_io_nc' + + ! Initialize Unit test: + CALL UnitTest_Init(ioTest, .TRUE.) + CALL UnitTest_Setup(ioTest, 'Emi_Coeff_IO_Test', Program_Name, .TRUE.) + + ! Greeting: + WRITE(*,*) 'HELLO, THIS IS A TEST CODE TO INSPECT EmisCoeff files in netCDF format.' + WRITE(*,*) 'test_emi_coeff_io_nc' + WRITE(*,*) 'The following optional EmisCoeff files are investigated: ' + + ! Load the default emissivity coefficient look-up table: + WRITE(*,*) '...loading: ', Default_IRlandCoeff_File + err_stat = 3 + err_stat = CRTM_IRlandCoeff_Load( & + Default_IRlandCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRlandCoeff_Load' ,'Error loading IRlandCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_IRwaterCoeff_File + err_stat = 3 + err_stat = CRTM_IRwaterCoeff_Load( & + Default_IRwaterCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRwaterCoeff_Load' ,'Error loading IRwaterCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_IRsnowCoeff_File + err_stat = 3 + err_stat = CRTM_IRsnowCoeff_Load( & + Default_IRsnowCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRsnowCoeff_Load' ,'Error loading IRsnowCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_IRiceCoeff_File + err_stat = 3 + err_stat = CRTM_IRiceCoeff_Load( & + Default_IRiceCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRiceCoeff_Load' ,'Error loading IRiceCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISlandCoeff_File + err_stat = 3 + err_stat = CRTM_VISlandCoeff_Load( & + Default_IRiceCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISlandCoeff_Load' ,'Error loading VISlandCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISwaterCoeff_File + err_stat = 3 + err_stat = CRTM_VISwaterCoeff_Load( & + Default_VISwaterCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISwaterCoeff_Load' ,'Error loading VISwaterCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISsnowCoeff_File + err_stat = 3 + err_stat = CRTM_VISsnowCoeff_Load( & + Default_VISsnowCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISsnowCoeff_Load' ,'Error loading VISsnowCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Default_VISiceCoeff_File + err_stat = 3 + err_stat = CRTM_VISiceCoeff_Load( & + Default_VISiceCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_VISiceCoeff_Load' ,'Error loading VISiceCoeff data', err_stat ) + STOP 1 + END IF + + ! Greeting: + WRITE(*,*) 'The following optional EmisCoeff files are investigated: ' + + ! Load the optional emissivity coefficient look-up table: + WRITE(*,*) '...loading: ', Optional_IRwaterCoeff_File + err_stat = 3 + err_stat = CRTM_IRwaterCoeff_Load( & + Optional_IRwaterCoeff_File, & + netCDF = netCDF, & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRwaterCoeff_Load' ,'Error loading IRwaterCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Optional_IRsnowCoeff_File + err_stat = 3 + err_stat = CRTM_IRsnowCoeff_Load( & + Optional_IRsnowCoeff_File, & + netCDF = netCDF, & + isSEcategory = .FALSE., & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRsnowCoeff_Load' ,'Error loading IRsnowCoeff data', err_stat ) + STOP 1 + END IF + + WRITE(*,*) '...loading: ', Optional_IRsnowCoeff_File_Nalli2 + err_stat = 3 + err_stat = CRTM_IRsnowCoeff_Load( & + Optional_IRsnowCoeff_File_Nalli2, & + netCDF = netCDF, & + isSEcategory = .FALSE., & + Quiet = Quiet, & + File_Path = NC_File_Path) + CALL UnitTest_Assert(ioTest, (err_stat==SUCCESS) ) + testPassed = UnitTest_Passed(ioTest) + IF ( err_stat /= SUCCESS ) THEN + CALL Display_Message( 'CRTM_IRsnowCoeff_Load' ,'Error loading IRsnowCoeff data', err_stat ) + STOP 1 + END IF + STOP 0 + +END PROGRAM test_emis_coeff_io_nc