From 5d20f4773bfcd380f40909946496758a15a72db2 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 1 Feb 2021 13:22:56 -0500 Subject: [PATCH 01/64] Added new JULES multi-layer snow variables for PS41 support. Code compiles, but not tested yet. --- lvt/core/LVT_LISoutputHandlerMod.F90 | 169 +++++++++++++++++++++++++++ 1 file changed, 169 insertions(+) diff --git a/lvt/core/LVT_LISoutputHandlerMod.F90 b/lvt/core/LVT_LISoutputHandlerMod.F90 index 5158dfa69..35b532766 100644 --- a/lvt/core/LVT_LISoutputHandlerMod.F90 +++ b/lvt/core/LVT_LISoutputHandlerMod.F90 @@ -419,6 +419,17 @@ module LVT_LISoutputHandlerMod integer :: LVT_LIS_MOC_RTM_COUNT(3) integer :: LVT_LIS_MOC_IRRIG_COUNT(3) + ! New variables for JULES 5.0 for PS41 (multi-layer snow) + integer :: LVT_LIS_MOC_SURFT_SNOW(3) = -9999 + integer :: LVT_LIS_MOC_GRND_SNOW(3) = -9999 + integer :: LVT_LIS_MOC_SOOT(3) = -9999 + integer :: LVT_LIS_MOC_SNOWGRAIN(3) = -9999 + integer :: LVT_LIS_MOC_SNOWDENSITY(3) = -9999 + integer :: LVT_LIS_MOC_SNOW_NLAYER(3) = -9999 + integer :: LVT_LIS_MOC_LAYERSNOWDEPTH(3) = -9999 + integer :: LVT_LIS_MOC_SNOWLIQ(3) = -9999 + integer :: LVT_LIS_MOC_LAYERSNOWDENSITY(3) = -9999 + integer :: LVT_LIS_MOC_LAYERSNOWGRAIN(3) = -9999 #if 0 ! SPECIAL CASE INDICES @@ -3621,6 +3632,164 @@ subroutine LVT_LISoutputInit() valid_min=(/-9999.0/),valid_max=(/-9999.0/),gribSFC=1,gribLvl=1) endif + !EMK...Added JULES variables for PS41 (multi-layer snow physics) + call ESMF_ConfigFindLabel(modelSpecConfig, "SurftSnow:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "SurftSnow",& + "snow_amount_on_tile",& + "snow amount on tile", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SURFT_SNOW(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"kg m-2"/),1,(/"-"/),valid_min=(/0.0/), & + valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "GrndSnow:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "GrndSnow",& + "snow_on_ground_beneath_canopy",& + "snow on ground (beneath canopy)", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_GRND_SNOW(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"kg m-2"/),1,(/"-"/),valid_min=(/0.0/), & + valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "SnowSoot:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "SnowSoot",& + "snow_soot_content",& + "snow soot content", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SOOT(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"kg kg-1"/),1,(/"-"/),valid_min=(/0.0/), & + valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "SnowGrain:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "SnowGrain",& + "snow_grain_size",& + "snow grain size", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SNOWGRAIN(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"micron"/),1,(/"-"/),valid_min=(/0.0/), & + valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "SnowDensity:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "SnowDensity",& + "bulk_snow_density",& + "bulk snow density", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SNOWDENSITY(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"kg m-3"/),1,(/"-"/),valid_min=(/0.0/), & + valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "ActSnowNL:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "ActSnowNL",& + "actual_number_of_snow_layers",& + "actual number of snow layers", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SNOW_NLAYER(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"-"/),1,(/"-"/),valid_min=(/0./), & + valid_max=(/3./),gribSFC=1,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "LayerSnowDepth:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "LayerSnowDepth",& + "snow_depth_for_each_layer",& + "snow_depth_for_each_layer", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_LAYERSNOWDEPTH(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 3, & + nsize,nensem,(/"m ", "cm", "mm"/),1,(/"-"/), & + valid_min=(/0., 0., 0./), & + valid_max=(/3., 300., 3000./),gribSFC=114,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "SnowLiq:", rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "SnowLiq",& + "snow-layer_liquid_water",& + "snow-layer liquid water", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SNOWLIQ(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 2, & + nsize,nensem,(/"kg/m2", "mm "/),1,(/"-"/), & + valid_min=(/0., 0./), & + valid_max=(/2000.0, 2.0/),gribSFC=114,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "LayerSnowDensity:", & + rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "LayerSnowDensity",& + "snow_density_for_each_layer",& + "snow density for each layer", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_LAYERSNOWDENSITY(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"kg/m3"/),1,(/"-"/), & + valid_min=(/0./), & + valid_max=(/2000.0/),gribSFC=114,gribLvl=1) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig, "LayerSnowGrain:", & + rc=rc) + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list, & + "LayerSnowGrain",& + "layer_snow_grain_size_for_each_layer",& + "snow grain size for each layer", "F", rc) + if (rc .eq. 1) then + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_LAYERSNOWGRAIN(kk), & + LVT_LISoutput(kk)%head_lsm_list, & + 1, & + nsize,nensem,(/"micron"/),1,(/"-"/), & + valid_min=(/0./), & + valid_max=(/2000.0/),gribSFC=114,gribLvl=1) + endif + !EMK END + !EMK...Correct name of minimum Tair variable. call ESMF_ConfigFindLabel(modelSpecConfig,"Tair_f_min:",rc=rc) call get_moc_attributes(modelSpecConfig,LVT_LISoutput(kk)%head_lsm_list,& From 38ade20952511abc572ad05e9934eb9549645a67 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 2 Feb 2021 17:18:24 -0500 Subject: [PATCH 02/64] Bug fixes to read select JULES 5.0 snow fields. --- lvt/core/LVT_LISoutputHandlerMod.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/lvt/core/LVT_LISoutputHandlerMod.F90 b/lvt/core/LVT_LISoutputHandlerMod.F90 index 35b532766..c9c969f2a 100644 --- a/lvt/core/LVT_LISoutputHandlerMod.F90 +++ b/lvt/core/LVT_LISoutputHandlerMod.F90 @@ -3644,7 +3644,7 @@ subroutine LVT_LISoutputInit() LVT_LIS_MOC_SURFT_SNOW(kk), & LVT_LISoutput(kk)%head_lsm_list, & 1, & - nsize,nensem,(/"kg m-2"/),1,(/"-"/),valid_min=(/0.0/), & + nsize,nensem,(/"kg/m2"/),1,(/"-"/),valid_min=(/0.0/), & valid_max=(/1200.0/),gribSFC=1,gribLvl=1) endif @@ -3767,7 +3767,7 @@ subroutine LVT_LISoutputInit() LVT_LIS_MOC_LAYERSNOWDENSITY(kk), & LVT_LISoutput(kk)%head_lsm_list, & 1, & - nsize,nensem,(/"kg/m3"/),1,(/"-"/), & + nsize,nensem,(/"kg m-3"/),1,(/"-"/), & valid_min=(/0./), & valid_max=(/2000.0/),gribSFC=114,gribLvl=1) endif @@ -10722,6 +10722,16 @@ subroutine mapLISdataToLVT(source,lvtdataEntry, lisdataEntry) elseif(lvtdataEntry%units.eq."W/m2".and.& lisdataEntry%units.eq."kg/m2s") then scale_f = LVT_CONST_LATVAP + !EMK HACKS + elseif(lvtdataEntry%units.eq."kg/m2".and.& + lisdataEntry%units.eq."kg m-2") then + scale_f = 1.0 + elseif(lvtdataEntry%units.eq."kg/m3".and.& + lisdataEntry%units.eq."kg m-3") then + scale_f = 1.0 + elseif(lvtdataEntry%units.eq."microns".and.& + lisdataEntry%units.eq."micron") then + scale_f = 1.0 else write(LVT_logunit,*) '[ERR] The units of the ' write(LVT_logunit,*) '[ERR] LIS output and the analysis' From 76acca0c6f9d34b0730ba10b79ef4e5d381c9e2c Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 2 Feb 2021 17:21:46 -0500 Subject: [PATCH 03/64] First attempt at postprocessing JULES multi-layer snow for GALWEM. TODO: * Update LVT to better handle number of snow layers. * Update run_ncks.py. * Update convert_nc2surf.py. * Update cat_lvt_grib2.py. * Port changes to scripts for Koehr. --- ...UT_LIST.TBL.lvt_557post.ActSnowNL_inst.3hr | 1 + ...PUT_LIST.TBL.lvt_557post.GrndSnow_inst.3hr | 1 + ....TBL.lvt_557post.LayerSnowDensity_inst.3hr | 2 + ...ST.TBL.lvt_557post.LayerSnowDepth_inst.3hr | 2 + ...ST.TBL.lvt_557post.LayerSnowGrain_inst.3hr | 2 + ..._LIST.TBL.lvt_557post.SnowDensity_inst.3hr | 1 + ...UT_LIST.TBL.lvt_557post.SnowGrain_inst.3hr | 1 + ...TPUT_LIST.TBL.lvt_557post.SnowIce_inst.3hr | 2 + ...TPUT_LIST.TBL.lvt_557post.SnowLiq_inst.3hr | 2 + ...PUT_LIST.TBL.lvt_557post.SnowSoot_inst.3hr | 1 + ...UT_LIST.TBL.lvt_557post.SnowTProf_inst.3hr | 1 + ...UT_LIST.TBL.lvt_557post.SurftSnow_inst.3hr | 1 + .../templates/make_lvt_config_3hr_jules.py | 83 +++++++++++++++++-- .../submit_lvt_discover_3hr_jules.py | 22 ++++- 14 files changed, 111 insertions(+), 11 deletions(-) create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.ActSnowNL_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.GrndSnow_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDensity_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDepth_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowGrain_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowDensity_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowGrain_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowIce_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowLiq_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowSoot_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowTProf_inst.3hr create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SurftSnow_inst.3hr diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.ActSnowNL_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.ActSnowNL_inst.3hr new file mode 100644 index 000000000..f66a28207 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.ActSnowNL_inst.3hr @@ -0,0 +1 @@ +ActSnowNL: 1 "-" - 0 0 0 1 255 1000 0 1 # Actual number of snow layers diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.GrndSnow_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.GrndSnow_inst.3hr new file mode 100644 index 000000000..d54b2cfb5 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.GrndSnow_inst.3hr @@ -0,0 +1 @@ +GrndSnow: 1 "kg m-2" - 0 0 0 1 66 1000 0 1 # Snow on ground beneath canopy diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDensity_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDensity_inst.3hr new file mode 100644 index 000000000..83d3e7a0d --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDensity_inst.3hr @@ -0,0 +1,2 @@ +LayerSnowDensity: 1 "kg m-3" - 0 0 0 3 61 1000 0 1 # Snow density for each layer + diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDepth_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDepth_inst.3hr new file mode 100644 index 000000000..d7f226fc1 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowDepth_inst.3hr @@ -0,0 +1,2 @@ +LayerSnowDepth: 1 "m" - 0 0 0 3 11 1000 0 1 # Snow depth for each layer + diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowGrain_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowGrain_inst.3hr new file mode 100644 index 000000000..5700d5e3e --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.LayerSnowGrain_inst.3hr @@ -0,0 +1,2 @@ +LayerSnowGrain: 1 "micron" - 0 0 0 3 255 1000 0 1 # Snow grain size for each layer + diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowDensity_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowDensity_inst.3hr new file mode 100644 index 000000000..b26ee4e06 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowDensity_inst.3hr @@ -0,0 +1 @@ +SnowDensity: 1 "kg m-3" - 0 0 0 1 255 1000 0 1 # Snow density diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowGrain_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowGrain_inst.3hr new file mode 100644 index 000000000..6c0255533 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowGrain_inst.3hr @@ -0,0 +1 @@ +SnowGrain: 1 "micron" - 0 0 0 1 255 1000 0 1 # Snow grain size diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowIce_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowIce_inst.3hr new file mode 100644 index 000000000..43f1c4e02 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowIce_inst.3hr @@ -0,0 +1,2 @@ +SnowIce: 1 "kg/m2" - 0 0 0 3 255 1000 0 1 # Snow layer ice + diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowLiq_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowLiq_inst.3hr new file mode 100644 index 000000000..8ddabf9eb --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowLiq_inst.3hr @@ -0,0 +1,2 @@ +SnowLiq: 1 "kg/m2" - 0 0 0 3 16 1000 0 1 # Snow layer liquid water + diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowSoot_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowSoot_inst.3hr new file mode 100644 index 000000000..f55bae0f4 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowSoot_inst.3hr @@ -0,0 +1 @@ +SnowSoot: 1 "kg kg-1" - 0 0 0 1 255 1000 0 1 # Snow soot content diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowTProf_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowTProf_inst.3hr new file mode 100644 index 000000000..f7f9e4853 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SnowTProf_inst.3hr @@ -0,0 +1 @@ +SnowTProf: 1 "K" - 0 0 0 3 1 1000 0 1 # Snow temperature profile diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SurftSnow_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SurftSnow_inst.3hr new file mode 100644 index 000000000..acf34891e --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.SurftSnow_inst.3hr @@ -0,0 +1 @@ +SurftSnow: 1 "kg/m2" - 0 0 0 1 66 1000 0 1 # Snow amount on tile diff --git a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py index 955c8e447..bd24af1bd 100755 --- a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py +++ b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py @@ -16,8 +16,8 @@ template = "template/lvt.config.template.jules50" -startdt = datetime.datetime(2007, 12, 1, 0) -enddt = datetime.datetime(2007, 12, 2, 0) +startdt = datetime.datetime(2018, 12, 1, 9) +enddt = datetime.datetime(2018, 12, 1, 12) output = "netcdf" #output = "grib2" @@ -94,6 +94,64 @@ "Wind_f 1 1 m/s - 0 1 Wind_f 1 1 m/s - 0 1", "Wind_f_tavg": "Wind_f 1 1 m/s - 1 1 Wind_f 1 1 m/s - 1 1", + + "SurftSnow_inst": + "SurftSnow 1 1 kg/m2 - 0 1 SurftSnow 1 1 kg/m2 - 0 1", + "GrndSnow_inst": + "GrndSnow 1 1 kg/m2 - 0 1 GrndSnow 1 1 kg/m2 - 0 1", + "SnowSoot_inst": + "SnowSoot 1 1 'kg kg-1' - 0 1 SnowSoot 1 1 'kg kg-1' - 0 1", + "SnowGrain_inst": + "SnowGrain 1 1 microns - 0 1 SnowGrain 1 1 microns - 0 1", + "SnowDensity_inst": + "SnowDensity 1 1 kg/m3 - 0 1 SnowDensity 1 1 kg/m3 - 0 1", + "ActSnowNL_inst": + "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", + "LayerSnowDepth_inst": + "LayerSnowDepth 1 1 m - 0 3 LayerSnowDepth 1 1 m - 0 3", + "SnowIce_inst": + "SnowIce 1 1 kg/m2 - 0 3 SnowIce 1 1 kg/m2 - 0 3", + "SnowLiq_inst": + "SnowLiq 1 1 kg/m2 - 0 3 SnowLiq 1 1 kg/m2 - 0 3", + "SnowTProf_inst": + "SnowTProf 1 1 K - 0 3 SnowTProf 1 1 K - 0 3", + "LayerSnowDensity_inst": + "LayerSnowDensity 1 1 kg/m3 - 0 3 LayerSnowDensity 1 1 kg/m3 - 0 3", + "LayerSnowGrain_inst": + "LayerSnowGrain 1 1 microns - 0 3 LayerSnowGrain 1 1 microns - 0 3", + +} + +# EMK FOR GALWEM TESTING +var_attributes = { + "ActSnowNL_inst": + "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", + "GrndSnow_inst": + "GrndSnow 1 1 kg/m2 - 0 1 GrndSnow 1 1 kg/m2 - 0 1", + "LayerSnowDensity_inst": + "LayerSnowDensity 1 1 kg/m3 - 0 3 LayerSnowDensity 1 1 kg/m3 - 0 3", + "LayerSnowDepth_inst": + "LayerSnowDepth 1 1 m - 0 3 LayerSnowDepth 1 1 m - 0 3", + "LayerSnowGrain_inst": + "LayerSnowGrain 1 1 microns - 0 3 LayerSnowGrain 1 1 microns - 0 3", + "SnowDepth_inst": + "SnowDepth 1 1 m - 0 1 SnowDepth 1 1 m - 0 1", + "SnowDensity_inst": + "SnowDensity 1 1 kg/m3 - 0 1 SnowDensity 1 1 kg/m3 - 0 1", + "SnowGrain_inst": + "SnowGrain 1 1 microns - 0 1 SnowGrain 1 1 microns - 0 1", + "SnowIce_inst": + "SnowIce 1 1 kg/m2 - 0 3 SnowIce 1 1 kg/m2 - 0 3", + "SnowLiq_inst": + "SnowLiq 1 1 kg/m2 - 0 3 SnowLiq 1 1 kg/m2 - 0 3", + "SnowSoot_inst": + "SnowSoot 1 1 'kg kg-1' - 0 1 SnowSoot 1 1 'kg kg-1' - 0 1", + "SnowTProf_inst": + "SnowTProf 1 1 K - 0 3 SnowTProf 1 1 K - 0 3", + "SurftSnow_inst": + "SurftSnow 1 1 kg/m2 - 0 1 SurftSnow 1 1 kg/m2 - 0 1", + "SWE_inst": + "SWE 1 1 kg/m2 - 0 1 SWE 1 1 kg/m2 - 0 1", } # RHMin must be processed with Tair_f_min, so these are listed together @@ -118,12 +176,20 @@ "SWdown_f_tavg", "SWE_inst", "Tair_f_inst", "Tair_f_max", "Tair_f_tavg", "TotalPrecip_acc", - "Tair_f_min", "RHMin_inst"] + "Tair_f_min", "RHMin_inst", + + "SurftSnow_inst", "GrndSnow_inst", + "SnowSoot_inst", "SnowGrain_inst", + "SnowDensity_inst", "ActSnowNL_inst", + "LayerSnowDepth_inst", "SnowIce_inst", + "SnowLiq_inst", "SnowTProf_inst", + "LayerSnowDensity_inst", "LayerSnowGrain_inst" ] + lines = open(template, 'r').readlines() vars = list(var_attributes.keys()) -vars.append("RHMin_inst") # RHMin will be handled specially below +#vars.append("RHMin_inst") # RHMin will be handled specially below vars.sort() firstVar = True for var in vars: @@ -132,10 +198,11 @@ if "LVT output format:" in line: line = "LVT output format: %s\n" % (output) elif "Process HYCOM data:" in line: - if firstVar: - line = "Process HYCOM data: 1\n" - else: - line = "Process HYCOM data: 0\n" + #if firstVar: + # line = "Process HYCOM data: 1\n" + #else: + # line = "Process HYCOM data: 0\n" + line = "Process HYCOM data: 0\n" elif "Apply noise reduction filter:" in line: if var in smooth_vars: line = "Apply noise reduction filter: 1\n" diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py index 29a9d2aaf..d9d23efb6 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py @@ -32,8 +32,24 @@ 'SnowDepth_inst', 'Snowcover_inst', 'Tair_f_inst', 'Tair_f_max', 'Tair_f_tavg', - 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg'] + 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg', + 'ActSnowNL_inst', 'GrndSnow_inst', + 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', + 'LayerSnowGrain_inst', 'SnowDensity_inst', + 'SnowGrain_inst', 'SnowIce_inst', + 'SnowLiq_inst', 'SnowSoot_inst', + 'SnowTProf_inst', 'SurftSnow_inst'] + +# EMK GALWEM TESTING +vars = ['ActSnowNL_inst', 'GrndSnow_inst', + 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', + 'LayerSnowGrain_inst', 'SnowDensity_inst', + 'SnowDepth_inst', + 'SnowGrain_inst', 'SnowIce_inst', + 'SnowLiq_inst', 'SnowSoot_inst', + 'SnowTProf_inst', 'SurftSnow_inst', + 'SWE_inst'] if not os.path.exists("LVT"): print("ERROR, LVT executable does not exist!") @@ -48,7 +64,7 @@ #SBATCH --account s1189 #SBATCH --output %s.3hr.slurm.out #Adjust node, core, and hardware constraints here -#SBATCH --ntasks=1 --constraint=hasw +#SBATCH --ntasks=1 if [ ! -z $SLURM_SUBMIT_DIR ] ; then cd $SLURM_SUBMIT_DIR || exit 1 @@ -56,7 +72,7 @@ module purge module use --append ~/privatemodules -module load lisf_7_intel_19_1_0_166 +module load lisf_7_intel_19_1_3_304_traceback-work-around if [ ! -e ./LVT ] ; then echo "ERROR, LVT does not exist!" && exit 1 From 855afb845def616a53ef9a3245e6688b359a9d0f Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Wed, 3 Feb 2021 13:55:34 -0500 Subject: [PATCH 04/64] Additional fixes to permitted max/min values for JULES multi-layer snow vars. --- lvt/core/LVT_LISoutputHandlerMod.F90 | 48 ++++++++++++++++------------ 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/lvt/core/LVT_LISoutputHandlerMod.F90 b/lvt/core/LVT_LISoutputHandlerMod.F90 index c9c969f2a..2ad812a9e 100644 --- a/lvt/core/LVT_LISoutputHandlerMod.F90 +++ b/lvt/core/LVT_LISoutputHandlerMod.F90 @@ -1138,20 +1138,26 @@ subroutine LVT_LISoutputInit() "liquid_water_content_of_surface_snow",& "snow water equivalent","F",rc) if(rc.eq.1) then - call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk),LVT_LIS_MOC_SWE(kk),& + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SWE(kk),& LVT_LISoutput(kk)%head_lsm_list,2,nsize,nensem,& (/"kg/m2","m "/),1,(/"-"/),& - valid_min=(/0.0,0.0/),valid_max=(/2000.0,2.0/),gribSFC=1,gribLvl=1) + valid_min=(/0.0,0.0/),valid_max=(/10000.0,10.0/), & + gribSFC=1,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig,"SnowDepth:",rc=rc) - call get_moc_attributes(modelSpecConfig, LVT_LISoutput(kk)%head_lsm_list,& + call get_moc_attributes(modelSpecConfig, & + LVT_LISoutput(kk)%head_lsm_list,& "SnowDepth","snow_depth","snow depth","F",rc) if(rc.eq.1) then - call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk),LVT_LIS_MOC_SNOWDEPTH(kk),& + call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk), & + LVT_LIS_MOC_SNOWDEPTH(kk),& LVT_LISoutput(kk)%head_lsm_list,& 3,nsize,nensem,(/"m ","cm","mm"/),1,(/"-"/),& - valid_min=(/0.0/),valid_max=(/10.0/),gribSFC=1,gribLvl=1) + valid_min=(/0.0, 0.0, 0.0/), & + valid_max=(/100.0, 10000.0, 100000.0/), & + gribSFC=1,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig,"SnowIce:",rc=rc) @@ -1163,7 +1169,8 @@ subroutine LVT_LISoutputInit() call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk),LVT_LIS_MOC_SNOWICE(kk),& LVT_LISoutput(kk)%head_lsm_list,2,nsize,nensem,& (/"kg/m2","mm "/),1,(/"-"/),& - valid_min=(/0.0,0.0/),valid_max=(/2000.0,2.0/),gribSFC=1,gribLvl=1) + valid_min=(/0.0,0.0/),valid_max=(/20000.0, 20000.0/), & + gribSFC=1,gribLvl=1) endif @@ -1485,7 +1492,8 @@ subroutine LVT_LISoutputInit() call register_dataEntry(LVT_LIS_MOC_LSM_COUNT(kk),LVT_LIS_MOC_SNOWTPROF(kk),& LVT_LISoutput(kk)%head_lsm_list,& 1,nsize,nensem,(/"K"/),1,(/"-"/),& - valid_min=(/0.0/),valid_max=(/1.0/),gribSFC=grib_snowlvl,gribLvl=0) + valid_min=(/100.0/),valid_max=(/273.15/),& + gribSFC=grib_snowlvl,gribLvl=0) endif call ESMF_ConfigFindLabel(modelSpecConfig,"SLiqFrac:",rc=rc) @@ -3645,7 +3653,7 @@ subroutine LVT_LISoutputInit() LVT_LISoutput(kk)%head_lsm_list, & 1, & nsize,nensem,(/"kg/m2"/),1,(/"-"/),valid_min=(/0.0/), & - valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + valid_max=(/10000.0/),gribSFC=1,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig, "GrndSnow:", rc=rc) @@ -3660,7 +3668,7 @@ subroutine LVT_LISoutputInit() LVT_LISoutput(kk)%head_lsm_list, & 1, & nsize,nensem,(/"kg m-2"/),1,(/"-"/),valid_min=(/0.0/), & - valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + valid_max=(/1000.0/),gribSFC=1,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig, "SnowSoot:", rc=rc) @@ -3689,8 +3697,8 @@ subroutine LVT_LISoutputInit() LVT_LIS_MOC_SNOWGRAIN(kk), & LVT_LISoutput(kk)%head_lsm_list, & 1, & - nsize,nensem,(/"micron"/),1,(/"-"/),valid_min=(/0.0/), & - valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + nsize,nensem,(/"micron"/),1,(/"-"/),valid_min=(/50.0/), & + valid_max=(/2000.0/),gribSFC=1,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig, "SnowDensity:", rc=rc) @@ -3704,8 +3712,8 @@ subroutine LVT_LISoutputInit() LVT_LIS_MOC_SNOWDENSITY(kk), & LVT_LISoutput(kk)%head_lsm_list, & 1, & - nsize,nensem,(/"kg m-3"/),1,(/"-"/),valid_min=(/0.0/), & - valid_max=(/1200.0/),gribSFC=1,gribLvl=1) + nsize,nensem,(/"kg m-3"/),1,(/"-"/),valid_min=(/100.0/), & + valid_max=(/1000.0/),gribSFC=1,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig, "ActSnowNL:", rc=rc) @@ -3736,7 +3744,7 @@ subroutine LVT_LISoutputInit() 3, & nsize,nensem,(/"m ", "cm", "mm"/),1,(/"-"/), & valid_min=(/0., 0., 0./), & - valid_max=(/3., 300., 3000./),gribSFC=114,gribLvl=1) + valid_max=(/100., 10000., 100000./),gribSFC=114,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig, "SnowLiq:", rc=rc) @@ -3752,7 +3760,7 @@ subroutine LVT_LISoutputInit() 2, & nsize,nensem,(/"kg/m2", "mm "/),1,(/"-"/), & valid_min=(/0., 0./), & - valid_max=(/2000.0, 2.0/),gribSFC=114,gribLvl=1) + valid_max=(/20000.0, 20000.0/),gribSFC=114,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig, "LayerSnowDensity:", & @@ -3769,7 +3777,7 @@ subroutine LVT_LISoutputInit() 1, & nsize,nensem,(/"kg m-3"/),1,(/"-"/), & valid_min=(/0./), & - valid_max=(/2000.0/),gribSFC=114,gribLvl=1) + valid_max=(/1000.0/),gribSFC=114,gribLvl=1) endif call ESMF_ConfigFindLabel(modelSpecConfig, "LayerSnowGrain:", & @@ -3785,7 +3793,7 @@ subroutine LVT_LISoutputInit() LVT_LISoutput(kk)%head_lsm_list, & 1, & nsize,nensem,(/"micron"/),1,(/"-"/), & - valid_min=(/0./), & + valid_min=(/50./), & valid_max=(/2000.0/),gribSFC=114,gribLvl=1) endif !EMK END @@ -4757,9 +4765,9 @@ subroutine readLISModelOutput(lsmoutfile, source, wout, wopt) swe_calc%value(gid,m,1) = & swe%value(gid,m,1) swe_calc%count(gid,m,1) = swe%count(gid,m,1) -! if(swe_calc%value(gid,m,1).gt.2000) then -! swe_calc%value(gid,m,1) = 2000.0 -! endif + !if(swe_calc%value(gid,m,1).gt.2000) then + ! swe_calc%value(gid,m,1) = 2000.0 + !endif enddo enddo endif From 39060de1e64b2a91a6638c3f145fc690fbb12d3b Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 5 Feb 2021 16:53:21 -0500 Subject: [PATCH 05/64] Added support for JULES multi-layer snow variables (PS41). --- lvt/utils/afwa/convert_nc2surf.py | 173 +++++++++++++++++++++++++++--- 1 file changed, 156 insertions(+), 17 deletions(-) diff --git a/lvt/utils/afwa/convert_nc2surf.py b/lvt/utils/afwa/convert_nc2surf.py index 4fee64680..2558732a7 100755 --- a/lvt/utils/afwa/convert_nc2surf.py +++ b/lvt/utils/afwa/convert_nc2surf.py @@ -44,6 +44,8 @@ # upgraded to MULE 2020.01.1. # 04 Dec 2020: Eric Kemp (SSAI): Fixed offset for starting lat/lon. # 25 Jan 2021: Eric Kemp (SSAI): Fixed calculation of bzy and bzx. +# 05 Feb 2021 : Eric Kemp (SSAI): Switched to multi-layer snow physics for +# PS41. # #------------------------------------------------------------------------------ """ @@ -62,7 +64,8 @@ #------------------------------------------------------------------------------ # Version of UM model. Used below when assigning metadata to SURF files. -_MODEL_VERSION = 1006 +#_MODEL_VERSION = 1006 +_MODEL_VERSION = 1009 #------------------------------------------------------------------------------ # SURF Variable codes, based on STASHmaster_A file used with GALWEM. @@ -101,6 +104,8 @@ "LBVC": 129, # Value at surface "LBPLEV": 0, # STASH pseudo dimension }, + + # EMK...Revised snow for PS41 # Snow amount over land aft tstp (1 level)...From LVT "SWE_inst:LVT": { "LBFC": 93, # PPF @@ -109,14 +114,103 @@ "LBVC": 129, # Value at surface "LBPLEV": 1, # STASH pseudo dimension }, + # Snow grain size on tiles (1 level)...From LVT + "SnowGrain_inst:LVT": { + "LBFC": 0, # From SURF + "ITEM_CODE": 231, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # Value at surface + "LBPLEV": 1, # STASH pseudo dimension + }, + # Snow amount on tiles (1 level)...From LVT + "SurftSnow_inst:LVT": { + "LBFC": 0, # From SURF + "ITEM_CODE": 240, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # Value at surface + "LBPLEV": 1, # STASH pseudo dimension + }, + # Snow beneath canopy (1 level)...From LVT + "GrndSnow_inst:LVT": { + "LBFC": 0, # From SURF + "ITEM_CODE": 242, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # Value at surface + "LBPLEV": 1 # STASH pseudo dimension + }, # Snow depth on ground on tiles (1 level)...From LVT "SnowDepth_inst:LVT": { "LBFC": 0, # PPF - "ITEM_CODE": 376, # Item + "ITEM_CODE": 376, # Item "LBTYP": 0, # CFFF "LBVC": 129, # Value at surface "LBPLEV": 1, # STASH pseudo dimension }, + # Snowpack bulk density (1 level)...From LVT + "SnowDensity_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE": 377, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # Value at surface + "LBPLEV": 1 # STASH pseudo dimension + }, + # Number of snow layers on tiles (1 level)...From LVT + "ActSnowNL_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE" : 380, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # Value at surface + "LBPLEV": 1, # STASH pseudo dimension + }, + # Snow layer thicknesses on tiles (3 levels)...From LVT + "LayerSnowDepth_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE": 381, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # LBVC + "LBPLEV": 1000, # 1000 will be added to layer number + }, + # Snow lyr ice mass on tiles (3 levels)...From LVT + "SnowIce_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE": 382, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # LBVC + "LBPLEV": 1000, # 1000 will be added to layer number + }, + # Snow lyr liquid mass on tiles (3 levels)...From LVT + "SnowLiq_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE": 383, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # LBVC + "LBPLEV": 1000, # 1000 will be added to layer number + }, + # Snow layer temperature on tiles (3 levels)...From LVT + "SnowTProf_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE": 384, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # LBVC + "LBPLEV": 1000, # 1000 will be added to layer number + }, + # Snow layer density on tiles (3 levels)...From LVT + "LayerSnowDensity_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE": 385, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # LBVC + "LBPLEV": 1000, # 1000 will be added to layer number + }, + # Snow layer grain size on tiles (3 levels)...From LVT + "LayerSnowGrain_inst:LVT": { + "LBFC": 0, # PPF + "ITEM_CODE": 386, # Item + "LBTYP": 0, # CFFF + "LBVC": 129, # LBVC + "LBPLEV": 1000, # 1000 will be added to layer number + }, + # Soil moisture content in a layer (4 levels)...From LVT "SoilMoist_inst:LVT": { "LBFC": 122, # PPF @@ -164,8 +258,20 @@ "water_temp" : 1, "aice" : 1, "hi" : 1, - "SWE_inst" : 1, + # EMK Revised snow vars for PS41. + "SWE_inst": 1, + "SnowGrain_inst" : 1, + "SurftSnow_inst" : 1, + "GrndSnow_inst" : 1, "SnowDepth_inst" : 1, + "SnowDensity_inst" : 1, + "ActSnowNL_inst" : 1, + "LayerSnowDepth_inst" : 3, + "SnowIce_inst" : 3, + "SnowLiq_inst" : 3, + "SnowTProf_inst" : 3, + "LayerSnowDensity_inst" : 3, + "LayerSnowGrain_inst" : 3, "SoilMoist_inst" : 4, "SoilTemp_inst" : 4, "AvgSurfT_inst" : 1, @@ -351,7 +457,8 @@ def _create_surf_template(self, file_type, varfields): 'integer_constants': { 'num_times': 1, 'num_levels': 1, - 'num_field_types': 2, # Two variables in snow file + #'num_field_types': 2, # For zero-layer snow + 'num_field_types': 13, # For PS41 multi-layer snow }, 'real_constants': { 'north_pole_lat': 90.0, @@ -428,7 +535,7 @@ def _create_surf_template(self, file_type, varfields): self.template["real_constants"]["start_lon"] = self.grid["start_lon"] #-------------------------------------------------------------------------- - def _set_field_lb(self, num_fields, key, field): + def _set_field_lb(self, num_fields, key, ilev, field): """Set the "lb" attributes in the Field object""" field.lbyr = self.time["year"] field.lbmon = self.time["month"] @@ -476,12 +583,16 @@ def _set_field_lb(self, num_fields, key, field): field.lbuser3 = 0 # No rim or halo sizes field.lbuser4 = _VARIDS[key]["ITEM_CODE"] #field.lbuser5 = 0 - field.lbuser5 = _VARIDS[key]["LBPLEV"] # "STASH Psuedo dimension" + # Special logic for multi-layer snow + if _VARIDS[key]["LBPLEV"] == 1000: + field.lbuser5 = ilev + _VARIDS[key]["LBPLEV"] + 1 + else: + field.lbuser5 = _VARIDS[key]["LBPLEV"] # "STASH Psuedo dimension" field.lbuser6 = 0 # Free space for users...Let MULE handle this field.lbuser7 = 1 # Atmosphere #-------------------------------------------------------------------------- - def _add_field(self, key, ilev, var2d_provider, surf): + def _add_field(self, key, ilev, var2d_provider, surface_flag, surf): """ Internal method to create and attach Field object to SURF object. Refer to Unified Model Documentation Paper F03 for meaning of metadata. @@ -496,11 +607,13 @@ def _add_field(self, key, ilev, var2d_provider, surf): field = mule.Field3.empty() # Populate the field records starting with "lb" - self._set_field_lb(num_fields, key, field) + self._set_field_lb(num_fields, key, ilev, field) # Populate remaining records field.bdatum = 0 # Datum value constant subtracted from field - if nlev == 1: + # Updated logic to specify surface levels, due to multi-layer + # snow physics from PS41. + if surface_flag: field.blev = 0 # Surface AGL else: field.blev = self.grid["soil_layer_thicknesses"][ilev] @@ -539,7 +652,7 @@ def _handle_glu_smc(self, file_type, surf): ldc = mule.ff.FF_LevelDependentConstants.empty(4) # 4 soil layers # NOTE: Pylint complains that the FF_LevelDependentConstants instance - # has no soil_thickness member. But this demonstrably false. Since + # has no soil_thickness member. But this is demonstrably false. Since # this is a bug, we disable the no-member check here. # pylint: disable=no-member ldc.soil_thickness[:] = self.grid["soil_layer_thicknesses"][:] @@ -604,17 +717,22 @@ def _get_var_and_fill_value(self, infile_type, varid): return var, fill_value #-------------------------------------------------------------------------- - def _create_var2d(self, var, ilev, fill_value): + def _create_var2d(self, var, ilev, surface_flag, fill_value): """Creates a 2d numpy array from the requested variable.""" # In 2D case, work with the whole array. if var.ndim == 2: var2d = var[:, :] - self.lblev = 9999 # Indicates surface level # In 3D case, pull out the current vertical level as a 2D array else: var2d = var[ilev, :, :] - self.lblev = ilev+1 # Use 1-based indexing + + # Revised logic for identifying surface level. This as added for + # multi-layer snow physics in PS41. + if surface_flag: + self.lblev = 9999 # Indicates surface level + else: + self.lblev = ilev + 1 # Use 1-based indexing # MULE doesn't like masked arrays, so pull the raw # data out in this case. @@ -697,11 +815,18 @@ def create_surf_file(self, file_type, varlist, surffile): nlev = _NLEVS[varid] for ilev in range(0, nlev): - var2d = self._create_var2d(var, ilev, fill_value) + # Added logic to specify if a field is at the surface. + # This logic was added with the multi-layer snow physics + # of PS41. + surface_flag = True + if varid == "SoilMoist_inst" or \ + varid == "SoilTemp_inst": + surface_flag = False + var2d = self._create_var2d(var, ilev, surface_flag, fill_value) # EMK...For SoilMoist, make sure no less than 0.1*wilting point # Wilting point is in m3/m3. Then convert from m3/m3 to - # kg m_2. + # kg m-2. if varid == "SoilMoist_inst": var2d = self._handle_soilmoist_var2d(ilev, var2d, var_wilt0p1) @@ -718,7 +843,7 @@ def create_surf_file(self, file_type, varlist, surffile): print("[INFO] Processing %s, ilev: %s" % (key, ilev)) surf = self._add_field(key, ilev, - var2d_provider, surf) + var2d_provider, surface_flag, surf) # All fields have been added to the SURF object. Write to file. surf.to_file(surffile) @@ -821,7 +946,21 @@ def read_cmd_args(): # Generate glu_snow SURF file FILE_TYPE = "_glu_snow" - VARFIELDS = ["SWE_inst:LVT", "SnowDepth_inst:LVT"] + # EMK...Upgrade to PS41 multi-layer snow + VARFIELDS = ["SWE_inst:LVT", + "SnowGrain_inst:LVT", + "SurftSnow_inst:LVT", + "GrndSnow_inst:LVT", + "SnowDepth_inst:LVT", + "SnowDensity_inst:LVT", + "ActSnowNL_inst:LVT", + "LayerSnowDepth_inst:LVT", + "SnowIce_inst:LVT", + "SnowLiq_inst:LVT", + "SnowTProf_inst:LVT", + "LayerSnowDensity_inst:LVT", + "LayerSnowGrain_inst:LVT"] + SURFFILE = "%4.4d%2.2d%2.2dT%2.2d00Z%s" \ % (VALIDDT.year, VALIDDT.month, From 06545ac7a0836717257486e03b44f763f59433e0 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 5 Feb 2021 16:56:04 -0500 Subject: [PATCH 06/64] Added support for JULES multi-layer snow variables (PS41). --- lvt/utils/afwa/run_ncks.py | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/lvt/utils/afwa/run_ncks.py b/lvt/utils/afwa/run_ncks.py index 52d43e880..ff9a32f40 100755 --- a/lvt/utils/afwa/run_ncks.py +++ b/lvt/utils/afwa/run_ncks.py @@ -45,6 +45,7 @@ # 25 Sep 2020: Eric Kemp (SSAI), tweaked comments for Python version. Also # added path for NCKS on Koehr. # 14 Oct 2020: Eric Kemp (SSAI), updated NCKS path on Discover. +# 05 Feb 2021: Eric Kemp (SSAI), added JULES multi-layer snow variables. # #------------------------------------------------------------------------------ @@ -152,11 +153,26 @@ 'SoilTemp_inst', 'SoilTemp_tavg', 'Tair_f_inst', 'Tair_f_max', 'Tair_f_tavg', - 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg'] + 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg', + 'ActSnowNL_inst', 'GrndSnow_inst', + 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', + 'LayerSnowGrain_inst', 'SnowDensity_inst', + 'SnowGrain_inst', 'SnowIce_inst', + 'SnowLiq_inst', + 'SnowTProf_inst', 'SurftSnow_inst'] # EMK for RECON #_LVT_JULES_INVOCATIONS_3HR = ["SWE_inst", "SnowDepth_inst", "SoilMoist_inst", # "SoilTemp_inst", "AvgSurfT_inst"] +# _LVT_JULES_INVOCATIONS_3HR = ["AvgSurfT_inst", +# "SoilMoist_inst","SoilTemp_inst", +# "SnowDepth_inst", "SWE_inst", +# 'ActSnowNL_inst', 'GrndSnow_inst', +# 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', +# 'LayerSnowGrain_inst', 'SnowDensity_inst', +# 'SnowGrain_inst', 'SnowIce_inst', +# 'SnowLiq_inst', +# 'SnowTProf_inst', 'SurftSnow_inst'] _LVT_JULES_INVOCATIONS_24HR = ['Evap_tavg', 'LWdown_f_tavg', 'RHMin_inst', From 6b5d79892a4ff08333f511de42493a6bd55642b7 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 5 Feb 2021 16:59:19 -0500 Subject: [PATCH 07/64] Updated for JULES multi-layer snow variables (PS41). --- .../submit_lvt_discover_3hr_jules.py | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py index d9d23efb6..2d538d7dc 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py @@ -33,23 +33,23 @@ 'Tair_f_inst', 'Tair_f_max', 'Tair_f_tavg', 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg', + "ActSnowNL_inst", "GrndSnow_inst", + "LayerSnowDensity_inst", "LayerSnowDepth_inst", + "LayerSnowGrain_inst", "SnowDensity_inst", + "SnowGrain_inst", "SnowIce_inst", + "SnowLiq_inst", "SnowTProf_inst", + "SurftSnow_inst"] - 'ActSnowNL_inst', 'GrndSnow_inst', - 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', - 'LayerSnowGrain_inst', 'SnowDensity_inst', - 'SnowGrain_inst', 'SnowIce_inst', - 'SnowLiq_inst', 'SnowSoot_inst', - 'SnowTProf_inst', 'SurftSnow_inst'] - -# EMK GALWEM TESTING -vars = ['ActSnowNL_inst', 'GrndSnow_inst', - 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', - 'LayerSnowGrain_inst', 'SnowDensity_inst', - 'SnowDepth_inst', - 'SnowGrain_inst', 'SnowIce_inst', - 'SnowLiq_inst', 'SnowSoot_inst', - 'SnowTProf_inst', 'SurftSnow_inst', - 'SWE_inst'] +# # EMK GALWEM TESTING +# vars = ["SoilMoist_inst", "SoilTemp_inst", +# "AvgSurfT_inst", +# 'SnowDepth_inst', 'SWE_inst', +# "ActSnowNL_inst", "GrndSnow_inst", +# "LayerSnowDensity_inst", "LayerSnowDepth_inst", +# "LayerSnowGrain_inst", "SnowDensity_inst", +# "SnowGrain_inst", "SnowIce_inst", +# "SnowLiq_inst", "SnowTProf_inst", +# "SurftSnow_inst"] if not os.path.exists("LVT"): print("ERROR, LVT executable does not exist!") From 9c05f30b33a9f2c6b48f4c657d4fef4319e87a88 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 5 Feb 2021 17:03:32 -0500 Subject: [PATCH 08/64] Added multi-layer snow variables (PS41). --- .../templates/make_lvt_config_3hr_jules.py | 85 ++++++++++--------- 1 file changed, 43 insertions(+), 42 deletions(-) diff --git a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py index bd24af1bd..6064164ba 100755 --- a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py +++ b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py @@ -17,7 +17,7 @@ template = "template/lvt.config.template.jules50" startdt = datetime.datetime(2018, 12, 1, 9) -enddt = datetime.datetime(2018, 12, 1, 12) +enddt = datetime.datetime(2018, 12, 2, 12) output = "netcdf" #output = "grib2" @@ -95,35 +95,6 @@ "Wind_f_tavg": "Wind_f 1 1 m/s - 1 1 Wind_f 1 1 m/s - 1 1", - "SurftSnow_inst": - "SurftSnow 1 1 kg/m2 - 0 1 SurftSnow 1 1 kg/m2 - 0 1", - "GrndSnow_inst": - "GrndSnow 1 1 kg/m2 - 0 1 GrndSnow 1 1 kg/m2 - 0 1", - "SnowSoot_inst": - "SnowSoot 1 1 'kg kg-1' - 0 1 SnowSoot 1 1 'kg kg-1' - 0 1", - "SnowGrain_inst": - "SnowGrain 1 1 microns - 0 1 SnowGrain 1 1 microns - 0 1", - "SnowDensity_inst": - "SnowDensity 1 1 kg/m3 - 0 1 SnowDensity 1 1 kg/m3 - 0 1", - "ActSnowNL_inst": - "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", - "LayerSnowDepth_inst": - "LayerSnowDepth 1 1 m - 0 3 LayerSnowDepth 1 1 m - 0 3", - "SnowIce_inst": - "SnowIce 1 1 kg/m2 - 0 3 SnowIce 1 1 kg/m2 - 0 3", - "SnowLiq_inst": - "SnowLiq 1 1 kg/m2 - 0 3 SnowLiq 1 1 kg/m2 - 0 3", - "SnowTProf_inst": - "SnowTProf 1 1 K - 0 3 SnowTProf 1 1 K - 0 3", - "LayerSnowDensity_inst": - "LayerSnowDensity 1 1 kg/m3 - 0 3 LayerSnowDensity 1 1 kg/m3 - 0 3", - "LayerSnowGrain_inst": - "LayerSnowGrain 1 1 microns - 0 3 LayerSnowGrain 1 1 microns - 0 3", - -} - -# EMK FOR GALWEM TESTING -var_attributes = { "ActSnowNL_inst": "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", "GrndSnow_inst": @@ -134,8 +105,6 @@ "LayerSnowDepth 1 1 m - 0 3 LayerSnowDepth 1 1 m - 0 3", "LayerSnowGrain_inst": "LayerSnowGrain 1 1 microns - 0 3 LayerSnowGrain 1 1 microns - 0 3", - "SnowDepth_inst": - "SnowDepth 1 1 m - 0 1 SnowDepth 1 1 m - 0 1", "SnowDensity_inst": "SnowDensity 1 1 kg/m3 - 0 1 SnowDensity 1 1 kg/m3 - 0 1", "SnowGrain_inst": @@ -144,16 +113,49 @@ "SnowIce 1 1 kg/m2 - 0 3 SnowIce 1 1 kg/m2 - 0 3", "SnowLiq_inst": "SnowLiq 1 1 kg/m2 - 0 3 SnowLiq 1 1 kg/m2 - 0 3", - "SnowSoot_inst": - "SnowSoot 1 1 'kg kg-1' - 0 1 SnowSoot 1 1 'kg kg-1' - 0 1", "SnowTProf_inst": "SnowTProf 1 1 K - 0 3 SnowTProf 1 1 K - 0 3", "SurftSnow_inst": "SurftSnow 1 1 kg/m2 - 0 1 SurftSnow 1 1 kg/m2 - 0 1", - "SWE_inst": - "SWE 1 1 kg/m2 - 0 1 SWE 1 1 kg/m2 - 0 1", } +# # EMK FOR GALWEM TESTING +# var_attributes = { +# "AvgSurfT_inst": +# "AvgSurfT 1 1 K - 0 1 AvgSurfT 1 1 K - 0 1", +# "SoilMoist_inst": +# "SoilMoist 1 4 m3/m3 - 0 4 SoilMoist 1 4 m3/m3 - 0 4", +# "SoilTemp_inst": +# "SoilTemp 1 4 K - 0 4 SoilTemp 1 4 K - 0 4", + +# "SnowDepth_inst": +# "SnowDepth 1 1 m - 0 1 SnowDepth 1 1 m - 0 1", +# "SWE_inst": +# "SWE 1 1 kg/m2 - 0 1 SWE 1 1 kg/m2 - 0 1", +# "ActSnowNL_inst": +# "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", +# "GrndSnow_inst": +# "GrndSnow 1 1 kg/m2 - 0 1 GrndSnow 1 1 kg/m2 - 0 1", +# "LayerSnowDensity_inst": +# "LayerSnowDensity 1 1 kg/m3 - 0 3 LayerSnowDensity 1 1 kg/m3 - 0 3", +# "LayerSnowDepth_inst": +# "LayerSnowDepth 1 1 m - 0 3 LayerSnowDepth 1 1 m - 0 3", +# "LayerSnowGrain_inst": +# "LayerSnowGrain 1 1 microns - 0 3 LayerSnowGrain 1 1 microns - 0 3", +# "SnowDensity_inst": +# "SnowDensity 1 1 kg/m3 - 0 1 SnowDensity 1 1 kg/m3 - 0 1", +# "SnowGrain_inst": +# "SnowGrain 1 1 microns - 0 1 SnowGrain 1 1 microns - 0 1", +# "SnowIce_inst": +# "SnowIce 1 1 kg/m2 - 0 3 SnowIce 1 1 kg/m2 - 0 3", +# "SnowLiq_inst": +# "SnowLiq 1 1 kg/m2 - 0 3 SnowLiq 1 1 kg/m2 - 0 3", +# "SnowTProf_inst": +# "SnowTProf 1 1 K - 0 3 SnowTProf 1 1 K - 0 3", +# "SurftSnow_inst": +# "SurftSnow 1 1 kg/m2 - 0 1 SurftSnow 1 1 kg/m2 - 0 1", +# } + # RHMin must be processed with Tair_f_min, so these are listed together var_attributes_special = { "Tair_f_min": @@ -178,12 +180,11 @@ "Tair_f_tavg", "TotalPrecip_acc", "Tair_f_min", "RHMin_inst", - "SurftSnow_inst", "GrndSnow_inst", - "SnowSoot_inst", "SnowGrain_inst", - "SnowDensity_inst", "ActSnowNL_inst", - "LayerSnowDepth_inst", "SnowIce_inst", - "SnowLiq_inst", "SnowTProf_inst", - "LayerSnowDensity_inst", "LayerSnowGrain_inst" ] + "GrndSnow_inst", "LayerSnowDensity_inst", + "LayerSnowDepth_inst", "LayerSnowGrain_inst", + "SnowDensity_inst", "SnowGrain_inst", + "SnowIce_inst", "SnowLiq_inst", + "SnowTProf_inst", "SurftSnow_inst"] lines = open(template, 'r').readlines() From a6c1f626b8a7386dbef9fa634e334ac8ad54e7c9 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 11 Feb 2021 09:11:00 -0500 Subject: [PATCH 09/64] Modified LIS-JULES code to output multi-layer snow variables. These are preliminary changes made by Shugong Wang. Additional changes to rename some variables will be coming later. --- lis/core/LIS_histDataMod.F90 | 69 +++++++++++++++-- .../land/jules.5.0/jules50_main.F90 | 74 ++++++++++++------- 2 files changed, 110 insertions(+), 33 deletions(-) diff --git a/lis/core/LIS_histDataMod.F90 b/lis/core/LIS_histDataMod.F90 index cc1d01b12..c217559fc 100644 --- a/lis/core/LIS_histDataMod.F90 +++ b/lis/core/LIS_histDataMod.F90 @@ -138,6 +138,7 @@ module LIS_histDataMod public :: LIS_MOC_SLIQFRAC public :: LIS_MOC_LAYERSNOWDEPTH public :: LIS_MOC_LAYERSNOWDENSITY + public :: LIS_MOC_LAYERSNOWGRAIN public :: LIS_MOC_LWUP public :: LIS_MOC_GPP public :: LIS_MOC_NPP @@ -452,7 +453,14 @@ module LIS_histDataMod PUBLIC :: LIS_MOC_JULES_FSAT PUBLIC :: LIS_MOC_JULES_FWETL public :: LIS_MOC_JULES_ESOIL - + ! For JULES 5.0 PS41 + public :: LIS_MOC_SNOW_SOOT + public :: LIS_MOC_GRND_SNOW + public :: LIS_MOC_SURFT_SNOW + + integer :: LIS_MOC_SNOW_SOOT = -9999 + integer :: LIS_MOC_GRND_SNOW = -9999 + integer :: LIS_MOC_SURFT_SNOW = -9999 integer :: LIS_MOC_JULES_STHZW = -9999 integer :: LIS_MOC_JULES_STHU = -9999 integer :: LIS_MOC_JULES_STHU_MIN = -9999 @@ -561,6 +569,7 @@ module LIS_histDataMod integer :: LIS_MOC_SNOWTHRESH = -9999 integer :: LIS_MOC_LAYERSNOWDEPTH = -9999 integer :: LIS_MOC_LAYERSNOWDENSITY = -9999 + integer :: LIS_MOC_LAYERSNOWGRAIN = -9999 ! ALMA VARIABLES TO BE COMPARED WITH REMOTE SENSED DATA integer :: LIS_MOC_LWUP = -9999 @@ -1091,6 +1100,17 @@ subroutine LIS_histDataInit(n, ntiles) ! read the meta data attributes for each variable !------------------------------------------------------------------------- !!! JULES + call ESMF_ConfigFindLabel(modelSpecConfig,"SnowSoot:",rc=rc) + call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & + "SnowSoot",& + "snow_soot_content",& + "snow soot content",rc) + if ( rc == 1 ) then + call register_dataEntry(LIS_MOC_LSM_COUNT,LIS_MOC_SNOW_SOOT,& + LIS_histData(n)%head_lsm_list,& + n,1,ntiles,(/"kg/kg"/),1,(/"-"/),1,112,0,& + model_patch=.true.) + endif call ESMF_ConfigFindLabel(modelSpecConfig,"sthu:",rc=rc) call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & @@ -1736,15 +1756,14 @@ subroutine LIS_histDataInit(n, ntiles) call ESMF_ConfigFindLabel(modelSpecConfig,"SnowDensity:",rc=rc) call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & "SnowDensity",& - "snow_density_for_each_layer",& - "snow density for each layer",rc) + "snowpack_bulk_density",& + "snowpack bulk density",rc) if ( rc == 1 ) then call register_dataEntry(LIS_MOC_LSM_COUNT,LIS_MOC_SNOWDENSITY,& LIS_histData(n)%head_lsm_list,& n,1,ntiles,(/"kg/m3"/),1,(/"-"/),1,1,1,& model_patch=.true.) endif - call ESMF_ConfigFindLabel(modelSpecConfig,"LayerSnowDensity:",rc=rc) call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & @@ -1757,12 +1776,12 @@ subroutine LIS_histDataInit(n, ntiles) n,1,ntiles,(/"kg/m3"/),1,(/"-"/),1,1,1,& model_patch=.true.) endif - + call ESMF_ConfigFindLabel(modelSpecConfig,"SnowGrain:",rc=rc) call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & "SnowGrain",& - "snow_grain_size_for_each_layer",& - "snow grain size for each layer",rc) + "snow_grain_size",& + "snow grain size",rc) if ( rc == 1 ) then call register_dataEntry(LIS_MOC_LSM_COUNT,LIS_MOC_SNOWGRAIN,& LIS_histData(n)%head_lsm_list,& @@ -1770,6 +1789,18 @@ subroutine LIS_histDataInit(n, ntiles) model_patch=.true.) endif + call ESMF_ConfigFindLabel(modelSpecConfig,"LayerSnowGrain:",rc=rc) + call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & + "LayerSnowGrain",& + "layer_snow_grain_size_for_each_layer",& + "snow grain size for each layer",rc) + if ( rc == 1 ) then + call register_dataEntry(LIS_MOC_LSM_COUNT,LIS_MOC_LAYERSNOWGRAIN,& + LIS_histData(n)%head_lsm_list,& + n,1,ntiles,(/"micron"/),1,(/"-"/),1,1,1,& + model_patch=.true.) + endif + call ESMF_ConfigFindLabel(modelSpecConfig,"SnowDepth:",rc=rc) call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & "SnowDepth",& @@ -1782,6 +1813,30 @@ subroutine LIS_histDataInit(n, ntiles) model_patch=.true.) ! cm is added for VIC, Shugong Wang 02/20/2012 endif + + call ESMF_ConfigFindLabel(modelSpecConfig,"GrndSnow:",rc=rc) + call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & + "GrndSnow",& + "snow_on_grond_beneath_canopy",& + "snow on ground (beneath canopy)",rc) + if ( rc == 1 ) then + call register_dataEntry(LIS_MOC_LSM_COUNT,LIS_MOC_GRND_SNOW,& + LIS_histData(n)%head_lsm_list,& + n,1,ntiles,(/"kg/m2"/),1,(/"-"/),1,1,1,& + model_patch=.true.) + endif + + call ESMF_ConfigFindLabel(modelSpecConfig,"SurftSnow:",rc=rc) + call get_moc_attributes(modelSpecConfig, LIS_histData(n)%head_lsm_list, & + "SurftSnow",& + "snow_amount_on_tile",& + "snow amount on tile",rc) + if ( rc == 1 ) then + call register_dataEntry(LIS_MOC_LSM_COUNT,LIS_MOC_SURFT_SNOW,& + LIS_histData(n)%head_lsm_list,& + n,1,ntiles,(/"kg/m2"/),1,(/"-"/),1,1,1,& + model_patch=.true.) + endif ! added by Shugong Wang 05/02/2018 for JULES call ESMF_ConfigFindLabel(modelSpecConfig,"SnowThick:",rc=rc) diff --git a/lis/surfacemodels/land/jules.5.0/jules50_main.F90 b/lis/surfacemodels/land/jules.5.0/jules50_main.F90 index 31d81b5d2..6e97a1e90 100644 --- a/lis/surfacemodels/land/jules.5.0/jules50_main.F90 +++ b/lis/surfacemodels/land/jules.5.0/jules50_main.F90 @@ -600,6 +600,38 @@ subroutine jules50_main(n) ! JULES snow variables + ! snow soot + call LIS_diagnoseSurfaceOutputVar(n,t, & + LIS_MOC_SNOW_SOOT, & + value=jules50_struc(n)%jules50(t)%soot_ij, & + vlevel=1,unit="kg kg-1",direction="-", & + surface_type=LIS_rc%lsm_index) + + ! Snow on the ground (kg/m2). This is the snow beneath the canopy and is only used if can_model=4. + call LIS_diagnoseSurfaceOutputVar(n, t, & + LIS_MOC_GRND_SNOW, & + value = jules50_struc(n)%jules50(t)%snow_grnd(pft), & + vlevel=1, unit="kg m-2", direction="-", & + surface_type = LIS_rc%lsm_index) + + ! Lying snow on tiles (kg/m2). If can_model=4, snow_surft is the snow on the canopy snow_grnd is the + ! snow on the ground beneath canopy If can_model/=4, snow_surft is the total snow. + call LIS_diagnoseSurfaceOutputVar(n, t, & + LIS_MOC_SURFT_SNOW, & + value = jules50_struc(n)%jules50(t)%snow_tile(pft), & + vlevel=1, unit="kg m-2", direction="-", & + surface_type = LIS_rc%lsm_index) + + ! bulk snow density + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWDENSITY, & + value = jules50_struc(n)%jules50(t)%rho_snow_grnd(pft),& + vlevel=1, unit="kg m-3", direction="-", surface_type = LIS_rc%lsm_index) + + ! bulk snow grain size + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWGRAIN, & + value = jules50_struc(n)%jules50(t)%rgrain(pft),& + vlevel=1, unit="micron", direction="-", surface_type = LIS_rc%lsm_index) + !!!! nsmax = 0, single layer snow physics if(nsmax .eq.0) then ! snow ice call LIS_diagnoseSurfaceOutputVar(n, t, & @@ -619,56 +651,46 @@ subroutine jules50_main(n) value=jules50_struc(n)%jules50(t)%tsnow(1,1), & vlevel=1, unit="K", direction="-", & surface_type=LIS_rc%lsm_index) - ! bulk snow density - call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWDENSITY, & - value = jules50_struc(n)%jules50(t)%rho_snow_grnd(pft),& - vlevel=1, unit="kg m-3", direction="-", surface_type = LIS_rc%lsm_index) - - ! bulk snow grain size - call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWGRAIN, & - value = jules50_struc(n)%jules50(t)%rgrain(pft),& - vlevel=1, unit="micron", direction="-", surface_type = LIS_rc%lsm_index) - - - call LIS_diagnoseSurfaceOutputVar(n,t, & - LIS_MOC_SNOWTHICK, & - vlevel=1, & - value=jules50_struc(n)%jules50(t)%snowdepth(pft), & - unit="m", direction="-",& + !!! nsmax > 0, multi-layer snow physics + else + ! Number of snow layers on ground on tiles + call LIS_diagnoseSurfaceOutputVar(n, t, & + LIS_MOC_SOWN_NLAYER, & + value=jules50_struc(n)%jules50(t)%nsnow(pft)*1.0, & ! nsnow is integer, -> real by *1.0 + vlevel=1, unit="-", direction="-", & surface_type=LIS_rc%lsm_index) - else do i=1, jules50_struc(n)%nsmax - ! snow ice + ! layer snow ice call LIS_diagnoseSurfaceOutputVar(n, t, & LIS_MOC_SNOWICE, & value=jules50_struc(n)%jules50(t)%sice(pft,i), & vlevel=i, unit="kg m-2", direction="-", & surface_type=LIS_rc%lsm_index) - ! snow liquid water + ! layer snow liquid water call LIS_diagnoseSurfaceOutputVar(n, t, & LIS_MOC_SNOWLIQ, & value=jules50_struc(n)%jules50(t)%sliq(pft,i), & vlevel=i, unit="kg m-2", direction="-", & surface_type=LIS_rc%lsm_index) - ! snow temperature K + ! layer snow temperature K call LIS_diagnoseSurfaceOutputVar(n, t, & LIS_MOC_SNOWTPROF, & value=jules50_struc(n)%jules50(t)%tsnow(pft,i), & vlevel=i, unit="K", direction="-", & surface_type=LIS_rc%lsm_index) - ! snow density - call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWDENSITY, & + ! layer snow density + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LAYERSNOWDENSITY, & value = jules50_struc(n)%jules50(t)%rho_snow(pft,i),& vlevel=i, unit="kg m-3", direction="-", surface_type = LIS_rc%lsm_index) - ! snow grain size - call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWGRAIN, & + ! layer snow grain size + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LAYERSNOWGRAIN, & value = jules50_struc(n)%jules50(t)%rgrainl(pft,i),& vlevel=i, unit="micron", direction="-", surface_type = LIS_rc%lsm_index) - ! thickness of snow layers - call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWTHICK, & + ! layer thickness of snow layers + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LAYERSNOWDEPTH, & value = jules50_struc(n)%jules50(t)%ds(pft,i),& vlevel=i, unit="m", direction="-", surface_type = LIS_rc%lsm_index) end do From 8b93fc9fd6adf7f3efa05fe65a487c4cbceaeaf1 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 4 Mar 2021 14:13:54 -0500 Subject: [PATCH 10/64] Fix soil moisture supersaturation triggered by unit conversion. Conversion of JULES soil moisture from kg m^-2 to m^3 m^-3 can lead to slightly oversaturated values if the values in the original units are already at saturation. This is due to floating point rounding error. The added code resets the converted soil moistures to the saturated value in that case. (The values are only about 1e-7 m^3 m^-3 over the saturation limit, so it's not a huge deal, but it seems best to fix it immediately.) --- .../land/jules.5.0/jules50_main.F90 | 22 +++++++++++++------ 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/lis/surfacemodels/land/jules.5.0/jules50_main.F90 b/lis/surfacemodels/land/jules.5.0/jules50_main.F90 index 6e97a1e90..070e0b7d9 100644 --- a/lis/surfacemodels/land/jules.5.0/jules50_main.F90 +++ b/lis/surfacemodels/land/jules.5.0/jules50_main.F90 @@ -113,7 +113,8 @@ subroutine jules50_main(n) real :: sfctmp, sfcprs, es, q2, q2sat real :: relsmc,smc,smcmax,smcwilt character*3 :: fnest - + real :: smoist_m3ovrm3 + ! check JULES alarm. If alarm is ring, run model. alarmCheck = LIS_isAlarmRinging(LIS_rc, "JULES.5.0 model alarm") if (alarmCheck) Then @@ -228,6 +229,7 @@ subroutine jules50_main(n) call top_pdm_to_tile(n, t) call sf_diag_to_tile(n, t) + ![ 1] output variable: soil_temp (unit=K). ! soil layer temperature do i=1, jules50_struc(n)%sm_levels @@ -249,14 +251,20 @@ subroutine jules50_main(n) ! m3/m3 do i=1, jules50_struc(n)%sm_levels + + ! EMK fix supersaturation induced by m3/m3 conversion + smoist_m3ovrm3 = & + jules50_struc(n)%jules50(t)%smcl_soilt(i)/ & + (1000.0*dzsoil(i)) + smoist_m3ovrm3 = min(smoist_m3ovrm3, & + jules50_struc(n)%jules50(t)%p_s_smvcst(i)) call LIS_diagnoseSurfaceOutputVar(n, t, & - LIS_MOC_SOILMOIST, & - value=jules50_struc(n)%jules50(t)%smcl_soilt(i)/ & - (1000.0*dzsoil(i)), & - vlevel=i, unit="m^3 m-3", direction="-", & - surface_type=LIS_rc%lsm_index) + LIS_MOC_SOILMOIST, & + value=smoist_m3ovrm3, & + vlevel=i, unit="m^3 m-3", direction="-", & + surface_type=LIS_rc%lsm_index) end do - + ! m3/m3, unfrozen (liquid) soil moisture do i=1, jules50_struc(n)%sm_levels ! p_s_sthu: unfrozen moisture content of each soil layer as a fraction of saturation (-) From 0607e8ee83a6158fd5c0593edf57a9331469918d Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 4 Mar 2021 14:31:23 -0500 Subject: [PATCH 11/64] Added comments indicating PS41 support. --- lvt/utils/afwa/run_ncks.py | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lvt/utils/afwa/run_ncks.py b/lvt/utils/afwa/run_ncks.py index ff9a32f40..6d7da45e5 100755 --- a/lvt/utils/afwa/run_ncks.py +++ b/lvt/utils/afwa/run_ncks.py @@ -133,7 +133,7 @@ # The 24-hr postprocessing should include the latest 3-hr snow depth and SWE. _LVT_NOAHMP_INVOCATIONS_24HR_LATEST = ['SnowDepth_inst', 'SWE_inst'] -# The LVT invocations for JULES LSM output. +# The LVT invocations for JULES LSM output. Updated for PS41. _LVT_JULES_INVOCATIONS_3HR = ['Albedo_tavg', 'AvgSurfT_inst', 'AvgSurfT_tavg', 'CanopInt_inst', @@ -161,9 +161,7 @@ 'SnowLiq_inst', 'SnowTProf_inst', 'SurftSnow_inst'] -# EMK for RECON -#_LVT_JULES_INVOCATIONS_3HR = ["SWE_inst", "SnowDepth_inst", "SoilMoist_inst", -# "SoilTemp_inst", "AvgSurfT_inst"] +# EMK for RECON...PS41 configuration # _LVT_JULES_INVOCATIONS_3HR = ["AvgSurfT_inst", # "SoilMoist_inst","SoilTemp_inst", # "SnowDepth_inst", "SWE_inst", From 468cc59051d953ba5bd2bfa54a8706770bd11e0a Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 4 Mar 2021 14:32:36 -0500 Subject: [PATCH 12/64] Disabled smoothing to avoid numerical instabilities with GALWEM. Also added comments indicating support for PS41. --- .../templates/make_lvt_config_3hr_jules.py | 47 +++++++++---------- 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py index 6064164ba..cb3c43bbd 100755 --- a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py +++ b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py @@ -16,13 +16,14 @@ template = "template/lvt.config.template.jules50" -startdt = datetime.datetime(2018, 12, 1, 9) -enddt = datetime.datetime(2018, 12, 2, 12) +startdt = datetime.datetime(2018, 12, 2, 9) +enddt = datetime.datetime(2018, 12, 31, 12) output = "netcdf" #output = "grib2" # Most variables are processed independently, and are listed below. +# Updated for PS41 (multi-layer snow physics) var_attributes = { "AvgSurfT_inst": "AvgSurfT 1 1 K - 0 1 AvgSurfT 1 1 K - 0 1", @@ -94,7 +95,6 @@ "Wind_f 1 1 m/s - 0 1 Wind_f 1 1 m/s - 0 1", "Wind_f_tavg": "Wind_f 1 1 m/s - 1 1 Wind_f 1 1 m/s - 1 1", - "ActSnowNL_inst": "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", "GrndSnow_inst": @@ -127,7 +127,6 @@ # "SoilMoist 1 4 m3/m3 - 0 4 SoilMoist 1 4 m3/m3 - 0 4", # "SoilTemp_inst": # "SoilTemp 1 4 K - 0 4 SoilTemp 1 4 K - 0 4", - # "SnowDepth_inst": # "SnowDepth 1 1 m - 0 1 SnowDepth 1 1 m - 0 1", # "SWE_inst": @@ -166,26 +165,26 @@ # Smooth variables that are perturbed, derived from perturbed variables, # or are LSM outputs that are affected by perturbed variables via physics. -smooth_vars = ["AvgSurfT_inst", "AvgSurfT_tavg", - "Albedo_tavg", "CanopInt_inst", - "Evap_tavg", "LWdown_f_inst", - "LWdown_f_tavg", "Qh_tavg", "Qle_tavg", - "Qs_acc", "Qsb_acc", "RelSMC_inst", - "SmLiqFrac_inst", "SnowDepth_inst", - "Snowcover_inst", "SoilMoist_inst", - "SoilMoist_tavg", "SoilTemp_inst", - "SoilTemp_tavg", "SWdown_f_inst", - "SWdown_f_tavg", "SWE_inst", - "Tair_f_inst", "Tair_f_max", - "Tair_f_tavg", "TotalPrecip_acc", - "Tair_f_min", "RHMin_inst", - - "GrndSnow_inst", "LayerSnowDensity_inst", - "LayerSnowDepth_inst", "LayerSnowGrain_inst", - "SnowDensity_inst", "SnowGrain_inst", - "SnowIce_inst", "SnowLiq_inst", - "SnowTProf_inst", "SurftSnow_inst"] - +# EMK...Smoothing turned off to avoid numerical instabilities in GALWEM. +# smooth_vars = ["AvgSurfT_inst", "AvgSurfT_tavg", +# "Albedo_tavg", "CanopInt_inst", +# "Evap_tavg", "LWdown_f_inst", +# "LWdown_f_tavg", "Qh_tavg", "Qle_tavg", +# "Qs_acc", "Qsb_acc", "RelSMC_inst", +# "SmLiqFrac_inst", "SnowDepth_inst", +# "Snowcover_inst", "SoilMoist_inst", +# "SoilMoist_tavg", "SoilTemp_inst", +# "SoilTemp_tavg", "SWdown_f_inst", +# "SWdown_f_tavg", "SWE_inst", +# "Tair_f_inst", "Tair_f_max", +# "Tair_f_tavg", "TotalPrecip_acc", +# "Tair_f_min", "RHMin_inst", +# "GrndSnow_inst", "LayerSnowDensity_inst", +# "LayerSnowDepth_inst", "LayerSnowGrain_inst", +# "SnowDensity_inst", "SnowGrain_inst", +# "SnowIce_inst", "SnowLiq_inst", +# "SnowTProf_inst", "SurftSnow_inst"] +smooth_vars = [] lines = open(template, 'r').readlines() From b8bd90ad1c7efc9379963eebbd6e9b6dc7ee6905 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 4 Mar 2021 14:34:39 -0500 Subject: [PATCH 13/64] Removed scripts for Conrad. Conrad was decommissioned in CY2020, so these scripts are useless. --- .../templates/submit_lvt_conrad_24hr_jules.py | 92 ---------------- .../templates/submit_lvt_conrad_24hr_noah.py | 92 ---------------- .../submit_lvt_conrad_24hr_noahmp.py | 92 ---------------- .../templates/submit_lvt_conrad_3hr_jules.py | 103 ----------------- .../templates/submit_lvt_conrad_3hr_noah.py | 104 ------------------ .../templates/submit_lvt_conrad_3hr_noahmp.py | 104 ------------------ 6 files changed, 587 deletions(-) delete mode 100755 lvt/utils/afwa/templates/submit_lvt_conrad_24hr_jules.py delete mode 100755 lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noah.py delete mode 100755 lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noahmp.py delete mode 100755 lvt/utils/afwa/templates/submit_lvt_conrad_3hr_jules.py delete mode 100755 lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noah.py delete mode 100755 lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noahmp.py diff --git a/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_jules.py deleted file mode 100755 index e662ced1f..000000000 --- a/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_jules.py +++ /dev/null @@ -1,92 +0,0 @@ -#!/usr/bin/env python3 - -#-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- -# NASA Goddard Space Flight Center -# Land Information System Framework (LISF) -# Version 7.3 -# -# Copyright (c) 2020 United States Government as represented by the -# Administrator of the National Aeronautics and Space Administration. -# All Rights Reserved. -#-------------------------END NOTICE -- DO NOT EDIT----------------------- - -import os -import subprocess -import sys -import time - -vars = ["SoilMoist_tavg", "SoilTemp_tavg", - "RHMin_inst", - "Evap_tavg", "LWdown_f_tavg", - "SWdown_f_tavg", - "Tair_f_max", - "Tair_f_tavg", - "TotalPrecip_acc", "Wind_f_tavg"] - -# Handle command line - - -def usage(): - print("Usage: %s chargecode queue" % (sys.argv[0])) - print(" where chargecode is PBS project_code") - print(" and queue is PBS queue OR reservation number") - - -if len(sys.argv) != 3: - print("ERROR, problem with command line arguments!") - usage() - sys.exit(1) -project_code = sys.argv[1] -reservation = sys.argv[2] - -# Make sure LVT executable is in place before launching jobs -if not os.path.exists("LVT"): - print("ERROR, LVT executable does not exist!") - sys.exit(1) - -# Loop through each invocation, create a batch script, and launch the -# batch script -for var in vars: - scriptname = "run_lvt.%s_24hr.sh" % (var) - f = open(scriptname, "w") - line = """#!/bin/sh -#PBS -A %s\n""" % (project_code) - line += """#PBS -j oe -#PBS -l walltime=0:15:00 -#PBS -l select=1:ncpus=32 -#PBS -N %s.24hr\n""" % (var) - line += """#PBS -q %s\n""" % (reservation) - line += """$PBS -W sandbox=PRIVATE -#PBS -V - -module use --append ~jim/README -module load lis_7_intel_17_0_2_174 -ulimit -c unlimited -ulimit -m unlimited -ulimit -s unlimited - -cd "$PBS_O_WORKDIR" || exit 1 -echo `pwd` - -if [ ! -e ./LVT ] ; then - echo "ERROR, LVT does not exist!" && exit 1 -fi - -if [ ! -e lvt.config.%s.24hr ] ; then - echo "ERROR, lvt.config.%s.24hr does not exist!" && exit 1 -fi - -aprun -n 1 -j 1 ./LVT lvt.config.%s.24hr || exit 1 - -exit 0 -""" % (var, var, var) - f.write(line) - f.close() - - cmd = "qsub %s" % (scriptname) - print(cmd) - rc = subprocess.call(cmd, shell=True) - if rc != 0: - print("[ERR] Problem with qsub!") - sys.exit(1) - time.sleep(1) # Don't overwhelm PBS! diff --git a/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noah.py b/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noah.py deleted file mode 100755 index 5845ffe7c..000000000 --- a/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noah.py +++ /dev/null @@ -1,92 +0,0 @@ -#!/usr/bin/env python3 - -#-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- -# NASA Goddard Space Flight Center -# Land Information System Framework (LISF) -# Version 7.3 -# -# Copyright (c) 2020 United States Government as represented by the -# Administrator of the National Aeronautics and Space Administration. -# All Rights Reserved. -#-------------------------END NOTICE -- DO NOT EDIT----------------------- - -import os -import subprocess -import sys -import time - -vars = ["SoilMoist_tavg", "SoilTemp_tavg", - "RHMin_inst", - "Evap_tavg", "LWdown_f_tavg", "PotEvap_tavg", - "SWdown_f_tavg", - "Tair_f_max", - "Tair_f_tavg", - "TotalPrecip_acc", "Wind_f_tavg"] - -# Handle command line - - -def usage(): - print("Usage: %s chargecode queue" % (sys.argv[0])) - print(" where chargecode is PBS project_code") - print(" and queue is PBS queue OR reservation number") - - -if len(sys.argv) != 3: - print("ERROR, problem with command line arguments!") - usage() - sys.exit(1) -project_code = sys.argv[1] -reservation = sys.argv[2] - -# Make sure LVT executable is in place before launching jobs -if not os.path.exists("LVT"): - print("ERROR, LVT executable does not exist!") - sys.exit(1) - -# Loop through each invocation, create a batch script, and launch the -# batch script -for var in vars: - scriptname = "run_lvt.%s_24hr.sh" % (var) - f = open(scriptname, "w") - line = """#!/bin/sh -#PBS -A %s\n""" % (project_code) - line += """#PBS -j oe -#PBS -l walltime=0:15:00 -#PBS -l select=1:ncpus=32 -#PBS -N %s.24hr\n""" % (var) - line += """#PBS -q %s\n""" % (reservation) - line += """$PBS -W sandbox=PRIVATE -#PBS -V - -module use --append ~jim/README -module load lis_7_intel_17_0_2_174 -ulimit -c unlimited -ulimit -m unlimited -ulimit -s unlimited - -cd "$PBS_O_WORKDIR" || exit 1 -echo `pwd` - -if [ ! -e ./LVT ] ; then - echo "ERROR, LVT does not exist!" && exit 1 -fi - -if [ ! -e lvt.config.%s.24hr ] ; then - echo "ERROR, lvt.config.%s.24hr does not exist!" && exit 1 -fi - -aprun -n 1 -j 1 ./LVT lvt.config.%s.24hr || exit 1 - -exit 0 -""" % (var, var, var) - f.write(line) - f.close() - - cmd = "qsub %s" % (scriptname) - print(cmd) - rc = subprocess.call(cmd, shell=True) - if rc != 0: - print("[ERR] Problem with qsub!") - sys.exit(1) - time.sleep(1) # Don't overwhelm PBS! diff --git a/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noahmp.py b/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noahmp.py deleted file mode 100755 index e662ced1f..000000000 --- a/lvt/utils/afwa/templates/submit_lvt_conrad_24hr_noahmp.py +++ /dev/null @@ -1,92 +0,0 @@ -#!/usr/bin/env python3 - -#-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- -# NASA Goddard Space Flight Center -# Land Information System Framework (LISF) -# Version 7.3 -# -# Copyright (c) 2020 United States Government as represented by the -# Administrator of the National Aeronautics and Space Administration. -# All Rights Reserved. -#-------------------------END NOTICE -- DO NOT EDIT----------------------- - -import os -import subprocess -import sys -import time - -vars = ["SoilMoist_tavg", "SoilTemp_tavg", - "RHMin_inst", - "Evap_tavg", "LWdown_f_tavg", - "SWdown_f_tavg", - "Tair_f_max", - "Tair_f_tavg", - "TotalPrecip_acc", "Wind_f_tavg"] - -# Handle command line - - -def usage(): - print("Usage: %s chargecode queue" % (sys.argv[0])) - print(" where chargecode is PBS project_code") - print(" and queue is PBS queue OR reservation number") - - -if len(sys.argv) != 3: - print("ERROR, problem with command line arguments!") - usage() - sys.exit(1) -project_code = sys.argv[1] -reservation = sys.argv[2] - -# Make sure LVT executable is in place before launching jobs -if not os.path.exists("LVT"): - print("ERROR, LVT executable does not exist!") - sys.exit(1) - -# Loop through each invocation, create a batch script, and launch the -# batch script -for var in vars: - scriptname = "run_lvt.%s_24hr.sh" % (var) - f = open(scriptname, "w") - line = """#!/bin/sh -#PBS -A %s\n""" % (project_code) - line += """#PBS -j oe -#PBS -l walltime=0:15:00 -#PBS -l select=1:ncpus=32 -#PBS -N %s.24hr\n""" % (var) - line += """#PBS -q %s\n""" % (reservation) - line += """$PBS -W sandbox=PRIVATE -#PBS -V - -module use --append ~jim/README -module load lis_7_intel_17_0_2_174 -ulimit -c unlimited -ulimit -m unlimited -ulimit -s unlimited - -cd "$PBS_O_WORKDIR" || exit 1 -echo `pwd` - -if [ ! -e ./LVT ] ; then - echo "ERROR, LVT does not exist!" && exit 1 -fi - -if [ ! -e lvt.config.%s.24hr ] ; then - echo "ERROR, lvt.config.%s.24hr does not exist!" && exit 1 -fi - -aprun -n 1 -j 1 ./LVT lvt.config.%s.24hr || exit 1 - -exit 0 -""" % (var, var, var) - f.write(line) - f.close() - - cmd = "qsub %s" % (scriptname) - print(cmd) - rc = subprocess.call(cmd, shell=True) - if rc != 0: - print("[ERR] Problem with qsub!") - sys.exit(1) - time.sleep(1) # Don't overwhelm PBS! diff --git a/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_jules.py deleted file mode 100755 index 98f98915b..000000000 --- a/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_jules.py +++ /dev/null @@ -1,103 +0,0 @@ -#!/usr/bin/env python3 - -#-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- -# NASA Goddard Space Flight Center -# Land Information System Framework (LISF) -# Version 7.3 -# -# Copyright (c) 2020 United States Government as represented by the -# Administrator of the National Aeronautics and Space Administration. -# All Rights Reserved. -#-------------------------END NOTICE -- DO NOT EDIT----------------------- - -import os -import subprocess -import sys -import time - -vars = ['RelSMC_inst', 'SmLiqFrac_inst', - 'SoilMoist_inst', 'SoilMoist_tavg', - 'SoilTemp_inst', 'SoilTemp_tavg', - 'RHMin_inst', - 'Albedo_tavg', 'AvgSurfT_inst', 'AvgSurfT_tavg', - 'CanopInt_inst', 'Elevation_inst', 'Evap_tavg', - 'LWdown_f_inst', 'LWdown_f_tavg', - 'Landcover_inst', 'Landmask_inst', - 'Psurf_f_inst', 'Psurf_f_tavg', - 'Qair_f_inst', 'Qair_f_tavg', - 'Qh_tavg', 'Qle_tavg', - 'Qs_acc', 'Qsb_acc', - 'SWE_inst', - 'SWdown_f_inst', 'SWdown_f_tavg', - 'SnowDepth_inst', 'Snowcover_inst', - 'Tair_f_inst', 'Tair_f_max', - 'Tair_f_tavg', - 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg'] - -# Handle command line - - -def usage(): - print("Usage: %s chargecode queue" % (sys.argv[0])) - print(" where chargecode is PBS project_code") - print(" and queue is PBS queue OR reservation number") - - -if len(sys.argv) != 3: - print("ERROR, problem with command line arguments!") - usage() - sys.exit(1) -project_code = sys.argv[1] -reservation = sys.argv[2] - -# Make sure LVT executable is in place before launching jobs -if not os.path.exists("LVT"): - print("ERROR, LVT executable does not exist!") - sys.exit(1) - -# Loop through each invocation, create a batch script, and launch the -# batch script. -for var in vars: - scriptname = "run_lvt.%s_3hr.sh" % (var) - f = open(scriptname, "w") - line = """#!/bin/sh -#PBS -A %s\n""" % (project_code) - line += """#PBS -j oe -#PBS -l walltime=0:15:00 -#PBS -l select=1:ncpus=32 -#PBS -N %s.3hr\n""" % (var) - line += """#PBS -q %s\n""" % (reservation) - line += """#PBS -W sandbox=PRIVATE -#PBS -V - -module use --append ~jim/README -module load lis_7_intel_17_0_2_174 -ulimit -c unlimited -ulimit -m unlimited -ulimit -s unlimited - -cd "$PBS_O_WORKDIR" || exit 1 -echo `pwd` - -if [ ! -e ./LVT ] ; then - echo "ERROR, LVT does not exist!" && exit 1 -fi - -if [ ! -e lvt.config.%s.3hr ] ; then - echo "ERROR, lvt.config.%s.3hr does not exist!" && exit 1 -fi - -aprun -n 1 -j 1 ./LVT lvt.config.%s.3hr || exit 1 - -exit 0 -""" % (var, var, var) - f.write(line) - f.close() - - cmd = "qsub %s" % (scriptname) - print(cmd) - rc = subprocess.call(cmd, shell=True) - if rc != 0: - print("[ERR] Problem with qsub!") - sys.exit(1) - time.sleep(1) # Don't overwhelm PBS! diff --git a/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noah.py b/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noah.py deleted file mode 100755 index b6a11abd0..000000000 --- a/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noah.py +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/env python3 - -#-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- -# NASA Goddard Space Flight Center -# Land Information System Framework (LISF) -# Version 7.3 -# -# Copyright (c) 2020 United States Government as represented by the -# Administrator of the National Aeronautics and Space Administration. -# All Rights Reserved. -#-------------------------END NOTICE -- DO NOT EDIT----------------------- - -import os -import subprocess -import sys -import time - -vars = ['RelSMC_inst', 'SmLiqFrac_inst', - 'SoilMoist_inst', 'SoilMoist_tavg', - 'SoilTemp_inst', 'SoilTemp_tavg', - 'RHMin_inst', - 'Albedo_tavg', 'AvgSurfT_inst', 'AvgSurfT_tavg', - 'CanopInt_inst', 'Elevation_inst', 'Evap_tavg', - 'Greenness_inst', - 'LWdown_f_inst', 'LWdown_f_tavg', - 'Landcover_inst', 'Landmask_inst', 'PotEvap_tavg', - 'Psurf_f_inst', 'Psurf_f_tavg', - 'Qair_f_inst', 'Qair_f_tavg', - 'Qg_tavg', 'Qh_tavg', 'Qle_tavg', 'Qs_acc', - 'Qsb_acc', 'SWE_inst', - 'SWdown_f_inst', 'SWdown_f_tavg', - 'SnowDepth_inst', 'Snowcover_inst', - 'Soiltype_inst', - 'Tair_f_inst', 'Tair_f_max', - 'Tair_f_tavg', - 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg'] - -# Handle command line - - -def usage(): - print("Usage: %s chargecode queue" % (sys.argv[0])) - print(" where chargecode is PBS project_code") - print(" and queue is PBS queue OR reservation number") - - -if len(sys.argv) != 3: - print("ERROR, problem with command line arguments!") - usage() - sys.exit(1) -project_code = sys.argv[1] -reservation = sys.argv[2] - -# Make sure LVT executable is in place before launching jobs -if not os.path.exists("LVT"): - print("ERROR, LVT executable does not exist!") - sys.exit(1) - -# Loop through each invocation, create a batch script, and launch the -# batch script. -for var in vars: - scriptname = "run_lvt.%s_3hr.sh" % (var) - f = open(scriptname, "w") - line = """#!/bin/sh -#PBS -A %s\n""" % (project_code) - line += """#PBS -j oe -#PBS -l walltime=0:15:00 -#PBS -l select=1:ncpus=32 -#PBS -N %s.3hr\n""" % (var) - line += """#PBS -q %s\n""" % (reservation) - line += """#PBS -W sandbox=PRIVATE -#PBS -V - -module use --append ~jim/README -module load lis_7_intel_17_0_2_174 -ulimit -c unlimited -ulimit -m unlimited -ulimit -s unlimited - -cd "$PBS_O_WORKDIR" || exit 1 -echo `pwd` - -if [ ! -e ./LVT ] ; then - echo "ERROR, LVT does not exist!" && exit 1 -fi - -if [ ! -e lvt.config.%s.3hr ] ; then - echo "ERROR, lvt.config.%s.3hr does not exist!" && exit 1 -fi - -aprun -n 1 -j 1 ./LVT lvt.config.%s.3hr || exit 1 - -exit 0 -""" % (var, var, var) - f.write(line) - f.close() - - cmd = "qsub %s" % (scriptname) - print(cmd) - rc = subprocess.call(cmd, shell=True) - if rc != 0: - print("[ERR] Problem with qsub!") - sys.exit(1) - time.sleep(1) # Don't overwhelm PBS! diff --git a/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noahmp.py b/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noahmp.py deleted file mode 100755 index c0555ca6b..000000000 --- a/lvt/utils/afwa/templates/submit_lvt_conrad_3hr_noahmp.py +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/env python3 - -#-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- -# NASA Goddard Space Flight Center -# Land Information System Framework (LISF) -# Version 7.3 -# -# Copyright (c) 2020 United States Government as represented by the -# Administrator of the National Aeronautics and Space Administration. -# All Rights Reserved. -#-------------------------END NOTICE -- DO NOT EDIT----------------------- - -import os -import subprocess -import sys -import time - -vars = ['RelSMC_inst', 'SmLiqFrac_inst', - 'SoilMoist_inst', 'SoilMoist_tavg', - 'SoilTemp_inst', 'SoilTemp_tavg', - 'RHMin_inst', - 'Albedo_tavg', 'AvgSurfT_inst', 'AvgSurfT_tavg', - 'CanopInt_inst', 'Elevation_inst', 'Evap_tavg', - 'Greenness_inst', - 'LWdown_f_inst', 'LWdown_f_tavg', - 'Landcover_inst', 'Landmask_inst', - 'Psurf_f_inst', 'Psurf_f_tavg', - 'Qair_f_inst', 'Qair_f_tavg', - 'Qg_tavg', 'Qh_tavg', 'Qle_tavg', 'Qs_acc', - 'Qsb_acc', 'SWE_inst', - 'SWdown_f_inst', 'SWdown_f_tavg', - 'SnowDepth_inst', 'Snowcover_inst', - 'Soiltype_inst', - 'Tair_f_inst', 'Tair_f_max', - 'Tair_f_tavg', - 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg'] - -# Handle command line - - -def usage(): - print("Usage: %s chargecode queue" % (sys.argv[0])) - print(" where chargecode is PBS project_code") - print(" and queue is PBS queue OR reservation number") - - -if len(sys.argv) != 3: - print("ERROR, problem with command line arguments!") - usage() - sys.exit(1) -project_code = sys.argv[1] -reservation = sys.argv[2] - -# Make sure LVT executable is in place before launching jobs -if not os.path.exists("LVT"): - print("ERROR, LVT executable does not exist!") - sys.exit(1) - -# Loop through each invocation, create a batch script, and launch the -# batch script. -for var in vars: - scriptname = "run_lvt.%s_3hr.sh" % (var) - f = open(scriptname, "w") - line = """#!/bin/sh -#PBS -A %s\n""" % (project_code) - line += """#PBS -j oe -#PBS -l walltime=0:15:00 -#PBS -l select=1:ncpus=32 -#PBS -N %s.3hr\n""" % (var) - line += """#PBS -q %s\n""" % (reservation) - line += """#PBS -W sandbox=PRIVATE -#PBS -V - -module use --append ~jim/README -module load lis_7_intel_17_0_2_174 -ulimit -c unlimited -ulimit -m unlimited -ulimit -s unlimited - -cd "$PBS_O_WORKDIR" || exit 1 -echo `pwd` - -if [ ! -e ./LVT ] ; then - echo "ERROR, LVT does not exist!" && exit 1 -fi - -if [ ! -e lvt.config.%s.3hr ] ; then - echo "ERROR, lvt.config.%s.3hr does not exist!" && exit 1 -fi - -aprun -n 1 -j 1 ./LVT lvt.config.%s.3hr || exit 1 - -exit 0 -""" % (var, var, var) - f.write(line) - f.close() - - cmd = "qsub %s" % (scriptname) - print(cmd) - rc = subprocess.call(cmd, shell=True) - if rc != 0: - print("[ERR] Problem with qsub!") - sys.exit(1) - time.sleep(1) # Don't overwhelm PBS! From 060e8619ec7f20233e243e46e2e40a6a60f425d8 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 4 Mar 2021 14:37:09 -0500 Subject: [PATCH 14/64] Updated to PS41 (multi-layer snow physics). --- .../templates/submit_lvt_koehr_3hr_jules.py | 20 +++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/lvt/utils/afwa/templates/submit_lvt_koehr_3hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_koehr_3hr_jules.py index e783af52c..136f3c864 100755 --- a/lvt/utils/afwa/templates/submit_lvt_koehr_3hr_jules.py +++ b/lvt/utils/afwa/templates/submit_lvt_koehr_3hr_jules.py @@ -32,10 +32,26 @@ 'SnowDepth_inst', 'Snowcover_inst', 'Tair_f_inst', 'Tair_f_max', 'Tair_f_tavg', - 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg'] + 'TotalPrecip_acc', 'Wind_f_inst', 'Wind_f_tavg', + "ActSnowNL_inst", "GrndSnow_inst", + "LayerSnowDensity_inst", "LayerSnowDepth_inst", + "LayerSnowGrain_inst", "SnowDensity_inst", + "SnowGrain_inst", "SnowIce_inst", + "SnowLiq_inst", "SnowTProf_inst", + "SurftSnow_inst"] + +# # EMK GALWEM TESTING +# vars = ["SoilMoist_inst", "SoilTemp_inst", +# "AvgSurfT_inst", +# 'SnowDepth_inst', 'SWE_inst', +# "ActSnowNL_inst", "GrndSnow_inst", +# "LayerSnowDensity_inst", "LayerSnowDepth_inst", +# "LayerSnowGrain_inst", "SnowDensity_inst", +# "SnowGrain_inst", "SnowIce_inst", +# "SnowLiq_inst", "SnowTProf_inst", +# "SurftSnow_inst"] # Handle command line - def usage(): print("Usage: %s chargecode queue" % (sys.argv[0])) print(" where chargecode is PBS project_code") From 417ce982f21be1cc2a71823256d137135319a939 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 11 Mar 2021 11:36:15 -0500 Subject: [PATCH 15/64] First prototype of LIS-JULES PS41 snow postprocessing code. This is committed to the repository for reference, but will not be used as-is in LVT. --- lvt/runmodes/557post/lis_jules_en_snow.F90 | 340 +++++++++++++++++++++ 1 file changed, 340 insertions(+) create mode 100644 lvt/runmodes/557post/lis_jules_en_snow.F90 diff --git a/lvt/runmodes/557post/lis_jules_en_snow.F90 b/lvt/runmodes/557post/lis_jules_en_snow.F90 new file mode 100644 index 000000000..5545922e4 --- /dev/null +++ b/lvt/runmodes/557post/lis_jules_en_snow.F90 @@ -0,0 +1,340 @@ +! Developer note: +! lis_jules_en_snow module is developed for creating a conceptual snowpack +! based on LIS-JULES ensemble simulation. The steps are consistent with +! JULES physics defined in the JULES subroutines "layersnow" and "relayersnow". +! Consistencies of snow mass and internal energy have been kept between ensemble +! means and the new snowpack. +! Shugong Wang (shugong.wang@nasa.gov) 03/10/2021 + + +module lis_jules_en_snow + implicit none + integer, parameter :: nlayer = 3 ! + integer, parameter :: nensem = 12 ! + + real, parameter, dimension(3) :: dzsnow= [0.04, 0.12, 0.34] + + real, parameter :: hcapi = 2100.0 + real, parameter :: hcapw = 4180.0 + real, parameter :: tm = 273.15 + + integer, parameter :: i_relayer_opt = 1 ! i_relayer_opt is either 0 (ip_relayer_linear) or 1 (ip_relayer_rgrain_inv) + ! i_relayer_opt should be consistent to JULES snow name list file + integer, parameter :: ip_relayer_linear = 0 ! *** relayer based on thickness + integer, parameter :: ip_relayer_rgrain_inv = 1 ! *** as the linear scheme, but relayering the inverse of the grain size + + ! input part, populate the following input variables before calling the step subroutines + real, dimension(nensem, nlayer) :: en_sice + real, dimension(nensem, nlayer) :: en_sliq + real, dimension(nensem, nlayer) :: en_tsnow + real, dimension(nensem, nlayer) :: en_rgrainl + real, dimension(nensem, nlayer) :: en_ds + integer, dimension(nensem) :: en_nsnow + + + ! local part + real, dimension(nensem, nlayer) :: en_C ! heat capacity (J/kg/K) + real, dimension(nensem, nlayer) :: en_e ! internal energy (J/m2) + + real, dimension(0:nlayer) :: sice0 ! average ice water content across ensemble for each snow laye + real, dimension(0:nlayer) :: sliq0 ! average liquid water content across ensemble for each snow layer + real, dimension(0:nlayer) :: e0 ! average internal energy across ensemble for each snow layer + real, dimension(0:nlayer) :: r0 ! weighted average of grain size across ensemble for each snow layer + real, dimension(0:nlayer) :: d0 ! average depth across ensemble for each snow layer + real, dimension(nlayer) :: u0 ! layer energy contents. + real, dimension(nlayer) :: newremains ! available (unfilled) depth in new layer (m). + real :: D ! average snow depth: D = sum of d0 over snow layers + real, parameter :: thin_snow_limit = 1.0e-6 + +! output part, grab values in these variables after calling the step subroutines + real, dimension(nlayer) :: new_ds + real, dimension(nlayer) :: new_sice + real, dimension(nlayer) :: new_sliq + real, dimension(nlayer) :: new_tsnow + real, dimension(nlayer) :: new_rgrainl + real, dimension(nlayer) :: new_rho_snow + real :: new_snowmass + real :: new_rgrain + real :: new_rho_snow_grnd + real :: new_snowdepth + real :: new_rho_grnd + integer :: new_nsnow + +contains + real function layer_mean(en_var_l, l) + implicit none + real, dimension(nensem, nlayer) ,intent(in):: en_var_l + integer :: l + ! local varialbes + integer :: n + real :: s + + s = 0.0 + do n =1, nensem + s = s + en_var_l(n, l) + end do + layer_mean = s/nensem + + end function + + !1. Calculate average ice water content across ensemble for each snow layer: sice0 = 1/N sum(sice) + subroutine step_1() + implicit none + integer :: l + + sice0(:) = 0.0 + do l=1, nlayer + sice0(l) = layer_mean(en_sice, l) + end do + + end subroutine step_1 + + !2. Calculate average liquid water content across ensemble for each snow layer: sliq0 = 1/N sum(sliq) + subroutine step_2() + implicit none + integer :: l + + sliq0(:) = 0.0 + do l=1, nlayer + sliq0(l) = layer_mean(en_sliq, l) + end do + + end subroutine step_2 + + !3. For each snow layer: calculate heat capacity for each ensemble member: C = sice * Ci + sliq * Cw + subroutine step_3() + implicit none + integer :: l, n + + en_C(:,:) = 0.0 + do n=1, nensem + do l=1, nlayer + en_C(n, l) = en_sice(n, l)*hcapi + en_sliq(n, l)*hcapw + end do + end do + + end subroutine step_3 + + !4. For each snow layer: calculate the energy for each ensemble member: e = C(T-Tw) + !*** Tw is assumed to be tm (temperature at which fresh water freezes and ice melts) + subroutine step_4() + implicit none + integer :: l, n + + en_e(:,:) = 0.0 + do n=1, nensem + do l=1, nlayer + en_e(n, l) = en_C(n, l)*(en_tsnow(n, l) - tm) + end do + end do + + end subroutine step_4 + + !5. Calculate average energy across ensemble for each snow layer: e0 = 1/N sum(e) + subroutine step_5() + implicit none + integer :: l + + e0(:) = 0.0 + do l=1, nlayer + e0(l) = layer_mean(en_e, l) + end do + + end subroutine step_5 + + !6. Calculate weighted average of grain size across ensemble for each snow layer: + ! r0 = 1/N sum( (sice+sliq)*r / (sice0+sliq0)) + subroutine step_6() + implicit none + integer :: l, n, n_empty + + r0(:) = 0.0 + do l=1, nlayer + n_empty = 0 + do n=1, nensem + if (sice0(l)+sliq0(0) > 0.0) then + r0(l) = r0(l) + (en_sice(n,l)+en_sliq(n,l))*en_rgrainl(n,l)/(sice0(l)+sliq0(0)) + else + n_empty = n_empty + 1 + endif + end do + if (nensem > n_empty) then + r0(l) = r0(l)/(nensem - n_empty) + else + r0(l) = 50.0 ! + endif + end do + end subroutine step_6 + + !7. Calculate average depth across ensemble for each snow layer: d0 = 1/N sum(dze) + !8. Calculate average snow depth: D = sum of d0 over snow layers + subroutine step_7_8() + implicit none + integer :: l + + D = 0.0 + do l=1, nlayer + d0(l) = layer_mean(en_ds, l) + D = D + d0(l) + end do + end subroutine step_7_8 + + !9. Calculate new snow layers depths using D as input into JULES routine layersnow (outputs new snow layer thicknesses: dz) + subroutine step_9() + implicit none + integer :: l + real :: remains + + new_ds(:) = 0.0 + ! only divide snowpack into layers if depth is >= a threshold + if (D >= dzsnow(1)) then + remains = D + do l = 1, nlayer + new_ds(l) = dzsnow(l) + + ! set number of snow layers + new_nsnow = l + + remains = remains - dzsnow(l) + if (remains <= dzsnow(l) .or. l==nlayer) then + new_ds(l) = new_ds(l) + remains + exit + end if + + end do + else + if (D>0) then + new_nsnow=1 + new_ds(1) = D + endif + endif + + new_snowdepth = sum(new_ds) + + end subroutine step_9 + + !10. Calculate new snow layer properties using the method in the JULES routine relayersnow from lines: 323 - 440 + subroutine step_10 + implicit none + real :: csnow + real :: oldremains ! remaining depth in an old layer (m). + real :: wt ! weight given to a layer value. + + integer :: l, nold, new, old, iznew, izz + real, dimension(nlayer) :: u + + ! number of (effective) layers before adjustment. + nold = maxval(en_nsnow) + + + !!! initialize accumulations for new layer values + u(:) = 0.0 + new_sice(:) = 0.0 + new_sliq(:) = 0.0 + new_rgrainl(:) = 0.0 + + !!! initialize with all new layers empty + do l = 1, new_nsnow + newremains(l) = new_ds(l) ! ! snow layer thicknesses (m), new + end do + + + iznew = 1 + ! loop over the old layers + ! 0 represent new snow. we set an empty layer 0 for this case + do old=0, nold + ! all of this old layer remains to be reassigned to new layer(s). + oldremains = d0(old) + + ! point to first new layer with remaining space. + izz = iznew + ! loop over new layers with remaining space + do new = izz, new_nsnow + if (oldremains>newremains(new)) then ! the old remains is more than the capacity of the current new layer + ! The remaining depth in the new layer will be exhausted by some or + ! all of the remaining depth from the old layer. + ! Note: newremains <-> left capacity/depth of the new layer + ! oldremains <-> remain snow of the old layer + ! decrement old layer by the remaining space in new layer. + oldremains = oldremains - newremains(new) + + ! add properties from old layers to accumulation for new layer + ! note that wt is <=1 since here we have oldremains > newremains + ! and oldremains<=d0 ??? + if ( d0(old) > thin_snow_limit) then + wt = newremains(new)/d0(old) + u(new) = u(new) + e0(old)*wt + new_sice(new) = new_sice(new) + sice0(old) * wt + new_sliq(new) = new_sliq(new) + sliq0(old) * wt + + select case(i_relayer_opt) + case (ip_relayer_linear) + new_rgrainl(new) = new_rgrainl(new) + r0(old)*newremains(new) + case (ip_relayer_rgrain_inv) + new_rgrainl(new) = new_rgrainl(new) + newremains(new)/r0(old) + end select + endif + + ! update the pointer to the next new layer with space + izz = new + 1 + + else ! the old layer will be exhausted by this increment. + ! decrement available space in the new layer. + newremains(new) = newremains(new) - oldremains + + ! add properties from old layer to accumulation for new layer + if (d0(old) > thin_snow_limit) then + wt = oldremains/d0(old) + u(new) = u(new) + e0(old)*wt + new_sice(new) = new_sice(new) + sice0(old) * wt + new_sliq(new) = new_sliq(new) + sliq0(old) * wt + select case(i_relayer_opt) + case (ip_relayer_linear) + new_rgrainl(new) = new_rgrainl(new) + r0(old)*oldremains + case (ip_relayer_rgrain_inv) + new_rgrainl(new) = new_rgrainl(new) + oldremains/r0(old) + end select + endif + ! proceed to the next old layer by exiting from the new layer loop + exit + end if + end do ! new layers + + ! update pointer to the next layer with space + iznew = izz + end do + + ! diagnose layer temperatures and densities + do l =1, new_nsnow + csnow = new_sice(l) * hcapi + new_sliq(l) * hcapw + new_tsnow(l) = tm + u(l)/csnow + new_rho_snow(l) = (new_sice(l) + new_sliq(l))/new_ds(l) + select case(i_relayer_opt) + case (ip_relayer_linear) + new_rgrainl(l) = new_rgrainl(l)/new_ds(l) + case (ip_relayer_rgrain_inv) + new_rgrainl(l) = new_ds(l)/new_rgrainl(l) + end select + end do + + ! snow surface grain size for radiative calculations + new_rgrain = new_rgrainl(1) + + + end subroutine step_10 + + !11. Calculate snowmass (sum of ice and liquid water contents) + subroutine step_11 + implicit none + integer :: l + + new_snowmass = 0.0 + do l =1, new_nsnow + new_snowmass = new_snowmass + new_sice(l) + new_sliq(l) + end do + + ! diagnose bulk density of snowpack + new_rho_grnd = new_snowmass/new_snowdepth + end subroutine step_11 +end module lis_jules_en_snow + From 1f9f92d83c81a6a923e438caf7c149b1788973eb Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 11 Mar 2021 14:28:31 -0500 Subject: [PATCH 16/64] First, incomplete JULES PS41 snow ensemble processing implementation in LVT. --- .../557post/LVT_557post_ps41_snowMod.F90 | 477 ++++++++++++++++++ 1 file changed, 477 insertions(+) create mode 100644 lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 new file mode 100644 index 000000000..f55de65ac --- /dev/null +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -0,0 +1,477 @@ +! Developer note: +! lis_jules_en_snow module is developed for creating a conceptual snowpack +! based on LIS-JULES ensemble simulation. The steps are consistent with +! JULES physics defined in the JULES subroutines "layersnow" and "relayersnow". +! Consistencies of snow mass and internal energy have been kept between +! ensemble means and the new snowpack. +! +! Shugong Wang (shugong.wang@nasa.gov) 03/10/2021 +! Editorial updates for LVT by Eric Kemp, SSAI, 11 Mar 2021 +! + +module LVT_557post_ps41_snowMod + + ! Defaults + implicit none + private + + integer, parameter :: nlayer = 3 ! JULES PS41 uses three-layer snow physics + + ! FIXME...Pass this from LVT for flexibility + !integer, parameter :: nensem = 12 + + real, parameter, dimension(3) :: dzsnow= (/ 0.04, 0.12, 0.34 /) + + real, parameter :: hcapi = 2100.0 + real, parameter :: hcapw = 4180.0 + real, parameter :: tm = 273.15 + + ! i_relayer_opt is either 0 (ip_relayer_linear) or 1 (ip_relayer_rgrain_inv) + ! i_relayer_opt should be consistent to JULES snow name list file + integer, parameter :: i_relayer_opt = 1 + + ! *** relayer based on thickness + integer, parameter :: ip_relayer_linear = 0 + + ! *** as the linear scheme, but relayering the inverse of the grain size + integer, parameter :: ip_relayer_rgrain_inv = 1 + + ! Input part, populate the following input variables before calling the + ! step subroutines + !real, dimension(nensem, nlayer) :: en_sice + !real, dimension(nensem, nlayer) :: en_sliq + !real, dimension(nensem, nlayer) :: en_tsnow + !real, dimension(nensem, nlayer) :: en_rgrainl + !real, dimension(nensem, nlayer) :: en_ds + !integer, dimension(nensem) :: en_nsnow + + real, allocatable :: en_sice(:,:) + real, allocatable :: en_sliq(:,:) + real, allocatable :: en_tsnow(:,:) + real, allocatable :: en_rgrainl(:,:) + real, allocatable :: en_ds(:,:) + integer, allocatable :: en_nsnow(:) + + ! output part, grab values in these variables after calling the step + ! subroutines + real, dimension(nlayer) :: new_ds + real, dimension(nlayer) :: new_sice + real, dimension(nlayer) :: new_sliq + real, dimension(nlayer) :: new_tsnow + real, dimension(nlayer) :: new_rgrainl + real, dimension(nlayer) :: new_rho_snow + real :: new_snowmass + real :: new_rgrain + real :: new_rho_snow_grnd + real :: new_snowdepth + real :: new_rho_grnd + integer :: new_nsnow + + ! Internal variables + !real, dimension(nensem, nlayer) :: en_C ! heat capacity (J/kg/K) + !real, dimension(nensem, nlayer) :: en_e ! internal energy (J/m2) + real, allocatable :: en_C(:,:) + real, allocatable :: en_e(:,:) + + ! Average ice water content across ensemble for each snow layer + real, dimension(0:nlayer) :: sice0 + ! Average liquid water content across ensemble for each snow layer + real, dimension(0:nlayer) :: sliq0 + ! Average internal energy across ensemble for each snow layer + real, dimension(0:nlayer) :: e0 + ! Weighted average of grain size across ensemble for each snow layer + real, dimension(0:nlayer) :: r0 + ! Average depth across ensemble for each snow layer + real, dimension(0:nlayer) :: d0 + ! Layer energy contents. + real, dimension(nlayer) :: u0 + ! Available (unfilled) depth in new layer (m). + real, dimension(nlayer) :: newremains + ! Average snow depth: D = sum of d0 over snow layers + real :: D + + real, parameter :: thin_snow_limit = 1.0e-6 + + ! Internal pointers for referencing PS41 JULES fields in LVT dataEntry + ! linked list. + real, pointer :: snowIce(:,:,:) + real, pointer :: snowLiq(:,:,:) + real, pointer :: snowTProf(:,:,:) + real, pointer :: layerSnowGrain(:,:,:) + real, pointer :: layerSnowDepth(:,:,:) + real, pointer :: ActSnowNL(:,:,:) + + ! Public routines + public :: LVT_prep_ps41_snowIce + public :: LVT_prep_ps41_snowLiq + public :: LVT_prep_ps41_snowTProf + public :: LVT_prep_ps41_layerSnowGrain + public :: LVT_prep_ps41_layerSnowDepth + public :: LVT_prep_ps41_ActSnowNL + public :: LVT_proc_jules_ps41_ens_snow +contains + + ! Allocate all arrays based on number of ensemble members. + ! Note that nlayers is hardwired since this targets PS41. + subroutine allocate_arrays(nensem) + implicit none + integer, intent(in) :: nensem + allocate(en_sice(nensem, nlayer)) + allocate(en_sliq(nensem, nlayer)) + allocate(en_tsnow(nensem, nlayer)) + allocate(en_ds(nensem, nlayer)) + allocate(en_nsnow(nensem)) + allocate(en_C(nensem, nlayer)) + allocate(en_e(nensem, nlayer)) + end subroutine allocate_arrays + + ! Nullify all pointers + subroutine nullify_pointers() + implicit none + nullify(snowIce) + nullify(snowLiq) + nullify(snowTProf) + nullify(layerSnowGrain) + nullify(layerSnowDepth) + nullify(ActSnowNL) + end subroutine nullify_pointers + + ! Deallocate memory + subroutine deallocate_arrays() + implicit none + if (allocated(en_sice)) deallocate(en_sice) + if (allocated(en_sliq)) deallocate(en_sliq) + if (allocated(en_tsnow)) deallocate(en_tsnow) + if (allocated(en_rgrainl)) deallocate(en_rgrainl) + if (allocated(en_ds)) deallocate(en_ds) + if (allocated(en_nsnow)) deallocate(en_nsnow) + if (allocated(en_C)) deallocate(en_C) + if (allocated(en_e)) deallocate(en_e) + end subroutine deallocate_arrays + + ! Calculate mean snow layer depth from ensemble members + real function layer_mean(nensem, en_var_l, l) + implicit none + integer, intent(in) :: nensem + real, dimension(nensem, nlayer) ,intent(in):: en_var_l + integer, intent(in) :: l + integer :: n + real :: s + s = 0.0 + do n = 1, nensem + s = s + en_var_l(n, l) + end do + layer_mean = s / nensem + end function layer_mean + + !1. Calculate average ice water content across ensemble for each snow + ! layer: sice0 = 1/N sum(sice) + subroutine step_1(nensem) + implicit none + integer, intent(in) :: nensem + integer :: l + sice0(:) = 0.0 + do l = 1, nlayer + sice0(l) = layer_mean(nensem, en_sice, l) + end do + end subroutine step_1 + + !2. Calculate average liquid water content across ensemble for each snow + ! layer: sliq0 = 1/N sum(sliq) + subroutine step_2(nensem) + implicit none + integer, intent(in) :: nensem + integer :: l + sliq0(:) = 0.0 + do l = 1, nlayer + sliq0(l) = layer_mean(nensem, en_sliq, l) + end do + end subroutine step_2 + + !3. For each snow layer: calculate heat capacity for each ensemble member: + ! C = sice * Ci + sliq * Cw + subroutine step_3(nensem) + implicit none + integer, intent(in) :: nensem + integer :: l, n + en_C(:,:) = 0.0 + do n = 1, nensem + do l = 1, nlayer + en_C(n,l) = en_sice(n,l)*hcapi + en_sliq(n,l)*hcapw + end do + end do + end subroutine step_3 + + !4. For each snow layer: calculate the energy for each ensemble member: + ! e = C(T-Tw) + ! *** Tw is assumed to be tm (temperature at which fresh water freezes and + ! ice melts) + subroutine step_4(nensem) + implicit none + integer, intent(in) :: nensem + integer :: l, n + en_e(:,:) = 0.0 + do n = 1, nensem + do l = 1, nlayer + en_e(n,l) = en_C(n,l)*(en_tsnow(n,l) - tm) + end do + end do + end subroutine step_4 + + !5. Calculate average energy across ensemble for each snow layer: + ! e0 = 1/N sum(e) + subroutine step_5(nensem) + implicit none + integer, intent(in) :: nensem + integer :: l + e0(:) = 0.0 + do l = 1, nlayer + e0(l) = layer_mean(nensem, en_e,l) + end do + end subroutine step_5 + + !6. Calculate weighted average of grain size across ensemble for each snow + ! layer: r0 = 1/N sum( (sice+sliq)*r / (sice0+sliq0)) + subroutine step_6(nensem) + implicit none + integer, intent(in) :: nensem + integer :: l, n, n_empty + r0(:) = 0.0 + do l = 1, nlayer + n_empty = 0 + do n = 1, nensem + if (sice0(l)+sliq0(0) > 0.0) then + r0(l) = r0(l) + & + (en_sice(n,l) + en_sliq(n,l)) * & + en_rgrainl(n,l) / (sice0(l) + sliq0(0)) + else + n_empty = n_empty + 1 + endif + end do + if (nensem > n_empty) then + r0(l) = r0(l) / (nensem - n_empty) + else + r0(l) = 50.0 ! + endif + end do + end subroutine step_6 + + !7. Calculate average depth across ensemble for each snow layer: + ! d0 = 1/N sum(dze) + !8. Calculate average snow depth: D = sum of d0 over snow layers + subroutine step_7_8(nensem) + implicit none + integer, intent(in) :: nensem + integer :: l + D = 0.0 + do l = 1, nlayer + d0(l) = layer_mean(nensem, en_ds, l) + D = D + d0(l) + end do + end subroutine step_7_8 + + !9. Calculate new snow layers depths using D as input into JULES routine + ! layersnow (outputs new snow layer thicknesses: dz) + subroutine step_9() + + implicit none + + integer :: l + real :: remains + + new_ds(:) = 0.0 + + ! only divide snowpack into layers if depth is >= a threshold + if (D >= dzsnow(1)) then + remains = D + do l = 1, nlayer + new_ds(l) = dzsnow(l) + ! set number of snow layers + new_nsnow = l + remains = remains - dzsnow(l) + if (remains <= dzsnow(l) .or. l == nlayer) then + new_ds(l) = new_ds(l) + remains + exit + end if + end do + else + if (D > 0) then + new_nsnow=1 + new_ds(1) = D + endif + endif + + new_snowdepth = sum(new_ds) + + end subroutine step_9 + + !10. Calculate new snow layer properties using the method in the JULES + ! routine relayersnow from lines: 323 - 440 + subroutine step_10() + + implicit none + + real :: csnow + real :: oldremains ! remaining depth in an old layer (m). + real :: wt ! weight given to a layer value. + integer :: l, nold, new, old, iznew, izz + real, dimension(nlayer) :: u + + ! number of (effective) layers before adjustment. + nold = maxval(en_nsnow) + + !!! initialize accumulations for new layer values + u(:) = 0.0 + new_sice(:) = 0.0 + new_sliq(:) = 0.0 + new_rgrainl(:) = 0.0 + + !!! initialize with all new layers empty + do l = 1, new_nsnow + newremains(l) = new_ds(l) ! ! snow layer thicknesses (m), new + end do + + iznew = 1 + ! loop over the old layers + ! 0 represent new snow. we set an empty layer 0 for this case + do old = 0, nold + ! all of this old layer remains to be reassigned to new layer(s). + oldremains = d0(old) + + ! point to first new layer with remaining space. + izz = iznew + ! loop over new layers with remaining space + do new = izz, new_nsnow + if (oldremains > newremains(new)) then + ! the old remains is more than the capacity of the current new layer + ! The remaining depth in the new layer will be exhausted by some or + ! all of the remaining depth from the old layer. + ! Note: newremains <-> left capacity/depth of the new layer + ! oldremains <-> remain snow of the old layer + ! decrement old layer by the remaining space in new layer. + oldremains = oldremains - newremains(new) + + ! add properties from old layers to accumulation for new layer + ! note that wt is <=1 since here we have oldremains > newremains + ! and oldremains<=d0 ??? + if ( d0(old) > thin_snow_limit) then + wt = newremains(new) / d0(old) + u(new) = u(new) + e0(old)*wt + new_sice(new) = new_sice(new) + sice0(old) * wt + new_sliq(new) = new_sliq(new) + sliq0(old) * wt + + select case(i_relayer_opt) + case (ip_relayer_linear) + new_rgrainl(new) = new_rgrainl(new) + r0(old)*newremains(new) + case (ip_relayer_rgrain_inv) + new_rgrainl(new) = new_rgrainl(new) + newremains(new)/r0(old) + end select + endif + + ! update the pointer to the next new layer with space + izz = new + 1 + + else ! the old layer will be exhausted by this increment. + ! decrement available space in the new layer. + newremains(new) = newremains(new) - oldremains + + ! add properties from old layer to accumulation for new layer + if (d0(old) > thin_snow_limit) then + wt = oldremains / d0(old) + u(new) = u(new) + e0(old)*wt + new_sice(new) = new_sice(new) + sice0(old) * wt + new_sliq(new) = new_sliq(new) + sliq0(old) * wt + select case(i_relayer_opt) + case (ip_relayer_linear) + new_rgrainl(new) = new_rgrainl(new) + r0(old)*oldremains + case (ip_relayer_rgrain_inv) + new_rgrainl(new) = new_rgrainl(new) + oldremains/r0(old) + end select + endif + ! proceed to the next old layer by exiting from the new layer loop + exit + end if + end do ! new layers + + ! update pointer to the next layer with space + iznew = izz + end do + + ! diagnose layer temperatures and densities + do l = 1, new_nsnow + csnow = new_sice(l) * hcapi + new_sliq(l) * hcapw + new_tsnow(l) = tm + u(l)/csnow + new_rho_snow(l) = (new_sice(l) + new_sliq(l)) / new_ds(l) + select case(i_relayer_opt) + case (ip_relayer_linear) + new_rgrainl(l) = new_rgrainl(l) / new_ds(l) + case (ip_relayer_rgrain_inv) + new_rgrainl(l) = new_ds(l) / new_rgrainl(l) + end select + end do + + ! snow surface grain size for radiative calculations + new_rgrain = new_rgrainl(1) + + end subroutine step_10 + + !11. Calculate snowmass (sum of ice and liquid water contents) + subroutine step_11 + implicit none + integer :: l + new_snowmass = 0.0 + do l = 1, new_nsnow + new_snowmass = new_snowmass + new_sice(l) + new_sliq(l) + end do + ! diagnose bulk density of snowpack + new_rho_grnd = new_snowmass / new_snowdepth + end subroutine step_11 + + ! Set pointer to SnowIce_inst + subroutine LVT_prep_ps41_snowIce(data) + implicit none + real, target, intent(in) :: data(:,:,:) + snowIce => data + end subroutine LVT_prep_ps41_snowIce + + ! Set pointer to SnowLiq_inst + subroutine LVT_prep_ps41_snowLiq(data) + implicit none + real, target, intent(in) :: data(:,:,:) + snowLiq => data + end subroutine LVT_prep_ps41_snowLiq + + ! Set pointer to SnowTProf_inst + subroutine LVT_prep_ps41_snowTProf(data) + implicit none + real, target, intent(in) :: data(:,:,:) + snowTProf => data + end subroutine LVT_prep_ps41_snowTProf + + ! Set pointer to LayerSnowGrain_inst + subroutine LVT_prep_ps41_layerSnowGrain(data) + implicit none + real, target, intent(in) :: data(:,:,:) + layerSnowGrain => data + end subroutine LVT_prep_ps41_layerSnowGrain + + ! Set pointer to LayerSnowDepth_inst + subroutine LVT_prep_ps41_layerSnowDepth(data) + implicit none + real, target, intent(in) :: data(:,:,:) + layerSnowDepth => data + end subroutine LVT_prep_ps41_layerSnowDepth + + ! Set pointer to ActSnowNL_inst + subroutine LVT_prep_ps41_actSnowNL(data) + implicit none + real, target, intent(in) :: data(:,:,:) + actSnowNL => data + end subroutine LVT_prep_ps41_actSnowNL + + ! Process the JULES PS41 snow variables + subroutine LVT_proc_jules_ps41_ens_snow() + implicit none + end subroutine LVT_proc_jules_ps41_ens_snow +end module LVT_557post_ps41_snowMod + From 26f16f1dd3ccd1b8c250ecdcb476ca18fc6b577d Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 11 Mar 2021 14:30:04 -0500 Subject: [PATCH 17/64] Started to add JULES PS41 snow ensemble processing. Compiles, but more work needed. --- lvt/core/LVT_DataStreamsMod.F90 | 74 ++++++++++++++++++++++++++++++++- 1 file changed, 73 insertions(+), 1 deletion(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 0955881c6..34b26ffd4 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -356,6 +356,7 @@ subroutine LVT_writeDataStreams ! !USES: use LVT_logMod use LVT_coreMod, only: LVT_LIS_rc ! EMK + use LVT_557post_ps41_snowMod ! EMK implicit none ! @@ -419,6 +420,10 @@ subroutine LVT_writeDataStreams ! EMK...For Welford algorithm integer :: count real :: mean, m2, stddev, new_value + + ! EMK...Keep track of how many JULES PS41 snow variables have been + ! prepped for ensemble processing + integer :: count_jules_ps41_vars ! EMK...This is only used when LVT is run in "557 post" mode. if (trim(LVT_rc%runmode) .ne. "557 post") return @@ -1450,7 +1455,74 @@ subroutine LVT_writeDataStreams endif dataEntry => LVT_histData%head_ds1_list + + ! EMK...Special handling of JULES PS41 multi-layer snow physics + ! when ensembles are processed. + if (trim(LVT_LIS_rc(1)%anlys_data_class) .eq. "LSM" .and. & + trim(LVT_LIS_rc(1)%model_name) .eq. "JULES.5.0" .and. & + LVT_rc%nensem .gt. 1) then + write(LVT_logunit,*) & + '[INFO] Prepare processing of JULES PS41 ensemble snow...' + count_jules_ps41_vars = 0 + do while(associated(dataEntry)) + + if (trim(dataEntry%short_name) .eq. "SnowIce_inst") then + write(LVT_logunit,*) & + '[INFO] Preparing SnowIce_inst...' + call LVT_prep_ps41_snowIce(dataEntry%value) + count_jules_ps41_vars = count_jules_ps41_vars + 1 + else if (trim(dataEntry%short_name) .eq. "SnowLiq_inst") then + write(LVT_logunit,*) & + '[INFO] Preparing SnowLiq_inst...' + call LVT_prep_ps41_snowLiq(dataEntry%value) + count_jules_ps41_vars = count_jules_ps41_vars + 1 + else if (trim(dataEntry%short_name) .eq. "SnowTProf_inst") then + write(LVT_logunit,*) & + '[INFO] Preparing SnowTProf_inst...' + call LVT_prep_ps41_snowTProf(dataEntry%value) + count_jules_ps41_vars = count_jules_ps41_vars + 1 + else if (trim(dataEntry%short_name) .eq. & + "LayerSnowGrain_inst") then + write(LVT_logunit,*) & + '[INFO] Preparing LayerSnowGrain_inst...' + call LVT_prep_ps41_layerSnowGrain(dataEntry%value) + count_jules_ps41_vars = count_jules_ps41_vars + 1 + else if (trim(dataEntry%short_name) .eq. & + "LayerSnowDepth_inst") then + write(LVT_logunit,*) & + '[INFO] Preparing LayerSnowDepth_inst...' + call LVT_prep_ps41_layerSnowDepth(dataEntry%value) + count_jules_ps41_vars = count_jules_ps41_vars + 1 + else if (trim(dataEntry%short_name) .eq. "ActSnowNL_inst") then + write(LVT_logunit,*) & + '[INFO] Preparing ActSnowNL_inst...' + call LVT_prep_ps41_ActSnowNL(dataEntry%value) + count_jules_ps41_vars = count_jules_ps41_vars + 1 + end if + + if (count_jules_ps41_vars .eq. 6) exit + dataEntry => dataEntry%next + end do + if (count_jules_ps41_vars .ne. 6) then + write(LVT_logunit,*) & + '[ERR] Cannot process JULES PS41 multi-layer snow' + write(LVT_logunit,*) & + '[ERR] Not all variables found for ensemble processing' + call LVT_endrun() + end if + + ! Go to head of list for later processing + dataEntry => LVT_histData%head_ds1_list + + ! We now have all the PS41 snow variables needed for ensemble + ! processing. We invoke the main driver. + call LVT_proc_jules_ps41_ens_snow() + end if + ! EMK END JULES PS41 Snow + + + do while(associated(dataEntry)) !reset the pointers to the head of the linked list if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then @@ -1515,7 +1587,7 @@ subroutine LVT_writeDataStreams timeRange = 7 pdTemplate = 12 end if - + ! EMK...Reworked ensemble statistics code. Allow application ! of noises smoother to each ensemble member *before* ! calculating ensemble mean and spread. From 3c6de48319a22c12e1f8d943fef21e724b16265e Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 11 Mar 2021 17:19:44 -0500 Subject: [PATCH 18/64] Further work to invoke relayering and to pull data out of module. Code compiles, but does not run. --- lvt/core/LVT_DataStreamsMod.F90 | 72 +++-- .../557post/LVT_557post_ps41_snowMod.F90 | 303 +++++++++++++++++- 2 files changed, 345 insertions(+), 30 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 34b26ffd4..185bf2121 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -423,7 +423,9 @@ subroutine LVT_writeDataStreams ! EMK...Keep track of how many JULES PS41 snow variables have been ! prepped for ensemble processing - integer :: count_jules_ps41_vars + integer :: count_jules_ps41_ens_vars + logical :: jules_ps41_ens_snow + logical :: is_ps41_snow_var ! EMK...This is only used when LVT is run in "557 post" mode. if (trim(LVT_rc%runmode) .ne. "557 post") return @@ -1458,71 +1460,79 @@ subroutine LVT_writeDataStreams ! EMK...Special handling of JULES PS41 multi-layer snow physics ! when ensembles are processed. + jules_ps41_ens_snow = .false. if (trim(LVT_LIS_rc(1)%anlys_data_class) .eq. "LSM" .and. & trim(LVT_LIS_rc(1)%model_name) .eq. "JULES.5.0" .and. & LVT_rc%nensem .gt. 1) then write(LVT_logunit,*) & '[INFO] Prepare processing of JULES PS41 ensemble snow...' - count_jules_ps41_vars = 0 + count_jules_ps41_ens_vars = 0 do while(associated(dataEntry)) - if (trim(dataEntry%short_name) .eq. "SnowIce_inst") then + if (trim(dataEntry%short_name) .eq. "SnowIce_inst" .and. & + dataEntry%vlevels .eq. 3) then write(LVT_logunit,*) & '[INFO] Preparing SnowIce_inst...' call LVT_prep_ps41_snowIce(dataEntry%value) - count_jules_ps41_vars = count_jules_ps41_vars + 1 - else if (trim(dataEntry%short_name) .eq. "SnowLiq_inst") then + count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 + else if (trim(dataEntry%short_name) .eq. "SnowLiq_inst" .and. & + dataEntry%vlevels .eq. 3) then write(LVT_logunit,*) & '[INFO] Preparing SnowLiq_inst...' call LVT_prep_ps41_snowLiq(dataEntry%value) - count_jules_ps41_vars = count_jules_ps41_vars + 1 - else if (trim(dataEntry%short_name) .eq. "SnowTProf_inst") then + count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 + else if (trim(dataEntry%short_name) .eq. "SnowTProf_inst" .and. & + dataEntry%vlevels .eq. 3) then write(LVT_logunit,*) & '[INFO] Preparing SnowTProf_inst...' call LVT_prep_ps41_snowTProf(dataEntry%value) - count_jules_ps41_vars = count_jules_ps41_vars + 1 + count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 else if (trim(dataEntry%short_name) .eq. & - "LayerSnowGrain_inst") then + "LayerSnowGrain_inst" .and. & + dataEntry%vlevels .eq. 3) then write(LVT_logunit,*) & '[INFO] Preparing LayerSnowGrain_inst...' call LVT_prep_ps41_layerSnowGrain(dataEntry%value) - count_jules_ps41_vars = count_jules_ps41_vars + 1 + count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 else if (trim(dataEntry%short_name) .eq. & - "LayerSnowDepth_inst") then + "LayerSnowDepth_inst" .and. & + dataEntry%vlevels .eq. 3) then write(LVT_logunit,*) & '[INFO] Preparing LayerSnowDepth_inst...' call LVT_prep_ps41_layerSnowDepth(dataEntry%value) - count_jules_ps41_vars = count_jules_ps41_vars + 1 + count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 else if (trim(dataEntry%short_name) .eq. "ActSnowNL_inst") then write(LVT_logunit,*) & '[INFO] Preparing ActSnowNL_inst...' call LVT_prep_ps41_ActSnowNL(dataEntry%value) - count_jules_ps41_vars = count_jules_ps41_vars + 1 + count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 end if - if (count_jules_ps41_vars .eq. 6) exit + if (count_jules_ps41_ens_vars .eq. 6) exit dataEntry => dataEntry%next end do - if (count_jules_ps41_vars .ne. 6) then + + if (count_jules_ps41_ens_vars .ne. 6) then write(LVT_logunit,*) & '[ERR] Cannot process JULES PS41 multi-layer snow' write(LVT_logunit,*) & '[ERR] Not all variables found for ensemble processing' call LVT_endrun() + else + jules_ps41_ens_snow = .true. end if ! Go to head of list for later processing dataEntry => LVT_histData%head_ds1_list ! We now have all the PS41 snow variables needed for ensemble - ! processing. We invoke the main driver. + ! processing. We invoke the main driver. The output variables + ! will be fetched further down. call LVT_proc_jules_ps41_ens_snow() - + end if ! EMK END JULES PS41 Snow - - do while(associated(dataEntry)) !reset the pointers to the head of the linked list if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then @@ -1589,12 +1599,28 @@ subroutine LVT_writeDataStreams end if ! EMK...Reworked ensemble statistics code. Allow application - ! of noises smoother to each ensemble member *before* + ! of noises smoother to each ensemble member *before* ! calculating ensemble mean and spread. - do k=1,dataEntry%vlevels + do k=1, dataEntry%vlevels gtmp1_1d(:) = 0.0 ngtmp1_1d(:) = 0 gtmp1_ss(:) = 0.0 + + ! EMK...Special handling for JULES PS41 snow variables. + ! In this case, we do not take raw ensemble means, but + ! instead apply a JULES-based relayering. This calculation + ! was done higher up; here we pull the requested variable + ! for output to file. + is_ps41_snow_var = .false. + if (jules_ps41_ens_snow) then + call LVT_fetch_final(LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + k, trim(dataEntry%short_name), is_ps41_snow_var) + if (is_ps41_snow_var) then + !...CODE HERE FOR WRITING TO OUTPUT + end if + cycle + end if + do m=1,LVT_rc%nensem ! Must initialize ensemble member with "undefined" for @@ -1688,7 +1714,7 @@ subroutine LVT_writeDataStreams enddo ! c enddo ! r ! EMK END...k loop ends further down - + if(LVT_rc%lvt_out_format.eq."grib2") then call writeSingleGrib2Var(ftn_mean,& @@ -1786,7 +1812,7 @@ subroutine LVT_writeDataStreams end if endif - enddo + enddo ! k exit endif lisdataEntry => lisdataEntry%next diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index f55de65ac..331852e45 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -101,6 +101,21 @@ module LVT_557post_ps41_snowMod real, pointer :: layerSnowDepth(:,:,:) real, pointer :: ActSnowNL(:,:,:) + ! Internal arrays for storing processed multi-layer snow + real, allocatable :: snowIce_final(:,:) + real, allocatable :: snowLiq_final(:,:) + real, allocatable :: snowTProf_final(:,:) + real, allocatable :: layerSnowGrain_final(:,:) + real, allocatable :: layerSnowDepth_final(:,:) + real, allocatable :: actSnowNL_final(:) + real, allocatable :: layerSnowDensity_final(:,:) + real, allocatable :: surftSnow_final(:) + real, allocatable :: snowGrain_final(:) + !real, allocatable :: new_rho_snow_grnd??? + real, allocatable :: snowDepth_final(:) + !real, allocatable :: new_rho_grnd??? + real, allocatable :: SWE_final(:) + ! Public routines public :: LVT_prep_ps41_snowIce public :: LVT_prep_ps41_snowLiq @@ -109,21 +124,57 @@ module LVT_557post_ps41_snowMod public :: LVT_prep_ps41_layerSnowDepth public :: LVT_prep_ps41_ActSnowNL public :: LVT_proc_jules_ps41_ens_snow + public :: LVT_fetch_final contains - ! Allocate all arrays based on number of ensemble members. + ! Allocate all step arrays based on number of ensemble members. ! Note that nlayers is hardwired since this targets PS41. - subroutine allocate_arrays(nensem) + subroutine allocate_step_arrays(nensem) implicit none integer, intent(in) :: nensem allocate(en_sice(nensem, nlayer)) allocate(en_sliq(nensem, nlayer)) allocate(en_tsnow(nensem, nlayer)) + allocate(en_rgrainl(nensem, nlayer)) allocate(en_ds(nensem, nlayer)) allocate(en_nsnow(nensem)) allocate(en_C(nensem, nlayer)) allocate(en_e(nensem, nlayer)) - end subroutine allocate_arrays + end subroutine allocate_step_arrays + + ! Allocate arrays for final data + subroutine allocate_final_arrays(nc, nr) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + allocate(snowIce_final(nc*nr, nlayer)) + allocate(snowLiq_final(nc*nr, nlayer)) + allocate(snowTProf_final(nc*nr, nlayer)) + allocate(layerSnowGrain_final(nc*nr, nlayer)) + allocate(layerSnowDepth_final(nc*nr, nlayer)) + allocate(actSnowNL_final(nc*nr)) + allocate(layerSnowDensity_final(nc*nr, nlayer)) + allocate(surftSnow_final(nc*nr)) + allocate(snowGrain_final(nc*nr)) + allocate(snowDepth_final(nc*nr)) + allocate(SWE_final(nc*nr)) + end subroutine allocate_final_arrays + + ! Deallocate arrays for final data + subroutine deallocate_final_arrays() + implicit none + if (allocated(snowIce_final)) deallocate(snowIce_final) + if (allocated(snowLiq_final)) deallocate(snowLiq_final) + if (allocated(snowTProf_final)) deallocate(snowTProf_final) + if (allocated(layerSnowGrain_final)) deallocate(layerSnowGrain_final) + if (allocated(layerSnowDepth_final)) deallocate(layerSnowDepth_final) + if (allocated(actSnowNL_final)) deallocate(actSnowNL_final) + if (allocated(layerSnowDensity_final)) deallocate(layerSnowDensity_final) + if (allocated(surftSnow_final)) deallocate(surftSnow_final) + if (allocated(snowGrain_final)) deallocate(snowGrain_final) + if (allocated(snowDepth_final)) deallocate(snowDepth_final) + if (allocated(SWE_final)) deallocate(SWE_final) + end subroutine deallocate_final_arrays ! Nullify all pointers subroutine nullify_pointers() @@ -136,8 +187,9 @@ subroutine nullify_pointers() nullify(ActSnowNL) end subroutine nullify_pointers - ! Deallocate memory - subroutine deallocate_arrays() + ! Deallocate memory for step routines. Final arrays are preserved for + ! later extraction by LVT. + subroutine deallocate_step_arrays() implicit none if (allocated(en_sice)) deallocate(en_sice) if (allocated(en_sliq)) deallocate(en_sliq) @@ -147,7 +199,7 @@ subroutine deallocate_arrays() if (allocated(en_nsnow)) deallocate(en_nsnow) if (allocated(en_C)) deallocate(en_C) if (allocated(en_e)) deallocate(en_e) - end subroutine deallocate_arrays + end subroutine deallocate_step_arrays ! Calculate mean snow layer depth from ensemble members real function layer_mean(nensem, en_var_l, l) @@ -416,7 +468,7 @@ subroutine step_10() end subroutine step_10 !11. Calculate snowmass (sum of ice and liquid water contents) - subroutine step_11 + subroutine step_11() implicit none integer :: l new_snowmass = 0.0 @@ -431,6 +483,7 @@ end subroutine step_11 subroutine LVT_prep_ps41_snowIce(data) implicit none real, target, intent(in) :: data(:,:,:) + nullify(snowIce) snowIce => data end subroutine LVT_prep_ps41_snowIce @@ -438,6 +491,7 @@ end subroutine LVT_prep_ps41_snowIce subroutine LVT_prep_ps41_snowLiq(data) implicit none real, target, intent(in) :: data(:,:,:) + nullify(snowLiq) snowLiq => data end subroutine LVT_prep_ps41_snowLiq @@ -445,6 +499,7 @@ end subroutine LVT_prep_ps41_snowLiq subroutine LVT_prep_ps41_snowTProf(data) implicit none real, target, intent(in) :: data(:,:,:) + nullify(snowTProf) snowTProf => data end subroutine LVT_prep_ps41_snowTProf @@ -452,6 +507,7 @@ end subroutine LVT_prep_ps41_snowTProf subroutine LVT_prep_ps41_layerSnowGrain(data) implicit none real, target, intent(in) :: data(:,:,:) + nullify(layerSnowGrain) layerSnowGrain => data end subroutine LVT_prep_ps41_layerSnowGrain @@ -459,6 +515,7 @@ end subroutine LVT_prep_ps41_layerSnowGrain subroutine LVT_prep_ps41_layerSnowDepth(data) implicit none real, target, intent(in) :: data(:,:,:) + nullify(layerSnowDepth) layerSnowDepth => data end subroutine LVT_prep_ps41_layerSnowDepth @@ -466,12 +523,244 @@ end subroutine LVT_prep_ps41_layerSnowDepth subroutine LVT_prep_ps41_actSnowNL(data) implicit none real, target, intent(in) :: data(:,:,:) + nullify(actSnowNL) actSnowNL => data end subroutine LVT_prep_ps41_actSnowNL ! Process the JULES PS41 snow variables subroutine LVT_proc_jules_ps41_ens_snow() + + ! Modules + use LVT_coreMod, only: LVT_domain, LVT_rc + + ! Defaults implicit none + + ! Locals + integer :: c, r, m, k, gid + + ! Initializations + call allocate_step_arrays(LVT_rc%nensem) + call allocate_final_arrays(LVT_rc%lnc, LVT_rc%lnr) + snowIce_final = LVT_rc%udef + snowLiq_final = LVT_rc%udef + snowTProf_final = LVT_rc%udef + layerSnowGrain_final = LVT_rc%udef + layerSnowDepth_final = LVT_rc%udef + actSnowNL_final = LVT_rc%udef + layerSnowDensity_final = LVT_rc%udef + surftSnow_final = LVT_rc%udef + snowGrain_final = LVT_rc%udef + snowDepth_final = LVT_rc%udef + SWE_final = LVT_rc%udef + + ! For each land point, apply PS41 ensemble post-processing + do r = 1, LVT_rc%lnr + do c = 1, LVT_rc%lnc + gid = LVT_domain%gindex(c,r) + if (gid == -1) cycle + + ! Load ensemble members into step arrays + do k = 1, nlayer + do m = 1, LVT_rc%nensem + en_sice(m,k) = snowIce(gid,m,k) + en_sliq(m,k) = snowLiq(gid,m,k) + en_tsnow(m,k) = snowTProf(gid,m,k) + en_rgrainl(m,k) = layerSnowGrain(gid,m,k) + en_ds(m,k) = layerSnowDepth(gid,m,k) + end do ! m + end do ! k + do m = 1, LVT_rc%nensem + en_nsnow(m) = actSnowNL(gid,m,1) + end do ! m + + ! Execute the relayering algorithm + call step_1(LVT_rc%nensem) + call step_2(LVT_rc%nensem) + call step_3(LVT_rc%nensem) + call step_4(LVT_rc%nensem) + call step_5(LVT_rc%nensem) + call step_6(LVT_rc%nensem) + call step_7_8(LVT_rc%nensem) + call step_9() + call step_10() + call step_11() + + ! Copy to final arrays + do k = 1, nlayer + snowIce_final(gid,k) = new_sice(k) + snowLiq_final(gid,k) = new_sliq(k) + snowTProf_final(gid,k) = new_tsnow(k) + layerSnowGrain_final(gid,k) = new_rgrainl(k) + layerSnowDepth_final(gid,k) = new_ds(k) + + layerSnowDensity_final(gid,k) = new_rho_snow(k) + end do ! k + actSnowNL_final(gid) = new_nsnow + + surftSnow_final(gid) = new_snowmass + snowGrain_final(gid) = new_rgrain + snowDepth_final(gid) = new_snowdepth + SWE_final(gid) = new_snowmass ! FIXME...Find liquid equivalent + + end do ! c + end do ! r + + ! Cleanup, but keep final arrays for later extraction by LVT + call deallocate_step_arrays() + call nullify_pointers() + end subroutine LVT_proc_jules_ps41_ens_snow + + subroutine LVT_fetch_final(nc, nr, data, k, short_name, is_ps41_snow_var) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + integer, intent(in) :: k + character(len=*), intent(in) :: short_name + logical, intent(out) :: is_ps41_snow_var + is_ps41_snow_var = .false. + if (trim(short_name) .eq. "SnowIce_inst") then + call LVT_fetch_snowIce_final(nc, nr, data, k) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "SnowLiq_inst") then + call LVT_fetch_snowLiq_final(nc, nr, data, k) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "SnowTProf_inst") then + call LVT_fetch_snowTProf_final(nc, nr, data, k) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "LayerSnowGrain_inst") then + call LVT_fetch_layerSnowGrain_final(nc, nr, data, k) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "LayerSnowDepth_inst") then + call LVT_fetch_layerSnowDepth_final(nc, nr, data, k) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "ActSnowNL_inst") then + call LVT_fetch_actSnowNL_final(nc, nr, data) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "LayerSnowDensity_inst") then + call LVT_fetch_layerSnowDensity_final(nc, nr, data, k) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "SurftSnow_inst") then + call LVT_fetch_surftSnow_final(nc, nr, data) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "SnowGrain_inst") then + call LVT_fetch_SnowGrain_final(nc, nr, data) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "SnowDepth_inst") then + call LVT_fetch_SnowDepth_final(nc, nr, data) + is_ps41_snow_var = .true. + else if (trim(short_name) .eq. "SWE_inst") then + call LVT_fetch_SWE_final(nc, nr, data) + is_ps41_snow_var = .true. + end if + end subroutine LVT_fetch_final + + ! Pass SnowIce back + subroutine LVT_fetch_snowIce_final(nc, nr, data, k) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + integer, intent(in) :: k + data(:) = snowIce_final(:,k) + end subroutine LVT_fetch_snowIce_final + + ! Pass SnowLiq back + subroutine LVT_fetch_snowLiq_final(nc, nr, data, k) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + integer, intent(in) :: k + data(:) = snowLiq_final(:,k) + end subroutine LVT_fetch_snowLiq_final + + ! Pass SnowtProf back + subroutine LVT_fetch_snowtProf_final(nc, nr, data, k) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + integer, intent(in) :: k + data(:) = snowtProf_final(:,k) + end subroutine LVT_fetch_snowtProf_final + + ! Pass layerSnowGrain back + subroutine LVT_fetch_layerSnowGrain_final(nc, nr, data, k) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + integer, intent(in) :: k + data(:) = layerSnowGrain_final(:,k) + end subroutine LVT_fetch_layerSnowGrain_final + + ! Pass layerSnowDepth back + subroutine LVT_fetch_layerSnowDepth_final(nc, nr, data, k) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + integer, intent(in) :: k + data(:) = layerSnowDepth_final(:,k) + end subroutine LVT_fetch_layerSnowDepth_final + + ! Pass actSnowNL back + subroutine LVT_fetch_actSnowNL_final(nc, nr, data) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + data(:) = actSnowNL_final(:) + end subroutine LVT_fetch_actSnowNL_final + + ! Pass layerSnowDensity back + subroutine LVT_fetch_layerSnowDensity_final(nc, nr, data, k) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + integer, intent(in) :: k + data(:) = layerSnowDensity_final(:,k) + end subroutine LVT_fetch_layerSnowDensity_final + + ! Pass surftSnow back + subroutine LVT_fetch_surftSnow_final(nc, nr, data) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + data(:) = surftSnow_final(:) + end subroutine LVT_fetch_surftSnow_final + + ! Pass snowGrain back + subroutine LVT_fetch_snowGrain_final(nc, nr, data) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + data(:) = snowGrain_final(:) + end subroutine LVT_fetch_snowGrain_final + + ! Pass snowDepth back + subroutine LVT_fetch_snowDepth_final(nc, nr, data) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + data(:) = snowDepth_final(:) + end subroutine LVT_fetch_snowDepth_final + + ! Pass SWE back + subroutine LVT_fetch_SWE_final(nc, nr, data) + implicit none + integer, intent(in) :: nc + integer, intent(in) :: nr + real, intent(inout) :: data(nc*nr) + data(:) = SWE_final(:) + end subroutine LVT_fetch_SWE_final + end module LVT_557post_ps41_snowMod From d6675dac72bd39a09f6385b9850d9058afea1f04 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 12 Mar 2021 07:37:11 -0500 Subject: [PATCH 19/64] Cleaned up code to fetch "final" array based on variable name. --- .../557post/LVT_557post_ps41_snowMod.F90 | 173 ++++-------------- 1 file changed, 34 insertions(+), 139 deletions(-) diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 331852e45..0ce83c7d9 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -612,155 +612,50 @@ subroutine LVT_proc_jules_ps41_ens_snow() end subroutine LVT_proc_jules_ps41_ens_snow + ! Fetch appropriate "final" array based on requested variable name. subroutine LVT_fetch_final(nc, nr, data, k, short_name, is_ps41_snow_var) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - integer, intent(in) :: k - character(len=*), intent(in) :: short_name - logical, intent(out) :: is_ps41_snow_var - is_ps41_snow_var = .false. - if (trim(short_name) .eq. "SnowIce_inst") then - call LVT_fetch_snowIce_final(nc, nr, data, k) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "SnowLiq_inst") then - call LVT_fetch_snowLiq_final(nc, nr, data, k) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "SnowTProf_inst") then - call LVT_fetch_snowTProf_final(nc, nr, data, k) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "LayerSnowGrain_inst") then - call LVT_fetch_layerSnowGrain_final(nc, nr, data, k) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "LayerSnowDepth_inst") then - call LVT_fetch_layerSnowDepth_final(nc, nr, data, k) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "ActSnowNL_inst") then - call LVT_fetch_actSnowNL_final(nc, nr, data) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "LayerSnowDensity_inst") then - call LVT_fetch_layerSnowDensity_final(nc, nr, data, k) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "SurftSnow_inst") then - call LVT_fetch_surftSnow_final(nc, nr, data) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "SnowGrain_inst") then - call LVT_fetch_SnowGrain_final(nc, nr, data) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "SnowDepth_inst") then - call LVT_fetch_SnowDepth_final(nc, nr, data) - is_ps41_snow_var = .true. - else if (trim(short_name) .eq. "SWE_inst") then - call LVT_fetch_SWE_final(nc, nr, data) - is_ps41_snow_var = .true. - end if - end subroutine LVT_fetch_final - - ! Pass SnowIce back - subroutine LVT_fetch_snowIce_final(nc, nr, data, k) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - integer, intent(in) :: k - data(:) = snowIce_final(:,k) - end subroutine LVT_fetch_snowIce_final - - ! Pass SnowLiq back - subroutine LVT_fetch_snowLiq_final(nc, nr, data, k) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - integer, intent(in) :: k - data(:) = snowLiq_final(:,k) - end subroutine LVT_fetch_snowLiq_final - - ! Pass SnowtProf back - subroutine LVT_fetch_snowtProf_final(nc, nr, data, k) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - integer, intent(in) :: k - data(:) = snowtProf_final(:,k) - end subroutine LVT_fetch_snowtProf_final - - ! Pass layerSnowGrain back - subroutine LVT_fetch_layerSnowGrain_final(nc, nr, data, k) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - integer, intent(in) :: k - data(:) = layerSnowGrain_final(:,k) - end subroutine LVT_fetch_layerSnowGrain_final - ! Pass layerSnowDepth back - subroutine LVT_fetch_layerSnowDepth_final(nc, nr, data, k) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - integer, intent(in) :: k - data(:) = layerSnowDepth_final(:,k) - end subroutine LVT_fetch_layerSnowDepth_final - - ! Pass actSnowNL back - subroutine LVT_fetch_actSnowNL_final(nc, nr, data) + ! Defaults implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - data(:) = actSnowNL_final(:) - end subroutine LVT_fetch_actSnowNL_final - ! Pass layerSnowDensity back - subroutine LVT_fetch_layerSnowDensity_final(nc, nr, data, k) - implicit none + ! Arguments integer, intent(in) :: nc integer, intent(in) :: nr real, intent(inout) :: data(nc*nr) integer, intent(in) :: k - data(:) = layerSnowDensity_final(:,k) - end subroutine LVT_fetch_layerSnowDensity_final - - ! Pass surftSnow back - subroutine LVT_fetch_surftSnow_final(nc, nr, data) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - data(:) = surftSnow_final(:) - end subroutine LVT_fetch_surftSnow_final - - ! Pass snowGrain back - subroutine LVT_fetch_snowGrain_final(nc, nr, data) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - data(:) = snowGrain_final(:) - end subroutine LVT_fetch_snowGrain_final + character(len=*), intent(in) :: short_name + logical, intent(out) :: is_ps41_snow_var - ! Pass snowDepth back - subroutine LVT_fetch_snowDepth_final(nc, nr, data) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - data(:) = snowDepth_final(:) - end subroutine LVT_fetch_snowDepth_final + is_ps41_snow_var = .true. ! First guess + + select case(trim(short_name)) + case ("SnowIce_inst") + data(:) = snowIce_final(:,k) + case ("SnowLiq_inst") + data(:) = snowLiq_final(:,k) + case ("SnowTProf_inst") + data(:) = snowtProf_final(:,k) + case ("LayerSnowGrain_inst") + data(:) = layerSnowGrain_final(:,k) + case ("LayerSnowDepth_inst") + data(:) = layerSnowDepth_final(:,k) + case ("ActSnowNL_inst") + data(:) = actSnowNL_final(:) + case ("LayerSnowDensity_inst") + data(:) = layerSnowDensity_final(:,k) + case ("SurftSnow_inst") + data(:) = surftSnow_final(:) + case ("SnowGrain_inst") + data(:) = snowGrain_final(:) + case ("SnowDepth_inst") + data(:) = snowDepth_final(:) + case ("SWE_inst") + data(:) = SWE_final(:) + case default + is_ps41_snow_var = .false. + end select - ! Pass SWE back - subroutine LVT_fetch_SWE_final(nc, nr, data) - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nr - real, intent(inout) :: data(nc*nr) - data(:) = SWE_final(:) - end subroutine LVT_fetch_SWE_final + end subroutine LVT_fetch_final end module LVT_557post_ps41_snowMod From 825e9282361cf4e6ba8df22c0df84275b852170f Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 12 Mar 2021 08:02:11 -0500 Subject: [PATCH 20/64] Simplified code for setting pointers to PS41 snow variables. --- lvt/core/LVT_DataStreamsMod.F90 | 53 +++--------- .../557post/LVT_557post_ps41_snowMod.F90 | 86 +++++++++---------- 2 files changed, 51 insertions(+), 88 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 185bf2121..5e7a69ca3 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -423,7 +423,7 @@ subroutine LVT_writeDataStreams ! EMK...Keep track of how many JULES PS41 snow variables have been ! prepped for ensemble processing - integer :: count_jules_ps41_ens_vars + integer :: count_jules_ps41_ens_snow_vars logical :: jules_ps41_ens_snow logical :: is_ps41_snow_var @@ -1466,53 +1466,22 @@ subroutine LVT_writeDataStreams LVT_rc%nensem .gt. 1) then write(LVT_logunit,*) & '[INFO] Prepare processing of JULES PS41 ensemble snow...' - count_jules_ps41_ens_vars = 0 + count_jules_ps41_ens_snow_vars = 0 do while(associated(dataEntry)) - if (trim(dataEntry%short_name) .eq. "SnowIce_inst" .and. & - dataEntry%vlevels .eq. 3) then - write(LVT_logunit,*) & - '[INFO] Preparing SnowIce_inst...' - call LVT_prep_ps41_snowIce(dataEntry%value) - count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 - else if (trim(dataEntry%short_name) .eq. "SnowLiq_inst" .and. & - dataEntry%vlevels .eq. 3) then - write(LVT_logunit,*) & - '[INFO] Preparing SnowLiq_inst...' - call LVT_prep_ps41_snowLiq(dataEntry%value) - count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 - else if (trim(dataEntry%short_name) .eq. "SnowTProf_inst" .and. & - dataEntry%vlevels .eq. 3) then - write(LVT_logunit,*) & - '[INFO] Preparing SnowTProf_inst...' - call LVT_prep_ps41_snowTProf(dataEntry%value) - count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 - else if (trim(dataEntry%short_name) .eq. & - "LayerSnowGrain_inst" .and. & - dataEntry%vlevels .eq. 3) then - write(LVT_logunit,*) & - '[INFO] Preparing LayerSnowGrain_inst...' - call LVT_prep_ps41_layerSnowGrain(dataEntry%value) - count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 - else if (trim(dataEntry%short_name) .eq. & - "LayerSnowDepth_inst" .and. & - dataEntry%vlevels .eq. 3) then - write(LVT_logunit,*) & - '[INFO] Preparing LayerSnowDepth_inst...' - call LVT_prep_ps41_layerSnowDepth(dataEntry%value) - count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 - else if (trim(dataEntry%short_name) .eq. "ActSnowNL_inst") then - write(LVT_logunit,*) & - '[INFO] Preparing ActSnowNL_inst...' - call LVT_prep_ps41_ActSnowNL(dataEntry%value) - count_jules_ps41_ens_vars = count_jules_ps41_ens_vars + 1 + call LVT_prep_jules_ps41_ens_snow_var(dataEntry%short_name, & + dataEntry%vlevels, dataEntry%value, is_ps41_snow_var) + + if (is_ps41_snow_var) then + count_jules_ps41_ens_snow_vars = & + count_jules_ps41_ens_snow_vars + 1 end if - if (count_jules_ps41_ens_vars .eq. 6) exit + if (count_jules_ps41_ens_snow_vars .eq. 6) exit dataEntry => dataEntry%next end do - if (count_jules_ps41_ens_vars .ne. 6) then + if (count_jules_ps41_ens_snow_vars .ne. 6) then write(LVT_logunit,*) & '[ERR] Cannot process JULES PS41 multi-layer snow' write(LVT_logunit,*) & @@ -1526,7 +1495,7 @@ subroutine LVT_writeDataStreams dataEntry => LVT_histData%head_ds1_list ! We now have all the PS41 snow variables needed for ensemble - ! processing. We invoke the main driver. The output variables + ! processing. We invoke the relayer algorithm. The output variables ! will be fetched further down. call LVT_proc_jules_ps41_ens_snow() diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 0ce83c7d9..214f5fb7b 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -117,12 +117,7 @@ module LVT_557post_ps41_snowMod real, allocatable :: SWE_final(:) ! Public routines - public :: LVT_prep_ps41_snowIce - public :: LVT_prep_ps41_snowLiq - public :: LVT_prep_ps41_snowTProf - public :: LVT_prep_ps41_layerSnowGrain - public :: LVT_prep_ps41_layerSnowDepth - public :: LVT_prep_ps41_ActSnowNL + public :: LVT_prep_jules_ps41_ens_snow_var public :: LVT_proc_jules_ps41_ens_snow public :: LVT_fetch_final contains @@ -479,53 +474,52 @@ subroutine step_11() new_rho_grnd = new_snowmass / new_snowdepth end subroutine step_11 - ! Set pointer to SnowIce_inst - subroutine LVT_prep_ps41_snowIce(data) - implicit none - real, target, intent(in) :: data(:,:,:) - nullify(snowIce) - snowIce => data - end subroutine LVT_prep_ps41_snowIce + ! Set pointer to passed array based on variable name + subroutine LVT_prep_jules_ps41_ens_snow_var(short_name, vlevels, data, & + is_ps41_snow_var) - ! Set pointer to SnowLiq_inst - subroutine LVT_prep_ps41_snowLiq(data) + ! Defaults implicit none - real, target, intent(in) :: data(:,:,:) - nullify(snowLiq) - snowLiq => data - end subroutine LVT_prep_ps41_snowLiq - ! Set pointer to SnowTProf_inst - subroutine LVT_prep_ps41_snowTProf(data) - implicit none + ! Arguments + character(len=*), intent(in) :: short_name + integer, intent(in) :: vlevels real, target, intent(in) :: data(:,:,:) - nullify(snowTProf) - snowTProf => data - end subroutine LVT_prep_ps41_snowTProf + logical, intent(out) :: is_ps41_snow_var - ! Set pointer to LayerSnowGrain_inst - subroutine LVT_prep_ps41_layerSnowGrain(data) - implicit none - real, target, intent(in) :: data(:,:,:) - nullify(layerSnowGrain) - layerSnowGrain => data - end subroutine LVT_prep_ps41_layerSnowGrain + is_ps41_snow_var = .true. ! First guess - ! Set pointer to LayerSnowDepth_inst - subroutine LVT_prep_ps41_layerSnowDepth(data) - implicit none - real, target, intent(in) :: data(:,:,:) - nullify(layerSnowDepth) - layerSnowDepth => data - end subroutine LVT_prep_ps41_layerSnowDepth + ! Preliminary check for 3 vertical levels (used with PS41). + ! This doesn't apply for ActSnowNL, since that is a single layer variable. + select case(trim(short_name)) + case ("ActSnowNL_inst") + continue + case default + if (vlevels .ne. 3) then + is_ps41_snow_var = .false. + return + end if + end select - ! Set pointer to ActSnowNL_inst - subroutine LVT_prep_ps41_actSnowNL(data) - implicit none - real, target, intent(in) :: data(:,:,:) - nullify(actSnowNL) - actSnowNL => data - end subroutine LVT_prep_ps41_actSnowNL + ! Now update the appropriate pointer + select case(trim(short_name)) + case ("SnowIce_inst") + snowIce => data + case ("SnowLiq_inst") + snowLiq => data + case ("SnowTProf_inst") + snowTProf => data + case ("LayerSnowGrain_inst") + layerSnowGrain => data + case ("LayerSnowDepth_inst") + layerSnowDepth => data + case ("ActSnowNL_inst") + actSnowNL => data + case default + is_ps41_snow_var = .false. + end select + + end subroutine LVT_prep_jules_ps41_ens_snow_var ! Process the JULES PS41 snow variables subroutine LVT_proc_jules_ps41_ens_snow() From b3916a3a4995617730f7ad3afa8de01ecbc373fc Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 12 Mar 2021 09:56:40 -0500 Subject: [PATCH 21/64] First attempt at writing output for PS41 snow physics. Code compiles, but not tested yet. --- lvt/core/LVT_DataStreamsMod.F90 | 90 ++++++++++++++++--- .../557post/LVT_557post_ps41_snowMod.F90 | 51 ++++++----- 2 files changed, 110 insertions(+), 31 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 5e7a69ca3..003607b38 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -426,7 +426,7 @@ subroutine LVT_writeDataStreams integer :: count_jules_ps41_ens_snow_vars logical :: jules_ps41_ens_snow logical :: is_ps41_snow_var - + ! EMK...This is only used when LVT is run in "557 post" mode. if (trim(LVT_rc%runmode) .ne. "557 post") return @@ -1455,17 +1455,21 @@ subroutine LVT_writeDataStreams 'nf90_put_var failed for lon') end if endif - + dataEntry => LVT_histData%head_ds1_list ! EMK...Special handling of JULES PS41 multi-layer snow physics ! when ensembles are processed. + ! FIXME...Add LVT flag specifying PS41? jules_ps41_ens_snow = .false. if (trim(LVT_LIS_rc(1)%anlys_data_class) .eq. "LSM" .and. & trim(LVT_LIS_rc(1)%model_name) .eq. "JULES.5.0" .and. & LVT_rc%nensem .gt. 1) then + write(LVT_logunit,*) & '[INFO] Prepare processing of JULES PS41 ensemble snow...' + call LVT_init_jules_PS41_ens_snow() + count_jules_ps41_ens_snow_vars = 0 do while(associated(dataEntry)) @@ -1582,22 +1586,81 @@ subroutine LVT_writeDataStreams ! for output to file. is_ps41_snow_var = .false. if (jules_ps41_ens_snow) then - call LVT_fetch_final(LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & k, trim(dataEntry%short_name), is_ps41_snow_var) + + ! Not all PS41 variables involve snow. Check to + ! see if this did; if it didn't, normal ensemble + ! post-processing will occur later down. if (is_ps41_snow_var) then - !...CODE HERE FOR WRITING TO OUTPUT - end if - cycle - end if - + + ! Only write ensemble mean for PS41 snow variables + if (LVT_rc%lvt_out_format .eq. "grib2") then + + call writeSingleGrib2Var(ftn_mean,& + gtmp1_1d,& + lisdataentry%varid_def,& + lisdataentry%gribSF,& + lisdataentry%gribSfc,& + lisdataentry%gribLvl,& + lisdataentry%gribDis,& + lisdataentry%gribCat,& + pdTemplate,& + stepType,& + time_unit,& + time_past,& + time_curr,& + timeRange,& + k,& + toplev(k:k),& + botlev(k:k),& + depscale(k:k), & + typeOfGeneratingProcess=4, & + typeOfProcessedData=4) + + elseif(LVT_rc%lvt_out_format.eq."grib1") then + call writeSingleGrib1Var(ftn_mean,& + gtmp1_1d,& + lisdataentry%varid_def,& + lisdataentry%gribSF,& + lisdataentry%gribSfc,& + lisdataentry%gribLvl,& + stepType,& + time_unit,& + time_past,& + time_curr,& + timeRange,& + k,& + toplev(k:k),& + botlev(k:k)) + + elseif(LVT_rc%lvt_out_format.eq."netcdf") then + call writeSingleNetcdfVar(ftn_mean,& + gtmp1_1d,& + lisdataentry%varid_def,& + k) + + end if ! output format + + ! If we processed a PS41 ensemble snow variable, we + ! don't need to continue to normal ensemble + ! processing. Just go to the next vertical level. + cycle + + end if ! if PS41 snow variable + end if ! If processing JULES PS41 snow ensembles. + + ! Normal ensemble postprocessing starts here. do m=1,LVT_rc%nensem ! Must initialize ensemble member with "undefined" for ! noise smoother - gtmp1_1d_mem(:) = LVT_rc%udef + gtmp1_1d_mem(:) = LVT_rc%udef do r=1,LVT_rc%lnr do c=1,LVT_rc%lnc - if(LVT_domain%gindex(c,r).ne.-1) then + if(LVT_domain%gindex(c,r).ne.-1) then gid = LVT_domain%gindex(c,r) gtmp1_1d_mem(c+(r-1)*LVT_rc%lnc) = & dataEntry%value(gid,m,k) @@ -1732,7 +1795,7 @@ subroutine LVT_writeDataStreams typeOfProcessedData=4) end if - elseif(LVT_rc%lvt_out_format.eq."grib1") then + elseif(LVT_rc%lvt_out_format.eq."grib1") then call writeSingleGrib1Var(ftn_mean,& gtmp1_1d,& lisdataentry%varid_def,& @@ -1789,6 +1852,11 @@ subroutine LVT_writeDataStreams dataEntry => dataEntry%next enddo + ! Free up memory for PS41 ensemble snow postprocessing. + if (jules_ps41_ens_snow) then + call LVT_cleanup_jules_ps41_ens_snow() + end if + call LVT_append_HYCOM_fields(ftn_mean,& time_unit,& time_past,& diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 214f5fb7b..51edb2b7f 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -115,11 +115,14 @@ module LVT_557post_ps41_snowMod real, allocatable :: snowDepth_final(:) !real, allocatable :: new_rho_grnd??? real, allocatable :: SWE_final(:) - + ! Public routines + public :: LVT_init_jules_ps41_ens_snow public :: LVT_prep_jules_ps41_ens_snow_var public :: LVT_proc_jules_ps41_ens_snow - public :: LVT_fetch_final + public :: LVT_fetch_jules_ps41_ens_snow_final + public :: LVT_cleanup_jules_ps41_ens_snow + contains ! Allocate all step arrays based on number of ensemble members. @@ -155,21 +158,11 @@ subroutine allocate_final_arrays(nc, nr) allocate(SWE_final(nc*nr)) end subroutine allocate_final_arrays - ! Deallocate arrays for final data - subroutine deallocate_final_arrays() + ! Initialize routine for JULES PS41 ensemble snow + subroutine LVT_init_jules_ps41_ens_snow() implicit none - if (allocated(snowIce_final)) deallocate(snowIce_final) - if (allocated(snowLiq_final)) deallocate(snowLiq_final) - if (allocated(snowTProf_final)) deallocate(snowTProf_final) - if (allocated(layerSnowGrain_final)) deallocate(layerSnowGrain_final) - if (allocated(layerSnowDepth_final)) deallocate(layerSnowDepth_final) - if (allocated(actSnowNL_final)) deallocate(actSnowNL_final) - if (allocated(layerSnowDensity_final)) deallocate(layerSnowDensity_final) - if (allocated(surftSnow_final)) deallocate(surftSnow_final) - if (allocated(snowGrain_final)) deallocate(snowGrain_final) - if (allocated(snowDepth_final)) deallocate(snowDepth_final) - if (allocated(SWE_final)) deallocate(SWE_final) - end subroutine deallocate_final_arrays + call nullify_pointers() + end subroutine LVT_init_jules_ps41_ens_snow ! Nullify all pointers subroutine nullify_pointers() @@ -489,7 +482,7 @@ subroutine LVT_prep_jules_ps41_ens_snow_var(short_name, vlevels, data, & is_ps41_snow_var = .true. ! First guess - ! Preliminary check for 3 vertical levels (used with PS41). + ! Preliminary check for 3 vertical levels (used with PS41 snow fields). ! This doesn't apply for ActSnowNL, since that is a single layer variable. select case(trim(short_name)) case ("ActSnowNL_inst") @@ -600,14 +593,16 @@ subroutine LVT_proc_jules_ps41_ens_snow() end do ! c end do ! r - ! Cleanup, but keep final arrays for later extraction by LVT + ! Free up internal memory, but keep "final" arrays for subsequent + ! copying to external routine. call deallocate_step_arrays() call nullify_pointers() end subroutine LVT_proc_jules_ps41_ens_snow ! Fetch appropriate "final" array based on requested variable name. - subroutine LVT_fetch_final(nc, nr, data, k, short_name, is_ps41_snow_var) + subroutine LVT_fetch_jules_ps41_ens_snow_final(nc, nr, data, k, short_name, & + is_ps41_snow_var) ! Defaults implicit none @@ -649,7 +644,23 @@ subroutine LVT_fetch_final(nc, nr, data, k, short_name, is_ps41_snow_var) is_ps41_snow_var = .false. end select - end subroutine LVT_fetch_final + end subroutine LVT_fetch_jules_ps41_ens_snow_final + + ! Deallocate arrays for final data + subroutine LVT_cleanup_jules_ps41_ens_snow() + implicit none + if (allocated(snowIce_final)) deallocate(snowIce_final) + if (allocated(snowLiq_final)) deallocate(snowLiq_final) + if (allocated(snowTProf_final)) deallocate(snowTProf_final) + if (allocated(layerSnowGrain_final)) deallocate(layerSnowGrain_final) + if (allocated(layerSnowDepth_final)) deallocate(layerSnowDepth_final) + if (allocated(actSnowNL_final)) deallocate(actSnowNL_final) + if (allocated(layerSnowDensity_final)) deallocate(layerSnowDensity_final) + if (allocated(surftSnow_final)) deallocate(surftSnow_final) + if (allocated(snowGrain_final)) deallocate(snowGrain_final) + if (allocated(snowDepth_final)) deallocate(snowDepth_final) + if (allocated(SWE_final)) deallocate(SWE_final) + end subroutine LVT_cleanup_jules_ps41_ens_snow end module LVT_557post_ps41_snowMod From 543eb289d65b00ff6c430782e255fcb1000eb747 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 12 Mar 2021 11:47:12 -0500 Subject: [PATCH 22/64] Added additional PS41 "final" snow variables missing earlier. --- .../557post/LVT_557post_ps41_snowMod.F90 | 128 ++++++++++-------- 1 file changed, 68 insertions(+), 60 deletions(-) diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 51edb2b7f..8384625be 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -62,7 +62,6 @@ module LVT_557post_ps41_snowMod real, dimension(nlayer) :: new_rho_snow real :: new_snowmass real :: new_rgrain - real :: new_rho_snow_grnd real :: new_snowdepth real :: new_rho_grnd integer :: new_nsnow @@ -102,19 +101,19 @@ module LVT_557post_ps41_snowMod real, pointer :: ActSnowNL(:,:,:) ! Internal arrays for storing processed multi-layer snow + real, allocatable :: actSnowNL_final(:) + real, allocatable :: grndSnow_final(:) + real, allocatable :: layerSnowDensity_final(:,:) + real, allocatable :: layerSnowDepth_final(:,:) + real, allocatable :: layerSnowGrain_final(:,:) + real, allocatable :: SWE_final(:) + real, allocatable :: snowDensity_final(:) + real, allocatable :: snowDepth_final(:) + real, allocatable :: snowGrain_final(:) real, allocatable :: snowIce_final(:,:) real, allocatable :: snowLiq_final(:,:) real, allocatable :: snowTProf_final(:,:) - real, allocatable :: layerSnowGrain_final(:,:) - real, allocatable :: layerSnowDepth_final(:,:) - real, allocatable :: actSnowNL_final(:) - real, allocatable :: layerSnowDensity_final(:,:) real, allocatable :: surftSnow_final(:) - real, allocatable :: snowGrain_final(:) - !real, allocatable :: new_rho_snow_grnd??? - real, allocatable :: snowDepth_final(:) - !real, allocatable :: new_rho_grnd??? - real, allocatable :: SWE_final(:) ! Public routines public :: LVT_init_jules_ps41_ens_snow @@ -145,17 +144,19 @@ subroutine allocate_final_arrays(nc, nr) implicit none integer, intent(in) :: nc integer, intent(in) :: nr + allocate(actSnowNL_final(nc*nr)) + allocate(grndSnow_final(nc*nr)) + allocate(layerSnowDensity_final(nc*nr, nlayer)) + allocate(layerSnowDepth_final(nc*nr, nlayer)) + allocate(layerSnowGrain_final(nc*nr, nlayer)) + allocate(SWE_final(nc*nr)) + allocate(snowDensity_final(nc*nr)) + allocate(snowDepth_final(nc*nr)) + allocate(snowGrain_final(nc*nr)) allocate(snowIce_final(nc*nr, nlayer)) allocate(snowLiq_final(nc*nr, nlayer)) allocate(snowTProf_final(nc*nr, nlayer)) - allocate(layerSnowGrain_final(nc*nr, nlayer)) - allocate(layerSnowDepth_final(nc*nr, nlayer)) - allocate(actSnowNL_final(nc*nr)) - allocate(layerSnowDensity_final(nc*nr, nlayer)) allocate(surftSnow_final(nc*nr)) - allocate(snowGrain_final(nc*nr)) - allocate(snowDepth_final(nc*nr)) - allocate(SWE_final(nc*nr)) end subroutine allocate_final_arrays ! Initialize routine for JULES PS41 ensemble snow @@ -199,7 +200,7 @@ real function layer_mean(nensem, en_var_l, l) real :: s s = 0.0 do n = 1, nensem - s = s + en_var_l(n, l) + s = s + en_var_l(n,l) end do layer_mean = s / nensem end function layer_mean @@ -235,9 +236,9 @@ subroutine step_3(nensem) integer, intent(in) :: nensem integer :: l, n en_C(:,:) = 0.0 - do n = 1, nensem - do l = 1, nlayer - en_C(n,l) = en_sice(n,l)*hcapi + en_sliq(n,l)*hcapw + do l = 1, nlayer + do n = 1, nensem + en_C(n,l) = en_sice(n,l)*hcapi + en_sliq(n,l)*hcapw end do end do end subroutine step_3 @@ -251,9 +252,9 @@ subroutine step_4(nensem) integer, intent(in) :: nensem integer :: l, n en_e(:,:) = 0.0 - do n = 1, nensem - do l = 1, nlayer - en_e(n,l) = en_C(n,l)*(en_tsnow(n,l) - tm) + do l = 1, nlayer + do n = 1, nensem + en_e(n,l) = en_C(n,l)*(en_tsnow(n,l) - tm) end do end do end subroutine step_4 @@ -266,7 +267,7 @@ subroutine step_5(nensem) integer :: l e0(:) = 0.0 do l = 1, nlayer - e0(l) = layer_mean(nensem, en_e,l) + e0(l) = layer_mean(nensem, en_e, l) end do end subroutine step_5 @@ -529,17 +530,19 @@ subroutine LVT_proc_jules_ps41_ens_snow() ! Initializations call allocate_step_arrays(LVT_rc%nensem) call allocate_final_arrays(LVT_rc%lnc, LVT_rc%lnr) + actSnowNL_final = LVT_rc%udef + grndSnow_final = LVT_rc%udef + layerSnowDensity_final = LVT_rc%udef + layerSnowDepth_final = LVT_rc%udef + layerSnowGrain_final = LVT_rc%udef + SWE_final = LVT_rc%udef + snowDensity_final = LVT_rc%udef + snowDepth_final = LVT_rc%udef + snowGrain_final = LVT_rc%udef snowIce_final = LVT_rc%udef snowLiq_final = LVT_rc%udef snowTProf_final = LVT_rc%udef - layerSnowGrain_final = LVT_rc%udef - layerSnowDepth_final = LVT_rc%udef - actSnowNL_final = LVT_rc%udef - layerSnowDensity_final = LVT_rc%udef surftSnow_final = LVT_rc%udef - snowGrain_final = LVT_rc%udef - snowDepth_final = LVT_rc%udef - SWE_final = LVT_rc%udef ! For each land point, apply PS41 ensemble post-processing do r = 1, LVT_rc%lnr @@ -575,21 +578,20 @@ subroutine LVT_proc_jules_ps41_ens_snow() ! Copy to final arrays do k = 1, nlayer + layerSnowDensity_final(gid,k) = new_rho_snow(k) snowIce_final(gid,k) = new_sice(k) snowLiq_final(gid,k) = new_sliq(k) snowTProf_final(gid,k) = new_tsnow(k) layerSnowGrain_final(gid,k) = new_rgrainl(k) layerSnowDepth_final(gid,k) = new_ds(k) - - layerSnowDensity_final(gid,k) = new_rho_snow(k) end do ! k actSnowNL_final(gid) = new_nsnow - - surftSnow_final(gid) = new_snowmass - snowGrain_final(gid) = new_rgrain + grndSnow_final(gid) = 0. ! Always zero in PS41 + SWE_final(gid) = new_snowmass + snowDensity_final(gid) = new_rho_grnd snowDepth_final(gid) = new_snowdepth - SWE_final(gid) = new_snowmass ! FIXME...Find liquid equivalent - + snowGrain_final(gid) = new_rgrain + surftSnow_final(gid) = new_snowmass end do ! c end do ! r @@ -618,28 +620,32 @@ subroutine LVT_fetch_jules_ps41_ens_snow_final(nc, nr, data, k, short_name, & is_ps41_snow_var = .true. ! First guess select case(trim(short_name)) + case ("ActSnowNL_inst") + data(:) = actSnowNL_final(:) + case ("GrndSnow_inst") + data(:) = grndSnow_final(:) + case ("LayerSnowDensity_inst") + data(:) = layerSnowDensity_final(:,k) + case ("LayerSnowDepth_inst") + data(:) = layerSnowDepth_final(:,k) + case ("LayerSnowGrain_inst") + data(:) = layerSnowGrain_final(:,k) + case ("SWE_inst") + data(:) = SWE_final(:) + case ("SnowDensity_inst") + data(:) = snowDensity_final(:) + case ("SnowDepth_inst") + data(:) = snowDepth_final(:) + case ("SnowGrain_inst") + data(:) = snowGrain_final(:) case ("SnowIce_inst") data(:) = snowIce_final(:,k) case ("SnowLiq_inst") data(:) = snowLiq_final(:,k) case ("SnowTProf_inst") data(:) = snowtProf_final(:,k) - case ("LayerSnowGrain_inst") - data(:) = layerSnowGrain_final(:,k) - case ("LayerSnowDepth_inst") - data(:) = layerSnowDepth_final(:,k) - case ("ActSnowNL_inst") - data(:) = actSnowNL_final(:) - case ("LayerSnowDensity_inst") - data(:) = layerSnowDensity_final(:,k) case ("SurftSnow_inst") data(:) = surftSnow_final(:) - case ("SnowGrain_inst") - data(:) = snowGrain_final(:) - case ("SnowDepth_inst") - data(:) = snowDepth_final(:) - case ("SWE_inst") - data(:) = SWE_final(:) case default is_ps41_snow_var = .false. end select @@ -649,17 +655,19 @@ end subroutine LVT_fetch_jules_ps41_ens_snow_final ! Deallocate arrays for final data subroutine LVT_cleanup_jules_ps41_ens_snow() implicit none + if (allocated(actSnowNL_final)) deallocate(actSnowNL_final) + if (allocated(grndSnow_final)) deallocate(grndSnow_final) + if (allocated(layerSnowDensity_final)) deallocate(layerSnowDensity_final) + if (allocated(layerSnowDepth_final)) deallocate(layerSnowDepth_final) + if (allocated(layerSnowGrain_final)) deallocate(layerSnowGrain_final) + if (allocated(SWE_final)) deallocate(SWE_final) + if (allocated(snowDensity_final)) deallocate(snowDensity_final) + if (allocated(snowDepth_final)) deallocate(snowDepth_final) + if (allocated(snowGrain_final)) deallocate(snowGrain_final) if (allocated(snowIce_final)) deallocate(snowIce_final) if (allocated(snowLiq_final)) deallocate(snowLiq_final) if (allocated(snowTProf_final)) deallocate(snowTProf_final) - if (allocated(layerSnowGrain_final)) deallocate(layerSnowGrain_final) - if (allocated(layerSnowDepth_final)) deallocate(layerSnowDepth_final) - if (allocated(actSnowNL_final)) deallocate(actSnowNL_final) - if (allocated(layerSnowDensity_final)) deallocate(layerSnowDensity_final) if (allocated(surftSnow_final)) deallocate(surftSnow_final) - if (allocated(snowGrain_final)) deallocate(snowGrain_final) - if (allocated(snowDepth_final)) deallocate(snowDepth_final) - if (allocated(SWE_final)) deallocate(SWE_final) end subroutine LVT_cleanup_jules_ps41_ens_snow end module LVT_557post_ps41_snowMod From 2d500b4684988eb15f9cc8518ae5f8dab68917b2 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Wed, 17 Mar 2021 08:24:28 -0400 Subject: [PATCH 23/64] Bug fixes to handle zero-snow case. --- .../557post/LVT_557post_ps41_snowMod.F90 | 66 ++++++++++++------- 1 file changed, 42 insertions(+), 24 deletions(-) diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 8384625be..59ff81fc9 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -17,9 +17,6 @@ module LVT_557post_ps41_snowMod integer, parameter :: nlayer = 3 ! JULES PS41 uses three-layer snow physics - ! FIXME...Pass this from LVT for flexibility - !integer, parameter :: nensem = 12 - real, parameter, dimension(3) :: dzsnow= (/ 0.04, 0.12, 0.34 /) real, parameter :: hcapi = 2100.0 @@ -69,8 +66,8 @@ module LVT_557post_ps41_snowMod ! Internal variables !real, dimension(nensem, nlayer) :: en_C ! heat capacity (J/kg/K) !real, dimension(nensem, nlayer) :: en_e ! internal energy (J/m2) - real, allocatable :: en_C(:,:) - real, allocatable :: en_e(:,:) + real, allocatable :: en_C(:,:) ! heat capacity (J/kg/K) + real, allocatable :: en_e(:,:) ! internal energy (J/m2) ! Average ice water content across ensemble for each snow layer real, dimension(0:nlayer) :: sice0 @@ -564,7 +561,7 @@ subroutine LVT_proc_jules_ps41_ens_snow() en_nsnow(m) = actSnowNL(gid,m,1) end do ! m - ! Execute the relayering algorithm + ! Execute most of the relayering algorithm call step_1(LVT_rc%nensem) call step_2(LVT_rc%nensem) call step_3(LVT_rc%nensem) @@ -573,25 +570,46 @@ subroutine LVT_proc_jules_ps41_ens_snow() call step_6(LVT_rc%nensem) call step_7_8(LVT_rc%nensem) call step_9() - call step_10() - call step_11() - ! Copy to final arrays - do k = 1, nlayer - layerSnowDensity_final(gid,k) = new_rho_snow(k) - snowIce_final(gid,k) = new_sice(k) - snowLiq_final(gid,k) = new_sliq(k) - snowTProf_final(gid,k) = new_tsnow(k) - layerSnowGrain_final(gid,k) = new_rgrainl(k) - layerSnowDepth_final(gid,k) = new_ds(k) - end do ! k - actSnowNL_final(gid) = new_nsnow - grndSnow_final(gid) = 0. ! Always zero in PS41 - SWE_final(gid) = new_snowmass - snowDensity_final(gid) = new_rho_grnd - snowDepth_final(gid) = new_snowdepth - snowGrain_final(gid) = new_rgrain - surftSnow_final(gid) = new_snowmass + ! Handle no-snow case + if (new_snowdepth .eq. 0) then + do k = 1, nlayer + layerSnowDensity_final(gid,k) = 0. + snowIce_final(gid,k) = 0. + snowLiq_final(gid,k) = 0. + snowTProf_final(gid,k) = tm ! Default in JULES + layerSnowGrain_final(gid,k) = 50. ! Default in JULES + layerSnowDepth_final(gid,k) = 0. + end do + actSnowNL_final(gid) = 0 + grndSnow_final(gid) = 0. ! Always zero in PS41 + SWE_final(gid) = 0. + snowDensity_final(gid) = 109. ! Default in JULES + snowDepth_final(gid) = 0. + snowGrain_final(gid) = 50. ! Default in JULES + surftSnow_final(gid) = 0. + else + + ! We have snow, so finish relayering and copy to final arrays + call step_10() + call step_11() + do k = 1, nlayer + layerSnowDensity_final(gid,k) = new_rho_snow(k) + snowIce_final(gid,k) = new_sice(k) + snowLiq_final(gid,k) = new_sliq(k) + snowTProf_final(gid,k) = new_tsnow(k) + layerSnowGrain_final(gid,k) = new_rgrainl(k) + layerSnowDepth_final(gid,k) = new_ds(k) + end do ! k + actSnowNL_final(gid) = new_nsnow + grndSnow_final(gid) = 0. ! Always zero in PS41 + SWE_final(gid) = new_snowmass + snowDensity_final(gid) = new_rho_grnd + snowDepth_final(gid) = new_snowdepth + snowGrain_final(gid) = new_rgrain + surftSnow_final(gid) = new_snowmass + end if + end do ! c end do ! r From 417e24046778e90b904822e43e2f11f4065cc1db Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Wed, 17 Mar 2021 14:11:50 -0400 Subject: [PATCH 24/64] Updated to disable STDDEV output when JULES PS41 snow is processed. --- lvt/core/LVT_DataStreamsMod.F90 | 195 +++++++++++++++++--------------- 1 file changed, 102 insertions(+), 93 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 003607b38..54d0a0593 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -96,7 +96,7 @@ subroutine LVT_DataStreamsInit real :: gridDesci(50) call LVT_datastream_plugin - + call observationsetup(trim(LVT_rc%obssource(1))//char(0),1) call observationsetup(trim(LVT_rc%obssource(2))//char(0),2) @@ -345,6 +345,7 @@ subroutine LVT_readDataStreams endif end subroutine LVT_readDataStreams + !BOP ! ! !ROUTINE: LVT_writeDataStreams @@ -426,6 +427,7 @@ subroutine LVT_writeDataStreams integer :: count_jules_ps41_ens_snow_vars logical :: jules_ps41_ens_snow logical :: is_ps41_snow_var + character(len=100) :: short_name ! EMK...This is only used when LVT is run in "557 post" mode. if (trim(LVT_rc%runmode) .ne. "557 post") return @@ -473,6 +475,63 @@ subroutine LVT_writeDataStreams enddo enddo + ! EMK...Special handling of JULES PS41 multi-layer snow physics + ! when ensembles are processed. + ! FIXME...Add LVT flag specifying PS41? + dataEntry => LVT_histData%head_ds1_list + jules_ps41_ens_snow = .false. + if (trim(LVT_LIS_rc(1)%anlys_data_class) .eq. "LSM" .and. & + trim(LVT_LIS_rc(1)%model_name) .eq. "JULES.5.0" .and. & + LVT_rc%nensem .gt. 1) then + + write(LVT_logunit,*) & + '[INFO] Prepare processing of JULES PS41 ensemble snow...' + call LVT_init_jules_PS41_ens_snow() + + count_jules_ps41_ens_snow_vars = 0 + do while(associated(dataEntry)) + + if (dataEntry%timeAvgOpt .ne. 0) then + dataEntry => dataEntry%next + cycle + end if + + short_name = trim(dataEntry%short_name)//"_inst" + + call LVT_prep_jules_ps41_ens_snow_var(short_name, & + dataEntry%vlevels, dataEntry%value, is_ps41_snow_var) + + if (is_ps41_snow_var) then + count_jules_ps41_ens_snow_vars = & + count_jules_ps41_ens_snow_vars + 1 + end if + + if (count_jules_ps41_ens_snow_vars .eq. 6) exit + dataEntry => dataEntry%next + end do + + if (count_jules_ps41_ens_snow_vars .ne. 6) then + write(LVT_logunit,*) & + '[ERR] Cannot process JULES PS41 multi-layer snow' + write(LVT_logunit,*) & + '[ERR] Not all variables found for ensemble processing' + flush(LVT_logunit) + call LVT_endrun() + else + jules_ps41_ens_snow = .true. + end if + + ! Go to head of list for later processing + dataEntry => LVT_histData%head_ds1_list + + ! We now have all the PS41 snow variables needed for ensemble + ! processing. We invoke the relayer algorithm. The output variables + ! will be fetched further down. + call LVT_proc_jules_ps41_ens_snow() + + end if + ! EMK END JULES PS41 Snow + if(LVT_rc%lvt_out_format.eq."grib1") then write(unit=cdate2,fmt='(i4.4,i2.2,i2.2)') & @@ -594,7 +653,7 @@ subroutine LVT_writeDataStreams call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call grib_open_file(ftn_ssdev,fname_ssdev,'w',iret) call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) end if @@ -721,7 +780,7 @@ subroutine LVT_writeDataStreams call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call grib_open_file(ftn_ssdev,fname_ssdev,'w',iret) call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) end if @@ -889,7 +948,7 @@ subroutine LVT_writeDataStreams call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then iret = nf90_create(path=trim(fname_ssdev), cmode =nf90_hdf5, & ncid = ftn_ssdev) call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) @@ -901,7 +960,7 @@ subroutine LVT_writeDataStreams call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then iret = nf90_create(path=trim(fname_ssdev), cmode =nf90_clobber, & ncid = ftn_ssdev) call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) @@ -1064,17 +1123,14 @@ subroutine LVT_writeDataStreams LVT_rc%gridDesc(9))) endif - if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then !Headers call LVT_verify(nf90_def_dim(ftn_ssdev,'east_west',LVT_rc%gnc,dimID(1))) call LVT_verify(nf90_def_dim(ftn_ssdev,'north_south',LVT_rc%gnr,dimID(2))) - call LVT_verify(nf90_def_dim(ftn_ssdev,'time',1,tdimID)) call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"missing_value",& LVT_rc%udef)) - call LVT_verify(nf90_def_var(ftn_ssdev,& trim(xlat%short_name),& nf90_float,& @@ -1226,7 +1282,7 @@ subroutine LVT_writeDataStreams end if dataEntry => LVT_histData%head_ds1_list - + do while(associated(dataEntry)) !reset the pointers to the head of the linked list if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then @@ -1244,7 +1300,7 @@ subroutine LVT_writeDataStreams call defineNETCDFheaderVar(ftn_mean,dimID, lisdataEntry) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call defineNETCDFheaderVar_ss(ftn_ssdev,dimID, lisdataEntry) end if @@ -1265,7 +1321,7 @@ subroutine LVT_writeDataStreams 'nf90_put_att for title failed in LVT_DataStreamsMod') if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,& "NUM_SOIL_LAYERS", & nsoillayers),& @@ -1428,7 +1484,7 @@ subroutine LVT_writeDataStreams call LVT_verify(nf90_put_var(ftn_mean,xtimeID,0.0)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call LVT_verify(nf90_enddef(ftn_ssdev)) call LVT_verify(nf90_put_var(ftn_ssdev,xtime_ss_ID,0.0)) end if @@ -1444,7 +1500,7 @@ subroutine LVT_writeDataStreams 'nf90_put_var failed for lon') if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call LVT_verify(nf90_put_var(ftn_ssdev,xlat_ss_ID, & lat, (/1,1/),& (/LVT_rc%gnc,LVT_rc%gnr/)),& @@ -1458,54 +1514,6 @@ subroutine LVT_writeDataStreams dataEntry => LVT_histData%head_ds1_list - ! EMK...Special handling of JULES PS41 multi-layer snow physics - ! when ensembles are processed. - ! FIXME...Add LVT flag specifying PS41? - jules_ps41_ens_snow = .false. - if (trim(LVT_LIS_rc(1)%anlys_data_class) .eq. "LSM" .and. & - trim(LVT_LIS_rc(1)%model_name) .eq. "JULES.5.0" .and. & - LVT_rc%nensem .gt. 1) then - - write(LVT_logunit,*) & - '[INFO] Prepare processing of JULES PS41 ensemble snow...' - call LVT_init_jules_PS41_ens_snow() - - count_jules_ps41_ens_snow_vars = 0 - do while(associated(dataEntry)) - - call LVT_prep_jules_ps41_ens_snow_var(dataEntry%short_name, & - dataEntry%vlevels, dataEntry%value, is_ps41_snow_var) - - if (is_ps41_snow_var) then - count_jules_ps41_ens_snow_vars = & - count_jules_ps41_ens_snow_vars + 1 - end if - - if (count_jules_ps41_ens_snow_vars .eq. 6) exit - dataEntry => dataEntry%next - end do - - if (count_jules_ps41_ens_snow_vars .ne. 6) then - write(LVT_logunit,*) & - '[ERR] Cannot process JULES PS41 multi-layer snow' - write(LVT_logunit,*) & - '[ERR] Not all variables found for ensemble processing' - call LVT_endrun() - else - jules_ps41_ens_snow = .true. - end if - - ! Go to head of list for later processing - dataEntry => LVT_histData%head_ds1_list - - ! We now have all the PS41 snow variables needed for ensemble - ! processing. We invoke the relayer algorithm. The output variables - ! will be fetched further down. - call LVT_proc_jules_ps41_ens_snow() - - end if - ! EMK END JULES PS41 Snow - do while(associated(dataEntry)) !reset the pointers to the head of the linked list if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then @@ -1541,7 +1549,7 @@ subroutine LVT_writeDataStreams pdTemplate = 2 ! Derived fcst from ensemble at point in time else if (dataEntry%timeAvgOpt.eq.1 .or. & dataEntry%timeAvgOpt.eq.2) then - stepType = "avg" + stepType = "avg" timeRange = 7 pdTemplate = 12 ! Derived fcsts from ensemble over time interval else if (dataEntry%timeAvgOpt.eq.3) then @@ -1567,7 +1575,7 @@ subroutine LVT_writeDataStreams ! (minimum) value. if (trim(dataEntry%short_name) == "RHMin") then stepType = "min" - timeRange = 7 + timeRange = 7 pdTemplate = 12 end if @@ -1637,6 +1645,7 @@ subroutine LVT_writeDataStreams botlev(k:k)) elseif(LVT_rc%lvt_out_format.eq."netcdf") then + call writeSingleNetcdfVar(ftn_mean,& gtmp1_1d,& lisdataentry%varid_def,& @@ -1771,7 +1780,8 @@ subroutine LVT_writeDataStreams typeOfProcessedData=4) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 & + .and. .not. jules_ps41_ens_snow) then call writeSingleGrib2Var(ftn_ssdev,& gtmp1_ss,& lisdataentry%varid_def,& @@ -1812,7 +1822,8 @@ subroutine LVT_writeDataStreams botlev(k:k)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 & + .and. .not. jules_ps41_ens_snow) then call writeSingleGrib1Var(ftn_ssdev,& gtmp1_ss,& @@ -1836,7 +1847,8 @@ subroutine LVT_writeDataStreams lisdataentry%varid_def,& k) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 & + .and. .not. jules_ps41_ens_snow) then call writeSingleNetcdfVar(ftn_ssdev,& gtmp1_ss,& lisdataentry%varid_ss,& @@ -1869,24 +1881,24 @@ subroutine LVT_writeDataStreams if(LVT_rc%lvt_out_format.eq."grib1") then call grib_close_file(ftn_mean,iret) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call grib_close_file(ftn_ssdev,iret) end if elseif(LVT_rc%lvt_out_format.eq."grib2") then call grib_close_file(ftn_mean,iret) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call grib_close_file(ftn_ssdev,iret) end if elseif(LVT_rc%lvt_out_format.eq."netcdf") then call LVT_verify(nf90_close(ftn_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & - LVT_rc%nensem > 1) then + LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call LVT_verify(nf90_close(ftn_ssdev)) end if endif endif - + end subroutine LVT_writeDataStreams ! EMK...Return logical indicating if alarm should ring. @@ -2106,9 +2118,6 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& do r = 1, LVT_rc%gnr do c = 1, LVT_rc%gnc gid = LVT_domain%gindex(c,r) -! write(LVT_logunit,*)'EMK: c,r,gid,lat(c,r) = ', & -! c,r,gid,lat(c,r) -! flush(LVT_logunit) if (gid .eq. -1 .and. lat(c,r) >= 80.) then if (watert_ip(c+(r-1)*LVT_rc%gnc) == -9999) then @@ -2122,14 +2131,14 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& gribDis = 10 !stepType = "avg" stepType = "instant" ! EMK - pdTemplate = 0 + pdTemplate = 0 gribCat = 3 varid_def = 0 - gribSfc = 1 + gribSfc = 1 gribSF = 10 - gribLvl = 1 - - if(LVT_rc%lvt_out_format.eq."grib2") then + gribLvl = 1 + + if(LVT_rc%lvt_out_format.eq."grib2") then ! add to the grib file call writeSingleGrib2Var(ftn_mean,& watert_ip,& @@ -2328,8 +2337,8 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& end if end do ! c - ! EMK: Since sea ice is missing north of -49.5N and south of 40N, we - ! need to set water points in this region to a reasonable value. We + ! EMK: Since sea ice is missing north of -49.5N and south of 40N, we + ! need to set water points in this region to a reasonable value. We ! assume sea ice fraction is zero in this region. do r = 1, LVT_rc%gnr do c = 1, LVT_rc%gnc @@ -2346,14 +2355,14 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& gribDis = 10 !stepType = "avg" stepType = "instant" ! EMK - pdTemplate = 0 + pdTemplate = 0 gribCat = 2 varid_def = 0 gribSfc = 1 gribSF = 100 gribLvl = 1 - - if(LVT_rc%lvt_out_format.eq."grib2") then + + if(LVT_rc%lvt_out_format.eq."grib2") then ! EMK...Use older cice date/time if (cice_ant_year .lt. cice_arc_year .or. & cice_ant_month .lt. cice_arc_month .or. & @@ -2565,8 +2574,8 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& end if end do ! c - ! EMK: Since sea ice is missing north of -49.5N and south of 40N, we - ! need to set water points in this region to a reasonable value. We + ! EMK: Since sea ice is missing north of -49.5N and south of 40N, we + ! need to set water points in this region to a reasonable value. We ! assume sea ice thickness is zero in this region. do r = 1, LVT_rc%gnr do c = 1, LVT_rc%gnc @@ -2583,14 +2592,14 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& gribDis = 10 !stepType = "avg" stepType = "instant" ! EMK - pdTemplate = 0 + pdTemplate = 0 gribCat = 2 varid_def = 1 gribSfc = 1 gribSF = 10 gribLvl = 1 - - if(LVT_rc%lvt_out_format.eq."grib2") then + + if(LVT_rc%lvt_out_format.eq."grib2") then ! EMK...Use older hi date/time if (hi_ant_year .lt. hi_arc_year .or. & @@ -4334,8 +4343,8 @@ end subroutine construct_hycom_cice_filename ! Chan, T F, G H Golub, and R J LeVeque, 1983: Algorithms for computing ! the sample variance: Analysis and recommendations. The American ! Statistician, 37, 242-247. doi:10.1080/00031305.1983.10483115. - ! Knuth, D E, 1998: The Art of Computer Programming, volume 2: - ! Seminumerical Algorithms. Third Edition, p 232. Boston: + ! Knuth, D E, 1998: The Art of Computer Programming, volume 2: + ! Seminumerical Algorithms. Third Edition, p 232. Boston: ! Addison-Wesley. ! Ling, R F, 1974: Comparisons of several algorithms for computing ! sample means and variances. Journal of the American Statistical @@ -4354,7 +4363,7 @@ subroutine welford_update(count, mean, m2, new_value) delta = new_value - mean mean = mean + (delta / real(count)) delta2 = new_value - mean - m2 = m2 + (delta * delta2) + m2 = m2 + (delta * delta2) end subroutine welford_update subroutine welford_finalize(count, mean, m2, stddev) implicit none @@ -4369,5 +4378,5 @@ subroutine welford_finalize(count, mean, m2, stddev) stddev = sqrt(m2 / real(count)) end if end subroutine welford_finalize - + end module LVT_DataStreamsMod From f5c5fc4db3eef0ffe201870ec39c2370e813803b Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 19 Mar 2021 12:43:48 -0400 Subject: [PATCH 25/64] Added output support for 5 additional JULES PS41 snow variables. Code runs, but some clean-up is needed. --- lvt/core/LVT_DataStreamsMod.F90 | 157 +++++++- .../557post/LVT_557post_ps41_snowMod.F90 | 334 +++++++++++++++--- 2 files changed, 435 insertions(+), 56 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 54d0a0593..9999b5469 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -428,7 +428,16 @@ subroutine LVT_writeDataStreams logical :: jules_ps41_ens_snow logical :: is_ps41_snow_var character(len=100) :: short_name - + type(LVT_lismetadataEntry), target :: GrndSnow + type(LVT_lismetadataEntry), target :: LayerSnowDensity + type(LVT_lismetadataEntry), target :: SWE + type(LVT_lismetadataEntry), target :: SnowDepth + type(LVT_lismetadataEntry), target :: SnowDensity + type(LVT_lismetadataEntry), target :: SnowGrain + type(LVT_lismetadataEntry), target :: SurftSnow + integer :: GrndSnowID, LayerSnowDensityID, SWEID, SnowDepthID, & + SnowDensityID, SnowGrainID, SurftSnowID + ! EMK...This is only used when LVT is run in "557 post" mode. if (trim(LVT_rc%runmode) .ne. "557 post") return @@ -529,10 +538,19 @@ subroutine LVT_writeDataStreams ! will be fetched further down. call LVT_proc_jules_ps41_ens_snow() + ! Set metadata for new derived snow variables not copied from + ! LIS file. + call LVT_set_SWE_metadata(SWE) + call LVT_set_SnowDensity_metadata(SnowDensity) + call LVT_set_LayerSnowDensity_metadata(LayerSnowDensity) + call LVT_set_SnowGrain_metadata(SnowGrain) + call LVT_set_SnowDepth_metadata(SnowDepth) + call LVT_set_GrndSnow_metadata(GrndSnow) + call LVT_set_SurftSnow_metadata(SurftSnow) end if ! EMK END JULES PS41 Snow - if(LVT_rc%lvt_out_format.eq."grib1") then + if(LVT_rc%lvt_out_format.eq."grib1") then write(unit=cdate2,fmt='(i4.4,i2.2,i2.2)') & LVT_rc%yr, LVT_rc%mo, LVT_rc%da @@ -588,7 +606,7 @@ subroutine LVT_writeDataStreams ! '_PA.03-HR-SUM_DD.'//& '_PA.LIS_DD.'//& trim(cdate2)//'_DT.'//trim(cdate3)//'_DF_SSDEV.GR1' - + end if ! Setup of GRIB-1 and GRIB-2 Metadata Section @@ -1297,7 +1315,7 @@ subroutine LVT_writeDataStreams do while(associated(lisdataEntry)) if(lisdataEntry%short_name.eq.dataEntry%short_name) then - call defineNETCDFheaderVar(ftn_mean,dimID, lisdataEntry) + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then @@ -1479,7 +1497,34 @@ subroutine LVT_writeDataStreams LVT_histData%hi%varId_def,& "vmax",LVT_rc%udef)) endif - + + ! EMK...Add additional PS41 snow variable headers. + if (jules_ps41_ens_snow) then + + lisdataEntry => SWE + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + + lisdataEntry => SnowDensity + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + + lisdataEntry => LayerSnowDensity + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + + lisdataEntry => SnowGrain + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + + lisdataEntry => SnowDepth + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + + lisdataEntry => GrndSnow + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + + lisdataEntry => SurftSnow + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + + end if + ! EMK END PS41 snow headers + call LVT_verify(nf90_enddef(ftn_mean)) call LVT_verify(nf90_put_var(ftn_mean,xtimeID,0.0)) @@ -1512,6 +1557,96 @@ subroutine LVT_writeDataStreams end if endif + ! EMK Output updated PS41 snow variables not read in from LIS file + if (jules_ps41_ens_snow) then + if (LVT_rc%lvt_out_format.eq."netcdf") then + + write(LVT_logunit,*)'EMK: LVT_rc%lnc, LVT_rc%gnc = ', & + LVT_rc%lnc, LVT_rc%gnc + write(LVT_logunit,*)'EMK: LVT_rc%lnr, LVT_rc%gnr = ', & + LVT_rc%lnr, LVT_rc%gnr + + gtmp1_1d = 0.0 + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + 1, "SWE_inst", is_ps41_snow_var) + call writeSingleNetcdfVar(ftn_mean,& + gtmp1_1d,& + SWE%varid_def,& + 1) + + gtmp1_1d = 0.0 + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + 1, "SnowDensity_inst", is_ps41_snow_var) + call writeSingleNetcdfVar(ftn_mean, & + gtmp1_1d, & + SnowDensity%varid_def, & + 1) + + do k = 1, 3 + gtmp1_1d = 0.0 + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + k, "LayerSnowDensity_inst", is_ps41_snow_var) + call writeSingleNetcdfVar(ftn_mean, & + gtmp1_1d, & + LayerSnowDensity%varid_def, & + k) + end do + + gtmp1_1d = 0.0 + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + 1, "SnowGrain_inst", is_ps41_snow_var) + call writeSingleNetcdfVar(ftn_mean,& + gtmp1_1d, & + SnowGrain%varid_def, & + 1) + + gtmp1_1d = 0.0 + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + 1, "SnowDepth_inst", is_ps41_snow_var) + write(LVT_logunit,*)'EMK: is_ps41_snow_var = ', is_ps41_snow_var + call writeSingleNetcdfVar(ftn_mean, & + gtmp1_1d, & + SnowDepth%varid_def, & + 1) + + gtmp1_1d = 0.0 + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + 1, "GrndSnow_inst", is_ps41_snow_var) + call writeSingleNetcdfVar(ftn_mean,& + gtmp1_1d, & + GrndSnow%varid_def, & + 1) + + gtmp1_1d = 0.0 + call LVT_fetch_jules_ps41_ens_snow_final( & + LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & + 1, "SurftSnow_inst", is_ps41_snow_var) + call writeSingleNetcdfVar(ftn_mean, & + gtmp1_1d, & + SurftSnow%varid_def, & + 1) + + ! Cleanup + call LVT_deallocate_metadata(SWE) + call LVT_deallocate_metadata(SnowDensity) + call LVT_deallocate_metadata(LayerSnowDensity) + call LVT_deallocate_metadata(SnowGrain) + call LVT_deallocate_metadata(SnowDepth) + call LVT_deallocate_metadata(GrndSnow) + call LVT_deallocate_metadata(SurftSnow) + + else + write(LVT_logunit,*)'EMK: GRIB OUTPUT NOT SUPPORTED YET' + stop + end if + end if + dataEntry => LVT_histData%head_ds1_list do while(associated(dataEntry)) @@ -1526,9 +1661,9 @@ subroutine LVT_writeDataStreams lisdataEntry => LVT_LISoutput(1)%head_irrig_list endif do while(associated(lisdataEntry)) - + if(lisdataEntry%short_name.eq.dataEntry%short_name) then - + ! Set timerange indicator equal to 133 for AFWA's specifications ! for surface runoff, baseflow, and total precipitation ! to make the LIS-7 output match the LIS-6 style. - dmm @@ -1597,7 +1732,8 @@ subroutine LVT_writeDataStreams call LVT_fetch_jules_ps41_ens_snow_final( & LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & - k, trim(dataEntry%short_name), is_ps41_snow_var) + k, trim(dataEntry%short_name)//"_inst", & + is_ps41_snow_var) ! Not all PS41 variables involve snow. Check to ! see if this did; if it didn't, normal ensemble @@ -1646,6 +1782,8 @@ subroutine LVT_writeDataStreams elseif(LVT_rc%lvt_out_format.eq."netcdf") then + write(LVT_logunit,*) & + 'EMK: Calling writeSingleNetcdfVar HERE...' call writeSingleNetcdfVar(ftn_mean,& gtmp1_1d,& lisdataentry%varid_def,& @@ -3575,6 +3713,7 @@ subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) 'failed in defineNETCDFheadervar') #endif endif + call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& "units",trim(dataEntry%units)),& @@ -3779,6 +3918,7 @@ subroutine writeSingleNetcdfVar(ftn,gtmp,varID,k) integer :: c,r real :: gtmp2d(LVT_rc%lnc,LVT_rc%lnr) + #if(defined USE_NETCDF3 || defined USE_NETCDF4) do r=1,LVT_rc%lnr @@ -3790,7 +3930,6 @@ subroutine writeSingleNetcdfVar(ftn,gtmp,varID,k) call LVT_verify(nf90_put_var(ftn,varID, gtmp2d,(/1,1,k/),& (/LVT_rc%gnc,LVT_rc%gnr,1/)),& 'nf90_put_var failed for in LVT_DataStreamsMod') - #endif end subroutine writeSingleNetcdfVar diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 59ff81fc9..80d4ea0d8 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -8,9 +8,13 @@ ! Shugong Wang (shugong.wang@nasa.gov) 03/10/2021 ! Editorial updates for LVT by Eric Kemp, SSAI, 11 Mar 2021 ! +#include "LVT_misc.h" +#include "LVT_NetCDF_inc.h" module LVT_557post_ps41_snowMod + use LVT_logMod, only: LVT_logunit + ! Defaults implicit none private @@ -90,27 +94,27 @@ module LVT_557post_ps41_snowMod ! Internal pointers for referencing PS41 JULES fields in LVT dataEntry ! linked list. - real, pointer :: snowIce(:,:,:) - real, pointer :: snowLiq(:,:,:) - real, pointer :: snowTProf(:,:,:) - real, pointer :: layerSnowGrain(:,:,:) - real, pointer :: layerSnowDepth(:,:,:) - real, pointer :: ActSnowNL(:,:,:) + real, pointer, save :: snowIce(:,:,:) + real, pointer, save :: snowLiq(:,:,:) + real, pointer, save :: snowTProf(:,:,:) + real, pointer, save :: layerSnowGrain(:,:,:) + real, pointer, save :: layerSnowDepth(:,:,:) + real, pointer, save :: ActSnowNL(:,:,:) ! Internal arrays for storing processed multi-layer snow - real, allocatable :: actSnowNL_final(:) - real, allocatable :: grndSnow_final(:) - real, allocatable :: layerSnowDensity_final(:,:) - real, allocatable :: layerSnowDepth_final(:,:) - real, allocatable :: layerSnowGrain_final(:,:) - real, allocatable :: SWE_final(:) - real, allocatable :: snowDensity_final(:) - real, allocatable :: snowDepth_final(:) - real, allocatable :: snowGrain_final(:) - real, allocatable :: snowIce_final(:,:) - real, allocatable :: snowLiq_final(:,:) - real, allocatable :: snowTProf_final(:,:) - real, allocatable :: surftSnow_final(:) + real, allocatable, save :: actSnowNL_final(:) + real, allocatable, save :: grndSnow_final(:) + real, allocatable, save :: layerSnowDensity_final(:,:) + real, allocatable, save :: layerSnowDepth_final(:,:) + real, allocatable, save :: layerSnowGrain_final(:,:) + real, allocatable, save :: SWE_final(:) + real, allocatable, save :: snowDensity_final(:) + real, allocatable, save :: snowDepth_final(:) + real, allocatable, save :: snowGrain_final(:) + real, allocatable, save :: snowIce_final(:,:) + real, allocatable, save :: snowLiq_final(:,:) + real, allocatable, save :: snowTProf_final(:,:) + real, allocatable, save :: surftSnow_final(:) ! Public routines public :: LVT_init_jules_ps41_ens_snow @@ -118,7 +122,15 @@ module LVT_557post_ps41_snowMod public :: LVT_proc_jules_ps41_ens_snow public :: LVT_fetch_jules_ps41_ens_snow_final public :: LVT_cleanup_jules_ps41_ens_snow - + public :: LVT_set_SWE_metadata + public :: LVT_set_SnowDensity_metadata + public :: LVT_set_LayerSnowDensity_metadata + public :: LVT_set_SnowGrain_metadata + public :: LVT_set_SnowDepth_metadata + public :: LVT_set_GrndSnow_metadata + public :: LVT_set_SurftSnow_metadata + public :: LVT_deallocate_metadata + !public :: LVT_set_ps41_netcdf_header contains ! Allocate all step arrays based on number of ensemble members. @@ -522,7 +534,7 @@ subroutine LVT_proc_jules_ps41_ens_snow() implicit none ! Locals - integer :: c, r, m, k, gid + integer :: c, r, m, k, gid, ij ! Initializations call allocate_step_arrays(LVT_rc%nensem) @@ -547,6 +559,8 @@ subroutine LVT_proc_jules_ps41_ens_snow() gid = LVT_domain%gindex(c,r) if (gid == -1) cycle + ij = c + (r-1)*LVT_rc%lnc + ! Load ensemble members into step arrays do k = 1, nlayer do m = 1, LVT_rc%nensem @@ -574,40 +588,40 @@ subroutine LVT_proc_jules_ps41_ens_snow() ! Handle no-snow case if (new_snowdepth .eq. 0) then do k = 1, nlayer - layerSnowDensity_final(gid,k) = 0. - snowIce_final(gid,k) = 0. - snowLiq_final(gid,k) = 0. - snowTProf_final(gid,k) = tm ! Default in JULES - layerSnowGrain_final(gid,k) = 50. ! Default in JULES - layerSnowDepth_final(gid,k) = 0. + layerSnowDensity_final(ij,k) = 0. + snowIce_final(ij,k) = 0. + snowLiq_final(ij,k) = 0. + snowTProf_final(ij,k) = tm ! Default in JULES + layerSnowGrain_final(ij,k) = 50. ! Default in JULES + layerSnowDepth_final(ij,k) = 0. end do - actSnowNL_final(gid) = 0 - grndSnow_final(gid) = 0. ! Always zero in PS41 - SWE_final(gid) = 0. - snowDensity_final(gid) = 109. ! Default in JULES - snowDepth_final(gid) = 0. - snowGrain_final(gid) = 50. ! Default in JULES - surftSnow_final(gid) = 0. + actSnowNL_final(ij) = 0 + grndSnow_final(ij) = 0. ! Always zero in PS41 + SWE_final(ij) = 0. + snowDensity_final(ij) = 109. ! Default in JULES + snowDepth_final(ij) = 0. + snowGrain_final(ij) = 50. ! Default in JULES + surftSnow_final(ij) = 0. else ! We have snow, so finish relayering and copy to final arrays call step_10() call step_11() do k = 1, nlayer - layerSnowDensity_final(gid,k) = new_rho_snow(k) - snowIce_final(gid,k) = new_sice(k) - snowLiq_final(gid,k) = new_sliq(k) - snowTProf_final(gid,k) = new_tsnow(k) - layerSnowGrain_final(gid,k) = new_rgrainl(k) - layerSnowDepth_final(gid,k) = new_ds(k) + layerSnowDensity_final(ij,k) = new_rho_snow(k) + snowIce_final(ij,k) = new_sice(k) + snowLiq_final(ij,k) = new_sliq(k) + snowTProf_final(ij,k) = new_tsnow(k) + layerSnowGrain_final(ij,k) = new_rgrainl(k) + layerSnowDepth_final(ij,k) = new_ds(k) end do ! k - actSnowNL_final(gid) = new_nsnow - grndSnow_final(gid) = 0. ! Always zero in PS41 - SWE_final(gid) = new_snowmass - snowDensity_final(gid) = new_rho_grnd - snowDepth_final(gid) = new_snowdepth - snowGrain_final(gid) = new_rgrain - surftSnow_final(gid) = new_snowmass + actSnowNL_final(ij) = new_nsnow + grndSnow_final(ij) = 0. ! Always zero in PS41 + SWE_final(ij) = new_snowmass + snowDensity_final(ij) = new_rho_grnd + snowDepth_final(ij) = new_snowdepth + snowGrain_final(ij) = new_rgrain + surftSnow_final(ij) = new_snowmass end if end do ! c @@ -640,8 +654,10 @@ subroutine LVT_fetch_jules_ps41_ens_snow_final(nc, nr, data, k, short_name, & select case(trim(short_name)) case ("ActSnowNL_inst") data(:) = actSnowNL_final(:) + deallocate(actSnowNL_final) case ("GrndSnow_inst") data(:) = grndSnow_final(:) + deallocate(grndSnow_final) case ("LayerSnowDensity_inst") data(:) = layerSnowDensity_final(:,k) case ("LayerSnowDepth_inst") @@ -650,12 +666,16 @@ subroutine LVT_fetch_jules_ps41_ens_snow_final(nc, nr, data, k, short_name, & data(:) = layerSnowGrain_final(:,k) case ("SWE_inst") data(:) = SWE_final(:) + deallocate(SWE_final) case ("SnowDensity_inst") data(:) = snowDensity_final(:) + deallocate(snowDensity_final) case ("SnowDepth_inst") data(:) = snowDepth_final(:) + deallocate(snowDepth_final) case ("SnowGrain_inst") data(:) = snowGrain_final(:) + deallocate(snowGrain_final) case ("SnowIce_inst") data(:) = snowIce_final(:,k) case ("SnowLiq_inst") @@ -664,6 +684,7 @@ subroutine LVT_fetch_jules_ps41_ens_snow_final(nc, nr, data, k, short_name, & data(:) = snowtProf_final(:,k) case ("SurftSnow_inst") data(:) = surftSnow_final(:) + deallocate(surftSnow_final) case default is_ps41_snow_var = .false. end select @@ -688,5 +709,224 @@ subroutine LVT_cleanup_jules_ps41_ens_snow() if (allocated(surftSnow_final)) deallocate(surftSnow_final) end subroutine LVT_cleanup_jules_ps41_ens_snow + subroutine LVT_set_SWE_metadata(SWE) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: SWE + SWE%short_name = "SWE" + SWE%long_name = "snow water equivalent" + SWE%standard_name = "liquid_water_content_of_surface_snow" + SWE%units = "kg m-2" + SWE%nunits = 1 + SWE%format = 'F' + SWE%vlevels = 1 + SWE%timeAvgOpt = 0 + allocate(SWE%unittypes(1)) + SWE%unittypes(1) = "kg m-2" + SWE%varid_def = -99 + SWE%selectOpt = 1 + end subroutine LVT_set_SWE_metadata + + subroutine LVT_set_SnowDensity_metadata(SnowDensity) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: SnowDensity + SnowDensity%short_name = "SnowDensity" + SnowDensity%long_name = "snowpack bulk density" + SnowDensity%standard_name = "snowpack_bulk_density" + SnowDensity%units = "kg m-3" + SnowDensity%nunits = 1 + SnowDensity%format = 'F' + SnowDensity%vlevels = 1 + SnowDensity%timeAvgOpt = 0 + allocate(SnowDensity%unittypes(1)) + SnowDensity%unittypes(1) = "kg m-3" + SnowDensity%varid_def = -99 + SnowDensity%selectOpt = 1 + end subroutine LVT_set_SnowDensity_metadata + + subroutine LVT_set_LayerSnowDensity_metadata(LayerSnowDensity) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: LayerSnowDensity + LayerSnowDensity%short_name = "LayerSnowDensity" + LayerSnowDensity%long_name = "snow_density_for_each_layer" + LayerSnowDensity%standard_name = "snow_density_for_each_layer" + LayerSnowDensity%units = "kg m-3" + LayerSnowDensity%nunits = 1 + LayerSnowDensity%format = 'F' + LayerSnowDensity%vlevels = 3 + LayerSnowDensity%timeAvgOpt = 0 + allocate(LayerSnowDensity%unittypes(1)) + LayerSnowDensity%unittypes(1) = "kg m-3" + LayerSnowDensity%varid_def = -99 + LayerSnowDensity%selectOpt = 1 + end subroutine LVT_set_LayerSnowDensity_metadata + + subroutine LVT_set_SnowGrain_metadata(SnowGrain) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: SnowGrain + SnowGrain%short_name = "SnowGrain" + SnowGrain%long_name = "snow grain size" + SnowGrain%standard_name = "snow_grain_size" + SnowGrain%units = "micron" + SnowGrain%nunits = 1 + SnowGrain%format = 'F' + SnowGrain%vlevels = 1 + SnowGrain%timeAvgOpt = 0 + allocate(SnowGrain%unittypes(1)) + SnowGrain%unittypes(1) = "micron" + SnowGrain%varid_def = -99 + SnowGrain%selectOpt = 1 + end subroutine LVT_set_SnowGrain_metadata + + subroutine LVT_set_SnowDepth_metadata(SnowDepth) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: SnowDepth + SnowDepth%short_name = "SnowDepth" + SnowDepth%long_name = "snow depth" + SnowDepth%standard_name = "snow_depth" + SnowDepth%units = "m" + SnowDepth%nunits = 1 + SnowDepth%format = 'F' + SnowDepth%vlevels = 1 + SnowDepth%timeAvgOpt = 0 + allocate(SnowDepth%unittypes(1)) + SnowDepth%unittypes(1) = "m" + SnowDepth%varid_def = -99 + SnowDepth%selectOpt = 1 + end subroutine LVT_set_SnowDepth_metadata + + subroutine LVT_set_grndsnow_metadata(grndSnow) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: grndSnow + grndSnow%short_name = "GrndSnow" + grndSnow%long_name = "snow on ground (beneath canopy)" + grndSnow%standard_name = "snow_on_ground_beneath_canopy" + grndSnow%units = "kg m-2" + grndSnow%nunits = 1 + grndSnow%format = 'F' + grndSnow%vlevels = 1 + grndSnow%timeAvgOpt = 0 + allocate(grndSnow%unittypes(1)) + grndSnow%unittypes(1) = "kg m-2" + grndSnow%varid_def = -99 + grndSnow%selectOpt = 1 + end subroutine LVT_set_grndsnow_metadata + + subroutine LVT_set_surftsnow_metadata(surftSnow) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: surftSnow + surftSnow%short_name = "SurftSnow" + surftSnow%long_name = "snow amount on tile" + surftSnow%standard_name = "snow_amount_on_tile" + surftSnow%units = "kg m-2" + surftSnow%nunits = 1 + surftSnow%format = 'F' + surftSnow%vlevels = 1 + surftSnow%timeAvgOpt = 0 + allocate(surftSnow%unittypes(1)) + surftSnow%unittypes(1) = "kg m-2" + surftSnow%varid_def = -99 + surftSnow%selectOpt = 1 + end subroutine LVT_set_surftsnow_metadata + + subroutine LVT_deallocate_metadata(var) + use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry + implicit none + type(LVT_lismetadataEntry), intent(inout) :: var + if (allocated(var%unittypes)) deallocate(var%unittypes) + end subroutine LVT_deallocate_metadata + +! subroutine LVT_set_ps41_netcdf_header(var, ftn, dimID, udef, varID) + +! ! Modules +! use LVT_histDataMod, only: LVT_metadataEntry +! use LVT_logMod, only: LVT_verify +! #if (defined USE_NETCDF3 || defined USE_NETCDF4) +! use netcdf +! #endif + +! ! Defaults +! implicit none + +! ! Arguments +! type(LVT_metadataEntry), intent(in) :: var +! integer, intent(in) :: ftn +! integer, intent(in) :: dimID(3) +! real, intent(in) :: udef +! integer, intent(out) :: varID + +! ! Local variables +! integer :: num_dims + +! num_dims = 2 +! if (var%vlevels .eq. 3) then +! num_dims = 3 +! end if + + +! ! call LVT_verify(nf90_def_var(ftn, & +! ! trim(var%short_name), & +! ! nf90_float, & +! ! dimids = dimID(1:num_dims), & +! ! varID=varID), & +! ! 'nf90_def_var for '// & +! ! trim(var%short_name)// & +! ! 'failed in LVT_set_ps41_netcdf_header') + +! ! #if(defined USE_NETCDF4) +! ! call LVT_verify(nf90_def_var_deflate(ftn, & +! ! varID, & +! ! NETCDF_shuffle, NETCDF_deflate, NETCDF_deflate_level), & +! ! 'nf90_def_var_deflate for '// & +! ! trim(var%short_name)// & +! ! 'failed in LVT_set_ps41_netcdf_header') +! ! #endif + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID, & +! ! "units",& +! ! trim(var%units))) + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID, & +! ! "standard_name", & +! ! trim(var%standard_name))) + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID,& +! ! "long_name",& +! ! trim(var%long_name))) + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID,& +! ! "scale_factor", 1.0)) + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID,& +! ! "add_offset", 0.0)) + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID,& +! ! "missing_value", udef)) + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID, & +! ! "_FillValue", udef)) + +! ! call LVT_verify(nf90_put_att(ftn, & +! ! varID, & +! ! "vmin", udef)) + +! ! call LVT_verify(nf90_put_att(ftn,& +! ! varID, & +! ! "vmax", udef)) + ! end subroutine LVT_set_ps41_netcdf_header + end module LVT_557post_ps41_snowMod From bb606e78cfdf773065c78b81b7403267e70068d8 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 19 Mar 2021 14:46:24 -0400 Subject: [PATCH 26/64] Added valid max/min for 5 JULES PS41 snow variables, to avoid alloc error. --- .../557post/LVT_557post_ps41_snowMod.F90 | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 80d4ea0d8..27784ce8e 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -723,6 +723,10 @@ subroutine LVT_set_SWE_metadata(SWE) SWE%timeAvgOpt = 0 allocate(SWE%unittypes(1)) SWE%unittypes(1) = "kg m-2" + allocate(SWE%valid_min(1)) + SWE%valid_min = (/ 0.0 /) + allocate(SWE%valid_max(1)) + SWE%valid_max = (/ 2000.0 /) SWE%varid_def = -99 SWE%selectOpt = 1 end subroutine LVT_set_SWE_metadata @@ -741,6 +745,10 @@ subroutine LVT_set_SnowDensity_metadata(SnowDensity) SnowDensity%timeAvgOpt = 0 allocate(SnowDensity%unittypes(1)) SnowDensity%unittypes(1) = "kg m-3" + allocate(SnowDensity%valid_min(1)) + SnowDensity%valid_min = (/ 100.0 /) + allocate( SnowDensity%valid_max(1)) + SnowDensity%valid_max = (/ 1000.0 /) SnowDensity%varid_def = -99 SnowDensity%selectOpt = 1 end subroutine LVT_set_SnowDensity_metadata @@ -759,6 +767,10 @@ subroutine LVT_set_LayerSnowDensity_metadata(LayerSnowDensity) LayerSnowDensity%timeAvgOpt = 0 allocate(LayerSnowDensity%unittypes(1)) LayerSnowDensity%unittypes(1) = "kg m-3" + allocate(LayerSnowDensity%valid_min(1)) + LayerSnowDensity%valid_min = (/ 100.0 /) + allocate(LayerSnowDensity%valid_max(1)) + LayerSnowDensity%valid_max = (/ 1000.0 /) LayerSnowDensity%varid_def = -99 LayerSnowDensity%selectOpt = 1 end subroutine LVT_set_LayerSnowDensity_metadata @@ -777,6 +789,10 @@ subroutine LVT_set_SnowGrain_metadata(SnowGrain) SnowGrain%timeAvgOpt = 0 allocate(SnowGrain%unittypes(1)) SnowGrain%unittypes(1) = "micron" + allocate(SnowGrain%valid_min(1)) + SnowGrain%valid_min = (/ 50.0 /) + allocate(SnowGrain%valid_max(1)) + SnowGrain%valid_max = (/ 2000.0 /) SnowGrain%varid_def = -99 SnowGrain%selectOpt = 1 end subroutine LVT_set_SnowGrain_metadata @@ -795,6 +811,10 @@ subroutine LVT_set_SnowDepth_metadata(SnowDepth) SnowDepth%timeAvgOpt = 0 allocate(SnowDepth%unittypes(1)) SnowDepth%unittypes(1) = "m" + allocate(SnowDepth%valid_min(1)) + SnowDepth%valid_min = (/ 0.0 /) + allocate(SnowDepth%valid_max(1)) + SnowDepth%valid_max = (/ 100.0 /) SnowDepth%varid_def = -99 SnowDepth%selectOpt = 1 end subroutine LVT_set_SnowDepth_metadata @@ -813,6 +833,10 @@ subroutine LVT_set_grndsnow_metadata(grndSnow) grndSnow%timeAvgOpt = 0 allocate(grndSnow%unittypes(1)) grndSnow%unittypes(1) = "kg m-2" + allocate(grndSnow%valid_min(1)) + grndSnow%valid_min = (/ 0.0 /) + allocate(grndSnow%valid_max(1)) + grndSnow%valid_max = (/ 1000.0 /) grndSnow%varid_def = -99 grndSnow%selectOpt = 1 end subroutine LVT_set_grndsnow_metadata @@ -831,6 +855,10 @@ subroutine LVT_set_surftsnow_metadata(surftSnow) surftSnow%timeAvgOpt = 0 allocate(surftSnow%unittypes(1)) surftSnow%unittypes(1) = "kg m-2" + allocate(surftSnow%valid_min(1)) + surftSnow%valid_min = (/ 0.0 /) + allocate(surftSnow%valid_max(1)) + surftSnow%valid_max = (/ 10000.0 /) surftSnow%varid_def = -99 surftSnow%selectOpt = 1 end subroutine LVT_set_surftsnow_metadata @@ -840,6 +868,8 @@ subroutine LVT_deallocate_metadata(var) implicit none type(LVT_lismetadataEntry), intent(inout) :: var if (allocated(var%unittypes)) deallocate(var%unittypes) + if (allocated(var%valid_min)) deallocate(var%valid_min) + if (allocated(var%valid_max)) deallocate(var%valid_max) end subroutine LVT_deallocate_metadata ! subroutine LVT_set_ps41_netcdf_header(var, ftn, dimID, udef, varID) From 84aa8ffb3df0377d6ecdc434e45bad8db83df151 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 19 Mar 2021 15:52:58 -0400 Subject: [PATCH 27/64] Some code cleanup. --- lvt/core/LVT_DataStreamsMod.F90 | 15 ++------------- 1 file changed, 2 insertions(+), 13 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 9999b5469..7d5787e12 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -422,8 +422,7 @@ subroutine LVT_writeDataStreams integer :: count real :: mean, m2, stddev, new_value - ! EMK...Keep track of how many JULES PS41 snow variables have been - ! prepped for ensemble processing + ! EMK...Special processing of some JULES PS41 multi-layer snow ensembles. integer :: count_jules_ps41_ens_snow_vars logical :: jules_ps41_ens_snow logical :: is_ps41_snow_var @@ -435,9 +434,7 @@ subroutine LVT_writeDataStreams type(LVT_lismetadataEntry), target :: SnowDensity type(LVT_lismetadataEntry), target :: SnowGrain type(LVT_lismetadataEntry), target :: SurftSnow - integer :: GrndSnowID, LayerSnowDensityID, SWEID, SnowDepthID, & - SnowDensityID, SnowGrainID, SurftSnowID - + ! EMK...This is only used when LVT is run in "557 post" mode. if (trim(LVT_rc%runmode) .ne. "557 post") return @@ -1561,11 +1558,6 @@ subroutine LVT_writeDataStreams if (jules_ps41_ens_snow) then if (LVT_rc%lvt_out_format.eq."netcdf") then - write(LVT_logunit,*)'EMK: LVT_rc%lnc, LVT_rc%gnc = ', & - LVT_rc%lnc, LVT_rc%gnc - write(LVT_logunit,*)'EMK: LVT_rc%lnr, LVT_rc%gnr = ', & - LVT_rc%lnr, LVT_rc%gnr - gtmp1_1d = 0.0 call LVT_fetch_jules_ps41_ens_snow_final( & LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & @@ -1608,7 +1600,6 @@ subroutine LVT_writeDataStreams call LVT_fetch_jules_ps41_ens_snow_final( & LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & 1, "SnowDepth_inst", is_ps41_snow_var) - write(LVT_logunit,*)'EMK: is_ps41_snow_var = ', is_ps41_snow_var call writeSingleNetcdfVar(ftn_mean, & gtmp1_1d, & SnowDepth%varid_def, & @@ -1782,8 +1773,6 @@ subroutine LVT_writeDataStreams elseif(LVT_rc%lvt_out_format.eq."netcdf") then - write(LVT_logunit,*) & - 'EMK: Calling writeSingleNetcdfVar HERE...' call writeSingleNetcdfVar(ftn_mean,& gtmp1_1d,& lisdataentry%varid_def,& From 7dc5ce8814042cc862716e4c816f5c052a009508 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 19 Mar 2021 16:55:41 -0400 Subject: [PATCH 28/64] Some code clean-up. --- .../557post/LVT_557post_ps41_snowMod.F90 | 114 +++--------------- 1 file changed, 14 insertions(+), 100 deletions(-) diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 27784ce8e..b133ac1cb 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -13,8 +13,6 @@ module LVT_557post_ps41_snowMod - use LVT_logMod, only: LVT_logunit - ! Defaults implicit none private @@ -39,13 +37,6 @@ module LVT_557post_ps41_snowMod ! Input part, populate the following input variables before calling the ! step subroutines - !real, dimension(nensem, nlayer) :: en_sice - !real, dimension(nensem, nlayer) :: en_sliq - !real, dimension(nensem, nlayer) :: en_tsnow - !real, dimension(nensem, nlayer) :: en_rgrainl - !real, dimension(nensem, nlayer) :: en_ds - !integer, dimension(nensem) :: en_nsnow - real, allocatable :: en_sice(:,:) real, allocatable :: en_sliq(:,:) real, allocatable :: en_tsnow(:,:) @@ -53,7 +44,7 @@ module LVT_557post_ps41_snowMod real, allocatable :: en_ds(:,:) integer, allocatable :: en_nsnow(:) - ! output part, grab values in these variables after calling the step + ! Output part, grab values in these variables after calling the step ! subroutines real, dimension(nlayer) :: new_ds real, dimension(nlayer) :: new_sice @@ -68,8 +59,6 @@ module LVT_557post_ps41_snowMod integer :: new_nsnow ! Internal variables - !real, dimension(nensem, nlayer) :: en_C ! heat capacity (J/kg/K) - !real, dimension(nensem, nlayer) :: en_e ! internal energy (J/m2) real, allocatable :: en_C(:,:) ! heat capacity (J/kg/K) real, allocatable :: en_e(:,:) ! internal energy (J/m2) @@ -130,7 +119,7 @@ module LVT_557post_ps41_snowMod public :: LVT_set_GrndSnow_metadata public :: LVT_set_SurftSnow_metadata public :: LVT_deallocate_metadata - !public :: LVT_set_ps41_netcdf_header + contains ! Allocate all step arrays based on number of ensemble members. @@ -174,7 +163,7 @@ subroutine LVT_init_jules_ps41_ens_snow() call nullify_pointers() end subroutine LVT_init_jules_ps41_ens_snow - ! Nullify all pointers + ! Nullify all internal pointers subroutine nullify_pointers() implicit none nullify(snowIce) @@ -635,6 +624,9 @@ subroutine LVT_proc_jules_ps41_ens_snow() end subroutine LVT_proc_jules_ps41_ens_snow ! Fetch appropriate "final" array based on requested variable name. + ! We also deallocate single-layer "final" array after copying to + ! reduce memory usage; the multi-layer arrays must remain allocated, + ! since only a single vertical slice is copied back by this routine. subroutine LVT_fetch_jules_ps41_ens_snow_final(nc, nr, data, k, short_name, & is_ps41_snow_var) @@ -709,6 +701,7 @@ subroutine LVT_cleanup_jules_ps41_ens_snow() if (allocated(surftSnow_final)) deallocate(surftSnow_final) end subroutine LVT_cleanup_jules_ps41_ens_snow + ! Set metadata structure for SWE subroutine LVT_set_SWE_metadata(SWE) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -731,6 +724,7 @@ subroutine LVT_set_SWE_metadata(SWE) SWE%selectOpt = 1 end subroutine LVT_set_SWE_metadata + ! Set metadata structure for SnowDensity subroutine LVT_set_SnowDensity_metadata(SnowDensity) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -753,6 +747,7 @@ subroutine LVT_set_SnowDensity_metadata(SnowDensity) SnowDensity%selectOpt = 1 end subroutine LVT_set_SnowDensity_metadata + ! Set metadata structure for LayerSnowDensity subroutine LVT_set_LayerSnowDensity_metadata(LayerSnowDensity) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -775,6 +770,7 @@ subroutine LVT_set_LayerSnowDensity_metadata(LayerSnowDensity) LayerSnowDensity%selectOpt = 1 end subroutine LVT_set_LayerSnowDensity_metadata + ! Set metadata structure for SnowGrain subroutine LVT_set_SnowGrain_metadata(SnowGrain) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -797,6 +793,7 @@ subroutine LVT_set_SnowGrain_metadata(SnowGrain) SnowGrain%selectOpt = 1 end subroutine LVT_set_SnowGrain_metadata + ! Set metadata structure for SnowDepth subroutine LVT_set_SnowDepth_metadata(SnowDepth) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -819,6 +816,7 @@ subroutine LVT_set_SnowDepth_metadata(SnowDepth) SnowDepth%selectOpt = 1 end subroutine LVT_set_SnowDepth_metadata + ! Set metadata structure for GrndSnow subroutine LVT_set_grndsnow_metadata(grndSnow) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -841,6 +839,7 @@ subroutine LVT_set_grndsnow_metadata(grndSnow) grndSnow%selectOpt = 1 end subroutine LVT_set_grndsnow_metadata + ! Set metadata structure for SurftSnow subroutine LVT_set_surftsnow_metadata(surftSnow) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -863,6 +862,7 @@ subroutine LVT_set_surftsnow_metadata(surftSnow) surftSnow%selectOpt = 1 end subroutine LVT_set_surftsnow_metadata + ! Deallocates internal arrays within structure subroutine LVT_deallocate_metadata(var) use LVT_LISoutputHandlerMod, only: LVT_lismetadataEntry implicit none @@ -872,91 +872,5 @@ subroutine LVT_deallocate_metadata(var) if (allocated(var%valid_max)) deallocate(var%valid_max) end subroutine LVT_deallocate_metadata -! subroutine LVT_set_ps41_netcdf_header(var, ftn, dimID, udef, varID) - -! ! Modules -! use LVT_histDataMod, only: LVT_metadataEntry -! use LVT_logMod, only: LVT_verify -! #if (defined USE_NETCDF3 || defined USE_NETCDF4) -! use netcdf -! #endif - -! ! Defaults -! implicit none - -! ! Arguments -! type(LVT_metadataEntry), intent(in) :: var -! integer, intent(in) :: ftn -! integer, intent(in) :: dimID(3) -! real, intent(in) :: udef -! integer, intent(out) :: varID - -! ! Local variables -! integer :: num_dims - -! num_dims = 2 -! if (var%vlevels .eq. 3) then -! num_dims = 3 -! end if - - -! ! call LVT_verify(nf90_def_var(ftn, & -! ! trim(var%short_name), & -! ! nf90_float, & -! ! dimids = dimID(1:num_dims), & -! ! varID=varID), & -! ! 'nf90_def_var for '// & -! ! trim(var%short_name)// & -! ! 'failed in LVT_set_ps41_netcdf_header') - -! ! #if(defined USE_NETCDF4) -! ! call LVT_verify(nf90_def_var_deflate(ftn, & -! ! varID, & -! ! NETCDF_shuffle, NETCDF_deflate, NETCDF_deflate_level), & -! ! 'nf90_def_var_deflate for '// & -! ! trim(var%short_name)// & -! ! 'failed in LVT_set_ps41_netcdf_header') -! ! #endif - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID, & -! ! "units",& -! ! trim(var%units))) - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID, & -! ! "standard_name", & -! ! trim(var%standard_name))) - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID,& -! ! "long_name",& -! ! trim(var%long_name))) - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID,& -! ! "scale_factor", 1.0)) - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID,& -! ! "add_offset", 0.0)) - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID,& -! ! "missing_value", udef)) - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID, & -! ! "_FillValue", udef)) - -! ! call LVT_verify(nf90_put_att(ftn, & -! ! varID, & -! ! "vmin", udef)) - -! ! call LVT_verify(nf90_put_att(ftn,& -! ! varID, & -! ! "vmax", udef)) - ! end subroutine LVT_set_ps41_netcdf_header - end module LVT_557post_ps41_snowMod From 3d8940b611fae9eef6c83dc9a4487467bb394f4a Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 19 Mar 2021 17:17:00 -0400 Subject: [PATCH 29/64] More code/comment cleanup. --- .../557post/LVT_557post_ps41_snowMod.F90 | 27 ++++++++++++------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index b133ac1cb..30524b91a 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -1,15 +1,22 @@ -! Developer note: -! lis_jules_en_snow module is developed for creating a conceptual snowpack -! based on LIS-JULES ensemble simulation. The steps are consistent with -! JULES physics defined in the JULES subroutines "layersnow" and "relayersnow". -! Consistencies of snow mass and internal energy have been kept between -! ensemble means and the new snowpack. +!-----------------------BEGIN NOTICE -- DO NOT EDIT---------------------------- +! NASA GSFC Land surface Verification Toolkit (LVT) V1.0 +!-------------------------END NOTICE -- DO NOT EDIT---------------------------- ! -! Shugong Wang (shugong.wang@nasa.gov) 03/10/2021 -! Editorial updates for LVT by Eric Kemp, SSAI, 11 Mar 2021 +! MODULE: LVT_557post_ps41_snowMod ! -#include "LVT_misc.h" -#include "LVT_NetCDF_inc.h" +! PURPOSE: +! +! This module was developed to create a conceptual snowpack based on a +! LIS-JULES ensemble simulation with "PS41" physics, to pass to the GALWEM +! NWP model which is coupled with JULES. The steps are consistent +! with JULES physics defined in the JULES subroutines "layersnow" and +! "relayersnow". Consistencies of snow mass and internal energy have been +! kept between ensemble means and the new snowpack. +! +! REVISION HISTORY: +! 10 Mar 2021: Shugong Wang, Initial Specification. +! 19 Mar 2021: Eric Kemp, Ported to LVT. +!------------------------------------------------------------------------------ module LVT_557post_ps41_snowMod From 1e192d00806693078017c8b19a1d7a31508c5229 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 22 Mar 2021 16:33:28 -0400 Subject: [PATCH 30/64] Added some array initializations and value limits. --- .../557post/LVT_557post_ps41_snowMod.F90 | 25 +++++++++++++++---- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 index 30524b91a..41917f298 100644 --- a/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 +++ b/lvt/runmodes/557post/LVT_557post_ps41_snowMod.F90 @@ -372,6 +372,10 @@ subroutine step_10() new_sliq(:) = 0.0 new_rgrainl(:) = 0.0 + ! EMK...Other initializations + new_rho_snow(:) = 0.0 + new_tsnow(:) = tm + !!! initialize with all new layers empty do l = 1, new_nsnow newremains(l) = new_ds(l) ! ! snow layer thicknesses (m), new @@ -448,6 +452,9 @@ subroutine step_10() csnow = new_sice(l) * hcapi + new_sliq(l) * hcapw new_tsnow(l) = tm + u(l)/csnow new_rho_snow(l) = (new_sice(l) + new_sliq(l)) / new_ds(l) + !EMK...Add limits to snow density + new_rho_snow(l) = max(109., min(917., new_rho_snow(l))) + select case(i_relayer_opt) case (ip_relayer_linear) new_rgrainl(l) = new_rgrainl(l) / new_ds(l) @@ -456,6 +463,11 @@ subroutine step_10() end select end do + ! EMK...Enforce snow grain size limits + do l = 1, nlayer + new_rgrainl(l) = min(2000., max(new_rgrainl(l), 50.) ) + end do + ! snow surface grain size for radiative calculations new_rgrain = new_rgrainl(1) @@ -471,6 +483,8 @@ subroutine step_11() end do ! diagnose bulk density of snowpack new_rho_grnd = new_snowmass / new_snowdepth + ! EMK...Add limits to bulk density + new_rho_grnd = max(109., min(917., new_rho_grnd)) end subroutine step_11 ! Set pointer to passed array based on variable name @@ -618,6 +632,7 @@ subroutine LVT_proc_jules_ps41_ens_snow() snowDepth_final(ij) = new_snowdepth snowGrain_final(ij) = new_rgrain surftSnow_final(ij) = new_snowmass + end if end do ! c @@ -680,7 +695,7 @@ subroutine LVT_fetch_jules_ps41_ens_snow_final(nc, nr, data, k, short_name, & case ("SnowLiq_inst") data(:) = snowLiq_final(:,k) case ("SnowTProf_inst") - data(:) = snowtProf_final(:,k) + data(:) = SnowTProf_final(:,k) case ("SurftSnow_inst") data(:) = surftSnow_final(:) deallocate(surftSnow_final) @@ -747,9 +762,9 @@ subroutine LVT_set_SnowDensity_metadata(SnowDensity) allocate(SnowDensity%unittypes(1)) SnowDensity%unittypes(1) = "kg m-3" allocate(SnowDensity%valid_min(1)) - SnowDensity%valid_min = (/ 100.0 /) + SnowDensity%valid_min = (/ 109.0 /) allocate( SnowDensity%valid_max(1)) - SnowDensity%valid_max = (/ 1000.0 /) + SnowDensity%valid_max = (/ 917.0 /) SnowDensity%varid_def = -99 SnowDensity%selectOpt = 1 end subroutine LVT_set_SnowDensity_metadata @@ -770,9 +785,9 @@ subroutine LVT_set_LayerSnowDensity_metadata(LayerSnowDensity) allocate(LayerSnowDensity%unittypes(1)) LayerSnowDensity%unittypes(1) = "kg m-3" allocate(LayerSnowDensity%valid_min(1)) - LayerSnowDensity%valid_min = (/ 100.0 /) + LayerSnowDensity%valid_min = (/ 109.0 /) allocate(LayerSnowDensity%valid_max(1)) - LayerSnowDensity%valid_max = (/ 1000.0 /) + LayerSnowDensity%valid_max = (/ 917.0 /) LayerSnowDensity%varid_def = -99 LayerSnowDensity%selectOpt = 1 end subroutine LVT_set_LayerSnowDensity_metadata From 3f22fef29dd6f048c947b14cf2ea4c28bec91a97 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 22 Mar 2021 17:05:52 -0400 Subject: [PATCH 31/64] Fixed bug that broke non-JULES PS41 snow ensemble postprocessing. --- lvt/core/LVT_DataStreamsMod.F90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 7d5787e12..72387a277 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -490,8 +490,8 @@ subroutine LVT_writeDataStreams trim(LVT_LIS_rc(1)%model_name) .eq. "JULES.5.0" .and. & LVT_rc%nensem .gt. 1) then - write(LVT_logunit,*) & - '[INFO] Prepare processing of JULES PS41 ensemble snow...' + ! It's possible JULES PS41 snow variables will be processed. + ! Take some preliminary steps. call LVT_init_jules_PS41_ens_snow() count_jules_ps41_ens_snow_vars = 0 @@ -516,11 +516,13 @@ subroutine LVT_writeDataStreams dataEntry => dataEntry%next end do - if (count_jules_ps41_ens_snow_vars .ne. 6) then + if (count_jules_ps41_ens_snow_vars .eq. 0) then + jules_ps41_ens_snow = .false. + else if (count_jules_ps41_ens_snow_vars .ne. 6) then write(LVT_logunit,*) & '[ERR] Cannot process JULES PS41 multi-layer snow' write(LVT_logunit,*) & - '[ERR] Not all variables found for ensemble processing' + '[ERR] Missing some snow variables for ensemble processing' flush(LVT_logunit) call LVT_endrun() else @@ -529,7 +531,9 @@ subroutine LVT_writeDataStreams ! Go to head of list for later processing dataEntry => LVT_histData%head_ds1_list + end if + if (jules_ps41_ens_snow) then ! We now have all the PS41 snow variables needed for ensemble ! processing. We invoke the relayer algorithm. The output variables ! will be fetched further down. @@ -1633,7 +1637,9 @@ subroutine LVT_writeDataStreams call LVT_deallocate_metadata(SurftSnow) else - write(LVT_logunit,*)'EMK: GRIB OUTPUT NOT SUPPORTED YET' + write(LVT_logunit,*) & + '[ERR] GRIB OUTPUT NOT SUPPORTED YET FOR PS41 SNOW' + flush(LVT_logunit) stop end if end if From a4aa003d9e6840099cae1230f956cb1cf4124e17 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 23 Mar 2021 16:49:13 -0400 Subject: [PATCH 32/64] Updated for special processing of JULES PS41 snow variables. --- .../templates/make_lvt_config_3hr_jules.py | 120 +++++++++--------- 1 file changed, 59 insertions(+), 61 deletions(-) diff --git a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py index cb3c43bbd..a5332908d 100755 --- a/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py +++ b/lvt/utils/afwa/templates/make_lvt_config_3hr_jules.py @@ -23,7 +23,6 @@ #output = "grib2" # Most variables are processed independently, and are listed below. -# Updated for PS41 (multi-layer snow physics) var_attributes = { "AvgSurfT_inst": "AvgSurfT 1 1 K - 0 1 AvgSurfT 1 1 K - 0 1", @@ -95,6 +94,7 @@ "Wind_f 1 1 m/s - 0 1 Wind_f 1 1 m/s - 0 1", "Wind_f_tavg": "Wind_f 1 1 m/s - 1 1 Wind_f 1 1 m/s - 1 1", + "ActSnowNL_inst": "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", "GrndSnow_inst": @@ -119,41 +119,15 @@ "SurftSnow 1 1 kg/m2 - 0 1 SurftSnow 1 1 kg/m2 - 0 1", } -# # EMK FOR GALWEM TESTING -# var_attributes = { -# "AvgSurfT_inst": -# "AvgSurfT 1 1 K - 0 1 AvgSurfT 1 1 K - 0 1", -# "SoilMoist_inst": -# "SoilMoist 1 4 m3/m3 - 0 4 SoilMoist 1 4 m3/m3 - 0 4", -# "SoilTemp_inst": -# "SoilTemp 1 4 K - 0 4 SoilTemp 1 4 K - 0 4", -# "SnowDepth_inst": -# "SnowDepth 1 1 m - 0 1 SnowDepth 1 1 m - 0 1", -# "SWE_inst": -# "SWE 1 1 kg/m2 - 0 1 SWE 1 1 kg/m2 - 0 1", -# "ActSnowNL_inst": -# "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", -# "GrndSnow_inst": -# "GrndSnow 1 1 kg/m2 - 0 1 GrndSnow 1 1 kg/m2 - 0 1", -# "LayerSnowDensity_inst": -# "LayerSnowDensity 1 1 kg/m3 - 0 3 LayerSnowDensity 1 1 kg/m3 - 0 3", -# "LayerSnowDepth_inst": -# "LayerSnowDepth 1 1 m - 0 3 LayerSnowDepth 1 1 m - 0 3", -# "LayerSnowGrain_inst": -# "LayerSnowGrain 1 1 microns - 0 3 LayerSnowGrain 1 1 microns - 0 3", -# "SnowDensity_inst": -# "SnowDensity 1 1 kg/m3 - 0 1 SnowDensity 1 1 kg/m3 - 0 1", -# "SnowGrain_inst": -# "SnowGrain 1 1 microns - 0 1 SnowGrain 1 1 microns - 0 1", -# "SnowIce_inst": -# "SnowIce 1 1 kg/m2 - 0 3 SnowIce 1 1 kg/m2 - 0 3", -# "SnowLiq_inst": -# "SnowLiq 1 1 kg/m2 - 0 3 SnowLiq 1 1 kg/m2 - 0 3", -# "SnowTProf_inst": -# "SnowTProf 1 1 K - 0 3 SnowTProf 1 1 K - 0 3", -# "SurftSnow_inst": -# "SurftSnow 1 1 kg/m2 - 0 1 SurftSnow 1 1 kg/m2 - 0 1", -# } +# EMK FOR GALWEM TESTING +var_attributes = { + "AvgSurfT_inst": + "AvgSurfT 1 1 K - 0 1 AvgSurfT 1 1 K - 0 1", + "SoilMoist_inst": + "SoilMoist 1 4 m3/m3 - 0 4 SoilMoist 1 4 m3/m3 - 0 4", + "SoilTemp_inst": + "SoilTemp 1 4 K - 0 4 SoilTemp 1 4 K - 0 4", +} # RHMin must be processed with Tair_f_min, so these are listed together var_attributes_special = { @@ -163,33 +137,52 @@ "RHMin 1 1 % - 0 1 RHMin 1 1 % - 0 1", } +# PS41 snow variables must be processed together. +var_attributes_ps41_snow = { + "ActSnowNL_inst": + "ActSnowNL 1 1 - - 0 1 ActSnowNL 1 1 - - 0 1", + "LayerSnowDepth_inst": + "LayerSnowDepth 1 1 m - 0 3 LayerSnowDepth 1 1 m - 0 3", + "LayerSnowGrain_inst": + "LayerSnowGrain 1 1 microns - 0 3 LayerSnowGrain 1 1 microns - 0 3", + "SnowIce_inst": + "SnowIce 1 1 kg/m2 - 0 3 SnowIce 1 1 kg/m2 - 0 3", + "SnowLiq_inst": + "SnowLiq 1 1 kg/m2 - 0 3 SnowLiq 1 1 kg/m2 - 0 3", + "SnowTProf_inst": + "SnowTProf 1 1 K - 0 3 SnowTProf 1 1 K - 0 3", +} + # Smooth variables that are perturbed, derived from perturbed variables, # or are LSM outputs that are affected by perturbed variables via physics. -# EMK...Smoothing turned off to avoid numerical instabilities in GALWEM. -# smooth_vars = ["AvgSurfT_inst", "AvgSurfT_tavg", -# "Albedo_tavg", "CanopInt_inst", -# "Evap_tavg", "LWdown_f_inst", -# "LWdown_f_tavg", "Qh_tavg", "Qle_tavg", -# "Qs_acc", "Qsb_acc", "RelSMC_inst", -# "SmLiqFrac_inst", "SnowDepth_inst", -# "Snowcover_inst", "SoilMoist_inst", -# "SoilMoist_tavg", "SoilTemp_inst", -# "SoilTemp_tavg", "SWdown_f_inst", -# "SWdown_f_tavg", "SWE_inst", -# "Tair_f_inst", "Tair_f_max", -# "Tair_f_tavg", "TotalPrecip_acc", -# "Tair_f_min", "RHMin_inst", -# "GrndSnow_inst", "LayerSnowDensity_inst", -# "LayerSnowDepth_inst", "LayerSnowGrain_inst", -# "SnowDensity_inst", "SnowGrain_inst", -# "SnowIce_inst", "SnowLiq_inst", -# "SnowTProf_inst", "SurftSnow_inst"] +smooth_vars = ["AvgSurfT_inst", "AvgSurfT_tavg", + "Albedo_tavg", "CanopInt_inst", + "Evap_tavg", "LWdown_f_inst", + "LWdown_f_tavg", "Qh_tavg", "Qle_tavg", + "Qs_acc", "Qsb_acc", "RelSMC_inst", + "SmLiqFrac_inst", "SnowDepth_inst", + "Snowcover_inst", "SoilMoist_inst", + "SoilMoist_tavg", "SoilTemp_inst", + "SoilTemp_tavg", "SWdown_f_inst", + "SWdown_f_tavg", "SWE_inst", + "Tair_f_inst", "Tair_f_max", + "Tair_f_tavg", "TotalPrecip_acc", + "Tair_f_min", "RHMin_inst", + + "GrndSnow_inst", "LayerSnowDensity_inst", + "LayerSnowDepth_inst", "LayerSnowGrain_inst", + "SnowDensity_inst", "SnowGrain_inst", + "SnowIce_inst", "SnowLiq_inst", + "SnowTProf_inst", "SurftSnow_inst"] + +# EMK for GALWEM...No smoothing smooth_vars = [] lines = open(template, 'r').readlines() vars = list(var_attributes.keys()) #vars.append("RHMin_inst") # RHMin will be handled specially below +vars.append("PS41Snow_inst") # PS41 snow vars handled specially below vars.sort() firstVar = True for var in vars: @@ -198,11 +191,10 @@ if "LVT output format:" in line: line = "LVT output format: %s\n" % (output) elif "Process HYCOM data:" in line: - #if firstVar: - # line = "Process HYCOM data: 1\n" - #else: - # line = "Process HYCOM data: 0\n" - line = "Process HYCOM data: 0\n" + if firstVar: + line = "Process HYCOM data: 1\n" + else: + line = "Process HYCOM data: 0\n" elif "Apply noise reduction filter:" in line: if var in smooth_vars: line = "Apply noise reduction filter: 1\n" @@ -234,6 +226,11 @@ keys = sorted(list(var_attributes_special.keys())) for key in keys: line += "%s\n" % (var_attributes_special[key]) + # Special handling for PS41 snow physics + if var == "PS41Snow_inst": + keys = sorted(list(var_attributes_ps41_snow.keys())) + for key in keys: + line += "%s\n" % (var_attributes_ps41_snow[key]) # The general case else: line += "%s\n" % (var_attributes[var]) @@ -241,7 +238,8 @@ line = "Metrics output directory: OUTPUT/STATS.%s.3hr\n" % (var) elif "LIS output attributes file:" in line: line = "LIS output attributes file:" - line += " ./tables/MODEL_OUTPUT_LIST.TBL.lvt_557post.%s.3hr\n" % (var) + line += " ./tables/MODEL_OUTPUT_LIST.TBL.lvt_557post.%s.3hr\n" \ + % (var) newlines.append(line) From 2d957a04a745b9cb9d87a56d6035a552d800fcd6 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 23 Mar 2021 16:51:29 -0400 Subject: [PATCH 33/64] Updated for special processing of JULES PS41 snow variables. --- .../afwa/templates/submit_lvt_discover_3hr_jules.py | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py index 2d538d7dc..22b7eee45 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py @@ -40,16 +40,9 @@ "SnowLiq_inst", "SnowTProf_inst", "SurftSnow_inst"] -# # EMK GALWEM TESTING -# vars = ["SoilMoist_inst", "SoilTemp_inst", -# "AvgSurfT_inst", -# 'SnowDepth_inst', 'SWE_inst', -# "ActSnowNL_inst", "GrndSnow_inst", -# "LayerSnowDensity_inst", "LayerSnowDepth_inst", -# "LayerSnowGrain_inst", "SnowDensity_inst", -# "SnowGrain_inst", "SnowIce_inst", -# "SnowLiq_inst", "SnowTProf_inst", -# "SurftSnow_inst"] +# EMK GALWEM TESTING +vars = ["AvgSurfT_inst", "PS41Snow_inst", + "SoilMoist_inst","SoilTemp_inst"] if not os.path.exists("LVT"): print("ERROR, LVT executable does not exist!") From 1ace6e90c2925dd5a04810dde1738d0035f63365 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 23 Mar 2021 16:54:47 -0400 Subject: [PATCH 34/64] Added special handling of JULES PS41 snow variables. --- lvt/utils/afwa/run_ncks.py | 37 ++++++++++++++++++++++++------------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/lvt/utils/afwa/run_ncks.py b/lvt/utils/afwa/run_ncks.py index 6d7da45e5..00c6af15c 100755 --- a/lvt/utils/afwa/run_ncks.py +++ b/lvt/utils/afwa/run_ncks.py @@ -46,6 +46,8 @@ # added path for NCKS on Koehr. # 14 Oct 2020: Eric Kemp (SSAI), updated NCKS path on Discover. # 05 Feb 2021: Eric Kemp (SSAI), added JULES multi-layer snow variables. +# 23 Mar 2021: Eric Kemp (SSAI), revised JULES multi-layer snow variables +# for PS41 physics. # #------------------------------------------------------------------------------ @@ -133,7 +135,7 @@ # The 24-hr postprocessing should include the latest 3-hr snow depth and SWE. _LVT_NOAHMP_INVOCATIONS_24HR_LATEST = ['SnowDepth_inst', 'SWE_inst'] -# The LVT invocations for JULES LSM output. Updated for PS41. +# The LVT invocations for JULES LSM output. _LVT_JULES_INVOCATIONS_3HR = ['Albedo_tavg', 'AvgSurfT_inst', 'AvgSurfT_tavg', 'CanopInt_inst', @@ -161,16 +163,19 @@ 'SnowLiq_inst', 'SnowTProf_inst', 'SurftSnow_inst'] -# EMK for RECON...PS41 configuration -# _LVT_JULES_INVOCATIONS_3HR = ["AvgSurfT_inst", -# "SoilMoist_inst","SoilTemp_inst", -# "SnowDepth_inst", "SWE_inst", -# 'ActSnowNL_inst', 'GrndSnow_inst', -# 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', -# 'LayerSnowGrain_inst', 'SnowDensity_inst', -# 'SnowGrain_inst', 'SnowIce_inst', -# 'SnowLiq_inst', -# 'SnowTProf_inst', 'SurftSnow_inst'] +# EMK for RECON +_LVT_JULES_INVOCATIONS_3HR = ["AvgSurfT_inst", + "SoilMoist_inst","SoilTemp_inst", + "PS41Snow_inst"] + +# JULES PS41 snow variables are in a unique netCDF file. +_LVT_JULES_PS41_SNOW_3HR = ["SnowDepth_inst", "SWE_inst", + 'ActSnowNL_inst', 'GrndSnow_inst', + 'LayerSnowDensity_inst', 'LayerSnowDepth_inst', + 'LayerSnowGrain_inst', 'SnowDensity_inst', + 'SnowGrain_inst', 'SnowIce_inst', + 'SnowLiq_inst', + 'SnowTProf_inst', 'SurftSnow_inst'] _LVT_JULES_INVOCATIONS_24HR = ['Evap_tavg', 'LWdown_f_tavg', 'RHMin_inst', @@ -373,7 +378,7 @@ def get_nc_mean_files(validdt, lsm, period): # Collect input files for invocation in invocation_list: - # FIXME -- Let user configure output directory prefix + path = "STATS.%s.%shr" % (invocation, period) # FIXME -- Let user configure file name @@ -523,7 +528,13 @@ def merge_nc_files(lsm, ncks, period, nc_infiles, invocations = _INVOCATIONS[key][1:] for invocation in invocations: - variables = _LIS_VARIABLES[key][invocation] + + # Special handing of JULES PS41 snow variables + if invocation == "PS41Snow_inst": + variables = _LVT_JULES_PS41_SNOW_3HR[:] + else: + variables = _LIS_VARIABLES[key][invocation] + for variable in variables: cmd = "%s -A -v %s %s %s" \ % (ncks, variable, nc_infiles[invocation], nc_outfile) From 4502dae8b702608a3eb85bba1abebd08193e0d79 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 23 Mar 2021 16:56:29 -0400 Subject: [PATCH 35/64] Added new template for JULES PS41 snow variables. --- .../MODEL_OUTPUT_LIST.TBL.lvt_557post.PS41Snow_inst.3hr | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.PS41Snow_inst.3hr diff --git a/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.PS41Snow_inst.3hr b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.PS41Snow_inst.3hr new file mode 100644 index 000000000..a3ac97703 --- /dev/null +++ b/lvt/utils/afwa/templates/MODEL_OUTPUT_LIST.TBL.lvt_557post.PS41Snow_inst.3hr @@ -0,0 +1,7 @@ +ActSnowNL: 1 "-" - 0 0 0 1 255 1000 0 1 # Actual number of snow layers +LayerSnowDepth: 1 "m" - 0 0 0 3 11 1000 0 1 # Snow depth for each layer +LayerSnowGrain: 1 "micron" - 0 0 0 3 255 1000 0 1 # Snow grain size for each layer +SnowIce: 1 "kg/m2" - 0 0 0 3 255 1000 0 1 # Snow layer ice +SnowLiq: 1 "kg/m2" - 0 0 0 3 16 1000 0 1 # Snow layer liquid water +SnowTProf: 1 "K" - 0 0 0 3 1 1000 0 1 # Snow temperature profile + From b7608d7e513b1bd1375a80d9e1aba1a4b48a8cbd Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 1 Apr 2021 16:31:07 -0400 Subject: [PATCH 36/64] Started new module for processing NAVGEM sea ice and temperature data. --- lvt/core/LVT_navgemMod.F90 | 107 +++++++++++++++++++++++++++++++++++++ 1 file changed, 107 insertions(+) create mode 100644 lvt/core/LVT_navgemMod.F90 diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 new file mode 100644 index 000000000..1fdcbbd2f --- /dev/null +++ b/lvt/core/LVT_navgemMod.F90 @@ -0,0 +1,107 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT---------------------------- +! NASA GSFC Land surface Verification Toolkit (LVT) V1.0 +!-------------------------END NOTICE -- DO NOT EDIT---------------------------- + +#include "LVT_misc.h" +#include "LVT_NetCDF_inc.h" + +!------------------------------------------------------------------------------ +! +! MODULE: LVT_navgemMod +! +! DESCRIPTION: +! Contains routines for reading skin temperature and sea ice from +! NAVGEM HDF5 restart files on thinned Gaussian grids, and interpolate to +! LVT grid. Intended to run as part of 557post mode for Air Force operations. +! +! REVISION HISTORY: +! 01 Apr 2021: Eric Kemp (SSAI), Initial implementation. Read codes borrow +! heavily from sample Python code provided by FNMOC. +!------------------------------------------------------------------------------ + +module LVT_navgemMod + + ! Modules + use LVT_logMod, only: LVT_logunit + + ! Defaults + implicit none + private + + ! Public routines + public :: LVT_get_navgem_filename + +contains + + subroutine construct_navgem_filename(rootdir, year, month, day, hour, & + fcst_hr, filename) + + ! Defaults + implicit none + + ! Arguments + character(len=*), intent(in) :: rootdir + integer, intent(in) :: year + integer, intent(in) :: month + integer, intent(in) :: day + integer, intent(in) :: hour + integer, intent(in) :: fcst_hr + character(len=*), intent(out) :: filename + + ! Local variables + character(len=10) :: yyyymmddhh + character(len=6) :: hhhhhh + + write(yyyymmddhh,'(i4.4,i2.2,i2.2,i2.2)') year, month, day, hour + write(hhhhhh,'(i6.6)') fcst_hr + + filename = trim(rootdir) // '/navgem_restart_T0681L060_slthin_quad_' & + // yyyymmddhh // '_' // hhhhhh // '.h5' + + end subroutine construct_navgem_filename + + subroutine LVT_get_navgem_filename(filename, & + year, month, day, hour, fcst_hr) + + ! Modules + use LVT_coreMod, only: LVT_rc + use LVT_timeMgrMod, only: LVT_get_julhr, LVT_julhr_date + + ! Defaults + implicit none + + ! Arguments + character(len=*), intent(inout) :: filename + integer, intent(out) :: year + integer, intent(out) :: month + integer, intent(out) :: day + integer, intent(out) :: hour + integer, intent(out) :: fcst_hr + + ! Locals + integer :: navgem_julhr, lvt_julhr + logical :: file_exists + + ! FIXME...Add dynamic search for nearest NAVGEM file + year = 2021 + month = 03 + day = 31 + hour = 18 + fcst_hr = 0 + call construct_navgem_filename('./navgem', & + year, month, day, hour, fcst_hr, filename) + + write(LVT_logunit,*)'[INFO] *** Searching for NAVGEM file ', & + trim(filename) + inquire(file=trim(filename), exist=file_exists) + if (file_exists) then + write(LVT_logunit,*)'[INFO] Will use ', trim(filename) + return + end if + + ! FIXME...Add dynamic search for NAVGEM file + write(LVT_logunit,*)'[ERR] Cannot find NAVGEM file!' + stop + + end subroutine LVT_get_navgem_filename +end module LVT_navgemMod From 8cef0cfc4d150ce9b781a14bbc74b30a6557e444 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 1 Apr 2021 16:31:47 -0400 Subject: [PATCH 37/64] Added use statement for NAVGEM module. This is to allow test compilations as the NAVGEM module is developed. It is not actually used yet. --- lvt/core/LVT_DataStreamsMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 72387a277..3ee26e254 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -22,6 +22,7 @@ module LVT_DataStreamsMod use LVT_coreMod use LVT_logMod use LVT_LISoutputHandlerMod + use LVT_navgemMod use LVT_timeMgrMod use map_utils use grib_api From 5fa8f6bb14826df9b2b39819d7c6b8e79d182647 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 1 Apr 2021 17:00:38 -0400 Subject: [PATCH 38/64] Started adding HDF5 wrapper subroutines. --- lvt/core/LVT_navgemMod.F90 | 89 +++++++++++++++++++++++++++++++++++--- 1 file changed, 83 insertions(+), 6 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 1fdcbbd2f..d639c4723 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -21,15 +21,11 @@ module LVT_navgemMod - ! Modules - use LVT_logMod, only: LVT_logunit - ! Defaults implicit none private ! Public routines - public :: LVT_get_navgem_filename contains @@ -60,11 +56,12 @@ subroutine construct_navgem_filename(rootdir, year, month, day, hour, & end subroutine construct_navgem_filename - subroutine LVT_get_navgem_filename(filename, & + subroutine get_navgem_filename(filename, & year, month, day, hour, fcst_hr) ! Modules use LVT_coreMod, only: LVT_rc + use LVT_logMod, only: LVT_logunit use LVT_timeMgrMod, only: LVT_get_julhr, LVT_julhr_date ! Defaults @@ -103,5 +100,85 @@ subroutine LVT_get_navgem_filename(filename, & write(LVT_logunit,*)'[ERR] Cannot find NAVGEM file!' stop - end subroutine LVT_get_navgem_filename + end subroutine get_navgem_filename + + subroutine fetch_navgem_fields(sst, cice, lat, lon) + + ! Modules +#if (defined USE_HDF5) + use HDF5 +#endif + + ! Defaults + implicit none + + ! Arguments + real, allocatable, intent(out) :: sst(:) + real, allocatable, intent(out) :: cice(:) + real, allocatable, intent(out) :: lat(:) + real, allocatable, intent(out) :: lon(:) + + ! Locals + character(len=250) :: filename + integer :: year, month, day, hour, fcst_hr + logical :: fail + integer :: hdferr +#if (defined USE_HDF5) + integer(HID_T) :: file_id, dataset_id, datatype_id +#endif + + ! Get NAVGEM filename + call get_navgem_filename(filename, year, month, day, hour, fcst_hr) + +#if (defined USE_HDF5) + ! Initialize IDs. Useful later for error handling. + file_id = -1 + dataset_id = -1 + datatype_id = -1 + + ! Initialize HDF5 Fortran interface + call open_hdf5_f_interface(fail) + if (fail) goto 100 + + ! Cleanup before returning +100 continue + call close_hdf5_f_interface(fail) + +#endif + end subroutine fetch_navgem_fields + +#if (defined USE_HDF5) + subroutine open_hdf5_f_interface(fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + implicit none + logical,intent(out) :: fail + integer :: hdferr + fail = .false. + call h5open_f(hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot initialize HDF5 ', & + 'Fortran interface!' + fail = .true. + end if + end subroutine open_hdf5_f_interface +#endif + +#if (defined USE_HDF5) + subroutine close_hdf5_f_interface(fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + implicit none + logical, intent(out) :: fail + integer :: hdferr + fail = .false. + call h5close_f(hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot close HDF5 Fortran interface!' + fail = .true. + end if + end subroutine close_hdf5_f_interface +#endif end module LVT_navgemMod From e113b8daf3c0fc73d0a60fc9a01ba8ff09a720a6 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 1 Apr 2021 17:12:09 -0400 Subject: [PATCH 39/64] Added routines to open and close NAVGEM file. --- lvt/core/LVT_navgemMod.F90 | 50 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index d639c4723..d5a67984a 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -140,8 +140,13 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) call open_hdf5_f_interface(fail) if (fail) goto 100 + ! Open the file + call open_navgem_file(filename, file_id, fail) + if (fail) goto 100 + ! Cleanup before returning 100 continue + if (file_id .gt. -1) call close_navgem_file(filename, file_id, fail) call close_hdf5_f_interface(fail) #endif @@ -165,6 +170,51 @@ subroutine open_hdf5_f_interface(fail) end subroutine open_hdf5_f_interface #endif +#if (defined USE_HDF5) + subroutine close_navgem_file(filename, file_id, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + implicit none + character(len=*), intent(in) :: filename + integer(HID_T), intent(inout) :: file_id + logical, intent(out) :: fail + integer :: hdferr + fail = .false. + call h5fclose_f(file_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot close file ', trim(filename) + fail = .true. + else + write(LVT_logunit,*) & + '[INFO] Closed NAVGEM file ',trim(filename) + end if + file_id = -1 + end subroutine close_navgem_file +#endif + +#if (defined USE_HDF5) + subroutine open_navgem_file(filename, file_id, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + implicit none + character(len=*), intent(in) :: filename + integer(HID_T), intent(out) :: file_id + logical, intent(out) :: fail + integer :: hdferr + fail = .false. + call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)& + '[ERR] Cannot open file ', trim(filename) + fail = .true. + else + write(LVT_logunit,*) & + '[INFO] Opened NAVGEM file ', trim(filename) + end if + end subroutine open_navgem_file +#endif + #if (defined USE_HDF5) subroutine close_hdf5_f_interface(fail) use HDF5 From e3037489dfdb49839ea3ed5e73fac9c608b62afe Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Thu, 1 Apr 2021 17:55:18 -0400 Subject: [PATCH 40/64] Added additional HDF5 wrapper routines. --- lvt/core/LVT_navgemMod.F90 | 121 ++++++++++++++++++++++++++++++++++++- 1 file changed, 118 insertions(+), 3 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index d5a67984a..4b1d0a608 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -15,8 +15,10 @@ ! LVT grid. Intended to run as part of 557post mode for Air Force operations. ! ! REVISION HISTORY: -! 01 Apr 2021: Eric Kemp (SSAI), Initial implementation. Read codes borrow -! heavily from sample Python code provided by FNMOC. +! 01 Apr 2021: Eric Kemp (SSAI), Initial implementation. Basic logic for +! pulling fields and calculating latitudes and longitudes is +! based on sample Python code provided by FNMOC. HDF5 logic +! borrows from IMERG reader in LIS. !------------------------------------------------------------------------------ module LVT_navgemMod @@ -126,6 +128,7 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) #if (defined USE_HDF5) integer(HID_T) :: file_id, dataset_id, datatype_id #endif + integer :: jm ! Get NAVGEM filename call get_navgem_filename(filename, year, month, day, hour, fcst_hr) @@ -144,8 +147,19 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) call open_navgem_file(filename, file_id, fail) if (fail) goto 100 + ! Get the gt ("ground temperature") field + call open_navgem_dataset(file_id, "/Grid/gt", dataset_id, fail) + if (fail) goto 100 + call get_navgem_datatype(dataset_id, datatype_id, fail) + if (fail) goto 100 + call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) + if (fail) goto 100 + + !... ! Cleanup before returning 100 continue + if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) + if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) if (file_id .gt. -1) call close_navgem_file(filename, file_id, fail) call close_hdf5_f_interface(fail) @@ -157,7 +171,7 @@ subroutine open_hdf5_f_interface(fail) use HDF5 use LVT_logMod, only: LVT_logunit implicit none - logical,intent(out) :: fail + logical, intent(out) :: fail integer :: hdferr fail = .false. call h5open_f(hdferr) @@ -170,6 +184,107 @@ subroutine open_hdf5_f_interface(fail) end subroutine open_hdf5_f_interface #endif +#if (defined USE_HDF5) + subroutine open_navgem_dataset(file_id, dataset_name, dataset_id, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + implicit none + integer(HID_T), intent(in) :: file_id + character(len=*), intent(in) :: dataset_name + integer(HID_T), intent(out) :: dataset_id + integer :: hdferr + logical, intent(out) :: fail + fail = .false. + call h5dopen_f(file_id, trim(dataset_name), dataset_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)& + '[ERR] Cannot open dataset ', trim(dataset_name) + fail = .true. + end if + end subroutine open_navgem_dataset +#endif + +#if (defined USE_HDF5) + subroutine get_navgem_datatype(dataset_id, datatype_id, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + implicit none + integer(HID_T), intent(in) :: dataset_id + integer(HID_T), intent(out) :: datatype_id + logical, intent(out) :: fail + integer :: hdferr + fail = .false. + call h5dget_type_f(dataset_id, datatype_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)& + '[ERR] Cannot determine datatype' + fail = .true. + end if + end subroutine get_navgem_datatype +#endif + +#if (defined USE_HDF5) + subroutine check_navgem_type(datatype_id, datatype, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + integer(HID_T), intent(in) :: datatype_id + integer(HID_T), intent(in) :: datatype + logical, intent(out) :: fail + logical :: flag + integer :: hdferr + fail = .false. + call h5tequal_f(datatype_id, datatype, flag, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot confirm datatype!' + fail = .true. + return + end if + if (.not. flag) then + write(LVT_logunit,*)& + '[ERR] Datatype is wrong type!' + fail = .true. + return + end if + end subroutine check_navgem_type +#endif + +#if (defined USE_HDF5) + subroutine close_navgem_datatype(datatype_id, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + integer(HID_T), intent(inout) :: datatype_id + logical, intent(out) :: fail + integer :: hdferr + fail = .false. + call h5tclose_f(datatype_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot close datatype ' + fail = .true. + end if + datatype_id = -1 + end subroutine close_navgem_datatype +#endif + +#if (defined USE_HDF5) + subroutine close_navgem_dataset(dataset_id, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + integer(HID_T), intent(inout) :: dataset_id + logical, intent(out) :: fail + integer :: hdferr + fail = .false. + call h5dclose_f(dataset_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot close dataset ' + fail = .true. + end if + dataset_id = -1 + end subroutine close_navgem_dataset +#endif + #if (defined USE_HDF5) subroutine close_navgem_file(filename, file_id, fail) use HDF5 From 607d9a0015782423f65034f3e532f49bc5709009 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 2 Apr 2021 09:17:24 -0400 Subject: [PATCH 41/64] Expanded code to pull /Grid/gt and /Grid/conice from NAVGEM file. --- lvt/core/LVT_navgemMod.F90 | 382 ++++++++++++++++++++++++++++++++++--- 1 file changed, 354 insertions(+), 28 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 4b1d0a608..c980cee09 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -110,6 +110,7 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) #if (defined USE_HDF5) use HDF5 #endif + use LVT_logMod, only: LVT_logunit ! Defaults implicit none @@ -127,7 +128,11 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) integer :: hdferr #if (defined USE_HDF5) integer(HID_T) :: file_id, dataset_id, datatype_id + integer(HSIZE_T), allocatable :: dims(:) + real, allocatable :: tmp_gt(:,:) + real, allocatable :: tmp_conice(:,:) #endif + integer :: rank integer :: jm ! Get NAVGEM filename @@ -154,10 +159,83 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) if (fail) goto 100 call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) if (fail) goto 100 + call check_navgem_units(dataset_id, "K", fail) + if (fail) goto 100 + call get_navgem_dims(dataset_id, rank, dims, fail) + if (fail) goto 100 + if (rank .ne. 2) then + write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/gt has wrong rank!' + write(LVT_logunit,*)'Expected 2, found ', rank + goto 100 + end if + if (dims(2) .ne. 1) then + write(LVT_logunit,*) & + '[ERR] Unexpected first dimension for HDF5 dataset /Grid/gt!' + write(LVT_logunit,*) 'Expected 1, found ', dims(2) + goto 100 + end if + allocate(tmp_gt(dims(1), dims(2))) + tmp_gt = 0 + call h5dread_f(dataset_id, H5T_IEEE_F32LE, tmp_gt, dims, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/gt!' + goto 100 + end if + + ! Close the /Grid/gt types + if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) + if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) + + ! Save the data into the sst array. + allocate(sst(dims(2))) + sst = tmp_gt(:,1) + deallocate(tmp_gt) + deallocate(dims) + + ! Get the conice (sea ice area fraction) field + call open_navgem_dataset(file_id, "/Grid/conice", dataset_id, fail) + if (fail) goto 100 + call get_navgem_datatype(dataset_id, datatype_id, fail) + if (fail) goto 100 + call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) + if (fail) goto 100 + call get_navgem_dims(dataset_id, rank, dims, fail) + if (fail) goto 100 + if (rank .ne. 2) then + write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/conice has wrong rank!' + write(LVT_logunit,*)'Expected 2, found ', rank + goto 100 + end if + if (dims(2) .ne. 1) then + write(LVT_logunit,*) & + '[ERR] Unexpected first dimension for HDF5 dataset /Grid/conice!' + write(LVT_logunit,*) 'Expected 1, found ', dims(2) + goto 100 + end if + allocate(tmp_conice(dims(1), dims(2))) + tmp_conice = 0 + call h5dread_f(dataset_id, H5T_IEEE_F32LE, tmp_conice, dims, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/conice!' + goto 100 + end if + + ! Close the /Grid/conice types + if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) + if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) + ! Save the data into the cice array. + allocate(cice(dims(2))) + cice = tmp_conice(:,1) + deallocate(tmp_conice) + deallocate(dims) + + !... ! Cleanup before returning 100 continue + if (allocated(tmp_gt)) deallocate(tmp_gt) + if (allocated(tmp_conice)) deallocate(tmp_conice) if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) if (file_id .gt. -1) call close_navgem_file(filename, file_id, fail) @@ -184,6 +262,28 @@ subroutine open_hdf5_f_interface(fail) end subroutine open_hdf5_f_interface #endif +#if (defined USE_HDF5) + subroutine open_navgem_file(filename, file_id, fail) + use HDF5 + use LVT_logMod, only: LVT_logunit + implicit none + character(len=*), intent(in) :: filename + integer(HID_T), intent(out) :: file_id + logical, intent(out) :: fail + integer :: hdferr + fail = .false. + call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)& + '[ERR] Cannot open NAVGEM file ', trim(filename) + fail = .true. + else + write(LVT_logunit,*) & + '[INFO] Opened NAVGEM file ', trim(filename) + end if + end subroutine open_navgem_file +#endif + #if (defined USE_HDF5) subroutine open_navgem_dataset(file_id, dataset_name, dataset_id, fail) use HDF5 @@ -198,7 +298,7 @@ subroutine open_navgem_dataset(file_id, dataset_name, dataset_id, fail) call h5dopen_f(file_id, trim(dataset_name), dataset_id, hdferr) if (hdferr .ne. 0) then write(LVT_logunit,*)& - '[ERR] Cannot open dataset ', trim(dataset_name) + '[ERR] Cannot open HDF5 dataset ', trim(dataset_name) fail = .true. end if end subroutine open_navgem_dataset @@ -217,7 +317,7 @@ subroutine get_navgem_datatype(dataset_id, datatype_id, fail) call h5dget_type_f(dataset_id, datatype_id, hdferr) if (hdferr .ne. 0) then write(LVT_logunit,*)& - '[ERR] Cannot determine datatype' + '[ERR] Cannot determine HDF5 datatype' fail = .true. end if end subroutine get_navgem_datatype @@ -236,19 +336,266 @@ subroutine check_navgem_type(datatype_id, datatype, fail) call h5tequal_f(datatype_id, datatype, flag, hdferr) if (hdferr .ne. 0) then write(LVT_logunit,*) & - '[ERR] Cannot confirm datatype!' + '[ERR] Cannot confirm HDF5 datatype!' fail = .true. return end if if (.not. flag) then write(LVT_logunit,*)& - '[ERR] Datatype is wrong type!' + '[ERR] HDF5 datatype is wrong type!' fail = .true. return end if end subroutine check_navgem_type #endif +#if (defined USE_HDF5) + subroutine check_navgem_units(dataset_id, units, fail) + + ! Modules + use HDF5 + use ISO_C_BINDING + use LVT_logMod, only: LVT_logunit + + ! Defaults + implicit none + + ! Arguments + integer(HID_T), intent(in) :: dataset_id + character(len=*), intent(in) :: units + logical, intent(out) :: fail + + ! Local variables + integer(HID_T) :: attr_id, type_id, space_id, memtype_id + integer :: hdferr + integer(size_t) :: size + integer(SIZE_T), parameter :: sdim = 5 + integer(HSIZE_T), dimension(1:1) :: dims = (/1/) + integer(HSIZE_T), dimension(1:1) :: maxdims + character(len=sdim), dimension(:), allocatable, target :: rdata + type(C_PTR) :: f_ptr + integer :: i + + fail = .false. + + ! Open the attribute + call h5aopen_f(dataset_id, 'units', attr_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot open HDF5 attribute' + fail = .true. + return + end if + + ! Get the attribute datatype + call h5aget_type_f(attr_id, type_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot get HDF5 attribute datatype' + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + + ! Get the size of the attribute datatype, and sanity check. + call h5tget_size_f(type_id, size, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot get HDF5 attribute ', & + 'datatype size' + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + if (size .gt. sdim+1) then + write(LVT_logunit,*) & + '[ERR] Expected smaller HDF5 attribute',& + 'datatype size' + write(LVT_logunit,*)'Expected ',sdim+1 + write(LVT_logunit,*)'Found ',size + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + + ! Get the attribute dataspace + call h5aget_space_f(attr_id, space_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot get HDF5 attribute', & + 'dataspace' + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + + ! Get the dimensions of the dataspace + call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot get HDF5 attribute ', & + 'dataspace dimensions' + call h5sclose_f(space_id, hdferr) + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + + ! Create the memory datatype + call h5tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot copy HDF5 attribute ', & + 'memory datatype.' + call h5sclose_f(space_id, hdferr) + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + call h5tset_size_f(memtype_id, sdim, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot set HDF5 attribute ', & + 'memory datatype size.' + call h5tclose_f(memtype_id, hdferr) + call h5sclose_f(space_id, hdferr) + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + + ! Read the attribute + allocate(rdata(1:dims(1))) + f_ptr = C_LOC(rdata(1)(1:1)) + call h5aread_f(attr_id, memtype_id, f_ptr, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot read HDF5 attribute.' + deallocate(rdata) + call h5tclose_f(memtype_id, hdferr) + call h5sclose_f(space_id, hdferr) + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + + ! Check the units + if (trim(rdata(1)) .ne. trim(units)) then + write(LVT_logunit,*) & + '[ERR] Found wrong HDF5 data', & + 'units' + write(LVT_logunit,*) 'Expected ', trim(units) + write(LVT_logunit,*) 'Found ',trim(rdata(1)) + deallocate(rdata) + call h5tclose_f(memtype_id, hdferr) + call h5sclose_f(space_id, hdferr) + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + fail = .true. + return + end if + + ! Clean up + deallocate(rdata) + call h5tclose_f(memtype_id, hdferr) + call h5sclose_f(space_id, hdferr) + call h5tclose_f(type_id, hdferr) + call h5aclose_f(attr_id, hdferr) + + end subroutine check_navgem_units +#endif + +#if (defined USE_HDF5) + subroutine get_navgem_dims(dataset_id, rank, dims, fail) + + ! Modules + use HDF5 + use LVT_logMod, only: LVT_logunit + + ! Defaults + implicit none + + ! Arguments + integer(HID_T), intent(in) :: dataset_id + integer, intent(out) :: rank + integer(HSIZE_T), allocatable, intent(out) :: dims(:) + logical, intent(out) :: fail + + ! Local variables + integer(HID_T) :: dataspace_id + integer(HSIZE_T), allocatable :: dataspace_maxdims(:) + integer :: hdferr + logical :: flag + integer :: i + + ! First, get the dataspace for the dataset + call h5dget_space_f(dataset_id, dataspace_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)& + '[ERR] Could not get HDF5 dataspace' + fail = .true. + return + end if + + ! Sanity check: Make sure this dataspace is "simple" + call h5sis_simple_f(dataspace_id, flag, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot determine if ', & + 'HDF5 dataspace is simple' + fail = .true. + return + end if + if (.not. flag) then + write(LVT_logunit,*) & + '[ERR] HDF5 dataspace is not simple' + fail = .true. + return + end if + + ! Get the rank (number of dimensions) + call h5sget_simple_extent_ndims_f(dataspace_id, rank, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)& + '[ERR] Cannot get rank of HDF5 dataspace ' + fail = .true. + return + end if + + ! Get the dimensions + allocate(dims(rank)) + allocate(dataspace_maxdims(rank)) + call h5sget_simple_extent_dims_f(dataspace_id, dims, & + dataspace_maxdims, hdferr) + if (hdferr .ne. rank) then + write(LVT_logunit,*) & + '[ERR] Cannot get dims for HDF5 dataspace' + deallocate(dims) + deallocate(dataspace_maxdims) + fail = .true. + return + end if + + ! Clean up + deallocate(dataspace_maxdims) + call h5sclose_f(dataspace_id, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot close HDF5 dataspace' + fail = .true. + return + end if + + end subroutine get_navgem_dims +#endif + #if (defined USE_HDF5) subroutine close_navgem_datatype(datatype_id, fail) use HDF5 @@ -260,7 +607,7 @@ subroutine close_navgem_datatype(datatype_id, fail) call h5tclose_f(datatype_id, hdferr) if (hdferr .ne. 0) then write(LVT_logunit,*) & - '[ERR] Cannot close datatype ' + '[ERR] Cannot close HDF5 datatype ' fail = .true. end if datatype_id = -1 @@ -278,7 +625,7 @@ subroutine close_navgem_dataset(dataset_id, fail) call h5dclose_f(dataset_id, hdferr) if (hdferr .ne. 0) then write(LVT_logunit,*) & - '[ERR] Cannot close dataset ' + '[ERR] Cannot close HDF5 dataset ' fail = .true. end if dataset_id = -1 @@ -298,7 +645,7 @@ subroutine close_navgem_file(filename, file_id, fail) call h5fclose_f(file_id, hdferr) if (hdferr .ne. 0) then write(LVT_logunit,*) & - '[ERR] Cannot close file ', trim(filename) + '[ERR] Cannot close NAVGEM file ', trim(filename) fail = .true. else write(LVT_logunit,*) & @@ -308,27 +655,6 @@ subroutine close_navgem_file(filename, file_id, fail) end subroutine close_navgem_file #endif -#if (defined USE_HDF5) - subroutine open_navgem_file(filename, file_id, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - implicit none - character(len=*), intent(in) :: filename - integer(HID_T), intent(out) :: file_id - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)& - '[ERR] Cannot open file ', trim(filename) - fail = .true. - else - write(LVT_logunit,*) & - '[INFO] Opened NAVGEM file ', trim(filename) - end if - end subroutine open_navgem_file -#endif #if (defined USE_HDF5) subroutine close_hdf5_f_interface(fail) From 399e750ac2756668340a9d70081681cd3b1ad0a0 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 2 Apr 2021 10:05:49 -0400 Subject: [PATCH 42/64] Added code to pull /Geometry/Latitudes and /Geometry/Points_per_lat. --- lvt/core/LVT_navgemMod.F90 | 107 +++++++++++++++++++++++++++++++++++-- 1 file changed, 104 insertions(+), 3 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index c980cee09..893fd295e 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -129,11 +129,13 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) #if (defined USE_HDF5) integer(HID_T) :: file_id, dataset_id, datatype_id integer(HSIZE_T), allocatable :: dims(:) +#endif real, allocatable :: tmp_gt(:,:) real, allocatable :: tmp_conice(:,:) -#endif + real, allocatable :: tmp_latitudes(:,:) + integer, allocatable :: tmp_points_per_lat(:,:) integer :: rank - integer :: jm + integer :: jm, im, itmp, t_number ! Get NAVGEM filename call get_navgem_filename(filename, year, month, day, hour, fcst_hr) @@ -230,12 +232,103 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) deallocate(tmp_conice) deallocate(dims) - + ! Get the Gaussian latitudes + call open_navgem_dataset(file_id, "/Geometry/Latitudes", dataset_id, fail) + if (fail) goto 100 + call get_navgem_datatype(dataset_id, datatype_id, fail) + if (fail) goto 100 + call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) + if (fail) goto 100 + call get_navgem_dims(dataset_id, rank, dims, fail) + if (fail) goto 100 + if (rank .ne. 2) then + write(LVT_logunit,*) & + '[ERR] HDF5 dataset /Geometry/Latitudes has wrong rank!' + write(LVT_logunit,*)'Expected 2, found ', rank + goto 100 + end if + if (dims(2) .ne. 1) then + write(LVT_logunit,*) & + '[ERR] Unexpected first dimension for HDF5 dataset ', & + '/Geometry/Latitudes!' + write(LVT_logunit,*) 'Expected 1, found ', dims(2) + goto 100 + end if + allocate(tmp_latitudes(dims(1), dims(2))) + tmp_latitudes = 0 + call h5dread_f(dataset_id, H5T_IEEE_F32LE, tmp_latitudes, dims, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot read HDF5 dataset /Geometry/Latitudes!' + goto 100 + end if + jm = dims(1) + + ! Close the /Grid/Latitudes types + if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) + if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) + deallocate(dims) + + ! Get the points per latitudes + call open_navgem_dataset(file_id, "/Geometry/Points_per_lat", dataset_id, & + fail) + if (fail) goto 100 + call get_navgem_datatype(dataset_id, datatype_id, fail) + if (fail) goto 100 + call check_navgem_type(datatype_id, H5T_STD_I32LE, fail) + if (fail) goto 100 + call get_navgem_dims(dataset_id, rank, dims, fail) + if (fail) goto 100 + if (rank .ne. 2) then + write(LVT_logunit,*) & + '[ERR] HDF5 dataset /Geometry/Points_per_lat has wrong rank!' + write(LVT_logunit,*)'Expected 2, found ', rank + goto 100 + end if + if (dims(2) .ne. 1) then + write(LVT_logunit,*) & + '[ERR] Unexpected first dimension for HDF5 dataset ', & + '/Geometry/Points_per_lat!' + write(LVT_logunit,*) 'Expected 1, found ', dims(2) + goto 100 + end if + allocate(tmp_points_per_lat(dims(1), dims(2))) + tmp_latitudes = 0 + call h5dread_f(dataset_id, H5T_STD_I32LE, tmp_points_per_lat, dims, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*) & + '[ERR] Cannot read HDF5 dataset /Geometry/Points_per_lat!' + goto 100 + end if + + ! Close the /Geometry/Points_per_lat types + if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) + if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) + + ! Calculate dimension im + itmp = floor(dims(1) / 2.) + 1 + im = tmp_points_per_lat(itmp,1) + deallocate(dims) + + ! Calculate t_number + call get_navgem_truncation(im, t_number) + if (t_number .ne. 681) then + write(LVT_logunit,*)'[ERR] Unexpected T-number for NAVGEM!' + write(LVT_logunit,*)'Expected T681, found T', t_number + goto 100 + end if + + ! Clean up temporary arrays + deallocate(tmp_latitudes) + deallocate(tmp_points_per_lat) + !... ! Cleanup before returning 100 continue if (allocated(tmp_gt)) deallocate(tmp_gt) if (allocated(tmp_conice)) deallocate(tmp_conice) + if (allocated(tmp_latitudes)) deallocate(tmp_latitudes) + if (allocated(tmp_points_per_lat)) deallocate(tmp_points_per_lat) if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) if (file_id .gt. -1) call close_navgem_file(filename, file_id, fail) @@ -672,4 +765,12 @@ subroutine close_hdf5_f_interface(fail) end if end subroutine close_hdf5_f_interface #endif + + subroutine get_navgem_truncation(im, t_number) + implicit none + integer, intent(in) :: im + integer, intent(out) :: t_number + t_number = int( 2 * int( int ( int( int(im-1)/3) + 1) / 2 ) ) + t_number = t_number - 1 + end subroutine get_navgem_truncation end module LVT_navgemMod From 5b9d06e02ba11753a82df6e2017a3fceb400aeb9 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 2 Apr 2021 11:20:27 -0400 Subject: [PATCH 43/64] Added code to calculate lat/lon of each NAVGEM point. --- lvt/core/LVT_navgemMod.F90 | 74 +++++++++++++++++++++++++++++++++++--- 1 file changed, 70 insertions(+), 4 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 893fd295e..d055edd37 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -135,7 +135,15 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) real, allocatable :: tmp_latitudes(:,:) integer, allocatable :: tmp_points_per_lat(:,:) integer :: rank - integer :: jm, im, itmp, t_number + integer :: im, itmp, t_number + + ! Handle case where LVT was not compiled with HDF5 support +#if (!defined USE_HDF5) + write(LVT_logunit,*)'[ERR] Cannot read NAVGEM HDF5 file!' + write(LVT_logunit,*) & + '[ERR] Reconfigure with HDF5, recompile, and try again!' + stop +#endif ! Get NAVGEM filename call get_navgem_filename(filename, year, month, day, hour, fcst_hr) @@ -262,9 +270,8 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) '[ERR] Cannot read HDF5 dataset /Geometry/Latitudes!' goto 100 end if - jm = dims(1) - ! Close the /Grid/Latitudes types + ! Close the /Geometry/Latitudes types if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) deallocate(dims) @@ -318,13 +325,19 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) goto 100 end if + ! Now we need to calculate the lat and lon of each sst and cice point. + call calc_navgem_latlons(tmp_latitudes, tmp_points_per_lat, size(sst), & + lat, lon) + ! Clean up temporary arrays deallocate(tmp_latitudes) deallocate(tmp_points_per_lat) - !... + write(LVT_logunit,*)'[INFO] Read data from NAVGEM file' + ! Cleanup before returning 100 continue + if (allocated(dims)) deallocate(dims) if (allocated(tmp_gt)) deallocate(tmp_gt) if (allocated(tmp_conice)) deallocate(tmp_conice) if (allocated(tmp_latitudes)) deallocate(tmp_latitudes) @@ -773,4 +786,57 @@ subroutine get_navgem_truncation(im, t_number) t_number = int( 2 * int( int ( int( int(im-1)/3) + 1) / 2 ) ) t_number = t_number - 1 end subroutine get_navgem_truncation + + ! Calculate the latitude and longitude of each data point on the reduced + ! Gaussian grid. This logic borrows heavily from Python code provided by + ! FNMOC. + subroutine calc_navgem_latlons(tmp_latitudes, tmp_points_per_lat, dim, & + lats, lons) + + ! Defaults + implicit none + + ! Arguments + real, intent(in) :: tmp_latitudes(:,:) ! The latitude of each parallel + integer, intent(in) :: tmp_points_per_lat(:,:) ! Points per parallel + integer, intent(in) :: dim ! Total number of points + real, allocatable, intent(out) :: lats(:) + real, allocatable, intent(out) :: lons(:) + + ! Locals + integer :: num_lons + real :: d_lon + integer :: r, c, i, jm + + jm = size(tmp_latitudes, 1) ! Number of parallels + + ! First calculate the latitudes at each point + allocate(lats(dim)) + lats = 0 + i = 0 + do r = 1, jm + num_lons = tmp_points_per_lat(r,1) + do c = 1, num_lons + i = i + 1 + lats(i) = tmp_latitudes(r,1) + end do ! c + end do ! r + + ! Next, calculate the longitudes at each point + allocate(lons(dim)) + lons = 0 + i = 0 + do r = 1, jm + num_lons = tmp_points_per_lat(r,1) + d_lon = 360. / num_lons + do c = 1, num_lons + i = i + 1 + lons(i) = 0.0 + (c-1)*d_lon + if (lons(i) .gt. 180.) then + lons(i) = lons(i) - 360. + end if + end do ! c + end do ! r + end subroutine calc_navgem_latlons + end module LVT_navgemMod From 3c3ebf9e67833032a07f24ad6dc23b12d44841a3 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 2 Apr 2021 13:11:30 -0400 Subject: [PATCH 44/64] Added upscaleByAveraging_input variant for NAVGEM. Normal upscaleByAveraging_input calculates latitudes and longitudes internally, and will not work with NAVGEM due to a lack of support for thinned (quasi-regular) Gaussian grids. This variant just takes the latitudes and longitudes as arguments. --- lvt/core/LVT_navgemMod.F90 | 50 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index d055edd37..5d1cbe69a 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -28,6 +28,7 @@ module LVT_navgemMod private ! Public routines + public :: LVT_upscaleByAveraging_input_navgem contains @@ -839,4 +840,53 @@ subroutine calc_navgem_latlons(tmp_latitudes, tmp_points_per_lat, dim, & end do ! r end subroutine calc_navgem_latlons + ! Special version of upscaleByAveraging_input. This variant skips the + ! internal calculation of latitudes and longitudes by compute_earth_coord, + ! since that subroutine doesn't support thinned (quasi-regular) Gaussian + ! grids. Instead, the latitudes and longitudes are passed in as additional + ! arguments. + subroutine LVT_upscaleByAveraging_input_navgem(gridDesco, mi, rlat, rlon, & + mo, n11) + + ! Defaults + implicit none + + ! Arguments + real, intent(in) :: gridDesco(50) + integer, intent(in) :: mi + real, intent(in) :: rlat(mi) + real, intent(in) :: rlon(mi) + integer, intent(in) :: mo + integer, intent(out) :: n11(mi) + + ! Locals + integer :: n + integer :: i, j + real :: xi, yi + real :: xpts(mi), ypts(mi) + real :: xpts1(mo), ypts1(mo) + real :: rlat1(mo), rlon1(mo) + integer :: nv + real, parameter :: fill = -9999.0 + + ! External functions + integer, external :: get_fieldpos + + ! Find the x,y coordinates of the input points on the output grid + call compute_grid_coord(gridDesco, mi,fill, xpts, ypts, rlon, rlat, nv) + + ! Determine which grid box in the outer grid each inner point resides in. + do n = 1, mi + xi = xpts(n) + yi = ypts(n) + if (xi.ne.fill .and. yi.ne.fill) then + i = nint(xi) + j = nint(yi) + n11(n) = get_fieldpos(i, j, gridDesco) + else + n11(n) = 0 + endif + end do ! n + end subroutine LVT_upscaleByAveraging_input_navgem + end module LVT_navgemMod From 6e97ac3e308f674c247cb94f817e0b70f578dce6 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Fri, 2 Apr 2021 17:27:06 -0400 Subject: [PATCH 45/64] Added code to interpolate to regular Gaussian grid. Still TODO: * Add code for bilinear interpolation * Test! --- lvt/core/LVT_navgemMod.F90 | 295 +++++++++++++++++++++++++------------ 1 file changed, 203 insertions(+), 92 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 5d1cbe69a..9707356f7 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -105,7 +105,7 @@ subroutine get_navgem_filename(filename, & end subroutine get_navgem_filename - subroutine fetch_navgem_fields(sst, cice, lat, lon) + subroutine fetch_navgem_fields(sst, cice, gridDesc) ! Modules #if (defined USE_HDF5) @@ -119,8 +119,7 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) ! Arguments real, allocatable, intent(out) :: sst(:) real, allocatable, intent(out) :: cice(:) - real, allocatable, intent(out) :: lat(:) - real, allocatable, intent(out) :: lon(:) + real, intent(out) :: gridDesc(50) ! Locals character(len=250) :: filename @@ -131,12 +130,15 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) integer(HID_T) :: file_id, dataset_id, datatype_id integer(HSIZE_T), allocatable :: dims(:) #endif - real, allocatable :: tmp_gt(:,:) - real, allocatable :: tmp_conice(:,:) - real, allocatable :: tmp_latitudes(:,:) - integer, allocatable :: tmp_points_per_lat(:,:) + real, allocatable :: thin_gt(:,:) + real, allocatable :: thin_conice(:,:) + real, allocatable :: thin_latitudes(:,:) + integer, allocatable :: thin_points_per_lat(:,:) + real, allocatable :: regular_longitude_slice(:) integer :: rank - integer :: im, itmp, t_number + integer :: im, jm, itmp, t_number + real :: dlon + integer :: c, r ! Handle case where LVT was not compiled with HDF5 support #if (!defined USE_HDF5) @@ -163,186 +165,221 @@ subroutine fetch_navgem_fields(sst, cice, lat, lon) call open_navgem_file(filename, file_id, fail) if (fail) goto 100 - ! Get the gt ("ground temperature") field - call open_navgem_dataset(file_id, "/Grid/gt", dataset_id, fail) + ! Get the Gaussian latitudes + call open_navgem_dataset(file_id, "/Geometry/Latitudes", dataset_id, fail) if (fail) goto 100 call get_navgem_datatype(dataset_id, datatype_id, fail) if (fail) goto 100 call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) if (fail) goto 100 - call check_navgem_units(dataset_id, "K", fail) - if (fail) goto 100 call get_navgem_dims(dataset_id, rank, dims, fail) if (fail) goto 100 if (rank .ne. 2) then - write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/gt has wrong rank!' + write(LVT_logunit,*) & + '[ERR] HDF5 dataset /Geometry/Latitudes has wrong rank!' write(LVT_logunit,*)'Expected 2, found ', rank goto 100 end if if (dims(2) .ne. 1) then write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset /Grid/gt!' + '[ERR] Unexpected first dimension for HDF5 dataset ', & + '/Geometry/Latitudes!' write(LVT_logunit,*) 'Expected 1, found ', dims(2) goto 100 end if - allocate(tmp_gt(dims(1), dims(2))) - tmp_gt = 0 - call h5dread_f(dataset_id, H5T_IEEE_F32LE, tmp_gt, dims, hdferr) + allocate(thin_latitudes(dims(1), dims(2))) + thin_latitudes = 0 + call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_latitudes, dims, hdferr) if (hdferr .ne. 0) then - write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/gt!' + write(LVT_logunit,*) & + '[ERR] Cannot read HDF5 dataset /Geometry/Latitudes!' goto 100 end if - ! Close the /Grid/gt types + ! Save dimension jm + jm = dims(1) + + ! Close the /Geometry/Latitudes types if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - - ! Save the data into the sst array. - allocate(sst(dims(2))) - sst = tmp_gt(:,1) - deallocate(tmp_gt) deallocate(dims) - ! Get the conice (sea ice area fraction) field - call open_navgem_dataset(file_id, "/Grid/conice", dataset_id, fail) + ! Get the points per latitudes + call open_navgem_dataset(file_id, "/Geometry/Points_per_lat", dataset_id, & + fail) if (fail) goto 100 call get_navgem_datatype(dataset_id, datatype_id, fail) if (fail) goto 100 - call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) + call check_navgem_type(datatype_id, H5T_STD_I32LE, fail) if (fail) goto 100 call get_navgem_dims(dataset_id, rank, dims, fail) if (fail) goto 100 if (rank .ne. 2) then - write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/conice has wrong rank!' + write(LVT_logunit,*) & + '[ERR] HDF5 dataset /Geometry/Points_per_lat has wrong rank!' write(LVT_logunit,*)'Expected 2, found ', rank goto 100 end if if (dims(2) .ne. 1) then write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset /Grid/conice!' + '[ERR] Unexpected first dimension for HDF5 dataset ', & + '/Geometry/Points_per_lat!' write(LVT_logunit,*) 'Expected 1, found ', dims(2) goto 100 end if - allocate(tmp_conice(dims(1), dims(2))) - tmp_conice = 0 - call h5dread_f(dataset_id, H5T_IEEE_F32LE, tmp_conice, dims, hdferr) + allocate(thin_points_per_lat(dims(1), dims(2))) + thin_points_per_lat = 0 + call h5dread_f(dataset_id, H5T_STD_I32LE, thin_points_per_lat, dims, & + hdferr) if (hdferr .ne. 0) then - write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/conice!' + write(LVT_logunit,*) & + '[ERR] Cannot read HDF5 dataset /Geometry/Points_per_lat!' goto 100 end if - ! Close the /Grid/conice types + ! Close the /Geometry/Points_per_lat types if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - ! Save the data into the cice array. - allocate(cice(dims(2))) - cice = tmp_conice(:,1) - deallocate(tmp_conice) + ! Calculate dimension im + itmp = floor(dims(1) / 2.) + 1 + im = thin_points_per_lat(itmp,1) deallocate(dims) - ! Get the Gaussian latitudes - call open_navgem_dataset(file_id, "/Geometry/Latitudes", dataset_id, fail) + ! Calculate and check t_number + call get_navgem_truncation(im, t_number) + if (t_number .ne. 681) then + write(LVT_logunit,*)'[ERR] Unexpected T-number for NAVGEM!' + write(LVT_logunit,*)'Expected T681, found T', t_number + goto 100 + end if + + ! Calculate full number of longitudes across a parallel + allocate(regular_longitude_slice(im)) + regular_longitude_slice = 0 + dlon = 360. / im + do c = 1, im + regular_longitude_slice(c) = 0. + (c-1)*dlon + end do + + ! Fill gridDesc array for NAVGEM regular grid. See LIS_PRIV_rcMod.F90 + ! for description of this array. + gridDesc = 0 + gridDesc(1) = 4 ! Regular Gaussian grid + gridDesc(2) = im + gridDesc(3) = jm + gridDesc(4) = thin_latitudes(1,1) + gridDesc(5) = regular_longitude_slice(1) + gridDesc(6) = 8 + gridDesc(7) = thin_latitudes(jm,1) + gridDesc(8) = regular_longitude_slice(im) + gridDesc(9) = dlon + gridDesc(10) = jm ! CHECK + gridDesc(11) = 64 ! CHECK + gridDesc(20) = 255 + gridDesc(41) = 4 ! Regular Gaussian grid + gridDesc(42) = im + gridDesc(43) = jm + gridDesc(44) = thin_latitudes(1,1) + gridDesc(45) = regular_longitude_slice(1) + gridDesc(46) = 128 + gridDesc(47) = thin_latitudes(jm,1) + gridDesc(48) = regular_longitude_slice(im) + gridDesc(49) = dlon + gridDesc(50) = jm ! CHECK + + deallocate(thin_latitudes) + + ! Get the gt ("ground temperature") field + call open_navgem_dataset(file_id, "/Grid/gt", dataset_id, fail) if (fail) goto 100 call get_navgem_datatype(dataset_id, datatype_id, fail) if (fail) goto 100 call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) if (fail) goto 100 + call check_navgem_units(dataset_id, "K", fail) + if (fail) goto 100 call get_navgem_dims(dataset_id, rank, dims, fail) if (fail) goto 100 if (rank .ne. 2) then - write(LVT_logunit,*) & - '[ERR] HDF5 dataset /Geometry/Latitudes has wrong rank!' + write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/gt has wrong rank!' write(LVT_logunit,*)'Expected 2, found ', rank goto 100 end if if (dims(2) .ne. 1) then write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset ', & - '/Geometry/Latitudes!' + '[ERR] Unexpected first dimension for HDF5 dataset /Grid/gt!' write(LVT_logunit,*) 'Expected 1, found ', dims(2) goto 100 end if - allocate(tmp_latitudes(dims(1), dims(2))) - tmp_latitudes = 0 - call h5dread_f(dataset_id, H5T_IEEE_F32LE, tmp_latitudes, dims, hdferr) + allocate(thin_gt(dims(1), dims(2))) + thin_gt = 0 + call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_gt, dims, hdferr) if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot read HDF5 dataset /Geometry/Latitudes!' + write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/gt!' goto 100 end if - ! Close the /Geometry/Latitudes types + ! Close the /Grid/gt types if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) deallocate(dims) - ! Get the points per latitudes - call open_navgem_dataset(file_id, "/Geometry/Points_per_lat", dataset_id, & - fail) + ! Save the data on the regular grid into the sst array. + call interp_thinned_to_regular(im, jm, thin_points_per_lat, & + regular_longitude_slice, thin_gt, sst) + + ! Get the conice (sea ice area fraction) field + call open_navgem_dataset(file_id, "/Grid/conice", dataset_id, fail) if (fail) goto 100 call get_navgem_datatype(dataset_id, datatype_id, fail) if (fail) goto 100 - call check_navgem_type(datatype_id, H5T_STD_I32LE, fail) + call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) if (fail) goto 100 call get_navgem_dims(dataset_id, rank, dims, fail) if (fail) goto 100 if (rank .ne. 2) then - write(LVT_logunit,*) & - '[ERR] HDF5 dataset /Geometry/Points_per_lat has wrong rank!' + write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/conice has wrong rank!' write(LVT_logunit,*)'Expected 2, found ', rank goto 100 end if if (dims(2) .ne. 1) then write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset ', & - '/Geometry/Points_per_lat!' + '[ERR] Unexpected first dimension for HDF5 dataset /Grid/conice!' write(LVT_logunit,*) 'Expected 1, found ', dims(2) goto 100 end if - allocate(tmp_points_per_lat(dims(1), dims(2))) - tmp_latitudes = 0 - call h5dread_f(dataset_id, H5T_STD_I32LE, tmp_points_per_lat, dims, hdferr) + allocate(thin_conice(dims(1), dims(2))) + thin_conice = 0 + call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_conice, dims, hdferr) if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot read HDF5 dataset /Geometry/Points_per_lat!' + write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/conice!' goto 100 end if - ! Close the /Geometry/Points_per_lat types + ! Close the /Grid/conice types if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - - ! Calculate dimension im - itmp = floor(dims(1) / 2.) + 1 - im = tmp_points_per_lat(itmp,1) deallocate(dims) - ! Calculate t_number - call get_navgem_truncation(im, t_number) - if (t_number .ne. 681) then - write(LVT_logunit,*)'[ERR] Unexpected T-number for NAVGEM!' - write(LVT_logunit,*)'Expected T681, found T', t_number - goto 100 - end if - - ! Now we need to calculate the lat and lon of each sst and cice point. - call calc_navgem_latlons(tmp_latitudes, tmp_points_per_lat, size(sst), & - lat, lon) + ! Save the data on the regular grid into the cice array. + call interp_thinned_to_regular(im, jm, thin_points_per_lat, & + regular_longitude_slice, thin_conice, cice) ! Clean up temporary arrays - deallocate(tmp_latitudes) - deallocate(tmp_points_per_lat) + deallocate(thin_points_per_lat) write(LVT_logunit,*)'[INFO] Read data from NAVGEM file' ! Cleanup before returning 100 continue if (allocated(dims)) deallocate(dims) - if (allocated(tmp_gt)) deallocate(tmp_gt) - if (allocated(tmp_conice)) deallocate(tmp_conice) - if (allocated(tmp_latitudes)) deallocate(tmp_latitudes) - if (allocated(tmp_points_per_lat)) deallocate(tmp_points_per_lat) + if (allocated(regular_longitude_slice)) & + deallocate(regular_longitude_slice) + if (allocated(thin_gt)) deallocate(thin_gt) + if (allocated(thin_conice)) deallocate(thin_conice) + if (allocated(thin_latitudes)) deallocate(thin_latitudes) + if (allocated(thin_points_per_lat)) deallocate(thin_points_per_lat) if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) if (file_id .gt. -1) call close_navgem_file(filename, file_id, fail) @@ -791,15 +828,15 @@ end subroutine get_navgem_truncation ! Calculate the latitude and longitude of each data point on the reduced ! Gaussian grid. This logic borrows heavily from Python code provided by ! FNMOC. - subroutine calc_navgem_latlons(tmp_latitudes, tmp_points_per_lat, dim, & + subroutine calc_navgem_latlons(thin_latitudes, thin_points_per_lat, dim, & lats, lons) ! Defaults implicit none ! Arguments - real, intent(in) :: tmp_latitudes(:,:) ! The latitude of each parallel - integer, intent(in) :: tmp_points_per_lat(:,:) ! Points per parallel + real, intent(in) :: thin_latitudes(:,:) ! The latitude of each parallel + integer, intent(in) :: thin_points_per_lat(:,:) ! Points per parallel integer, intent(in) :: dim ! Total number of points real, allocatable, intent(out) :: lats(:) real, allocatable, intent(out) :: lons(:) @@ -809,17 +846,17 @@ subroutine calc_navgem_latlons(tmp_latitudes, tmp_points_per_lat, dim, & real :: d_lon integer :: r, c, i, jm - jm = size(tmp_latitudes, 1) ! Number of parallels + jm = size(thin_latitudes, 1) ! Number of parallels ! First calculate the latitudes at each point allocate(lats(dim)) lats = 0 i = 0 do r = 1, jm - num_lons = tmp_points_per_lat(r,1) + num_lons = thin_points_per_lat(r,1) do c = 1, num_lons i = i + 1 - lats(i) = tmp_latitudes(r,1) + lats(i) = thin_latitudes(r,1) end do ! c end do ! r @@ -828,7 +865,7 @@ subroutine calc_navgem_latlons(tmp_latitudes, tmp_points_per_lat, dim, & lons = 0 i = 0 do r = 1, jm - num_lons = tmp_points_per_lat(r,1) + num_lons = thin_points_per_lat(r,1) d_lon = 360. / num_lons do c = 1, num_lons i = i + 1 @@ -889,4 +926,78 @@ subroutine LVT_upscaleByAveraging_input_navgem(gridDesco, mi, rlat, rlon, & end do ! n end subroutine LVT_upscaleByAveraging_input_navgem + ! Linearly interpolate thinned grid points on parallel to regular + ! grid points. + subroutine interp_thinned_to_regular(im, jm, thin_points_per_lat, & + regular_longitude_slice, thin_var, var) + + ! Defaults + implicit none + + ! Arguments + integer, intent(in) :: im + integer, intent(in) :: jm + integer, intent(in) :: thin_points_per_lat(:,:) + real, intent(in) :: regular_longitude_slice(:) + real, intent(in) :: thin_var(:,:) + real, allocatable, intent(out) :: var(:) + + ! Locals + real, allocatable :: thin_var_slice(:) + real, allocatable :: thin_longitude_slice(:) + integer :: num_lons + real :: dlon, ratio + integer :: c, r, i, icount + + ! Save the data on the regular grid into the var array. + allocate(var(im*jm)) + var = -9999. + icount = 0 + do r = 1, jm + + ! Copy the thinned data into a slice + num_lons = thin_points_per_lat(r,1) + allocate(thin_var_slice(num_lons)) + do c = 1, num_lons + icount = icount + 1 + thin_var_slice(c) = thin_var(icount,1) + end do + icount = icount - num_lons ! Rewind + + ! Next, calculate the thinned longitudes on the slice + allocate(thin_longitude_slice(num_lons)) + thin_longitude_slice = 0 + dlon = 360. / num_lons + do c = 1, num_lons + thin_longitude_slice(c) = 0.0 + (c-1)*dlon + end do ! c + + ! Next, linearly interpolate the thinned var in the slice to + ! the regular grid points. + do i = 1, im + do c = 1, num_lons + + if (thin_longitude_slice(c) .gt. regular_longitude_slice(i)) cycle + + if (c .eq. num_lons) then ! wrap around + ratio = (thin_var_slice(1) - thin_var_slice(c)) / & + (360. - thin_longitude_slice(c)) + else + ratio = (thin_var_slice(c+1) - thin_var_slice(c)) / & + (thin_longitude_slice(c+1) - thin_longitude_slice(c)) + end if + + icount = icount + 1 + var(icount) = thin_var_slice(c) + & + (ratio * & + (regular_longitude_slice(i) - thin_longitude_slice(c))) + exit + end do ! c + end do ! i + + deallocate(thin_var_slice) + deallocate(thin_longitude_slice) + end do ! r + + end subroutine interp_thinned_to_regular end module LVT_navgemMod From e59137c8e7902c63c4244d990af917c66e183314 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 5 Apr 2021 09:23:49 -0400 Subject: [PATCH 46/64] Added read of ice thickness from NAVGEM. --- lvt/core/LVT_navgemMod.F90 | 54 +++++++++++++++++++++++++++++++++++++- 1 file changed, 53 insertions(+), 1 deletion(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 9707356f7..7835e9aaf 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -105,7 +105,7 @@ subroutine get_navgem_filename(filename, & end subroutine get_navgem_filename - subroutine fetch_navgem_fields(sst, cice, gridDesc) + subroutine fetch_navgem_fields(sst, cice, icethick, gridDesc) ! Modules #if (defined USE_HDF5) @@ -119,6 +119,7 @@ subroutine fetch_navgem_fields(sst, cice, gridDesc) ! Arguments real, allocatable, intent(out) :: sst(:) real, allocatable, intent(out) :: cice(:) + real, allocatable, intent(out) :: icethick(:) real, intent(out) :: gridDesc(50) ! Locals @@ -132,6 +133,7 @@ subroutine fetch_navgem_fields(sst, cice, gridDesc) #endif real, allocatable :: thin_gt(:,:) real, allocatable :: thin_conice(:,:) + real, allocatable :: thin_grdice(:,:) real, allocatable :: thin_latitudes(:,:) integer, allocatable :: thin_points_per_lat(:,:) real, allocatable :: regular_longitude_slice(:) @@ -139,6 +141,7 @@ subroutine fetch_navgem_fields(sst, cice, gridDesc) integer :: im, jm, itmp, t_number real :: dlon integer :: c, r + real :: ice_density ! Handle case where LVT was not compiled with HDF5 support #if (!defined USE_HDF5) @@ -148,6 +151,9 @@ subroutine fetch_navgem_fields(sst, cice, gridDesc) stop #endif + ! Calculate ice density in kg m^-3 + ice_density = 0.9167 * 1000. + ! Get NAVGEM filename call get_navgem_filename(filename, year, month, day, hour, fcst_hr) @@ -328,6 +334,50 @@ subroutine fetch_navgem_fields(sst, cice, gridDesc) ! Save the data on the regular grid into the sst array. call interp_thinned_to_regular(im, jm, thin_points_per_lat, & regular_longitude_slice, thin_gt, sst) + deallocate(thin_gt) + + ! Get the grdice variable, which (despite the name) is sea ice thickness + call open_navgem_dataset(file_id, "/Land/grdice", dataset_id, fail) + if (fail) goto 100 + call get_navgem_datatype(dataset_id, datatype_id, fail) + if (fail) goto 100 + call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) + if (fail) goto 100 + call check_navgem_units(dataset_id, "kg m-2", fail) + if (fail) goto 100 + call get_navgem_dims(dataset_id, rank, dims, fail) + if (fail) goto 100 + if (rank .ne. 2) then + write(LVT_logunit,*)'[ERR] HDF5 dataset /Land/grdice has wrong rank!' + write(LVT_logunit,*)'Expected 2, found ', rank + goto 100 + end if + if (dims(2) .ne. 4) then + write(LVT_logunit,*) & + '[ERR] Unexpected first dimension for HDF5 dataset /Land/grdice!' + write(LVT_logunit,*) 'Expected 4, found ', dims(2) + goto 100 + end if + allocate(thin_grdice(dims(1), dims(2))) + thin_grdice = 0 + call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_grdice, dims, hdferr) + if (hdferr .ne. 0) then + write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Land/grdice!' + goto 100 + end if + + ! Close the /Land/grdice types + if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) + if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) + deallocate(dims) + + ! Save the data on the regular grid into the sst array. + call interp_thinned_to_regular(im, jm, thin_points_per_lat, & + regular_longitude_slice, thin_grdice, icethick) + deallocate(thin_grdice) + + ! Convert icethick units from kg m^-2 to m + icethick = icethick / ice_density ! Get the conice (sea ice area fraction) field call open_navgem_dataset(file_id, "/Grid/conice", dataset_id, fail) @@ -365,6 +415,7 @@ subroutine fetch_navgem_fields(sst, cice, gridDesc) ! Save the data on the regular grid into the cice array. call interp_thinned_to_regular(im, jm, thin_points_per_lat, & regular_longitude_slice, thin_conice, cice) + deallocate(thin_conice) ! Clean up temporary arrays deallocate(thin_points_per_lat) @@ -377,6 +428,7 @@ subroutine fetch_navgem_fields(sst, cice, gridDesc) if (allocated(regular_longitude_slice)) & deallocate(regular_longitude_slice) if (allocated(thin_gt)) deallocate(thin_gt) + if (allocated(thin_grdice)) deallocate(thin_grdice) if (allocated(thin_conice)) deallocate(thin_conice) if (allocated(thin_latitudes)) deallocate(thin_latitudes) if (allocated(thin_points_per_lat)) deallocate(thin_points_per_lat) From 028231cc0a032167f57ac404d6e6951d5b9c98db Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 5 Apr 2021 09:39:34 -0400 Subject: [PATCH 47/64] Added public routine. --- lvt/core/LVT_navgemMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 7835e9aaf..e556c8061 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -28,6 +28,7 @@ module LVT_navgemMod private ! Public routines + public :: LVT_fetch_navgem_fields public :: LVT_upscaleByAveraging_input_navgem contains @@ -105,7 +106,7 @@ subroutine get_navgem_filename(filename, & end subroutine get_navgem_filename - subroutine fetch_navgem_fields(sst, cice, icethick, gridDesc) + subroutine LVT_fetch_navgem_fields(sst, cice, icethick, gridDesc) ! Modules #if (defined USE_HDF5) @@ -438,7 +439,7 @@ subroutine fetch_navgem_fields(sst, cice, icethick, gridDesc) call close_hdf5_f_interface(fail) #endif - end subroutine fetch_navgem_fields + end subroutine LVT_fetch_navgem_fields #if (defined USE_HDF5) subroutine open_hdf5_f_interface(fail) From 5a3bcd699adc3fa2706d096804b0ce412693bc44 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 5 Apr 2021 11:02:57 -0400 Subject: [PATCH 48/64] Began integrating NAVGEM processing into LVT. --- lvt/core/LVT_DataStreamsMod.F90 | 201 ++++++++++++++++++++++++++++++++ lvt/core/LVT_navgemMod.F90 | 12 +- 2 files changed, 206 insertions(+), 7 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 3ee26e254..81b8ac275 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -2067,6 +2067,207 @@ logical function alarm_is_on() result(alarmCheck) return end function alarm_is_on + ! EMK BEGIN + subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & + time_curr, timeRange, toplev, botlev) + + ! Defaults + implicit none + + ! Arguments + integer, intent(in) :: ftn_mean + integer, intent(in) :: time_unit + integer, intent(in) :: time_past + integer, intent(in) :: time_curr + integer, intent(in) :: timeRange + real, intent(in) :: toplev(1) + real, intent(in) :: botlev(1) + + ! Locals + character(250) :: navgem_fname + real :: gridDesci(50) ! Full NAVGEM grid + character(10) :: cdate + logical :: file_exists + real, allocatable :: sst(:) + real, allocatable :: cice(:) + real, allocatable :: icethick(:) + integer :: npts + real :: rlat(LVT_rc%lnc * LVT_rc%lnr) + real :: rlon(LVT_rc%lnc * LVT_rc%lnr) + integer :: n11(LVT_rc%lnc * LVT_rc%lnr) + integer :: n12(LVT_rc%lnc * LVT_rc%lnr) + integer :: n21(LVT_rc%lnc * LVT_rc%lnr) + integer :: n22(LVT_rc%lnc * LVT_rc%lnr) + real :: w11(LVT_rc%lnc * LVT_rc%lnr) + real :: w12(LVT_rc%lnc * LVT_rc%lnr) + real :: w21(LVT_rc%lnc * LVT_rc%lnr) + real :: w22(LVT_rc%lnc * LVT_rc%lnr) + real :: interp_var(LVT_rc%lnc * LVT_rc%lnr) + logical*1, allocatable :: li(:) + logical*1 :: lo(LVT_rc%lnc * LVT_rc%lnr) + integer :: mi, mo + integer :: year, month, day, hour, fcst_hr + real :: udef + integer :: ivar + integer :: iret + integer :: gribSF, gribSfc, gribLvl, gribCat, gribDis + character*10 :: stepType + integer :: pdTemplate + integer :: varid_def + real :: depscale(1) + + call LVT_get_navgem_filename(navgem_fname, & + year, month, day, hour, fcst_hr) + if (trim(navgem_fname) .eq. "NONE") then + file_exists = .false. + else + file_exists = .true. + end if + + if (.not. file_exists) then + write(LVT_logunit,*) '[INFO] No NAVGEM fields to append!' + return + end if + + lo = .true. ! For now, interpolate to all LVT grid points + + ! Fetch the fields from the NAVGEM file, and create lookup table for + ! upscale averaging. + call LVT_fetch_navgem_fields(navgem_fname, sst, cice, icethick, gridDesci) + npts = LVT_rc%lnc*LVT_rc%lnr + call bilinear_interp_input(gridDesci, LVT_rc%gridDesc, npts, & + rlat, rlon, n11, n12, n21, n22, & + w11, w12, w21, w22) + + allocate(li(size(sst))) + li = .true. + mo = npts + udef = -9999. + + do ivar = 1, 3 + interp_var = udef + if (ivar .eq. 1) then + + ! Handle SST first + call bilinear_interp(LVT_rc%gridDesc, size(sst), mo, li, lo, & + sst, interp_var, rlat, rlon, w11, w12, w21, w22, & + n11, n12, n21, n22, udef, iret) + + gribDis = 10 + stepType = "instant" + pdTemplate = 0 + gribCat = 3 + varid_def = 0 + gribSfc = 1 + gribSF = 10 + gribLvl = 1 + + else if (ivar .eq. 2) then + + ! Handle sea ice fraction + call bilinear_interp(LVT_rc%gridDesc, size(cice), mo, li, lo, & + cice, interp_var, rlat, rlon, w11, w12, w21, w22, & + n11, n12, n21, n22, udef, iret) + + gribDis = 10 + stepType = "instant" + pdTemplate = 0 + gribCat = 2 + varid_def = 0 + gribSfc = 1 + gribSF = 100 + gribLvl = 1 + + else if (ivar .eq. 3) then + + ! Handle sea ice thickness + call bilinear_interp(LVT_rc%gridDesc, size(icethick), mo, li, lo, & + icethick, interp_var, rlat, rlon, w11, w12, w21, w22, & + n11, n12, n21, n22, udef, iret) + + gribDis = 10 + stepType = "instant" + pdTemplate = 0 + gribCat = 2 + varid_def = 1 + gribSfc = 1 + gribSF = 10 + gribLvl = 1 + + else + write(LVT_logunit,*)'[ERR] INTERNAL ERROR, unknown ivar!' + stop + end if + + ! Now write the interpolated field to output + if (LVT_rc%lvt_out_format .eq. "grib2") then + call writeSingleGrib2Var(ftn_mean, & + interp_var, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + gribDis, & + gribCat, & + pdTemplate, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & + botlev(1), & + depscale(1), & + typeOfGeneratingProcess=2, & + typeOfProcessedData=1, & + ref_year=year, & ! FIXME + ref_month=month, & ! FIXME + ref_day=day, & ! FIXME + ref_hour=hour, & ! FIXME + ref_fcst_hr=fcst_hr) ! FIXME + else if (LVT_rc%lvt_out_format .eq. "grib1") then + call writeSingleGrib1Var(ftn_mean, & + interp_var, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & + botlev(1)) + else if (LVT_rc%lvt_out_format .eq. "netcdf") then + if (ivar .eq. 1) then + call writeSingleNetcdfVar(ftn_mean, & + interp_var, & + LVT_histData%watertemp%varId_def, & + 1) + else if (ivar .eq. 2) then + call writeSingleNetcdfVar(ftn_mean, & + interp_var, & + LVT_histData%aice%varId_def, & + 1) + else if (ivar .eq. 3) then + call writeSingleNetcdfVar(ftn_mean, & + interp_var, & + LVT_histData%hi%varId_def, & + 1) + end if + + end if + + end do ! ivar + + ! Clean up + if (allocated(li)) deallocate(li) + end subroutine LVT_append_navgem_fields + + !BOP ! ! !ROUTINE: LVT_append_HYCOM_fields diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index e556c8061..920ed86ad 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -28,6 +28,7 @@ module LVT_navgemMod private ! Public routines + public :: LVT_get_navgem_filename public :: LVT_fetch_navgem_fields public :: LVT_upscaleByAveraging_input_navgem @@ -60,7 +61,7 @@ subroutine construct_navgem_filename(rootdir, year, month, day, hour, & end subroutine construct_navgem_filename - subroutine get_navgem_filename(filename, & + subroutine LVT_get_navgem_filename(filename, & year, month, day, hour, fcst_hr) ! Modules @@ -104,9 +105,9 @@ subroutine get_navgem_filename(filename, & write(LVT_logunit,*)'[ERR] Cannot find NAVGEM file!' stop - end subroutine get_navgem_filename + end subroutine LVT_get_navgem_filename - subroutine LVT_fetch_navgem_fields(sst, cice, icethick, gridDesc) + subroutine LVT_fetch_navgem_fields(filename, sst, cice, icethick, gridDesc) ! Modules #if (defined USE_HDF5) @@ -118,13 +119,13 @@ subroutine LVT_fetch_navgem_fields(sst, cice, icethick, gridDesc) implicit none ! Arguments + character(len=*), intent(in) :: filename real, allocatable, intent(out) :: sst(:) real, allocatable, intent(out) :: cice(:) real, allocatable, intent(out) :: icethick(:) real, intent(out) :: gridDesc(50) ! Locals - character(len=250) :: filename integer :: year, month, day, hour, fcst_hr logical :: fail integer :: hdferr @@ -155,9 +156,6 @@ subroutine LVT_fetch_navgem_fields(sst, cice, icethick, gridDesc) ! Calculate ice density in kg m^-3 ice_density = 0.9167 * 1000. - ! Get NAVGEM filename - call get_navgem_filename(filename, year, month, day, hour, fcst_hr) - #if (defined USE_HDF5) ! Initialize IDs. Useful later for error handling. file_id = -1 From 6baea55b163ed29e7ce406c8c401acc8fde8cd83 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 5 Apr 2021 11:16:23 -0400 Subject: [PATCH 49/64] Added call to process NAVGEM data, and commented out HYCOM code. NOTES: 1. Latest source code compiles, but is not tested yet. 2. Eventually all HYCOM code will be removed, but only after demonstrating that NAVGEM code works. --- lvt/core/LVT_DataStreamsMod.F90 | 300 +++++++++++++++++--------------- 1 file changed, 155 insertions(+), 145 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 81b8ac275..f20e50170 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -145,97 +145,98 @@ subroutine LVT_DataStreamsInit ! temperature fields !------------------------------------------------------------------- if(LVT_rc%runmode.eq."557 post") then + ! EMK FIXME...Replace HYCOM with NAVGEM if(LVT_rc%processHYCOM.eq.1) then LVT_rc%HYCOM_proc_start = .true. - ! First, handle water_temp - LVT_rc%HYCOM_nc = 4500 - LVT_rc%HYCOM_nr = 2001 - - gridDesci = 0 - gridDesci(1) = 0 - gridDesci(2) = LVT_rc%HYCOM_nc - gridDesci(3) = LVT_rc%HYCOM_nr - gridDesci(4) = -80.0 - gridDesci(5) = -180.0 - gridDesci(7) = 80.0 - gridDesci(8) = 180.0 - gridDesci(6) = 128 - gridDesci(9) = 0.08 - gridDesci(10) = 0.08 - gridDesci(20) = 64 - - allocate(LVT_rc%HYCOM_n11(LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr)) - - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr, & - LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_n11) - - LVT_histData%watertemp%short_name = "water_temp" - LVT_histData%watertemp%long_name = "water_temp" - LVT_histData%watertemp%standard_name = "water temperature" - LVT_histData%watertemp%units = "K" - LVT_histData%watertemp%nunits = 1 - LVT_histData%watertemp%format = 'F' - LVT_histData%watertemp%vlevels = 1 - LVT_histData%watertemp%timeAvgOpt = 0 - LVT_histData%watertemp%startNlevs = 1 - LVT_histData%watertemp%endNlevs = 1 - allocate(LVT_histData%watertemp%value(LVT_rc%ngrid,& - 1,LVT_histData%watertemp%vlevels)) - allocate(LVT_histData%watertemp%unittypes(1)) - LVT_histData%watertemp%unittypes(1) = "K" - - ! Now handle Arctic sea ice fraction (aice) - LVT_rc%HYCOM_aice_arc_nc = 4500 - LVT_rc%HYCOM_aice_arc_nr = 1251 - - ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - gridDesci = 0 - gridDesci(1) = 0 ! Lat/lon projection - gridDesci(2) = LVT_rc%HYCOM_aice_arc_nc ! Number of columns - gridDesci(3) = LVT_rc%HYCOM_aice_arc_nr ! Number of rows - gridDesci(4) = 40. ! Lower-left latitude (deg N) - gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - gridDesci(6) = 128 ! Not used - gridDesci(7) = 90.0 ! Upper-right latitude (deg N) - gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) - gridDesci(20) = 64 ! East-west ordering - - allocate(LVT_rc%HYCOM_aice_arc_n11(& - LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr)) - - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr, & - LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_arc_n11) - - ! Now handle Antarctic sea ice fraction (aice) - LVT_rc%HYCOM_aice_ant_nc = 4500 - LVT_rc%HYCOM_aice_ant_nr = 775 - - ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - gridDesci = 0 - gridDesci(1) = 0 ! Lat/lon projection - gridDesci(2) = LVT_rc%HYCOM_aice_ant_nc ! Number of columns - gridDesci(3) = LVT_rc%HYCOM_aice_ant_nr ! Number of rows - gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) - gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - gridDesci(6) = 128 ! Not used - gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) - gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) - gridDesci(20) = 64 ! East-west ordering - - allocate(LVT_rc%HYCOM_aice_ant_n11(& - LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr)) - - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr, & - LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_ant_n11) + ! ! First, handle water_temp + ! LVT_rc%HYCOM_nc = 4500 + ! LVT_rc%HYCOM_nr = 2001 + + ! gridDesci = 0 + ! gridDesci(1) = 0 + ! gridDesci(2) = LVT_rc%HYCOM_nc + ! gridDesci(3) = LVT_rc%HYCOM_nr + ! gridDesci(4) = -80.0 + ! gridDesci(5) = -180.0 + ! gridDesci(7) = 80.0 + ! gridDesci(8) = 180.0 + ! gridDesci(6) = 128 + ! gridDesci(9) = 0.08 + ! gridDesci(10) = 0.08 + ! gridDesci(20) = 64 + + ! allocate(LVT_rc%HYCOM_n11(LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr)) + + ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + ! LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr, & + ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_n11) + + ! LVT_histData%watertemp%short_name = "water_temp" + ! LVT_histData%watertemp%long_name = "water_temp" + ! LVT_histData%watertemp%standard_name = "water temperature" + ! LVT_histData%watertemp%units = "K" + ! LVT_histData%watertemp%nunits = 1 + ! LVT_histData%watertemp%format = 'F' + ! LVT_histData%watertemp%vlevels = 1 + ! LVT_histData%watertemp%timeAvgOpt = 0 + ! LVT_histData%watertemp%startNlevs = 1 + ! LVT_histData%watertemp%endNlevs = 1 + ! allocate(LVT_histData%watertemp%value(LVT_rc%ngrid,& + ! 1,LVT_histData%watertemp%vlevels)) + ! allocate(LVT_histData%watertemp%unittypes(1)) + ! LVT_histData%watertemp%unittypes(1) = "K" + + ! ! Now handle Arctic sea ice fraction (aice) + ! LVT_rc%HYCOM_aice_arc_nc = 4500 + ! LVT_rc%HYCOM_aice_arc_nr = 1251 + + ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + ! gridDesci = 0 + ! gridDesci(1) = 0 ! Lat/lon projection + ! gridDesci(2) = LVT_rc%HYCOM_aice_arc_nc ! Number of columns + ! gridDesci(3) = LVT_rc%HYCOM_aice_arc_nr ! Number of rows + ! gridDesci(4) = 40. ! Lower-left latitude (deg N) + ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + ! gridDesci(6) = 128 ! Not used + ! gridDesci(7) = 90.0 ! Upper-right latitude (deg N) + ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + ! gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) + ! gridDesci(20) = 64 ! East-west ordering + + ! allocate(LVT_rc%HYCOM_aice_arc_n11(& + ! LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr)) + + ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + ! LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr, & + ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_arc_n11) + + ! ! Now handle Antarctic sea ice fraction (aice) + ! LVT_rc%HYCOM_aice_ant_nc = 4500 + ! LVT_rc%HYCOM_aice_ant_nr = 775 + + ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + ! gridDesci = 0 + ! gridDesci(1) = 0 ! Lat/lon projection + ! gridDesci(2) = LVT_rc%HYCOM_aice_ant_nc ! Number of columns + ! gridDesci(3) = LVT_rc%HYCOM_aice_ant_nr ! Number of rows + ! gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) + ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + ! gridDesci(6) = 128 ! Not used + ! gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) + ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + ! gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) + ! gridDesci(20) = 64 ! East-west ordering + + ! allocate(LVT_rc%HYCOM_aice_ant_n11(& + ! LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr)) + + ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + ! LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr, & + ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_ant_n11) LVT_histData%aice%short_name = "aice" LVT_histData%aice%long_name = "aice" @@ -252,55 +253,55 @@ subroutine LVT_DataStreamsInit allocate(LVT_histData%aice%unittypes(1)) LVT_histData%aice%unittypes(1) = "" - ! Now handle Arctic sea ice thickness (hi) - LVT_rc%HYCOM_hi_arc_nc = 4500 - LVT_rc%HYCOM_hi_arc_nr = 1251 - - ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - gridDesci = 0 - gridDesci(1) = 0 ! Lat/lon projection - gridDesci(2) = LVT_rc%HYCOM_hi_arc_nc ! Number of columns - gridDesci(3) = LVT_rc%HYCOM_hi_arc_nr ! Number of rows - gridDesci(4) = 40. ! Lower-left latitude (deg N) - gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - gridDesci(6) = 128 ! Not used - gridDesci(7) = 90.0 ! Upper-right latitude (deg N) - gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) - gridDesci(20) = 64 ! East-west ordering - - allocate(LVT_rc%HYCOM_hi_arc_n11(& - LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr)) - - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr, & - LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_arc_n11) - - ! Now handle Antarctic sea ice thickness (hi) - LVT_rc%HYCOM_hi_ant_nc = 4500 - LVT_rc%HYCOM_hi_ant_nr = 775 - - ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - gridDesci = 0 - gridDesci(1) = 0 ! Lat/lon projection - gridDesci(2) = LVT_rc%HYCOM_hi_ant_nc ! Number of columns - gridDesci(3) = LVT_rc%HYCOM_hi_ant_nr ! Number of rows - gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) - gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - gridDesci(6) = 128 ! Not used - gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) - gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) - gridDesci(20) = 64 ! East-west ordering - - allocate(LVT_rc%HYCOM_hi_ant_n11(& - LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr)) - - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr, & - LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_ant_n11) + ! ! Now handle Arctic sea ice thickness (hi) + ! LVT_rc%HYCOM_hi_arc_nc = 4500 + ! LVT_rc%HYCOM_hi_arc_nr = 1251 + + ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + ! gridDesci = 0 + ! gridDesci(1) = 0 ! Lat/lon projection + ! gridDesci(2) = LVT_rc%HYCOM_hi_arc_nc ! Number of columns + ! gridDesci(3) = LVT_rc%HYCOM_hi_arc_nr ! Number of rows + ! gridDesci(4) = 40. ! Lower-left latitude (deg N) + ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + ! gridDesci(6) = 128 ! Not used + ! gridDesci(7) = 90.0 ! Upper-right latitude (deg N) + ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + ! gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) + ! gridDesci(20) = 64 ! East-west ordering + + ! allocate(LVT_rc%HYCOM_hi_arc_n11(& + ! LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr)) + + ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + ! LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr, & + ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_arc_n11) + + ! ! Now handle Antarctic sea ice thickness (hi) + ! LVT_rc%HYCOM_hi_ant_nc = 4500 + ! LVT_rc%HYCOM_hi_ant_nr = 775 + + ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + ! gridDesci = 0 + ! gridDesci(1) = 0 ! Lat/lon projection + ! gridDesci(2) = LVT_rc%HYCOM_hi_ant_nc ! Number of columns + ! gridDesci(3) = LVT_rc%HYCOM_hi_ant_nr ! Number of rows + ! gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) + ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + ! gridDesci(6) = 128 ! Not used + ! gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) + ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + ! gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) + ! gridDesci(20) = 64 ! East-west ordering + + ! allocate(LVT_rc%HYCOM_hi_ant_n11(& + ! LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr)) + + ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + ! LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr, & + ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_ant_n11) LVT_histData%hi%short_name = "hi" LVT_histData%hi%long_name = "hi" @@ -1352,6 +1353,7 @@ subroutine LVT_writeDataStreams 'nf90_put_att for title failed in LVT_DataStreamsMod') end if + ! EMK FIXME...Replace HYCOM with NAVGEM if(LVT_rc%processHYCOM.eq.1) then ! First, handle water_temp @@ -2003,15 +2005,23 @@ subroutine LVT_writeDataStreams call LVT_cleanup_jules_ps41_ens_snow() end if - call LVT_append_HYCOM_fields(ftn_mean,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - toplev(1),& - botlev(1),& - lat,lon) - + ! EMK...Replace HYCOM with NAVGEM + !call LVT_append_HYCOM_fields(ftn_mean,& + ! time_unit,& + ! time_past,& + ! time_curr,& + ! timeRange,& + ! toplev(1),& + ! botlev(1),& + ! lat,lon) + call LVT_append_navgem_fields(ftn_mean, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + toplev(1), & + botlev(1)) + if(LVT_rc%lvt_out_format.eq."grib1") then call grib_close_file(ftn_mean,iret) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & From 7ff1f3ab8937c7a7fd35f3227d9a26611c84cebc Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 6 Apr 2021 11:57:53 -0400 Subject: [PATCH 50/64] Fixed bugs to read variable units and to remap to regular grid. --- lvt/core/LVT_navgemMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 920ed86ad..731e71464 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -564,7 +564,7 @@ subroutine check_navgem_units(dataset_id, units, fail) integer(HID_T) :: attr_id, type_id, space_id, memtype_id integer :: hdferr integer(size_t) :: size - integer(SIZE_T), parameter :: sdim = 5 + integer(SIZE_T), parameter :: sdim = 7 integer(HSIZE_T), dimension(1:1) :: dims = (/1/) integer(HSIZE_T), dimension(1:1) :: maxdims character(len=sdim), dimension(:), allocatable, target :: rdata @@ -998,22 +998,22 @@ subroutine interp_thinned_to_regular(im, jm, thin_points_per_lat, & real, allocatable :: thin_longitude_slice(:) integer :: num_lons real :: dlon, ratio - integer :: c, r, i, icount + integer :: c, r, i, icount, icount_thin ! Save the data on the regular grid into the var array. allocate(var(im*jm)) var = -9999. icount = 0 + icount_thin = 0 do r = 1, jm ! Copy the thinned data into a slice num_lons = thin_points_per_lat(r,1) allocate(thin_var_slice(num_lons)) do c = 1, num_lons - icount = icount + 1 - thin_var_slice(c) = thin_var(icount,1) + icount_thin = icount_thin + 1 + thin_var_slice(c) = thin_var(icount_thin,1) end do - icount = icount - num_lons ! Rewind ! Next, calculate the thinned longitudes on the slice allocate(thin_longitude_slice(num_lons)) From e953f214aac421de4a8acb86c243aa1a1b8e730a Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 6 Apr 2021 11:59:00 -0400 Subject: [PATCH 51/64] Fixed bug with declaring water temperature netCDF4 header. --- lvt/core/LVT_DataStreamsMod.F90 | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index f20e50170..e4306864b 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -173,20 +173,20 @@ subroutine LVT_DataStreamsInit ! LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr, & ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_n11) - ! LVT_histData%watertemp%short_name = "water_temp" - ! LVT_histData%watertemp%long_name = "water_temp" - ! LVT_histData%watertemp%standard_name = "water temperature" - ! LVT_histData%watertemp%units = "K" - ! LVT_histData%watertemp%nunits = 1 - ! LVT_histData%watertemp%format = 'F' - ! LVT_histData%watertemp%vlevels = 1 - ! LVT_histData%watertemp%timeAvgOpt = 0 - ! LVT_histData%watertemp%startNlevs = 1 - ! LVT_histData%watertemp%endNlevs = 1 - ! allocate(LVT_histData%watertemp%value(LVT_rc%ngrid,& - ! 1,LVT_histData%watertemp%vlevels)) - ! allocate(LVT_histData%watertemp%unittypes(1)) - ! LVT_histData%watertemp%unittypes(1) = "K" + LVT_histData%watertemp%short_name = "water_temp" + LVT_histData%watertemp%long_name = "water_temp" + LVT_histData%watertemp%standard_name = "water temperature" + LVT_histData%watertemp%units = "K" + LVT_histData%watertemp%nunits = 1 + LVT_histData%watertemp%format = 'F' + LVT_histData%watertemp%vlevels = 1 + LVT_histData%watertemp%timeAvgOpt = 0 + LVT_histData%watertemp%startNlevs = 1 + LVT_histData%watertemp%endNlevs = 1 + allocate(LVT_histData%watertemp%value(LVT_rc%ngrid,& + 1,LVT_histData%watertemp%vlevels)) + allocate(LVT_histData%watertemp%unittypes(1)) + LVT_histData%watertemp%unittypes(1) = "K" ! ! Now handle Arctic sea ice fraction (aice) ! LVT_rc%HYCOM_aice_arc_nc = 4500 @@ -1365,6 +1365,7 @@ subroutine LVT_writeDataStreams 'nf90_def_var for '//& trim(LVT_histData%watertemp%short_name)//& 'failed in defineNETCDFheadervar') + #if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_mean,& LVT_histData%watertemp%varId_def,& From 630444e9919dadbe227745d79a6322f8ab6daa55 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 10 May 2021 10:58:13 -0400 Subject: [PATCH 52/64] Rewrote NAVGEM code to use 0.25 deg GRIB1 files. NOTE: Currently only SST is supported. Also, code is hardwired for a particular day since only a single sample GRIB file is available. --- lvt/core/LVT_DataStreamsMod.F90 | 238 +++---- lvt/core/LVT_navgemMod.F90 | 1184 +++++++------------------------ 2 files changed, 332 insertions(+), 1090 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index e4306864b..087cafe14 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -2008,20 +2008,20 @@ subroutine LVT_writeDataStreams ! EMK...Replace HYCOM with NAVGEM !call LVT_append_HYCOM_fields(ftn_mean,& - ! time_unit,& - ! time_past,& - ! time_curr,& - ! timeRange,& - ! toplev(1),& - ! botlev(1),& - ! lat,lon) - call LVT_append_navgem_fields(ftn_mean, & - time_unit, & - time_past, & - time_curr, & - timeRange, & - toplev(1), & - botlev(1)) + ! time_unit,& + ! time_past,& + ! time_curr,& + ! timeRange,& + ! toplev(1),& + ! botlev(1),& + ! lat,lon) + call LVT_append_navgem_fields(ftn_mean, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + toplev(1), & + botlev(1)) if(LVT_rc%lvt_out_format.eq."grib1") then call grib_close_file(ftn_mean,iret) @@ -2078,7 +2078,8 @@ logical function alarm_is_on() result(alarmCheck) return end function alarm_is_on - ! EMK BEGIN + ! Add NAVGEM fields to output file. + ! TODO: Add sea ice (thickness and areal coverage). subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & time_curr, timeRange, toplev, botlev) @@ -2095,7 +2096,7 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & real, intent(in) :: botlev(1) ! Locals - character(250) :: navgem_fname + character(250) :: navgem_sst_fname real :: gridDesci(50) ! Full NAVGEM grid character(10) :: cdate logical :: file_exists @@ -2126,156 +2127,107 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & integer :: pdTemplate integer :: varid_def real :: depscale(1) + real, allocatable :: thin_latitudes(:,:) - call LVT_get_navgem_filename(navgem_fname, & + ! Check for SST GRIB file. (This actually contains merged sea surface + ! temperature and land surface temperature; we treat as SST for + ! simplicity.) + call LVT_get_navgem_sst_gr1_filename(navgem_sst_fname, & year, month, day, hour, fcst_hr) - if (trim(navgem_fname) .eq. "NONE") then + if (trim(navgem_sst_fname) .eq. "NONE") then file_exists = .false. else file_exists = .true. end if - if (.not. file_exists) then write(LVT_logunit,*) '[INFO] No NAVGEM fields to append!' return end if - lo = .true. ! For now, interpolate to all LVT grid points + ! Fetch SST from the NAVGEM file. + call LVT_fetch_navgem_sst_gr1_field(navgem_sst_fname, sst, gridDesci) - ! Fetch the fields from the NAVGEM file, and create lookup table for - ! upscale averaging. - call LVT_fetch_navgem_fields(navgem_fname, sst, cice, icethick, gridDesci) + ! Prepare to interpolate. npts = LVT_rc%lnc*LVT_rc%lnr call bilinear_interp_input(gridDesci, LVT_rc%gridDesc, npts, & rlat, rlon, n11, n12, n21, n22, & w11, w12, w21, w22) - allocate(li(size(sst))) li = .true. mo = npts udef = -9999. - - do ivar = 1, 3 - interp_var = udef - if (ivar .eq. 1) then - - ! Handle SST first - call bilinear_interp(LVT_rc%gridDesc, size(sst), mo, li, lo, & - sst, interp_var, rlat, rlon, w11, w12, w21, w22, & - n11, n12, n21, n22, udef, iret) - - gribDis = 10 - stepType = "instant" - pdTemplate = 0 - gribCat = 3 - varid_def = 0 - gribSfc = 1 - gribSF = 10 - gribLvl = 1 - - else if (ivar .eq. 2) then - - ! Handle sea ice fraction - call bilinear_interp(LVT_rc%gridDesc, size(cice), mo, li, lo, & - cice, interp_var, rlat, rlon, w11, w12, w21, w22, & - n11, n12, n21, n22, udef, iret) - - gribDis = 10 - stepType = "instant" - pdTemplate = 0 - gribCat = 2 - varid_def = 0 - gribSfc = 1 - gribSF = 100 - gribLvl = 1 - - else if (ivar .eq. 3) then - - ! Handle sea ice thickness - call bilinear_interp(LVT_rc%gridDesc, size(icethick), mo, li, lo, & - icethick, interp_var, rlat, rlon, w11, w12, w21, w22, & - n11, n12, n21, n22, udef, iret) - - gribDis = 10 - stepType = "instant" - pdTemplate = 0 - gribCat = 2 - varid_def = 1 - gribSfc = 1 - gribSF = 10 - gribLvl = 1 - - else - write(LVT_logunit,*)'[ERR] INTERNAL ERROR, unknown ivar!' - stop - end if - - ! Now write the interpolated field to output - if (LVT_rc%lvt_out_format .eq. "grib2") then - call writeSingleGrib2Var(ftn_mean, & - interp_var, & - varid_def, & - gribSF, & - gribSfc, & - gribLvl, & - gribDis, & - gribCat, & - pdTemplate, & - stepType, & - time_unit, & - time_past, & - time_curr, & - timeRange, & - 1, & - toplev(1), & - botlev(1), & - depscale(1), & - typeOfGeneratingProcess=2, & - typeOfProcessedData=1, & - ref_year=year, & ! FIXME - ref_month=month, & ! FIXME - ref_day=day, & ! FIXME - ref_hour=hour, & ! FIXME - ref_fcst_hr=fcst_hr) ! FIXME - else if (LVT_rc%lvt_out_format .eq. "grib1") then - call writeSingleGrib1Var(ftn_mean, & - interp_var, & - varid_def, & - gribSF, & - gribSfc, & - gribLvl, & - stepType, & - time_unit, & - time_past, & - time_curr, & - timeRange, & - 1, & - toplev(1), & - botlev(1)) - else if (LVT_rc%lvt_out_format .eq. "netcdf") then - if (ivar .eq. 1) then - call writeSingleNetcdfVar(ftn_mean, & - interp_var, & - LVT_histData%watertemp%varId_def, & - 1) - else if (ivar .eq. 2) then - call writeSingleNetcdfVar(ftn_mean, & - interp_var, & - LVT_histData%aice%varId_def, & - 1) - else if (ivar .eq. 3) then - call writeSingleNetcdfVar(ftn_mean, & - interp_var, & - LVT_histData%hi%varId_def, & - 1) - end if - - end if - - end do ! ivar + interp_var = udef + li = .true. + lo = .true. + + ! Interpolate the SST + call bilinear_interp(LVT_rc%gridDesc, li, sst, lo, interp_var, & + size(sst), size(interp_var), rlat, rlon, & + w11, w12, w21, w22, & + n11, n12, n21, n22, udef, iret) + + ! Prepare output field settings. + gribDis = 10 + stepType = "instant" + pdTemplate = 0 + gribCat = 3 + varid_def = 0 + gribSfc = 1 + gribSF = 10 + gribLvl = 1 + + ! Now write the interpolated field to output + if (LVT_rc%lvt_out_format .eq. "grib2") then + call writeSingleGrib2Var(ftn_mean, & + interp_var, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + gribDis, & + gribCat, & + pdTemplate, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & + botlev(1), & + depscale(1), & + typeOfGeneratingProcess=2, & + typeOfProcessedData=1, & + ref_year=year, & ! FIXME + ref_month=month, & ! FIXME + ref_day=day, & ! FIXME + ref_hour=hour, & ! FIXME + ref_fcst_hr=fcst_hr) ! FIXME + else if (LVT_rc%lvt_out_format .eq. "grib1") then + call writeSingleGrib1Var(ftn_mean, & + interp_var, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & + botlev(1)) + else if (LVT_rc%lvt_out_format .eq. "netcdf") then + call writeSingleNetcdfVar(ftn_mean, & + interp_var, & + LVT_histData%watertemp%varId_def, & + 1) + end if ! Clean up if (allocated(li)) deallocate(li) + if (allocated(sst)) deallocate(sst) end subroutine LVT_append_navgem_fields diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 731e71464..4527b8d31 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -11,14 +11,15 @@ ! ! DESCRIPTION: ! Contains routines for reading skin temperature and sea ice from -! NAVGEM HDF5 restart files on thinned Gaussian grids, and interpolate to +! NAVGEM GRIB files at 0.25 deg resolution, and interpolate to ! LVT grid. Intended to run as part of 557post mode for Air Force operations. ! ! REVISION HISTORY: -! 01 Apr 2021: Eric Kemp (SSAI), Initial implementation. Basic logic for -! pulling fields and calculating latitudes and longitudes is -! based on sample Python code provided by FNMOC. HDF5 logic -! borrows from IMERG reader in LIS. +! 10 May 2021: Eric Kemp (SSAI), Initial implementaton. Basic logic for +! pulling merged SST/skin temperature and interpolating, +! based on sample file provided by FNMOC. Still TODO: Handling +! sea ice (thickness and areal fraction), and finalizing +! file name convention. !------------------------------------------------------------------------------ module LVT_navgemMod @@ -28,13 +29,13 @@ module LVT_navgemMod private ! Public routines - public :: LVT_get_navgem_filename - public :: LVT_fetch_navgem_fields - public :: LVT_upscaleByAveraging_input_navgem + public :: LVT_get_navgem_sst_gr1_filename + public :: LVT_fetch_navgem_sst_gr1_field contains - subroutine construct_navgem_filename(rootdir, year, month, day, hour, & + subroutine construct_navgem_sst_gr1_filename(rootdir, & + year, month, day, hour, & fcst_hr, filename) ! Defaults @@ -51,17 +52,22 @@ subroutine construct_navgem_filename(rootdir, year, month, day, hour, & ! Local variables character(len=10) :: yyyymmddhh - character(len=6) :: hhhhhh + character(len=4) :: hhhh write(yyyymmddhh,'(i4.4,i2.2,i2.2,i2.2)') year, month, day, hour - write(hhhhhh,'(i6.6)') fcst_hr + write(hhhh,'(i4.4)') fcst_hr - filename = trim(rootdir) // '/navgem_restart_T0681L060_slthin_quad_' & - // yyyymmddhh // '_' // hhhhhh // '.h5' + ! FIXME: Update file name to match that provided by 557WW. The + ! existing code is for a sample file provided by FNMOC. + filename = trim(rootdir) // '/NAVGEM-' & + // yyyymmddhh & + // '-global_1440x721-grnd_sea_temp-surface-' & + // '00000000-00000000-fcst_ops-' & + // hhhh // '.gr1' - end subroutine construct_navgem_filename + end subroutine construct_navgem_sst_gr1_filename - subroutine LVT_get_navgem_filename(filename, & + subroutine LVT_get_navgem_sst_gr1_filename(filename, & year, month, day, hour, fcst_hr) ! Modules @@ -84,13 +90,15 @@ subroutine LVT_get_navgem_filename(filename, & integer :: navgem_julhr, lvt_julhr logical :: file_exists - ! FIXME...Add dynamic search for nearest NAVGEM file + ! FIXME...Add dynamic search for nearest NAVGEM file. The + ! existing code is hardwired for a sample file provided by FNMOC. year = 2021 - month = 03 - day = 31 - hour = 18 - fcst_hr = 0 - call construct_navgem_filename('./navgem', & + month = 04 + day = 13 + hour = 00 + fcst_hr = 00 + + call construct_navgem_sst_gr1_filename('./navgem', & year, month, day, hour, fcst_hr, filename) write(LVT_logunit,*)'[INFO] *** Searching for NAVGEM file ', & @@ -105,15 +113,15 @@ subroutine LVT_get_navgem_filename(filename, & write(LVT_logunit,*)'[ERR] Cannot find NAVGEM file!' stop - end subroutine LVT_get_navgem_filename + end subroutine LVT_get_navgem_sst_gr1_filename - subroutine LVT_fetch_navgem_fields(filename, sst, cice, icethick, gridDesc) + ! Routine for fetching merged sea surface temperature/land surface + ! field. We refer to this as "SST" for simplicity. + subroutine LVT_fetch_navgem_sst_gr1_field(filename, sst, gridDesc) ! Modules -#if (defined USE_HDF5) - use HDF5 -#endif - use LVT_logMod, only: LVT_logunit + use grib_api + use LVT_logMod, only: LVT_logunit, LVT_verify ! Defaults implicit none @@ -121,934 +129,216 @@ subroutine LVT_fetch_navgem_fields(filename, sst, cice, icethick, gridDesc) ! Arguments character(len=*), intent(in) :: filename real, allocatable, intent(out) :: sst(:) - real, allocatable, intent(out) :: cice(:) - real, allocatable, intent(out) :: icethick(:) real, intent(out) :: gridDesc(50) ! Locals integer :: year, month, day, hour, fcst_hr - logical :: fail - integer :: hdferr -#if (defined USE_HDF5) - integer(HID_T) :: file_id, dataset_id, datatype_id - integer(HSIZE_T), allocatable :: dims(:) -#endif - real, allocatable :: thin_gt(:,:) - real, allocatable :: thin_conice(:,:) - real, allocatable :: thin_grdice(:,:) - real, allocatable :: thin_latitudes(:,:) - integer, allocatable :: thin_points_per_lat(:,:) - real, allocatable :: regular_longitude_slice(:) - integer :: rank - integer :: im, jm, itmp, t_number - real :: dlon - integer :: c, r - real :: ice_density - - ! Handle case where LVT was not compiled with HDF5 support -#if (!defined USE_HDF5) - write(LVT_logunit,*)'[ERR] Cannot read NAVGEM HDF5 file!' - write(LVT_logunit,*) & - '[ERR] Reconfigure with HDF5, recompile, and try again!' - stop -#endif - - ! Calculate ice density in kg m^-3 - ice_density = 0.9167 * 1000. - -#if (defined USE_HDF5) - ! Initialize IDs. Useful later for error handling. - file_id = -1 - dataset_id = -1 - datatype_id = -1 - - ! Initialize HDF5 Fortran interface - call open_hdf5_f_interface(fail) - if (fail) goto 100 - - ! Open the file - call open_navgem_file(filename, file_id, fail) - if (fail) goto 100 - - ! Get the Gaussian latitudes - call open_navgem_dataset(file_id, "/Geometry/Latitudes", dataset_id, fail) - if (fail) goto 100 - call get_navgem_datatype(dataset_id, datatype_id, fail) - if (fail) goto 100 - call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) - if (fail) goto 100 - call get_navgem_dims(dataset_id, rank, dims, fail) - if (fail) goto 100 - if (rank .ne. 2) then - write(LVT_logunit,*) & - '[ERR] HDF5 dataset /Geometry/Latitudes has wrong rank!' - write(LVT_logunit,*)'Expected 2, found ', rank - goto 100 - end if - if (dims(2) .ne. 1) then - write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset ', & - '/Geometry/Latitudes!' - write(LVT_logunit,*) 'Expected 1, found ', dims(2) - goto 100 - end if - allocate(thin_latitudes(dims(1), dims(2))) - thin_latitudes = 0 - call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_latitudes, dims, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot read HDF5 dataset /Geometry/Latitudes!' - goto 100 - end if - - ! Save dimension jm - jm = dims(1) - - ! Close the /Geometry/Latitudes types - if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) - if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - deallocate(dims) - - ! Get the points per latitudes - call open_navgem_dataset(file_id, "/Geometry/Points_per_lat", dataset_id, & - fail) - if (fail) goto 100 - call get_navgem_datatype(dataset_id, datatype_id, fail) - if (fail) goto 100 - call check_navgem_type(datatype_id, H5T_STD_I32LE, fail) - if (fail) goto 100 - call get_navgem_dims(dataset_id, rank, dims, fail) - if (fail) goto 100 - if (rank .ne. 2) then - write(LVT_logunit,*) & - '[ERR] HDF5 dataset /Geometry/Points_per_lat has wrong rank!' - write(LVT_logunit,*)'Expected 2, found ', rank - goto 100 - end if - if (dims(2) .ne. 1) then - write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset ', & - '/Geometry/Points_per_lat!' - write(LVT_logunit,*) 'Expected 1, found ', dims(2) - goto 100 - end if - allocate(thin_points_per_lat(dims(1), dims(2))) - thin_points_per_lat = 0 - call h5dread_f(dataset_id, H5T_STD_I32LE, thin_points_per_lat, dims, & - hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot read HDF5 dataset /Geometry/Points_per_lat!' - goto 100 - end if - - ! Close the /Geometry/Points_per_lat types - if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) - if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - - ! Calculate dimension im - itmp = floor(dims(1) / 2.) + 1 - im = thin_points_per_lat(itmp,1) - deallocate(dims) - - ! Calculate and check t_number - call get_navgem_truncation(im, t_number) - if (t_number .ne. 681) then - write(LVT_logunit,*)'[ERR] Unexpected T-number for NAVGEM!' - write(LVT_logunit,*)'Expected T681, found T', t_number - goto 100 - end if - - ! Calculate full number of longitudes across a parallel - allocate(regular_longitude_slice(im)) - regular_longitude_slice = 0 - dlon = 360. / im - do c = 1, im - regular_longitude_slice(c) = 0. + (c-1)*dlon - end do - - ! Fill gridDesc array for NAVGEM regular grid. See LIS_PRIV_rcMod.F90 - ! for description of this array. - gridDesc = 0 - gridDesc(1) = 4 ! Regular Gaussian grid - gridDesc(2) = im - gridDesc(3) = jm - gridDesc(4) = thin_latitudes(1,1) - gridDesc(5) = regular_longitude_slice(1) - gridDesc(6) = 8 - gridDesc(7) = thin_latitudes(jm,1) - gridDesc(8) = regular_longitude_slice(im) - gridDesc(9) = dlon - gridDesc(10) = jm ! CHECK - gridDesc(11) = 64 ! CHECK - gridDesc(20) = 255 - gridDesc(41) = 4 ! Regular Gaussian grid - gridDesc(42) = im - gridDesc(43) = jm - gridDesc(44) = thin_latitudes(1,1) - gridDesc(45) = regular_longitude_slice(1) - gridDesc(46) = 128 - gridDesc(47) = thin_latitudes(jm,1) - gridDesc(48) = regular_longitude_slice(im) - gridDesc(49) = dlon - gridDesc(50) = jm ! CHECK - - deallocate(thin_latitudes) - - ! Get the gt ("ground temperature") field - call open_navgem_dataset(file_id, "/Grid/gt", dataset_id, fail) - if (fail) goto 100 - call get_navgem_datatype(dataset_id, datatype_id, fail) - if (fail) goto 100 - call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) - if (fail) goto 100 - call check_navgem_units(dataset_id, "K", fail) - if (fail) goto 100 - call get_navgem_dims(dataset_id, rank, dims, fail) - if (fail) goto 100 - if (rank .ne. 2) then - write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/gt has wrong rank!' - write(LVT_logunit,*)'Expected 2, found ', rank - goto 100 - end if - if (dims(2) .ne. 1) then - write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset /Grid/gt!' - write(LVT_logunit,*) 'Expected 1, found ', dims(2) - goto 100 - end if - allocate(thin_gt(dims(1), dims(2))) - thin_gt = 0 - call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_gt, dims, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/gt!' - goto 100 - end if - - ! Close the /Grid/gt types - if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) - if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - deallocate(dims) - - ! Save the data on the regular grid into the sst array. - call interp_thinned_to_regular(im, jm, thin_points_per_lat, & - regular_longitude_slice, thin_gt, sst) - deallocate(thin_gt) - - ! Get the grdice variable, which (despite the name) is sea ice thickness - call open_navgem_dataset(file_id, "/Land/grdice", dataset_id, fail) - if (fail) goto 100 - call get_navgem_datatype(dataset_id, datatype_id, fail) - if (fail) goto 100 - call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) - if (fail) goto 100 - call check_navgem_units(dataset_id, "kg m-2", fail) - if (fail) goto 100 - call get_navgem_dims(dataset_id, rank, dims, fail) - if (fail) goto 100 - if (rank .ne. 2) then - write(LVT_logunit,*)'[ERR] HDF5 dataset /Land/grdice has wrong rank!' - write(LVT_logunit,*)'Expected 2, found ', rank - goto 100 - end if - if (dims(2) .ne. 4) then - write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset /Land/grdice!' - write(LVT_logunit,*) 'Expected 4, found ', dims(2) - goto 100 - end if - allocate(thin_grdice(dims(1), dims(2))) - thin_grdice = 0 - call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_grdice, dims, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Land/grdice!' - goto 100 - end if - - ! Close the /Land/grdice types - if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) - if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - deallocate(dims) - - ! Save the data on the regular grid into the sst array. - call interp_thinned_to_regular(im, jm, thin_points_per_lat, & - regular_longitude_slice, thin_grdice, icethick) - deallocate(thin_grdice) - - ! Convert icethick units from kg m^-2 to m - icethick = icethick / ice_density - - ! Get the conice (sea ice area fraction) field - call open_navgem_dataset(file_id, "/Grid/conice", dataset_id, fail) - if (fail) goto 100 - call get_navgem_datatype(dataset_id, datatype_id, fail) - if (fail) goto 100 - call check_navgem_type(datatype_id, H5T_IEEE_F32LE, fail) - if (fail) goto 100 - call get_navgem_dims(dataset_id, rank, dims, fail) - if (fail) goto 100 - if (rank .ne. 2) then - write(LVT_logunit,*)'[ERR] HDF5 dataset /Grid/conice has wrong rank!' - write(LVT_logunit,*)'Expected 2, found ', rank - goto 100 - end if - if (dims(2) .ne. 1) then - write(LVT_logunit,*) & - '[ERR] Unexpected first dimension for HDF5 dataset /Grid/conice!' - write(LVT_logunit,*) 'Expected 1, found ', dims(2) - goto 100 - end if - allocate(thin_conice(dims(1), dims(2))) - thin_conice = 0 - call h5dread_f(dataset_id, H5T_IEEE_F32LE, thin_conice, dims, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)'[ERR] Cannot read HDF5 dataset /Grid/conice!' - goto 100 - end if - - ! Close the /Grid/conice types - if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) - if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - deallocate(dims) - - ! Save the data on the regular grid into the cice array. - call interp_thinned_to_regular(im, jm, thin_points_per_lat, & - regular_longitude_slice, thin_conice, cice) - deallocate(thin_conice) - - ! Clean up temporary arrays - deallocate(thin_points_per_lat) - - write(LVT_logunit,*)'[INFO] Read data from NAVGEM file' - - ! Cleanup before returning -100 continue - if (allocated(dims)) deallocate(dims) - if (allocated(regular_longitude_slice)) & - deallocate(regular_longitude_slice) - if (allocated(thin_gt)) deallocate(thin_gt) - if (allocated(thin_grdice)) deallocate(thin_grdice) - if (allocated(thin_conice)) deallocate(thin_conice) - if (allocated(thin_latitudes)) deallocate(thin_latitudes) - if (allocated(thin_points_per_lat)) deallocate(thin_points_per_lat) - if (datatype_id .gt. -1) call close_navgem_datatype(datatype_id, fail) - if (dataset_id .gt. -1) call close_navgem_dataset(dataset_id, fail) - if (file_id .gt. -1) call close_navgem_file(filename, file_id, fail) - call close_hdf5_f_interface(fail) - -#endif - end subroutine LVT_fetch_navgem_fields - -#if (defined USE_HDF5) - subroutine open_hdf5_f_interface(fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - implicit none - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5open_f(hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot initialize HDF5 ', & - 'Fortran interface!' - fail = .true. - end if - end subroutine open_hdf5_f_interface -#endif - -#if (defined USE_HDF5) - subroutine open_navgem_file(filename, file_id, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - implicit none - character(len=*), intent(in) :: filename - integer(HID_T), intent(out) :: file_id - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)& - '[ERR] Cannot open NAVGEM file ', trim(filename) - fail = .true. - else - write(LVT_logunit,*) & - '[INFO] Opened NAVGEM file ', trim(filename) - end if - end subroutine open_navgem_file -#endif - -#if (defined USE_HDF5) - subroutine open_navgem_dataset(file_id, dataset_name, dataset_id, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - implicit none - integer(HID_T), intent(in) :: file_id - character(len=*), intent(in) :: dataset_name - integer(HID_T), intent(out) :: dataset_id - integer :: hdferr - logical, intent(out) :: fail - fail = .false. - call h5dopen_f(file_id, trim(dataset_name), dataset_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)& - '[ERR] Cannot open HDF5 dataset ', trim(dataset_name) - fail = .true. - end if - end subroutine open_navgem_dataset -#endif - -#if (defined USE_HDF5) - subroutine get_navgem_datatype(dataset_id, datatype_id, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - implicit none - integer(HID_T), intent(in) :: dataset_id - integer(HID_T), intent(out) :: datatype_id - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5dget_type_f(dataset_id, datatype_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)& - '[ERR] Cannot determine HDF5 datatype' - fail = .true. - end if - end subroutine get_navgem_datatype -#endif - -#if (defined USE_HDF5) - subroutine check_navgem_type(datatype_id, datatype, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - integer(HID_T), intent(in) :: datatype_id - integer(HID_T), intent(in) :: datatype - logical, intent(out) :: fail - logical :: flag - integer :: hdferr - fail = .false. - call h5tequal_f(datatype_id, datatype, flag, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot confirm HDF5 datatype!' - fail = .true. - return - end if - if (.not. flag) then - write(LVT_logunit,*)& - '[ERR] HDF5 datatype is wrong type!' - fail = .true. - return - end if - end subroutine check_navgem_type -#endif - -#if (defined USE_HDF5) - subroutine check_navgem_units(dataset_id, units, fail) - - ! Modules - use HDF5 - use ISO_C_BINDING - use LVT_logMod, only: LVT_logunit - - ! Defaults - implicit none - - ! Arguments - integer(HID_T), intent(in) :: dataset_id - character(len=*), intent(in) :: units - logical, intent(out) :: fail - - ! Local variables - integer(HID_T) :: attr_id, type_id, space_id, memtype_id - integer :: hdferr - integer(size_t) :: size - integer(SIZE_T), parameter :: sdim = 7 - integer(HSIZE_T), dimension(1:1) :: dims = (/1/) - integer(HSIZE_T), dimension(1:1) :: maxdims - character(len=sdim), dimension(:), allocatable, target :: rdata - type(C_PTR) :: f_ptr - integer :: i - - fail = .false. - - ! Open the attribute - call h5aopen_f(dataset_id, 'units', attr_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot open HDF5 attribute' - fail = .true. - return - end if - - ! Get the attribute datatype - call h5aget_type_f(attr_id, type_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot get HDF5 attribute datatype' - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - - ! Get the size of the attribute datatype, and sanity check. - call h5tget_size_f(type_id, size, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot get HDF5 attribute ', & - 'datatype size' - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - if (size .gt. sdim+1) then - write(LVT_logunit,*) & - '[ERR] Expected smaller HDF5 attribute',& - 'datatype size' - write(LVT_logunit,*)'Expected ',sdim+1 - write(LVT_logunit,*)'Found ',size - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - - ! Get the attribute dataspace - call h5aget_space_f(attr_id, space_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot get HDF5 attribute', & - 'dataspace' - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - - ! Get the dimensions of the dataspace - call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot get HDF5 attribute ', & - 'dataspace dimensions' - call h5sclose_f(space_id, hdferr) - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - - ! Create the memory datatype - call h5tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot copy HDF5 attribute ', & - 'memory datatype.' - call h5sclose_f(space_id, hdferr) - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - call h5tset_size_f(memtype_id, sdim, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot set HDF5 attribute ', & - 'memory datatype size.' - call h5tclose_f(memtype_id, hdferr) - call h5sclose_f(space_id, hdferr) - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - - ! Read the attribute - allocate(rdata(1:dims(1))) - f_ptr = C_LOC(rdata(1)(1:1)) - call h5aread_f(attr_id, memtype_id, f_ptr, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot read HDF5 attribute.' - deallocate(rdata) - call h5tclose_f(memtype_id, hdferr) - call h5sclose_f(space_id, hdferr) - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - - ! Check the units - if (trim(rdata(1)) .ne. trim(units)) then - write(LVT_logunit,*) & - '[ERR] Found wrong HDF5 data', & - 'units' - write(LVT_logunit,*) 'Expected ', trim(units) - write(LVT_logunit,*) 'Found ',trim(rdata(1)) - deallocate(rdata) - call h5tclose_f(memtype_id, hdferr) - call h5sclose_f(space_id, hdferr) - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - fail = .true. - return - end if - - ! Clean up - deallocate(rdata) - call h5tclose_f(memtype_id, hdferr) - call h5sclose_f(space_id, hdferr) - call h5tclose_f(type_id, hdferr) - call h5aclose_f(attr_id, hdferr) - - end subroutine check_navgem_units -#endif - -#if (defined USE_HDF5) - subroutine get_navgem_dims(dataset_id, rank, dims, fail) - - ! Modules - use HDF5 - use LVT_logMod, only: LVT_logunit - - ! Defaults - implicit none - - ! Arguments - integer(HID_T), intent(in) :: dataset_id - integer, intent(out) :: rank - integer(HSIZE_T), allocatable, intent(out) :: dims(:) - logical, intent(out) :: fail - - ! Local variables - integer(HID_T) :: dataspace_id - integer(HSIZE_T), allocatable :: dataspace_maxdims(:) - integer :: hdferr - logical :: flag - integer :: i - - ! First, get the dataspace for the dataset - call h5dget_space_f(dataset_id, dataspace_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)& - '[ERR] Could not get HDF5 dataspace' - fail = .true. - return - end if - - ! Sanity check: Make sure this dataspace is "simple" - call h5sis_simple_f(dataspace_id, flag, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot determine if ', & - 'HDF5 dataspace is simple' - fail = .true. - return - end if - if (.not. flag) then - write(LVT_logunit,*) & - '[ERR] HDF5 dataspace is not simple' - fail = .true. - return - end if - - ! Get the rank (number of dimensions) - call h5sget_simple_extent_ndims_f(dataspace_id, rank, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*)& - '[ERR] Cannot get rank of HDF5 dataspace ' - fail = .true. - return - end if - - ! Get the dimensions - allocate(dims(rank)) - allocate(dataspace_maxdims(rank)) - call h5sget_simple_extent_dims_f(dataspace_id, dims, & - dataspace_maxdims, hdferr) - if (hdferr .ne. rank) then - write(LVT_logunit,*) & - '[ERR] Cannot get dims for HDF5 dataspace' - deallocate(dims) - deallocate(dataspace_maxdims) - fail = .true. - return - end if - - ! Clean up - deallocate(dataspace_maxdims) - call h5sclose_f(dataspace_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot close HDF5 dataspace' - fail = .true. - return - end if - - end subroutine get_navgem_dims -#endif - -#if (defined USE_HDF5) - subroutine close_navgem_datatype(datatype_id, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - integer(HID_T), intent(inout) :: datatype_id - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5tclose_f(datatype_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot close HDF5 datatype ' - fail = .true. - end if - datatype_id = -1 - end subroutine close_navgem_datatype -#endif - -#if (defined USE_HDF5) - subroutine close_navgem_dataset(dataset_id, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - integer(HID_T), intent(inout) :: dataset_id - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5dclose_f(dataset_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot close HDF5 dataset ' - fail = .true. - end if - dataset_id = -1 - end subroutine close_navgem_dataset -#endif - -#if (defined USE_HDF5) - subroutine close_navgem_file(filename, file_id, fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - implicit none - character(len=*), intent(in) :: filename - integer(HID_T), intent(inout) :: file_id - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5fclose_f(file_id, hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot close NAVGEM file ', trim(filename) - fail = .true. - else - write(LVT_logunit,*) & - '[INFO] Closed NAVGEM file ',trim(filename) - end if - file_id = -1 - end subroutine close_navgem_file -#endif - - -#if (defined USE_HDF5) - subroutine close_hdf5_f_interface(fail) - use HDF5 - use LVT_logMod, only: LVT_logunit - implicit none - logical, intent(out) :: fail - integer :: hdferr - fail = .false. - call h5close_f(hdferr) - if (hdferr .ne. 0) then - write(LVT_logunit,*) & - '[ERR] Cannot close HDF5 Fortran interface!' - fail = .true. - end if - end subroutine close_hdf5_f_interface -#endif - - subroutine get_navgem_truncation(im, t_number) - implicit none - integer, intent(in) :: im - integer, intent(out) :: t_number - t_number = int( 2 * int( int ( int( int(im-1)/3) + 1) / 2 ) ) - t_number = t_number - 1 - end subroutine get_navgem_truncation - - ! Calculate the latitude and longitude of each data point on the reduced - ! Gaussian grid. This logic borrows heavily from Python code provided by - ! FNMOC. - subroutine calc_navgem_latlons(thin_latitudes, thin_points_per_lat, dim, & - lats, lons) - - ! Defaults - implicit none - - ! Arguments - real, intent(in) :: thin_latitudes(:,:) ! The latitude of each parallel - integer, intent(in) :: thin_points_per_lat(:,:) ! Points per parallel - integer, intent(in) :: dim ! Total number of points - real, allocatable, intent(out) :: lats(:) - real, allocatable, intent(out) :: lons(:) - - ! Locals - integer :: num_lons - real :: d_lon - integer :: r, c, i, jm - - jm = size(thin_latitudes, 1) ! Number of parallels - - ! First calculate the latitudes at each point - allocate(lats(dim)) - lats = 0 - i = 0 - do r = 1, jm - num_lons = thin_points_per_lat(r,1) - do c = 1, num_lons - i = i + 1 - lats(i) = thin_latitudes(r,1) - end do ! c - end do ! r + logical :: file_exists + integer :: ftn, iret, igrib + integer :: nvars, ivar + integer :: editionNumber, indicatorOfParameter, centre, table2Version, & + generatingProcessIdentifier, indicatorOfTypeOfLevel, level, & + dataRepresentationType, Ni, Nj, & + latitudeOfFirstGridPoint, longitudeOfFirstGridPoint, & + latitudeOfLastGridPoint, longitudeOfLastGridPoint, & + iDirectionIncrement, jDirectionIncrement, scanningMode + integer :: i_180, i, j, ilon, iNewStartLon, iNewEndLon, i_rotate + real, allocatable :: sst1(:,:), sst2(:,:) - ! Next, calculate the longitudes at each point - allocate(lons(dim)) - lons = 0 - i = 0 - do r = 1, jm - num_lons = thin_points_per_lat(r,1) - d_lon = 360. / num_lons - do c = 1, num_lons - i = i + 1 - lons(i) = 0.0 + (c-1)*d_lon - if (lons(i) .gt. 180.) then - lons(i) = lons(i) - 360. + inquire(file=trim(filename), exist=file_exists) + if (.not. file_exists) return + write(LVT_logunit,*)'[INFO] Processing ', trim(filename) + + call grib_open_file(ftn, trim(filename), 'r', iret) + call LVT_verify(iret, '[ERR] Bad return from grib_open_file') + + call grib_count_in_file(ftn, nvars, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_count_in_file') + + ! NOTE: Below code assumes GRIB1. + do ivar = 1, nvars + + ! Get next GRIB message + call grib_new_from_file(ftn, igrib, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_new_from_file') + + ! Make sure this is a GRIB1 message + call grib_get(igrib, 'editionNumber', editionNumber, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + if (editionNumber .ne. 1) then + write(LVT_logunit,*) & + '[WARN] Expected GRIB1 message, found ', editionNumber + cycle + end if + + ! Check the parameter number + call grib_get(igrib, 'indicatorOfParameter', indicatorOfParameter, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + if (indicatorOfParameter .ne. 133) cycle + + ! At this point we think we have SST. We sanity + ! check by looking at the center, table version, etc. + call grib_get(igrib, 'centre', centre, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + if (centre .ne. 58) cycle ! Not from FNMOC + + call grib_get(igrib, 'table2Version', table2Version, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + if (table2Version .ne. 3) cycle ! Wrong table version + + call grib_get(igrib, 'generatingProcessIdentifier', & + generatingProcessIdentifier, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + if (generatingProcessIdentifier .ne. 18) cycle ! Not from NAVGEM + + call grib_get(igrib, 'indicatorOfTypeOfLevel', & + indicatorOfTypeOfLevel, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + if (indicatorOfTypeOfLevel .ne. 1) cycle ! Not at ground or water sfc + + call grib_get(igrib, 'level', level, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + if (level .ne. 0) cycle ! Not at ground or water surface + + ! Confidence is high this is the SST field. Now we assemble the + ! map projection data. + call grib_get(igrib, 'dataRepresentationType', & + dataRepresentationType, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'Ni', Ni, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'Nj', Nj, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'latitudeOfFirstGridPoint', & + latitudeOfFirstGridPoint, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'longitudeOfFirstGridPoint', & + longitudeOfFirstGridPoint, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'latitudeOfLastGridPoint', & + latitudeOfLastGridPoint, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'longitudeOfLastGridPoint', & + longitudeOfLastGridPoint, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'iDirectionIncrement', & + iDirectionIncrement, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'jDirectionIncrement', & + jDirectionIncrement, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + call grib_get(igrib, 'scanningMode', & + scanningMode, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + ! We may need to rotate the grid to fit the longitude limits of + ! -180 to 180 E. + i_180 = 0 + iNewStartLon = longitudeOfFirstGridPoint + iNewEndLon = longitudeOfLastGridPoint + ilon = longitudeOfFirstGridPoint - iDirectionIncrement + do i = 1, Ni + ilon = ilon + iDirectionIncrement + if (ilon .ge. 180000 .and. & + (ilon - iDirectionIncrement) .lt. 180000) then + i_180 = i + iNewStartLon = ilon - 360000 + iNewEndLon = ilon - iDirectionIncrement + exit end if - end do ! c - end do ! r - end subroutine calc_navgem_latlons - - ! Special version of upscaleByAveraging_input. This variant skips the - ! internal calculation of latitudes and longitudes by compute_earth_coord, - ! since that subroutine doesn't support thinned (quasi-regular) Gaussian - ! grids. Instead, the latitudes and longitudes are passed in as additional - ! arguments. - subroutine LVT_upscaleByAveraging_input_navgem(gridDesco, mi, rlat, rlon, & - mo, n11) - - ! Defaults - implicit none - - ! Arguments - real, intent(in) :: gridDesco(50) - integer, intent(in) :: mi - real, intent(in) :: rlat(mi) - real, intent(in) :: rlon(mi) - integer, intent(in) :: mo - integer, intent(out) :: n11(mi) - - ! Locals - integer :: n - integer :: i, j - real :: xi, yi - real :: xpts(mi), ypts(mi) - real :: xpts1(mo), ypts1(mo) - real :: rlat1(mo), rlon1(mo) - integer :: nv - real, parameter :: fill = -9999.0 - - ! External functions - integer, external :: get_fieldpos - - ! Find the x,y coordinates of the input points on the output grid - call compute_grid_coord(gridDesco, mi,fill, xpts, ypts, rlon, rlat, nv) - - ! Determine which grid box in the outer grid each inner point resides in. - do n = 1, mi - xi = xpts(n) - yi = ypts(n) - if (xi.ne.fill .and. yi.ne.fill) then - i = nint(xi) - j = nint(yi) - n11(n) = get_fieldpos(i, j, gridDesco) - else - n11(n) = 0 - endif - end do ! n - end subroutine LVT_upscaleByAveraging_input_navgem - - ! Linearly interpolate thinned grid points on parallel to regular - ! grid points. - subroutine interp_thinned_to_regular(im, jm, thin_points_per_lat, & - regular_longitude_slice, thin_var, var) - - ! Defaults - implicit none - - ! Arguments - integer, intent(in) :: im - integer, intent(in) :: jm - integer, intent(in) :: thin_points_per_lat(:,:) - real, intent(in) :: regular_longitude_slice(:) - real, intent(in) :: thin_var(:,:) - real, allocatable, intent(out) :: var(:) - - ! Locals - real, allocatable :: thin_var_slice(:) - real, allocatable :: thin_longitude_slice(:) - integer :: num_lons - real :: dlon, ratio - integer :: c, r, i, icount, icount_thin - - ! Save the data on the regular grid into the var array. - allocate(var(im*jm)) - var = -9999. - icount = 0 - icount_thin = 0 - do r = 1, jm - - ! Copy the thinned data into a slice - num_lons = thin_points_per_lat(r,1) - allocate(thin_var_slice(num_lons)) - do c = 1, num_lons - icount_thin = icount_thin + 1 - thin_var_slice(c) = thin_var(icount_thin,1) end do - ! Next, calculate the thinned longitudes on the slice - allocate(thin_longitude_slice(num_lons)) - thin_longitude_slice = 0 - dlon = 360. / num_lons - do c = 1, num_lons - thin_longitude_slice(c) = 0.0 + (c-1)*dlon - end do ! c - - ! Next, linearly interpolate the thinned var in the slice to - ! the regular grid points. - do i = 1, im - do c = 1, num_lons - - if (thin_longitude_slice(c) .gt. regular_longitude_slice(i)) cycle - - if (c .eq. num_lons) then ! wrap around - ratio = (thin_var_slice(1) - thin_var_slice(c)) / & - (360. - thin_longitude_slice(c)) - else - ratio = (thin_var_slice(c+1) - thin_var_slice(c)) / & - (thin_longitude_slice(c+1) - thin_longitude_slice(c)) - end if - - icount = icount + 1 - var(icount) = thin_var_slice(c) + & - (ratio * & - (regular_longitude_slice(i) - thin_longitude_slice(c))) - exit - end do ! c - end do ! i + ! Construct the grid description. Look in lis/core/LIS_PRIV_rcMod.F90 + ! for info on the grid description array. + if (dataRepresentationType .ne. 0) then + write(LVT_logunit,*) & + '[WARN] NAVGEM data not on lat/lon grid, will skip...' + cycle + end if + griddesc = 0 + griddesc(1) = 0 ! Lat/lon projection + griddesc(2) = Ni + griddesc(3) = Nj + griddesc(4) = latitudeOfFirstGridPoint * 1.e-3 + griddesc(5) = iNewStartLon * 1.e-3 ! Possibly rotated grid + gridDesc(6) = 128 + gridDesc(7) = latitudeOfLastGridPoint * 1.e-3 + gridDesc(8) = iNewEndLon * 1.e-3 ! Possibly rotated grid + gridDesc(9) = iDirectionIncrement * 1.e-3 + gridDesc(10) = jDirectionIncrement * 1.e-3 + gridDesc(11) = 64 + ! If scanning mode flag bit 3 is 0, data are in E-W ordering, otherwise + ! in N-S ordering. See NCEP ON388 Table 8. + ! Note that GRIB1 bit ordering is right-to-left and starts at 1, while + ! Fortran bit ordering is left-to-right and starts at 0. So, GRIB1 + ! bit 3 is Fortran bit 5. + if (.not. btest(scanningMode, 5)) then + gridDesc(20) = 64 ! E-W ordering + else + gridDesc(20) = 255 ! N-S ordering + end if + gridDesc(30) = 0 ! Lat/lon projection + griddesc(32) = Ni + griddesc(33) = Nj + griddesc(34) = latitudeOfFirstGridPoint * 1.e-3 + griddesc(35) = iNewStartLon * 1.e-3 ! Possibly rotated grid + gridDesc(36) = 128 + gridDesc(37) = latitudeOfLastGridPoint * 1.e-3 + gridDesc(38) = iNewEndLon * 1.e-3 ! Possibly rotated grid + gridDesc(39) = iDirectionIncrement * 1.e-3 + gridDesc(40) = jDirectionIncrement * 1.e-3 + + ! Get the values + allocate(sst(Ni*Nj)) + call grib_get(igrib, 'values', sst, iret) + call LVT_verify(iret, '[ERR] Bad return from grib_get') + + ! See if we need to rotate the data + if (iNewStartLon .ne. longitudeOfFirstGridPoint .or. & + iNewEndLon .ne. longitudeOfLastGridPoint) then + allocate(sst1(Ni,Nj)) + sst1 = 0 + allocate(sst2(Ni,Nj)) + sst2 = 0 + + do j = 1, Nj + do i = 1, Ni + sst1(i,j) = sst(i + (j-1)*Ni) + end do + end do + do j = 1, Nj + do i = 1, Ni + i_rotate = i + i_180 - 1 + if (i_rotate .gt. Ni) then + i_rotate = i_rotate - Ni + end if + sst2(i_rotate, j) = sst1(i,j) + end do + end do + do j = 1, Nj + do i = 1, Ni + sst(i + (j-1)*Ni) = sst2(i,j) + end do + end do + + deallocate(sst1) + deallocate(sst2) + end if + + ! If we reached this point, we have what we need. + exit + end do - deallocate(thin_var_slice) - deallocate(thin_longitude_slice) - end do ! r + call grib_close_file(ftn) - end subroutine interp_thinned_to_regular + end subroutine LVT_fetch_navgem_sst_gr1_field end module LVT_navgemMod From 9cf388a148382941c6b0c7ecbae025d822c2c491 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 10 May 2021 12:28:29 -0400 Subject: [PATCH 53/64] Added external declarations. --- lvt/core/LVT_DataStreamsMod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 087cafe14..acbeca37e 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -2129,6 +2129,9 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & real :: depscale(1) real, allocatable :: thin_latitudes(:,:) + external :: bilinear_interp_input + external :: bilinear_interp + ! Check for SST GRIB file. (This actually contains merged sea surface ! temperature and land surface temperature; we treat as SST for ! simplicity.) From f45bb71da7303006d534e86c9109778b6de8706d Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 10 May 2021 12:28:52 -0400 Subject: [PATCH 54/64] Removed unused module import. --- lvt/core/LVT_navgemMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 4527b8d31..83f2a150f 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -71,7 +71,6 @@ subroutine LVT_get_navgem_sst_gr1_filename(filename, & year, month, day, hour, fcst_hr) ! Modules - use LVT_coreMod, only: LVT_rc use LVT_logMod, only: LVT_logunit use LVT_timeMgrMod, only: LVT_get_julhr, LVT_julhr_date From c87d4a5efc74dbc53fc204b72f0c49d8663e6ae5 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 10 May 2021 18:28:14 -0400 Subject: [PATCH 55/64] Added temporary support for Navy "degribbed" binary SST files. --- lvt/core/LVT_navgemMod.F90 | 232 ++++++++++++++++++++++++++++++++++++- 1 file changed, 231 insertions(+), 1 deletion(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 83f2a150f..50bb3436f 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -31,6 +31,8 @@ module LVT_navgemMod ! Public routines public :: LVT_get_navgem_sst_gr1_filename public :: LVT_fetch_navgem_sst_gr1_field + public :: LVT_get_navgem_sst_bin_filename + public :: LVT_fetch_navgem_sst_bin_field contains @@ -248,7 +250,7 @@ subroutine LVT_fetch_navgem_sst_gr1_field(filename, sst, gridDesc) do i = 1, Ni ilon = ilon + iDirectionIncrement if (ilon .ge. 180000 .and. & - (ilon - iDirectionIncrement) .lt. 180000) then + (ilon - iDirectionIncrement) .lt. 180000) then i_180 = i iNewStartLon = ilon - 360000 iNewEndLon = ilon - iDirectionIncrement @@ -340,4 +342,232 @@ subroutine LVT_fetch_navgem_sst_gr1_field(filename, sst, gridDesc) call grib_close_file(ftn) end subroutine LVT_fetch_navgem_sst_gr1_field + + subroutine construct_navgem_sst_bin_filename(rootdir, & + year, month, day, hour, filename) + + ! Defaults + implicit none + + ! Arguments + character(len=*), intent(in) :: rootdir + integer, intent(in) :: year + integer, intent(in) :: month + integer, intent(in) :: day + integer, intent(in) :: hour + character(len=*), intent(out) :: filename + + ! Local variables + character(len=10) :: yyyymmddhh + + write(yyyymmddhh,'(i4.4,i2.2,i2.2,i2.2)') year, month, day, hour + + ! FIXME: Update file name to match that provided by 557WW. The + ! existing code is for a sample file provided by FNMOC. + filename = trim(rootdir) // '/navyssts_0p25deg.' & + // yyyymmddhh & + // '.dat' + + end subroutine construct_navgem_sst_bin_filename + + ! Select binary file with Navy 0.25deg SST data. Based on SNODEP/USAFSI + ! code. + subroutine LVT_get_navgem_sst_bin_filename(filename, & + year, month, day, hour) + + ! Modules + use LVT_logMod, only: LVT_logunit + use LVT_timeMgrMod, only: LVT_get_julhr, LVT_julhr_date + + ! Defaults + implicit none + + ! Arguments + character(len=*), intent(inout) :: filename + integer, intent(out) :: year + integer, intent(out) :: month + integer, intent(out) :: day + integer, intent(out) :: hour + + ! Locals + integer :: navgem_julhr, lvt_julhr + logical :: file_exists + + ! FIXME...Add dynamic search for nearest NAVGEM file. The + ! existing code is hardwired for a sample file. + year = 2021 + month = 05 + day = 05 + hour = 12 + + call construct_navgem_sst_bin_filename('./navgem', & + year, month, day, hour, filename) + + write(LVT_logunit,*)'[INFO] *** Searching for NAVGEM file ', & + trim(filename) + inquire(file=trim(filename), exist=file_exists) + if (file_exists) then + write(LVT_logunit,*)'[INFO] Will use ', trim(filename) + return + end if + + ! FIXME...Add dynamic search for NAVGEM file + write(LVT_logunit,*)'[ERR] Cannot find NAVGEM file!' + stop + + end subroutine LVT_get_navgem_sst_bin_filename + + ! Binary file reader. Taken from SNODEP/USAFSI + subroutine putget_real(buffer, iofunc, file_name, igrid, jgrid) + + ! Modules + use LVT_logMod, only: LVT_logunit + + ! Defaults + implicit none + + ! Arguments + real, intent(inout) :: buffer(igrid, jgrid) + character*1, intent(in) :: iofunc + character(len=*), intent(in) :: file_name + integer, intent(in) :: igrid + integer, intent(in) :: jgrid + + ! Locals + integer, parameter :: msglns = 20 + character*14 :: access_type + character*4 :: cstat + character*90 :: message(msglns) + integer :: istat + integer :: istat1 + integer :: reclen + logical :: isopen + integer :: i + + isopen = .false. + message = ' ' + reclen = igrid * jgrid * 4 + + access_type = '[INFO] Opening' + open( 2, file=trim(file_name), form='unformatted', convert='little_endian', & + access='direct', recl=reclen, iostat=istat, err=1000 ) + isopen = .true. + + ! Read from file, abort on error + if ( (iofunc .eq. 'r') .or. (iofunc .eq. 'R') ) then + access_type = '[INFO] Reading' + read( 2, rec=1, iostat=istat, err=1000 ) buffer + + ! Write to file, abort on error + else if ( (iofunc .eq. 'w') .or. (iofunc .eq. 'W') ) then + access_type = '[INFO] Writing' + write( 2, rec=1, iostat=istat, err=1000 ) buffer + + ! Else abort due to invalid IOFUNC value. + else + go to 4000 + endif + + close(2) + + return + + ! Error handling +1000 continue + if (isopen) close (2) + message(1) = '[ERR] LIBROUTINE: PUTGET_REAL' + message(2) = '[ERR] ERROR ' // access_type // ' ' // trim (file_name) + write (cstat, '(i4)', iostat=istat1) istat + if (istat1 .eq. 0) message(3) = 'ISTAT = ' // cstat + do i = 1, 3 + write(LVT_logunit,*) trim(message(i)) + end do + return + +4000 continue + close(2) + message(1) = '[ERR] LIBROUTINE: PUTGET_REAL' + message(2) = '[ERR] INVALID IOFUNC VALUE = '// trim(iofunc) + do i = 1, 2 + write(LVT_logunit,*) trim(message(i)) + end do + return + + end subroutine putget_real + + ! Routine for fetching merged sea surface temperature/land surface + ! field. We refer to this as "SST" for simplicity. + subroutine LVT_fetch_navgem_sst_bin_field(filename, sst, gridDesc) + + ! Modules + use LVT_coreMod, only: LVT_rc + use LVT_logMod, only: LVT_logunit, LVT_verify + + ! Defaults + implicit none + + ! Arguments + character(len=*), intent(in) :: filename + real, allocatable, intent(out) :: sst(:) + real, intent(out) :: gridDesc(50) + + ! Locals + integer, parameter :: sst_igrid = 1440 + integer, parameter :: sst_jgrid = 721 + integer, parameter :: sst_size = sst_igrid * sst_jgrid + integer :: year, month, day, hour, fcst_hr + logical :: file_exists + real, allocatable :: sst2d(:,:) + integer :: i, j, i_180, i_rotate + + inquire(file=trim(filename), exist=file_exists) + if (.not. file_exists) return + write(LVT_logunit,*)'[INFO] Processing ', trim(filename) + + allocate(sst2d(sst_igrid, sst_jgrid)) + sst2d = LVT_rc%udef + call putget_real(sst2d, 'r', trim(filename), sst_igrid, sst_jgrid) + + ! This grid ranges from 0 to 360E, but we need to rotate to -180 to 180 + ! E. + allocate(sst(sst_size)) + sst = -1 + i_180 = 720 + do j = 1, sst_jgrid + do i = 1, sst_igrid + i_rotate = i + i_180 - 1 + if (i_rotate .gt. sst_igrid) then + i_rotate = i_rotate - sst_igrid + end if + sst(i_rotate + (j-1)*sst_igrid) = sst2d(i,j) + end do + end do + deallocate(sst2d) + + griddesc = 0 + griddesc(1) = 0 ! Lat/lon projection + griddesc(2) = sst_igrid + griddesc(3) = sst_jgrid + griddesc(4) = -90. + griddesc(5) = -180.! Rotated grid + gridDesc(6) = 128 + gridDesc(7) = 90. + gridDesc(8) = 179.75 ! Rotated grid + gridDesc(9) = 0.25 + gridDesc(10) = 0.25 + gridDesc(11) = 64 + gridDesc(20) = 64 ! E-W ordering + gridDesc(30) = 0 ! Lat/lon projection + griddesc(32) = sst_igrid + griddesc(33) = sst_jgrid + griddesc(34) = -90. + griddesc(35) = -180. ! Rotated grid + gridDesc(36) = 128 + gridDesc(37) = 90. + gridDesc(38) = 179.75 ! Rotated grid + gridDesc(39) = 0.25 + gridDesc(40) = 0.25 + + end subroutine LVT_fetch_navgem_sst_bin_field + end module LVT_navgemMod From 58f024385dcd183a05862ccaad6d9e3bc5ce17c6 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Mon, 10 May 2021 18:28:49 -0400 Subject: [PATCH 56/64] Added temporary support for Navy "degribbed" 0.25 deg SST binary files. --- lvt/core/LVT_DataStreamsMod.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index acbeca37e..a8fcd3824 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -2135,8 +2135,10 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & ! Check for SST GRIB file. (This actually contains merged sea surface ! temperature and land surface temperature; we treat as SST for ! simplicity.) - call LVT_get_navgem_sst_gr1_filename(navgem_sst_fname, & - year, month, day, hour, fcst_hr) + !call LVT_get_navgem_sst_gr1_filename(navgem_sst_fname, & + ! year, month, day, hour, fcst_hr) + call LVT_get_navgem_sst_bin_filename(navgem_sst_fname, & + year, month, day, hour) if (trim(navgem_sst_fname) .eq. "NONE") then file_exists = .false. else @@ -2148,7 +2150,8 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & end if ! Fetch SST from the NAVGEM file. - call LVT_fetch_navgem_sst_gr1_field(navgem_sst_fname, sst, gridDesci) + !call LVT_fetch_navgem_sst_gr1_field(navgem_sst_fname, sst, gridDesci) + call LVT_fetch_navgem_sst_bin_field(navgem_sst_fname, sst, gridDesci) ! Prepare to interpolate. npts = LVT_rc%lnc*LVT_rc%lnr From 1f608f91c47a0b3f6fd49caadd0cbcd8aef1ce13 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 11 May 2021 13:11:21 -0400 Subject: [PATCH 57/64] Changed data for test SST binary file. --- lvt/core/LVT_navgemMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 50bb3436f..66a15167c 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -396,8 +396,8 @@ subroutine LVT_get_navgem_sst_bin_filename(filename, & ! FIXME...Add dynamic search for nearest NAVGEM file. The ! existing code is hardwired for a sample file. year = 2021 - month = 05 - day = 05 + month = 04 + day = 13 hour = 12 call construct_navgem_sst_bin_filename('./navgem', & From b9aafb3c511a8c8a0c55dbb3fbcad354e220e920 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 11 May 2021 13:11:47 -0400 Subject: [PATCH 58/64] Reinstituted HYCOM sea ice support. --- lvt/core/LVT_DataStreamsMod.F90 | 630 ++++++++++++++++---------------- 1 file changed, 314 insertions(+), 316 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index a8fcd3824..8dcbc68e2 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -188,55 +188,55 @@ subroutine LVT_DataStreamsInit allocate(LVT_histData%watertemp%unittypes(1)) LVT_histData%watertemp%unittypes(1) = "K" - ! ! Now handle Arctic sea ice fraction (aice) - ! LVT_rc%HYCOM_aice_arc_nc = 4500 - ! LVT_rc%HYCOM_aice_arc_nr = 1251 - - ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - ! gridDesci = 0 - ! gridDesci(1) = 0 ! Lat/lon projection - ! gridDesci(2) = LVT_rc%HYCOM_aice_arc_nc ! Number of columns - ! gridDesci(3) = LVT_rc%HYCOM_aice_arc_nr ! Number of rows - ! gridDesci(4) = 40. ! Lower-left latitude (deg N) - ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - ! gridDesci(6) = 128 ! Not used - ! gridDesci(7) = 90.0 ! Upper-right latitude (deg N) - ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - ! gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) - ! gridDesci(20) = 64 ! East-west ordering - - ! allocate(LVT_rc%HYCOM_aice_arc_n11(& - ! LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr)) - - ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - ! LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr, & - ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_arc_n11) - - ! ! Now handle Antarctic sea ice fraction (aice) - ! LVT_rc%HYCOM_aice_ant_nc = 4500 - ! LVT_rc%HYCOM_aice_ant_nr = 775 - - ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - ! gridDesci = 0 - ! gridDesci(1) = 0 ! Lat/lon projection - ! gridDesci(2) = LVT_rc%HYCOM_aice_ant_nc ! Number of columns - ! gridDesci(3) = LVT_rc%HYCOM_aice_ant_nr ! Number of rows - ! gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) - ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - ! gridDesci(6) = 128 ! Not used - ! gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) - ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - ! gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) - ! gridDesci(20) = 64 ! East-west ordering - - ! allocate(LVT_rc%HYCOM_aice_ant_n11(& - ! LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr)) - - ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - ! LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr, & - ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_ant_n11) + ! Now handle Arctic sea ice fraction (aice) + LVT_rc%HYCOM_aice_arc_nc = 4500 + LVT_rc%HYCOM_aice_arc_nr = 1251 + + ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + gridDesci = 0 + gridDesci(1) = 0 ! Lat/lon projection + gridDesci(2) = LVT_rc%HYCOM_aice_arc_nc ! Number of columns + gridDesci(3) = LVT_rc%HYCOM_aice_arc_nr ! Number of rows + gridDesci(4) = 40. ! Lower-left latitude (deg N) + gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + gridDesci(6) = 128 ! Not used + gridDesci(7) = 90.0 ! Upper-right latitude (deg N) + gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) + gridDesci(20) = 64 ! East-west ordering + + allocate(LVT_rc%HYCOM_aice_arc_n11(& + LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr)) + + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr, & + LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_arc_n11) + + ! Now handle Antarctic sea ice fraction (aice) + LVT_rc%HYCOM_aice_ant_nc = 4500 + LVT_rc%HYCOM_aice_ant_nr = 775 + + ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + gridDesci = 0 + gridDesci(1) = 0 ! Lat/lon projection + gridDesci(2) = LVT_rc%HYCOM_aice_ant_nc ! Number of columns + gridDesci(3) = LVT_rc%HYCOM_aice_ant_nr ! Number of rows + gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) + gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + gridDesci(6) = 128 ! Not used + gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) + gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) + gridDesci(20) = 64 ! East-west ordering + + allocate(LVT_rc%HYCOM_aice_ant_n11(& + LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr)) + + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr, & + LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_ant_n11) LVT_histData%aice%short_name = "aice" LVT_histData%aice%long_name = "aice" @@ -245,7 +245,7 @@ subroutine LVT_DataStreamsInit LVT_histData%aice%nunits = 1 LVT_histData%aice%format = 'F' LVT_histData%aice%vlevels = 1 - LVT_histData%aice%timeAvgOpt = 0 + LVT_histData%aice%timeAvgOpt = 0 LVT_histData%aice%startNlevs = 1 LVT_histData%aice%endNlevs = 1 allocate(LVT_histData%aice%value(LVT_rc%ngrid,& @@ -253,55 +253,55 @@ subroutine LVT_DataStreamsInit allocate(LVT_histData%aice%unittypes(1)) LVT_histData%aice%unittypes(1) = "" - ! ! Now handle Arctic sea ice thickness (hi) - ! LVT_rc%HYCOM_hi_arc_nc = 4500 - ! LVT_rc%HYCOM_hi_arc_nr = 1251 - - ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - ! gridDesci = 0 - ! gridDesci(1) = 0 ! Lat/lon projection - ! gridDesci(2) = LVT_rc%HYCOM_hi_arc_nc ! Number of columns - ! gridDesci(3) = LVT_rc%HYCOM_hi_arc_nr ! Number of rows - ! gridDesci(4) = 40. ! Lower-left latitude (deg N) - ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - ! gridDesci(6) = 128 ! Not used - ! gridDesci(7) = 90.0 ! Upper-right latitude (deg N) - ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - ! gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) - ! gridDesci(20) = 64 ! East-west ordering - - ! allocate(LVT_rc%HYCOM_hi_arc_n11(& - ! LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr)) - - ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - ! LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr, & - ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_arc_n11) - - ! ! Now handle Antarctic sea ice thickness (hi) - ! LVT_rc%HYCOM_hi_ant_nc = 4500 - ! LVT_rc%HYCOM_hi_ant_nr = 775 - - ! ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc - ! gridDesci = 0 - ! gridDesci(1) = 0 ! Lat/lon projection - ! gridDesci(2) = LVT_rc%HYCOM_hi_ant_nc ! Number of columns - ! gridDesci(3) = LVT_rc%HYCOM_hi_ant_nr ! Number of rows - ! gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) - ! gridDesci(5) = -180.0 ! Lower-left longitude (deg E) - ! gridDesci(6) = 128 ! Not used - ! gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) - ! gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) - ! gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) - ! gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) - ! gridDesci(20) = 64 ! East-west ordering - - ! allocate(LVT_rc%HYCOM_hi_ant_n11(& - ! LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr)) - - ! call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& - ! LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr, & - ! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_ant_n11) + ! Now handle Arctic sea ice thickness (hi) + LVT_rc%HYCOM_hi_arc_nc = 4500 + LVT_rc%HYCOM_hi_arc_nr = 1251 + + ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + gridDesci = 0 + gridDesci(1) = 0 ! Lat/lon projection + gridDesci(2) = LVT_rc%HYCOM_hi_arc_nc ! Number of columns + gridDesci(3) = LVT_rc%HYCOM_hi_arc_nr ! Number of rows + gridDesci(4) = 40. ! Lower-left latitude (deg N) + gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + gridDesci(6) = 128 ! Not used + gridDesci(7) = 90.0 ! Upper-right latitude (deg N) + gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) + gridDesci(20) = 64 ! East-west ordering + + allocate(LVT_rc%HYCOM_hi_arc_n11(& + LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr)) + + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr, & + LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_arc_n11) + + ! Now handle Antarctic sea ice thickness (hi) + LVT_rc%HYCOM_hi_ant_nc = 4500 + LVT_rc%HYCOM_hi_ant_nr = 775 + + ! See LIS_PRIV_rcMod.F90 for documentation of gridDesc + gridDesci = 0 + gridDesci(1) = 0 ! Lat/lon projection + gridDesci(2) = LVT_rc%HYCOM_hi_ant_nc ! Number of columns + gridDesci(3) = LVT_rc%HYCOM_hi_ant_nr ! Number of rows + gridDesci(4) = -80.4800033569336 ! Lower-left latitude (deg N) + gridDesci(5) = -180.0 ! Lower-left longitude (deg E) + gridDesci(6) = 128 ! Not used + gridDesci(7) = -49.5200004577637 ! Upper-right latitude (deg N) + gridDesci(8) = 179.920043945312 ! Upper-right longitude (deg E) + gridDesci(9) = 0.080017089844005795 ! delta-lon (deg) + gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) + gridDesci(20) = 64 ! East-west ordering + + allocate(LVT_rc%HYCOM_hi_ant_n11(& + LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr)) + + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr, & + LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_ant_n11) LVT_histData%hi%short_name = "hi" LVT_histData%hi%long_name = "hi" @@ -310,7 +310,7 @@ subroutine LVT_DataStreamsInit LVT_histData%hi%nunits = 1 LVT_histData%hi%format = 'F' LVT_histData%hi%vlevels = 1 - LVT_histData%hi%timeAvgOpt = 0 + LVT_histData%hi%timeAvgOpt = 0 LVT_histData%hi%startNlevs = 1 LVT_histData%hi%endNlevs = 1 allocate(LVT_histData%hi%value(LVT_rc%ngrid,& @@ -2006,16 +2006,16 @@ subroutine LVT_writeDataStreams call LVT_cleanup_jules_ps41_ens_snow() end if - ! EMK...Replace HYCOM with NAVGEM - !call LVT_append_HYCOM_fields(ftn_mean,& - ! time_unit,& - ! time_past,& - ! time_curr,& - ! timeRange,& - ! toplev(1),& - ! botlev(1),& - ! lat,lon) - call LVT_append_navgem_fields(ftn_mean, & + ! EMK...Use HYCOM for sea ice, and NAVGEM for SST. + call LVT_append_HYCOM_cice_fields(ftn_mean,& + time_unit,& + time_past,& + time_curr,& + timeRange,& + toplev(1),& + botlev(1),& + lat,lon) + call LVT_append_navgem_sst_field(ftn_mean, & time_unit, & time_past, & time_curr, & @@ -2079,8 +2079,7 @@ logical function alarm_is_on() result(alarmCheck) end function alarm_is_on ! Add NAVGEM fields to output file. - ! TODO: Add sea ice (thickness and areal coverage). - subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & + subroutine LVT_append_navgem_sst_field(ftn_mean, time_unit, time_past, & time_curr, timeRange, toplev, botlev) ! Defaults @@ -2135,10 +2134,10 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & ! Check for SST GRIB file. (This actually contains merged sea surface ! temperature and land surface temperature; we treat as SST for ! simplicity.) - !call LVT_get_navgem_sst_gr1_filename(navgem_sst_fname, & - ! year, month, day, hour, fcst_hr) - call LVT_get_navgem_sst_bin_filename(navgem_sst_fname, & - year, month, day, hour) + call LVT_get_navgem_sst_gr1_filename(navgem_sst_fname, & + year, month, day, hour, fcst_hr) + !call LVT_get_navgem_sst_bin_filename(navgem_sst_fname, & + ! year, month, day, hour) if (trim(navgem_sst_fname) .eq. "NONE") then file_exists = .false. else @@ -2150,8 +2149,8 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & end if ! Fetch SST from the NAVGEM file. - !call LVT_fetch_navgem_sst_gr1_field(navgem_sst_fname, sst, gridDesci) - call LVT_fetch_navgem_sst_bin_field(navgem_sst_fname, sst, gridDesci) + call LVT_fetch_navgem_sst_gr1_field(navgem_sst_fname, sst, gridDesci) + !call LVT_fetch_navgem_sst_bin_field(navgem_sst_fname, sst, gridDesci) ! Prepare to interpolate. npts = LVT_rc%lnc*LVT_rc%lnr @@ -2234,25 +2233,24 @@ subroutine LVT_append_navgem_fields(ftn_mean, time_unit, time_past, & ! Clean up if (allocated(li)) deallocate(li) if (allocated(sst)) deallocate(sst) - end subroutine LVT_append_navgem_fields + end subroutine LVT_append_navgem_sst_field - !BOP -! -! !ROUTINE: LVT_append_HYCOM_fields -! \label{LVT_append_HYCOM_fields} ! -! !INTERFACE: - subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& - timeRange, toplev,botlev,lat,lon) +! !ROUTINE: LVT_append_HYCOM_cice_fields +! \label{LVT_append_HYCOM_cice_fields} +! +! !INTERFACE: + subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & + time_curr, timeRange, toplev, botlev, lat, lon) -! -! !DESCRIPTION: -! This subroutine read the water temperature fields from the HYCOM output, -! reprojects it to the LVT/LIS grid and appends to the grib1 formatted file. +! +! !DESCRIPTION: +! This subroutine read the water temperature fields from the HYCOM output, +! reprojects it to the LVT/LIS grid and appends to the grib1 formatted file. ! !EOP - + #if (defined USE_NETCDF3 || defined USE_NETCDF4) use netcdf #endif @@ -2272,13 +2270,13 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& logical :: file_exists integer :: nid,ios integer :: c,r,c1,r1,k,cindex,rindex - integer :: watertid - real :: watert_ip(LVT_rc%lnc*LVT_rc%lnr) + !integer :: watertid + !real :: watert_ip(LVT_rc%lnc*LVT_rc%lnr) logical*1 :: lo(LVT_rc%lnc*LVT_rc%lnr) logical*1 :: lb(LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr) - real :: watert(LVT_rc%HYCOM_nc,LVT_rc%HYCOM_nr,1,1) - real :: watert_1d(LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr) - + !real :: watert(LVT_rc%HYCOM_nc,LVT_rc%HYCOM_nr,1,1) + !real :: watert_1d(LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr) + ! EMK...Support aice_arc integer :: aice_arc_id real :: aice_arc_ip(LVT_rc%lnc*LVT_rc%lnr) @@ -2328,8 +2326,8 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& integer :: gribSF, gribSfc,gribLvl,gribCat,gribDis real :: depscale(1) integer :: pdTemplate - - integer :: sst_year,sst_month,sst_day, sst_hour, sst_fcst_hr + + !integer :: sst_year,sst_month,sst_day, sst_hour, sst_fcst_hr integer :: cice_arc_year, cice_arc_month, cice_arc_day, & cice_arc_hour, cice_arc_fcst_hr integer :: cice_ant_year, cice_ant_month, cice_ant_day, & @@ -2343,7 +2341,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& ! find the filename, open the file, read the field - if(LVT_rc%processHYCOM.eq.1) then + if(LVT_rc%processHYCOM.eq.1) then ! *** HANDLE SST *** ! write(unit=cdate,fmt='(i4.4,i2.2,i2.2,i2.2)') & @@ -2351,7 +2349,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& ! ! FIXME...Update HYCOM file name convention ! hycom_fname = trim(LVT_rc%HYCOMdir)//'/'//& ! 'hycom_glb_928_'//trim(cdate)//'_t000_ts3z.nc' - + ! watert = LVT_rc%udef ! inquire(file=hycom_fname,exist=file_exists) ! @@ -2359,147 +2357,147 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& ! write(LVT_logunit,*)'[WARN], missing file ',trim(hycom_fname) ! end if - watert = LVT_rc%udef - call get_hycom_sst_filename(hycom_fname, & - sst_year, sst_month, sst_day, sst_hour, sst_fcst_hr) - if (trim(hycom_fname) == "NONE") then - file_exists = .false. - else - file_exists = .true. - end if - - if(file_exists) then -#if (defined USE_NETCDF3 || defined USE_NETCDF4) - write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) - - ios = nf90_open(path=trim(hycom_fname),mode=NF90_NOWRITE,ncid=nid) - call LVT_verify(ios, 'Error opening file'//trim(hycom_fname)) - -!variable ids - ios = nf90_inq_varid(nid, 'water_temp',watertid) - call LVT_verify(ios, 'Error nf90_inq_varid: water_temp') - -!values - ios = nf90_get_var(nid,watertid, watert,& - start=(/1,1,1,1/), count=(/LVT_rc%HYCOM_nc,LVT_rc%HYCOM_nr,1,1/)) - call LVT_verify(ios, 'Error nf90_get_var: water_temp') - - ios = nf90_close(nid) - call LVT_verify(ios, 'Error in nf90_close') -#endif - watert_1d = -9999.0 - lb = .false. - - do r=1,LVT_rc%HYCOM_nr - do c=1,LVT_rc%HYCOM_nc - if(watert(c,r,1,1).ne.-30000) then - if(c.gt.2250) then - c1 = c-2250 - r1 = r - else - c1 = c+2250 - r1 = r - endif -! EMK...Change from Celsius to Kelvin -! watert_1d(c1+(r1-1)*LVT_rc%HYCOM_nc) = watert(c,r,1,1)*0.001+20.0 - watert_1d(c1+(r1-1)*LVT_rc%HYCOM_nc) = watert(c,r,1,1)*0.001+20.0+273.15 +! watert = LVT_rc%udef +! call get_hycom_sst_filename(hycom_fname, & +! sst_year, sst_month, sst_day, sst_hour, sst_fcst_hr) +! if (trim(hycom_fname) == "NONE") then +! file_exists = .false. +! else +! file_exists = .true. +! end if - lb(c1+(r1-1)*LVT_rc%HYCOM_nc) = .true. - - endif - enddo - enddo - - call upscaleByAveraging(& - LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr, & - LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & - LVT_rc%HYCOM_n11, lb, & - watert_1d, lo, watert_ip) - - ! EMK: Since SST is missing north of 80N, we need to set water points - ! in this region to a reasonable value. We follow the typical - ! UKMET SURF value of 271.35K. - do r = 1, LVT_rc%gnr - do c = 1, LVT_rc%gnc - gid = LVT_domain%gindex(c,r) - - if (gid .eq. -1 .and. lat(c,r) >= 80.) then - if (watert_ip(c+(r-1)*LVT_rc%gnc) == -9999) then - watert_ip(c+(r-1)*LVT_rc%gnc) = 271.35 - end if - end if - end do ! c - end do ! r - - ! GRIB2 settings...Updated by EMK - gribDis = 10 - !stepType = "avg" - stepType = "instant" ! EMK - pdTemplate = 0 - gribCat = 3 - varid_def = 0 - gribSfc = 1 - gribSF = 10 - gribLvl = 1 - - if(LVT_rc%lvt_out_format.eq."grib2") then - ! add to the grib file - call writeSingleGrib2Var(ftn_mean,& - watert_ip,& - varid_def,& - gribSF,& - gribSfc,& - gribLvl,& - gribDis,& - gribCat,& - pdTemplate,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - 1,& - toplev(1),& - botlev(1),& - depscale(1),& - typeOfGeneratingProcess=2, & - typeOfProcessedData=1, & - ref_year=sst_year, & - ref_month=sst_month, & - ref_day=sst_day, & - ref_hour=sst_hour, & - ref_fcst_hr=sst_fcst_hr) - - elseif(LVT_rc%lvt_out_format.eq."grib1") then - call writeSingleGrib1Var(ftn_mean,& - watert_ip,& - varid_def,& - gribSF,& - gribSfc,& - gribLvl,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - 1,& - toplev(1),& - botlev(1)) - elseif(LVT_rc%lvt_out_format.eq."netcdf") then - call writeSingleNetcdfVar(ftn_mean,& - watert_ip,& - LVT_histData%watertemp%varId_def,& - 1) - - endif - endif +! if(file_exists) then +! #if (defined USE_NETCDF3 || defined USE_NETCDF4) +! write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) + +! ios = nf90_open(path=trim(hycom_fname),mode=NF90_NOWRITE,ncid=nid) +! call LVT_verify(ios, 'Error opening file'//trim(hycom_fname)) + +! !variable ids +! ios = nf90_inq_varid(nid, 'water_temp',watertid) +! call LVT_verify(ios, 'Error nf90_inq_varid: water_temp') + +! !values +! ios = nf90_get_var(nid,watertid, watert,& +! start=(/1,1,1,1/), count=(/LVT_rc%HYCOM_nc,LVT_rc%HYCOM_nr,1,1/)) +! call LVT_verify(ios, 'Error nf90_get_var: water_temp') + +! ios = nf90_close(nid) +! call LVT_verify(ios, 'Error in nf90_close') +! #endif +! watert_1d = -9999.0 +! lb = .false. + +! do r=1,LVT_rc%HYCOM_nr +! do c=1,LVT_rc%HYCOM_nc +! if(watert(c,r,1,1).ne.-30000) then +! if(c.gt.2250) then +! c1 = c-2250 +! r1 = r +! else +! c1 = c+2250 +! r1 = r +! endif +! !EMK...Change from Celsius to Kelvin +! !watert_1d(c1+(r1-1)*LVT_rc%HYCOM_nc) = watert(c,r,1,1)*0.001+20.0 +! watert_1d(c1+(r1-1)*LVT_rc%HYCOM_nc) = watert(c,r,1,1)*0.001+20.0+273.15 + +! lb(c1+(r1-1)*LVT_rc%HYCOM_nc) = .true. + +! endif +! enddo +! enddo + +! call upscaleByAveraging(& +! LVT_rc%HYCOM_nc*LVT_rc%HYCOM_nr, & +! LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & +! LVT_rc%HYCOM_n11, lb, & +! watert_1d, lo, watert_ip) + +! EMK: Since SST is missing north of 80N, we need to set water points +! in this region to a reasonable value. We follow the typical +! UKMET SURF value of 271.35K. +! do r = 1, LVT_rc%gnr +! do c = 1, LVT_rc%gnc +! gid = LVT_domain%gindex(c,r) + +! if (gid .eq. -1 .and. lat(c,r) >= 80.) then +! if (watert_ip(c+(r-1)*LVT_rc%gnc) == -9999) then +! watert_ip(c+(r-1)*LVT_rc%gnc) = 271.35 +! end if +! end if +! end do c +! end do r + +! ! GRIB2 settings...Updated by EMK +! gribDis = 10 +! stepType = "avg" +! stepType = "instant" EMK +! pdTemplate = 0 +! gribCat = 3 +! varid_def = 0 +! gribSfc = 1 +! gribSF = 10 +! gribLvl = 1 + +! if(LVT_rc%lvt_out_format.eq."grib2") then +! !add to the grib file +! call writeSingleGrib2Var(ftn_mean,& +! watert_ip,& +! varid_def,& +! gribSF,& +! gribSfc,& +! gribLvl,& +! gribDis,& +! gribCat,& +! pdTemplate,& +! stepType,& +! time_unit,& +! time_past,& +! time_curr,& +! timeRange,& +! 1,& +! toplev(1),& +! botlev(1),& +! depscale(1),& +! typeOfGeneratingProcess=2, & +! typeOfProcessedData=1, & +! ref_year=sst_year, & +! ref_month=sst_month, & +! ref_day=sst_day, & +! ref_hour=sst_hour, & +! ref_fcst_hr=sst_fcst_hr) + +! elseif(LVT_rc%lvt_out_format.eq."grib1") then +! call writeSingleGrib1Var(ftn_mean,& +! watert_ip,& +! varid_def,& +! gribSF,& +! gribSfc,& +! gribLvl,& +! stepType,& +! time_unit,& +! time_past,& +! time_curr,& +! timeRange,& +! 1,& +! toplev(1),& +! botlev(1)) +! elseif(LVT_rc%lvt_out_format.eq."netcdf") then +! call writeSingleNetcdfVar(ftn_mean,& +! watert_ip,& +! LVT_histData%watertemp%varId_def,& +! 1) + +! endif +! endif ! *** HANDLE AICE_ARC *** ! FIXME...Update HYCOM file name convention ! hycom_fname = trim(LVT_rc%HYCOMdir)//'/'//& ! 'hycom-cice_inst_ARCu0.08_928_'//trim(cdate)//'_t000.nc' -! +! ! aice_arc = LVT_rc%udef ! inquire(file=hycom_fname,exist=file_exists) ! @@ -2518,7 +2516,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& aice_arc_1d(:) = -9999 aice_arc_ip(:) = -9999 - if(file_exists) then + if(file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) @@ -2528,7 +2526,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& !variable ids ios = nf90_inq_varid(nid, 'aice',aice_arc_id) call LVT_verify(ios, 'Error nf90_inq_varid: aice') - + !values ios = nf90_get_var(nid,aice_arc_id, aice_arc,& start=(/1,1,1,1/), & @@ -2539,18 +2537,18 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& call LVT_verify(ios, 'Error in nf90_close') #endif aice_arc_1d = -9999.0 - aice_arc_lb = .false. + aice_arc_lb = .false. - do r=1,LVT_rc%HYCOM_aice_arc_nr + do r=1,LVT_rc%HYCOM_aice_arc_nr do c=1,LVT_rc%HYCOM_aice_arc_nc - if(aice_arc(c,r,1,1).ne.-30000) then + if(aice_arc(c,r,1,1).ne.-30000) then c1 = c r1 = r aice_arc_1d(c1+(r1-1)*LVT_rc%HYCOM_aice_arc_nc) = & - aice_arc(c,r,1,1)*0.0001 + aice_arc(c,r,1,1)*0.0001 aice_arc_lb(c1+(r1-1)*LVT_rc%HYCOM_aice_arc_nc) = .true. - + endif enddo enddo @@ -2560,13 +2558,13 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_aice_arc_n11, aice_arc_lb, & aice_arc_1d, lo, aice_arc_ip) - + end if ! FIXME...Update HYCOM file name convention ! hycom_fname = trim(LVT_rc%HYCOMdir)//'/'//& ! 'hycom-cice_inst_ANTu0.08_928_'//trim(cdate)//'_t000.nc' -! +! ! aice_ant = LVT_rc%udef ! inquire(file=hycom_fname,exist=file_exists) ! @@ -2587,7 +2585,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& aice_ant_1d = -9999.0 aice_ant_ip(:) = -9999 - if(file_exists) then + if(file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) @@ -2597,7 +2595,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& !variable ids ios = nf90_inq_varid(nid, 'aice',aice_ant_id) call LVT_verify(ios, 'Error nf90_inq_varid: aice') - + !values ios = nf90_get_var(nid,aice_ant_id, aice_ant,& start=(/1,1,1,1/), & @@ -2608,15 +2606,15 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& call LVT_verify(ios, 'Error in nf90_close') #endif aice_ant_1d = -9999.0 - aice_ant_lb = .false. + aice_ant_lb = .false. - do r=1,LVT_rc%HYCOM_aice_ant_nr + do r=1,LVT_rc%HYCOM_aice_ant_nr do c=1,LVT_rc%HYCOM_aice_ant_nc - if(aice_ant(c,r,1,1).ne.-30000) then + if(aice_ant(c,r,1,1).ne.-30000) then c1 = c r1 = r aice_ant_1d(c1+(r1-1)*LVT_rc%HYCOM_aice_ant_nc) = & - aice_ant(c,r,1,1)*0.0001 + aice_ant(c,r,1,1)*0.0001 aice_ant_lb(c1+(r1-1)*LVT_rc%HYCOM_aice_ant_nc) = .true. endif @@ -2628,7 +2626,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_aice_ant_n11, aice_ant_lb, & aice_ant_1d, lo, aice_ant_ip) - + end if ! Merge the two interpolated aice fields together. @@ -2703,8 +2701,8 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& ref_day=cice_arc_day,& ref_hour=cice_arc_hour,& ref_fcst_hr=cice_arc_fcst_hr) - - elseif(LVT_rc%lvt_out_format.eq."grib1") then + + elseif(LVT_rc%lvt_out_format.eq."grib1") then call writeSingleGrib1Var(ftn_mean,& aice_ip,& varid_def,& @@ -2719,12 +2717,12 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& 1,& toplev(1),& botlev(1)) - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif(LVT_rc%lvt_out_format.eq."netcdf") then call writeSingleNetcdfVar(ftn_mean,& aice_ip,& LVT_histData%aice%varId_def,& 1) - + endif ! *** HANDLE HI_ARC *** @@ -2732,7 +2730,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& ! ! FIXME...Update HYCOM file name convention ! hycom_fname = trim(LVT_rc%HYCOMdir)//'/'//& ! 'hycom-cice_inst_ARCu0.08_928_'//trim(cdate)//'_t000.nc' - + ! hi_arc = LVT_rc%udef ! inquire(file=hycom_fname,exist=file_exists) @@ -2754,7 +2752,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& hi_arc_1d(:) = -9999 hi_arc_ip(:) = -9999 - if(file_exists) then + if(file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) @@ -2764,7 +2762,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& !variable ids ios = nf90_inq_varid(nid, 'hi',hi_arc_id) call LVT_verify(ios, 'Error nf90_inq_varid: hi') - + !values ios = nf90_get_var(nid,hi_arc_id, hi_arc,& start=(/1,1,1,1/), & @@ -2775,18 +2773,18 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& call LVT_verify(ios, 'Error in nf90_close') #endif hi_arc_1d = -9999.0 - hi_arc_lb = .false. + hi_arc_lb = .false. - do r=1,LVT_rc%HYCOM_hi_arc_nr + do r=1,LVT_rc%HYCOM_hi_arc_nr do c=1,LVT_rc%HYCOM_hi_arc_nc - if(hi_arc(c,r,1,1).ne.-30000) then + if(hi_arc(c,r,1,1).ne.-30000) then c1 = c r1 = r hi_arc_1d(c1+(r1-1)*LVT_rc%HYCOM_hi_arc_nc) = & - hi_arc(c,r,1,1)*0.001 + hi_arc(c,r,1,1)*0.001 hi_arc_lb(c1+(r1-1)*LVT_rc%HYCOM_hi_arc_nc) = .true. - + endif enddo enddo @@ -2796,13 +2794,13 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_hi_arc_n11, hi_arc_lb, & hi_arc_1d, lo, hi_arc_ip) - + end if ! FIXME...Update HYCOM file name convention ! hycom_fname = trim(LVT_rc%HYCOMdir)//'/'//& ! 'hycom-cice_inst_ANTu0.08_928_'//trim(cdate)//'_t000.nc' - + ! hi_ant = LVT_rc%udef ! inquire(file=hycom_fname,exist=file_exists) @@ -2824,7 +2822,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& hi_ant_1d = -9999.0 hi_ant_ip(:) = -9999 - if(file_exists) then + if(file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) @@ -2834,7 +2832,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& !variable ids ios = nf90_inq_varid(nid, 'hi',hi_ant_id) call LVT_verify(ios, 'Error nf90_inq_varid: hi') - + !values ios = nf90_get_var(nid,hi_ant_id, hi_ant,& start=(/1,1,1,1/), & @@ -2845,15 +2843,15 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& call LVT_verify(ios, 'Error in nf90_close') #endif hi_ant_1d = -9999.0 - hi_ant_lb = .false. + hi_ant_lb = .false. - do r=1,LVT_rc%HYCOM_hi_ant_nr + do r=1,LVT_rc%HYCOM_hi_ant_nr do c=1,LVT_rc%HYCOM_hi_ant_nc - if(hi_ant(c,r,1,1).ne.-30000) then + if(hi_ant(c,r,1,1).ne.-30000) then c1 = c r1 = r hi_ant_1d(c1+(r1-1)*LVT_rc%HYCOM_hi_ant_nc) = & - hi_ant(c,r,1,1)*0.001 + hi_ant(c,r,1,1)*0.001 hi_ant_lb(c1+(r1-1)*LVT_rc%HYCOM_hi_ant_nc) = .true. endif @@ -2865,7 +2863,7 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_hi_ant_n11, hi_ant_lb, & hi_ant_1d, lo, hi_ant_ip) - + end if ! Merge the two interpolated hi fields together. @@ -2943,8 +2941,8 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& ref_day=hi_arc_day, & ref_hour=hi_arc_hour, & ref_fcst_hr=hi_arc_fcst_hr) - - elseif(LVT_rc%lvt_out_format.eq."grib1") then + + elseif(LVT_rc%lvt_out_format.eq."grib1") then call writeSingleGrib1Var(ftn_mean,& hi_ip,& varid_def,& @@ -2959,17 +2957,17 @@ subroutine LVT_append_HYCOM_fields(ftn_mean,time_unit, time_past, time_curr,& 1,& toplev(1),& botlev(1)) - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif(LVT_rc%lvt_out_format.eq."netcdf") then call writeSingleNetcdfVar(ftn_mean,& hi_ip,& LVT_histData%hi%varId_def,& 1) - + endif endif - end subroutine LVT_append_HYCOM_fields + end subroutine LVT_append_HYCOM_cice_fields subroutine applyNoiseReductionFilter(gvar) From ef4963317963298f373a92f1adf1476350043d0a Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 11 May 2021 14:01:52 -0400 Subject: [PATCH 59/64] Removed unnecessary/annoying white-space. --- lvt/core/LVT_DataStreamsMod.F90 | 882 ++++++++++++++++---------------- 1 file changed, 441 insertions(+), 441 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 8dcbc68e2..04506df7b 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -11,13 +11,13 @@ #include "LVT_NetCDF_inc.h" module LVT_DataStreamsMod !BOP -! +! ! !MODULE: LVT_DataStreamMod ! \label(LVT_DataStreamMod) ! ! !INTERFACE: -! -! !USES: +! +! !USES: use LVT_histDataMod use LVT_coreMod use LVT_logMod @@ -26,29 +26,29 @@ module LVT_DataStreamsMod use LVT_timeMgrMod use map_utils use grib_api -#if (defined USE_NETCDF3 || defined USE_NETCDF4) +#if (defined USE_NETCDF3 || defined USE_NETCDF4) use netcdf #endif implicit none ! -! !INPUT PARAMETERS: -! +! !INPUT PARAMETERS: +! ! !OUTPUT PARAMETERS: ! -! !DESCRIPTION: -! The code in this file contains the basic datastructures and -! control routines for handling the operations associated -! with the datastreams. The invocation to read, perform -! temporal averaging and resetting of the datastreams are +! !DESCRIPTION: +! The code in this file contains the basic datastructures and +! control routines for handling the operations associated +! with the datastreams. The invocation to read, perform +! temporal averaging and resetting of the datastreams are ! performed from this module. The calculations of derived ! variables are also performed in this module. -! +! ! !FILES USED: ! -! !REVISION HISTORY: +! !REVISION HISTORY: ! 02 Oct 2008 Sujay Kumar Initial Specification -! +! !EOP PRIVATE !----------------------------------------------------------------------------- @@ -62,35 +62,35 @@ module LVT_DataStreamsMod !----------------------------------------------------------------------------- ! !PUBLIC TYPES: !----------------------------------------------------------------------------- - + !EOP - + contains !BOP -! +! ! !ROUTINE: LVT_DataStreamsInit ! \label{LVT_DataStreamsInit} ! -! !INTERFACE: +! !INTERFACE: subroutine LVT_DataStreamsInit -! -! !USES: +! +! !USES: use LVT_datastream_pluginMod, only : LVT_datastream_plugin implicit none ! ! !DESCRIPTION: -! +! ! This subroutine invokes the call to initialize each datastream. ! -! The routines invoked are: +! The routines invoked are: ! \begin{description} ! \item[LVT\_datastream\_plugin] (\ref{LVT_datastream_plugin}) \newline ! routine to register all the supported datastream plugin implementations ! \item[LVT\_LISoutputInit] (\ref{LVT_LISoutputInit}) \newline ! routine to initialize the handling of LIS output data (if LIS output ! data is one of the datastreams) -! \end{description} +! \end{description} !EOP integer :: kk type(LVT_metadataEntry), pointer :: ds1, ds2 @@ -101,39 +101,39 @@ subroutine LVT_DataStreamsInit call observationsetup(trim(LVT_rc%obssource(1))//char(0),1) call observationsetup(trim(LVT_rc%obssource(2))//char(0),2) - if(LVT_rc%nDatastreams.gt.2) then + if(LVT_rc%nDatastreams.gt.2) then call observationsetup(trim(LVT_rc%obssource(3))//char(0),3) endif call LVT_LISoutputInit ! checking for duplicate entries in a given datastream -! Note that this check is not enabled for three datastrems. +! Note that this check is not enabled for three datastrems. ! The responsibility of ensuring non-duplicate entries is -! on the user. +! on the user. - LVT_rc%ds1_dup = .false. - ds1 => LVT_histData%head_ds1_list + LVT_rc%ds1_dup = .false. + ds1 => LVT_histData%head_ds1_list do while(associated(ds1)) ds2 => ds1%next do while(associated(ds2)) if(ds2%index.ne.ds1%index.and.& - ds1%short_name.eq.ds2%short_name) then - LVT_rc%ds1_dup = .true. + ds1%short_name.eq.ds2%short_name) then + LVT_rc%ds1_dup = .true. endif ds2 => ds2%next enddo ds1 => ds1%next enddo - LVT_rc%ds2_dup = .false. - ds1 => LVT_histData%head_ds2_list + LVT_rc%ds2_dup = .false. + ds1 => LVT_histData%head_ds2_list do while(associated(ds1)) ds2 => ds1%next do while(associated(ds2)) if(ds2%index.ne.ds1%index.and.& - ds1%short_name.eq.ds2%short_name) then - LVT_rc%ds2_dup = .true. + ds1%short_name.eq.ds2%short_name) then + LVT_rc%ds2_dup = .true. endif ds2 => ds2%next enddo @@ -144,18 +144,18 @@ subroutine LVT_DataStreamsInit ! for 557 post, the HYCOM data is processed to include the water ! temperature fields !------------------------------------------------------------------- - if(LVT_rc%runmode.eq."557 post") then + if(LVT_rc%runmode.eq."557 post") then ! EMK FIXME...Replace HYCOM with NAVGEM - if(LVT_rc%processHYCOM.eq.1) then + if(LVT_rc%processHYCOM.eq.1) then - LVT_rc%HYCOM_proc_start = .true. + LVT_rc%HYCOM_proc_start = .true. ! ! First, handle water_temp ! LVT_rc%HYCOM_nc = 4500 ! LVT_rc%HYCOM_nr = 2001 - ! gridDesci = 0 - ! gridDesci(1) = 0 + ! gridDesci = 0 + ! gridDesci(1) = 0 ! gridDesci(2) = LVT_rc%HYCOM_nc ! gridDesci(3) = LVT_rc%HYCOM_nr ! gridDesci(4) = -80.0 @@ -180,7 +180,7 @@ subroutine LVT_DataStreamsInit LVT_histData%watertemp%nunits = 1 LVT_histData%watertemp%format = 'F' LVT_histData%watertemp%vlevels = 1 - LVT_histData%watertemp%timeAvgOpt = 0 + LVT_histData%watertemp%timeAvgOpt = 0 LVT_histData%watertemp%startNlevs = 1 LVT_histData%watertemp%endNlevs = 1 allocate(LVT_histData%watertemp%value(LVT_rc%ngrid,& @@ -323,53 +323,53 @@ subroutine LVT_DataStreamsInit end subroutine LVT_DataStreamsInit !BOP -! +! ! !ROUTINE: LVT_readDataStreams ! \label{LVT_readDataStreams} ! -! !INTERFACE: +! !INTERFACE: subroutine LVT_readDataStreams -! -! !USES: +! +! !USES: implicit none ! ! -! !DESCRIPTION: +! !DESCRIPTION: ! This subroutine invokes the routines that read the datastreams -! +! !EOP - call readObservationSource(trim(LVT_rc%obssource(1))//char(0),1) - call readObservationSource(trim(LVT_rc%obssource(2))//char(0),2) + call readObservationSource(trim(LVT_rc%obssource(1))//char(0),1) + call readObservationSource(trim(LVT_rc%obssource(2))//char(0),2) - if(LVT_rc%nDatastreams.gt.2) then - call readObservationSource(trim(LVT_rc%obssource(3))//char(0),3) + if(LVT_rc%nDatastreams.gt.2) then + call readObservationSource(trim(LVT_rc%obssource(3))//char(0),3) endif end subroutine LVT_readDataStreams - + !BOP -! +! ! !ROUTINE: LVT_writeDataStreams ! \label{LVT_writeDataStreams} ! -! !INTERFACE: +! !INTERFACE: subroutine LVT_writeDataStreams -! -! !USES: +! +! !USES: use LVT_logMod use LVT_coreMod, only: LVT_LIS_rc ! EMK use LVT_557post_ps41_snowMod ! EMK - + implicit none ! ! -! !DESCRIPTION: +! !DESCRIPTION: ! This subroutine invokes the routines that writes the datastream values ! to an external file. Currently this feature is only supported ! in the '557 post' runmode, for the processing of LIS outputs to the -! grib format. The datastream1 output must be set to 'LIS output'. -! +! grib format. The datastream1 output must be set to 'LIS output'. +! !EOP @@ -467,7 +467,7 @@ subroutine LVT_writeDataStreams depscale = 0 end if do k = 1, nsoillayers - lyrthk(k) = LVT_LIS_rc(1)%smthick(k) + lyrthk(k) = LVT_LIS_rc(1)%smthick(k) end do if (LVT_557post_alarm_is_on()) then @@ -595,7 +595,7 @@ subroutine LVT_writeDataStreams ! '_PA.03-HR-SUM_DD.'//& '_PA.LIS_DD.'//& trim(cdate2)//'_DT.'//trim(cdate3)//'_DF.GR1' - + fname_ssdev = trim(LVT_rc%statsodir)//& ! '/PS.AFWA_SC.'//trim(LVT_rc%security_class)//& ! '_DI.'//trim(LVT_rc%distribution_class)//& @@ -613,12 +613,12 @@ subroutine LVT_writeDataStreams end if ! Setup of GRIB-1 and GRIB-2 Metadata Section - + ! toplev is the depth of the top of each soil layer ! botlev is the depth of the bottom of each soil layer toplev(1) = 0.0 botlev(1) = lyrthk(1) - + ! determine bounding levels for each soil moisture layer do i = 2, nsoillayers toplev(i) = toplev(i-1) + lyrthk(i-1) @@ -630,23 +630,23 @@ subroutine LVT_writeDataStreams ! Set values for non layered fields (Fluxes, Sfc Fields, etc.) toplev0 = 0 botlev0 = 0 - + yr = LVT_rc%yr mo = LVT_rc%mo da = LVT_rc%da hr = LVT_rc%hr mn = LVT_rc%mn ss = LVT_rc%ss - + call LVT_tick(time,doy,gmt,yr,mo,da,hr,mn,ss,-1*LVT_rc%statswriteint) - + if(LVT_rc%statswriteint .GT. 0) then time_unit = 254 ! seconds time_curr = 0 time_past = LVT_rc%statswriteint endif if(LVT_rc%statswriteint .GE. 60) then - time_unit = 0 ! minutes + time_unit = 0 ! minutes time_curr = 0 time_past = (LVT_rc%statswriteint / 60) endif @@ -660,9 +660,9 @@ subroutine LVT_writeDataStreams time_curr = 0 time_past = (LVT_rc%statswriteint / 86400) endif - + !time_past: from LVT_grib1_finalize - !time_P1 (Negative Time Unit for avg, or 0 for analysis) + !time_P1 (Negative Time Unit for avg, or 0 for analysis) !According to the in-line comments, time_past must be negative or 0. !Here we are setting it to a positive value. This produces bad output. !Setting it to a negative value also produces bad output. @@ -679,7 +679,7 @@ subroutine LVT_writeDataStreams call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) end if - elseif(LVT_rc%lvt_out_format.eq."grib2") then + elseif(LVT_rc%lvt_out_format.eq."grib2") then write(unit=cdate2,fmt='(i4.4,i2.2,i2.2)') & LVT_rc%yr, LVT_rc%mo, LVT_rc%da write(unit=cdate3,fmt='(i2.2,i2.2)') & @@ -740,12 +740,12 @@ subroutine LVT_writeDataStreams end if end if ! Setup of GRIB-1 and GRIB-2 Metadata Section - + ! toplev is the depth of the top of each soil layer ! botlev is the depth of the bottom of each soil layer toplev(1) = 0.0 botlev(1) = lyrthk(1) - + ! determine bounding levels for each soil moisture layer do i = 2, nsoillayers toplev(i) = toplev(i-1) + lyrthk(i-1) @@ -757,23 +757,23 @@ subroutine LVT_writeDataStreams ! Set values for non layered fields (Fluxes, Sfc Fields, etc.) toplev0 = 0 botlev0 = 0 - + yr = LVT_rc%yr mo = LVT_rc%mo da = LVT_rc%da hr = LVT_rc%hr mn = LVT_rc%mn ss = LVT_rc%ss - + call LVT_tick(time,doy,gmt,yr,mo,da,hr,mn,ss,-1*LVT_rc%statswriteint) - + if(LVT_rc%statswriteint .GT. 0) then time_unit = 254 ! seconds time_curr = 0 time_past = LVT_rc%statswriteint endif if(LVT_rc%statswriteint .GE. 60) then - time_unit = 0 ! minutes + time_unit = 0 ! minutes time_curr = 0 time_past = (LVT_rc%statswriteint / 60) endif @@ -787,9 +787,9 @@ subroutine LVT_writeDataStreams time_curr = 0 time_past = (LVT_rc%statswriteint / 86400) endif - + !time_past: from LVT_grib1_finalize - !time_P1 (Negative Time Unit for avg, or 0 for analysis) + !time_P1 (Negative Time Unit for avg, or 0 for analysis) !According to the in-line comments, time_past must be negative or 0. !Here we are setting it to a positive value. This produces bad output. !Setting it to a negative value also produces bad output. @@ -806,7 +806,7 @@ subroutine LVT_writeDataStreams call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) end if - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif(LVT_rc%lvt_out_format.eq."netcdf") then call date_and_time(date,stime,zone,values) @@ -870,12 +870,12 @@ subroutine LVT_writeDataStreams end if end if ! Setup of GRIB-1 and GRIB-2 Metadata Section - + ! toplev is the depth of the top of each soil layer ! botlev is the depth of the bottom of each soil layer toplev(1) = 0.0 botlev(1) = lyrthk(1) - + ! determine bounding levels for each soil moisture layer do i = 2, nsoillayers toplev(i) = toplev(i-1) + lyrthk(i-1) @@ -887,23 +887,23 @@ subroutine LVT_writeDataStreams ! Set values for non layered fields (Fluxes, Sfc Fields, etc.) toplev0 = 0 botlev0 = 0 - + yr = LVT_rc%yr mo = LVT_rc%mo da = LVT_rc%da hr = LVT_rc%hr mn = LVT_rc%mn ss = LVT_rc%ss - + call LVT_tick(time,doy,gmt,yr,mo,da,hr,mn,ss,-1*LVT_rc%statswriteint) - + if(LVT_rc%statswriteint .GT. 0) then time_unit = 254 ! seconds time_curr = 0 time_past = LVT_rc%statswriteint endif if(LVT_rc%statswriteint .GE. 60) then - time_unit = 0 ! minutes + time_unit = 0 ! minutes time_curr = 0 time_past = (LVT_rc%statswriteint / 60) endif @@ -917,9 +917,9 @@ subroutine LVT_writeDataStreams time_curr = 0 time_past = (LVT_rc%statswriteint / 86400) endif - + !time_past: from LVT_grib1_finalize - !time_P1 (Negative Time Unit for avg, or 0 for analysis) + !time_P1 (Negative Time Unit for avg, or 0 for analysis) !According to the in-line comments, time_past must be negative or 0. !Here we are setting it to a positive value. This produces bad output. !Setting it to a negative value also produces bad output. @@ -940,7 +940,7 @@ subroutine LVT_writeDataStreams xlat%nunits = 1 xlat%format = 'F' xlat%vlevels = 1 - xlat%timeAvgOpt = 0 + xlat%timeAvgOpt = 0 xlat%startNlevs = 1 xlat%endNlevs = 1 allocate(xlat%value(LVT_rc%ngrid,& @@ -955,7 +955,7 @@ subroutine LVT_writeDataStreams xlon%nunits = 1 xlon%format = 'F' xlon%vlevels = 1 - xlon%timeAvgOpt = 0 + xlon%timeAvgOpt = 0 xlon%startNlevs = 1 xlon%endNlevs = 1 allocate(xlon%value(LVT_rc%ngrid,& @@ -994,12 +994,12 @@ subroutine LVT_writeDataStreams call LVT_verify(nf90_def_dim(ftn_mean,'time',1,tdimID)) call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"missing_value",& LVT_rc%udef)) - + call LVT_verify(nf90_def_var(ftn_mean,& trim(xlat%short_name),& nf90_float,& dimids = dimID(1:2), varID=xlatID)) -#if(defined USE_NETCDF4) +#if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_mean,& xlatID,& shuffle,deflate,deflate_level)) @@ -1008,7 +1008,7 @@ subroutine LVT_writeDataStreams trim(xlon%short_name),& nf90_float,& dimids = dimID(1:2), varID=xlonID)) -#if(defined USE_NETCDF4) +#if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_mean,& xlonID,& shuffle,deflate,deflate_level)) @@ -1056,7 +1056,7 @@ subroutine LVT_writeDataStreams LVT_rc%hr, LVT_rc%mn, LVT_rc%ss write(xtime_timeInc, fmt='(I20)') & LVT_rc%ts - + call LVT_verify(nf90_put_att(ftn_mean,xtimeID,& "units",trim(xtime_units))) call LVT_verify(nf90_put_att(ftn_mean,xtimeID,& @@ -1091,8 +1091,8 @@ subroutine LVT_writeDataStreams call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DX", & LVT_rc%gridDesc(9))) call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DY", & - LVT_rc%gridDesc(10))) - elseif(trim(LVT_rc%domain).eq."mercator") then + LVT_rc%gridDesc(10))) + elseif(trim(LVT_rc%domain).eq."mercator") then call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"MAP_PROJECTION", & "MERCATOR")) call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & @@ -1124,7 +1124,7 @@ subroutine LVT_writeDataStreams LVT_rc%gridDesc(8))) call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DY", & LVT_rc%gridDesc(9))) - + elseif(trim(LVT_rc%domain).eq."polar") then ! polar stereographic call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"MAP_PROJECTION", & "POLAR STEREOGRAPHIC")) @@ -1156,7 +1156,7 @@ subroutine LVT_writeDataStreams trim(xlat%short_name),& nf90_float,& dimids = dimID(1:2), varID=xlat_ss_ID)) -#if(defined USE_NETCDF4) +#if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_ssdev,& xlat_ss_ID,& shuffle,deflate,deflate_level)) @@ -1165,7 +1165,7 @@ subroutine LVT_writeDataStreams trim(xlon%short_name),& nf90_float,& dimids = dimID(1:2), varID=xlon_ss_ID)) -#if(defined USE_NETCDF4) +#if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_ssdev,& xlon_ss_ID,& shuffle,deflate,deflate_level)) @@ -1184,7 +1184,7 @@ subroutine LVT_writeDataStreams "missing_value",LVT_rc%udef)) call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& "_FillValue",LVT_rc%udef)) - + call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& "units",trim(xlon%units))) call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& @@ -1199,7 +1199,7 @@ subroutine LVT_writeDataStreams "missing_value",LVT_rc%udef)) call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& "_FillValue",LVT_rc%udef)) - + !define time field call LVT_verify(nf90_def_var(ftn_ssdev,'time',& nf90_float,dimids = tdimID,varID=xtime_ss_ID)) @@ -1213,7 +1213,7 @@ subroutine LVT_writeDataStreams LVT_rc%hr, LVT_rc%mn, LVT_rc%ss write(xtime_timeInc, fmt='(I20)') & LVT_rc%ts - + call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& "units",trim(xtime_units))) call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& @@ -1224,7 +1224,7 @@ subroutine LVT_writeDataStreams "begin_date",xtime_begin_date)) call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& "begin_time",xtime_begin_time)) - + call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"title", & "LVT land surface analysis output")) call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"institution", & @@ -1248,8 +1248,8 @@ subroutine LVT_writeDataStreams call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DX", & LVT_rc%gridDesc(9))) call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DY", & - LVT_rc%gridDesc(10))) - elseif(trim(LVT_rc%domain).eq."mercator") then + LVT_rc%gridDesc(10))) + elseif(trim(LVT_rc%domain).eq."mercator") then call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"MAP_PROJECTION", & "MERCATOR")) call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & @@ -1281,7 +1281,7 @@ subroutine LVT_writeDataStreams LVT_rc%gridDesc(8))) call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DY", & LVT_rc%gridDesc(9))) - + elseif(trim(LVT_rc%domain).eq."polar") then ! polar stereographic call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"MAP_PROJECTION", & "POLAR STEREOGRAPHIC")) @@ -1306,23 +1306,23 @@ subroutine LVT_writeDataStreams do while(associated(dataEntry)) !reset the pointers to the head of the linked list - if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then + if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then lisdataEntry => LVT_LISoutput(1)%head_lsm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Routing") then + elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Routing") then lisdataEntry => LVT_LISoutput(1)%head_routing_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."RTM") then + elseif(LVT_LIS_rc(1)%anlys_data_class.eq."RTM") then lisdataEntry => LVT_LISoutput(1)%head_rtm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Irrigation") then + elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Irrigation") then lisdataEntry => LVT_LISoutput(1)%head_irrig_list endif - do while(associated(lisdataEntry)) + do while(associated(lisdataEntry)) if(lisdataEntry%short_name.eq.dataEntry%short_name) then - - call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) - + + call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) + if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call defineNETCDFheaderVar_ss(ftn_ssdev,dimID, lisdataEntry) + call defineNETCDFheaderVar_ss(ftn_ssdev,dimID, lisdataEntry) end if endif @@ -1354,7 +1354,7 @@ subroutine LVT_writeDataStreams end if ! EMK FIXME...Replace HYCOM with NAVGEM - if(LVT_rc%processHYCOM.eq.1) then + if(LVT_rc%processHYCOM.eq.1) then ! First, handle water_temp call LVT_verify(nf90_def_var(ftn_mean,& @@ -1364,7 +1364,7 @@ subroutine LVT_writeDataStreams varID=LVT_histData%watertemp%varId_def),& 'nf90_def_var for '//& trim(LVT_histData%watertemp%short_name)//& - 'failed in defineNETCDFheadervar') + 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_mean,& @@ -1372,8 +1372,8 @@ subroutine LVT_writeDataStreams shuffle, deflate, deflate_level),& 'nf90_def_var_deflate for '//& trim(LVT_histData%watertemp%short_name)//& - 'failed in defineNETCDFheadervar') -#endif + 'failed in defineNETCDFheadervar') +#endif !EMK...Add variable attributes call LVT_verify(nf90_put_att(ftn_mean,& LVT_histData%watertemp%varId_def,& @@ -1414,15 +1414,15 @@ subroutine LVT_writeDataStreams varID=LVT_histData%aice%varId_def),& 'nf90_def_var for '//& trim(LVT_histData%aice%short_name)//& - 'failed in defineNETCDFheadervar') + 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_mean,& LVT_histData%aice%varId_def,& shuffle, deflate, deflate_level),& 'nf90_def_var_deflate for '//& trim(LVT_histData%aice%short_name)//& - 'failed in defineNETCDFheadervar') -#endif + 'failed in defineNETCDFheadervar') +#endif call LVT_verify(nf90_put_att(ftn_mean,& LVT_histData%aice%varId_def,& "units",& @@ -1462,15 +1462,15 @@ subroutine LVT_writeDataStreams varID=LVT_histData%hi%varId_def),& 'nf90_def_var for '//& trim(LVT_histData%hi%short_name)//& - 'failed in defineNETCDFheadervar') + 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_deflate(ftn_mean,& LVT_histData%hi%varId_def,& shuffle, deflate, deflate_level),& 'nf90_def_var_deflate for '//& trim(LVT_histData%hi%short_name)//& - 'failed in defineNETCDFheadervar') -#endif + 'failed in defineNETCDFheadervar') +#endif call LVT_verify(nf90_put_att(ftn_mean,& LVT_histData%hi%varId_def,& "units",& @@ -1652,23 +1652,23 @@ subroutine LVT_writeDataStreams do while(associated(dataEntry)) !reset the pointers to the head of the linked list - if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then + if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then lisdataEntry => LVT_LISoutput(1)%head_lsm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Routing") then + elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Routing") then lisdataEntry => LVT_LISoutput(1)%head_routing_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."RTM") then + elseif(LVT_LIS_rc(1)%anlys_data_class.eq."RTM") then lisdataEntry => LVT_LISoutput(1)%head_rtm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Irrigation") then + elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Irrigation") then lisdataEntry => LVT_LISoutput(1)%head_irrig_list endif - do while(associated(lisdataEntry)) + do while(associated(lisdataEntry)) if(lisdataEntry%short_name.eq.dataEntry%short_name) then ! Set timerange indicator equal to 133 for AFWA's specifications ! for surface runoff, baseflow, and total precipitation ! to make the LIS-7 output match the LIS-6 style. - dmm - + ! EMK...Revised settings based on name of variable if (index(trim(dataEntry%short_name),"_max") .gt. 0) then @@ -1702,12 +1702,12 @@ subroutine LVT_writeDataStreams (lisdataEntry%index.eq.LVT_LIS_MOC_QSB(1)).or. & (lisdataEntry%index.eq.LVT_LIS_MOC_TOTALPRECIP(1))) then ! EMK...GRIB1 only - if(LVT_rc%lvt_out_format.ne."grib2") then + if(LVT_rc%lvt_out_format.ne."grib2") then timeRange = 133 end if endif - !EMK...Special handling for RHMin, which is an extreme + !EMK...Special handling for RHMin, which is an extreme ! (minimum) value. if (trim(dataEntry%short_name) == "RHMin") then stepType = "min" @@ -1809,7 +1809,7 @@ subroutine LVT_writeDataStreams if(LVT_domain%gindex(c,r).ne.-1) then gid = LVT_domain%gindex(c,r) gtmp1_1d_mem(c+(r-1)*LVT_rc%lnc) = & - dataEntry%value(gid,m,k) + dataEntry%value(gid,m,k) endif enddo ! c enddo ! r @@ -1819,13 +1819,13 @@ subroutine LVT_writeDataStreams ! smoothing. The original exception list did not ! consider forcing perturbations. It seams best ! to just trust the setting in the lvt.config file. - ! EMK...Restored exception list for categorical + ! EMK...Restored exception list for categorical ! variables, since smoothing makes no physical sense if (.not. ( & (dataEntry%short_name .eq. "Landcover") .or. & (dataEntry%short_name .eq. "Landmask") .or. & (dataEntry%short_name .eq. "Soiltype"))) then - if(LVT_rc%applyNoiseReductionFilter.eq.1) then + if(LVT_rc%applyNoiseReductionFilter.eq.1) then call applyNoiseReductionFilter(gtmp1_1d_mem) end if end if @@ -1834,7 +1834,7 @@ subroutine LVT_writeDataStreams ! spread do r=1,LVT_rc%lnr do c=1,LVT_rc%lnc - if(LVT_domain%gindex(c,r).ne.-1) then + if(LVT_domain%gindex(c,r).ne.-1) then gid = LVT_domain%gindex(c,r) if (LVT_rc%nensem > 1) then @@ -1893,7 +1893,7 @@ subroutine LVT_writeDataStreams enddo ! r ! EMK END...k loop ends further down - if(LVT_rc%lvt_out_format.eq."grib2") then + if(LVT_rc%lvt_out_format.eq."grib2") then call writeSingleGrib2Var(ftn_mean,& gtmp1_1d,& @@ -1942,7 +1942,7 @@ subroutine LVT_writeDataStreams typeOfProcessedData=4) end if - elseif(LVT_rc%lvt_out_format.eq."grib1") then + elseif(LVT_rc%lvt_out_format.eq."grib1") then call writeSingleGrib1Var(ftn_mean,& gtmp1_1d,& lisdataentry%varid_def,& @@ -1978,7 +1978,7 @@ subroutine LVT_writeDataStreams botlev(k:k)) end if - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif(LVT_rc%lvt_out_format.eq."netcdf") then call writeSingleNetcdfVar(ftn_mean,& gtmp1_1d,& lisdataentry%varid_def,& @@ -1992,7 +1992,7 @@ subroutine LVT_writeDataStreams k) end if endif - + enddo ! k exit endif @@ -2015,7 +2015,7 @@ subroutine LVT_writeDataStreams toplev(1),& botlev(1),& lat,lon) - call LVT_append_navgem_sst_field(ftn_mean, & + call LVT_append_navgem_sst_field(ftn_mean, & time_unit, & time_past, & time_curr, & @@ -2023,19 +2023,19 @@ subroutine LVT_writeDataStreams toplev(1), & botlev(1)) - if(LVT_rc%lvt_out_format.eq."grib1") then + if(LVT_rc%lvt_out_format.eq."grib1") then call grib_close_file(ftn_mean,iret) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call grib_close_file(ftn_ssdev,iret) end if - elseif(LVT_rc%lvt_out_format.eq."grib2") then + elseif(LVT_rc%lvt_out_format.eq."grib2") then call grib_close_file(ftn_mean,iret) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call grib_close_file(ftn_ssdev,iret) end if - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif(LVT_rc%lvt_out_format.eq."netcdf") then call LVT_verify(nf90_close(ftn_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then @@ -2046,12 +2046,12 @@ subroutine LVT_writeDataStreams end subroutine LVT_writeDataStreams - ! EMK...Return logical indicating if alarm should ring. + ! EMK...Return logical indicating if alarm should ring. ! Used by "557 post" runmode. logical function alarm_is_on() result(alarmCheck) use LVT_timeMgrMod, only : LVT_get_julhr implicit none - + logical, save :: firstTime = .true. integer, save :: starttime = 0 integer :: curtime @@ -2971,64 +2971,64 @@ end subroutine LVT_append_HYCOM_cice_fields subroutine applyNoiseReductionFilter(gvar) - + real :: gvar(LVT_rc%lnc*LVT_rc%lnr) real :: gtmp(LVT_rc%lnc*LVT_rc%lnr) - + integer :: c,r, c1,r1,c_s, c_e, r_s, r_e real :: avg_val real :: navg_val real :: sigma,wt gtmp = LVT_rc%udef - - if(LVT_rc%smoothingFilterType.eq."box filter") then + + if(LVT_rc%smoothingFilterType.eq."box filter") then do r=1,LVT_rc%lnr do c=1,LVT_rc%lnc - + c_s = max(1,c-2) c_e = min(LVT_rc%lnc,c+2) r_s = max(1,r-2) r_e = min(LVT_rc%lnr,r+2) - + avg_val = 0.0 navg_val = 0 do c1=c_s, c_e do r1=r_s,r_e - if(gvar(c1+(r1-1)*LVT_rc%lnc).ne.LVT_rc%udef) then + if(gvar(c1+(r1-1)*LVT_rc%lnc).ne.LVT_rc%udef) then avg_val = avg_val + gvar(c1+(r1-1)*LVT_rc%lnc) navg_val = navg_val + 1 endif enddo enddo - if(navg_val.gt.0) then + if(navg_val.gt.0) then avg_val = avg_val/navg_val else avg_val = LVT_rc%udef endif - + gtmp(c+(r-1)*LVT_rc%lnc) = avg_val - + enddo enddo - - elseif(LVT_rc%smoothingFilterType.eq."gaussian filter") then + + elseif(LVT_rc%smoothingFilterType.eq."gaussian filter") then sigma = 1.0 do r=1,LVT_rc%lnr do c=1,LVT_rc%lnc - + c_s = max(1,c-2) c_e = min(LVT_rc%lnc,c+2) r_s = max(1,r-2) r_e = min(LVT_rc%lnr,r+2) - + avg_val = 0.0 navg_val = 0 do c1=c_s, c_e do r1=r_s,r_e - if(gvar(c1+(r1-1)*LVT_rc%lnc).ne.LVT_rc%udef) then + if(gvar(c1+(r1-1)*LVT_rc%lnc).ne.LVT_rc%udef) then wt = exp(-((c1-c)**2+(r1-r)**2)/(2*sigma**2))/& (2*LVT_CONST_PI*sigma**2) avg_val = avg_val + wt*gvar(c1+(r1-1)*LVT_rc%lnc) @@ -3036,8 +3036,8 @@ subroutine applyNoiseReductionFilter(gvar) endif enddo enddo - if(navg_val.gt.0) then - if(gvar(c+(r-1)*LVT_rc%lnc).ne.LVT_rc%udef) then + if(navg_val.gt.0) then + if(gvar(c+(r-1)*LVT_rc%lnc).ne.LVT_rc%udef) then avg_val = avg_val/navg_val else avg_val = LVT_rc%udef @@ -3045,11 +3045,11 @@ subroutine applyNoiseReductionFilter(gvar) else avg_val = LVT_rc%udef endif - + gtmp(c+(r-1)*LVT_rc%lnc) = avg_val - + enddo - enddo + enddo endif @@ -3057,20 +3057,20 @@ subroutine applyNoiseReductionFilter(gvar) end subroutine applyNoiseReductionFilter !BOP -! +! ! !ROUTINE: writeSingleGrib1Var ! \label{writeSingleGrib1Var} ! -! !INTERFACE: +! !INTERFACE: subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& sType, time_unit, time_p1, time_p2, & timeRange,k,toplev,botlev) ! -! !DESCRIPTION: +! !DESCRIPTION: ! This subroutine writes a single variable to a grib file -! +! !EOP - + integer :: ftn real :: gtmp(LVT_rc%lnc*LVT_rc%lnr) integer, intent(in) :: gribid @@ -3085,7 +3085,7 @@ subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& integer, intent(in) :: k real :: toplev(1) real :: botlev(1) - + character*8 :: date integer :: yr1, mo1,da1,hr1,mn1 @@ -3098,7 +3098,7 @@ subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Note passing string of defined points only to output ! because bitmap in GRIB-1 file will fill in the rest - + #if (defined USE_ECCODES) call grib_new_from_samples(igrib,"GRIB1",iret) @@ -3107,78 +3107,78 @@ subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call grib_new_from_template(igrib,"GRIB1",iret) call LVT_verify(iret, 'grib_new_from_template failed in LVT_DataStreamsMod') #endif - + call grib_set(igrib,'table2Version',LVT_rc%grib_table,iret) call LVT_verify(iret,'grib_set:table2version failed in LVT_DataStreamsMod') - + call grib_set(igrib,'generatingProcessIdentifier',LVT_rc%grib_process_id,iret) call LVT_verify(iret,'grib_set:generatingProcessIdentifier failed in LVT_DataStreamsMod') - + call grib_set(igrib,'gridDefinition',LVT_rc%grib_grid_id,iret) call LVT_verify(iret,'grib_set:grid ID failed in LVT_DataStreamsMod') - + call grib_set(igrib,'indicatorOfParameter',gribid, iret) call LVT_verify(iret,'grib_set:indicatorOfParameter failed in LVT_DataStreamsMod') - + ! call grib_set(igrib,'paramId',gribid, iret) ! call LVT_verify(iret,'grib_set:paramId failed in LVT_DataStreamsMod') - + call grib_set(igrib,'indicatorOfTypeOfLevel',gribSfc, iret) call LVT_verify(iret,'grib_set:indicatorOfTypeOfLevel failed in LVT_DataStreamsMod') - + call grib_set(igrib,'level',gribLvl, iret) call LVT_verify(iret,'grib_set:level failed in LVT_DataStreamsMod') - + call grib_set(igrib,'topLevel',toplev(1), iret) call LVT_verify(iret,'grib_set:topLevel failed in LVT_DataStreamsMod') - + call grib_set(igrib,'bottomLevel',botlev(1), iret) call LVT_verify(iret,'grib_set:bottomLevel failed in LVT_DataStreamsMod') - + call grib_set(igrib,'stepType',sType, iret) call LVT_verify(iret,'grib_set:stepType failed in LVT_DataStreamsMod') - + call grib_set(igrib,'stepUnits',time_unit, iret) call LVT_verify(iret,'grib_set:stepUnits failed in LVT_DataStreamsMod') call grib_set(igrib,'startStep',time_p1, iret) call LVT_verify(iret,'grib_set:startStep failed in LVT_DataStreamsMod') - + call grib_set(igrib,'endStep',time_p2, iret) call LVT_verify(iret,'grib_set:endStep failed in LVT_DataStreamsMod') - + call grib_set(igrib,'timeRangeIndicator',timeRange, iret) call LVT_verify(iret,'grib_set:timeRangeIndicator failed in LVT_DataStreamsMod') - + call grib_set(igrib,'swapScanningLat',1, iret) call LVT_verify(iret,'grib_set:swapScanningLat failed in LVT_DataStreamsMod') - + call grib_set(igrib,'Ni',LVT_rc%gnc,iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') - + call grib_set(igrib,'Nj',LVT_rc%gnr,iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') - + call ij_to_latlon(LVT_domain%lvtproj,float(LVT_rc%gnc),& - float(LVT_rc%gnr),lat_ur,lon_ur) + float(LVT_rc%gnr),lat_ur,lon_ur) call ij_to_latlon(LVT_domain%lvtproj,1.0, 1.0, & - lat_ll,lon_ll) - + lat_ll,lon_ll) + call grib_set(igrib, 'latitudeOfFirstGridPointInDegrees',lat_ll,iret) call LVT_verify(iret, 'grib_set:latitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'longitudeOfFirstGridPointInDegrees',lon_ll,iret) call LVT_verify(iret, 'grib_set:longitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'latitudeOfLastGridPointInDegrees',lat_ur,iret) call LVT_verify(iret, 'grib_set:latitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'longitudeOfLastGridPointInDegrees',lon_ur,iret) call LVT_verify(iret, 'grib_set:longitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'missingValue',LVT_rc%udef,iret) call LVT_verify(iret, 'grib_set:missingValue failed in LVT_DataStreamsMod') - + ! Should not need to fix the "num bits" value for each parameter ! if the "decimalPrecision" (aka, "DecScale") is set properly. - dmm ! call grib_set(igrib, 'bitsPerValue',12,iret) @@ -3194,64 +3194,64 @@ subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& enddo call grib_set(igrib, 'decimalPrecision',decimalPrecision,iret) call LVT_verify(iret, 'grib_set:decimalPrecision failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'bitmapPresent',1,iret) call LVT_verify(iret, 'grib_set:bitmapPresent failed in LVT_DataStreamsMod') - - if (LVT_rc%domain.eq."latlon") then + + if (LVT_rc%domain.eq."latlon") then call grib_set(igrib,'gridType','regular_ll',iret) call LVT_verify(iret,'grib_set: gridType failed in LVT_DataStreamsMod') - + call grib_set(igrib,'iDirectionIncrementInDegrees',LVT_rc%gridDesc(9),iret) call LVT_verify(iret,'grib_set:iDirectionIncrementInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib,'jDirectionIncrementInDegrees',LVT_rc%gridDesc(10),iret) call LVT_verify(iret,'grib_set:jDirectionIncrementInDegrees failed in LVT_DataStreamsMod') - + else !Unsupported Map Projection for GRIB output - + message(1)='program: LVT_DataStreamsMod' message(2)=' subroutine: writevar_grib1_withstats_real' message(3)=' Unsupported map projection for GRIB1 output!' call lvt_abort(message) stop - + endif - + da1=LVT_rc%da mo1=LVT_rc%mo yr1=LVT_rc%yr - + write(unit=date,fmt='(i4.4,i2.2,i2.2)') yr1,mo1,da1 read(date,'(I8)') idate - + call grib_set(igrib,'dataDate',idate,iret) call LVT_verify(iret, 'grib_set:dataDate failed in LVT_DataStreamsMod') - + hr1=LVT_rc%hr mn1=LVT_rc%mn - + write(unit=date,fmt='(i2.2,i2.2)') hr1,mn1 read(date,'(I4)') idate1 - + call grib_set(igrib,'dataTime',idate1,iret) call LVT_verify(iret, 'grib_set:dataTime failed in LVT_DataStreamsMod') - + call grib_set(igrib,'values',gtmp,iret) call LVT_verify(iret, 'grib_set:values failed in LVT_DataStreamsMod') - + ! Move setting of centre and subCentre to the end of the settings. ! The order these are written is important and will affect output. - dmm call grib_set(igrib,'centre',LVT_rc%grib_center_id,iret) call LVT_verify(iret,'grib_set:centre failed in LVT_DataStreamsMod') - + call grib_set(igrib,'subCentre',LVT_rc%grib_subcenter_id,iret) call LVT_verify(iret,'grib_set:subCentre failed in LVT_DataStreamsMod') - + call grib_write(igrib,ftn,iret) call LVT_verify(iret, 'grib_write failed in LVT_DataStreamsMod') - + call grib_release(igrib,iret) call LVT_verify(iret,'grib_release failed in LVT_DataStreamsMod') @@ -3259,11 +3259,11 @@ subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& end subroutine writeSingleGrib1Var !BOP -! +! ! !ROUTINE: writeSingleGrib2Var ! \label{writeSingleGrib2Var} ! -! !INTERFACE: +! !INTERFACE: subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& gribDis, gribCat, pdTemplate, & sType, time_unit, time_p1, time_p2, & @@ -3272,10 +3272,10 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& typeOfProcessedData, & ref_year,ref_month,ref_day,ref_hour,ref_fcst_hr) ! -! !DESCRIPTION: -! This subroutine writes a single variable to a grib2 file based on -! the implementation by Hiroko Kato within LIS. -! +! !DESCRIPTION: +! This subroutine writes a single variable to a grib2 file based on +! the implementation by Hiroko Kato within LIS. +! ! !EOP @@ -3343,7 +3343,7 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Note passing string of defined points only to output ! because bitmap in GRIB-1 file will fill in the rest - + #if (defined USE_ECCODES) call grib_new_from_samples(igrib,"GRIB2",iret) call LVT_verify(iret, 'grib_new_from_samples failed in LVT_DataStreamsMod') @@ -3352,7 +3352,7 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call LVT_verify(iret, 'grib_new_from_template failed in LVT_DataStreamsMod') #endif - ! Section 0: Indicator + ! Section 0: Indicator ! Octet 7 call grib_set(igrib, 'discipline', gribDis, iret) call LVT_verify(iret, 'grib_set: discipline failed in LVT_DataStreamsMod') @@ -3384,7 +3384,7 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call LVT_verify(iret, & 'grib_set:significanceOfReferenceTime failed in LVT_DataStreamsMod') end if - + if (present(ref_year) .and. present(ref_month) .and. present(ref_day) & .and. present(ref_hour)) then yr1 = ref_year @@ -3393,11 +3393,11 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& hr1 = ref_hour mn1 = 0 else - yr1=LVT_rc%syr + yr1=LVT_rc%syr mo1=LVT_rc%smo da1=LVT_rc%sda hr1=LVT_rc%shr - mn1=LVT_rc%smn + mn1=LVT_rc%smn end if ! Octets 13-16 @@ -3405,10 +3405,10 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& read(date,'(I8)') idate call grib_set(igrib,'dataDate',idate,iret) call LVT_verify(iret, 'grib_set:dataDate failed in LVT_DataStreamsMod') - + ! Octets 17-19 write(unit=date,fmt='(i2.2,i2.2)') hr1,mn1 - read(date,'(I4)') idate1 + read(date,'(I4)') idate1 call grib_set(igrib,'dataTime',idate1,iret) call LVT_verify(iret, 'grib_set:dataTime failed in LVT_DataStreamsMod') @@ -3434,56 +3434,56 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call LVT_verify(iret, & 'grib_set:gridDefinitionTemplateNumber failed in LVT_DataStreamsMod') - ! Hard-coded: shape of the Earth 0=radius = 6,367,470.0 m; 3.2.table + ! Hard-coded: shape of the Earth 0=radius = 6,367,470.0 m; 3.2.table call grib_set(igrib,'shapeOfTheEarth',0,iret) call LVT_verify(iret, & 'grib_set:shapeOfTheEarth failed in LVT_DataStreamsMod') - + call grib_set(igrib,'swapScanningLat',1, iret) call LVT_verify(iret,& 'grib_set:swapScanningLat failed in LVT_DataStreamsMod') call grib_set(igrib,'Ni',LVT_rc%gnc,iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') - + call grib_set(igrib,'Nj',LVT_rc%gnr,iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') call ij_to_latlon(LVT_domain%lvtproj,float(LVT_rc%gnc),& - float(LVT_rc%gnr),lat_ur,lon_ur) + float(LVT_rc%gnr),lat_ur,lon_ur) call ij_to_latlon(LVT_domain%lvtproj,1.0, 1.0, & - lat_ll,lon_ll) - + lat_ll,lon_ll) + call grib_set(igrib, 'latitudeOfFirstGridPointInDegrees',lat_ll,iret) call LVT_verify(iret, 'grib_set:latitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'longitudeOfFirstGridPointInDegrees',lon_ll,iret) call LVT_verify(iret, 'grib_set:longitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'latitudeOfLastGridPointInDegrees',lat_ur,iret) call LVT_verify(iret, 'grib_set:latitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib, 'longitudeOfLastGridPointInDegrees',lon_ur,iret) call LVT_verify(iret, 'grib_set:longitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') - if (LVT_rc%domain.eq."latlon") then + if (LVT_rc%domain.eq."latlon") then call grib_set(igrib,'gridType','regular_ll',iret) call LVT_verify(iret,'grib_set: gridType failed in LVT_DataStreamsMod') - + call grib_set(igrib,'iDirectionIncrementInDegrees',LVT_rc%gridDesc(9),iret) call LVT_verify(iret,'grib_set:iDirectionIncrementInDegrees failed in LVT_DataStreamsMod') - + call grib_set(igrib,'jDirectionIncrementInDegrees',LVT_rc%gridDesc(10),iret) call LVT_verify(iret,'grib_set:jDirectionIncrementInDegrees failed in LVT_DataStreamsMod') - + else !Unsupported Map Projection for GRIB output - + message(1)='program: LVT_DataStreamsMod' message(2)=' subroutine: writevar_grib1_withstats_real' message(3)=' Unsupported map projection for GRIB1 output!' call lvt_abort(message) stop - + endif ! Section 4: Product Definition Section @@ -3491,7 +3491,7 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Octets 8-9 call grib_set(igrib,'productDefinitionTemplateNumber',pdTemplate, iret) call LVT_verify(iret,'grib_set:productDefinitionTemplateNumber failed in LVT_DataStreamsMod') - + if (pdTemplate .ne. 0 .and. & pdTemplate .ne. 2 .and. & pdTemplate .ne. 12) then @@ -3512,7 +3512,7 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& 'grib_set:parameterNumber failed in LVT_DataStreamsMod') ! Octet 12 call grib_set(igrib,'typeOfGeneratingProcess', & - typeOfGeneratingProcess_local, iret) + typeOfGeneratingProcess_local, iret) call LVT_verify(iret, & 'grib_set:typeOfGeneratingProcess failed in LVT_DataStreamsMod') ! Octet 13 @@ -3529,8 +3529,8 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Octet 18...Use hours call grib_set(igrib,'indicatorOfUnitOfTimeRange',1, iret) - call LVT_verify(iret,'grib_set:indicatorOfUnitOfTimeRange failed in LVT_DataStreamsMod') - + call LVT_verify(iret,'grib_set:indicatorOfUnitOfTimeRange failed in LVT_DataStreamsMod') + ! Octets 19-22...Forecast time is in hours. Must calculate. ! For analyses, forecast time is always zero. ! In the case of PDT 4.12, the forecast time is for the start of @@ -3568,8 +3568,8 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call grib_set(igrib,'forecastTime',hr1,iret) call LVT_verify(iret,& 'grib_set:forecast_time failed in LVT_DataStreamsMod') - - ! Octets 23-34. Varies by type of level/layer. + + ! Octets 23-34. Varies by type of level/layer. call grib_set(igrib,'typeOfFirstFixedSurface',gribSfc, iret) call LVT_verify(iret,& 'grib_set:typeOfFirstFixedSurface failed in LVT_DataStreamsMod') @@ -3584,7 +3584,7 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call grib_set(igrib,'scaleFactorOfFirstFixedSurface',depscale(1), & iret) call LVT_verify(iret,& - 'grib_set:scaleFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') + 'grib_set:scaleFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') call grib_set(igrib,'scaledValueOfFirstFixedSurface',toplev(1), iret) call LVT_verify(iret,& 'grib_set:scaledValueOfFirstFixedSurface failed in LVT_DataStreamsMod') @@ -3604,19 +3604,19 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call grib_set(igrib,'scaleFactorOfFirstFixedSurface',0, iret) call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') call grib_set(igrib,'scaledValueOfFirstFixedSurface',toplev(1), iret) - call LVT_verify(iret,'grib_set:scaledValueOfFirstFixedSurface failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:scaledValueOfFirstFixedSurface failed in LVT_DataStreamsMod') call grib_set(igrib,'scaleFactorOfSecondFixedSurface',255, iret) call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') call grib_set(igrib,'scaledValueOfSecondFixedSurface',255, iret) call LVT_verify(iret,'grib_set:scaledValueOfSecondFixedSurface failed in LVT_DataStreamsMod') - + else if ( gribSfc .eq. 103 ) then ! EMK...Meters AGL call grib_set(igrib,'scaleFactorOfFirstFixedSurface',depscale(1), iret) - call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') call grib_set(igrib,'level',gribLvl, iret) - call LVT_verify(iret,'grib_set:level failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:level failed in LVT_DataStreamsMod') else ! 114 (snow level) or old 112 ?? write(LVT_logunit,*) 'Warning: special surface type !! '//& 'verify scale/depth for ',gribSfc @@ -3628,26 +3628,26 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') call grib_set(igrib,'scaledValueOfFirstFixedSurface',toplev(1), iret) call LVT_verify(iret,'grib_set:scaledValueOfFirstFixedSurface failed in LVT_DataStreamsMod') - + call grib_set(igrib,'scaleFactorOfSecondFixedSurface',0, iret) call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') call grib_set(igrib,'scaledValueOfSecondFixedSurface',botlev(1), iret) call LVT_verify(iret,'grib_set:scaledValueOfSecondFixedSurface failed in LVT_DataStreamsMod') endif - + end if ! Common settings for Product Definition Templates 4.2 and 4.12, but not - ! 4.0 + ! 4.0 if (pdTemplate == 2 .or. pdTemplate == 12) then ! Octet 35 if (ensembleSpread_local) then call grib_set(igrib,'derivedForecast',4, iret) - call LVT_verify(iret,'grib_set:derivedForecast failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:derivedForecast failed in LVT_DataStreamsMod') else call grib_set(igrib,'derivedForecast',0, iret) - call LVT_verify(iret,'grib_set:derivedForecast failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:derivedForecast failed in LVT_DataStreamsMod') end if ! Octet 36. @@ -3660,32 +3660,32 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& if (pdTemplate == 12) then ! Octet 37-38 call grib_set(igrib,'yearOfEndOfOverallTimeInterval',LVT_rc%yr, iret) - call LVT_verify(iret,'grib_set:yearOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:yearOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') ! Octet 39 call grib_set(igrib,'monthOfEndOfOverallTimeInterval',LVT_rc%mo, iret) - call LVT_verify(iret,'grib_set:monthOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:monthOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') ! Octet 40 call grib_set(igrib,'dayOfEndOfOverallTimeInterval',LVT_rc%da, iret) - call LVT_verify(iret,'grib_set:dayOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:dayOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') ! Octet 41 call grib_set(igrib,'hourOfEndOfOverallTimeInterval',LVT_rc%hr, iret) - call LVT_verify(iret,'grib_set:hourOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:hourOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') ! Octet 42 call grib_set(igrib,'minuteOfEndOfOverallTimeInterval',LVT_rc%mn, iret) - call LVT_verify(iret,'grib_set:minuteOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:minuteOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') ! Octet 43 call grib_set(igrib,'secondOfEndOfOverallTimeInterval',LVT_rc%ss, iret) - call LVT_verify(iret,'grib_set:secondOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call LVT_verify(iret,'grib_set:secondOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') ! Octet 49 - if(trim(sType).eq."avg") then + if(trim(sType).eq."avg") then sType_int = 0 - elseif(trim(sType).eq."accum") then + elseif(trim(sType).eq."accum") then sType_int = 1 else if (trim(sType).eq."max") then sType_int = 2 @@ -3696,11 +3696,11 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call LVT_verify(iret,'grib_set:typeOfStatisticalProcessing failed in LVT_DataStreamsMod') ! Octet 50 - ! Use 2 -- Successive times processed have same start time of - ! forecast, forecast time is incremented. - call grib_set(igrib,'typeOfTimeIncrement',2, iret) + ! Use 2 -- Successive times processed have same start time of + ! forecast, forecast time is incremented. + call grib_set(igrib,'typeOfTimeIncrement',2, iret) call LVT_verify(iret,'grib_set:typeOfTimeIncrement failed in LVT_DataStreamsMod') - + ! Octet 51...Use hours call grib_set(igrib,'indicatorOfUnitForTimeRange',1, iret) ! Hour call LVT_verify(iret,'grib_set:indicatorOfUnitForTimeRange failed in LVT_DataStreamsMod') @@ -3709,32 +3709,32 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& call ESMF_TimeIntervalGet(timeinterval12, h=hr1, rc=iret) call LVT_verify(iret,& 'ESMF_TimeIntervalGet:timeinterval12 failed in LVT_DataStreamsMod') - call grib_set(igrib,'lengthOfTimeRange',hr1, iret) + call grib_set(igrib,'lengthOfTimeRange',hr1, iret) call LVT_verify(iret,'grib_set:lengthOfTimeRange failed in LVT_DataStreamsMod') ! Octet 56...Use minutes call grib_set(igrib,'indicatorOfUnitForTimeIncrement',0, iret) ! Minutes call LVT_verify(iret,'grib_set:indicatorOfUnitForTimeIncrement failed in LVT_DataStreamsMod') - ! Octet 57-60...Time increment. This should be the LIS time step in + ! Octet 57-60...Time increment. This should be the LIS time step in ! minutes call grib_set(igrib,'timeIncrement',LVT_rc%lis_ts/60, iret) call LVT_verify(iret,'grib_set:timeIncrement failed in LVT_DataStreamsMod') - + end if ! PDT 4.12 - + ! Section 5: Data Representation call grib_set(igrib,'packingType',LVT_rc%grib_packing_type,iret) call LVT_verify(iret, 'grib_set:packingType failed in LVT_DataStreamsMod') call grib_set(igrib, 'missingValue',LVT_rc%udef,iret) call LVT_verify(iret, 'grib_set:missingValue failed in LVT_DataStreamsMod') - + ! Should not need to fix the "num bits" value for each parameter ! if the "decimalPrecision" (aka, "DecScale") is set properly. - dmm ! call grib_set(igrib, 'bitsPerValue',12,iret) ! call LVT_verify(iret, 'grib_set:bitsPerValue failed in LVT_DataStreamsMod') - + ! Set the "decimalPrecision" (aka, "DecScale") based on the ! gribSF (grib scale factor) set in the MODEL OUTPUT TBL. - dmm gribSFtemp = gribSF @@ -3745,17 +3745,17 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& enddo call grib_set(igrib, 'decimalPrecision',decimalPrecision,iret) call LVT_verify(iret, 'grib_set:decimalPrecision failed in LVT_DataStreamsMod') - - ! Section 6: Bit-Map + + ! Section 6: Bit-Map call grib_set(igrib, 'bitmapPresent',1,iret) call LVT_verify(iret, 'grib_set:bitmapPresent failed in LVT_DataStreamsMod') - + call grib_set(igrib,'values',gtmp,iret) call LVT_verify(iret, 'grib_set:values failed in LVT_DataStreamsMod') - + call grib_write(igrib,ftn,iret) call LVT_verify(iret, 'grib_write failed in LVT_DataStreamsMod') - + call grib_release(igrib,iret) call LVT_verify(iret,'grib_release failed in LVT_DataStreamsMod') @@ -3764,21 +3764,21 @@ end subroutine writeSingleGrib2Var !BOP ! !ROUTINE: defineNETCDFheaderVar ! \label{defineNETCDFheaderVar} -! -! !INTERFACE: - subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) +! +! !INTERFACE: + subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) -! !USES: +! !USES: -! !ARGUMENTS: +! !ARGUMENTS: integer :: ftn type(LVT_lismetadataEntry), pointer :: dataEntry integer :: dimID(4) -! -! !DESCRIPTION: +! +! !DESCRIPTION: ! This routine writes the required NETCDF header for a single variable -! -! The arguments are: +! +! The arguments are: ! \begin{description} ! \item[n] ! index of the nest @@ -3787,14 +3787,14 @@ subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) ! \item[dimID] ! NETCDF dimension ID corresponding to the variable ! \item[dataEntry] -! object containing the values and attributes of the variable to be +! object containing the values and attributes of the variable to be ! written ! \end{description} ! -! The routines invoked are: +! The routines invoked are: ! \begin{description} ! \item[LIS\_endrun](\ref{LIS_endrun}) -! call to abort program when a fatal error is detected. +! call to abort program when a fatal error is detected. ! \item[LIS\_verify](\ref{LVT_verify}) ! call to check if the return value is valid or not. ! \end{description} @@ -3814,8 +3814,8 @@ subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) deflate = NETCDF_deflate deflate_level =NETCDF_deflate_level - if(dataEntry%selectOpt.eq.1)then - if(dataEntry%vlevels.gt.1) then + if(dataEntry%selectOpt.eq.1)then + if(dataEntry%vlevels.gt.1) then call LVT_verify(nf90_def_dim(ftn,& trim(dataEntry%short_name)//'_profiles',& dataEntry%vlevels, dimID(3)),& @@ -3840,7 +3840,7 @@ subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) call LVT_endrun() end if - if(dataEntry%vlevels.gt.1) then + if(dataEntry%vlevels.gt.1) then call LVT_verify(nf90_def_var(ftn,trim(short_name),& nf90_float,& dimids = dimID(1:3), varID=dataEntry%varId_def),& @@ -3851,34 +3851,34 @@ subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) dataEntry%varId_def, & 1,fill_value), 'nf90_def_var_fill failed for '//& dataEntry%short_name) - + call LVT_verify(nf90_def_var_deflate(ftn,& dataEntry%varId_def,& shuffle, deflate, deflate_level),& 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& - 'failed in defineNETCDFheadervar') + 'failed in defineNETCDFheadervar') #endif else call LVT_verify(nf90_def_var(ftn,trim(short_name),& nf90_float,& dimids = dimID(1:2), varID=dataEntry%varId_def),& 'nf90_def_var for '//trim(short_name)//& - 'failed in defineNETCDFheadervar') + 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_fill(ftn,& dataEntry%varId_def, & 1,fill_value), 'nf90_def_var_fill failed for '//& - dataEntry%short_name) - + dataEntry%short_name) + call LVT_verify(nf90_def_var_deflate(ftn,& dataEntry%varId_def,& shuffle, deflate, deflate_level),& 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& - 'failed in defineNETCDFheadervar') -#endif + 'failed in defineNETCDFheadervar') +#endif endif - + call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& "units",trim(dataEntry%units)),& 'nf90_put_att for units failed in defineNETCDFheaderVar') @@ -3915,21 +3915,21 @@ end subroutine defineNETCDFheaderVar !BOP ! !ROUTINE: defineNETCDFheaderVar_SS ! \label{defineNETCDFheaderVar_SS} -! -! !INTERFACE: - subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) +! +! !INTERFACE: + subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) -! !USES: +! !USES: -! !ARGUMENTS: +! !ARGUMENTS: integer :: ftn type(LVT_lismetadataEntry), pointer :: dataEntry integer :: dimID(4) -! -! !DESCRIPTION: +! +! !DESCRIPTION: ! This routine writes the required NETCDF header for a single variable -! -! The arguments are: +! +! The arguments are: ! \begin{description} ! \item[n] ! index of the nest @@ -3938,14 +3938,14 @@ subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) ! \item[dimID] ! NETCDF dimension ID corresponding to the variable ! \item[dataEntry] -! object containing the values and attributes of the variable to be +! object containing the values and attributes of the variable to be ! written ! \end{description} ! -! The routines invoked are: +! The routines invoked are: ! \begin{description} ! \item[LIS\_endrun](\ref{LIS_endrun}) -! call to abort program when a fatal error is detected. +! call to abort program when a fatal error is detected. ! \item[LIS\_verify](\ref{LVT_verify}) ! call to check if the return value is valid or not. ! \end{description} @@ -3965,8 +3965,8 @@ subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) deflate = NETCDF_deflate deflate_level =NETCDF_deflate_level - if(dataEntry%selectOpt.eq.1)then - if(dataEntry%vlevels.gt.1) then + if(dataEntry%selectOpt.eq.1)then + if(dataEntry%vlevels.gt.1) then call LVT_verify(nf90_def_dim(ftn,& trim(dataEntry%short_name)//'_profiles',& dataEntry%vlevels, dimID(3)),& @@ -3991,7 +3991,7 @@ subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) call LVT_endrun() end if - if(dataEntry%vlevels.gt.1) then + if(dataEntry%vlevels.gt.1) then call LVT_verify(nf90_def_var(ftn,trim(short_name),& nf90_float,& dimids = dimID(1:3), varID=dataEntry%varid_ss),& @@ -4002,33 +4002,33 @@ subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) dataEntry%varid_ss, & 1,fill_value), 'nf90_def_var_fill failed for '//& dataEntry%short_name) - + call LVT_verify(nf90_def_var_deflate(ftn,& dataEntry%varid_ss,& shuffle, deflate, deflate_level),& 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& - 'failed in defineNETCDFheadervar') + 'failed in defineNETCDFheadervar') #endif else call LVT_verify(nf90_def_var(ftn,trim(short_name),& nf90_float,& dimids = dimID(1:2), varID=dataEntry%varid_ss),& 'nf90_def_var for '//trim(dataEntry%short_name)//& - 'failed in defineNETCDFheadervar') + 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) call LVT_verify(nf90_def_var_fill(ftn,& dataEntry%varid_ss, & 1,fill_value), 'nf90_def_var_fill failed for '//& - dataEntry%short_name) - + dataEntry%short_name) + call LVT_verify(nf90_def_var_deflate(ftn,& dataEntry%varid_ss,& shuffle, deflate, deflate_level),& 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& - 'failed in defineNETCDFheadervar') -#endif + 'failed in defineNETCDFheadervar') +#endif endif - + call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& "units",trim(dataEntry%units)),& 'nf90_put_att for units failed in defineNETCDFheaderVar') @@ -4062,19 +4062,19 @@ subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) end subroutine defineNETCDFheaderVar_SS !BOP -! +! ! !ROUTINE: writeSingleNetcdfVar ! \label{writeSingleNetcdfVar} ! -! !INTERFACE: +! !INTERFACE: subroutine writeSingleNetcdfVar(ftn,gtmp,varID,k) ! -! !DESCRIPTION: +! !DESCRIPTION: ! This subroutine writes a single variable to a grib file -! +! !EOP -! !ARGUMENTS: +! !ARGUMENTS: integer :: ftn real :: gtmp(LVT_rc%lnc*LVT_rc%lnr) integer, intent(in) :: varid @@ -4099,34 +4099,34 @@ subroutine writeSingleNetcdfVar(ftn,gtmp,varID,k) end subroutine writeSingleNetcdfVar !BOP -! +! ! !ROUTINE: LVT_tavgDataStreams ! \label{LVT_tavgDataStreams} ! -! !INTERFACE: +! !INTERFACE: subroutine LVT_tavgDataStreams -! -! !USES: +! +! !USES: use LVT_statsDataMod implicit none ! ! -! !DESCRIPTION: -! This routine invokes the calls to compute temporal averages of -! desired set of variables, based on the specified -! temporal averaging frequency. -! -! The routines invoked are: +! !DESCRIPTION: +! This routine invokes the calls to compute temporal averages of +! desired set of variables, based on the specified +! temporal averaging frequency. +! +! The routines invoked are: ! \begin{description} ! \item[tavgSingleDataStream](\ref{tavgSingleDataStream}) ! computes the temporal average for a single variable ! \end{description} -! +! ! !FILES USED: ! -! !REVISION HISTORY: -! +! !REVISION HISTORY: +! !EOP integer :: kk @@ -4142,35 +4142,35 @@ subroutine LVT_tavgDataStreams if (LVT_rc%runmode.eq."557 post") then local_computeFlag = LVT_557post_alarm_is_on() end if - !if(LVT_rc%computeFlag) then + !if(LVT_rc%computeFlag) then if (local_computeFlag) then !data stream 1 do kk=1,LVT_rc%nDataStreams - if(kk.eq.1) then + if(kk.eq.1) then dataEntry => LVT_histData%head_ds1_list - elseif(kk.eq.2) then + elseif(kk.eq.2) then dataEntry => LVT_histData%head_ds2_list - elseif(kk.eq.3) then + elseif(kk.eq.3) then dataEntry => LVT_histData%head_ds3_list endif - + do while(associated(dataEntry)) call tavgSingleDataStream(dataEntry) dataEntry => dataEntry%next enddo ! copy duplicate entries -! Note that this check is not enabled for three datastrems. +! Note that this check is not enabled for three datastrems. ! The responsibility of ensuring non-duplicate entries is -! on the user. - if(LVT_rc%ds1_dup) then - ds1 => LVT_histData%head_ds1_list +! on the user. + if(LVT_rc%ds1_dup) then + ds1 => LVT_histData%head_ds1_list do while(associated(ds1)) ds2 => ds1%next do while(associated(ds2)) if(ds2%index.ne.ds1%index.and.& - ds1%short_name.eq.ds2%short_name) then + ds1%short_name.eq.ds2%short_name) then ds2%value = ds1%value ds2%count = ds1%count endif @@ -4178,16 +4178,16 @@ subroutine LVT_tavgDataStreams enddo ds1 => ds1%next enddo - + endif - if(LVT_rc%ds2_dup) then - ds1 => LVT_histData%head_ds2_list + if(LVT_rc%ds2_dup) then + ds1 => LVT_histData%head_ds2_list do while(associated(ds1)) ds2 => ds1%next do while(associated(ds2)) if(ds2%index.ne.ds1%index.and.& - ds1%short_name.eq.ds2%short_name) then + ds1%short_name.eq.ds2%short_name) then ds2%value = ds1%value ds2%count = ds1%count endif @@ -4195,7 +4195,7 @@ subroutine LVT_tavgDataStreams enddo ds1 => ds1%next enddo - + endif if(LVT_rc%var_based_strat .gt. 0) then @@ -4208,32 +4208,32 @@ subroutine LVT_tavgDataStreams end subroutine LVT_tavgDataStreams !BOP -! +! ! !ROUTINE: tavgSingleDataStream ! \label{tavgSingleDataStream} ! ! !INTERFACE: subroutine tavgSingleDataStream( dataEntry) -! -! !USES: +! +! !USES: implicit none ! -! !INPUT PARAMETERS: -! +! !INPUT PARAMETERS: +! ! !OUTPUT PARAMETERS: ! -! !DESCRIPTION: +! !DESCRIPTION: ! This routine temporally averages the accumulated data in a ! given datastream -! +! ! !FILES USED: ! -! !REVISION HISTORY: -! +! !REVISION HISTORY: +! !EOP !BOP -! !ARGUMENTS: +! !ARGUMENTS: type(LVT_metadataEntry) :: dataEntry !EOP integer :: k,t,c,r,m,gid @@ -4247,32 +4247,32 @@ subroutine tavgSingleDataStream( dataEntry) ! if (trim(dataEntry%short_name) == "Tair_f_max") return ! if (trim(dataEntry%short_name) == "Tair_f_min") return - if(dataEntry%selectNlevs.ge.1) then - if(LVT_rc%computeEnsMetrics.eq.1) then + if(dataEntry%selectNlevs.ge.1) then + if(LVT_rc%computeEnsMetrics.eq.1) then do t=1,LVT_LIS_rc(1)%ntiles do k=1,dataEntry%vlevels c = LVT_LIS_domain(1)%tile(t)%col r = LVT_LIS_domain(1)%tile(t)%row - if(LVT_LIS_domain(1)%gindex(c,r).ne.-1) then + if(LVT_LIS_domain(1)%gindex(c,r).ne.-1) then gid = LVT_LIS_domain(1)%gindex(c,r) do m=1,LVT_rc%nensem - if(dataEntry%count(t,m,k).ne.0) then + if(dataEntry%count(t,m,k).ne.0) then dataEntry%value(t,m,k) = & dataEntry%value(t,m,k)/dataEntry%count(t,m,k) - + endif enddo endif enddo - enddo + enddo else do r=1,LVT_rc%lnr do c=1,LVT_rc%lnc do k=1,dataEntry%vlevels - if(LVT_domain%gindex(c,r).ne.-1) then + if(LVT_domain%gindex(c,r).ne.-1) then gid = LVT_domain%gindex(c,r) do m=1,LVT_rc%nensem - if(dataEntry%count(gid,m,k).ne.0) then + if(dataEntry%count(gid,m,k).ne.0) then dataEntry%value(gid,m,k) = & dataEntry%value(gid,m,k)/& dataEntry%count(gid,m,k) @@ -4289,34 +4289,34 @@ end subroutine tavgSingleDataStream !BOP -! +! ! !ROUTINE: LVT_resetDataStreams ! \label{LVT_resetDataStreams} ! -! !INTERFACE: +! !INTERFACE: subroutine LVT_resetDataStreams -! -! !USES: +! +! !USES: implicit none ! -! !INPUT PARAMETERS: -! +! !INPUT PARAMETERS: +! ! !OUTPUT PARAMETERS: ! -! !DESCRIPTION: +! !DESCRIPTION: ! This routine reinitializes the data structures that hold the observational ! data -! -! The routines invoked are: +! +! The routines invoked are: ! \begin{description} ! \item[resetSingleDataStream2](\ref{resetSingleDataStream2}) ! resets the datastructures for a single variable ! \end{description} -! +! ! !FILES USED: ! -! !REVISION HISTORY: -! +! !REVISION HISTORY: +! !EOP type(LVT_metadataEntry), pointer :: ds1 @@ -4331,45 +4331,45 @@ subroutine LVT_resetDataStreams if (LVT_rc%runmode.eq."557 post") then local_computeFlag = LVT_557post_alarm_is_on() end if - -! if(LVT_rc%computeFlag) then + +! if(LVT_rc%computeFlag) then if (local_computeFlag) then !data stream 1 ds1 => LVT_histData%head_ds1_list - + do while(associated(ds1)) call resetSingleDataStream(ds1) ds1 => ds1%next enddo - + !data stream 2 ds2 => LVT_histData%head_ds2_list - + do while(associated(ds2)) call resetSingleDataStream(ds2) ds2 => ds2%next enddo - - if(LVT_rc%nDataStreams.gt.2) then - + + if(LVT_rc%nDataStreams.gt.2) then + !data stream 3 ds3 => LVT_histData%head_ds3_list - + do while(associated(ds3)) call resetSingleDataStream(ds3) ds3 => ds3%next enddo endif !need special handler for LIS output - if(LVT_rc%lis_output_obs) then - if(LVT_rc%obssource(1).eq."LIS output") then + if(LVT_rc%lis_output_obs) then + if(LVT_rc%obssource(1).eq."LIS output") then call LVT_resetLISoutputContainers(1) endif - if(LVT_rc%obssource(2).eq."LIS output") then + if(LVT_rc%obssource(2).eq."LIS output") then call LVT_resetLISoutputContainers(2) endif - if(LVT_rc%nDataStreams.gt.2) then - if(LVT_rc%obssource(3).eq."LIS output") then + if(LVT_rc%nDataStreams.gt.2) then + if(LVT_rc%obssource(3).eq."LIS output") then call LVT_resetLISoutputContainers(3) endif endif @@ -4379,48 +4379,48 @@ end subroutine LVT_resetDataStreams !BOP -! +! ! !ROUTINE: resetSingleDataStream ! \label{resetSingleDataStream} ! -! !INTERFACE: +! !INTERFACE: subroutine resetSingleDataStream(dataEntry) -! -! !USES: - implicit none ! -! !INPUT PARAMETERS: -! +! !USES: + implicit none +! +! !INPUT PARAMETERS: +! ! !OUTPUT PARAMETERS: ! -! !DESCRIPTION: -! This routine resets the data structures that hold the observational +! !DESCRIPTION: +! This routine resets the data structures that hold the observational ! data and the temporal averaging counters -! +! ! !FILES USED: ! -! !REVISION HISTORY: -! +! !REVISION HISTORY: +! !EOP !BOP -! -! !ARGUMENTS: +! +! !ARGUMENTS: type(LVT_metadataEntry) :: dataEntry -! +! !EOP - integer :: k + integer :: k - if(dataEntry%selectNlevs.ge.1) then + if(dataEntry%selectNlevs.ge.1) then do k=1,dataEntry%vlevels - dataEntry%value(:,:,k) = 0 - dataEntry%count(:,:,k) = 0 - dataEntry%count_status(:,:,k) = 0 - if(dataEntry%stdev_flag) then - dataEntry%count_stdev(:,k)= 0 + dataEntry%value(:,:,k) = 0 + dataEntry%count(:,:,k) = 0 + dataEntry%count_status(:,:,k) = 0 + if(dataEntry%stdev_flag) then + dataEntry%count_stdev(:,k)= 0 dataEntry%stdev(:,k) = 0 endif - enddo + enddo endif end subroutine resetSingleDataStream @@ -4437,7 +4437,7 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & integer, intent(out) :: sst_day integer, intent(out) :: sst_hour integer, intent(out) :: sst_fcst_hr - + ! GOFS SST fields are generated from a single 00Z cycle, with output ! 6-hrly from 0 to 24 hours. integer :: sst_julhr, lvt_julhr @@ -4447,7 +4447,7 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & sst_year = LVT_rc%yr sst_month = LVT_rc%mo sst_day = LVT_rc%da - sst_hour = 0 + sst_hour = 0 if (LVT_rc%hr .lt. 6) then sst_fcst_hr = 0 else if (LVT_rc%hr .lt. 12) then @@ -4467,7 +4467,7 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & inquire(file=trim(sst_filename),exist=file_exists) if (file_exists) then write(LVT_logunit,*)'[INFO] Will use ',trim(sst_filename) - return + return end if ! At this point, we are rolling back to earlier SST file @@ -4481,7 +4481,7 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & sst_fcst_hr = sst_fcst_hr - 6 if (sst_fcst_hr < 0) then sst_fcst_hr = 24 - sst_julhr = sst_julhr - 24 ! Roll back to previous 00Z cycle + sst_julhr = sst_julhr - 24 ! Roll back to previous 00Z cycle ! Give up after 5 days if ((lvt_julhr - sst_julhr) > 24*5) then write(LVT_logunit,*)'[WARN] *** GIVING UP ON GOFS SST! ***' @@ -4490,7 +4490,7 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & return end if call LVT_julhr_date(sst_julhr,sst_year,sst_month,sst_day,sst_hour) - end if + end if call construct_hycom_sst_filename(LVT_rc%HYCOMdir, & sst_year, sst_month, sst_day, & @@ -4499,7 +4499,7 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & inquire(file=trim(sst_filename),exist=file_exists) if (file_exists) then write(LVT_logunit,*)'[INFO] Will use ',trim(sst_filename) - return + return end if end do return @@ -4546,7 +4546,7 @@ subroutine get_hycom_cice_filename(region,cice_filename, & integer, intent(out) :: cice_day integer, intent(out) :: cice_hour integer, intent(out) :: cice_fcst_hr - + ! GOFS CICE fields are generated from a single 12Z cycle, with output ! 12-hrly from 0 to 180 hours. integer :: cice_julhr, lvt_julhr @@ -4575,9 +4575,9 @@ subroutine get_hycom_cice_filename(region,cice_filename, & inquire(file=trim(cice_filename),exist=file_exists) if (file_exists) then write(LVT_logunit,*)'[INFO] Will use ',trim(cice_filename) - return + return end if - + ! At this point, we are rolling back to earlier CICE file ! Start looping for earlier files do @@ -4594,7 +4594,7 @@ subroutine get_hycom_cice_filename(region,cice_filename, & return end if call LVT_julhr_date(cice_julhr,cice_year,cice_month,cice_day,cice_hour) - + call construct_hycom_cice_filename(LVT_rc%HYCOMdir, & region, & cice_year, cice_month, cice_day, & @@ -4603,7 +4603,7 @@ subroutine get_hycom_cice_filename(region,cice_filename, & inquire(file=trim(cice_filename),exist=file_exists) if (file_exists) then write(LVT_logunit,*)'[INFO] Will use ',trim(cice_filename) - return + return end if end do From 9572db4d9038d1e37e87352e7f3a414e31141abe Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 11 May 2021 17:17:01 -0400 Subject: [PATCH 60/64] More code beautification. --- lvt/core/LVT_DataStreamsMod.F90 | 2711 ++++++++++++++++--------------- 1 file changed, 1434 insertions(+), 1277 deletions(-) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index 04506df7b..d453792ee 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -144,9 +144,9 @@ subroutine LVT_DataStreamsInit ! for 557 post, the HYCOM data is processed to include the water ! temperature fields !------------------------------------------------------------------- - if(LVT_rc%runmode.eq."557 post") then + if (LVT_rc%runmode .eq. "557 post") then ! EMK FIXME...Replace HYCOM with NAVGEM - if(LVT_rc%processHYCOM.eq.1) then + if (LVT_rc%processHYCOM .eq. 1) then LVT_rc%HYCOM_proc_start = .true. @@ -183,8 +183,8 @@ subroutine LVT_DataStreamsInit LVT_histData%watertemp%timeAvgOpt = 0 LVT_histData%watertemp%startNlevs = 1 LVT_histData%watertemp%endNlevs = 1 - allocate(LVT_histData%watertemp%value(LVT_rc%ngrid,& - 1,LVT_histData%watertemp%vlevels)) + allocate(LVT_histData%watertemp%value(LVT_rc%ngrid, & + 1, LVT_histData%watertemp%vlevels)) allocate(LVT_histData%watertemp%unittypes(1)) LVT_histData%watertemp%unittypes(1) = "K" @@ -206,10 +206,10 @@ subroutine LVT_DataStreamsInit gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) gridDesci(20) = 64 ! East-west ordering - allocate(LVT_rc%HYCOM_aice_arc_n11(& + allocate(LVT_rc%HYCOM_aice_arc_n11( & LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr)) - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc, & LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_arc_n11) @@ -231,10 +231,10 @@ subroutine LVT_DataStreamsInit gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) gridDesci(20) = 64 ! East-west ordering - allocate(LVT_rc%HYCOM_aice_ant_n11(& + allocate(LVT_rc%HYCOM_aice_ant_n11( & LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr)) - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc, & LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_aice_ant_n11) @@ -248,8 +248,8 @@ subroutine LVT_DataStreamsInit LVT_histData%aice%timeAvgOpt = 0 LVT_histData%aice%startNlevs = 1 LVT_histData%aice%endNlevs = 1 - allocate(LVT_histData%aice%value(LVT_rc%ngrid,& - 1,LVT_histData%aice%vlevels)) + allocate(LVT_histData%aice%value(LVT_rc%ngrid, & + 1, LVT_histData%aice%vlevels)) allocate(LVT_histData%aice%unittypes(1)) LVT_histData%aice%unittypes(1) = "" @@ -271,10 +271,10 @@ subroutine LVT_DataStreamsInit gridDesci(10) = 0.040000915527301117 ! delta-lat (deg) gridDesci(20) = 64 ! East-west ordering - allocate(LVT_rc%HYCOM_hi_arc_n11(& + allocate(LVT_rc%HYCOM_hi_arc_n11( & LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr)) - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc, & LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_arc_n11) @@ -296,10 +296,10 @@ subroutine LVT_DataStreamsInit gridDesci(10) = 0.040000915527400593 ! delta-lat (deg) gridDesci(20) = 64 ! East-west ordering - allocate(LVT_rc%HYCOM_hi_ant_n11(& + allocate(LVT_rc%HYCOM_hi_ant_n11( & LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr)) - call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc,& + call upscaleByAveraging_input(gridDesci, LVT_rc%gridDesc, & LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%HYCOM_hi_ant_n11) @@ -313,8 +313,8 @@ subroutine LVT_DataStreamsInit LVT_histData%hi%timeAvgOpt = 0 LVT_histData%hi%startNlevs = 1 LVT_histData%hi%endNlevs = 1 - allocate(LVT_histData%hi%value(LVT_rc%ngrid,& - 1,LVT_histData%hi%vlevels)) + allocate(LVT_histData%hi%value(LVT_rc%ngrid, & + 1, LVT_histData%hi%vlevels)) allocate(LVT_histData%hi%unittypes(1)) LVT_histData%hi%unittypes(1) = "" @@ -448,20 +448,20 @@ subroutine LVT_writeDataStreams ! lyrthk(4) = 1.0*100.0 ! EMK...Use soil thicknesses read in from file. if (LVT_LIS_rc(1)%nsmlayers .ne. nsoillayers) then - write(LVT_logunit,*)'[ERR] Internal error, bad value of soil layers!' - write(LVT_logunit,*)'Program failed in LVT_writeDataStreams' + write(LVT_logunit,*) '[ERR] Internal error, bad value of soil layers!' + write(LVT_logunit,*) 'Program failed in LVT_writeDataStreams' call LVT_endrun() end if if (LVT_LIS_rc(1)%nstlayers .ne. nsoillayers) then - write(LVT_logunit,*)'[ERR] Internal error, bad value of soil layers!' - write(LVT_logunit,*)'Program failed in LVT_writeDataStreams' + write(LVT_logunit,*) '[ERR] Internal error, bad value of soil layers!' + write(LVT_logunit,*) 'Program failed in LVT_writeDataStreams' call LVT_endrun() end if ! EMK...Soil layers are in centimeters. Technically GRIB2 requires ! meters, but in practice we keep as centimeters and just modify ! the scale factor by 100. - if(LVT_rc%lvt_out_format.eq."grib2") then + if (LVT_rc%lvt_out_format .eq. "grib2") then depscale = 2 else depscale = 0 @@ -476,10 +476,10 @@ subroutine LVT_writeDataStreams ! FIXME...Add support for other projections, not just lat/lon. lat = LVT_rc%udef lon = LVT_rc%udef - do r=1,LVT_rc%gnr - do c=1,LVT_rc%gnc - lat(c,r) = LVT_rc%gridDesc(4)+(r-1)*LVT_rc%gridDesc(10) - lon(c,r) = LVT_rc%gridDesc(5)+(c-1)*LVT_rc%gridDesc(9) + do r = 1, LVT_rc%gnr + do c = 1, LVT_rc%gnc + lat(c,r) = LVT_rc%gridDesc(4) + (r-1)*LVT_rc%gridDesc(10) + lon(c,r) = LVT_rc%gridDesc(5) + (c-1)*LVT_rc%gridDesc(9) enddo enddo @@ -553,47 +553,47 @@ subroutine LVT_writeDataStreams end if ! EMK END JULES PS41 Snow - if(LVT_rc%lvt_out_format.eq."grib1") then + if (LVT_rc%lvt_out_format .eq. "grib1") then - write(unit=cdate2,fmt='(i4.4,i2.2,i2.2)') & + write(unit=cdate2, fmt='(i4.4,i2.2,i2.2)') & LVT_rc%yr, LVT_rc%mo, LVT_rc%da - write(unit=cdate3,fmt='(i2.2,i2.2)') & - LVT_rc%hr,LVT_rc%mn + write(unit=cdate3, fmt='(i2.2,i2.2)') & + LVT_rc%hr, LVT_rc%mn ! EMK...Different file name convention for 24-hr data if (LVT_rc%tavgInterval == 86400) then - fname_mean = trim(LVT_rc%statsodir)//& + fname_mean = trim(LVT_rc%statsodir)// & '/PS.557WW_SC.' & //trim(LVT_rc%security_class)//'_DI.' & //trim(LVT_rc%data_category)//'_GP.' & - //'LIS_GR.C0P09DEG_AR.'//& + //'LIS_GR.C0P09DEG_AR.'// & trim(LVT_rc%area_of_data)//'_PA.'& - //'LIS24_DD.'//& - trim(cdate2)//'_DT.'& + //'LIS24_DD.'// & + trim(cdate2)//'_DT.' & //trim(cdate3)//'_DF.GR1' - fname_ssdev = trim(LVT_rc%statsodir)//& + fname_ssdev = trim(LVT_rc%statsodir)// & '/PS.557WW_SC.' & //trim(LVT_rc%security_class)//'_DI.' & //trim(LVT_rc%data_category)//'_GP.' & - //'LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//'_PA.'& - //'LIS24_DD.'//& + //'LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)//'_PA.' & + //'LIS24_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF_SSDEV.GR1' else - fname_mean = trim(LVT_rc%statsodir)//& + fname_mean = trim(LVT_rc%statsodir)// & ! '/PS.AFWA_SC.'//trim(LVT_rc%security_class)//& ! '_DI.'//trim(LVT_rc%distribution_class)//& ! '_DC.'//trim(LVT_rc%data_category)//& ! '_GP.LIS_GR.C0P25DEG_AR.'//& ! EMK...Update name convention - '/PS.557WW_SC.'//trim(LVT_rc%security_class)//& - '_DI.'//trim(LVT_rc%data_category)//& - '_GP.LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//& + '/PS.557WW_SC.'//trim(LVT_rc%security_class)// & + '_DI.'//trim(LVT_rc%data_category)// & + '_GP.LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)// & ! '_PA.03-HR-SUM_DD.'//& - '_PA.LIS_DD.'//& + '_PA.LIS_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF.GR1' fname_ssdev = trim(LVT_rc%statsodir)//& @@ -602,12 +602,12 @@ subroutine LVT_writeDataStreams ! '_DC.'//trim(LVT_rc%data_category)//& ! '_GP.LIS_GR.C0P25DEG_AR.'//& ! EMK...Update name convention - '/PS.557WW_SC.'//trim(LVT_rc%security_class)//& - '_DI.'//trim(LVT_rc%data_category)//& - '_GP.LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//& - ! '_PA.03-HR-SUM_DD.'//& - '_PA.LIS_DD.'//& + '/PS.557WW_SC.'//trim(LVT_rc%security_class)// & + '_DI.'//trim(LVT_rc%data_category)// & + '_GP.LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)// & + ! '_PA.03-HR-SUM_DD.'// & + '_PA.LIS_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF_SSDEV.GR1' end if @@ -670,72 +670,73 @@ subroutine LVT_writeDataStreams !the binary output. ! time_past=0 - call grib_open_file(ftn_mean,fname_mean,'w',iret) + call grib_open_file(ftn_mean, fname_mean, 'w', iret) call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call grib_open_file(ftn_ssdev,fname_ssdev,'w',iret) - call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) + call grib_open_file(ftn_ssdev, fname_ssdev, 'w', iret) + call LVT_verify(iret, & + 'failed to open grib file '//trim(fname_ssdev)) end if - elseif(LVT_rc%lvt_out_format.eq."grib2") then - write(unit=cdate2,fmt='(i4.4,i2.2,i2.2)') & + elseif (LVT_rc%lvt_out_format .eq. "grib2") then + write(unit=cdate2, fmt='(i4.4,i2.2,i2.2)') & LVT_rc%yr, LVT_rc%mo, LVT_rc%da - write(unit=cdate3,fmt='(i2.2,i2.2)') & - LVT_rc%hr,LVT_rc%mn + write(unit=cdate3, fmt='(i2.2,i2.2)') & + LVT_rc%hr, LVT_rc%mn ! EMK...Different file name convention for 24-hr data if (LVT_rc%tavgInterval == 86400) then - fname_mean = trim(LVT_rc%statsodir)//& + fname_mean = trim(LVT_rc%statsodir)// & '/PS.557WW_SC.' & //trim(LVT_rc%security_class)//'_DI.' & //trim(LVT_rc%data_category)//'_GP.' & - //'LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//'_PA.'& - //'LIS24_DD.'//& - trim(cdate2)//'_DT.'& + //'LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)//'_PA.' & + //'LIS24_DD.'// & + trim(cdate2)//'_DT.' & //trim(cdate3)//'_DF.GR2' if (LVT_rc%nensem > 1) then - fname_ssdev = trim(LVT_rc%statsodir)//& + fname_ssdev = trim(LVT_rc%statsodir)// & '/PS.557WW_SC.' & //trim(LVT_rc%security_class)//'_DI.' & //trim(LVT_rc%data_category)//'_GP.' & - //'LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//'_PA.'& - //'LIS24_DD.'//& + //'LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)//'_PA.' & + //'LIS24_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF_SSDEV.GR2' end if else ! EMK...Assume 3-hr - fname_mean = trim(LVT_rc%statsodir)//& + fname_mean = trim(LVT_rc%statsodir)// & ! '/PS.AFWA_SC.'//trim(LVT_rc%security_class)//& ! '_DI.'//trim(LVT_rc%distribution_class)//& ! '_DC.'//trim(LVT_rc%data_category)//& ! '_GP.LIS_GR.C0P25DEG_AR.'//& ! EMK...Update name convention - '/PS.557WW_SC.'//trim(LVT_rc%security_class)//& - '_DI.'//trim(LVT_rc%data_category)//& - '_GP.LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//& + '/PS.557WW_SC.'//trim(LVT_rc%security_class)// & + '_DI.'//trim(LVT_rc%data_category)// & + '_GP.LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)// & ! '_PA.03-HR-SUM_DD.'//& - '_PA.LIS_DD.'//& + '_PA.LIS_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF.GR2' if (LVT_rc%nensem > 1) then - fname_ssdev = trim(LVT_rc%statsodir)//& + fname_ssdev = trim(LVT_rc%statsodir)// & ! '/PS.AFWA_SC.'//trim(LVT_rc%security_class)//& ! '_DI.'//trim(LVT_rc%distribution_class)//& ! '_DC.'//trim(LVT_rc%data_category)//& ! '_GP.LIS_GR.C0P25DEG_AR.'//& ! EMK...Update name convention - '/PS.557WW_SC.'//trim(LVT_rc%security_class)//& - '_DI.'//trim(LVT_rc%data_category)//& - '_GP.LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//& + '/PS.557WW_SC.'//trim(LVT_rc%security_class)// & + '_DI.'//trim(LVT_rc%data_category)// & + '_GP.LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)// & ! '_PA.03-HR-SUM_DD.'//& - '_PA.LIS_DD.'//& + '_PA.LIS_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF_SSDEV.GR2' end if end if @@ -765,24 +766,25 @@ subroutine LVT_writeDataStreams mn = LVT_rc%mn ss = LVT_rc%ss - call LVT_tick(time,doy,gmt,yr,mo,da,hr,mn,ss,-1*LVT_rc%statswriteint) + call LVT_tick(time, doy, gmt, yr, mo, da, hr, mn, ss, & + -1*LVT_rc%statswriteint) - if(LVT_rc%statswriteint .GT. 0) then + if (LVT_rc%statswriteint .GT. 0) then time_unit = 254 ! seconds time_curr = 0 time_past = LVT_rc%statswriteint endif - if(LVT_rc%statswriteint .GE. 60) then + if (LVT_rc%statswriteint .GE. 60) then time_unit = 0 ! minutes time_curr = 0 time_past = (LVT_rc%statswriteint / 60) endif - if(LVT_rc%statswriteint .GE. 3600) then + if (LVT_rc%statswriteint .GE. 3600) then time_unit = 1 ! hours time_curr = 0 time_past = (LVT_rc%statswriteint / 3600) endif - if(LVT_rc%statswriteint .GE. 86400) then + if (LVT_rc%statswriteint .GE. 86400) then time_unit = 2 ! days time_curr = 0 time_past = (LVT_rc%statswriteint / 86400) @@ -791,81 +793,82 @@ subroutine LVT_writeDataStreams !time_past: from LVT_grib1_finalize !time_P1 (Negative Time Unit for avg, or 0 for analysis) !According to the in-line comments, time_past must be negative or 0. - !Here we are setting it to a positive value. This produces bad output. - !Setting it to a negative value also produces bad output. + !Here we are setting it to a positive value. This produces bad + !output. Setting it to a negative value also produces bad output. !So I am resetting it to zero. This produces output that matches !the binary output. ! time_past=0 - call grib_open_file(ftn_mean,fname_mean,'w',iret) + call grib_open_file(ftn_mean,fname_mean, 'w', iret) call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call grib_open_file(ftn_ssdev,fname_ssdev,'w',iret) - call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) + call grib_open_file(ftn_ssdev, fname_ssdev, 'w', iret) + call LVT_verify(iret, & + 'failed to open grib file '//trim(fname_ssdev)) end if - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif (LVT_rc%lvt_out_format .eq. "netcdf") then - call date_and_time(date,stime,zone,values) + call date_and_time(date, stime, zone, values) - write(unit=cdate2,fmt='(i4.4,i2.2,i2.2)') & + write(unit=cdate2, fmt='(i4.4,i2.2,i2.2)') & LVT_rc%yr, LVT_rc%mo, LVT_rc%da - write(unit=cdate3,fmt='(i2.2,i2.2)') & - LVT_rc%hr,LVT_rc%mn + write(unit=cdate3, fmt='(i2.2,i2.2)') & + LVT_rc%hr, LVT_rc%mn ! EMK...Different file name convention for 24-hr data if (LVT_rc%tavgInterval == 86400) then - fname_mean = trim(LVT_rc%statsodir)//& + fname_mean = trim(LVT_rc%statsodir)// & '/PS.557WW_SC.' & //trim(LVT_rc%security_class)//'_DI.' & //trim(LVT_rc%data_category)//'_GP.' & - //'LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//'_PA.'& - //'LIS24_DD.'//& - trim(cdate2)//'_DT.'& + //'LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)//'_PA.' & + //'LIS24_DD.'// & + trim(cdate2)//'_DT.' & //trim(cdate3)//'_DF.nc' if (LVT_rc%nensem > 1) then - fname_ssdev = trim(LVT_rc%statsodir)//& + fname_ssdev = trim(LVT_rc%statsodir)// & '/PS.557WW_SC.' & //trim(LVT_rc%security_class)//'_DI.' & //trim(LVT_rc%data_category)//'_GP.' & - //'LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//'_PA.'& - //'LIS24_DD.'//& + //'LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)//'_PA.' & + //'LIS24_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF_SSDEV.nc' end if else - fname_mean = trim(LVT_rc%statsodir)//& + fname_mean = trim(LVT_rc%statsodir)// & ! '/PS.AFWA_SC.'//trim(LVT_rc%security_class)//& ! '_DI.'//trim(LVT_rc%distribution_class)//& ! '_DC.'//trim(LVT_rc%data_category)//& ! '_GP.LIS_GR.C0P25DEG_AR.'//& ! EMK...Update name convention - '/PS.557WW_SC.'//trim(LVT_rc%security_class)//& - '_DI.'//trim(LVT_rc%data_category)//& - '_GP.LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//& + '/PS.557WW_SC.'//trim(LVT_rc%security_class)// & + '_DI.'//trim(LVT_rc%data_category)// & + '_GP.LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)// & ! '_PA.03-HR-SUM_DD.'//& - '_PA.LIS_DD.'//& + '_PA.LIS_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF.nc' if (LVT_rc%nensem > 1) then - fname_ssdev = trim(LVT_rc%statsodir)//& + fname_ssdev = trim(LVT_rc%statsodir)// & ! '/PS.AFWA_SC.'//trim(LVT_rc%security_class)//& ! '_DI.'//trim(LVT_rc%distribution_class)//& ! '_DC.'//trim(LVT_rc%data_category)//& ! '_GP.LIS_GR.C0P25DEG_AR.'//& ! EMK...Update name convention - '/PS.557WW_SC.'//trim(LVT_rc%security_class)//& - '_DI.'//trim(LVT_rc%data_category)//& - '_GP.LIS_GR.C0P09DEG_AR.'//& - trim(LVT_rc%area_of_data)//& + '/PS.557WW_SC.'//trim(LVT_rc%security_class)// & + '_DI.'//trim(LVT_rc%data_category)// & + '_GP.LIS_GR.C0P09DEG_AR.'// & + trim(LVT_rc%area_of_data)// & ! '_PA.03-HR-SUM_DD.'//& - '_PA.LIS_DD.'//& + '_PA.LIS_DD.'// & trim(cdate2)//'_DT.'//trim(cdate3)//'_DF_SSDEV.nc' end if end if @@ -895,24 +898,25 @@ subroutine LVT_writeDataStreams mn = LVT_rc%mn ss = LVT_rc%ss - call LVT_tick(time,doy,gmt,yr,mo,da,hr,mn,ss,-1*LVT_rc%statswriteint) + call LVT_tick(time, doy, gmt, yr, mo, da, hr, mn, ss, & + -1*LVT_rc%statswriteint) - if(LVT_rc%statswriteint .GT. 0) then + if (LVT_rc%statswriteint .GT. 0) then time_unit = 254 ! seconds time_curr = 0 time_past = LVT_rc%statswriteint endif - if(LVT_rc%statswriteint .GE. 60) then + if (LVT_rc%statswriteint .GE. 60) then time_unit = 0 ! minutes time_curr = 0 time_past = (LVT_rc%statswriteint / 60) endif - if(LVT_rc%statswriteint .GE. 3600) then + if (LVT_rc%statswriteint .GE. 3600) then time_unit = 1 ! hours time_curr = 0 time_past = (LVT_rc%statswriteint / 3600) endif - if(LVT_rc%statswriteint .GE. 86400) then + if (LVT_rc%statswriteint .GE. 86400) then time_unit = 2 ! days time_curr = 0 time_past = (LVT_rc%statswriteint / 86400) @@ -921,14 +925,12 @@ subroutine LVT_writeDataStreams !time_past: from LVT_grib1_finalize !time_P1 (Negative Time Unit for avg, or 0 for analysis) !According to the in-line comments, time_past must be negative or 0. - !Here we are setting it to a positive value. This produces bad output. - !Setting it to a negative value also produces bad output. + !Here we are setting it to a positive value. This produces bad + !output. Setting it to a negative value also produces bad output. !So I am resetting it to zero. This produces output that matches !the binary output. ! time_past=0 - - shuffle = NETCDF_shuffle deflate = NETCDF_deflate deflate_level =NETCDF_deflate_level @@ -943,8 +945,8 @@ subroutine LVT_writeDataStreams xlat%timeAvgOpt = 0 xlat%startNlevs = 1 xlat%endNlevs = 1 - allocate(xlat%value(LVT_rc%ngrid,& - 1,xlat%vlevels)) + allocate(xlat%value(LVT_rc%ngrid, & + 1, xlat%vlevels)) allocate(xlat%unittypes(1)) xlat%unittypes(1) = "degree_north" @@ -958,94 +960,99 @@ subroutine LVT_writeDataStreams xlon%timeAvgOpt = 0 xlon%startNlevs = 1 xlon%endNlevs = 1 - allocate(xlon%value(LVT_rc%ngrid,& - 1,xlon%vlevels)) + allocate(xlon%value(LVT_rc%ngrid, & + 1, xlon%vlevels)) allocate(xlon%unittypes(1)) xlon%unittypes(1) = "degree_east" #if (defined USE_NETCDF4) - iret = nf90_create(path=trim(fname_mean), cmode =nf90_hdf5, & - ncid = ftn_mean) + iret = nf90_create(path=trim(fname_mean), cmode=nf90_hdf5, & + ncid=ftn_mean) call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - iret = nf90_create(path=trim(fname_ssdev), cmode =nf90_hdf5, & - ncid = ftn_ssdev) - call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) + iret = nf90_create(path=trim(fname_ssdev), cmode=nf90_hdf5, & + ncid=ftn_ssdev) + call LVT_verify(iret, & + 'failed to open grib file '//trim(fname_ssdev)) end if #endif #if (defined USE_NETCDF3) - iret = nf90_create(path=trim(fname_mean), cmode =nf90_clobber, & - ncid = ftn_mean) + iret = nf90_create(path=trim(fname_mean), cmode=nf90_clobber, & + ncid=ftn_mean) call LVT_verify(iret, 'failed to open grib file '//trim(fname_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - iret = nf90_create(path=trim(fname_ssdev), cmode =nf90_clobber, & - ncid = ftn_ssdev) - call LVT_verify(iret, 'failed to open grib file '//trim(fname_ssdev)) + iret = nf90_create(path=trim(fname_ssdev), cmode=nf90_clobber, & + ncid=ftn_ssdev) + call LVT_verify(iret, & + 'failed to open grib file '//trim(fname_ssdev)) end if #endif !Headers - call LVT_verify(nf90_def_dim(ftn_mean,'east_west',LVT_rc%gnc,dimID(1))) - call LVT_verify(nf90_def_dim(ftn_mean,'north_south',LVT_rc%gnr,dimID(2))) - - call LVT_verify(nf90_def_dim(ftn_mean,'time',1,tdimID)) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"missing_value",& + call LVT_verify(nf90_def_dim(ftn_mean, 'east_west', & + LVT_rc%gnc, dimID(1))) + call LVT_verify(nf90_def_dim(ftn_mean, 'north_south', & + LVT_rc%gnr, dimID(2))) + + call LVT_verify(nf90_def_dim(ftn_mean, 'time', 1, tdimID)) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "missing_value", & LVT_rc%udef)) - call LVT_verify(nf90_def_var(ftn_mean,& - trim(xlat%short_name),& - nf90_float,& + call LVT_verify(nf90_def_var(ftn_mean, & + trim(xlat%short_name), & + nf90_float, & dimids = dimID(1:2), varID=xlatID)) #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_deflate(ftn_mean,& - xlatID,& - shuffle,deflate,deflate_level)) + call LVT_verify(nf90_def_var_deflate(ftn_mean, & + xlatID, & + shuffle, deflate, deflate_level)) #endif - call LVT_verify(nf90_def_var(ftn_mean,& - trim(xlon%short_name),& - nf90_float,& + call LVT_verify(nf90_def_var(ftn_mean, & + trim(xlon%short_name), & + nf90_float, & dimids = dimID(1:2), varID=xlonID)) #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_deflate(ftn_mean,& - xlonID,& - shuffle,deflate,deflate_level)) + call LVT_verify(nf90_def_var_deflate(ftn_mean, & + xlonID, & + shuffle, deflate, deflate_level)) #endif - call LVT_verify(nf90_put_att(ftn_mean,xlatID,& - "units",trim(xlat%units))) - call LVT_verify(nf90_put_att(ftn_mean,xlatID,& - "standard_name",trim(xlat%standard_name))) - call LVT_verify(nf90_put_att(ftn_mean,xlatID,& - "long_name",trim(xlat%long_name))) - call LVT_verify(nf90_put_att(ftn_mean,xlatID,& - "scale_factor",1.0)) - call LVT_verify(nf90_put_att(ftn_mean,xlatID,& - "add_offset",0.0)) - call LVT_verify(nf90_put_att(ftn_mean,xlatID,& - "missing_value",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,xlatID,& - "_FillValue",LVT_rc%udef)) - - call LVT_verify(nf90_put_att(ftn_mean,xlonID,& - "units",trim(xlon%units))) - call LVT_verify(nf90_put_att(ftn_mean,xlonID,& - "standard_name",trim(xlon%standard_name))) - call LVT_verify(nf90_put_att(ftn_mean,xlonID,& - "long_name",trim(xlon%long_name))) - call LVT_verify(nf90_put_att(ftn_mean,xlonID,& - "scale_factor",1.0)) - call LVT_verify(nf90_put_att(ftn_mean,xlonID,& - "add_offset",0.0)) - call LVT_verify(nf90_put_att(ftn_mean,xlonID,& - "missing_value",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,xlonID,& - "_FillValue",LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, xlatID, & + "units", trim(xlat%units))) + call LVT_verify(nf90_put_att(ftn_mean, xlatID, & + "standard_name", trim(xlat%standard_name))) + call LVT_verify(nf90_put_att(ftn_mean, xlatID, & + "long_name", trim(xlat%long_name))) + call LVT_verify(nf90_put_att(ftn_mean, xlatID, & + "scale_factor", 1.0)) + call LVT_verify(nf90_put_att(ftn_mean, xlatID, & + "add_offset", 0.0)) + call LVT_verify(nf90_put_att(ftn_mean, xlatID, & + "missing_value", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, xlatID, & + "_FillValue", LVT_rc%udef)) + + call LVT_verify(nf90_put_att(ftn_mean, xlonID, & + "units", trim(xlon%units))) + call LVT_verify(nf90_put_att(ftn_mean, xlonID, & + "standard_name", trim(xlon%standard_name))) + call LVT_verify(nf90_put_att(ftn_mean, xlonID, & + "long_name", trim(xlon%long_name))) + call LVT_verify(nf90_put_att(ftn_mean, xlonID, & + "scale_factor", 1.0)) + call LVT_verify(nf90_put_att(ftn_mean, xlonID, & + "add_offset", 0.0)) + call LVT_verify(nf90_put_att(ftn_mean, xlonID, & + "missing_value", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, xlonID, & + "_FillValue", LVT_rc%udef)) !define time field - call LVT_verify(nf90_def_var(ftn_mean,'time',& - nf90_float,dimids = tdimID,varID=xtimeID)) + call LVT_verify(nf90_def_var(ftn_mean, 'time', & + nf90_float, dimids=tdimID, varID=xtimeID)) write(xtime_units,200) LVT_rc%yr, LVT_rc%mo, LVT_rc%da, & LVT_rc%hr, LVT_rc%mn, LVT_rc%ss 200 format ('minutes since ',I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':', & @@ -1057,152 +1064,156 @@ subroutine LVT_writeDataStreams write(xtime_timeInc, fmt='(I20)') & LVT_rc%ts - call LVT_verify(nf90_put_att(ftn_mean,xtimeID,& - "units",trim(xtime_units))) - call LVT_verify(nf90_put_att(ftn_mean,xtimeID,& - "long_name","time")) - call LVT_verify(nf90_put_att(ftn_mean,xtimeID,& - "time_increment",trim(adjustl(xtime_timeInc)))) - call LVT_verify(nf90_put_att(ftn_mean,xtimeID,& - "begin_date",xtime_begin_date)) - call LVT_verify(nf90_put_att(ftn_mean,xtimeID,& - "begin_time",xtime_begin_time)) - - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"title", & + call LVT_verify(nf90_put_att(ftn_mean, xtimeID,& + "units", trim(xtime_units))) + call LVT_verify(nf90_put_att(ftn_mean, xtimeID,& + "long_name", "time")) + call LVT_verify(nf90_put_att(ftn_mean, xtimeID,& + "time_increment", trim(adjustl(xtime_timeInc)))) + call LVT_verify(nf90_put_att(ftn_mean, xtimeID,& + "begin_date", xtime_begin_date)) + call LVT_verify(nf90_put_att(ftn_mean, xtimeID,& + "begin_time", xtime_begin_time)) + + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "title", & "LVT land surface analysis output")) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"institution", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "institution", & trim(LVT_rc%institution))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"history", & - "created on date: "//date(1:4)//"-"//date(5:6)//"-"//& + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "history", & + "created on date: "//date(1:4)//"-"//date(5:6)//"-"// & date(7:8)//"T"//stime(1:2)//":"//stime(3:4)//":"//stime(5:10))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"references", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "references", & "Kumar_etal_GMD_2012")) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"comment", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "comment", & "website: http://lis.gsfc.nasa.gov/")) !grid information - if(trim(LVT_rc%domain).eq."latlon") then !latlon - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"MAP_PROJECTION", & - "EQUIDISTANT CYLINDRICAL")) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & - LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & - LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DX", & + if (trim(LVT_rc%domain) .eq. "latlon") then !latlon + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "MAP_PROJECTION", "EQUIDISTANT CYLINDRICAL")) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", LVT_rc%gridDesc(4))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", LVT_rc%gridDesc(5))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(9))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(10))) - elseif(trim(LVT_rc%domain).eq."mercator") then - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"MAP_PROJECTION", & - "MERCATOR")) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & - LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & - LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"TRUELAT1", & + elseif (trim(LVT_rc%domain) .eq. "mercator") then + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "MAP_PROJECTION", "MERCATOR")) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", LVT_rc%gridDesc(4))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", LVT_rc%gridDesc(5))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "TRUELAT1", & LVT_rc%gridDesc(10))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"STANDARD_LON", & - LVT_rc%gridDesc(11))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DX", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "STANDARD_LON", LVT_rc%gridDesc(11))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(8))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(9))) - elseif(trim(LVT_rc%domain).eq."lambert") then !lambert conformal - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"MAP_PROJECTION", & - "LAMBERT CONFORMAL")) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & - LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & - LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"TRUELAT1", & - LVT_rc%gridDesc(10))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"TRUELAT2", & - LVT_rc%gridDesc(7))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"STANDARD_LON", & - LVT_rc%gridDesc(11))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DX", & + elseif (trim(LVT_rc%domain).eq."lambert") then !lambert conformal + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "MAP_PROJECTION", "LAMBERT CONFORMAL")) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", LVT_rc%gridDesc(4))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", LVT_rc%gridDesc(5))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "TRUELAT1", LVT_rc%gridDesc(10))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "TRUELAT2", LVT_rc%gridDesc(7))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "STANDARD_LON", LVT_rc%gridDesc(11))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(8))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(9))) - elseif(trim(LVT_rc%domain).eq."polar") then ! polar stereographic - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"MAP_PROJECTION", & - "POLAR STEREOGRAPHIC")) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & - LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & - LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"TRUELAT1", & + elseif (trim(LVT_rc%domain) .eq. "polar") then ! polar stereographic + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "MAP_PROJECTION", "POLAR STEREOGRAPHIC")) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", LVT_rc%gridDesc(4))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", LVT_rc%gridDesc(5))) + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "TRUELAT1", & LVT_rc%gridDesc(10))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"ORIENT", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "ORIENT", & LVT_rc%gridDesc(7))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"STANDARD_LON", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & + "STANDARD_LON", & LVT_rc%gridDesc(11))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DX", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(8))) - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(9))) endif if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then !Headers - call LVT_verify(nf90_def_dim(ftn_ssdev,'east_west',LVT_rc%gnc,dimID(1))) - call LVT_verify(nf90_def_dim(ftn_ssdev,'north_south',LVT_rc%gnr,dimID(2))) - call LVT_verify(nf90_def_dim(ftn_ssdev,'time',1,tdimID)) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"missing_value",& + call LVT_verify(nf90_def_dim(ftn_ssdev, 'east_west', & + LVT_rc%gnc, dimID(1))) + call LVT_verify(nf90_def_dim(ftn_ssdev, 'north_south', & + LVT_rc%gnr,dimID(2))) + call LVT_verify(nf90_def_dim(ftn_ssdev,'time', 1, tdimID)) + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "missing_value", & LVT_rc%udef)) - call LVT_verify(nf90_def_var(ftn_ssdev,& - trim(xlat%short_name),& - nf90_float,& - dimids = dimID(1:2), varID=xlat_ss_ID)) + call LVT_verify(nf90_def_var(ftn_ssdev, & + trim(xlat%short_name), & + nf90_float, & + dimids=dimID(1:2), varID=xlat_ss_ID)) #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_deflate(ftn_ssdev,& - xlat_ss_ID,& - shuffle,deflate,deflate_level)) + call LVT_verify(nf90_def_var_deflate(ftn_ssdev, & + xlat_ss_ID, & + shuffle, deflate, deflate_level)) #endif - call LVT_verify(nf90_def_var(ftn_ssdev,& - trim(xlon%short_name),& - nf90_float,& - dimids = dimID(1:2), varID=xlon_ss_ID)) + call LVT_verify(nf90_def_var(ftn_ssdev, & + trim(xlon%short_name), & + nf90_float, & + dimids=dimID(1:2), varID=xlon_ss_ID)) #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_deflate(ftn_ssdev,& - xlon_ss_ID,& - shuffle,deflate,deflate_level)) + call LVT_verify(nf90_def_var_deflate(ftn_ssdev, & + xlon_ss_ID, & + shuffle, deflate, deflate_level)) #endif - call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& - "units",trim(xlat%units))) - call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& - "standard_name",trim(xlat%standard_name))) - call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& - "long_name",trim(xlat%long_name))) - call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& - "scale_factor",1.0)) - call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& - "add_offset",0.0)) - call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& - "missing_value",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_ssdev,xlat_ss_ID,& - "_FillValue",LVT_rc%udef)) - - call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& - "units",trim(xlon%units))) - call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& - "standard_name",trim(xlon%standard_name))) - call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& - "long_name",trim(xlon%long_name))) - call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& - "scale_factor",1.0)) - call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& - "add_offset",0.0)) - call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& - "missing_value",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_ssdev,xlon_ss_ID,& - "_FillValue",LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_ssdev, xlat_ss_ID, & + "units", trim(xlat%units))) + call LVT_verify(nf90_put_att(ftn_ssdev, xlat_ss_ID, & + "standard_name", trim(xlat%standard_name))) + call LVT_verify(nf90_put_att(ftn_ssdev, xlat_ss_ID, & + "long_name", trim(xlat%long_name))) + call LVT_verify(nf90_put_att(ftn_ssdev, xlat_ss_ID, & + "scale_factor", 1.0)) + call LVT_verify(nf90_put_att(ftn_ssdev, xlat_ss_ID, & + "add_offset", 0.0)) + call LVT_verify(nf90_put_att(ftn_ssdev, xlat_ss_ID, & + "missing_value", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_ssdev, xlat_ss_ID, & + "_FillValue", LVT_rc%udef)) + + call LVT_verify(nf90_put_att(ftn_ssdev, xlon_ss_ID, & + "units", trim(xlon%units))) + call LVT_verify(nf90_put_att(ftn_ssdev, xlon_ss_ID, & + "standard_name", trim(xlon%standard_name))) + call LVT_verify(nf90_put_att(ftn_ssdev, xlon_ss_ID, & + "long_name", trim(xlon%long_name))) + call LVT_verify(nf90_put_att(ftn_ssdev, xlon_ss_ID, & + "scale_factor", 1.0)) + call LVT_verify(nf90_put_att(ftn_ssdev, xlon_ss_ID, & + "add_offset", 0.0)) + call LVT_verify(nf90_put_att(ftn_ssdev, xlon_ss_ID, & + "missing_value", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_ssdev, xlon_ss_ID, & + "_FillValue", LVT_rc%udef)) !define time field - call LVT_verify(nf90_def_var(ftn_ssdev,'time',& - nf90_float,dimids = tdimID,varID=xtime_ss_ID)) + call LVT_verify(nf90_def_var(ftn_ssdev,'time', & + nf90_float, dimids=tdimID, varID=xtime_ss_ID)) write(xtime_units,201) LVT_rc%yr, LVT_rc%mo, LVT_rc%da, & LVT_rc%hr, LVT_rc%mn, LVT_rc%ss 201 format ('minutes since ',I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':', & @@ -1214,90 +1225,112 @@ subroutine LVT_writeDataStreams write(xtime_timeInc, fmt='(I20)') & LVT_rc%ts - call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& - "units",trim(xtime_units))) - call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& - "long_name","time")) - call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& - "time_increment",trim(adjustl(xtime_timeInc)))) - call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& - "begin_date",xtime_begin_date)) - call LVT_verify(nf90_put_att(ftn_ssdev,xtime_ss_ID,& - "begin_time",xtime_begin_time)) - - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"title", & + call LVT_verify(nf90_put_att(ftn_ssdev, xtime_ss_ID,& + "units", trim(xtime_units))) + call LVT_verify(nf90_put_att(ftn_ssdev, xtime_ss_ID,& + "long_name", "time")) + call LVT_verify(nf90_put_att(ftn_ssdev, xtime_ss_ID,& + "time_increment", trim(adjustl(xtime_timeInc)))) + call LVT_verify(nf90_put_att(ftn_ssdev, xtime_ss_ID,& + "begin_date", xtime_begin_date)) + call LVT_verify(nf90_put_att(ftn_ssdev, xtime_ss_ID,& + "begin_time", xtime_begin_time)) + + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "title", & "LVT land surface analysis output")) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"institution", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "institution", & trim(LVT_rc%institution))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"history", & - "created on date: "//date(1:4)//"-"//date(5:6)//"-"//& - date(7:8)//"T"//stime(1:2)//":"//stime(3:4)//":"//stime(5:10))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"references", & - "Kumar_etal_GMD_2012")) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"comment", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "history", & + "created on date: "//date(1:4)//"-"//date(5:6)//"-"// & + date(7:8)//"T"//stime(1:2)//":"//stime(3:4)//":"// & + stime(5:10))) + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "references", "Kumar_etal_GMD_2012")) + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "comment", & "website: http://lis.gsfc.nasa.gov/")) !grid information - if(trim(LVT_rc%domain).eq."latlon") then !latlon - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"MAP_PROJECTION", & + if (trim(LVT_rc%domain) .eq."latlon" ) then !latlon + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "MAP_PROJECTION", & "EQUIDISTANT CYLINDRICAL")) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", & LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", & LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DX", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(9))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(10))) - elseif(trim(LVT_rc%domain).eq."mercator") then - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"MAP_PROJECTION", & + elseif (trim(LVT_rc%domain) .eq. "mercator") then + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "MAP_PROJECTION", & "MERCATOR")) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", & LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", & LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"TRUELAT1", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "TRUELAT1", & LVT_rc%gridDesc(10))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"STANDARD_LON", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "STANDARD_LON", & LVT_rc%gridDesc(11))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DX", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(8))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(9))) - elseif(trim(LVT_rc%domain).eq."lambert") then !lambert conformal - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"MAP_PROJECTION", & + elseif (trim(LVT_rc%domain) .eq. "lambert") then !lambert conformal + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "MAP_PROJECTION", & "LAMBERT CONFORMAL")) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", & LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", & LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"TRUELAT1", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "TRUELAT1", & LVT_rc%gridDesc(10))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"TRUELAT2", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "TRUELAT2", & LVT_rc%gridDesc(7))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"STANDARD_LON", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "STANDARD_LON", & LVT_rc%gridDesc(11))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DX", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(8))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(9))) - elseif(trim(LVT_rc%domain).eq."polar") then ! polar stereographic - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"MAP_PROJECTION", & + elseif (trim(LVT_rc%domain) .eq. "polar") then ! polar stereographic + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "MAP_PROJECTION", & "POLAR STEREOGRAPHIC")) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LAT", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LAT", & LVT_rc%gridDesc(4))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"SOUTH_WEST_CORNER_LON", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "SOUTH_WEST_CORNER_LON", & LVT_rc%gridDesc(5))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"TRUELAT1", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "TRUELAT1", & LVT_rc%gridDesc(10))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"ORIENT", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "ORIENT", & LVT_rc%gridDesc(7))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"STANDARD_LON", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & + "STANDARD_LON", & LVT_rc%gridDesc(11))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DX", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DX", & LVT_rc%gridDesc(8))) - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,"DY", & + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, "DY", & LVT_rc%gridDesc(9))) endif end if @@ -1306,23 +1339,24 @@ subroutine LVT_writeDataStreams do while(associated(dataEntry)) !reset the pointers to the head of the linked list - if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then + if (LVT_LIS_rc(1)%anlys_data_class .eq. "LSM") then lisdataEntry => LVT_LISoutput(1)%head_lsm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Routing") then + elseif (LVT_LIS_rc(1)%anlys_data_class .eq. "Routing") then lisdataEntry => LVT_LISoutput(1)%head_routing_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."RTM") then + elseif (LVT_LIS_rc(1)%anlys_data_class .eq. "RTM") then lisdataEntry => LVT_LISoutput(1)%head_rtm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Irrigation") then + elseif (LVT_LIS_rc(1)%anlys_data_class .eq. "Irrigation") then lisdataEntry => LVT_LISoutput(1)%head_irrig_list endif do while(associated(lisdataEntry)) - if(lisdataEntry%short_name.eq.dataEntry%short_name) then + if (lisdataEntry%short_name .eq. dataEntry%short_name) then call defineNETCDFheaderVar(ftn_mean, dimID, lisdataEntry) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call defineNETCDFheaderVar_ss(ftn_ssdev,dimID, lisdataEntry) + call defineNETCDFheaderVar_ss(ftn_ssdev, dimID, & + lisdataEntry) end if endif @@ -1332,175 +1366,175 @@ subroutine LVT_writeDataStreams enddo ! EMK: Include number of soil layers and soil layer thicknesses - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,& + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & "NUM_SOIL_LAYERS", & - nsoillayers),& + nsoillayers), & 'nf90_put_att for title failed in LVT_DataStreamsMod') - call LVT_verify(nf90_put_att(ftn_mean,NF90_GLOBAL,& + call LVT_verify(nf90_put_att(ftn_mean, NF90_GLOBAL, & "SOIL_LAYER_THICKNESSES", & - lyrthk),& + lyrthk), & 'nf90_put_att for title failed in LVT_DataStreamsMod') if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,& + call LVT_verify(nf90_put_att(ftn_ssdev, NF90_GLOBAL, & "NUM_SOIL_LAYERS", & - nsoillayers),& + nsoillayers), & 'nf90_put_att for title failed in LVT_DataStreamsMod') - call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL,& + call LVT_verify(nf90_put_att(ftn_ssdev,NF90_GLOBAL, & "SOIL_LAYER_THICKNESSES", & - lyrthk),& + lyrthk), & 'nf90_put_att for title failed in LVT_DataStreamsMod') end if ! EMK FIXME...Replace HYCOM with NAVGEM - if(LVT_rc%processHYCOM.eq.1) then + if (LVT_rc%processHYCOM .eq. 1) then ! First, handle water_temp - call LVT_verify(nf90_def_var(ftn_mean,& - trim(LVT_histData%watertemp%short_name),& - nf90_float,& - dimids = dimID(1:2), & - varID=LVT_histData%watertemp%varId_def),& - 'nf90_def_var for '//& - trim(LVT_histData%watertemp%short_name)//& + call LVT_verify(nf90_def_var(ftn_mean, & + trim(LVT_histData%watertemp%short_name), & + nf90_float, & + dimids=dimID(1:2), & + varID=LVT_histData%watertemp%varId_def), & + 'nf90_def_var for '// & + trim(LVT_histData%watertemp%short_name)// & 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_deflate(ftn_mean,& - LVT_histData%watertemp%varId_def,& - shuffle, deflate, deflate_level),& - 'nf90_def_var_deflate for '//& - trim(LVT_histData%watertemp%short_name)//& + call LVT_verify(nf90_def_var_deflate(ftn_mean, & + LVT_histData%watertemp%varId_def, & + shuffle, deflate, deflate_level), & + 'nf90_def_var_deflate for '// & + trim(LVT_histData%watertemp%short_name)// & 'failed in defineNETCDFheadervar') #endif !EMK...Add variable attributes - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "units",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "units", & trim(LVT_histData%watertemp%units))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "standard_name",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "standard_name", & trim(LVT_histData%watertemp%standard_name))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "long_name",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "long_name", & trim(LVT_histData%watertemp%long_name))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "scale_factor",1.0)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "add_offset",0.0)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "missing_value",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "_FillValue",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "vmin",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%watertemp%varId_def,& - "vmax",LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "scale_factor", 1.0)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "add_offset", 0.0)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "missing_value", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "_FillValue", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "vmin", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%watertemp%varId_def, & + "vmax", LVT_rc%udef)) ! Next, add aice - call LVT_verify(nf90_def_var(ftn_mean,& - trim(LVT_histData%aice%short_name),& - nf90_float,& - dimids = dimID(1:2), & - varID=LVT_histData%aice%varId_def),& - 'nf90_def_var for '//& - trim(LVT_histData%aice%short_name)//& + call LVT_verify(nf90_def_var(ftn_mean, & + trim(LVT_histData%aice%short_name), & + nf90_float, & + dimids=dimID(1:2), & + varID=LVT_histData%aice%varId_def), & + 'nf90_def_var for '// & + trim(LVT_histData%aice%short_name)// & 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_deflate(ftn_mean,& - LVT_histData%aice%varId_def,& - shuffle, deflate, deflate_level),& - 'nf90_def_var_deflate for '//& - trim(LVT_histData%aice%short_name)//& + call LVT_verify(nf90_def_var_deflate(ftn_mean, & + LVT_histData%aice%varId_def, & + shuffle, deflate, deflate_level), & + 'nf90_def_var_deflate for '// & + trim(LVT_histData%aice%short_name)// & 'failed in defineNETCDFheadervar') #endif - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "units",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "units", & trim(LVT_histData%aice%units))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "standard_name",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "standard_name", & trim(LVT_histData%aice%standard_name))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "long_name",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "long_name", & trim(LVT_histData%aice%long_name))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "scale_factor",1.0)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "add_offset",0.0)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "missing_value",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "_FillValue",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "vmin",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%aice%varId_def,& - "vmax",LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "scale_factor", 1.0)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "add_offset", 0.0)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "missing_value", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "_FillValue", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "vmin", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%aice%varId_def, & + "vmax", LVT_rc%udef)) ! Next, add hi - call LVT_verify(nf90_def_var(ftn_mean,& - trim(LVT_histData%hi%short_name),& - nf90_float,& - dimids = dimID(1:2), & - varID=LVT_histData%hi%varId_def),& - 'nf90_def_var for '//& - trim(LVT_histData%hi%short_name)//& + call LVT_verify(nf90_def_var(ftn_mean, & + trim(LVT_histData%hi%short_name), & + nf90_float, & + dimids=dimID(1:2), & + varID=LVT_histData%hi%varId_def), & + 'nf90_def_var for '// & + trim(LVT_histData%hi%short_name)// & 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_deflate(ftn_mean,& - LVT_histData%hi%varId_def,& - shuffle, deflate, deflate_level),& - 'nf90_def_var_deflate for '//& - trim(LVT_histData%hi%short_name)//& + call LVT_verify(nf90_def_var_deflate(ftn_mean, & + LVT_histData%hi%varId_def, & + shuffle, deflate, deflate_level), & + 'nf90_def_var_deflate for '// & + trim(LVT_histData%hi%short_name)// & 'failed in defineNETCDFheadervar') #endif - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "units",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "units", & trim(LVT_histData%hi%units))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "standard_name",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "standard_name", & trim(LVT_histData%hi%standard_name))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "long_name",& + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "long_name", & trim(LVT_histData%hi%long_name))) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "scale_factor",1.0)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "add_offset",0.0)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "missing_value",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "_FillValue",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "vmin",LVT_rc%udef)) - call LVT_verify(nf90_put_att(ftn_mean,& - LVT_histData%hi%varId_def,& - "vmax",LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "scale_factor", 1.0)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "add_offset", 0.0)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "missing_value", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "_FillValue", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "vmin", LVT_rc%udef)) + call LVT_verify(nf90_put_att(ftn_mean, & + LVT_histData%hi%varId_def, & + "vmax", LVT_rc%udef)) endif ! EMK...Add additional PS41 snow variable headers. @@ -1531,48 +1565,48 @@ subroutine LVT_writeDataStreams ! EMK END PS41 snow headers call LVT_verify(nf90_enddef(ftn_mean)) - call LVT_verify(nf90_put_var(ftn_mean,xtimeID,0.0)) + call LVT_verify(nf90_put_var(ftn_mean, xtimeID, 0.0)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then call LVT_verify(nf90_enddef(ftn_ssdev)) - call LVT_verify(nf90_put_var(ftn_ssdev,xtime_ss_ID,0.0)) + call LVT_verify(nf90_put_var(ftn_ssdev, xtime_ss_ID, 0.0)) end if ! EMK...lat/lon calculated above for all output file types. - call LVT_verify(nf90_put_var(ftn_mean,xlatID, & - lat, (/1,1/),& - (/LVT_rc%gnc,LVT_rc%gnr/)),& + call LVT_verify(nf90_put_var(ftn_mean, xlatID, & + lat, (/1, 1/), & + (/LVT_rc%gnc, LVT_rc%gnr/)), & 'nf90_put_var failed for lat') - call LVT_verify(nf90_put_var(ftn_mean,xlonID, & - lon, (/1,1/),& - (/LVT_rc%gnc,LVT_rc%gnr/)),& + call LVT_verify(nf90_put_var(ftn_mean, xlonID, & + lon, (/1, 1/), & + (/LVT_rc%gnc, LVT_rc%gnr/)), & 'nf90_put_var failed for lon') if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call LVT_verify(nf90_put_var(ftn_ssdev,xlat_ss_ID, & - lat, (/1,1/),& - (/LVT_rc%gnc,LVT_rc%gnr/)),& + call LVT_verify(nf90_put_var(ftn_ssdev, xlat_ss_ID, & + lat, (/1, 1/),& + (/LVT_rc%gnc, LVT_rc%gnr/)),& 'nf90_put_var failed for lat') - call LVT_verify(nf90_put_var(ftn_ssdev,xlon_ss_ID, & - lon, (/1,1/),& - (/LVT_rc%gnc,LVT_rc%gnr/)),& + call LVT_verify(nf90_put_var(ftn_ssdev, xlon_ss_ID, & + lon, (/1, 1/),& + (/LVT_rc%gnc, LVT_rc%gnr/)),& 'nf90_put_var failed for lon') end if endif ! EMK Output updated PS41 snow variables not read in from LIS file if (jules_ps41_ens_snow) then - if (LVT_rc%lvt_out_format.eq."netcdf") then + if (LVT_rc%lvt_out_format .eq. "netcdf") then gtmp1_1d = 0.0 call LVT_fetch_jules_ps41_ens_snow_final( & LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & 1, "SWE_inst", is_ps41_snow_var) - call writeSingleNetcdfVar(ftn_mean,& - gtmp1_1d,& - SWE%varid_def,& + call writeSingleNetcdfVar(ftn_mean, & + gtmp1_1d, & + SWE%varid_def, & 1) gtmp1_1d = 0.0 @@ -1599,7 +1633,7 @@ subroutine LVT_writeDataStreams call LVT_fetch_jules_ps41_ens_snow_final( & LVT_rc%lnc, LVT_rc%lnr, gtmp1_1d, & 1, "SnowGrain_inst", is_ps41_snow_var) - call writeSingleNetcdfVar(ftn_mean,& + call writeSingleNetcdfVar(ftn_mean, & gtmp1_1d, & SnowGrain%varid_def, & 1) @@ -1650,59 +1684,60 @@ subroutine LVT_writeDataStreams dataEntry => LVT_histData%head_ds1_list - do while(associated(dataEntry)) + do while (associated(dataEntry)) !reset the pointers to the head of the linked list - if(LVT_LIS_rc(1)%anlys_data_class.eq."LSM") then + if (LVT_LIS_rc(1)%anlys_data_class .eq. "LSM") then lisdataEntry => LVT_LISoutput(1)%head_lsm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Routing") then + elseif (LVT_LIS_rc(1)%anlys_data_class .eq. "Routing") then lisdataEntry => LVT_LISoutput(1)%head_routing_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."RTM") then + elseif (LVT_LIS_rc(1)%anlys_data_class .eq. "RTM") then lisdataEntry => LVT_LISoutput(1)%head_rtm_list - elseif(LVT_LIS_rc(1)%anlys_data_class.eq."Irrigation") then + elseif (LVT_LIS_rc(1)%anlys_data_class .eq. "Irrigation") then lisdataEntry => LVT_LISoutput(1)%head_irrig_list endif - do while(associated(lisdataEntry)) + do while (associated(lisdataEntry)) - if(lisdataEntry%short_name.eq.dataEntry%short_name) then - - ! Set timerange indicator equal to 133 for AFWA's specifications - ! for surface runoff, baseflow, and total precipitation - ! to make the LIS-7 output match the LIS-6 style. - dmm + if (lisdataEntry%short_name .eq. dataEntry%short_name) then + ! Set timerange indicator equal to 133 for AFWA's + ! specifications for surface runoff, baseflow, and total + ! precipitation to make the LIS-7 output match the LIS-6 + ! style. - dmm ! EMK...Revised settings based on name of variable - if (index(trim(dataEntry%short_name),"_max") .gt. 0) then + if (index(trim(dataEntry%short_name), "_max") .gt. 0) then stepType = "max" timeRange = 7 pdTemplate = 12 ! Derived fcsts from ensemble over time interval - else if (index(trim(dataEntry%short_name),"_min") .gt. 0) then + else if (index(trim(dataEntry%short_name), "_min") .gt. 0) then stepType = "min" timeRange = 7 pdTemplate = 12 ! Derived fcsts from ensemble over time interval - else if (dataEntry%timeAvgOpt.eq.0) then + else if (dataEntry%timeAvgOpt .eq. 0) then stepType = "instant" timeRange = 1 pdTemplate = 2 ! Derived fcst from ensemble at point in time - else if (dataEntry%timeAvgOpt.eq.1 .or. & - dataEntry%timeAvgOpt.eq.2) then + + else if (dataEntry%timeAvgOpt .eq. 1 .or. & + dataEntry%timeAvgOpt .eq. 2) then stepType = "avg" timeRange = 7 pdTemplate = 12 ! Derived fcsts from ensemble over time interval - else if (dataEntry%timeAvgOpt.eq.3) then + else if (dataEntry%timeAvgOpt .eq. 3) then stepType = "accum" timeRange = 7 ! "between first and second" pdTemplate = 12 ! Derived fcsts from ensemble over time interval else - write(LVT_logunit,*)'[ERR] Cannot handle ',& + write(LVT_logunit,*)'[ERR] Cannot handle ', & trim(dataEntry%short_name) call LVT_endrun() end if - if ((lisdataEntry%index.eq.LVT_LIS_MOC_QS(1)).or. & - (lisdataEntry%index.eq.LVT_LIS_MOC_QSB(1)).or. & - (lisdataEntry%index.eq.LVT_LIS_MOC_TOTALPRECIP(1))) then + if ((lisdataEntry%index .eq. LVT_LIS_MOC_QS(1)) .or. & + (lisdataEntry%index .eq. LVT_LIS_MOC_QSB(1)) .or. & + (lisdataEntry%index .eq. LVT_LIS_MOC_TOTALPRECIP(1))) then ! EMK...GRIB1 only - if(LVT_rc%lvt_out_format.ne."grib2") then + if(LVT_rc%lvt_out_format .ne. "grib2") then timeRange = 133 end if endif @@ -1718,7 +1753,7 @@ subroutine LVT_writeDataStreams ! EMK...Reworked ensemble statistics code. Allow application ! of noises smoother to each ensemble member *before* ! calculating ensemble mean and spread. - do k=1, dataEntry%vlevels + do k = 1, dataEntry%vlevels gtmp1_1d(:) = 0.0 ngtmp1_1d(:) = 0 gtmp1_ss(:) = 0.0 @@ -1744,48 +1779,48 @@ subroutine LVT_writeDataStreams ! Only write ensemble mean for PS41 snow variables if (LVT_rc%lvt_out_format .eq. "grib2") then - call writeSingleGrib2Var(ftn_mean,& - gtmp1_1d,& - lisdataentry%varid_def,& - lisdataentry%gribSF,& - lisdataentry%gribSfc,& - lisdataentry%gribLvl,& - lisdataentry%gribDis,& - lisdataentry%gribCat,& - pdTemplate,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - k,& - toplev(k:k),& - botlev(k:k),& + call writeSingleGrib2Var(ftn_mean, & + gtmp1_1d, & + lisdataentry%varid_def, & + lisdataentry%gribSF, & + lisdataentry%gribSfc, & + lisdataentry%gribLvl, & + lisdataentry%gribDis, & + lisdataentry%gribCat, & + pdTemplate, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + k, & + toplev(k:k), & + botlev(k:k), & depscale(k:k), & typeOfGeneratingProcess=4, & typeOfProcessedData=4) - elseif(LVT_rc%lvt_out_format.eq."grib1") then - call writeSingleGrib1Var(ftn_mean,& - gtmp1_1d,& - lisdataentry%varid_def,& - lisdataentry%gribSF,& - lisdataentry%gribSfc,& - lisdataentry%gribLvl,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - k,& - toplev(k:k),& + elseif (LVT_rc%lvt_out_format .eq. "grib1") then + call writeSingleGrib1Var(ftn_mean, & + gtmp1_1d, & + lisdataentry%varid_def, & + lisdataentry%gribSF, & + lisdataentry%gribSfc, & + lisdataentry%gribLvl, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + k, & + toplev(k:k), & botlev(k:k)) - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif (LVT_rc%lvt_out_format .eq. "netcdf") then - call writeSingleNetcdfVar(ftn_mean,& - gtmp1_1d,& - lisdataentry%varid_def,& + call writeSingleNetcdfVar(ftn_mean, & + gtmp1_1d, & + lisdataentry%varid_def, & k) end if ! output format @@ -1799,16 +1834,16 @@ subroutine LVT_writeDataStreams end if ! If processing JULES PS41 snow ensembles. ! Normal ensemble postprocessing starts here. - do m=1,LVT_rc%nensem + do m = 1, LVT_rc%nensem ! Must initialize ensemble member with "undefined" for ! noise smoother gtmp1_1d_mem(:) = LVT_rc%udef - do r=1,LVT_rc%lnr - do c=1,LVT_rc%lnc - if(LVT_domain%gindex(c,r).ne.-1) then + do r = 1, LVT_rc%lnr + do c = 1, LVT_rc%lnc + if (LVT_domain%gindex(c,r) .ne. -1) then gid = LVT_domain%gindex(c,r) - gtmp1_1d_mem(c+(r-1)*LVT_rc%lnc) = & + gtmp1_1d_mem(c + (r-1)*LVT_rc%lnc) = & dataEntry%value(gid,m,k) endif enddo ! c @@ -1825,36 +1860,37 @@ subroutine LVT_writeDataStreams (dataEntry%short_name .eq. "Landcover") .or. & (dataEntry%short_name .eq. "Landmask") .or. & (dataEntry%short_name .eq. "Soiltype"))) then - if(LVT_rc%applyNoiseReductionFilter.eq.1) then + if (LVT_rc%applyNoiseReductionFilter .eq. 1) then call applyNoiseReductionFilter(gtmp1_1d_mem) end if end if ! Now provide smoothed field to ensemble mean and ! spread - do r=1,LVT_rc%lnr - do c=1,LVT_rc%lnc - if(LVT_domain%gindex(c,r).ne.-1) then + do r = 1,LVT_rc%lnr + do c = 1,LVT_rc%lnc + if (LVT_domain%gindex(c,r) .ne. -1) then gid = LVT_domain%gindex(c,r) if (LVT_rc%nensem > 1) then ! Use Welford algorithm to calculate ! mean and standard deviation - count = ngtmp1_1d(c+(r-1)*LVT_rc%lnc) - mean = gtmp1_1d(c+(r-1)*LVT_rc%lnc) - m2 = gtmp1_ss(c+(r-1)*LVT_rc%lnc) - new_value = gtmp1_1d_mem(c+(r-1)*LVT_rc%lnc) + count = ngtmp1_1d(c + (r-1)*LVT_rc%lnc) + mean = gtmp1_1d(c + (r-1)*LVT_rc%lnc) + m2 = gtmp1_ss(c + (r-1)*LVT_rc%lnc) + new_value = & + gtmp1_1d_mem(c + (r-1)*LVT_rc%lnc) call welford_update(count, mean, m2, & new_value) - ngtmp1_1d(c+(r-1)*LVT_rc%lnc) = count - gtmp1_1d(c+(r-1)*LVT_rc%lnc) = mean - gtmp1_ss(c+(r-1)*LVT_rc%lnc) = m2 + ngtmp1_1d(c + (r-1)*LVT_rc%lnc) = count + gtmp1_1d(c + (r-1)*LVT_rc%lnc) = mean + gtmp1_ss(c + (r-1)*LVT_rc%lnc) = m2 else - gtmp1_1d(c+(r-1)*LVT_rc%lnc) = & - gtmp1_1d(c+(r-1)*LVT_rc%lnc) + & - gtmp1_1d_mem(c+(r-1)*LVT_rc%lnc) - ngtmp1_1d(c+(r-1)*LVT_rc%lnc) = & - ngtmp1_1d(c+(r-1)*LVT_rc%lnc) + 1 + gtmp1_1d(c + (r-1)*LVT_rc%lnc) = & + gtmp1_1d(c + (r-1)*LVT_rc%lnc) + & + gtmp1_1d_mem(c + (r-1)*LVT_rc%lnc) + ngtmp1_1d(c + (r-1)*LVT_rc%lnc) = & + ngtmp1_1d(c + (r-1)*LVT_rc%lnc) + 1 end if endif enddo ! c @@ -1863,55 +1899,55 @@ subroutine LVT_writeDataStreams end do ! m ! Finalize the ensemble mean and spread - do r=1,LVT_rc%lnr - do c=1,LVT_rc%lnc + do r = 1, LVT_rc%lnr + do c = 1, LVT_rc%lnc if (LVT_rc%nensem > 1) then ! Use Welford algorithm to calculate mean and ! standard deviation - count = ngtmp1_1d(c+(r-1)*LVT_rc%lnc) + count = ngtmp1_1d(c + (r-1)*LVT_rc%lnc) if (count < 1) then - gtmp1_1d(c+(r-1)*LVT_rc%lnc) = LVT_rc%udef - gtmp1_ss(c+(r-1)*LVT_rc%lnc) = LVT_rc%udef + gtmp1_1d(c + (r-1)*LVT_rc%lnc) = LVT_rc%udef + gtmp1_ss(c + (r-1)*LVT_rc%lnc) = LVT_rc%udef else - mean = gtmp1_1d(c+(r-1)*LVT_rc%lnc) - m2 = gtmp1_ss(c+(r-1)*LVT_rc%lnc) + mean = gtmp1_1d(c + (r-1)*LVT_rc%lnc) + m2 = gtmp1_ss(c + (r-1)*LVT_rc%lnc) call welford_finalize(count, mean, m2, stddev) - gtmp1_1d(c+(r-1)*LVT_rc%lnc) = mean - gtmp1_ss(c+(r-1)*LVT_rc%lnc) = stddev + gtmp1_1d(c + (r-1)*LVT_rc%lnc) = mean + gtmp1_ss(c + (r-1)*LVT_rc%lnc) = stddev end if else ! No ensembles, just calculate mean - if(ngtmp1_1d(c+(r-1)*LVT_rc%lnc).gt.0) then - gtmp1_1d(c+(r-1)*LVT_rc%lnc) = & - gtmp1_1d(c+(r-1)*LVT_rc%lnc)/& - ngtmp1_1d(c+(r-1)*LVT_rc%lnc) + if(ngtmp1_1d(c + (r-1)*LVT_rc%lnc).gt.0) then + gtmp1_1d(c + (r-1)*LVT_rc%lnc) = & + gtmp1_1d(c + (r-1)*LVT_rc%lnc)/& + ngtmp1_1d(c + (r-1)*LVT_rc%lnc) else - gtmp1_1d(c+(r-1)*LVT_rc%lnc) = LVT_rc%udef + gtmp1_1d(c + (r-1)*LVT_rc%lnc) = LVT_rc%udef end if - gtmp1_ss(c+(r-1)*LVT_rc%lnc) = LVT_rc%udef + gtmp1_ss(c + (r-1)*LVT_rc%lnc) = LVT_rc%udef end if enddo ! c enddo ! r ! EMK END...k loop ends further down - if(LVT_rc%lvt_out_format.eq."grib2") then - - call writeSingleGrib2Var(ftn_mean,& - gtmp1_1d,& - lisdataentry%varid_def,& - lisdataentry%gribSF,& - lisdataentry%gribSfc,& - lisdataentry%gribLvl,& - lisdataentry%gribDis,& - lisdataentry%gribCat,& - pdTemplate,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - k,& - toplev(k:k),& - botlev(k:k),& + if (LVT_rc%lvt_out_format .eq. "grib2") then + + call writeSingleGrib2Var(ftn_mean, & + gtmp1_1d, & + lisdataentry%varid_def, & + lisdataentry%gribSF, & + lisdataentry%gribSfc, & + lisdataentry%gribLvl, & + lisdataentry%gribDis, & + lisdataentry%gribCat, & + pdTemplate, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + k, & + toplev(k:k), & + botlev(k:k), & depscale(k:k), & typeOfGeneratingProcess=4, & typeOfProcessedData=4) @@ -1919,23 +1955,23 @@ subroutine LVT_writeDataStreams if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 & .and. .not. jules_ps41_ens_snow) then - call writeSingleGrib2Var(ftn_ssdev,& - gtmp1_ss,& - lisdataentry%varid_def,& - lisdataentry%gribSF,& - lisdataentry%gribSfc,& - lisdataentry%gribLvl,& - lisdataentry%gribDis,& - lisdataentry%gribCat,& - pdTemplate,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - k,& - toplev(k:k),& - botlev(k:k),& + call writeSingleGrib2Var(ftn_ssdev, & + gtmp1_ss, & + lisdataentry%varid_def, & + lisdataentry%gribSF, & + lisdataentry%gribSfc, & + lisdataentry%gribLvl, & + lisdataentry%gribDis, & + lisdataentry%gribCat, & + pdTemplate, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + k, & + toplev(k:k), & + botlev(k:k), & depscale(k:k), & ensembleSpread=.true., & typeOfGeneratingProcess=4, & @@ -1943,52 +1979,52 @@ subroutine LVT_writeDataStreams end if elseif(LVT_rc%lvt_out_format.eq."grib1") then - call writeSingleGrib1Var(ftn_mean,& - gtmp1_1d,& - lisdataentry%varid_def,& - lisdataentry%gribSF,& - lisdataentry%gribSfc,& - lisdataentry%gribLvl,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - k,& - toplev(k:k),& + call writeSingleGrib1Var(ftn_mean, & + gtmp1_1d, & + lisdataentry%varid_def, & + lisdataentry%gribSF, & + lisdataentry%gribSfc, & + lisdataentry%gribLvl, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + k, & + toplev(k:k), & botlev(k:k)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 & .and. .not. jules_ps41_ens_snow) then - call writeSingleGrib1Var(ftn_ssdev,& - gtmp1_ss,& - lisdataentry%varid_def,& - lisdataentry%gribSF,& - lisdataentry%gribSfc,& - lisdataentry%gribLvl,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - k,& - toplev(k:k),& + call writeSingleGrib1Var(ftn_ssdev, & + gtmp1_ss, & + lisdataentry%varid_def, & + lisdataentry%gribSF, & + lisdataentry%gribSfc, & + lisdataentry%gribLvl, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + k, & + toplev(k:k), & botlev(k:k)) end if - elseif(LVT_rc%lvt_out_format.eq."netcdf") then - call writeSingleNetcdfVar(ftn_mean,& - gtmp1_1d,& - lisdataentry%varid_def,& + elseif (LVT_rc%lvt_out_format .eq. "netcdf") then + call writeSingleNetcdfVar(ftn_mean, & + gtmp1_1d, & + lisdataentry%varid_def, & k) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 & .and. .not. jules_ps41_ens_snow) then - call writeSingleNetcdfVar(ftn_ssdev,& - gtmp1_ss,& - lisdataentry%varid_ss,& + call writeSingleNetcdfVar(ftn_ssdev, & + gtmp1_ss, & + lisdataentry%varid_ss, & k) end if endif @@ -2007,14 +2043,14 @@ subroutine LVT_writeDataStreams end if ! EMK...Use HYCOM for sea ice, and NAVGEM for SST. - call LVT_append_HYCOM_cice_fields(ftn_mean,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - toplev(1),& - botlev(1),& - lat,lon) + call LVT_append_HYCOM_cice_fields(ftn_mean, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + toplev(1), & + botlev(1), & + lat, lon) call LVT_append_navgem_sst_field(ftn_mean, & time_unit, & time_past, & @@ -2023,19 +2059,19 @@ subroutine LVT_writeDataStreams toplev(1), & botlev(1)) - if(LVT_rc%lvt_out_format.eq."grib1") then - call grib_close_file(ftn_mean,iret) + if (LVT_rc%lvt_out_format .eq. "grib1") then + call grib_close_file(ftn_mean, iret) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call grib_close_file(ftn_ssdev,iret) + call grib_close_file(ftn_ssdev, iret) end if - elseif(LVT_rc%lvt_out_format.eq."grib2") then - call grib_close_file(ftn_mean,iret) + elseif (LVT_rc%lvt_out_format .eq. "grib2") then + call grib_close_file(ftn_mean, iret) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then - call grib_close_file(ftn_ssdev,iret) + call grib_close_file(ftn_ssdev, iret) end if - elseif(LVT_rc%lvt_out_format.eq."netcdf") then + elseif (LVT_rc%lvt_out_format .eq. "netcdf") then call LVT_verify(nf90_close(ftn_mean)) if (LVT_rc%tavgInterval == LVT_rc%ts .and. & LVT_rc%nensem > 1 .and. .not. jules_ps41_ens_snow) then @@ -2070,7 +2106,7 @@ logical function alarm_is_on() result(alarmCheck) curtime) difftime = curtime - starttime if (difftime .gt. 0) then - if (mod(difftime,LVT_rc%statswriteint).eq.0) then + if (mod(difftime, LVT_rc%statswriteint) .eq. 0) then alarmCheck = .true. end if end if @@ -2341,7 +2377,7 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & ! find the filename, open the file, read the field - if(LVT_rc%processHYCOM.eq.1) then + if (LVT_rc%processHYCOM .eq. 1) then ! *** HANDLE SST *** ! write(unit=cdate,fmt='(i4.4,i2.2,i2.2,i2.2)') & @@ -2504,8 +2540,8 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & ! watert = LVT_rc%udef aice_arc = LVT_rc%udef - call get_hycom_cice_filename('ARC',hycom_fname, & - cice_arc_year,cice_arc_month,cice_arc_day,cice_arc_hour, & + call get_hycom_cice_filename('ARC', hycom_fname, & + cice_arc_year, cice_arc_month, cice_arc_day, cice_arc_hour, & cice_arc_fcst_hr) if (trim(hycom_fname) == "NONE") then file_exists = .false. @@ -2516,21 +2552,22 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & aice_arc_1d(:) = -9999 aice_arc_ip(:) = -9999 - if(file_exists) then + if (file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) - write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) + write(LVT_logunit,*) '[INFO] Reading HYCOM data ', trim(hycom_fname) - ios = nf90_open(path=trim(hycom_fname),mode=NF90_NOWRITE,ncid=nid) + ios = nf90_open(path=trim(hycom_fname), mode=NF90_NOWRITE, ncid=nid) call LVT_verify(ios, 'Error opening file'//trim(hycom_fname)) !variable ids - ios = nf90_inq_varid(nid, 'aice',aice_arc_id) + ios = nf90_inq_varid(nid, 'aice', aice_arc_id) call LVT_verify(ios, 'Error nf90_inq_varid: aice') !values ios = nf90_get_var(nid,aice_arc_id, aice_arc,& - start=(/1,1,1,1/), & - count=(/LVT_rc%HYCOM_aice_arc_nc,LVT_rc%HYCOM_aice_arc_nr,1,1/)) + start=(/1, 1, 1, 1/), & + count=(/LVT_rc%HYCOM_aice_arc_nc, LVT_rc%HYCOM_aice_arc_nr, & + 1, 1/)) call LVT_verify(ios, 'Error nf90_get_var: aice_arc') ios = nf90_close(nid) @@ -2539,21 +2576,21 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & aice_arc_1d = -9999.0 aice_arc_lb = .false. - do r=1,LVT_rc%HYCOM_aice_arc_nr - do c=1,LVT_rc%HYCOM_aice_arc_nc - if(aice_arc(c,r,1,1).ne.-30000) then + do r = 1, LVT_rc%HYCOM_aice_arc_nr + do c = 1, LVT_rc%HYCOM_aice_arc_nc + if (aice_arc(c,r,1,1) .ne. -30000) then c1 = c r1 = r - aice_arc_1d(c1+(r1-1)*LVT_rc%HYCOM_aice_arc_nc) = & + aice_arc_1d(c1 + (r1-1)*LVT_rc%HYCOM_aice_arc_nc) = & aice_arc(c,r,1,1)*0.0001 - aice_arc_lb(c1+(r1-1)*LVT_rc%HYCOM_aice_arc_nc) = .true. + aice_arc_lb(c1 + (r1-1)*LVT_rc%HYCOM_aice_arc_nc) = .true. endif enddo enddo - call upscaleByAveraging(& + call upscaleByAveraging( & LVT_rc%HYCOM_aice_arc_nc*LVT_rc%HYCOM_aice_arc_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_aice_arc_n11, aice_arc_lb, & @@ -2572,10 +2609,10 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & ! write(LVT_logunit,*)'[WARN], missing file ',trim(hycom_fname) ! end if - aice_ant = LVT_rc%udef - call get_hycom_cice_filename('ANT',hycom_fname, & - cice_ant_year,cice_ant_month,cice_ant_day, & - cice_ant_hour,cice_ant_fcst_hr) + aice_ant = LVT_rc%udef + call get_hycom_cice_filename('ANT', hycom_fname, & + cice_ant_year, cice_ant_month, cice_ant_day, & + cice_ant_hour, cice_ant_fcst_hr) if (trim(hycom_fname) == "NONE") then file_exists = .false. else @@ -2585,21 +2622,22 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & aice_ant_1d = -9999.0 aice_ant_ip(:) = -9999 - if(file_exists) then + if (file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) - write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) + write(LVT_logunit,*) '[INFO] Reading HYCOM data ', trim(hycom_fname) - ios = nf90_open(path=trim(hycom_fname),mode=NF90_NOWRITE,ncid=nid) + ios = nf90_open(path=trim(hycom_fname), mode=NF90_NOWRITE, ncid=nid) call LVT_verify(ios, 'Error opening file'//trim(hycom_fname)) !variable ids - ios = nf90_inq_varid(nid, 'aice',aice_ant_id) + ios = nf90_inq_varid(nid, 'aice', aice_ant_id) call LVT_verify(ios, 'Error nf90_inq_varid: aice') !values - ios = nf90_get_var(nid,aice_ant_id, aice_ant,& - start=(/1,1,1,1/), & - count=(/LVT_rc%HYCOM_aice_ant_nc,LVT_rc%HYCOM_aice_ant_nr,1,1/)) + ios = nf90_get_var(nid, aice_ant_id, aice_ant,& + start=(/1, 1, 1, 1/), & + count=(/LVT_rc%HYCOM_aice_ant_nc, LVT_rc%HYCOM_aice_ant_nr, & + 1, 1/)) call LVT_verify(ios, 'Error nf90_get_var: aice_ant') ios = nf90_close(nid) @@ -2608,20 +2646,20 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & aice_ant_1d = -9999.0 aice_ant_lb = .false. - do r=1,LVT_rc%HYCOM_aice_ant_nr - do c=1,LVT_rc%HYCOM_aice_ant_nc - if(aice_ant(c,r,1,1).ne.-30000) then + do r = 1, LVT_rc%HYCOM_aice_ant_nr + do c = 1, LVT_rc%HYCOM_aice_ant_nc + if (aice_ant(c,r,1,1) .ne. -30000) then c1 = c r1 = r - aice_ant_1d(c1+(r1-1)*LVT_rc%HYCOM_aice_ant_nc) = & + aice_ant_1d(c1 + (r1-1)*LVT_rc%HYCOM_aice_ant_nc) = & aice_ant(c,r,1,1)*0.0001 - aice_ant_lb(c1+(r1-1)*LVT_rc%HYCOM_aice_ant_nc) = .true. + aice_ant_lb(c1 + (r1-1)*LVT_rc%HYCOM_aice_ant_nc) = .true. endif enddo enddo - call upscaleByAveraging(& + call upscaleByAveraging( & LVT_rc%HYCOM_aice_ant_nc*LVT_rc%HYCOM_aice_ant_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_aice_ant_n11, aice_ant_lb, & @@ -2646,8 +2684,8 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & do c = 1, LVT_rc%gnc gid = LVT_domain%gindex(c,r) if (gid .eq. -1) then - if (aice_ip(c+(r-1)*LVT_rc%gnc) == -9999) then - aice_ip(c+(r-1)*LVT_rc%gnc) = 0 + if (aice_ip(c + (r-1)*LVT_rc%gnc) == -9999) then + aice_ip(c + (r-1)*LVT_rc%gnc) = 0 end if end if end do ! c @@ -2664,7 +2702,7 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & gribSF = 100 gribLvl = 1 - if(LVT_rc%lvt_out_format.eq."grib2") then + if (LVT_rc%lvt_out_format .eq. "grib2" ) then ! EMK...Use older cice date/time if (cice_ant_year .lt. cice_arc_year .or. & cice_ant_month .lt. cice_arc_month .or. & @@ -2676,51 +2714,51 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & cice_arc_hour = cice_arc_hour cice_arc_fcst_hr = cice_ant_fcst_hr end if - call writeSingleGrib2Var(ftn_mean,& - aice_ip,& - varid_def,& - gribSF,& - gribSfc,& - gribLvl,& - gribDis,& - gribCat,& - pdTemplate,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - 1,& - toplev(1),& - botlev(1),& - depscale(1),& + call writeSingleGrib2Var(ftn_mean, & + aice_ip, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + gribDis, & + gribCat, & + pdTemplate, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & + botlev(1), & + depscale(1), & typeOfGeneratingProcess=2, & typeOfProcessedData=1, & ref_year=cice_arc_year, & ref_month=cice_arc_month,& - ref_day=cice_arc_day,& - ref_hour=cice_arc_hour,& + ref_day=cice_arc_day, & + ref_hour=cice_arc_hour, & ref_fcst_hr=cice_arc_fcst_hr) - elseif(LVT_rc%lvt_out_format.eq."grib1") then - call writeSingleGrib1Var(ftn_mean,& - aice_ip,& - varid_def,& - gribSF,& - gribSfc,& - gribLvl,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - 1,& - toplev(1),& + elseif (LVT_rc%lvt_out_format .eq. "grib1") then + call writeSingleGrib1Var(ftn_mean, & + aice_ip, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & botlev(1)) - elseif(LVT_rc%lvt_out_format.eq."netcdf") then - call writeSingleNetcdfVar(ftn_mean,& - aice_ip,& - LVT_histData%aice%varId_def,& + elseif (LVT_rc%lvt_out_format .eq. "netcdf") then + call writeSingleNetcdfVar(ftn_mean, & + aice_ip, & + LVT_histData%aice%varId_def, & 1) endif @@ -2738,10 +2776,10 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & ! write(LVT_logunit,*)'[WARN], missing file ',trim(hycom_fname) ! end if - hi_arc = LVT_rc%udef - call get_hycom_cice_filename('ARC',hycom_fname, & - hi_arc_year,hi_arc_month,hi_arc_day, & - hi_arc_hour,hi_arc_fcst_hr) + hi_arc = LVT_rc%udef + call get_hycom_cice_filename('ARC', hycom_fname, & + hi_arc_year, hi_arc_month, hi_arc_day, & + hi_arc_hour, hi_arc_fcst_hr) if (trim(hycom_fname) == "NONE") then file_exists = .false. @@ -2754,19 +2792,19 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & if(file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) - write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) + write(LVT_logunit,*) '[INFO] Reading HYCOM data ', trim(hycom_fname) - ios = nf90_open(path=trim(hycom_fname),mode=NF90_NOWRITE,ncid=nid) + ios = nf90_open(path=trim(hycom_fname), mode=NF90_NOWRITE, ncid=nid) call LVT_verify(ios, 'Error opening file'//trim(hycom_fname)) !variable ids - ios = nf90_inq_varid(nid, 'hi',hi_arc_id) + ios = nf90_inq_varid(nid, 'hi', hi_arc_id) call LVT_verify(ios, 'Error nf90_inq_varid: hi') !values ios = nf90_get_var(nid,hi_arc_id, hi_arc,& - start=(/1,1,1,1/), & - count=(/LVT_rc%HYCOM_hi_arc_nc,LVT_rc%HYCOM_hi_arc_nr,1,1/)) + start=(/1, 1, 1, 1/), & + count=(/LVT_rc%HYCOM_hi_arc_nc, LVT_rc%HYCOM_hi_arc_nr, 1, 1/)) call LVT_verify(ios, 'Error nf90_get_var: hi_arc') ios = nf90_close(nid) @@ -2775,21 +2813,21 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & hi_arc_1d = -9999.0 hi_arc_lb = .false. - do r=1,LVT_rc%HYCOM_hi_arc_nr - do c=1,LVT_rc%HYCOM_hi_arc_nc - if(hi_arc(c,r,1,1).ne.-30000) then + do r = 1, LVT_rc%HYCOM_hi_arc_nr + do c = 1, LVT_rc%HYCOM_hi_arc_nc + if (hi_arc(c,r,1,1) .ne. -30000) then c1 = c r1 = r - hi_arc_1d(c1+(r1-1)*LVT_rc%HYCOM_hi_arc_nc) = & + hi_arc_1d(c1 + (r1-1)*LVT_rc%HYCOM_hi_arc_nc) = & hi_arc(c,r,1,1)*0.001 - hi_arc_lb(c1+(r1-1)*LVT_rc%HYCOM_hi_arc_nc) = .true. + hi_arc_lb(c1 + (r1-1)*LVT_rc%HYCOM_hi_arc_nc) = .true. endif enddo enddo - call upscaleByAveraging(& + call upscaleByAveraging( & LVT_rc%HYCOM_hi_arc_nc*LVT_rc%HYCOM_hi_arc_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_hi_arc_n11, hi_arc_lb, & @@ -2809,9 +2847,9 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & ! end if hi_ant = LVT_rc%udef - call get_hycom_cice_filename('ANT',hycom_fname, & - hi_ant_year,hi_ant_month,hi_ant_day, & - hi_ant_hour,hi_ant_fcst_hr) + call get_hycom_cice_filename('ANT', hycom_fname, & + hi_ant_year, hi_ant_month, hi_ant_day, & + hi_ant_hour, hi_ant_fcst_hr) if (trim(hycom_fname) == "NONE") then file_exists = .false. @@ -2824,19 +2862,19 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & if(file_exists) then #if (defined USE_NETCDF3 || defined USE_NETCDF4) - write(LVT_logunit,*) '[INFO] Reading HYCOM data ',trim(hycom_fname) + write(LVT_logunit,*) '[INFO] Reading HYCOM data ', trim(hycom_fname) - ios = nf90_open(path=trim(hycom_fname),mode=NF90_NOWRITE,ncid=nid) + ios = nf90_open(path=trim(hycom_fname), mode=NF90_NOWRITE, ncid=nid) call LVT_verify(ios, 'Error opening file'//trim(hycom_fname)) !variable ids - ios = nf90_inq_varid(nid, 'hi',hi_ant_id) + ios = nf90_inq_varid(nid, 'hi', hi_ant_id) call LVT_verify(ios, 'Error nf90_inq_varid: hi') !values - ios = nf90_get_var(nid,hi_ant_id, hi_ant,& - start=(/1,1,1,1/), & - count=(/LVT_rc%HYCOM_hi_ant_nc,LVT_rc%HYCOM_hi_ant_nr,1,1/)) + ios = nf90_get_var(nid, hi_ant_id, hi_ant,& + start=(/1, 1, 1, 1/), & + count=(/LVT_rc%HYCOM_hi_ant_nc, LVT_rc%HYCOM_hi_ant_nr, 1, 1/)) call LVT_verify(ios, 'Error nf90_get_var: hi_ant') ios = nf90_close(nid) @@ -2845,20 +2883,20 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & hi_ant_1d = -9999.0 hi_ant_lb = .false. - do r=1,LVT_rc%HYCOM_hi_ant_nr - do c=1,LVT_rc%HYCOM_hi_ant_nc - if(hi_ant(c,r,1,1).ne.-30000) then + do r = 1, LVT_rc%HYCOM_hi_ant_nr + do c = 1, LVT_rc%HYCOM_hi_ant_nc + if (hi_ant(c,r,1,1) .ne. -30000) then c1 = c r1 = r - hi_ant_1d(c1+(r1-1)*LVT_rc%HYCOM_hi_ant_nc) = & + hi_ant_1d(c1 + (r1-1)*LVT_rc%HYCOM_hi_ant_nc) = & hi_ant(c,r,1,1)*0.001 - hi_ant_lb(c1+(r1-1)*LVT_rc%HYCOM_hi_ant_nc) = .true. + hi_ant_lb(c1 + (r1-1)*LVT_rc%HYCOM_hi_ant_nc) = .true. endif enddo enddo - call upscaleByAveraging(& + call upscaleByAveraging( & LVT_rc%HYCOM_hi_ant_nc*LVT_rc%HYCOM_hi_ant_nr, & LVT_rc%lnc*LVT_rc%lnr, LVT_rc%udef, & LVT_rc%HYCOM_hi_ant_n11, hi_ant_lb, & @@ -2868,7 +2906,7 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & ! Merge the two interpolated hi fields together. hi_ip(:) = -9999 - do c = 1,LVT_rc%lnc*LVT_rc%lnr + do c = 1, LVT_rc%lnc*LVT_rc%lnr if (hi_ant_ip(c) > -9999) then hi_ip(c) = hi_ant_ip(c) else if (hi_arc_ip(c) > -9999) then @@ -2883,8 +2921,8 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & do c = 1, LVT_rc%gnc gid = LVT_domain%gindex(c,r) if (gid .eq. -1) then - if (hi_ip(c+(r-1)*LVT_rc%gnc) == -9999) then - hi_ip(c+(r-1)*LVT_rc%gnc) = 0 + if (hi_ip(c + (r-1)*LVT_rc%gnc) == -9999) then + hi_ip(c + (r-1)*LVT_rc%gnc) = 0 end if end if end do ! c @@ -2901,7 +2939,7 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & gribSF = 10 gribLvl = 1 - if(LVT_rc%lvt_out_format.eq."grib2") then + if (LVT_rc%lvt_out_format .eq. "grib2") then ! EMK...Use older hi date/time if (hi_ant_year .lt. hi_arc_year .or. & @@ -2916,24 +2954,24 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & end if ! add to the grib file - call writeSingleGrib2Var(ftn_mean,& - hi_ip,& - varid_def,& - gribSF,& - gribSfc,& - gribLvl,& - gribDis,& - gribCat,& - pdTemplate,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - 1,& - toplev(1),& - botlev(1),& - depscale(1),& + call writeSingleGrib2Var(ftn_mean, & + hi_ip, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + gribDis, & + gribCat, & + pdTemplate, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & + botlev(1), & + depscale(1), & typeOfGeneratingProcess=2, & typeOfProcessedData=1, & ref_year=hi_arc_year, & @@ -2942,25 +2980,25 @@ subroutine LVT_append_HYCOM_cice_fields(ftn_mean, time_unit, time_past, & ref_hour=hi_arc_hour, & ref_fcst_hr=hi_arc_fcst_hr) - elseif(LVT_rc%lvt_out_format.eq."grib1") then - call writeSingleGrib1Var(ftn_mean,& - hi_ip,& - varid_def,& - gribSF,& - gribSfc,& - gribLvl,& - stepType,& - time_unit,& - time_past,& - time_curr,& - timeRange,& - 1,& - toplev(1),& + elseif (LVT_rc%lvt_out_format .eq. "grib1") then + call writeSingleGrib1Var(ftn_mean, & + hi_ip, & + varid_def, & + gribSF, & + gribSfc, & + gribLvl, & + stepType, & + time_unit, & + time_past, & + time_curr, & + timeRange, & + 1, & + toplev(1), & botlev(1)) - elseif(LVT_rc%lvt_out_format.eq."netcdf") then - call writeSingleNetcdfVar(ftn_mean,& - hi_ip,& - LVT_histData%hi%varId_def,& + elseif (LVT_rc%lvt_out_format .eq. "netcdf") then + call writeSingleNetcdfVar(ftn_mean, & + hi_ip, & + LVT_histData%hi%varId_def, & 1) endif @@ -2982,63 +3020,61 @@ subroutine applyNoiseReductionFilter(gvar) gtmp = LVT_rc%udef + if (LVT_rc%smoothingFilterType .eq. "box filter") then + do r = 1, LVT_rc%lnr + do c = 1, LVT_rc%lnc - if(LVT_rc%smoothingFilterType.eq."box filter") then - do r=1,LVT_rc%lnr - do c=1,LVT_rc%lnc - - c_s = max(1,c-2) - c_e = min(LVT_rc%lnc,c+2) - r_s = max(1,r-2) - r_e = min(LVT_rc%lnr,r+2) + c_s = max(1, c-2) + c_e = min(LVT_rc%lnc, c + 2) + r_s = max(1, r - 2) + r_e = min(LVT_rc%lnr, r + 2) avg_val = 0.0 navg_val = 0 - do c1=c_s, c_e - do r1=r_s,r_e - if(gvar(c1+(r1-1)*LVT_rc%lnc).ne.LVT_rc%udef) then - avg_val = avg_val + gvar(c1+(r1-1)*LVT_rc%lnc) + do c1 = c_s, c_e + do r1 = r_s,r_e + if (gvar(c1 + (r1-1)*LVT_rc%lnc) .ne. LVT_rc%udef) then + avg_val = avg_val + gvar(c1 + (r1-1)*LVT_rc%lnc) navg_val = navg_val + 1 endif enddo enddo - if(navg_val.gt.0) then - avg_val = avg_val/navg_val + if (navg_val .gt. 0) then + avg_val = avg_val / navg_val else avg_val = LVT_rc%udef endif - gtmp(c+(r-1)*LVT_rc%lnc) = avg_val + gtmp(c + (r-1)*LVT_rc%lnc) = avg_val enddo enddo - - elseif(LVT_rc%smoothingFilterType.eq."gaussian filter") then + elseif (LVT_rc%smoothingFilterType .eq. "gaussian filter") then sigma = 1.0 - do r=1,LVT_rc%lnr - do c=1,LVT_rc%lnc + do r = 1, LVT_rc%lnr + do c = 1, LVT_rc%lnc - c_s = max(1,c-2) - c_e = min(LVT_rc%lnc,c+2) - r_s = max(1,r-2) - r_e = min(LVT_rc%lnr,r+2) + c_s = max(1, c - 2) + c_e = min(LVT_rc%lnc, c + 2) + r_s = max(1, r - 2) + r_e = min(LVT_rc%lnr, r + 2) avg_val = 0.0 navg_val = 0 - do c1=c_s, c_e - do r1=r_s,r_e - if(gvar(c1+(r1-1)*LVT_rc%lnc).ne.LVT_rc%udef) then + do c1 = c_s, c_e + do r1 = r_s,r_e + if(gvar(c1 + (r1-1)*LVT_rc%lnc) .ne. LVT_rc%udef) then wt = exp(-((c1-c)**2+(r1-r)**2)/(2*sigma**2))/& (2*LVT_CONST_PI*sigma**2) - avg_val = avg_val + wt*gvar(c1+(r1-1)*LVT_rc%lnc) + avg_val = avg_val + wt*gvar(c1 + (r1-1)*LVT_rc%lnc) navg_val = navg_val + wt endif enddo enddo - if(navg_val.gt.0) then - if(gvar(c+(r-1)*LVT_rc%lnc).ne.LVT_rc%udef) then - avg_val = avg_val/navg_val + if (navg_val .gt. 0) then + if (gvar(c + (r-1)*LVT_rc%lnc) .ne. LVT_rc%udef) then + avg_val = avg_val / navg_val else avg_val = LVT_rc%udef endif @@ -3046,7 +3082,7 @@ subroutine applyNoiseReductionFilter(gvar) avg_val = LVT_rc%udef endif - gtmp(c+(r-1)*LVT_rc%lnc) = avg_val + gtmp(c + (r-1)*LVT_rc%lnc) = avg_val enddo enddo @@ -3062,9 +3098,9 @@ end subroutine applyNoiseReductionFilter ! \label{writeSingleGrib1Var} ! ! !INTERFACE: - subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& + subroutine writeSingleGrib1Var(ftn, gtmp, gribId, gribSF, gribSfc, gribLvl, & sType, time_unit, time_p1, time_p2, & - timeRange,k,toplev,botlev) + timeRange, k, toplev, botlev) ! ! !DESCRIPTION: ! This subroutine writes a single variable to a grib file @@ -3099,85 +3135,101 @@ subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Note passing string of defined points only to output ! because bitmap in GRIB-1 file will fill in the rest - #if (defined USE_ECCODES) - call grib_new_from_samples(igrib,"GRIB1",iret) + call grib_new_from_samples(igrib, "GRIB1", iret) call LVT_verify(iret, 'grib_new_from_samples failed in LVT_DataStreamsMod') #else - call grib_new_from_template(igrib,"GRIB1",iret) - call LVT_verify(iret, 'grib_new_from_template failed in LVT_DataStreamsMod') + call grib_new_from_template(igrib, "GRIB1", iret) + call LVT_verify(iret, & + 'grib_new_from_template failed in LVT_DataStreamsMod') #endif - call grib_set(igrib,'table2Version',LVT_rc%grib_table,iret) - call LVT_verify(iret,'grib_set:table2version failed in LVT_DataStreamsMod') + call grib_set(igrib, 'table2Version', LVT_rc%grib_table, iret) + call LVT_verify(iret, & + 'grib_set:table2version failed in LVT_DataStreamsMod') - call grib_set(igrib,'generatingProcessIdentifier',LVT_rc%grib_process_id,iret) - call LVT_verify(iret,'grib_set:generatingProcessIdentifier failed in LVT_DataStreamsMod') + call grib_set(igrib, 'generatingProcessIdentifier', & + LVT_rc%grib_process_id, iret) + call LVT_verify(iret, & + 'grib_set:generatingProcessIdentifier failed in LVT_DataStreamsMod') - call grib_set(igrib,'gridDefinition',LVT_rc%grib_grid_id,iret) - call LVT_verify(iret,'grib_set:grid ID failed in LVT_DataStreamsMod') + call grib_set(igrib, 'gridDefinition', LVT_rc%grib_grid_id, iret) + call LVT_verify(iret, 'grib_set:grid ID failed in LVT_DataStreamsMod') - call grib_set(igrib,'indicatorOfParameter',gribid, iret) - call LVT_verify(iret,'grib_set:indicatorOfParameter failed in LVT_DataStreamsMod') + call grib_set(igrib, 'indicatorOfParameter', gribid, iret) + call LVT_verify(iret, & + 'grib_set:indicatorOfParameter failed in LVT_DataStreamsMod') ! call grib_set(igrib,'paramId',gribid, iret) ! call LVT_verify(iret,'grib_set:paramId failed in LVT_DataStreamsMod') - call grib_set(igrib,'indicatorOfTypeOfLevel',gribSfc, iret) - call LVT_verify(iret,'grib_set:indicatorOfTypeOfLevel failed in LVT_DataStreamsMod') + call grib_set(igrib, 'indicatorOfTypeOfLevel', gribSfc, iret) + call LVT_verify(iret, & + 'grib_set:indicatorOfTypeOfLevel failed in LVT_DataStreamsMod') - call grib_set(igrib,'level',gribLvl, iret) - call LVT_verify(iret,'grib_set:level failed in LVT_DataStreamsMod') + call grib_set(igrib, 'level', gribLvl, iret) + call LVT_verify(iret, 'grib_set:level failed in LVT_DataStreamsMod') - call grib_set(igrib,'topLevel',toplev(1), iret) - call LVT_verify(iret,'grib_set:topLevel failed in LVT_DataStreamsMod') + call grib_set(igrib, 'topLevel', toplev(1), iret) + call LVT_verify(iret, 'grib_set:topLevel failed in LVT_DataStreamsMod') - call grib_set(igrib,'bottomLevel',botlev(1), iret) - call LVT_verify(iret,'grib_set:bottomLevel failed in LVT_DataStreamsMod') + call grib_set(igrib, 'bottomLevel', botlev(1), iret) + call LVT_verify(iret, 'grib_set:bottomLevel failed in LVT_DataStreamsMod') - call grib_set(igrib,'stepType',sType, iret) - call LVT_verify(iret,'grib_set:stepType failed in LVT_DataStreamsMod') + call grib_set(igrib, 'stepType', sType, iret) + call LVT_verify(iret, 'grib_set:stepType failed in LVT_DataStreamsMod') - call grib_set(igrib,'stepUnits',time_unit, iret) - call LVT_verify(iret,'grib_set:stepUnits failed in LVT_DataStreamsMod') + call grib_set(igrib, 'stepUnits', time_unit, iret) + call LVT_verify(iret, 'grib_set:stepUnits failed in LVT_DataStreamsMod') - call grib_set(igrib,'startStep',time_p1, iret) - call LVT_verify(iret,'grib_set:startStep failed in LVT_DataStreamsMod') + call grib_set(igrib, 'startStep', time_p1, iret) + call LVT_verify(iret, 'grib_set:startStep failed in LVT_DataStreamsMod') - call grib_set(igrib,'endStep',time_p2, iret) - call LVT_verify(iret,'grib_set:endStep failed in LVT_DataStreamsMod') + call grib_set(igrib, 'endStep', time_p2, iret) + call LVT_verify(iret, 'grib_set:endStep failed in LVT_DataStreamsMod') - call grib_set(igrib,'timeRangeIndicator',timeRange, iret) - call LVT_verify(iret,'grib_set:timeRangeIndicator failed in LVT_DataStreamsMod') + call grib_set(igrib, 'timeRangeIndicator', timeRange, iret) + call LVT_verify(iret, & + 'grib_set:timeRangeIndicator failed in LVT_DataStreamsMod') - call grib_set(igrib,'swapScanningLat',1, iret) - call LVT_verify(iret,'grib_set:swapScanningLat failed in LVT_DataStreamsMod') + call grib_set(igrib, 'swapScanningLat', 1, iret) + call LVT_verify(iret, & + 'grib_set:swapScanningLat failed in LVT_DataStreamsMod') - call grib_set(igrib,'Ni',LVT_rc%gnc,iret) + call grib_set(igrib, 'Ni', LVT_rc%gnc, iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') - call grib_set(igrib,'Nj',LVT_rc%gnr,iret) + call grib_set(igrib,'Nj', LVT_rc%gnr, iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') - call ij_to_latlon(LVT_domain%lvtproj,float(LVT_rc%gnc),& - float(LVT_rc%gnr),lat_ur,lon_ur) - call ij_to_latlon(LVT_domain%lvtproj,1.0, 1.0, & - lat_ll,lon_ll) + call ij_to_latlon(LVT_domain%lvtproj, float(LVT_rc%gnc),& + float(LVT_rc%gnr), lat_ur, lon_ur) + call ij_to_latlon(LVT_domain%lvtproj, 1.0, 1.0, & + lat_ll, lon_ll) - call grib_set(igrib, 'latitudeOfFirstGridPointInDegrees',lat_ll,iret) - call LVT_verify(iret, 'grib_set:latitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'latitudeOfFirstGridPointInDegrees', lat_ll, iret) + call LVT_verify(iret, & + 'grib_set:latitudeOfFirstGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib, 'longitudeOfFirstGridPointInDegrees',lon_ll,iret) - call LVT_verify(iret, 'grib_set:longitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'longitudeOfFirstGridPointInDegrees', lon_ll, iret) + call LVT_verify(iret, & + 'grib_set:longitudeOfFirstGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib, 'latitudeOfLastGridPointInDegrees',lat_ur,iret) - call LVT_verify(iret, 'grib_set:latitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'latitudeOfLastGridPointInDegrees', lat_ur, iret) + call LVT_verify(iret, & + 'grib_set:latitudeOfLastGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib, 'longitudeOfLastGridPointInDegrees',lon_ur,iret) - call LVT_verify(iret, 'grib_set:longitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'longitudeOfLastGridPointInDegrees', lon_ur, iret) + call LVT_verify(iret, & + 'grib_set:longitudeOfLastGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib, 'missingValue',LVT_rc%udef,iret) - call LVT_verify(iret, 'grib_set:missingValue failed in LVT_DataStreamsMod') + call grib_set(igrib, 'missingValue', LVT_rc%udef, iret) + call LVT_verify(iret, & + 'grib_set:missingValue failed in LVT_DataStreamsMod') ! Should not need to fix the "num bits" value for each parameter ! if the "decimalPrecision" (aka, "DecScale") is set properly. - dmm @@ -3192,68 +3244,76 @@ subroutine writeSingleGrib1Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& decimalPrecision = decimalPrecision + 1 gribSFtemp = gribSFtemp / 10 enddo - call grib_set(igrib, 'decimalPrecision',decimalPrecision,iret) - call LVT_verify(iret, 'grib_set:decimalPrecision failed in LVT_DataStreamsMod') + call grib_set(igrib, 'decimalPrecision', decimalPrecision, iret) + call LVT_verify(iret, & + 'grib_set:decimalPrecision failed in LVT_DataStreamsMod') - call grib_set(igrib, 'bitmapPresent',1,iret) - call LVT_verify(iret, 'grib_set:bitmapPresent failed in LVT_DataStreamsMod') + call grib_set(igrib, 'bitmapPresent', 1, iret) + call LVT_verify(iret, & + 'grib_set:bitmapPresent failed in LVT_DataStreamsMod') - if (LVT_rc%domain.eq."latlon") then - call grib_set(igrib,'gridType','regular_ll',iret) - call LVT_verify(iret,'grib_set: gridType failed in LVT_DataStreamsMod') + if (LVT_rc%domain .eq. "latlon") then + call grib_set(igrib, 'gridType', 'regular_ll', iret) + call LVT_verify(iret, 'grib_set: gridType failed in LVT_DataStreamsMod') - call grib_set(igrib,'iDirectionIncrementInDegrees',LVT_rc%gridDesc(9),iret) - call LVT_verify(iret,'grib_set:iDirectionIncrementInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'iDirectionIncrementInDegrees', & + LVT_rc%gridDesc(9), iret) + call LVT_verify(iret, & + 'grib_set:iDirectionIncrementInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib,'jDirectionIncrementInDegrees',LVT_rc%gridDesc(10),iret) - call LVT_verify(iret,'grib_set:jDirectionIncrementInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'jDirectionIncrementInDegrees', & + LVT_rc%gridDesc(10), iret) + call LVT_verify(iret, & + 'grib_set:jDirectionIncrementInDegrees failed in '// & + 'LVT_DataStreamsMod') else !Unsupported Map Projection for GRIB output - message(1)='program: LVT_DataStreamsMod' - message(2)=' subroutine: writevar_grib1_withstats_real' - message(3)=' Unsupported map projection for GRIB1 output!' + message(1) = 'program: LVT_DataStreamsMod' + message(2) = ' subroutine: writevar_grib1_withstats_real' + message(3) = ' Unsupported map projection for GRIB1 output!' call lvt_abort(message) stop endif - da1=LVT_rc%da - mo1=LVT_rc%mo - yr1=LVT_rc%yr + da1 = LVT_rc%da + mo1 = LVT_rc%mo + yr1 = LVT_rc%yr - write(unit=date,fmt='(i4.4,i2.2,i2.2)') yr1,mo1,da1 + write(unit=date, fmt='(i4.4,i2.2,i2.2)') yr1, mo1, da1 read(date,'(I8)') idate - call grib_set(igrib,'dataDate',idate,iret) + call grib_set(igrib, 'dataDate', idate, iret) call LVT_verify(iret, 'grib_set:dataDate failed in LVT_DataStreamsMod') - hr1=LVT_rc%hr - mn1=LVT_rc%mn + hr1 = LVT_rc%hr + mn1 = LVT_rc%mn - write(unit=date,fmt='(i2.2,i2.2)') hr1,mn1 + write(unit=date,fmt='(i2.2,i2.2)') hr1, mn1 read(date,'(I4)') idate1 - call grib_set(igrib,'dataTime',idate1,iret) + call grib_set(igrib, 'dataTime', idate1, iret) call LVT_verify(iret, 'grib_set:dataTime failed in LVT_DataStreamsMod') - call grib_set(igrib,'values',gtmp,iret) + call grib_set(igrib, 'values', gtmp, iret) call LVT_verify(iret, 'grib_set:values failed in LVT_DataStreamsMod') ! Move setting of centre and subCentre to the end of the settings. ! The order these are written is important and will affect output. - dmm - call grib_set(igrib,'centre',LVT_rc%grib_center_id,iret) - call LVT_verify(iret,'grib_set:centre failed in LVT_DataStreamsMod') + call grib_set(igrib, 'centre', LVT_rc%grib_center_id, iret) + call LVT_verify(iret, 'grib_set:centre failed in LVT_DataStreamsMod') - call grib_set(igrib,'subCentre',LVT_rc%grib_subcenter_id,iret) - call LVT_verify(iret,'grib_set:subCentre failed in LVT_DataStreamsMod') + call grib_set(igrib, 'subCentre', LVT_rc%grib_subcenter_id, iret) + call LVT_verify(iret, 'grib_set:subCentre failed in LVT_DataStreamsMod') - call grib_write(igrib,ftn,iret) + call grib_write(igrib, ftn, iret) call LVT_verify(iret, 'grib_write failed in LVT_DataStreamsMod') - call grib_release(igrib,iret) - call LVT_verify(iret,'grib_release failed in LVT_DataStreamsMod') + call grib_release(igrib, iret) + call LVT_verify(iret, 'grib_release failed in LVT_DataStreamsMod') end subroutine writeSingleGrib1Var @@ -3264,13 +3324,13 @@ end subroutine writeSingleGrib1Var ! \label{writeSingleGrib2Var} ! ! !INTERFACE: - subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& + subroutine writeSingleGrib2Var(ftn, gtmp, gribId, gribSF, gribSfc, gribLvl,& gribDis, gribCat, pdTemplate, & sType, time_unit, time_p1, time_p2, & - timeRange,k,toplev,botlev,depscale, & - ensembleSpread,typeOfGeneratingProcess, & + timeRange, k, toplev, botlev, depscale, & + ensembleSpread, typeOfGeneratingProcess, & typeOfProcessedData, & - ref_year,ref_month,ref_day,ref_hour,ref_fcst_hr) + ref_year, ref_month, ref_day, ref_hour, ref_fcst_hr) ! ! !DESCRIPTION: ! This subroutine writes a single variable to a grib2 file based on @@ -3279,7 +3339,7 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! !EOP - use ESMF + use ESMF integer :: ftn real :: gtmp(LVT_rc%lnc*LVT_rc%lnr) @@ -3345,10 +3405,10 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! because bitmap in GRIB-1 file will fill in the rest #if (defined USE_ECCODES) - call grib_new_from_samples(igrib,"GRIB2",iret) + call grib_new_from_samples(igrib, "GRIB2", iret) call LVT_verify(iret, 'grib_new_from_samples failed in LVT_DataStreamsMod') #else - call grib_new_from_template(igrib,"GRIB2",iret) + call grib_new_from_template(igrib, "GRIB2", iret) call LVT_verify(iret, 'grib_new_from_template failed in LVT_DataStreamsMod') #endif @@ -3359,30 +3419,34 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Section 1: Identification ! Octets 6-7 - call grib_set(igrib,'centre',LVT_rc%grib_center_id,iret) - call LVT_verify(iret,'grib_set:centre failed in LVT_DataStreamsMod') + call grib_set(igrib, 'centre', LVT_rc%grib_center_id, iret) + call LVT_verify(iret, 'grib_set:centre failed in LVT_DataStreamsMod') ! Octets 8-9 - call grib_set(igrib,'subCentre',LVT_rc%grib_subcenter_id,iret) - call LVT_verify(iret,'grib_set:subCentre failed in LVT_DataStreamsMod') + call grib_set(igrib, 'subCentre', LVT_rc%grib_subcenter_id, iret) + call LVT_verify(iret, 'grib_set:subCentre failed in LVT_DataStreamsMod') ! Octet 10 - call grib_set(igrib,'tablesVersion',LVT_rc%grib_table,iret) - call LVT_verify(iret,'grib_set:tablesversion failed in LVT_DataStreamsMod') + call grib_set(igrib,'tablesVersion', LVT_rc%grib_table, iret) + call LVT_verify(iret, & + 'grib_set:tablesversion failed in LVT_DataStreamsMod') ! Octet 11 - call grib_set(igrib,'localTablesVersion',1,iret) - call LVT_verify(iret,'grib_set:localTablesVersion failed in LVT_DataStreamsMod') + call grib_set(igrib, 'localTablesVersion', 1, iret) + call LVT_verify(iret, & + 'grib_set:localTablesVersion failed in LVT_DataStreamsMod') ! Octet 12 ! EMK 8 May 2018...Reference time will always be start of forecast. ! Since this is not available in the LIS history file, we will use ! the start day/time specified in the lvt.config file. ! Exception is for GOFS analyses. if (typeOfGeneratingProcess_local == 0) then ! Analysis - call grib_set(igrib,'significanceOfReferenceTime',0,iret) + call grib_set(igrib,'significanceOfReferenceTime', 0, iret) call LVT_verify(iret, & - 'grib_set:significanceOfReferenceTime failed in LVT_DataStreamsMod') + 'grib_set:significanceOfReferenceTime failed in '// & + 'LVT_DataStreamsMod') else - call grib_set(igrib,'significanceOfReferenceTime',1,iret) + call grib_set(igrib, 'significanceOfReferenceTime', 1, iret) call LVT_verify(iret, & - 'grib_set:significanceOfReferenceTime failed in LVT_DataStreamsMod') + 'grib_set:significanceOfReferenceTime failed in '// & + 'LVT_DataStreamsMod') end if if (present(ref_year) .and. present(ref_month) .and. present(ref_day) & @@ -3393,33 +3457,34 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& hr1 = ref_hour mn1 = 0 else - yr1=LVT_rc%syr - mo1=LVT_rc%smo - da1=LVT_rc%sda - hr1=LVT_rc%shr - mn1=LVT_rc%smn + yr1 = LVT_rc%syr + mo1 = LVT_rc%smo + da1 = LVT_rc%sda + hr1 = LVT_rc%shr + mn1 = LVT_rc%smn end if ! Octets 13-16 - write(unit=date,fmt='(i4.4,i2.2,i2.2)') yr1,mo1,da1 + write(unit=date, fmt='(i4.4,i2.2,i2.2)') yr1, mo1, da1 read(date,'(I8)') idate - call grib_set(igrib,'dataDate',idate,iret) + call grib_set(igrib, 'dataDate', idate, iret) call LVT_verify(iret, 'grib_set:dataDate failed in LVT_DataStreamsMod') ! Octets 17-19 - write(unit=date,fmt='(i2.2,i2.2)') hr1,mn1 + write(unit=date, fmt='(i2.2,i2.2)') hr1, mn1 read(date,'(I4)') idate1 - call grib_set(igrib,'dataTime',idate1,iret) + call grib_set(igrib, 'dataTime', idate1, iret) call LVT_verify(iret, 'grib_set:dataTime failed in LVT_DataStreamsMod') ! Octet 20...Hardcode to operations for 557 ! FIXME...Set in lvt.config - call grib_set(igrib,'productionStatusOfProcessedData',0,iret) - call LVT_verify(iret,& - 'grib_set:productionStatusOfProcessedData failed in LVT_DataStreamsMod') + call grib_set(igrib, 'productionStatusOfProcessedData', 0, iret) + call LVT_verify(iret, & + 'grib_set:productionStatusOfProcessedData failed in '// & + 'LVT_DataStreamsMod') ! Octet 21 - call grib_set(igrib,'typeOfProcessedData',typeOfProcessedData_local,iret) - call LVT_verify(iret,& + call grib_set(igrib,'typeOfProcessedData', typeOfProcessedData_local, iret) + call LVT_verify(iret, & 'grib_set:typeOfProcessedData failed in LVT_DataStreamsMod') ! ! ???? @@ -3430,57 +3495,72 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Section 2: Local Use Section (Optional) --none for now ! Section 3: Grid - call grib_set(igrib,'gridDefinitionTemplateNumber',LVT_rc%grib_grid_id,iret) + call grib_set(igrib, 'gridDefinitionTemplateNumber', & + LVT_rc%grib_grid_id, iret) call LVT_verify(iret, & 'grib_set:gridDefinitionTemplateNumber failed in LVT_DataStreamsMod') ! Hard-coded: shape of the Earth 0=radius = 6,367,470.0 m; 3.2.table - call grib_set(igrib,'shapeOfTheEarth',0,iret) + call grib_set(igrib, 'shapeOfTheEarth', 0, iret) call LVT_verify(iret, & 'grib_set:shapeOfTheEarth failed in LVT_DataStreamsMod') - call grib_set(igrib,'swapScanningLat',1, iret) - call LVT_verify(iret,& + call grib_set(igrib, 'swapScanningLat', 1, iret) + call LVT_verify(iret, & 'grib_set:swapScanningLat failed in LVT_DataStreamsMod') - call grib_set(igrib,'Ni',LVT_rc%gnc,iret) + call grib_set(igrib, 'Ni', LVT_rc%gnc, iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') - call grib_set(igrib,'Nj',LVT_rc%gnr,iret) + call grib_set(igrib, 'Nj', LVT_rc%gnr,iret) call LVT_verify(iret, 'grib_set:Ni failed in LVT_DataStreamsMod') - call ij_to_latlon(LVT_domain%lvtproj,float(LVT_rc%gnc),& - float(LVT_rc%gnr),lat_ur,lon_ur) - call ij_to_latlon(LVT_domain%lvtproj,1.0, 1.0, & - lat_ll,lon_ll) + call ij_to_latlon(LVT_domain%lvtproj, float(LVT_rc%gnc), & + float(LVT_rc%gnr), lat_ur, lon_ur) + call ij_to_latlon(LVT_domain%lvtproj, 1.0, 1.0, & + lat_ll, lon_ll) - call grib_set(igrib, 'latitudeOfFirstGridPointInDegrees',lat_ll,iret) - call LVT_verify(iret, 'grib_set:latitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'latitudeOfFirstGridPointInDegrees', lat_ll, iret) + call LVT_verify(iret, & + 'grib_set:latitudeOfFirstGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib, 'longitudeOfFirstGridPointInDegrees',lon_ll,iret) - call LVT_verify(iret, 'grib_set:longitudeOfFirstGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'longitudeOfFirstGridPointInDegrees', lon_ll, iret) + call LVT_verify(iret, & + 'grib_set:longitudeOfFirstGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib, 'latitudeOfLastGridPointInDegrees',lat_ur,iret) - call LVT_verify(iret, 'grib_set:latitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'latitudeOfLastGridPointInDegrees', lat_ur, iret) + call LVT_verify(iret, & + 'grib_set:latitudeOfLastGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib, 'longitudeOfLastGridPointInDegrees',lon_ur,iret) - call LVT_verify(iret, 'grib_set:longitudeOfLastGridPointInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'longitudeOfLastGridPointInDegrees', lon_ur, iret) + call LVT_verify(iret, & + 'grib_set:longitudeOfLastGridPointInDegrees failed in '// & + 'LVT_DataStreamsMod') - if (LVT_rc%domain.eq."latlon") then - call grib_set(igrib,'gridType','regular_ll',iret) - call LVT_verify(iret,'grib_set: gridType failed in LVT_DataStreamsMod') + if (LVT_rc%domain .eq. "latlon") then + call grib_set(igrib, 'gridType', 'regular_ll', iret) + call LVT_verify(iret, 'grib_set: gridType failed in LVT_DataStreamsMod') - call grib_set(igrib,'iDirectionIncrementInDegrees',LVT_rc%gridDesc(9),iret) - call LVT_verify(iret,'grib_set:iDirectionIncrementInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'iDirectionIncrementInDegrees', & + LVT_rc%gridDesc(9), iret) + call LVT_verify(iret, & + 'grib_set:iDirectionIncrementInDegrees failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib,'jDirectionIncrementInDegrees',LVT_rc%gridDesc(10),iret) - call LVT_verify(iret,'grib_set:jDirectionIncrementInDegrees failed in LVT_DataStreamsMod') + call grib_set(igrib, 'jDirectionIncrementInDegrees', & + LVT_rc%gridDesc(10), iret) + call LVT_verify(iret, & + 'grib_set:jDirectionIncrementInDegrees failed in '// & + 'LVT_DataStreamsMod') else !Unsupported Map Projection for GRIB output - message(1)='program: LVT_DataStreamsMod' - message(2)=' subroutine: writevar_grib1_withstats_real' - message(3)=' Unsupported map projection for GRIB1 output!' + message(1) = 'program: LVT_DataStreamsMod' + message(2) = ' subroutine: writevar_grib1_withstats_real' + message(3) = ' Unsupported map projection for GRIB1 output!' call lvt_abort(message) stop @@ -3489,13 +3569,15 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Section 4: Product Definition Section ! Octets 8-9 - call grib_set(igrib,'productDefinitionTemplateNumber',pdTemplate, iret) - call LVT_verify(iret,'grib_set:productDefinitionTemplateNumber failed in LVT_DataStreamsMod') + call grib_set(igrib, 'productDefinitionTemplateNumber', pdTemplate, iret) + call LVT_verify(iret, & + 'grib_set:productDefinitionTemplateNumber failed in '// & + 'LVT_DataStreamsMod') if (pdTemplate .ne. 0 .and. & pdTemplate .ne. 2 .and. & pdTemplate .ne. 12) then - write(LVT_logunit,*)& + write(LVT_logunit,*) & '[ERR] Unsupported Product Definition Template ', pdTemplate call LVT_endrun() end if @@ -3503,33 +3585,36 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Common settings for Product Definition Templates 4.0, 4.2 and 4.12 if (pdTemplate == 0 .or. pdTemplate == 2 .or. pdTemplate == 12) then ! Octet 10 - call grib_set(igrib,'parameterCategory',gribCat, iret) - call LVT_verify(iret,& + call grib_set(igrib, 'parameterCategory', gribCat, iret) + call LVT_verify(iret, & 'grib_set:parameterCategory failed in LVT_DataStreamsMod') ! Octet 11 - call grib_set(igrib,'parameterNumber',gribid, iret) + call grib_set(igrib, 'parameterNumber', gribid, iret) call LVT_verify(iret, & 'grib_set:parameterNumber failed in LVT_DataStreamsMod') ! Octet 12 - call grib_set(igrib,'typeOfGeneratingProcess', & + call grib_set(igrib, 'typeOfGeneratingProcess', & typeOfGeneratingProcess_local, iret) call LVT_verify(iret, & 'grib_set:typeOfGeneratingProcess failed in LVT_DataStreamsMod') ! Octet 13 - call grib_set(igrib,'backgroundGeneratingProcessIdentifier', & - LVT_rc%grib_process_id,iret) - call LVT_verify(iret,& - 'grib_set:backgroundGeneratingProcessIdentifier failed in LVT_DataStreamsMod') + call grib_set(igrib, 'backgroundGeneratingProcessIdentifier', & + LVT_rc%grib_process_id, iret) + call LVT_verify(iret, & + 'grib_set:backgroundGeneratingProcessIdentifier failed in '// & + 'LVT_DataStreamsMod') ! Octet 14 - call grib_set(igrib,'generatingProcessIdentifier', & - LVT_rc%grib_process_id,iret) - call LVT_verify(iret,& - 'grib_set:generatingProcessIdentifier failed in LVT_DataStreamsMod') + call grib_set(igrib, 'generatingProcessIdentifier', & + LVT_rc%grib_process_id, iret) + call LVT_verify(iret, & + 'grib_set:generatingProcessIdentifier failed in '// & + 'LVT_DataStreamsMod') ! Octet 15-17 are skipped ! Octet 18...Use hours - call grib_set(igrib,'indicatorOfUnitOfTimeRange',1, iret) - call LVT_verify(iret,'grib_set:indicatorOfUnitOfTimeRange failed in LVT_DataStreamsMod') + call grib_set(igrib, 'indicatorOfUnitOfTimeRange', 1, iret) + call LVT_verify(iret, & + 'grib_set:indicatorOfUnitOfTimeRange failed in LVT_DataStreamsMod') ! Octets 19-22...Forecast time is in hours. Must calculate. ! For analyses, forecast time is always zero. @@ -3538,101 +3623,140 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! If reference time is explicitly passed to routine (like for GOFS ! data), use that. if (typeOfGeneratingProcess_local == 0) then ! Analysis - call ESMF_TimeIntervalSet(timeinterval,s=0,rc=iret) + call ESMF_TimeIntervalSet(timeinterval, s=0, rc=iret) else if (present(ref_year) .and. present(ref_month) .and. & present(ref_day) .and. present(ref_hour) .and. & present(ref_fcst_hr)) then - call ESMF_TimeIntervalSet(timeinterval,h=ref_fcst_hr,rc=iret) + call ESMF_TimeIntervalSet(timeinterval, h=ref_fcst_hr, rc=iret) else call ESMF_TimeSet(time1, yy=LVT_rc%syr, mm=LVT_rc%smo, & dd=LVT_rc%sda, & h=LVT_rc%shr, m=LVT_rc%smn, s=LVT_rc%sss, rc=iret) - call LVT_verify(iret,'ESMF_TimeSet:time1 failed in LVT_DataStreamsMod') + call LVT_verify(iret,& + 'ESMF_TimeSet:time1 failed in LVT_DataStreamsMod') call ESMF_TimeSet(time2, yy=LVT_rc%yr, mm=LVT_rc%mo, dd=LVT_rc%da, & h=LVT_rc%hr, m=LVT_rc%mn, s=LVT_rc%ss, rc=iret) - call LVT_verify(iret,'ESMF_TimeSet:time2 failed in LVT_DataStreamsMod') + call LVT_verify(iret, & + 'ESMF_TimeSet:time2 failed in LVT_DataStreamsMod') if (pdTemplate == 12) then - call ESMF_TimeIntervalSet(timeinterval12,& - s=LVT_rc%statswriteint,rc=iret) - call LVT_verify(iret,'ESMF_TimeIntervalSet:timeinterval12 failed in LVT_DataStreamsMod') + call ESMF_TimeIntervalSet(timeinterval12, & + s=LVT_rc%statswriteint, rc=iret) + call LVT_verify(iret,& + 'ESMF_TimeIntervalSet:timeinterval12 failed in '// & + 'LVT_DataStreamsMod') timeinterval = time2 - time1 - timeinterval12 else timeinterval = time2 - time1 end if end if call ESMF_TimeIntervalGet(timeinterval, h=hr1, rc=iret) - call LVT_verify(iret,& + call LVT_verify(iret, & 'ESMF_TimeIntervalGet:timeinterval failed in LVT_DataStreamsMod') - call grib_set(igrib,'forecastTime',hr1,iret) - call LVT_verify(iret,& + call grib_set(igrib, 'forecastTime', hr1, iret) + call LVT_verify(iret, & 'grib_set:forecast_time failed in LVT_DataStreamsMod') ! Octets 23-34. Varies by type of level/layer. - call grib_set(igrib,'typeOfFirstFixedSurface',gribSfc, iret) - call LVT_verify(iret,& + call grib_set(igrib, 'typeOfFirstFixedSurface', gribSfc, iret) + call LVT_verify(iret, & 'grib_set:typeOfFirstFixedSurface failed in LVT_DataStreamsMod') if ( gribSfc .eq. 106 ) then ! soil layers ! Must set this before scale factor/values of surfaces - call grib_set(igrib,'typeOfSecondFixedSurface',gribSfc, iret) - call LVT_verify(iret,& - 'grib_set:typeOfSecondFixedSurface failed in LVT_DataStreamsMod') + call grib_set(igrib, 'typeOfSecondFixedSurface', gribSfc, iret) + call LVT_verify(iret, & + 'grib_set:typeOfSecondFixedSurface failed in '// & + 'LVT_DataStreamsMod') - call grib_set(igrib,'scaleFactorOfFirstFixedSurface',depscale(1), & + call grib_set(igrib, 'scaleFactorOfFirstFixedSurface', & + depscale(1), & iret) - call LVT_verify(iret,& - 'grib_set:scaleFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') - call grib_set(igrib,'scaledValueOfFirstFixedSurface',toplev(1), iret) - call LVT_verify(iret,& - 'grib_set:scaledValueOfFirstFixedSurface failed in LVT_DataStreamsMod') - - call grib_set(igrib,'scaleFactorOfSecondFixedSurface',depscale(1), & + call LVT_verify(iret, & + 'grib_set:scaleFactorOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + call grib_set(igrib, 'scaledValueOfFirstFixedSurface', & + toplev(1), iret) + call LVT_verify(iret, & + 'grib_set:scaledValueOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + + call grib_set(igrib, 'scaleFactorOfSecondFixedSurface', & + depscale(1), & iret) - call LVT_verify(iret,'grib_set:scaledFactorOfSecondFixedSurface failed in LVT_DataStreamsMod') - call grib_set(igrib,'scaledValueOfSecondFixedSurface',botlev(1), & + call LVT_verify(iret, & + 'grib_set:scaledFactorOfSecondFixedSurface failed in '// & + 'LVT_DataStreamsMod') + call grib_set(igrib, 'scaledValueOfSecondFixedSurface', & + botlev(1), & iret) - call LVT_verify(iret,'grib_set:scaledValueOfSecondFixedSurface failed in LVT_DataStreamsMod') + call LVT_verify(iret, & + 'grib_set:scaledValueOfSecondFixedSurface failed in '// & + 'LVT_DataStreamsMod') elseif ( gribSfc .eq. 1 ) then ! surface ! Must set this before scale factor/value of surfaces - call grib_set(igrib,'typeOfSecondFixedSurface',255, iret) - call LVT_verify(iret,'grib_set:typeOfFirstFixedSurface failed in LVT_DataStreamsMod') - - call grib_set(igrib,'scaleFactorOfFirstFixedSurface',0, iret) - call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') - call grib_set(igrib,'scaledValueOfFirstFixedSurface',toplev(1), iret) - call LVT_verify(iret,'grib_set:scaledValueOfFirstFixedSurface failed in LVT_DataStreamsMod') - - call grib_set(igrib,'scaleFactorOfSecondFixedSurface',255, iret) - call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') - call grib_set(igrib,'scaledValueOfSecondFixedSurface',255, iret) - call LVT_verify(iret,'grib_set:scaledValueOfSecondFixedSurface failed in LVT_DataStreamsMod') + call grib_set(igrib, 'typeOfSecondFixedSurface', 255, iret) + call LVT_verify(iret, & + 'grib_set:typeOfFirstFixedSurface failed in LVT_DataStreamsMod') + + call grib_set(igrib, 'scaleFactorOfFirstFixedSurface', 0, iret) + call LVT_verify(iret, & + 'grib_set:scaledFactorOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + call grib_set(igrib, 'scaledValueOfFirstFixedSurface', & + toplev(1), iret) + call LVT_verify(iret, & + 'grib_set:scaledValueOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + + call grib_set(igrib, 'scaleFactorOfSecondFixedSurface', 255, iret) + call LVT_verify(iret, & + 'grib_set:scaledFactorOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + call grib_set(igrib, 'scaledValueOfSecondFixedSurface', 255, iret) + call LVT_verify(iret, & + 'grib_set:scaledValueOfSecondFixedSurface failed in '// & + 'LVT_DataStreamsMod') else if ( gribSfc .eq. 103 ) then ! EMK...Meters AGL - call grib_set(igrib,'scaleFactorOfFirstFixedSurface',depscale(1), iret) - call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') - - call grib_set(igrib,'level',gribLvl, iret) - call LVT_verify(iret,'grib_set:level failed in LVT_DataStreamsMod') + call grib_set(igrib, 'scaleFactorOfFirstFixedSurface', & + depscale(1), iret) + call LVT_verify(iret, & + 'grib_set:scaledFactorOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + + call grib_set(igrib, 'level', gribLvl, iret) + call LVT_verify(iret, 'grib_set:level failed in LVT_DataStreamsMod') else ! 114 (snow level) or old 112 ?? write(LVT_logunit,*) 'Warning: special surface type !! '//& - 'verify scale/depth for ',gribSfc + 'verify scale/depth for ', gribSfc - call grib_set(igrib,'typeOfSecondFixedSurface',gribSfc, iret) - call LVT_verify(iret,'grib_set:typeOfFirstFixedSurface failed in LVT_DataStreamsMod') - - call grib_set(igrib,'scaleFactorOfFirstFixedSurface',0, iret) - call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') - call grib_set(igrib,'scaledValueOfFirstFixedSurface',toplev(1), iret) - call LVT_verify(iret,'grib_set:scaledValueOfFirstFixedSurface failed in LVT_DataStreamsMod') + call grib_set(igrib, 'typeOfSecondFixedSurface', gribSfc, iret) + call LVT_verify(iret,& + 'grib_set:typeOfFirstFixedSurface failed in LVT_DataStreamsMod') - call grib_set(igrib,'scaleFactorOfSecondFixedSurface',0, iret) - call LVT_verify(iret,'grib_set:scaledFactorOfFirstFixedSurface failed in LVT_DataStreamsMod') - call grib_set(igrib,'scaledValueOfSecondFixedSurface',botlev(1), iret) - call LVT_verify(iret,'grib_set:scaledValueOfSecondFixedSurface failed in LVT_DataStreamsMod') + call grib_set(igrib, 'scaleFactorOfFirstFixedSurface', 0, iret) + call LVT_verify(iret,& + 'grib_set:scaledFactorOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + call grib_set(igrib, 'scaledValueOfFirstFixedSurface', & + toplev(1), iret) + call LVT_verify(iret, & + 'grib_set:scaledValueOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + + call grib_set(igrib, 'scaleFactorOfSecondFixedSurface', 0, iret) + call LVT_verify(iret, & + 'grib_set:scaledFactorOfFirstFixedSurface failed in '// & + 'LVT_DataStreamsMod') + call grib_set(igrib, 'scaledValueOfSecondFixedSurface', & + botlev(1), iret) + call LVT_verify(iret, & + 'grib_set:scaledValueOfSecondFixedSurface failed in '// & + 'LVT_DataStreamsMod') endif end if @@ -3643,91 +3767,118 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! Octet 35 if (ensembleSpread_local) then - call grib_set(igrib,'derivedForecast',4, iret) - call LVT_verify(iret,'grib_set:derivedForecast failed in LVT_DataStreamsMod') + call grib_set(igrib, 'derivedForecast', 4, iret) + call LVT_verify(iret, & + 'grib_set:derivedForecast failed in LVT_DataStreamsMod') else - call grib_set(igrib,'derivedForecast',0, iret) - call LVT_verify(iret,'grib_set:derivedForecast failed in LVT_DataStreamsMod') + call grib_set(igrib, 'derivedForecast', 0, iret) + call LVT_verify(iret, & + 'grib_set:derivedForecast failed in LVT_DataStreamsMod') end if ! Octet 36. - call grib_set(igrib,'numberOfForecastsInEnsemble',LVT_rc%nensem, iret) - call LVT_verify(iret,'grib_set:numberOfForecastsInEnsemble failed in LVT_DataStreamsMod') + call grib_set(igrib, 'numberOfForecastsInEnsemble', LVT_rc%nensem, iret) + call LVT_verify(iret, & + 'grib_set:numberOfForecastsInEnsemble failed in '// & + 'LVT_DataStreamsMod') end if ! PDT 4.2 or PDT 4.12 ! Additional entries for Product Definition Template 4.12 if (pdTemplate == 12) then ! Octet 37-38 - call grib_set(igrib,'yearOfEndOfOverallTimeInterval',LVT_rc%yr, iret) - call LVT_verify(iret,'grib_set:yearOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call grib_set(igrib, 'yearOfEndOfOverallTimeInterval', LVT_rc%yr, iret) + call LVT_verify(iret, & + 'grib_set:yearOfEndOfOverallTimeInterval failed in '// & + 'LVT_DataStreamsMod') ! Octet 39 - call grib_set(igrib,'monthOfEndOfOverallTimeInterval',LVT_rc%mo, iret) - call LVT_verify(iret,'grib_set:monthOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call grib_set(igrib, 'monthOfEndOfOverallTimeInterval', LVT_rc%mo, iret) + call LVT_verify(iret, & + 'grib_set:monthOfEndOfOverallTimeInterval failed in '// & + 'LVT_DataStreamsMod') ! Octet 40 - call grib_set(igrib,'dayOfEndOfOverallTimeInterval',LVT_rc%da, iret) - call LVT_verify(iret,'grib_set:dayOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call grib_set(igrib, 'dayOfEndOfOverallTimeInterval', LVT_rc%da, iret) + call LVT_verify(iret, & + 'grib_set:dayOfEndOfOverallTimeInterval failed in '// & + 'LVT_DataStreamsMod') ! Octet 41 - call grib_set(igrib,'hourOfEndOfOverallTimeInterval',LVT_rc%hr, iret) - call LVT_verify(iret,'grib_set:hourOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call grib_set(igrib, 'hourOfEndOfOverallTimeInterval', LVT_rc%hr, iret) + call LVT_verify(iret, & + 'grib_set:hourOfEndOfOverallTimeInterval failed in '// & + 'LVT_DataStreamsMod') ! Octet 42 - call grib_set(igrib,'minuteOfEndOfOverallTimeInterval',LVT_rc%mn, iret) - call LVT_verify(iret,'grib_set:minuteOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call grib_set(igrib, 'minuteOfEndOfOverallTimeInterval', & + LVT_rc%mn, iret) + call LVT_verify(iret, & + 'grib_set:minuteOfEndOfOverallTimeInterval failed in '// & + 'LVT_DataStreamsMod') ! Octet 43 - call grib_set(igrib,'secondOfEndOfOverallTimeInterval',LVT_rc%ss, iret) - call LVT_verify(iret,'grib_set:secondOfEndOfOverallTimeInterval failed in LVT_DataStreamsMod') + call grib_set(igrib, 'secondOfEndOfOverallTimeInterval', & + LVT_rc%ss, iret) + call LVT_verify(iret, & + 'grib_set:secondOfEndOfOverallTimeInterval failed in '// & + 'LVT_DataStreamsMod') ! Octet 49 - if(trim(sType).eq."avg") then + if (trim(sType) .eq. "avg") then sType_int = 0 - elseif(trim(sType).eq."accum") then + elseif (trim(sType) .eq. "accum") then sType_int = 1 - else if (trim(sType).eq."max") then + else if (trim(sType) .eq. "max") then sType_int = 2 - else if (trim(sType).eq."min") then + else if (trim(sType) .eq. "min") then sType_int = 3 endif - call grib_set(igrib,'typeOfStatisticalProcessing',sType_int, iret) - call LVT_verify(iret,'grib_set:typeOfStatisticalProcessing failed in LVT_DataStreamsMod') + call grib_set(igrib, 'typeOfStatisticalProcessing', sType_int, iret) + call LVT_verify(iret, & + 'grib_set:typeOfStatisticalProcessing failed in '// & + 'LVT_DataStreamsMod') ! Octet 50 ! Use 2 -- Successive times processed have same start time of ! forecast, forecast time is incremented. - call grib_set(igrib,'typeOfTimeIncrement',2, iret) - call LVT_verify(iret,'grib_set:typeOfTimeIncrement failed in LVT_DataStreamsMod') + call grib_set(igrib, 'typeOfTimeIncrement', 2, iret) + call LVT_verify(iret, & + 'grib_set:typeOfTimeIncrement failed in LVT_DataStreamsMod') ! Octet 51...Use hours - call grib_set(igrib,'indicatorOfUnitForTimeRange',1, iret) ! Hour - call LVT_verify(iret,'grib_set:indicatorOfUnitForTimeRange failed in LVT_DataStreamsMod') + call grib_set(igrib, 'indicatorOfUnitForTimeRange', 1, iret) ! Hour + call LVT_verify(iret, & + 'grib_set:indicatorOfUnitForTimeRange failed in '// & + 'LVT_DataStreamsMod') ! Octet 52-55...Time range for statistical processing call ESMF_TimeIntervalGet(timeinterval12, h=hr1, rc=iret) call LVT_verify(iret,& 'ESMF_TimeIntervalGet:timeinterval12 failed in LVT_DataStreamsMod') - call grib_set(igrib,'lengthOfTimeRange',hr1, iret) - call LVT_verify(iret,'grib_set:lengthOfTimeRange failed in LVT_DataStreamsMod') + call grib_set(igrib, 'lengthOfTimeRange', hr1, iret) + call LVT_verify(iret,& + 'grib_set:lengthOfTimeRange failed in LVT_DataStreamsMod') ! Octet 56...Use minutes - call grib_set(igrib,'indicatorOfUnitForTimeIncrement',0, iret) ! Minutes - call LVT_verify(iret,'grib_set:indicatorOfUnitForTimeIncrement failed in LVT_DataStreamsMod') + call grib_set(igrib, 'indicatorOfUnitForTimeIncrement', 0, iret) + call LVT_verify(iret, & + 'grib_set:indicatorOfUnitForTimeIncrement failed in '// & + 'LVT_DataStreamsMod') ! Octet 57-60...Time increment. This should be the LIS time step in ! minutes - call grib_set(igrib,'timeIncrement',LVT_rc%lis_ts/60, iret) - call LVT_verify(iret,'grib_set:timeIncrement failed in LVT_DataStreamsMod') + call grib_set(igrib, 'timeIncrement', LVT_rc%lis_ts/60, iret) + call LVT_verify(iret, & + 'grib_set:timeIncrement failed in LVT_DataStreamsMod') end if ! PDT 4.12 ! Section 5: Data Representation - call grib_set(igrib,'packingType',LVT_rc%grib_packing_type,iret) + call grib_set(igrib, 'packingType', LVT_rc%grib_packing_type, iret) call LVT_verify(iret, 'grib_set:packingType failed in LVT_DataStreamsMod') - call grib_set(igrib, 'missingValue',LVT_rc%udef,iret) + call grib_set(igrib, 'missingValue', LVT_rc%udef, iret) call LVT_verify(iret, 'grib_set:missingValue failed in LVT_DataStreamsMod') ! Should not need to fix the "num bits" value for each parameter @@ -3739,24 +3890,26 @@ subroutine writeSingleGrib2Var(ftn,gtmp,gribId,gribSF,gribSfc,gribLvl,& ! gribSF (grib scale factor) set in the MODEL OUTPUT TBL. - dmm gribSFtemp = gribSF decimalPrecision = 0 - do while (gribSFtemp.ge.10) + do while (gribSFtemp .ge. 10) decimalPrecision = decimalPrecision + 1 gribSFtemp = gribSFtemp / 10 enddo - call grib_set(igrib, 'decimalPrecision',decimalPrecision,iret) - call LVT_verify(iret, 'grib_set:decimalPrecision failed in LVT_DataStreamsMod') + call grib_set(igrib, 'decimalPrecision', decimalPrecision, iret) + call LVT_verify(iret, & + 'grib_set:decimalPrecision failed in LVT_DataStreamsMod') ! Section 6: Bit-Map - call grib_set(igrib, 'bitmapPresent',1,iret) - call LVT_verify(iret, 'grib_set:bitmapPresent failed in LVT_DataStreamsMod') + call grib_set(igrib, 'bitmapPresent', 1, iret) + call LVT_verify(iret, & + 'grib_set:bitmapPresent failed in LVT_DataStreamsMod') - call grib_set(igrib,'values',gtmp,iret) + call grib_set(igrib, 'values', gtmp, iret) call LVT_verify(iret, 'grib_set:values failed in LVT_DataStreamsMod') - call grib_write(igrib,ftn,iret) + call grib_write(igrib, ftn, iret) call LVT_verify(iret, 'grib_write failed in LVT_DataStreamsMod') - call grib_release(igrib,iret) + call grib_release(igrib, iret) call LVT_verify(iret,'grib_release failed in LVT_DataStreamsMod') end subroutine writeSingleGrib2Var @@ -3812,13 +3965,13 @@ subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) shuffle = NETCDF_shuffle deflate = NETCDF_deflate - deflate_level =NETCDF_deflate_level + deflate_level = NETCDF_deflate_level - if(dataEntry%selectOpt.eq.1)then - if(dataEntry%vlevels.gt.1) then - call LVT_verify(nf90_def_dim(ftn,& - trim(dataEntry%short_name)//'_profiles',& - dataEntry%vlevels, dimID(3)),& + if (dataEntry%selectOpt .eq. 1 )then + if (dataEntry%vlevels .gt. 1) then + call LVT_verify(nf90_def_dim(ftn, & + trim(dataEntry%short_name)//'_profiles', & + dataEntry%vlevels, dimID(3)), & 'nf90_def_dim failed (2d gridspace) in LVT_DataStreamsMod') endif @@ -3836,75 +3989,76 @@ subroutine defineNETCDFheaderVar(ftn, dimID, dataEntry) else if (dataEntry%timeAvgOpt.eq.3) then short_name = trim(dataEntry%short_name)//"_acc" else - write(LVT_logunit,*)'[ERR] Cannot handle ',trim(dataEntry%short_name) + write(LVT_logunit,*) '[ERR] Cannot handle ', & + trim(dataEntry%short_name) call LVT_endrun() end if - if(dataEntry%vlevels.gt.1) then - call LVT_verify(nf90_def_var(ftn,trim(short_name),& - nf90_float,& - dimids = dimID(1:3), varID=dataEntry%varId_def),& - 'nf90_def_var for '//trim(short_name)//& + if (dataEntry%vlevels .gt. 1) then + call LVT_verify(nf90_def_var(ftn,trim(short_name), & + nf90_float, & + dimids = dimID(1:3), varID=dataEntry%varId_def), & + 'nf90_def_var for '//trim(short_name)// & 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_fill(ftn,& + call LVT_verify(nf90_def_var_fill(ftn, & dataEntry%varId_def, & - 1,fill_value), 'nf90_def_var_fill failed for '//& + 1,fill_value), 'nf90_def_var_fill failed for '// & dataEntry%short_name) - call LVT_verify(nf90_def_var_deflate(ftn,& - dataEntry%varId_def,& - shuffle, deflate, deflate_level),& - 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& + call LVT_verify(nf90_def_var_deflate(ftn, & + dataEntry%varId_def, & + shuffle, deflate, deflate_level), & + 'nf90_def_var_deflate for '//trim(dataEntry%short_name)// & 'failed in defineNETCDFheadervar') #endif else - call LVT_verify(nf90_def_var(ftn,trim(short_name),& - nf90_float,& - dimids = dimID(1:2), varID=dataEntry%varId_def),& - 'nf90_def_var for '//trim(short_name)//& + call LVT_verify(nf90_def_var(ftn,trim(short_name), & + nf90_float, & + dimids = dimID(1:2), varID=dataEntry%varId_def), & + 'nf90_def_var for '//trim(short_name)// & 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_fill(ftn,& + call LVT_verify(nf90_def_var_fill(ftn, & dataEntry%varId_def, & - 1,fill_value), 'nf90_def_var_fill failed for '//& + 1,fill_value), 'nf90_def_var_fill failed for '// & dataEntry%short_name) - call LVT_verify(nf90_def_var_deflate(ftn,& - dataEntry%varId_def,& - shuffle, deflate, deflate_level),& - 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& + call LVT_verify(nf90_def_var_deflate(ftn, & + dataEntry%varId_def, & + shuffle, deflate, deflate_level), & + 'nf90_def_var_deflate for '//trim(dataEntry%short_name)// & 'failed in defineNETCDFheadervar') #endif endif - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "units",trim(dataEntry%units)),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def, & + "units", trim(dataEntry%units)), & 'nf90_put_att for units failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "standard_name",trim(dataEntry%standard_name)),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def, & + "standard_name", trim(dataEntry%standard_name)), & 'nf90_put_att for standard_name failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "long_name",trim(dataEntry%long_name)),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def, & + "long_name",trim(dataEntry%long_name)), & 'nf90_put_att for long_name failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "scale_factor",1.0),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def, & + "scale_factor", 1.0), & 'nf90_put_att for scale_factor failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "add_offset",0.0),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def, & + "add_offset", 0.0), & 'nf90_put_att for add_offset failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "missing_value",LVT_rc%udef),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def, & + "missing_value", LVT_rc%udef), & 'nf90_put_att for missing_value failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "_FillValue",LVT_rc%udef),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def, & + "_FillValue", LVT_rc%udef), & 'nf90_put_att for _FillValue failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "vmin",dataEntry%valid_min),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def,& + "vmin", dataEntry%valid_min),& 'nf90_put_att for vmin failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varId_def,& - "vmax",dataEntry%valid_max),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varId_def,& + "vmax", dataEntry%valid_max),& 'nf90_put_att for vmax failed in defineNETCDFheaderVar') endif @@ -3963,13 +4117,13 @@ subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) shuffle = NETCDF_shuffle deflate = NETCDF_deflate - deflate_level =NETCDF_deflate_level + deflate_level = NETCDF_deflate_level - if(dataEntry%selectOpt.eq.1)then - if(dataEntry%vlevels.gt.1) then - call LVT_verify(nf90_def_dim(ftn,& - trim(dataEntry%short_name)//'_profiles',& - dataEntry%vlevels, dimID(3)),& + if (dataEntry%selectOpt .eq. 1) then + if (dataEntry%vlevels .gt. 1) then + call LVT_verify(nf90_def_dim(ftn, & + trim(dataEntry%short_name)//'_profiles', & + dataEntry%vlevels, dimID(3)), & 'nf90_def_dim failed (2d gridspace) in LVT_DataStreamsMod') endif @@ -3992,69 +4146,69 @@ subroutine defineNETCDFheaderVar_SS(ftn, dimID, dataEntry) end if if(dataEntry%vlevels.gt.1) then - call LVT_verify(nf90_def_var(ftn,trim(short_name),& + call LVT_verify(nf90_def_var(ftn, trim(short_name),& nf90_float,& - dimids = dimID(1:3), varID=dataEntry%varid_ss),& + dimids=dimID(1:3), varID=dataEntry%varid_ss),& 'nf90_def_var for '//trim(dataEntry%short_name)//& 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_fill(ftn,& + call LVT_verify(nf90_def_var_fill(ftn, & dataEntry%varid_ss, & - 1,fill_value), 'nf90_def_var_fill failed for '//& + 1,fill_value), 'nf90_def_var_fill failed for '// & dataEntry%short_name) - call LVT_verify(nf90_def_var_deflate(ftn,& - dataEntry%varid_ss,& - shuffle, deflate, deflate_level),& - 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& + call LVT_verify(nf90_def_var_deflate(ftn, & + dataEntry%varid_ss, & + shuffle, deflate, deflate_level), & + 'nf90_def_var_deflate for '//trim(dataEntry%short_name)// & 'failed in defineNETCDFheadervar') #endif else - call LVT_verify(nf90_def_var(ftn,trim(short_name),& - nf90_float,& - dimids = dimID(1:2), varID=dataEntry%varid_ss),& - 'nf90_def_var for '//trim(dataEntry%short_name)//& + call LVT_verify(nf90_def_var(ftn,trim(short_name), & + nf90_float, & + dimids = dimID(1:2), varID=dataEntry%varid_ss), & + 'nf90_def_var for '//trim(dataEntry%short_name)// & 'failed in defineNETCDFheadervar') #if(defined USE_NETCDF4) - call LVT_verify(nf90_def_var_fill(ftn,& + call LVT_verify(nf90_def_var_fill(ftn, & dataEntry%varid_ss, & - 1,fill_value), 'nf90_def_var_fill failed for '//& + 1,fill_value), 'nf90_def_var_fill failed for '// & dataEntry%short_name) - call LVT_verify(nf90_def_var_deflate(ftn,& - dataEntry%varid_ss,& - shuffle, deflate, deflate_level),& - 'nf90_def_var_deflate for '//trim(dataEntry%short_name)//& + call LVT_verify(nf90_def_var_deflate(ftn, & + dataEntry%varid_ss, & + shuffle, deflate, deflate_level), & + 'nf90_def_var_deflate for '//trim(dataEntry%short_name)// & 'failed in defineNETCDFheadervar') #endif endif - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "units",trim(dataEntry%units)),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss, & + "units",trim(dataEntry%units)), & 'nf90_put_att for units failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "standard_name",trim(dataEntry%standard_name)),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss, & + "standard_name", trim(dataEntry%standard_name)), & 'nf90_put_att for standard_name failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "long_name",trim(dataEntry%long_name)),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss, & + "long_name", trim(dataEntry%long_name)), & 'nf90_put_att for long_name failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "scale_factor",1.0),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss, & + "scale_factor", 1.0), & 'nf90_put_att for scale_factor failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "add_offset",0.0),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss,& + "add_offset", 0.0),& 'nf90_put_att for add_offset failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "missing_value",LVT_rc%udef),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss,& + "missing_value", LVT_rc%udef),& 'nf90_put_att for missing_value failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "_FillValue",LVT_rc%udef),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss,& + "_FillValue", LVT_rc%udef),& 'nf90_put_att for _FillValue failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "vmin",dataEntry%valid_min),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss,& + "vmin", dataEntry%valid_min),& 'nf90_put_att for vmin failed in defineNETCDFheaderVar') - call LVT_verify(nf90_put_att(ftn,dataEntry%varid_ss,& - "vmax",dataEntry%valid_max),& + call LVT_verify(nf90_put_att(ftn, dataEntry%varid_ss,& + "vmax" ,dataEntry%valid_max),& 'nf90_put_att for vmax failed in defineNETCDFheaderVar') endif @@ -4067,7 +4221,7 @@ end subroutine defineNETCDFheaderVar_SS ! \label{writeSingleNetcdfVar} ! ! !INTERFACE: - subroutine writeSingleNetcdfVar(ftn,gtmp,varID,k) + subroutine writeSingleNetcdfVar(ftn, gtmp, varID, k) ! ! !DESCRIPTION: ! This subroutine writes a single variable to a grib file @@ -4085,14 +4239,14 @@ subroutine writeSingleNetcdfVar(ftn,gtmp,varID,k) #if(defined USE_NETCDF3 || defined USE_NETCDF4) - do r=1,LVT_rc%lnr - do c=1,LVT_rc%lnc - gtmp2d(c,r) = gtmp(c+(r-1)*LVT_rc%lnc) + do r = 1, LVT_rc%lnr + do c = 1, LVT_rc%lnc + gtmp2d(c,r) = gtmp(c + (r-1)*LVT_rc%lnc) enddo enddo - call LVT_verify(nf90_put_var(ftn,varID, gtmp2d,(/1,1,k/),& - (/LVT_rc%gnc,LVT_rc%gnr,1/)),& + call LVT_verify(nf90_put_var(ftn, varID, gtmp2d, (/1, 1, k/),& + (/LVT_rc%gnc, LVT_rc%gnr, 1/)),& 'nf90_put_var failed for in LVT_DataStreamsMod') #endif @@ -4146,16 +4300,16 @@ subroutine LVT_tavgDataStreams if (local_computeFlag) then !data stream 1 - do kk=1,LVT_rc%nDataStreams - if(kk.eq.1) then + do kk = 1, LVT_rc%nDataStreams + if (kk .eq. 1) then dataEntry => LVT_histData%head_ds1_list - elseif(kk.eq.2) then + elseif (kk .eq. 2) then dataEntry => LVT_histData%head_ds2_list - elseif(kk.eq.3) then + elseif (kk .eq. 3) then dataEntry => LVT_histData%head_ds3_list endif - do while(associated(dataEntry)) + do while (associated(dataEntry)) call tavgSingleDataStream(dataEntry) dataEntry => dataEntry%next enddo @@ -4164,13 +4318,13 @@ subroutine LVT_tavgDataStreams ! Note that this check is not enabled for three datastrems. ! The responsibility of ensuring non-duplicate entries is ! on the user. - if(LVT_rc%ds1_dup) then + if (LVT_rc%ds1_dup) then ds1 => LVT_histData%head_ds1_list - do while(associated(ds1)) + do while (associated(ds1)) ds2 => ds1%next - do while(associated(ds2)) - if(ds2%index.ne.ds1%index.and.& - ds1%short_name.eq.ds2%short_name) then + do while (associated(ds2)) + if (ds2%index .ne. ds1%index .and.& + ds1%short_name .eq. ds2%short_name) then ds2%value = ds1%value ds2%count = ds1%count endif @@ -4181,13 +4335,13 @@ subroutine LVT_tavgDataStreams endif - if(LVT_rc%ds2_dup) then + if (LVT_rc%ds2_dup) then ds1 => LVT_histData%head_ds2_list - do while(associated(ds1)) + do while (associated(ds1)) ds2 => ds1%next - do while(associated(ds2)) - if(ds2%index.ne.ds1%index.and.& - ds1%short_name.eq.ds2%short_name) then + do while (associated(ds2)) + if(ds2%index .ne. ds1%index .and.& + ds1%short_name .eq. ds2%short_name) then ds2%value = ds1%value ds2%count = ds1%count endif @@ -4213,7 +4367,7 @@ end subroutine LVT_tavgDataStreams ! \label{tavgSingleDataStream} ! ! !INTERFACE: - subroutine tavgSingleDataStream( dataEntry) + subroutine tavgSingleDataStream (dataEntry) ! ! !USES: @@ -4247,16 +4401,16 @@ subroutine tavgSingleDataStream( dataEntry) ! if (trim(dataEntry%short_name) == "Tair_f_max") return ! if (trim(dataEntry%short_name) == "Tair_f_min") return - if(dataEntry%selectNlevs.ge.1) then - if(LVT_rc%computeEnsMetrics.eq.1) then - do t=1,LVT_LIS_rc(1)%ntiles - do k=1,dataEntry%vlevels + if (dataEntry%selectNlevs .ge. 1) then + if (LVT_rc%computeEnsMetrics .eq. 1) then + do t = 1, LVT_LIS_rc(1)%ntiles + do k = 1, dataEntry%vlevels c = LVT_LIS_domain(1)%tile(t)%col r = LVT_LIS_domain(1)%tile(t)%row - if(LVT_LIS_domain(1)%gindex(c,r).ne.-1) then + if (LVT_LIS_domain(1)%gindex(c,r) .ne. -1) then gid = LVT_LIS_domain(1)%gindex(c,r) - do m=1,LVT_rc%nensem - if(dataEntry%count(t,m,k).ne.0) then + do m = 1,LVT_rc%nensem + if (dataEntry%count(t,m,k) .ne. 0) then dataEntry%value(t,m,k) = & dataEntry%value(t,m,k)/dataEntry%count(t,m,k) @@ -4266,15 +4420,15 @@ subroutine tavgSingleDataStream( dataEntry) enddo enddo else - do r=1,LVT_rc%lnr - do c=1,LVT_rc%lnc - do k=1,dataEntry%vlevels - if(LVT_domain%gindex(c,r).ne.-1) then + do r = 1,LVT_rc%lnr + do c = 1,LVT_rc%lnc + do k = 1,dataEntry%vlevels + if (LVT_domain%gindex(c,r) .ne. -1) then gid = LVT_domain%gindex(c,r) - do m=1,LVT_rc%nensem - if(dataEntry%count(gid,m,k).ne.0) then + do m = 1,LVT_rc%nensem + if (dataEntry%count(gid,m,k).ne.0) then dataEntry%value(gid,m,k) = & - dataEntry%value(gid,m,k)/& + dataEntry%value(gid,m,k) / & dataEntry%count(gid,m,k) endif enddo @@ -4328,7 +4482,7 @@ subroutine LVT_resetDataStreams ! compute flag compared to normal LVT users. So we use a local variable ! to accomodate both. local_computeFlag = LVT_rc%computeFlag - if (LVT_rc%runmode.eq."557 post") then + if (LVT_rc%runmode .eq. "557 post") then local_computeFlag = LVT_557post_alarm_is_on() end if @@ -4337,7 +4491,7 @@ subroutine LVT_resetDataStreams !data stream 1 ds1 => LVT_histData%head_ds1_list - do while(associated(ds1)) + do while (associated(ds1)) call resetSingleDataStream(ds1) ds1 => ds1%next enddo @@ -4345,31 +4499,31 @@ subroutine LVT_resetDataStreams !data stream 2 ds2 => LVT_histData%head_ds2_list - do while(associated(ds2)) + do while (associated(ds2)) call resetSingleDataStream(ds2) ds2 => ds2%next enddo - if(LVT_rc%nDataStreams.gt.2) then + if (LVT_rc%nDataStreams .gt. 2) then !data stream 3 ds3 => LVT_histData%head_ds3_list - do while(associated(ds3)) + do while (associated(ds3)) call resetSingleDataStream(ds3) ds3 => ds3%next enddo endif !need special handler for LIS output - if(LVT_rc%lis_output_obs) then - if(LVT_rc%obssource(1).eq."LIS output") then + if (LVT_rc%lis_output_obs) then + if (LVT_rc%obssource(1) .eq. "LIS output") then call LVT_resetLISoutputContainers(1) endif - if(LVT_rc%obssource(2).eq."LIS output") then + if (LVT_rc%obssource(2) .eq. "LIS output") then call LVT_resetLISoutputContainers(2) endif - if(LVT_rc%nDataStreams.gt.2) then - if(LVT_rc%obssource(3).eq."LIS output") then + if (LVT_rc%nDataStreams .gt. 2) then + if (LVT_rc%obssource(3) .eq. "LIS output") then call LVT_resetLISoutputContainers(3) endif endif @@ -4411,8 +4565,8 @@ subroutine resetSingleDataStream(dataEntry) integer :: k - if(dataEntry%selectNlevs.ge.1) then - do k=1,dataEntry%vlevels + if (dataEntry%selectNlevs .ge. 1) then + do k = 1, dataEntry%vlevels dataEntry%value(:,:,k) = 0 dataEntry%count(:,:,k) = 0 dataEntry%count_status(:,:,k) = 0 @@ -4463,21 +4617,21 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & write(LVT_logunit,*)'----------------------------------------------------' write(LVT_logunit,*)'[INFO] *** SEARCHING FOR GOFS SST ***' - write(LVT_logunit,*)'[INFO] Trying ',trim(sst_filename) - inquire(file=trim(sst_filename),exist=file_exists) + write(LVT_logunit,*)'[INFO] Trying ', trim(sst_filename) + inquire(file=trim(sst_filename), exist=file_exists) if (file_exists) then - write(LVT_logunit,*)'[INFO] Will use ',trim(sst_filename) + write(LVT_logunit,*)'[INFO] Will use ', trim(sst_filename) return end if ! At this point, we are rolling back to earlier SST file call LVT_get_julhr(LVT_rc%yr, LVT_rc%mo, LVT_rc%da, & - 0,0,0,lvt_julhr) + 0, 0, 0, lvt_julhr) sst_julhr = lvt_julhr ! Start looping for earlier files do - write(LVT_logunit,*)'[WARN] Cannot find ',trim(sst_filename) + write(LVT_logunit,*) '[WARN] Cannot find ', trim(sst_filename) sst_fcst_hr = sst_fcst_hr - 6 if (sst_fcst_hr < 0) then sst_fcst_hr = 24 @@ -4489,16 +4643,17 @@ subroutine get_hycom_sst_filename(sst_filename, sst_year, sst_month, & sst_filename = 'NONE' return end if - call LVT_julhr_date(sst_julhr,sst_year,sst_month,sst_day,sst_hour) + call LVT_julhr_date(sst_julhr, sst_year, sst_month, sst_day, & + sst_hour) end if call construct_hycom_sst_filename(LVT_rc%HYCOMdir, & sst_year, sst_month, sst_day, & sst_hour, sst_fcst_hr, sst_filename) - write(LVT_logunit,*)'[INFO] Trying ',trim(sst_filename) - inquire(file=trim(sst_filename),exist=file_exists) + write(LVT_logunit,*) '[INFO] Trying ', trim(sst_filename) + inquire(file=trim(sst_filename), exist=file_exists) if (file_exists) then - write(LVT_logunit,*)'[INFO] Will use ',trim(sst_filename) + write(LVT_logunit,*) '[INFO] Will use ', trim(sst_filename) return end if end do @@ -4524,8 +4679,8 @@ subroutine construct_hycom_sst_filename(rootdir, & character(len=10) :: yyyymmddhh character(len=4) :: thhh - write(yyyymmddhh,'(i4.4,i2.2,i2.2,i2.2)') yr,mo,da,hr - write(thhh,'(a1,i3.3)') 't',fcst_hr + write(yyyymmddhh,'(i4.4,i2.2,i2.2,i2.2)') yr, mo, da, hr + write(thhh,'(a1,i3.3)') 't', fcst_hr sst_filename = trim(rootdir) // '/hycom_glb_sfc_u_' //yyyymmddhh// & '_'//thhh//'.nc' @@ -4533,8 +4688,8 @@ subroutine construct_hycom_sst_filename(rootdir, & end subroutine construct_hycom_sst_filename ! EMK...Construct filename for HYCOM sea ice. Targets GOFS 93.0 - subroutine get_hycom_cice_filename(region,cice_filename, & - cice_year,cice_month,cice_day,cice_hour,cice_fcst_hr) + subroutine get_hycom_cice_filename(region, cice_filename, & + cice_year, cice_month, cice_day, cice_hour, cice_fcst_hr) implicit none @@ -4554,7 +4709,7 @@ subroutine get_hycom_cice_filename(region,cice_filename, & ! First guess call LVT_get_julhr(LVT_rc%yr, LVT_rc%mo, LVT_rc%da, & - 12,0,0,lvt_julhr) + 12,0,0, lvt_julhr) if (LVT_rc%hr .ge. 12) then cice_julhr = lvt_julhr cice_fcst_hr = 0 @@ -4562,7 +4717,8 @@ subroutine get_hycom_cice_filename(region,cice_filename, & cice_julhr = lvt_julhr - 24 ! Must be previous day cice_fcst_hr = 12 end if - call LVT_julhr_date(cice_julhr,cice_year,cice_month,cice_day,cice_hour) + call LVT_julhr_date(cice_julhr, cice_year, cice_month, cice_day, & + cice_hour) call construct_hycom_cice_filename(LVT_rc%HYCOMdir, & region, & cice_year, cice_month, cice_day, & @@ -4570,39 +4726,40 @@ subroutine get_hycom_cice_filename(region,cice_filename, & write(LVT_logunit,*)'----------------------------------------------------' write(LVT_logunit,*)'[INFO] *** SEARCHING FOR GOFS CICE FOR ',& - trim(region),' REGION ***' - write(LVT_logunit,*)'[INFO] Trying ',trim(cice_filename) - inquire(file=trim(cice_filename),exist=file_exists) + trim(region), ' REGION ***' + write(LVT_logunit,*)'[INFO] Trying ', trim(cice_filename) + inquire(file=trim(cice_filename), exist=file_exists) if (file_exists) then - write(LVT_logunit,*)'[INFO] Will use ',trim(cice_filename) + write(LVT_logunit,*)'[INFO] Will use ', trim(cice_filename) return end if ! At this point, we are rolling back to earlier CICE file ! Start looping for earlier files do - write(LVT_logunit,*)'[WARN] Cannot find ',trim(cice_filename) + write(LVT_logunit,*) '[WARN] Cannot find ', trim(cice_filename) cice_fcst_hr = cice_fcst_hr + 24 cice_julhr = cice_julhr - 24 if ((lvt_julhr - cice_julhr) > 24*5) then - write(LVT_logunit,*)& - '[WARN] *** GIVING UP ON GOFS CICE FOR ',trim(region),' ***' write(LVT_logunit,*) & - '[WARN] *** NO GOFS CICE DATA FOR ',trim(region), & + '[WARN] *** GIVING UP ON GOFS CICE FOR ', trim(region), ' ***' + write(LVT_logunit,*) & + '[WARN] *** NO GOFS CICE DATA FOR ', trim(region), & ' AVAILABLE!!! ***' cice_filename = 'NONE' return end if - call LVT_julhr_date(cice_julhr,cice_year,cice_month,cice_day,cice_hour) + call LVT_julhr_date(cice_julhr, cice_year, cice_month, cice_day, & + cice_hour) call construct_hycom_cice_filename(LVT_rc%HYCOMdir, & region, & cice_year, cice_month, cice_day, & cice_hour, cice_fcst_hr, cice_filename) - write(LVT_logunit,*)'[INFO] Trying ',trim(cice_filename) - inquire(file=trim(cice_filename),exist=file_exists) + write(LVT_logunit,*)'[INFO] Trying ', trim(cice_filename) + inquire(file=trim(cice_filename), exist=file_exists) if (file_exists) then - write(LVT_logunit,*)'[INFO] Will use ',trim(cice_filename) + write(LVT_logunit,*)'[INFO] Will use ', trim(cice_filename) return end if end do @@ -4612,7 +4769,7 @@ end subroutine get_hycom_cice_filename ! EMK subroutine construct_hycom_cice_filename(rootdir, & - region,yr, mo, da, hr, fcst_hr, cice_filename) + region, yr, mo, da, hr, fcst_hr, cice_filename) implicit none @@ -4630,8 +4787,8 @@ subroutine construct_hycom_cice_filename(rootdir, & character(len=10) :: yyyymmddhh character(len=4) :: thhh - write(yyyymmddhh,'(i4.4,i2.2,i2.2,i2.2)') yr,mo,da,hr - write(thhh,'(a1,i3.3)') 't',fcst_hr + write(yyyymmddhh,'(i4.4,i2.2,i2.2,i2.2)') yr, mo, da, hr + write(thhh,'(a1,i3.3)') 't', fcst_hr cice_filename = trim(rootdir) // '/hycom-cice_inst_' // trim(region) & // 'u0.08_930_' // yyyymmddhh // '_'//thhh//'.nc' From 761605967c933a747dc02f2a2424f25264199538 Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Wed, 12 May 2021 14:16:32 -0400 Subject: [PATCH 61/64] Added logic to dynamically pick NAVGEM forecast for SST. --- lvt/core/LVT_navgemMod.F90 | 82 ++++++++++++++++++++++++++++++++------ 1 file changed, 70 insertions(+), 12 deletions(-) diff --git a/lvt/core/LVT_navgemMod.F90 b/lvt/core/LVT_navgemMod.F90 index 66a15167c..5317a4ce4 100644 --- a/lvt/core/LVT_navgemMod.F90 +++ b/lvt/core/LVT_navgemMod.F90 @@ -73,6 +73,7 @@ subroutine LVT_get_navgem_sst_gr1_filename(filename, & year, month, day, hour, fcst_hr) ! Modules + use LVT_coreMod, only: LVT_rc use LVT_logMod, only: LVT_logunit use LVT_timeMgrMod, only: LVT_get_julhr, LVT_julhr_date @@ -91,28 +92,85 @@ subroutine LVT_get_navgem_sst_gr1_filename(filename, & integer :: navgem_julhr, lvt_julhr logical :: file_exists - ! FIXME...Add dynamic search for nearest NAVGEM file. The - ! existing code is hardwired for a sample file provided by FNMOC. - year = 2021 - month = 04 - day = 13 - hour = 00 - fcst_hr = 00 + ! EMK TEST...Hardwired attributes for sample NAVGEM data from FNMOC. + ! year = 2021 + ! month = 04 + ! day = 13 + ! hour = 00 + ! fcst_hr = 00 + + ! First guess for NAVGEM run + call LVT_get_julhr(LVT_rc%yr, LVT_rc%mo, LVT_rc%da, & + LVT_rc%hr, 0, 0, lvt_julhr) + select case (LVT_rc%hr) + case(21) + navgem_julhr = lvt_julhr - 3 + fcst_hr = 3 + case (18) + navgem_julhr = lvt_julhr + fcst_hr = 0 + case (15) + navgem_julhr = lvt_julhr - 3 + fcst_hr = 3 + case (12) + navgem_julhr = lvt_julhr + fcst_hr = 0 + case (9) + navgem_julhr = lvt_julhr - 3 + fcst_hr = 3 + case (6) + navgem_julhr = lvt_julhr + fcst_hr = 0 + case (3) + navgem_julhr = lvt_julhr - 3 + fcst_hr = 3 + case (0) + navgem_julhr = lvt_julhr + fcst_hr = 0 + case default + write(LVT_logunit,*)'[ERR] Invalid hour for LVT postprocessing!' + write(LVT_logunit,*)'LVT_rc%hr = ', LVT_rc%hr + stop + end select + + call LVT_julhr_date(navgem_julhr, year, month, day, hour) call construct_navgem_sst_gr1_filename('./navgem', & year, month, day, hour, fcst_hr, filename) - write(LVT_logunit,*)'[INFO] *** Searching for NAVGEM file ', & - trim(filename) inquire(file=trim(filename), exist=file_exists) if (file_exists) then write(LVT_logunit,*)'[INFO] Will use ', trim(filename) return end if - ! FIXME...Add dynamic search for NAVGEM file - write(LVT_logunit,*)'[ERR] Cannot find NAVGEM file!' - stop + ! At this point, we are rolling back to earlier NAVGEM file + ! Start looping for earlier files + do + write(LVT_logunit,*) '[WARN] Cannot find ', trim(filename) + navgem_julhr = navgem_julhr - 6 + fcst_hr = fcst_hr + 6 + + ! NAVGEM only produces SST out to 180 hours (as of 12 May 2021). + ! So that is a good criteria to give up. + if (fcst_hr .gt. 180) then + write(LVT_logunit,*) & + '[WARN] *** GIVING UP ON NAVGEM SST ***' + write(LVT_logunit,*) & + '[WARN] *** NO NAVGEM SST DATA AVAILABLE!!!' + filename = 'NONE' + return + end if + call LVT_julhr_date(navgem_julhr, year, month, day, hour) + + call construct_navgem_sst_gr1_filename('./navgem', & + year, month, day, hour, fcst_hr, filename) + inquire(file=trim(filename), exist=file_exists) + if (file_exists) then + write(LVT_logunit,*)'[INFO] Will use ', trim(filename) + return + end if + end do end subroutine LVT_get_navgem_sst_gr1_filename From 94e3582d3455b6c6b24afe4f8ebe7174b5d7d6ef Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 18 May 2021 12:57:40 -0400 Subject: [PATCH 62/64] Turned off NAVGEM SST processing when HYCOM is off. --- lvt/core/LVT_DataStreamsMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lvt/core/LVT_DataStreamsMod.F90 b/lvt/core/LVT_DataStreamsMod.F90 index d453792ee..1a4cbe13e 100644 --- a/lvt/core/LVT_DataStreamsMod.F90 +++ b/lvt/core/LVT_DataStreamsMod.F90 @@ -2167,6 +2167,8 @@ subroutine LVT_append_navgem_sst_field(ftn_mean, time_unit, time_past, & external :: bilinear_interp_input external :: bilinear_interp + if (LVT_rc%processHYCOM .ne. 1) return + ! Check for SST GRIB file. (This actually contains merged sea surface ! temperature and land surface temperature; we treat as SST for ! simplicity.) From 338295fb3a77316efcc9c6153e42ef0ce790083d Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 18 May 2021 14:08:13 -0400 Subject: [PATCH 63/64] Updated module for Discover. --- lvt/utils/afwa/templates/submit_lvt_discover_24hr_jules.py | 4 ++-- lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_jules.py index fbefc4321..1089658a4 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_jules.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_jules.py @@ -36,7 +36,7 @@ #SBATCH --account s1189 #SBATCH --output %s.24hr.slurm.out #Adjust node, core, and hardware constraints here -#SBATCH --ntasks=1 --constraint=hasw +#SBATCH --ntasks=1 --constraint="sky|hasw" if [ ! -z $SLURM_SUBMIT_DIR ] ; then cd $SLURM_SUBMIT_DIR || exit 1 @@ -44,7 +44,7 @@ module purge module use --append ~/privatemodules -module load lisf_7_intel_19_1_0_166 +module load lisf_7_intel_19_1_3_304 if [ ! -e ./LVT ] ; then echo "ERROR, LVT does not exist!" && exit 1 diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py index 2e290fb00..86564b348 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py @@ -43,7 +43,7 @@ module purge module use --append ~/privatemodules -module load lisf_7_intel_19_1_0_166 +module load lisf_7_intel_19_1_3_304 if [ ! -e ./LVT ] ; then diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py index d46b26fd3..66485dca8 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py @@ -45,7 +45,7 @@ module purge module use --append ~/privatemodules -module load lisf_7_intel_19_1_0_166 +module load lisf_7_intel_19_1_3_304 if [ ! -e ./LVT ] ; then echo "ERROR, LVT does not exist!" && exit 1 diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py index 22b7eee45..327fda4cf 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py @@ -65,7 +65,7 @@ module purge module use --append ~/privatemodules -module load lisf_7_intel_19_1_3_304_traceback-work-around +module load lisf_7_intel_19_1_3_304 if [ ! -e ./LVT ] ; then echo "ERROR, LVT does not exist!" && exit 1 diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py index 0da75c192..14764d7aa 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py @@ -57,7 +57,7 @@ module purge module use --append ~/privatemodules -module load lisf_7_intel_19_1_0_166 +module load lisf_7_intel_19_1_3_304 if [ ! -e ./LVT ] ; then echo "ERROR, LVT does not exist!" && exit 1 diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py index 5935e695e..3f1789e4b 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py @@ -58,7 +58,7 @@ module purge module use --append ~/privatemodules -module load lisf_7_intel_19_1_0_166 +module load lisf_7_intel_19_1_3_304 if [ ! -e ./LVT ] ; then From 016f00e37bd482dfa52291693cdaa91b1a72a45f Mon Sep 17 00:00:00 2001 From: Eric Kemp Date: Tue, 18 May 2021 14:11:26 -0400 Subject: [PATCH 64/64] Added support for Discover Skylake nodes. --- lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py | 2 +- lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py index 86564b348..85395f369 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noah.py @@ -35,7 +35,7 @@ #SBATCH --time=1:00:00 #SBATCH --account s1189 #SBATCH --output %s.24hr.slurm.out -#SBATCH --ntasks=1 --constraint=hasw +#SBATCH --ntasks=1 --constraint="sky|hasw" if [ ! -z $SLURM_SUBMIT_DIR ] ; then cd $SLURM_SUBMIT_DIR || exit 1 diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py index 66485dca8..6302962da 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_24hr_noahmp.py @@ -36,7 +36,7 @@ #SBATCH --account s1189 #SBATCH --output %s.24hr.slurm.out #Adjust node, core, and hardware constraints here -#SBATCH --ntasks=1 --constraint=hasw +#SBATCH --ntasks=1 --constraint="sky|hasw" #Set quality of service, if needed. if [ ! -z $SLURM_SUBMIT_DIR ] ; then diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py index 327fda4cf..5a7c5a430 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_jules.py @@ -57,7 +57,7 @@ #SBATCH --account s1189 #SBATCH --output %s.3hr.slurm.out #Adjust node, core, and hardware constraints here -#SBATCH --ntasks=1 +#SBATCH --ntasks=1 --constraint="sky|hasw" if [ ! -z $SLURM_SUBMIT_DIR ] ; then cd $SLURM_SUBMIT_DIR || exit 1 diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py index 14764d7aa..eaff706a5 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noah.py @@ -49,7 +49,7 @@ #SBATCH --account s1189 #SBATCH --output %s.3hr.slurm.out #Adjust node, core, and hardware constraints here -#SBATCH --ntasks=1 --constraint=hasw +#SBATCH --ntasks=1 --constraint="sky|hasw" if [ ! -z $SLURM_SUBMIT_DIR ] ; then cd $SLURM_SUBMIT_DIR || exit 1 diff --git a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py index 3f1789e4b..7f2043e08 100755 --- a/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py +++ b/lvt/utils/afwa/templates/submit_lvt_discover_3hr_noahmp.py @@ -49,7 +49,7 @@ #SBATCH --account s1189 #SBATCH --output %s.3hr.slurm.out #Adjust node, core, and hardware constraints here -#SBATCH --ntasks=1 --constraint=hasw +#SBATCH --ntasks=1 --constraint="sky|hasw" #Set quality of service, if needed. if [ ! -z $SLURM_SUBMIT_DIR ] ; then