From 6f91aae8ca3eda5822832fe4e4922b5ed94bd352 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 26 Feb 2020 15:43:33 -0500 Subject: [PATCH 01/42] Merging develop into master in preparation for beta release (v17.9.0-beta.2) (#133) --------------- science functionality changes --------------------------- * Added assimilation for cubed-sphere grid. * Added reading forcing from matching cubed-sphere grid when running on cubed-sphere tiles. * Added functionality for output of Catchment prognostics increments via HISTORY. Removed legacy code from LDASsa for output of increments. * Added FP-5.25 transition (30 Jan 2020) to "cross-stream" dates. * Functionality to create regional (non-global) nc4 vegdyn restart file. * Additional functionality for CATCHMENT_OFFLINE to add extra variables into catch restart files (as needed by GCM). * Permitted processing of (assimilation) observations for innovations output *without* perturbations turned on. ------------- infrastructure changes --------------------------------- * Added functionality for SLES 12 support in addition to SLES11 (ESMA_env v2.0.2). * Updated to MAPL v2.0. * Removed dycore and FMS * Conforms to GNU compiler (gcc-9.1). * Initial clean up of GEOSldas_HIST.rc. * Added post-processing to compress (gzip) landpert restart files (except final time). * Added LDAS_app/mk_GEOSldasRestarts.F90. Adapted from GCM GridComp's mk_LDASsaRestarts.F90 in preparation for re-tiling changes. * Fixed output log file name and location. ---------------- bug fixes and other minor changes ------------------------------------- * Bug fix in select-update_type 9 (abs(deltaT)>0.) * Bug fix for local mwRTM and time dimension restart. * Replaced copy ("cp") with link ("ln") for catparam and mwrtm diagnostic output files. --------------------------------------------------------------------------------------------------- --- Externals.cfg | 29 +- config/GMAO_Shared.sparse | 1 - src/Applications/LDAS_App/CMakeLists.txt | 5 +- src/Applications/LDAS_App/GEOSldas_CAP.rc | 2 +- src/Applications/LDAS_App/GEOSldas_HIST.rc | 142 +- src/Applications/LDAS_App/GEOSldas_LDAS.rc | 10 +- .../LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml | 4 +- src/Applications/LDAS_App/ldas_setup | 369 +- src/Applications/LDAS_App/lenkf.j.template | 978 ++-- .../LDAS_App/mk_GEOSldasRestarts.F90 | 4420 +++++++++++++++++ src/Applications/LDAS_App/preprocess_ldas.F90 | 215 +- src/Applications/LDAS_App/process_rst.csh | 30 +- src/Applications/LDAS_App/tile_bin2nc4.F90 | 27 + .../GEOSldas_GridComp/CMakeLists.txt | 4 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 154 +- .../GEOS_LandAssimGridComp.F90 | 619 ++- .../clsm_adapt_routines.F90 | 2 +- .../clsm_bias_routines.F90 | 4 +- .../clsm_ensdrv_out_routines.F90 | 2 +- .../clsm_ensupd_enkf_update.F90 | 185 +- .../clsm_ensupd_read_obs.F90 | 4 +- .../clsm_ensupd_upd_routines.F90 | 16 +- .../GEOSlandassim_GridComp/mwRTM_routines.F90 | 4 +- .../GEOS_LandPertGridComp.F90 | 184 +- .../LDAS_PertRoutines.F90 | 17 +- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 694 +-- .../Shared/LDAS_TileCoordRoutines.F90 | 12 - .../Shared/LDAS_TileCoordType.F90 | 15 +- .../Shared/LDAS_ensdrv_init_routines.F90 | 2 +- .../Shared/LDAS_ensdrv_mpi.F90 | 4 +- src/Shared/CMakeLists.txt | 4 - 31 files changed, 6489 insertions(+), 1669 deletions(-) create mode 100644 src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 diff --git a/Externals.cfg b/Externals.cfg index 9c875855..c645adba 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -2,14 +2,14 @@ required = True repo_url = git@github.com:GEOS-ESM/ESMA_env.git local_path = ./@env -tag = v1.3.2+openmpi +tag = v2.0.2 protocol = git [ESMA_cmake] required = True repo_url = git@github.com:GEOS-ESM/ESMA_cmake.git local_path = ./@cmake -tag = v1.0.11 +tag = v2.1.2 externals = Externals.cfg protocol = git @@ -17,8 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -#branch = master -tag = v1.0.13 +branch = master protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -26,34 +25,16 @@ sparse = ../../../config/GMAO_Shared.sparse required = True repo_url = git@github.com:GEOS-ESM/MAPL.git local_path = ./src/Shared/@MAPL -#branch = master -tag = v1.1.13 -protocol = git - -[FMS] -required = True -repo_url = git@github.com:GEOS-ESM/FMS.git -local_path = ./src/Shared/@FMS -tag = geos/orphan/v1.0.2 +tag = v2.0.0 protocol = git [GEOSgcm_GridComp] required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -#branch = develop -tag = v1.0.4 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse -[FVdycoreCubed_GridComp] -required = True -repo_url = git@github.com:GEOS-ESM/FVdycoreCubed_GridComp.git -local_path = ./src/Components/GEOSldas_GridComp/@FVdycoreCubed_GridComp -#branch = master -tag = v1.0.8 -externals = Externals.cfg -protocol = git - [externals_description] schema_version = 1.0.0 diff --git a/config/GMAO_Shared.sparse b/config/GMAO_Shared.sparse index 436943ff..5f57b71b 100644 --- a/config/GMAO_Shared.sparse +++ b/config/GMAO_Shared.sparse @@ -1,6 +1,5 @@ /* !/GEOS_Pert -!/GMAO_perllib !/GMAO_pilgrim !/GMAO_ncdiag !/GMAO_ods diff --git a/src/Applications/LDAS_App/CMakeLists.txt b/src/Applications/LDAS_App/CMakeLists.txt index f4b5ec21..345e4ced 100644 --- a/src/Applications/LDAS_App/CMakeLists.txt +++ b/src/Applications/LDAS_App/CMakeLists.txt @@ -1,12 +1,13 @@ ecbuild_add_executable ( TARGET GEOSldas.x SOURCES GEOSldas.F90 - LIBS GEOSldas_GridComp MAPL_Base) + LIBS GEOSldas_GridComp MAPL) set(executables preprocess_ldas tile_bin2nc4 - mwrtm_bin2nc4) + mwrtm_bin2nc4 + mk_GEOSldasRestarts) foreach (prog ${executables}) ecbuild_add_executable ( diff --git a/src/Applications/LDAS_App/GEOSldas_CAP.rc b/src/Applications/LDAS_App/GEOSldas_CAP.rc index 96e4d9e2..42650936 100644 --- a/src/Applications/LDAS_App/GEOSldas_CAP.rc +++ b/src/Applications/LDAS_App/GEOSldas_CAP.rc @@ -28,7 +28,7 @@ FCST_SEGMENT: 00000000 #PERPETUAL_MONTH: MM #PERPETUAL_DAY: DD -MAPL_ENABLE_TIMERS: NO +MAPL_ENABLE_TIMERS: YES MAPL_ENABLE_MEMUTILS: NO PRINTSPEC: 0 # (0: OFF, 1: IMPORT & EXPORT, 2: IMPORT, 3: EXPORT) PRINTRC: 1 diff --git a/src/Applications/LDAS_App/GEOSldas_HIST.rc b/src/Applications/LDAS_App/GEOSldas_HIST.rc index 089da919..42c71954 100644 --- a/src/Applications/LDAS_App/GEOSldas_HIST.rc +++ b/src/Applications/LDAS_App/GEOSldas_HIST.rc @@ -1,21 +1,42 @@ +# Sample HISTORY.rc file for GEOSldas +# +# This file is edited by "ldsetup" via "process_hist.csh". The strings '#ASSIM', '#EASE', and '#CUBE' +# are not linked to MAPL HISTORY functionality. For example, the line +# "#CUBE 'tavg24_2d_lnd_Nx'" +# does not mean that the 'lnd' output will be on a cube-sphere grid. + +#CUBE VERSION: 1 EXPID: GEOSldas_expid EXPDSC: GEOSldas_output EXPSRC: GEOSldas COLLECTIONS: +#EASE 'tavg24_1d_lfs_Nt' +#CUBE 'tavg24_2d_lfs_Nx' +#EASE 'tavg24_1d_lnd_Nt' +#CUBE 'tavg24_2d_lnd_Nx' #ASSIM 'SMAP_L4_SM_gph' -#EASE 'tavg1_1D_lnd_Nt' -#CUBE 'tavg1_2D_lnd_Nx' -#EASE 'tavg1_1D_lfs_Nt' -#CUBE 'tavg1_2D_lfs_Nx' +# 'catch_progn_incr' :: - tavg1_1D_lfs_Nt.template: '%y4%m2%d2_%h2%n2z.bin', - tavg1_1D_lfs_Nt.archive: '%c/Y%y4', - tavg1_1D_lfs_Nt.mode: 'time-averaged', - tavg1_1D_lfs_Nt.frequency: 240000, - tavg1_1D_lfs_Nt.ref_time: 000000, - tavg1_1D_lfs_Nt.fields: 'Tair' , 'DATAATM' , +#CUBE GRID_LABELS: PC720x361-DC + +#CUBE :: + +#CUBE PC720x361-DC.GRID_TYPE: LatLon +#CUBE PC720x361-DC.IM_WORLD: 720 +#CUBE PC720x361-DC.JM_WORLD: 361 +#CUBE PC720x361-DC.POLE: PC +#CUBE PC720x361-DC.DATELINE: DC +#CUBE PC720x361-DC.LM: 1 + + tavg24_1d_lfs_Nt.descr: 'Tile-space,Daily,Time-Averaged,Single-Level,Assimilation,Land Surface Forcings and States', + tavg24_1d_lfs_Nt.template: '%y4%m2%d2_%h2%n2z.bin', + tavg24_1d_lfs_Nt.archive: '%c/Y%y4', + tavg24_1d_lfs_Nt.mode: 'time-averaged', + tavg24_1d_lfs_Nt.frequency: 240000, + tavg24_1d_lfs_Nt.ref_time: 000000, + tavg24_1d_lfs_Nt.fields:'Tair' , 'DATAATM' , 'Qair' , 'DATAATM' , 'LWdown' , 'DATAATM' , 'SWdown' , 'DATAATM' , @@ -36,17 +57,18 @@ COLLECTIONS: 'HLWUP' , 'GridComp' , :: - tavg1_2D_lfs_Nx.template: '%y4%m2%d2_%h2%n2z.nc4', - tavg1_2D_lfs_Nx.archive: '%c/Y%y4', - tavg1_2D_lfs_Nx.mode: 'time-averaged', - tavg1_2D_lfs_Nx.frequency: 240000, - tavg1_2D_lfs_Nx.ref_time: 000000, - tavg1_2D_lfs_Nx.format: 'CFIO', - tavg1_2D_lfs_Nx.regrid_exch:'../input/tile.data' - tavg1_2D_lfs_Nx.regrid_name:'GRIDNAME' - tavg1_2D_lfs_Nx.resolution: 720 361, - tavg1_2D_lfs_Nx.deflate: 2, - tavg1_2D_lfs_Nx.fields: 'Tair' , 'DATAATM' , + tavg24_2d_lfs_Nx.descr: '2d,Daily,Time-Averaged,Single-Level,Assimilation,Land Surface Forcings and States', + tavg24_2d_lfs_Nx.template: '%y4%m2%d2_%h2%n2z.nc4', + tavg24_2d_lfs_Nx.archive: '%c/Y%y4', + tavg24_2d_lfs_Nx.mode: 'time-averaged', + tavg24_2d_lfs_Nx.frequency: 240000, + tavg24_2d_lfs_Nx.ref_time: 000000, + tavg24_2d_lfs_Nx.format: 'CFIO', + tavg24_2d_lfs_Nx.regrid_exch: '../input/tile.data', + tavg24_2d_lfs_Nx.regrid_name: 'GRIDNAME', + tavg24_2d_lfs_Nx.grid_label: PC720x361-DC, + tavg24_2d_lfs_Nx.deflate: 2, + tavg24_2d_lfs_Nx.fields:'Tair' , 'DATAATM' , 'Qair' , 'DATAATM' , 'LWdown' , 'DATAATM' , 'SWdown' , 'DATAATM' , @@ -67,12 +89,12 @@ COLLECTIONS: 'HLWUP' , 'GridComp' , :: - tavg1_1D_lnd_Nt.descr: 'tile-space, daily,Time-Averaged,Single-Level,Assimilation,Land Surface Diagnostics' , - tavg1_1D_lnd_Nt.template: '%y4%m2%d2_%h2%n2z.bin' , - tavg1_1D_lnd_Nt.mode: 'time-averaged' , - tavg1_1D_lnd_Nt.frequency: 240000 , - tavg1_1D_lnd_Nt.ref_time: 000000, - tavg1_1D_lnd_Nt.fields: 'WET3' , 'GridComp' , 'GWETPROF' , + tavg24_1d_lnd_Nt.descr: 'Tile-space,Daily,Time-Averaged,Single-Level,Assimilation,Land Surface Diagnostics', + tavg24_1d_lnd_Nt.template: '%y4%m2%d2_%h2%n2z.bin', + tavg24_1d_lnd_Nt.mode: 'time-averaged', + tavg24_1d_lnd_Nt.frequency: 240000, + tavg24_1d_lnd_Nt.ref_time: 000000, + tavg24_1d_lnd_Nt.fields: 'WET3' , 'GridComp' , 'GWETPROF' , 'WET2' , 'GridComp' , 'GWETROOT' , 'WET1' , 'GridComp' , 'GWETTOP' , 'WCPR' , 'GridComp' , 'PRMC' , @@ -122,7 +144,7 @@ COLLECTIONS: 'SPLAND' , 'GridComp' , 'SPWATR' , 'GridComp' , 'SPSNOW' , 'GridComp' , ->>>HIST_AEROSOL<<< 'RMELTDU001' , 'GridComp' , +>>>HIST_AEROSOL<<< 'RMELTDU001' , 'GridComp' , >>>HIST_AEROSOL<<< 'RMELTDU002' , 'GridComp' , >>>HIST_AEROSOL<<< 'RMELTDU003' , 'GridComp' , >>>HIST_AEROSOL<<< 'RMELTDU004' , 'GridComp' , @@ -160,17 +182,17 @@ COLLECTIONS: >>>HIST_IRRIG<<< 'IRRIGRATE' , 'GridComp' , :: - tavg1_2D_lnd_Nx.descr: '2D-space, daily,Time-Averaged,Single-Level,Assimilation,Land Surface Diagnostics' , - tavg1_2D_lnd_Nx.template: '%y4%m2%d2_%h2%n2z.nc4' , - tavg1_2D_lnd_Nx.mode: 'time-averaged' , - tavg1_2D_lnd_Nx.frequency: 240000 , - tavg1_2D_lnd_Nx.ref_time: 000000, - tavg1_2D_lnd_Nx.format: 'CFIO', - tavg1_2D_lnd_Nx.regrid_exch:'../input/tile.data' - tavg1_2D_lnd_Nx.regrid_name: 'GRIDNAME' - tavg1_2D_lnd_Nx.resolution: 720 361, - tavg1_2D_lnd_Nx.deflate: 2, - tavg1_2D_lnd_Nx.fields: 'WET3' , 'GridComp' , 'GWETPROF' , + tavg24_2d_lnd_Nx.descr: '2d,Daily,Time-Averaged,Single-Level,Assimilation,Land Surface Diagnostics', + tavg24_2d_lnd_Nx.template: '%y4%m2%d2_%h2%n2z.nc4', + tavg24_2d_lnd_Nx.mode: 'time-averaged', + tavg24_2d_lnd_Nx.frequency: 240000, + tavg24_2d_lnd_Nx.ref_time: 000000, + tavg24_2d_lnd_Nx.format: 'CFIO', + tavg24_2d_lnd_Nx.regrid_exch: '../input/tile.data' + tavg24_2d_lnd_Nx.regrid_name: 'GRIDNAME' + tavg24_2d_lnd_Nx.grid_label: PC720x361-DC + tavg24_2d_lnd_Nx.deflate: 2, + tavg24_2d_lnd_Nx.fields: 'WET3' , 'GridComp' , 'GWETPROF' , 'WET2' , 'GridComp' , 'GWETROOT' , 'WET1' , 'GridComp' , 'GWETTOP' , 'WCPR' , 'GridComp' , 'PRMC' , @@ -258,11 +280,11 @@ COLLECTIONS: >>>HIST_IRRIG<<< 'IRRIGRATE' , 'GridComp' , :: - SMAP_L4_SM_gph.descr: 'tile-space, 3-hourly,Time-Averaged,Single-Level,Assimilation,Land Surface Diagnostics' , - SMAP_L4_SM_gph.template: '%y4%m2%d2_%h2%n2z.bin' , - SMAP_L4_SM_gph.mode: 'time-averaged' , - SMAP_L4_SM_gph.frequency: 030000, - SMAP_L4_SM_gph.ref_time: 000000, + SMAP_L4_SM_gph.descr: 'Tile-space,3-Hourly,Time-Averaged,Single-Level,Assimilation,SMAP L4_SM Land Geophysical Diagnostics', + SMAP_L4_SM_gph.template: '%y4%m2%d2_%h2%n2z.bin', + SMAP_L4_SM_gph.mode: 'time-averaged', + SMAP_L4_SM_gph.frequency: 030000, + SMAP_L4_SM_gph.ref_time: 000000, SMAP_L4_SM_gph.fields: 'WCSF' , 'ENSAVG' , 'sm_surface' , 'WCRZ' , 'ENSAVG' , 'sm_rootzone' , 'WCPR' , 'ENSAVG' , 'sm_profile' , @@ -305,3 +327,35 @@ COLLECTIONS: 'LAI' , 'VEGDYN' , 'leaf_area_index' , :: + catch_progn_incr.descr: 'Tile-space,3-Hourly,Instantaneous,Single-Level,Assimilation,Ensemble-Average Land Prognostics Increments', + catch_progn_incr.template: '%y4%m2%d2_%h2%n2z.bin', + catch_progn_incr.mode: 'instantaneous', + catch_progn_incr.frequency: 030000, + catch_progn_incr.ref_time: 000000, + catch_progn_incr.fields: 'TCFSAT_INCR' , 'LANDASSIM' , + 'TCFTRN_INCR' , 'LANDASSIM' , + 'TCFWLT_INCR' , 'LANDASSIM' , + 'QCFSAT_INCR' , 'LANDASSIM' , + 'QCFTRN_INCR' , 'LANDASSIM' , + 'QCFWLT_INCR' , 'LANDASSIM' , + 'CAPAC_INCR' , 'LANDASSIM' , + 'CATDEF_INCR' , 'LANDASSIM' , + 'RZEXC_INCR' , 'LANDASSIM' , + 'SRFEXC_INCR' , 'LANDASSIM' , + 'GHTCNT1_INCR' , 'LANDASSIM' , + 'GHTCNT2_INCR' , 'LANDASSIM' , + 'GHTCNT3_INCR' , 'LANDASSIM' , + 'GHTCNT4_INCR' , 'LANDASSIM' , + 'GHTCNT5_INCR' , 'LANDASSIM' , + 'GHTCNT6_INCR' , 'LANDASSIM' , + 'WESNN1_INCR' , 'LANDASSIM' , + 'WESNN2_INCR' , 'LANDASSIM' , + 'WESNN3_INCR' , 'LANDASSIM' , + 'HTSNNN1_INCR' , 'LANDASSIM' , + 'HTSNNN2_INCR' , 'LANDASSIM' , + 'HTSNNN3_INCR' , 'LANDASSIM' , + 'SNDZN1_INCR' , 'LANDASSIM' , + 'SNDZN2_INCR' , 'LANDASSIM' , + 'SNDZN3_INCR' , 'LANDASSIM' , + :: + diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index 61ab3efa..55224f68 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -10,7 +10,10 @@ #--------------------------------------------------------# # ---- Using offline? -# 1 : yes, offline +# +# 0: DEFAULT for GCM. (WW,CH,CM,CQ,FR) are required in catchment restart file +# 1: DEFAULT for GEOSldas (WW,CH,CM,CQ,FR) are optional +# 2: (WW,CH,CM,CQ,FR) are optional for input restart but will be in output restart # CATCHMENT_OFFLINE : 1 @@ -30,11 +33,6 @@ FIRST_ENS_ID : 0 # MAPL_ENABLE_BOOTSTRAP : YES -# ---- Vegedyn and catchment default file types -# -VEGDYN_INTERNAL_RESTART_TYPE : binary -CATCH_INTERNAL_RESTART_TYPE : pnc4 -CATCH_INTERNAL_CHECKPOINT_TYPE : pnc4 # ---- SURFLAY # diff --git a/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml b/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml index 8cb14778..4b08d676 100644 --- a/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml +++ b/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml @@ -42,7 +42,7 @@ centered_update = .false. out_obslog = .true. out_ObsFcstAna = .false. -out_incr = .false. +!out_incr = .false. out_smapL4SMaup = .false. ! select format of increments output @@ -51,7 +51,7 @@ out_smapL4SMaup = .false. ! 1: suitable for land incremental analysis update (LIAU) in GEOS-5 GCM ! (output on global domain in GEOS-5 global tile order) -out_incr_format = 0 +!out_incr_format = 0 ! --------------------------------------------------------------------- ! diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 5ccf979d..063602d9 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -101,7 +101,7 @@ class LDASsetup: self.has_landassim_seed = False self.has_geos_pert = False self.has_ldassa_pert = False - self.nSegments = 0 + self.nSegments = 1 # ------ # Read exe input file which is required to setup the dir # ------ @@ -191,12 +191,15 @@ class LDASsetup: _difftime = int(self.rqdExeInp['NUM_SGMT'])*_difftime print int(self.rqdExeInp['NUM_SGMT']) _d = self.begDates[0] - while _d < self.endDates[0]: + _endDate = self.endDates[0] + _d = _d + _difftime + while _d < _endDate : print _difftime.days - _d = _d+ _difftime self.nSegments +=1 print _d.year, _d.month, _d.day - + self.begDates.append(_d) + self.endDates.insert(-1,_d) + _d = _d+ _difftime # make sure path is path if self.rqdExeInp['BCS_PATH'][-1] != '/': @@ -413,95 +416,95 @@ class LDASsetup: # start/end_times are now lists of len > 1 # ------ # wj notes: disable daysperjob - self.daysperjob = 0 - if self.daysperjob: - # shorthands - _dpj = self.daysperjob - _start = self.begDates[0] - _end = self.endDates[0] - assert _dpj>0, 'daysperjob = %d' % _dpj - # total number of days for the given job - nDays = (_end - _start).days - assert nDays>_dpj, \ - 'Days per job [%d] >= Duration [%d days]' %\ - (_dpj, nDays) - # number of job segments - q = nDays/_dpj - r = nDays%_dpj - if r>0: - nSegments = q+1 - else: - nSegments = q - # lists of start times, end times - _start_list = list() - _end_list = list() - for iseg in xrange(nSegments): - _start_list.append(_start+timedelta(days=iseg*_dpj)) - for iseg in xrange(nSegments-1): - _end_list.append(_start_list[iseg+1]) - _end_list.append(_end) - - #update beg dates and end dates - self.begDates = _start_list - self.endDates = _end_list - self.job_sgmt = list() - for iseg in xrange(nSegments): - self.job_sgmt.append("JOB_SGMT: 000000%02d 000000"%(self.endDates[iseg]-self.begDates[iseg]).days) - - # print, if requested - if self.verbose: - print '\nn start end' - for iseg in xrange(nSegments): - print iseg, ':', _start_list[iseg], '-', _end_list[iseg] - - # wj notes: disable monthsperjob - self.monthsperjob = 0 - if self.monthsperjob: - # shorthands - _mpj = self.monthsperjob - assert _mpj>0, 'monthsperjob = %d' % _mpj - _start = self.begDates[0] - _end = self.endDates[0] - # for this option the start/end dates have to be - # 0z on the first of the month - assert (_start.day==1 and _start.hour==0 and - _start.minute==0 and _start.second==0 - ), 'invalid start_time: %s for --monthsperjob' % \ - _start.strftime('%Y-%m-%d-%H-%M-%S') - assert (_end.day==1 and _end.hour==0 and - _end.minute==0 and _end.second==0 - ), 'invalid end_time: %s for --monthsperjob' % \ - _end.strftime('%Y-%m-%d-%H-%M-%S') - _start_list = list() - _end_list = list() - for dt in rrule.rrule(rrule.MONTHLY, interval=_mpj, dtstart=_start, until=_end): - seg_start = dt - seg_end = dt+relativedelta(months=_mpj) - if seg_end>_end: - seg_end = _end - if(seg_start>=seg_end) : - break - _start_list.append(seg_start) - _end_list.append(seg_end) - - #update beg dates and end dates - - self.begDates = _start_list - self.endDates = _end_list - self.job_sgmt =list() - for iseg in xrange(len(_start_list)): - months = 0 - dt = relativedelta(months=+1) - d = self.begDates[iseg] - while d 0, 'daysperjob = %d' % _dpj +# # total number of days for the given job +# nDays = (_end - _start).days +# assert nDays>_dpj, \ +# 'Days per job [%d] >= Duration [%d days]' %\ +# (_dpj, nDays) +# # number of job segments +# q = nDays/_dpj +# r = nDays%_dpj +# if r>0: +# nSegments = q+1 +# else: +# nSegments = q +# # lists of start times, end times +# _start_list = list() +# _end_list = list() +# for iseg in xrange(nSegments): +# _start_list.append(_start+timedelta(days=iseg*_dpj)) +# for iseg in xrange(nSegments-1): +# _end_list.append(_start_list[iseg+1]) +# _end_list.append(_end) +# +# #update beg dates and end dates +# self.begDates = _start_list +# self.endDates = _end_list +# self.job_sgmt = list() +# for iseg in xrange(nSegments): +# self.job_sgmt.append("JOB_SGMT: 000000%02d 000000"%(self.endDates[iseg]-self.begDates[iseg]).days) +# +# # print, if requested +# if self.verbose: +# print '\nn start end' +# for iseg in xrange(nSegments): +# print iseg, ':', _start_list[iseg], '-', _end_list[iseg] +# +# # wj notes: disable monthsperjob +# self.monthsperjob = 0 +# if self.monthsperjob: +# # shorthands +# _mpj = self.monthsperjob +# assert _mpj>0, 'monthsperjob = %d' % _mpj +# _start = self.begDates[0] +# _end = self.endDates[0] +# # for this option the start/end dates have to be +# # 0z on the first of the month +# assert (_start.day==1 and _start.hour==0 and +# _start.minute==0 and _start.second==0 +# ), 'invalid start_time: %s for --monthsperjob' % \ +# _start.strftime('%Y-%m-%d-%H-%M-%S') +# assert (_end.day==1 and _end.hour==0 and +# _end.minute==0 and _end.second==0 +# ), 'invalid end_time: %s for --monthsperjob' % \ +# _end.strftime('%Y-%m-%d-%H-%M-%S') +# _start_list = list() +# _end_list = list() +# for dt in rrule.rrule(rrule.MONTHLY, interval=_mpj, dtstart=_start, until=_end): +# seg_start = dt +# seg_end = dt+relativedelta(months=_mpj) +# if seg_end>_end: +# seg_end = _end +# if(seg_start>=seg_end) : +# break +# _start_list.append(seg_start) +# _end_list.append(seg_end) +# +# #update beg dates and end dates +# +# self.begDates = _start_list +# self.endDates = _end_list +# self.job_sgmt =list() +# for iseg in xrange(len(_start_list)): +# months = 0 +# dt = relativedelta(months=+1) +# d = self.begDates[iseg] +# while d 1 else 0 if((self.has_ldassa_pert or self.has_geos_pert) and _perturb == 1) : rstkey=[catch_,'VEGDYN','LANDPERT'] rstval=[self.catch,'vegdyn','landpert'] - rsttyp=[catch_type,vegdyn_type,'pnc4'] _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 if self.has_mwrtm and _assim ==1 : keyn='LANDASSIM_INTERNAL_RESTART_FILE' valn='../input/restart/mwrtm_param_rst' ldasrcInp[keyn]= valn - keyn='LANDASSIM_INTERNAL_RESTART_TYPE' - valn='pnc4' - ldasrcInp[keyn]= valn if self.has_landassim_seed and _assim ==1 : keyn='LANDASSIM_OBSPERTRSEED_RESTART_FILE' @@ -1126,7 +1114,7 @@ class LDASsetup: valn='4' ldasrcInp[keyn]= valn - for key,val,typ in zip(rstkey,rstval,rsttyp) : + for key,val in zip(rstkey,rstval) : keyn = key+ '_INTERNAL_RESTART_FILE' valn = '../input/restart/'+val+ensid+'_internal_rst' ldasrcInp[keyn]= valn @@ -1209,116 +1197,6 @@ class LDASsetup: return directives - def _getPostCommand(self, iseg): - """ - """ - _nens= self.nens - ensdirs = self.ensdirs - ensdirs_avg = self.ensdirs_avg - cmd='' - # if failed to finish, return - cmd += "\nif (-e EGRESS.ldas) then\n /bin/rm EGRESS.ldas\nelse\n echo failed \n exit\nendif\n" - # move the history to the output - for dt in rrule.rrule(rrule.MONTHLY, dtstart=self.begDates[iseg],until=self.endDates[iseg]): - # Yyyyy/Mmm between StartDateTime and EndDateTime - y4m2 ='Y%4d/M%02d' % (dt.year, dt.month) - filen='%4d%02d'%(dt.year,dt.month) - for ensid in ensdirs_avg: - mydir= '/'.join([ - self.outdir, - self.rqdExeInp['EXP_DOMAIN'], - 'cat', # ana/cat/rs/rc_out - ensid, - y4m2 - ]) - fn='*'+filen+'*' - if len(ensdirs) ==1 : - ens='' - else : - ens=ensid.split('s')[1] - fn='*'+ens+fn - cmd += '\n/bin/mv '+fn +' ' + mydir - cmd += '\n/bin/cp *.ctl ' + mydir - - - # remove the old restart link and create a new link - enddate=self.endDates[iseg].strftime('%Y%m%d_%H%M') - - #for ensid in ensdirs : - for iens in xrange(self.nens) : - ensdir = self.ensdirs[iens] - ensid = self.ensids[iens] - rsdir = '/'.join([ - self.outdir, - self.rqdExeInp['EXP_DOMAIN'], - 'rs', # ana/cat/rs/rc_out - ensdir, - y4m2 - ]) - # catch interal restart - rstname = self.rqdExeInp['EXP_ID']+'.'+self.catch+'_internal_rst.'+enddate - cmd += '\n/bin/mv '+self.catch + ensid+'_internal_checkpoint '+ rsdir+'/'+rstname - cmd += '\n/bin/rm -f ../input/restart/'+self.catch+ensid+'_internal_rst' - cmd += '\n/bin/ln -s '+ rsdir+'/'+rstname + ' ../input/restart/'+self.catch+ensid+'_internal_rst' - - return cmd - - - def createRunScripts(self): - """ - """ - - status = False - - bindir = self.blddirLn + '/bin' - - ntasks = int(self.rqdRmInp['ntasks']) - cmd = '\nmpiexec_mpt -np %d \\\n %s' % (ntasks, self.exefyl) - nSegments = len(self.begDates) - for iseg in xrange(nSegments): - # start/end times for this segment - _start_seg = self.begDates[iseg] - _end_seg = self.endDates[iseg] - jobname = 'lenkf.%d.j' % iseg - # open - jobfile = self.rundir + '/' + jobname - fout = open(jobfile, 'w') - fout.write('#!/bin/csh -fx\n\n'); - # resource manager directives - directives = self._getRMdirectives(_start_seg)+'\n' - fout.write(directives) - # set environment - fout.write('limit stacksize unlimited\n') - fout.write('source %s/g5_modules\n' % os.path.relpath(bindir,self.rundir)) - fout.write('setenv MKL_CBWR SSE4_2 # ensure zero-diff across archs\n') - fout.write('setenv MV2_ON_DEMAND_THRESHOLD 8192 # MVAPICH2\n') - - - enddate=self.endDates[iseg].strftime('END_DATE: %Y%m%d %H%M%S') - startdate=self.begDates[iseg].strftime('%Y%m%d %H%M%S') - fout.write("\nif !(-e cap_restart) then\n echo " + startdate+ " >cap_restart \nendif\n") - fout.write("\n# replace the end date and job_sgmt\n") - fout.write(r"sed -i '/END_DATE/c" +"\\"+ enddate + r"'"+ ' CAP.rc\n') - fout.write(r"sed -i '/JOB_SGMT/c" +"\\"+ self.job_sgmt[iseg] + r"'"+ ' CAP.rc\n') - - expid="EXPID: "+ self.rqdExeInp['EXP_ID'] - fout.write(r"sed -i '/EXPID/c" +"\\"+ expid + r"'"+ ' HISTORY.rc\n') - # write run command - - fout.write(cmd+'\n') - - # write post proccess for next job - post=self._getPostCommand(iseg) - fout.write(post+'\n') - fout.close() - os.chmod(jobfile, 0755) - - expdir = '/'.join(self.rundir.rstrip('/').split('/')[:-1]) - print '\nExperiment directory: %s' % expdir - - status = True - return status - def createBatchRun(self): """ """ @@ -1326,21 +1204,45 @@ class LDASsetup: status = False rm_name = self.rqdRmInp['rm_name'].lower() - nSegments = self.nSegments os.chdir(self.rundir) fout =open(self.rundir+'/ldas_batchrun.j','w') fout.write("#!/bin/bash -f\n") jobid = None - - fout.write("\nsed -i 's/if($capdate<$enddate) sbatch $HOMDIR\/lenkf.j/#if($capdate<$enddate) sbatch $HOMDIR\/lenkf.j/g' lenkf.j\n\n") + expid = self.rqdExeInp['EXP_ID'] + fout.write("\nsed -i 's/if($capdate<$enddate) sbatch /#if($capdate<$enddate) sbatch /g' lenkf.j\n\n") + nSegments = self.nSegments for iseg in xrange(nSegments): if iseg ==0 : fout.write("jobid%d=$(echo $(sbatch lenkf.j) | cut -d' ' -f 4)\n"%(iseg)) fout.write("echo $jobid%d\n"%iseg ) else : - fout.write("jobid%d=$(echo $(sbatch --dependency=afterany:$jobid%d lenkf.j) | cut -d' ' -f 4)\n"%(iseg,iseg-1)) + _start = self.begDates[iseg] + myDateTime = '%04d%02d%02d_%02d%02dz' % \ + (_start.year, _start.month, _start.day,_start.hour,_start.minute) + _logfile = os.path.relpath( + '/'.join([ + self.outdir, + self.rqdExeInp['EXP_DOMAIN'], + 'rc_out', + 'Y%04d' % _start.year, + 'M%02d' % _start.month, + '.'.join([expid, 'ldas_log', myDateTime, 'txt']), + ]), + self.rundir) + _errfile = os.path.relpath( + '/'.join([ + self.outdir, + self.rqdExeInp['EXP_DOMAIN'], + 'rc_out', + 'Y%04d' % _start.year, + 'M%02d' % _start.month, + '.'.join([expid, 'ldas_err', myDateTime, 'txt']), + ]), + self.rundir) + + fout.write("jobid%d=$(echo $(sbatch --dependency=afterany:$jobid%d --output=%s --error=%s lenkf.j) | cut -d' ' -f 4)\n"%(iseg,iseg-1,_logfile, _errfile)) fout.write("echo $jobid%d\n"%iseg ) - fout.write("\nsed -i 's/#if($capdate<$enddate) sbatch $HOMDIR\/lenkf.j/if($capdate<$enddate) sbatch $HOMDIR\/lenkf.j/g' lenkf.j") + fout.write("\nsed -i 's/#if($capdate<$enddate) sbatch/if($capdate<$enddate) sbatch /g' lenkf.j") fout.close() os.chmod(self.rundir+'/ldas_batchrun.j', 0755) @@ -1348,14 +1250,13 @@ class LDASsetup: return status - def createBatchRun_gcm(self): + def createRunScripts(self): """ """ status = False rm_name = self.rqdRmInp['rm_name'].lower() - nSegments = len(self.begDates) os.chdir(self.rundir) lenkf=self.blddir+'/etc/lenkf.j.template' shutil.copy(lenkf,'lenkf.j') @@ -1665,12 +1566,8 @@ if __name__=='__main__': status =ld.createRCFiles() assert status - #print "creating Run script" - #status = ld.createRunScripts() - #assert(status) - print "creating gcm style batch Run scripts lenkf.j" - status = ld.createBatchRun_gcm() + status = ld.createRunScripts() print "creating batch Run scripts" status = ld.createBatchRun() diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index bf009ade..440c2236 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -4,8 +4,8 @@ # Batch Parameters for Run Job ####################################################################### -#SBATCH --output=../scratch/GEOSldas_log_txt -#SBATCH --error=../scratch/GEOSldas_err_txt +#SBATCH --output=MY_LOGFILE +#SBATCH --error=MY_ERRFILE #SBATCH --account=MY_ACCOUNT #SBATCH --time=MY_WALLTIME #SBATCH --ntasks=MY_NTASKS @@ -16,18 +16,26 @@ ####################################################################### # System Settings and Architecture Specific Environment Variables ####################################################################### - +umask 022 limit stacksize unlimited +setenv ARCH `uname` + setenv EXPID MY_EXPID setenv EXPDOMAIN MY_EXPDOMAIN setenv EXPDIR MY_EXPDIR setenv ESMADIR $EXPDIR/build/ setenv GEOSBIN $ESMADIR/bin/ source $GEOSBIN/g5_modules -setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0 -#setenv MKL_CBWR SSE4_2 # ensure zero-diff across archs -#setenv MV2_ON_DEMAND_THRESHOLD 8192 # MVAPICH2 -setenv PATH $PATH\:/usr/local/other/SLES11.3/nco/4.6.8/gcc-5.3-sp3/bin/ + +setenv I_MPI_DAPL_UD enable + +setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/${ARCH}/lib +if ( -e /etc/os-release ) then + module load nco/4.8.1 +else + module load other/nco-4.6.8-gcc-5.3-sp3 +endif +setenv RUN_CMD "$GEOSBIN/esma_mpirun -np " ####################################################################### # Experiment Specific Environment Variables @@ -71,7 +79,7 @@ set NUM_SGMT = `grep NUM_SGMT: $HOMDIR/CAP.rc | cut -d':' -f2` ####################################################################### cd $SCRDIR -/bin/rm -rf *.* +/bin/rm -rf * /bin/cp $HOMDIR/cap_restart . /bin/cp -f $HOMDIR/*.rc . /bin/cp -f $HOMDIR/*.nml . @@ -138,497 +146,493 @@ chmod +x $FILE @ counter = 1 while ( $counter <= ${NUM_SGMT} ) -/bin/rm -f EGRESS.ldas -/bin/cp -f $HOMDIR/CAP.rc . -./strip CAP.rc - -# Set Time Variables for Current_(c), Ending_(e), and Segment_(s) dates -# --------------------------------------------------------------------- -set nymdc = `cat cap_restart | cut -c1-8` -set nhmsc = `cat cap_restart | cut -c10-15` -set nymde = `cat CAP.rc | grep END_DATE: | cut -d: -f2 | cut -c2-9` -set nhmse = `cat CAP.rc | grep END_DATE: | cut -d: -f2 | cut -c11-16` -set nymds = `cat CAP.rc | grep JOB_SGMT: | cut -d: -f2 | cut -c2-9` -set nhmss = `cat CAP.rc | grep JOB_SGMT: | cut -d: -f2 | cut -c11-16` - -# Compute Time Variables at the Finish_(f) of current segment -# ----------------------------------------------------------- -set nyear = `echo $nymds | cut -c1-4` -set nmonth = `echo $nymds | cut -c5-6` -set nday = `echo $nymds | cut -c7-8` -set nhour = `echo $nhmss | cut -c1-2` -set nminute = `echo $nhmss | cut -c3-4` -set nsec = `echo $nhmss | cut -c5-6` - @ dt = $nsec + 60 * $nminute + 3600 * $nhour + 86400 * $nday - -set nymdf = $nymdc -set nhmsf = $nhmsc -set date = `$GEOSBIN/tick $nymdf $nhmsf $dt` -set nymdf = $date[1] -set nhmsf = $date[2] -set year = `echo $nymdf | cut -c1-4` -set month = `echo $nymdf | cut -c5-6` -set day = `echo $nymdf | cut -c7-8` - - @ month = $month + $nmonth -while( $month > 12 ) - @ month = $month - 12 - @ year = $year + 1 -end - @ year = $year + $nyear - @ nymdf = $year * 10000 + $month * 100 + $day - -if( $nymdf > $nymde ) set nymdf = $nymde -if( $nymdf == $nymde ) then - if( $nhmsf > $nhmse ) set nhmsf = $nhmse -endif - -set yearc = `echo $nymdc | cut -c1-4` -set yearf = `echo $nymdf | cut -c1-4` - -# Prescribed LAI/SAI for CATCHCN -# ------------------------------- - -set PRESCRIBE_DVG = `grep PRESCRIBE_DVG LDAS.rc | cut -d':' -f2` -if( ${PRESCRIBE_DVG} == 3 ) then - set FCSTDATE = `grep FCAST_BEGTIME $HOMDIR/LDAS.rc | cut -d':' -f2` - if( `echo $FCSTDATE | cut -d' ' -f1` == "" ) then - set CAPRES = `cat cap_restart` - set CAPRES1 = `echo $CAPRES | cut -d' ' -f1` - set CAPRES2 = `echo $CAPRES | cut -d' ' -f2` - set CAPRES = 'FCAST_BEGTIME: '`echo $CAPRES1``echo $CAPRES2` - echo $CAPRES >> $HOMDIR/LDAS.rc - /bin/cp -p $HOMDIR/LDAS.rc . - endif -endif - -if( ${PRESCRIBE_DVG} >= 1 ) then - - # Modify local CAP.rc Ending date if Finish time exceeds Current year boundary - # ---------------------------------------------------------------------------- - - if( $yearf > $yearc ) then - @ yearf = $yearc + 1 - @ nymdf = $yearf * 10000 + 0101 - set oldstring = `cat CAP.rc | grep END_DATE:` - set newstring = "END_DATE: $nymdf $nhmsf" - /bin/mv CAP.rc CAP.tmp - cat CAP.tmp | sed -e "s?$oldstring?$newstring?g" > CAP.rc - endif - - # Creaate VEGDATA FIle Links - # -------------------------- - - if( ${PRESCRIBE_DVG} == 1 ) set VEGYR = $yearc - if( ${PRESCRIBE_DVG} >= 2 ) set VEGYR = CLIM - - set FILE = vegfile - set nz = 1 - /bin/rm CNLAI* - /bin/rm CNSAI* - - while ( $nz <= 3 ) - set nv = 1 - while ($nv <= 4 ) - /bin/ln -s ../VEGDATA/CNLAI${nv}${nz}_${VEGYR}.data CNLAI${nv}${nz}.data - /bin/ln -s ../VEGDATA/CNSAI${nv}${nz}_${VEGYR}.data CNSAI${nv}${nz}.data - echo "CNLAI${nv}${nz}_FILE: CNLAI${nv}${nz}.data" >> $FILE - echo "CNSAI${nv}${nz}_FILE: CNSAI${nv}${nz}.data" >> $FILE - @ nv++ - end - @ nz++ - end - /bin/mv LDAS.rc LDAS.rc.tmp - cat LDAS.rc.tmp $FILE >> LDAS.rc - /bin/rm LDAS.rc.tmp $FILE -endif - -# ---------------------------------------------------------------------------- - -set bYEAR = `cat cap_restart | cut -c1-4` -set bMON = `cat cap_restart | cut -c5-6` -set bDAY = `cat cap_restart | cut -c7-8` -set bHour = `cat cap_restart | cut -c10-11` -set bMin = `cat cap_restart | cut -c12-13` - -if($counter == 1) then - set logYEAR = $bYEAR - set logMON = $bMON - set logDAY = $bDAY - set logHour = $bHour - set logMin = $bMin -endif - -set old_mwrtm_file = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_mwRTMparam.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.nc4 -set old_catch_param = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_catparam.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.bin - -/bin/cp LDAS.rc $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_LDAS_rc.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.txt -/bin/cp CAP.rc $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_CAP_rc.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.txt - -# Run GEOSldas.x -# -------------- - -# Debugging -# --------- -if( $DEBUGGER == 1) then - module load tool/tview-2018.0.5 - totalview $GEOSBIN/GEOSldas.x - exit -endif -if( $DEBUGGER == 2) then - module load tool/arm-forge-19.0.3 - ddt $GEOSBIN/GEOSldas.x - exit -endif - -#$GEOSBIN/esma_mpirun -np $numprocs $GEOSBIN/GEOSldas.x -mpirun -map-by core --mca btl ^vader -np $numprocs $GEOSBIN/GEOSldas.x - -if( -e EGRESS.ldas ) then - set rc = 0 -else - set rc = -1 -endif -echo GEOSldas Run Status: $rc - - -####################################################################### -# Move HISTORY Files to cat/ens Directory -####################################################################### - -set outfiles = `ls $EXPID.*[bin,nc4]` -set TILECOORD=`ls ../output/*/rc_out/*ldas_tilecoord.bin` - -# Move current files to /cat/ens -# ------------------------------ - -foreach ofile ( $outfiles ) - set ThisTime = `echo $ofile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - if ($NENS == 1) then - set THISDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens0000/Y${TY}/M${TM}/ - else - set THISDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens_avg/Y${TY}/M${TM}/ - endif - if (! -e $THISDIR ) mkdir -p $THISDIR - - set file_ext = `echo $ofile | rev | cut -d'.' -f1 | rev` - - if($file_ext == nc4) then - /bin/mv $ofile $THISDIR/. - else - set binfile = `echo $ofile | rev | cut -d'.' -f2- | rev` - set decr_file = `echo $ofile | rev | cut -d'.' -f3- | rev`.ctl - $GEOSBIN/tile_bin2nc4.x $binfile $decr_file $TILECOORD - /bin/mv ${binfile}.nc4 $THISDIR/. - /bin/rm ${binfile}.bin + /bin/rm -f EGRESS.ldas + /bin/cp -f $HOMDIR/CAP.rc . + ./strip CAP.rc + + # Set Time Variables for Current_(c), Ending_(e), and Segment_(s) dates + # --------------------------------------------------------------------- + set nymdc = `cat cap_restart | cut -c1-8` + set nhmsc = `cat cap_restart | cut -c10-15` + set nymde = `cat CAP.rc | grep END_DATE: | cut -d: -f2 | cut -c2-9` + set nhmse = `cat CAP.rc | grep END_DATE: | cut -d: -f2 | cut -c11-16` + set nymds = `cat CAP.rc | grep JOB_SGMT: | cut -d: -f2 | cut -c2-9` + set nhmss = `cat CAP.rc | grep JOB_SGMT: | cut -d: -f2 | cut -c11-16` + + # Compute Time Variables at the Finish_(f) of current segment + # ----------------------------------------------------------- + set nyear = `echo $nymds | cut -c1-4` + set nmonth = `echo $nymds | cut -c5-6` + set nday = `echo $nymds | cut -c7-8` + set nhour = `echo $nhmss | cut -c1-2` + set nminute = `echo $nhmss | cut -c3-4` + set nsec = `echo $nhmss | cut -c5-6` + @ dt = $nsec + 60 * $nminute + 3600 * $nhour + 86400 * $nday + + set nymdf = $nymdc + set nhmsf = $nhmsc + set date = `$GEOSBIN/tick $nymdf $nhmsf $dt` + set nymdf = $date[1] + set nhmsf = $date[2] + set year = `echo $nymdf | cut -c1-4` + set month = `echo $nymdf | cut -c5-6` + set day = `echo $nymdf | cut -c7-8` + + @ month = $month + $nmonth + while( $month > 12 ) + @ month = $month - 12 + @ year = $year + 1 + end + @ year = $year + $nyear + @ nymdf = $year * 10000 + $month * 100 + $day + + if( $nymdf > $nymde ) set nymdf = $nymde + if( $nymdf == $nymde ) then + if( $nhmsf > $nhmse ) set nhmsf = $nhmse endif -end - -####################################################################### -# Create HISTORY Collection Directories -####################################################################### - -set collections = '' -foreach line ("`cat HISTORY.rc`") - set firstword = `echo $line | awk '{print $1}'` - set firstchar = `echo $firstword | cut -c1` - set secondword = `echo $line | awk '{print $2}'` - - if ( $firstword == "::" ) goto done - - if ( $firstchar != "#" ) then - set collection = `echo $firstword | sed -e "s/'//g"` - set collections = `echo $collections $collection` - if ( $secondword == :: ) goto done - endif - - if ( $firstword == COLLECTIONS: ) then - set collections = `echo $secondword | sed -e "s/'//g"` + + set yearc = `echo $nymdc | cut -c1-4` + set yearf = `echo $nymdf | cut -c1-4` + + # Prescribed LAI/SAI for CATCHCN + # ------------------------------- + + set PRESCRIBE_DVG = `grep PRESCRIBE_DVG LDAS.rc | cut -d':' -f2` + if( ${PRESCRIBE_DVG} == 3 ) then + set FCSTDATE = `grep FCAST_BEGTIME $HOMDIR/LDAS.rc | cut -d':' -f2` + if( `echo $FCSTDATE | cut -d' ' -f1` == "" ) then + set CAPRES = `cat cap_restart` + set CAPRES1 = `echo $CAPRES | cut -d' ' -f1` + set CAPRES2 = `echo $CAPRES | cut -d' ' -f2` + set CAPRES = 'FCAST_BEGTIME: '`echo $CAPRES1``echo $CAPRES2` + echo $CAPRES >> $HOMDIR/LDAS.rc + /bin/cp -p $HOMDIR/LDAS.rc . + endif endif -end - -done: - -####################################################################### -# (1) Concatenating Sub-daily Files to Daily Files -# (2) Write monthly means -####################################################################### - -if ($NODAILIES > 0) then - - set PWD = `pwd` - - if ($NENS == 1) then - set OUTDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens0000/ - else - set OUTDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens_avg/ - endif - - set MONTHDIRS = `ls -d $OUTDIR/*/*` - - foreach THISMONTH ($MONTHDIRS) - - set MM = `echo $THISMONTH | rev | cut -d'/' -f1 | cut -c1-2 | rev` - set YYYY = `echo $THISMONTH | rev | cut -d'/' -f2 | cut -c1-4 | rev` - set NDAYS = `cal $MM $YYYY | awk 'NF {DAYS = $NF}; END {print DAYS}'` - - cd $THISMONTH + + if( ${PRESCRIBE_DVG} >= 1 ) then + + # Modify local CAP.rc Ending date if Finish time exceeds Current year boundary + # ---------------------------------------------------------------------------- - foreach ThisCol ($collections) - - # if monthly exists, move on to the next collection - if (-f $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4) continue - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` - set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" - set LEN = `echo $#time_steps` - # no file? move on - if ($LEN == 0) continue - - set dayl = `echo $time_steps[$LEN] | cut -c1-8` - set day1 = `echo $time_steps[1] | cut -c1-8` - @ NAVAIL = ($dayl - $day1) + 1 - - # not enough days? move on to the next collection - if($NAVAIL != $NDAYS) continue - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` - set LEN_SUB = `echo $#time_steps` - @ LEN_AVAIL = $LEN_SUB * $NDAYS - - # not enough sub-daylies? move on to the next collection - if ($LEN != $LEN_AVAIL) continue - - # create the monly average - ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 - ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 - /bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 - - # don't want a daily? delete the daily and sub-dailies and continue - # - if($NODAILIES == 2) then - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* - continue + if( $yearf > $yearc ) then + @ yearf = $yearc + 1 + @ nymdf = $yearf * 10000 + 0101 + set oldstring = `cat CAP.rc | grep END_DATE:` + set newstring = "END_DATE: $nymdf $nhmsf" + /bin/mv CAP.rc CAP.tmp + cat CAP.tmp | sed -e "s?$oldstring?$newstring?g" > CAP.rc endif - - # create daily and remove the sub-daily - # ------------------------------------------------------------------ - set day=1 - while ($day <= $NDAYS && $LEN_SUB > 1) - if ( $day < 10 ) set DD=0${day} - if ( $day >= 10 ) set DD=${day} - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` - set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" - -cat << EOF > timestamp.cdl -netcdf timestamp { -dimensions: -time = UNLIMITED ; // (NT currently) -string_length = 14 ; -variables: -char time_stamp (time, string_length) ; - -data: - -time_stamp = -DATAVALUES; -} -EOF - - sed -i -e "s/NT/$LEN_SUB/g" timestamp.cdl - sed -i -e "s/DATAVALUES/$tstep2/g" timestamp.cdl - ncgen -k4 -o timestamp.nc4 timestamp.cdl - ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}${DD}_* ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 - ncks -4 -h -v time_stamp timestamp.nc4 -A ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 - /bin/rm timestamp.cdl - /bin/rm timestamp.nc4 - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 - @ day++ - end # concatenate for each day - end # each collection - end # each month - cd $PWD -endif # dailies > 0 - -####################################################################### -# Rename Final Checkpoints => Restarts for Next Segment and Archive -# Note: cap_restart contains the current NYMD and NHMS -####################################################################### - -set edate = e`cat cap_restart | cut -c1-8`_`cat cap_restart | cut -c10-11`z -set eYEAR = `cat cap_restart | cut -c1-4` -set eMON = `cat cap_restart | cut -c5-6` -set eDAY = `cat cap_restart | cut -c7-8` -set eHour = `cat cap_restart | cut -c10-11` -set eMin = `cat cap_restart | cut -c12-13` - -# Create rc_out/YYYY/MM -# --------------------- - -set THISDIR = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/ -if (! -e $THISDIR ) mkdir -p $THISDIR - -# Move mwrtm and cat_param - -set new_mwrtm_file = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_mwRTMparam.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.nc4 -set new_catch_param = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_catparam.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.bin - -if (-f $old_mwrtm_file) then - /bin/cp $old_mwrtm_file $new_mwrtm_file - /bin/rm ../input/restart/mwrtm_param_rst - /bin/ln -s $new_mwrtm_file ../input/restart/mwrtm_param_rst -endif - -if (-f $old_catch_param) then - /bin/cp $old_catch_param $new_catch_param -endif - -# Move Intermediate Checkpoints to RESTARTS directory -# --------------------------------------------------- - -@ inens = 0 -while ($inens < $NENS) - if ($inens <10) then - set ENSDIR = `echo ens000${inens}` - else if($inens<100) then - set ENSDIR=`echo ens00${inens}` - else if($inens < 1000) then - set ENSDIR =`echo ens0${inens}` - else - set ENSDIR = `echo ens${inens}` - endif - set ENSID = `echo $ENSDIR | cut -c4-7` - if ( $NENS == 1) set ENSID ='' - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/ - if (! -e $THISDIR ) mkdir -p $THISDIR - - set rstf = ${MODEL} - if (-f ${rstf}${ENSID}_internal_checkpoint ) then - /bin/mv ${rstf}${ENSID}_internal_checkpoint $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} - /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst - /bin/ln -s $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst - endif - - set rstf = 'landpert' - if (-f ${rstf}${ENSID}_internal_checkpoint ) then - ncks -4 -O -C -x -v lat,lon -L 2 ${rstf}${ENSID}_internal_checkpoint $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} - /bin/rm -f ${rstf}${ENSID}_internal_checkpoint - /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst - /bin/ln -s $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst - endif - - set rstf = 'landassim_obspertrseed' - if (-f ${rstf}${ENSID}_checkpoint ) then - /bin/mv ${rstf}${ENSID}_checkpoint $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} - /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_rst - /bin/ln -s $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} $EXPDIR/input/restart/${rstf}${ENSID}_rst - endif -# move intermediate check point files to output/$EXPDOMAIN/rs/$ENSDIR/Yyyyy/Mmm/ directories -# ------------------------------------------------------------------------------------------- - - set rstfiles1 = `ls ${MODEL}${ENSID}_internal_checkpoint*` - set rstfiles2 = `ls landpert${ENSID}_internal_checkpoint*` - set rstfiles3 = `ls landassim_obspertrseed${ENSID}_checkpoint*` - - set NFILES = `echo $#rstfiles1` - if($NFILES > 0) then - foreach rfile ( $rstfiles1 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR - /bin/mv $rfile ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 + + # Creaate VEGDATA FIle Links + # -------------------------- + + if( ${PRESCRIBE_DVG} == 1 ) set VEGYR = $yearc + if( ${PRESCRIBE_DVG} >= 2 ) set VEGYR = CLIM + + set FILE = vegfile + set nz = 1 + /bin/rm CNLAI* + /bin/rm CNSAI* + + while ( $nz <= 3 ) + set nv = 1 + while ($nv <= 4 ) + /bin/ln -s ../VEGDATA/CNLAI${nv}${nz}_${VEGYR}.data CNLAI${nv}${nz}.data + /bin/ln -s ../VEGDATA/CNSAI${nv}${nz}_${VEGYR}.data CNSAI${nv}${nz}.data + echo "CNLAI${nv}${nz}_FILE: CNLAI${nv}${nz}.data" >> $FILE + echo "CNSAI${nv}${nz}_FILE: CNSAI${nv}${nz}.data" >> $FILE + @ nv++ + end + @ nz++ end - endif + /bin/mv LDAS.rc LDAS.rc.tmp + cat LDAS.rc.tmp $FILE >> LDAS.rc + /bin/rm LDAS.rc.tmp $FILE + endif + + # ---------------------------------------------------------------------------- + + set bYEAR = `cat cap_restart | cut -c1-4` + set bMON = `cat cap_restart | cut -c5-6` + set bDAY = `cat cap_restart | cut -c7-8` + set bHour = `cat cap_restart | cut -c10-11` + set bMin = `cat cap_restart | cut -c12-13` + + if($counter == 1) then + set logYEAR = $bYEAR + set logMON = $bMON + set logDAY = $bDAY + set logHour = $bHour + set logMin = $bMin + endif + + set old_mwrtm_file = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_mwRTMparam.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.nc4 + set old_catch_param = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_catparam.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.bin + + /bin/cp LDAS.rc $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_LDAS_rc.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.txt + /bin/cp CAP.rc $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_CAP_rc.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.txt + + # Run GEOSldas.x + # -------------- + + # Debugging + # --------- + if( $DEBUGGER == 1) then + module load tool/tview-2018.0.5 + totalview $GEOSBIN/GEOSldas.x + exit + endif + if( $DEBUGGER == 2) then + module load tool/arm-forge-19.0.3 + ddt $GEOSBIN/GEOSldas.x + exit + endif + + $GEOSBIN/RmShmKeys_sshmpi.csh + $RUN_CMD $numprocs $GEOSBIN/GEOSldas.x + + if( -e EGRESS.ldas ) then + set rc = 0 + else + set rc = -1 + endif + echo GEOSldas Run Status: $rc - set NFILES = `echo $#rstfiles2` - if($NFILES > 0) then - foreach rfile ( $rstfiles2 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR - ncks -4 -O -C -x -v lat,lon -L 2 $rfile ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4 - /bin/rm -f $rfile - end - endif - - set NFILES = `echo $#rstfiles3` - if($NFILES > 0) then - foreach rfile ( $rstfiles3 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR - /bin/mv $rfile ${THISDIR}${EXPID}.landassim_obspertrseed_rst.${ThisTime}.nc4 - end - endif - - @ inens ++ -end ## end of while ($inens < $NENS) - -##################### -# update cap_restart -# ################## - -set CO2LINE = `grep -n -m 1 "CO2_YEAR" $HOMDIR/LDAS.rc | cut -d':' -f1` - -if ( $CO2LINE >= 1 ) then - - # Update reference year for Carbon Tracker CO2 - ############################################## + + ####################################################################### + # Move HISTORY Files to cat/ens Directory + ####################################################################### + + set outfiles = `ls $EXPID.*[bin,nc4]` + set TILECOORD=`ls ../output/*/rc_out/*ldas_tilecoord.bin` + + # Move current files to /cat/ens + # ------------------------------ + + foreach ofile ( $outfiles ) + set ThisTime = `echo $ofile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + if ($NENS == 1) then + set THISDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens0000/Y${TY}/M${TM}/ + else + set THISDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens_avg/Y${TY}/M${TM}/ + endif + if (! -e $THISDIR ) mkdir -p $THISDIR + + set file_ext = `echo $ofile | rev | cut -d'.' -f1 | rev` + + if($file_ext == nc4) then + /bin/mv $ofile $THISDIR/. + else + set binfile = `echo $ofile | rev | cut -d'.' -f2- | rev` + set decr_file = `echo $ofile | rev | cut -d'.' -f3- | rev`.ctl + $GEOSBIN/tile_bin2nc4.x $binfile $decr_file $TILECOORD + /bin/mv ${binfile}.nc4 $THISDIR/. + /bin/rm ${binfile}.bin + endif + end + + ####################################################################### + # Create HISTORY Collection Directories + ####################################################################### + + set collections = '' + foreach line ("`cat HISTORY.rc`") + set firstword = `echo $line | awk '{print $1}'` + set firstchar = `echo $firstword | cut -c1` + set secondword = `echo $line | awk '{print $2}'` + + if ( $firstword == "::" ) goto done + + if ( $firstchar != "#" ) then + set collection = `echo $firstword | sed -e "s/'//g"` + set collections = `echo $collections $collection` + if ( $secondword == :: ) goto done + endif + + if ( $firstword == COLLECTIONS: ) then + set collections = `echo $secondword | sed -e "s/'//g"` + endif + end + + done: + + ####################################################################### + # (1) Concatenating Sub-daily Files to Daily Files + # (2) Write monthly means + ####################################################################### + + if ($NODAILIES > 0) then + + set PWD = `pwd` + + if ($NENS == 1) then + set OUTDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens0000/ + else + set OUTDIR = $EXPDIR/output/$EXPDOMAIN/cat/ens_avg/ + endif + + set MONTHDIRS = `ls -d $OUTDIR/*/*` + + foreach THISMONTH ($MONTHDIRS) + + set MM = `echo $THISMONTH | rev | cut -d'/' -f1 | cut -c1-2 | rev` + set YYYY = `echo $THISMONTH | rev | cut -d'/' -f2 | cut -c1-4 | rev` + set NDAYS = `cal $MM $YYYY | awk 'NF {DAYS = $NF}; END {print DAYS}'` + + cd $THISMONTH + + foreach ThisCol ($collections) + + # if monthly exists, move on to the next collection + if (-f $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4) continue + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` + set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" + set LEN = `echo $#time_steps` + # no file? move on + if ($LEN == 0) continue - set CO2_BEFORE = `sed -n "${CO2LINE}p;d" LDAS.rc | cut -d':' -f2` - set CAP_BEFORE = `head -1 $HOMDIR/cap_restart | cut -c1-4` - @ DY = $CAP_BEFORE - $CO2_BEFORE - @ CO2_AFTER = `head -1 cap_restart | cut -c1-4` - $DY - set CO2UPDATE = "CO2_YEAR: $CO2_AFTER" - sed -i "${CO2LINE} s|.*|$CO2UPDATE|" LDAS.rc - /bin/rm -f $HOMDIR//LDAS.rc - /bin/cp -p LDAS.rc $HOMDIR/LDAS.rc -endif - -/bin/rm -f $HOMDIR/cap_restart -/bin/cp cap_restart $HOMDIR/cap_restart - -####################################################################### -# Update Iteration Counter -####################################################################### - -set enddate = `echo $END_DATE | cut -c1-8` -set capdate = `cat cap_restart | cut -c1-8` - -if ( $capdate < $enddate ) then -@ counter = $counter + 1 -else -@ counter = ${NUM_SGMT} + 1 -endif - + set dayl = `echo $time_steps[$LEN] | cut -c1-8` + set day1 = `echo $time_steps[1] | cut -c1-8` + @ NAVAIL = ($dayl - $day1) + 1 + + # not enough days? move on to the next collection + if($NAVAIL != $NDAYS) continue + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` + set LEN_SUB = `echo $#time_steps` + @ LEN_AVAIL = $LEN_SUB * $NDAYS + + # not enough sub-daylies? move on to the next collection + if ($LEN != $LEN_AVAIL) continue + + # create the monly average + ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 + ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 + /bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 + + # don't want a daily? delete the daily and sub-dailies and continue + # + if($NODAILIES == 2) then + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* + continue + endif + + # create daily and remove the sub-daily + # ------------------------------------------------------------------ + set day=1 + while ($day <= $NDAYS && $LEN_SUB > 1) + if ( $day < 10 ) set DD=0${day} + if ( $day >= 10 ) set DD=${day} + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` + set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" + + cat << EOF > timestamp.cdl + netcdf timestamp { + dimensions: + time = UNLIMITED ; // (NT currently) + string_length = 14 ; + variables: + char time_stamp (time, string_length) ; + + data: + + time_stamp = + DATAVALUES; + } + EOF + + sed -i -e "s/NT/$LEN_SUB/g" timestamp.cdl + sed -i -e "s/DATAVALUES/$tstep2/g" timestamp.cdl + ncgen -k4 -o timestamp.nc4 timestamp.cdl + ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}${DD}_* ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 + ncks -4 -h -v time_stamp timestamp.nc4 -A ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 + /bin/rm timestamp.cdl + /bin/rm timestamp.nc4 + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 + @ day++ + end # concatenate for each day + end # each collection + end # each month + cd $PWD + endif # dailies > 0 + + ####################################################################### + # Rename Final Checkpoints => Restarts for Next Segment and Archive + # Note: cap_restart contains the current NYMD and NHMS + ####################################################################### + + set edate = e`cat cap_restart | cut -c1-8`_`cat cap_restart | cut -c10-11`z + set eYEAR = `cat cap_restart | cut -c1-4` + set eMON = `cat cap_restart | cut -c5-6` + set eDAY = `cat cap_restart | cut -c7-8` + set eHour = `cat cap_restart | cut -c10-11` + set eMin = `cat cap_restart | cut -c12-13` + + # Create rc_out/YYYY/MM + # --------------------- + + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + + # Move mwrtm and cat_param + + set new_mwrtm_file = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_mwRTMparam.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.nc4 + set new_catch_param = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_catparam.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.bin + + if (-f $old_mwrtm_file) then + /bin/ln -s $old_mwrtm_file $new_mwrtm_file + /bin/rm ../input/restart/mwrtm_param_rst + /bin/ln -s $new_mwrtm_file ../input/restart/mwrtm_param_rst + endif + + if (-f $old_catch_param) then + /bin/ln -s $old_catch_param $new_catch_param + endif + + # Move Intermediate Checkpoints to RESTARTS directory + # --------------------------------------------------- + + @ inens = 0 + while ($inens < $NENS) + if ($inens <10) then + set ENSDIR = `echo ens000${inens}` + else if($inens<100) then + set ENSDIR=`echo ens00${inens}` + else if($inens < 1000) then + set ENSDIR =`echo ens0${inens}` + else + set ENSDIR = `echo ens${inens}` + endif + set ENSID = `echo $ENSDIR | cut -c4-7` + if ( $NENS == 1) set ENSID ='' + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + + set rstf = ${MODEL} + if (-f ${rstf}${ENSID}_internal_checkpoint ) then + set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} + /bin/mv ${rstf}${ENSID}_internal_checkpoint $tmp_file + /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst + /bin/ln -s $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst + endif + + set rstf = 'landpert' + if (-f ${rstf}${ENSID}_internal_checkpoint ) then + set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} + ncks -4 -O -C -x -v lat,lon ${rstf}${ENSID}_internal_checkpoint $tmp_file + /bin/rm -f ${rstf}${ENSID}_internal_checkpoint + set old_rst = `/usr/bin/readlink $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst` + /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst + /bin/ln -s $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst + /usr/bin/gzip $old_rst + endif + + set rstf = 'landassim_obspertrseed' + if (-f ${rstf}${ENSID}_checkpoint ) then + set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} + /bin/mv ${rstf}${ENSID}_checkpoint $tmp_file + /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_rst + /bin/ln -s $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_rst + endif + # move intermediate check point files to output/$EXPDOMAIN/rs/$ENSDIR/Yyyyy/Mmm/ directories + # ------------------------------------------------------------------------------------------- + + set rstfiles1 = `ls ${MODEL}${ENSID}_internal_checkpoint*` + set rstfiles2 = `ls landpert${ENSID}_internal_checkpoint*` + set rstfiles3 = `ls landassim_obspertrseed${ENSID}_checkpoint*` + + set NFILES = `echo $#rstfiles1` + if($NFILES > 0) then + foreach rfile ( $rstfiles1 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $rfile ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 + end + endif + + set NFILES = `echo $#rstfiles2` + if($NFILES > 0) then + foreach rfile ( $rstfiles2 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + ncks -4 -O -C -x -v lat,lon $rfile ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4 + /usr/bin/gzip ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4 + /bin/rm -f $rfile + end + endif + + set NFILES = `echo $#rstfiles3` + if($NFILES > 0) then + foreach rfile ( $rstfiles3 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $rfile ${THISDIR}${EXPID}.landassim_obspertrseed_rst.${ThisTime}.nc4 + end + endif + + @ inens ++ + end ## end of while ($inens < $NENS) + + ##################### + # update cap_restart + # ################## + + set CO2LINE = `grep -n -m 1 "CO2_YEAR" $HOMDIR/LDAS.rc | cut -d':' -f1` + + if ( $CO2LINE >= 1 ) then + + # Update reference year for Carbon Tracker CO2 + ############################################## + + set CO2_BEFORE = `sed -n "${CO2LINE}p;d" LDAS.rc | cut -d':' -f2` + set CAP_BEFORE = `head -1 $HOMDIR/cap_restart | cut -c1-4` + @ DY = $CAP_BEFORE - $CO2_BEFORE + @ CO2_AFTER = `head -1 cap_restart | cut -c1-4` - $DY + set CO2UPDATE = "CO2_YEAR: $CO2_AFTER" + sed -i "${CO2LINE} s|.*|$CO2UPDATE|" LDAS.rc + /bin/rm -f $HOMDIR//LDAS.rc + /bin/cp -p LDAS.rc $HOMDIR/LDAS.rc + endif + + /bin/rm -f $HOMDIR/cap_restart + /bin/cp cap_restart $HOMDIR/cap_restart + + ####################################################################### + # Update Iteration Counter + ####################################################################### + + set enddate = `echo $END_DATE | cut -c1-8` + set capdate = `cat cap_restart | cut -c1-8` + + if ( $capdate < $enddate ) then + @ counter = $counter + 1 + else + @ counter = ${NUM_SGMT} + 1 + endif + ## End of the while ( $counter <= ${NUM_SGMT} ) loop ## end ####################################################################### -# mv log and error file +# set next log and error file ####################################################################### -set logfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${logYEAR}/M${logMON}/${EXPID}.ldas_log.${logYEAR}${logMON}${logDAY}_${logHour}${logMin}z.txt -set errfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${logYEAR}/M${logMON}/${EXPID}.ldas_err.${logYEAR}${logMON}${logDAY}_${logHour}${logMin}z.txt - -if (-f GEOSldas_log_txt) then - /bin/cp GEOSldas_log_txt $logfile - /bin/rm -f GEOSldas_log_txt -endif - -if(-f GEOSldas_err_txt) then - /bin/cp GEOSldas_err_txt $errfile - /bin/rm -f GEOSldas_err_txt -endif +set logfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_log.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.txt +set errfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_err.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.txt ####################################################################### # Re-Submit Job @@ -637,5 +641,5 @@ endif if ( $rc == 0 ) then cd $HOMDIR #don't change below line(not even extra space) - if($capdate<$enddate) sbatch $HOMDIR/lenkf.j + if($capdate<$enddate) sbatch --output=$logfile --error=$errfile $HOMDIR/lenkf.j endif diff --git a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 new file mode 100644 index 00000000..e573fdd2 --- /dev/null +++ b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 @@ -0,0 +1,4420 @@ +#define VERIFY_(A) if(A /=0)then;print *,'ERROR code',A,'at',__LINE__;call exit(3);endif + +PROGRAM mk_GEOSldasRestarts + +! USAGE/HELP (NOTICE mpirun -np 1) +! mpirun -np 1 bin/mk_GEOSldasRestarts.x -h +! +! (1) to create an initial catch(cn)_internal_rst file ready for an offline experiment : +! -------------------------------------------------------------------------------------- +! (1.1) mpirun -np 1 bin/mk_GEOSldasRestarts.x -a SPONSORCODE -b BCSDIR -m MODEL -s SURFLAY(20/50) -t TILFILE +! where MODEL : catch or catchcn +! (1.2) sbatch mkLDAS.j +! +! (2) to reorder an LDASsa restart file to the order of the BCs for use in an GCM experiment : +! -------------------------------------------------------------------------------------------- +! mpirun -np 1 bin/mk_GEOSldasRestarts.x -b BCSDIR -d YYYYMMDD -e EXPNAME -l EXPDIR -m MODEL -s SURFLAY(20/50) -r Y -t TILFILE -p PARAMFILE + + use MAPL + use gFTL_StringVector + use ieee_arithmetic, only: isnan => ieee_is_nan + USE STIEGLITZSNOW, ONLY : & + StieglitzSnow_calc_tpsnow + implicit none + include 'mpif.h' + INCLUDE 'netcdf.inc' + + ! initialize to non-MPI values + + integer :: myid=0, numprocs=1, mpierr + logical :: master_proc=.true. + + ! Carbon model specifics + ! ---------------------- + + character*256 :: Usage="mk_GEOSldasRestarts.x -a SPONSORCODE -b BCSDIR -d YYYYMMDD -e EXPNAME -j JOBFILE -k ENS -l EXPDIR -m MODEL -r REORDER -s SURFLAY -t TILFILE -p PARAMFILE" + character*256 :: BCSDIR, SPONSORCODE, EXPNAME, EXPDIR, MODEL, TILFILE, YYYYMMDD, SFL, PFILE + character*400 :: CMD + + real, parameter :: ECCENTRICITY = 0.0167 + real, parameter :: PERIHELION = 102.0 + real, parameter :: OBLIQUITY = 23.45 + integer, parameter :: EQUINOX = 80 + + integer, parameter :: nveg = 4 + integer, parameter :: nzone = 3 + integer, parameter :: VAR_COL_CLM40 = 40 ! number of CN column restart variables + integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column + integer, parameter :: npft = 19 + integer, parameter :: npft_clm45 = 19 + integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables + integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column + + real, parameter :: nan = O'17760000000' + real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value + integer, parameter :: OutUnit = 40, InUnit = 50 + character*256 :: arg, tmpstring, ESMADIR + character*1 :: opt, REORDER='N', JOBFILE ='N' + character*4 :: ENS='0000' + integer :: ntiles, rc, nxt + character(len=300) :: OutFileName + integer :: VAR_COL, VAR_PFT + integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) + + ! =============================================================================================== + ! Below hard-wired ldas restart file is from a global offline simulation on the SMAP M09 grid + ! after 1000s of years of simulations + + integer, parameter :: ntiles_cn = 1684725, ntiles_cat = 1653157 + character(len=300), parameter :: & + InCNRestart = '/gpfsm/dnb42/projects/p16/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/M09/20151231/catchcn_internal_rst', & + InCNTilFile = '/discover/nobackup/ltakacs/bcs/Heracles-NL/SMAP_EASEv2_M09/SMAP_EASEv2_M09_3856x1624.til', & + InCatRestart= '/gpfsm/dnb42/projects/p16/ssd/land/l_data/LandRestarts_for_Regridding/Catch/M09/20170101/catch_internal_rst', & + InCatTilFile= '/discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v002/' & + //'SMAP_EASEv2_M09/SMAP_EASEv2_M09_3856x1624.til', & + InCatRest45 = '/gpfsm/dnb42/projects/p16/ssd/land/l_data/LandRestarts_for_Regridding/Catch/M09/20170101/catch_internal_rst', & + InCatTil45 = '/discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v002/' & + //'SMAP_EASEv2_M09/SMAP_EASEv2_M09_3856x1624.til' + REAL :: SURFLAY = 50. + integer :: STATUS + + character(len=256), parameter :: CatNames (57) = & + (/'BF1 ', 'BF2 ', 'BF3 ', 'VGWMAX ', 'CDCR1 ', & + 'CDCR2 ', 'PSIS ', 'BEE ', 'POROS ', 'WPWET ', & + 'COND ', 'GNU ', 'ARS1 ', 'ARS2 ', 'ARS3 ', & + 'ARA1 ', 'ARA2 ', 'ARA3 ', 'ARA4 ', 'ARW1 ', & + 'ARW2 ', 'ARW3 ', 'ARW4 ', 'TSA1 ', 'TSA2 ', & + 'TSB1 ', 'TSB2 ', 'ATAU ', 'BTAU ', 'OLD_ITY', & + 'TC ', 'QC ', 'CAPAC ', 'CATDEF ', 'RZEXC ', & + 'SRFEXC ', 'GHTCNT1', 'GHTCNT2', 'GHTCNT3', 'GHTCNT4', & + 'GHTCNT5', 'GHTCNT6', 'TSURF ', 'WESNN1 ', 'WESNN2 ', & + 'WESNN3 ', 'HTSNNN1', 'HTSNNN2', 'HTSNNN3', 'SNDZN1 ', & + 'SNDZN2 ', 'SNDZN3 ', 'CH ', 'CM ', 'CQ ', & + 'FR ', 'WW '/) + + character(len=256), parameter :: CarbNames (68) = & + (/'BF1 ', 'BF2 ', 'BF3 ', 'VGWMAX ', 'CDCR1 ', & + 'CDCR2 ', 'PSIS ', 'BEE ', 'POROS ', 'WPWET ', & + 'COND ', 'GNU ', 'ARS1 ', 'ARS2 ', 'ARS3 ', & + 'ARA1 ', 'ARA2 ', 'ARA3 ', 'ARA4 ', 'ARW1 ', & + 'ARW2 ', 'ARW3 ', 'ARW4 ', 'TSA1 ', 'TSA2 ', & + 'TSB1 ', 'TSB2 ', 'ATAU ', 'BTAU ', 'ITY ', & + 'FVG ', 'TC ', 'QC ', 'TG ', 'CAPAC ', & + 'CATDEF ', 'RZEXC ', 'SRFEXC ', 'GHTCNT1', 'GHTCNT2', & + 'GHTCNT3', 'GHTCNT4', 'GHTCNT5', 'GHTCNT6', 'TSURF ', & + 'WESNN1 ', 'WESNN2 ', 'WESNN3 ', 'HTSNNN1', 'HTSNNN2', & + 'HTSNNN3', 'SNDZN1 ', 'SNDZN2 ', 'SNDZN3 ', 'CH ', & + 'CM ', 'CQ ', 'FR ', 'WW ', 'TILE_ID', & + 'NDEP ', 'CLI_T2M', 'BGALBVR', 'BGALBVF', 'BGALBNR', & + 'BGALBNF', 'CNCOL ', 'CNPFT ' /) + + CHARACTER( * ), PARAMETER :: LOWER_CASE = 'abcdefghijklmnopqrstuvwxyz' + CHARACTER( * ), PARAMETER :: UPPER_CASE = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + logical, parameter :: clm45 = .false. + logical :: second_visit + integer :: zoom, k, n + character*100 :: InRestart + + interface GetIds + procedure GetIds_fast_1p + procedure GetIds_accurate_mpi + procedure GetIds_carbon + end interface + + VAR_COL = VAR_COL_CLM40 + VAR_PFT = VAR_PFT_CLM40 + + if(clm45) then + VAR_COL = VAR_COL_CLM45 + VAR_PFT = VAR_PFT_CLM45 + endif + + call init_MPI() + + ! process commands + ! ---------------- + + CALL get_command (cmd) + call getenv ("ESMADIR" ,ESMADIR ) + nxt = 1 + + call getarg(nxt,arg) + + do while(arg(1:1)=='-') + + opt=arg(2:2) + if(len(trim(arg))==2) then + nxt = nxt + 1 + call getarg(nxt,arg) + else + arg = arg(3:) + end if + + select case (opt) + case ('a') + SPONSORCODE = trim(arg) + case ('b') + BCSDIR = trim(arg) + case ('d') + YYYYMMDD = trim(arg) + case ('e') + EXPNAME = trim(arg) + case ('h') + print *,' ' + print *,'(1) to create an initial catch(cn)_internal_rst file ready for an offline experiment :' + print *,'--------------------------------------------------------------------------------------' + print *,'(1.1) mpirun -np 1 bin/mk_GEOSldasRestarts.x -a SPONSORCODE -b BCSDIR -m MODEL -s SURFLAY(20/50)' + print *,'where MODEL : catch or catchcn' + print *,'(1.2) sbatch mkLDAS.j' + print *,' ' + print *,'(2) to reorder an LDASsa restart file to the order of the BCs for use in an GCM experiment :' + print *,'--------------------------------------------------------------------------------------------' + print *,'mpirun -np 1 bin/mk_GEOSldasRestarts.x -b BCSDIR -d YYYYMMDD -e EXPNAME -l EXPDIR -m MODEL -s SURFLAY(20/50) -r Y -t TILFILE -p PARAMFILE' + stop + case ('j') + JOBFILE = trim(arg) + case ('k') + ENS = trim(arg) + case ('l') + EXPDIR = trim(arg) + case ('m') + MODEL = StrUpCase(trim(arg)) + case ('r') + REORDER = trim(arg) + case ('s') + SFL = trim(arg) + read(arg,*) SURFLAY + case ('t') + TILFILE = trim(arg) + case ('p') + PFILE = trim(arg) + case default + print *, trim(Usage) + call exit(1) + end select + nxt = nxt + 1 + call getarg(nxt,arg) + end do + + if (trim(model) == 'CATCHCN') then + if((INDEX(BCSDIR, 'Heracles') == 0).AND.(INDEX(BCSDIR, 'Icarus') == 0)) then + print *,'Land BCs in : ',trim(BCSDIR) + print *,'do not support ',trim (model) + stop + endif + endif + + + if(trim(REORDER) == 'Y') then + + ! This call is to reorder a LDASsa restart file (RESTART: 1) + + call reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL, ENS) + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + call MPI_FINALIZE(mpierr) + call exit(0) + + elseif (trim(REORDER) == 'R') then + + ! This call is to regrid LDASsa/GEOSldas restarts from a different grid (RESTART: 2) + + call regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL, PFILE) + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + call MPI_FINALIZE(mpierr) + call exit(0) + +else + + ! The user does now have restarts, thus cold start (RESTART: 0) + + if(JOBFILE == 'N') then + + call system('mkdir -p OutData1/ OutData2/') + tmpstring = 'ln -s '//trim(BCSDIR)//'/'//trim(TILFILE)//' OutData1/OutTileFile' + call system(tmpstring) + tmpstring = 'ln -s '//trim(BCSDIR)//'/'//trim(TILFILE)//' OutData2/OutTileFile' + call system(tmpstring) + tmpstring = 'ln -s '//trim(BCSDIR)//'/clsm OutData2/clsm' + call system(tmpstring) + + open (10, file ='mkLDASsa.j', form = 'formatted', status ='unknown', action = 'write') + write(10,'(a)')'#!/bin/csh -fx' + write(10,'(a)')' ' + write(10,'(a)')'#SBATCH --account='//trim(SPONSORCODE) + write(10,'(a)')'#SBATCH --time=1:00:00' + write(10,'(a)')'#SBATCH --ntasks=56' + write(10,'(a)')'#SBATCH --job-name=mkLDAS' + write(10,'(a)')'#SBATCH --constraint=hasw' + write(10,'(a)')'#SBATCH --output=mkLDAS.o' + write(10,'(a)')'#SBATCH --error=mkLDAS.e' + write(10,'(a)')' ' + write(10,'(a)')'limit stacksize unlimited' + write(10,'(a)')'source bin/g5_modules' + !tmpstring = "set BINDIR=`ls -l bin | cut -d'>' -f2`" + !write(10,'(a)')trim(tmpstring) + !tmpstring = "setenv ESMADIR `echo $BINDIR | sed 's/Linux\/bin//g'`" + write(10,'(a)')'setenv ESMADIR '//trim(ESMADIR) + write(10,'(a)')'setenv MKL_CBWR SSE4_2 # ensure zero-diff across archs' + write(10,'(a)')'setenv MV2_ON_DEMAND_THRESHOLD 8192 # MVAPICH2' + write(10,'(a)')' ' + write(10,'(a)')'mpirun -np 56 '//trim(cmd)//' -j Y' + + if(trim(model) == 'CATCHCN') then + write(10,'(a)')'bin/Scale_CatchCN OutData1/catchcn_internal_rst OutData2/catchcn_internal_rst catchcn_internal_rst '//trim(SFL) + else + write(10,'(a)')'bin/Scale_Catch OutData1/catch_internal_rst OutData2/catch_internal_rst catch_internal_rst '//trim(SFL) + endif + + close (10, status ='keep') + call system('chmod 755 mkLDASsa.j') + stop + endif + endif + + if (master_proc) then + + ! read in ntiles + ! ---------------------------- + + open (10,file = trim(BCSDIR)//'/clsm/catchment.def', form = 'formatted', status ='old', action = 'read') + read (10,*) ntiles + close (10, status ='keep') + + endif + + call MPI_BCAST(NTILES , 1, MPI_INTEGER , 0,MPI_COMM_WORLD,mpierr) + + ! Regridding + if(trim(MODEL) == 'CATCH' )inquire(file='OutData1/catch_internal_rst',exist=second_visit ) + if(trim(MODEL) == 'CATCHCN' )inquire(file='OutData1/catchcn_internal_rst',exist=second_visit ) + if(.not. second_visit) then + call regrid_hyd_vars (NTILES, trim(MODEL)) + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + stop + endif + if (master_proc) then + if(trim(MODEL) == 'CATCH' ) call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catch_internal_rst' ) + if(trim(MODEL) == 'CATCHCN') call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catchcn_internal_rst') + endif + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + + if(trim(MODEL) == 'CATCHCN') then + + call regrid_carbon_vars (NTILES) + + endif + + call MPI_FINALIZE(mpierr) + +contains + + ! ***************************************************************************** + + SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL, PFILE) + + implicit none + + real, intent (in) :: SURFLAY + character(*), intent (in) :: BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL, PFILE + character(256) :: tile_coord, vname + character(300) :: rst_file + integer :: NTILES, nv, iv, i,j,k,n, nx, nz, ndims,dimSizes(3), NTILES_RST,nplus, STATUS,NCFID, req, filetype, OUTID + integer, allocatable :: LDAS2BCS (:), tile_id(:) + real, allocatable :: var1(:), var2(:),wesn1(:), htsn1(:), lon_rst(:), lat_rst(:) + logical :: fexist, bin_out = .false., lendian = .true. + real , allocatable, dimension (:) :: LATT, LONN, DAYX + real , pointer , dimension (:) :: long, latg, lonc, latc + integer, allocatable, dimension (:) :: low_ind, upp_ind, nt_local + integer, allocatable, dimension (:) :: Id_glb, id_loc + integer, allocatable, dimension (:,:) :: Id_glb_cn, id_loc_cn + integer, allocatable, dimension (:) :: ld_reorder, tid_offl + logical, allocatable, dimension (:) :: mask + real, allocatable, dimension (:) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & + CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, var_dum2 + integer :: AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR=0,AGCM_DATE + real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl, fveg_tmp, ityp_tmp + real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:) + + ! read NTILES from output BCs and tile_coord from GEOSldas/LDASsa input restarts + + open (10,file =trim(BCSDIR)//"clsm/catchment.def",status='old',form='formatted') + read (10,*) ntiles + close (10, status = 'keep') + + ! Determine whether LDASsa or GEOSldas + if(trim(MODEL) == 'CATCH') then + rst_file = trim(EXPDIR)//'rs/ens'//ENS//'/Y'//YYYYMMDD(1:4)//'/M'//YYYYMMDD(5:6)//'/'//trim(ExpName)//& + '.catch_internal_rst.'//trim(YYYYMMDD)//'_0000' + inquire(file = trim(rst_file), exist=fexist) + if (.not.fexist) then + rst_file = trim(EXPDIR)//'rs/ens'//ENS//'/Y'//YYYYMMDD(1:4)//'/M'//YYYYMMDD(5:6)//'/' & + //trim(ExpName)//'.ens'//ENS//'.catch_ldas_rst.'// & + YYYYMMDD(1:8)//'_0000z.bin' + lendian = .false. + endif + else + rst_file = trim(EXPDIR)//'rs/ens'//ENS//'/Y'//YYYYMMDD(1:4)//'/M'//YYYYMMDD(5:6)//'/'//trim(ExpName)//& + '.catchcn_internal_rst.'//trim(YYYYMMDD)//'_0000' + inquire(file = trim(rst_file), exist=fexist) + if (.not. fexist) then + rst_file = trim(EXPDIR)//'rs/ens'//ENS//'/Y'//YYYYMMDD(1:4)//'/M'//YYYYMMDD(5:6)//'/'//trim(ExpName)//& + '.ens'//ENS//'.catchcn_ldas_rst.'//trim(YYYYMMDD)//'_0000z' + lendian = .false. + endif + endif + + ! Open input tile_coord + tile_coord = trim(EXPDIR)//'rc_out/'//trim(expname)//'.ldas_tilecoord.bin' + if(lendian) then + open (10,file =trim(tile_coord),status='old',form='unformatted', action = 'read') + else + open (10,file =trim(tile_coord),status='old',form='unformatted', action = 'read', convert ='big_endian') + endif + + read (10) NTILES_RST + + if(master_proc) then + print *,'NTILES in BCs : ',NTILES + print *,'NTILES in restarts : ',NTILES_RST + endif + + ! Domain decomposition + ! -------------------- + + allocate(low_ind ( numprocs)) + allocate(upp_ind ( numprocs)) + allocate(nt_local( numprocs)) + + low_ind (:) = 1 + upp_ind (:) = NTILES + nt_local(:) = NTILES + + if (numprocs > 1) then + do i = 1, numprocs - 1 + upp_ind(i) = low_ind(i) + (ntiles/numprocs) - 1 + low_ind(i+1) = upp_ind(i) + 1 + nt_local(i) = upp_ind(i) - low_ind(i) + 1 + end do + nt_local(numprocs) = upp_ind(numprocs) - low_ind(numprocs) + 1 + endif + + allocate (id_loc (nt_local (myid + 1))) + allocate (lonn (nt_local (myid + 1))) + allocate (latt (nt_local (myid + 1))) + allocate (lonc (1:ntiles_rst)) + allocate (latc (1:ntiles_rst)) + allocate (tid_offl (ntiles_rst)) + + if (master_proc) then + allocate (long (ntiles)) + allocate (latg (ntiles)) + allocate (ld_reorder(ntiles_rst)) + allocate (tile_id (1:ntiles_rst)) + allocate (LDAS2BCS (1:ntiles_rst)) + allocate (lon_rst (1:ntiles_rst)) + allocate (lat_rst (1:ntiles_rst)) + + call ReadCNTilFile ('OutData1/OutTileFile', i, long, latg); VERIFY_(i-ntiles) + + read (10) LDAS2BCS + read (10) tile_id + read (10) tile_id + read (10) lon_rst + read (10) lat_rst + + tile_id = LDAS2BCS + + do n = 1, NTILES_RST + ld_reorder (tile_id(n)) = n + tid_offl(n) = n + end do + do n = 1, NTILES_RST + lonc(n) = lon_rst(ld_reorder(n)) + latc(n) = lat_rst(ld_reorder(n)) + END DO + deallocate (lon_rst, lat_rst) + endif + + close (10, status = 'keep') + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + + do i = 1, numprocs + if((I == 1).and.(myid == 0)) then + lonn(:) = long(low_ind(i) : upp_ind(i)) + latt(:) = latg(low_ind(i) : upp_ind(i)) + else if (I > 1) then + if(I-1 == myid) then + ! receiving from root + call MPI_RECV(lonn,nt_local(i) , MPI_REAL, 0,995,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(latt,nt_local(i) , MPI_REAL, 0,994,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + else if (myid == 0) then + ! root sends + call MPI_ISend(long(low_ind(i) : upp_ind(i)),nt_local(i),MPI_REAL,i-1,995,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + call MPI_ISend(latg(low_ind(i) : upp_ind(i)),nt_local(i),MPI_REAL,i-1,994,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + endif + endif + end do + + if(master_proc) deallocate (long) + + call MPI_BCAST(lonc,ntiles_rst,MPI_REAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(latc,ntiles_rst,MPI_REAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(tid_offl,size(tid_offl ),MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) + + ! -------------------------------------------------------------------------------- + ! Here we create transfer index array to map offline restarts to output tile space + ! -------------------------------------------------------------------------------- + + ! id_glb for hydrologic variable + + call GetIds(lonc,latc,lonn,latt,id_loc, tid_offl) + if(master_proc) allocate (id_glb (ntiles)) + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) +! call MPI_GATHERV( & +! id_loc, nt_local(myid+1) , MPI_real, & +! id_glb, nt_local,low_ind-1, MPI_real, & +! 0, MPI_COMM_WORLD, mpierr ) + do i = 1, numprocs + if((I == 1).and.(myid == 0)) then + id_glb(low_ind(i) : upp_ind(i)) = Id_loc(:) + else if (I > 1) then + if(I-1 == myid) then + ! send to root + call MPI_ISend(id_loc,nt_local(i),MPI_INTEGER,0,993,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + else if (myid == 0) then + ! root receives + call MPI_RECV(id_glb(low_ind(i) : upp_ind(i)),nt_local(i) , MPI_INTEGER, i-1,993,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + endif + endif + end do + + deallocate (id_loc) + + if(master_proc) then + + inquire(file = trim(rst_file), exist=fexist) + if (.not. fexist) then + print*, "WARNING!!" + print*, trim(rst_file) // " does not exist .. !" + stop + endif + + ! =========================================================== + ! Map restart nearest restart to output grid (hydrologic var) + ! =========================================================== + + filetype = 0 + call MAPL_NCIOGetFileType(rst_file, filetype,rc=rc) + if(filetype == 0) then + ! GEOSldas CATCH/CATCHCN or CATCHCN LDASsa + call put_land_vars (NTILES, ntiles_rst, id_glb, ld_reorder, model, rst_file) + else + call read_ldas_restarts (NTILES, ntiles_rst, id_glb, ld_reorder, rst_file, pfile) + endif + + ! ==================== + ! READ AND PUT OUT BCS + ! ==================== + + do i = 1,10000 + ! just delaying few seconds to allow the system to copy the file + end do + + if(trim(MODEL) == 'CATCH' ) call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catch_internal_rst' ) + if(trim(MODEL) == 'CATCHCN') call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catchcn_internal_rst') + + endif + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + + ! ============= + ! REGRID Carbon + ! ============= + + if(trim(MODEL) == 'CATCHCN')then + + allocate (CLMC_pf1(nt_local (myid + 1))) + allocate (CLMC_pf2(nt_local (myid + 1))) + allocate (CLMC_sf1(nt_local (myid + 1))) + allocate (CLMC_sf2(nt_local (myid + 1))) + allocate (CLMC_pt1(nt_local (myid + 1))) + allocate (CLMC_pt2(nt_local (myid + 1))) + allocate (CLMC_st1(nt_local (myid + 1))) + allocate (CLMC_st2(nt_local (myid + 1))) + allocate (ityp_offl (ntiles_rst,nveg)) + allocate (fveg_offl (ntiles_rst,nveg)) + allocate (id_loc_cn (nt_local (myid + 1),nveg)) + + STATUS = NF_OPEN ('OutData2/catchcn_internal_rst',NF_WRITE,OUTID) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),1/), (/nt_local(myid+1),1/),CLMC_pt1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),2/), (/nt_local(myid+1),1/),CLMC_pt2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_st1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_st2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),1/), (/nt_local(myid+1),1/),CLMC_pf1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),2/), (/nt_local(myid+1),1/),CLMC_pf2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_sf1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_sf2) + + if (master_proc) then + + allocate (ityp_tmp (ntiles_rst,nveg)) + allocate (fveg_tmp (ntiles_rst,nveg)) + allocate (DAYX (NTILES)) + + AGCM_DATE = ICHAR(trim(YYYYMMDD)) + AGCM_YY = AGCM_DATE / 10000 + AGCM_MM = (AGCM_DATE - AGCM_YY*10000) / 100 + AGCM_DD = (AGCM_DATE - AGCM_YY*10000 - AGCM_MM*100) + + call compute_dayx ( & + NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & + LATG, DAYX) + + STATUS = NF_OPEN (trim(rst_file),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ITY'), (/1,1/), (/ntiles_rst,4/),ityp_tmp) + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'FVG'), (/1,1/), (/ntiles_rst,4/),fveg_tmp) + + do n = 1, NTILES_RST + ityp_offl (n,:) = ityp_tmp (ld_reorder(n),:) + fveg_offl (n,:) = fveg_tmp (ld_reorder(n),:) + + if((ityp_offl(N,3) == 0).and.(ityp_offl(N,4) == 0)) then + if(ityp_offl(N,1) /= 0) then + ityp_offl(N,3) = ityp_offl(N,1) + else + ityp_offl(N,3) = ityp_offl(N,2) + endif + endif + + if((ityp_offl(N,1) == 0).and.(ityp_offl(N,2) /= 0)) ityp_offl(N,1) = ityp_offl(N,2) + if((ityp_offl(N,2) == 0).and.(ityp_offl(N,1) /= 0)) ityp_offl(N,2) = ityp_offl(N,1) + if((ityp_offl(N,3) == 0).and.(ityp_offl(N,4) /= 0)) ityp_offl(N,3) = ityp_offl(N,4) + if((ityp_offl(N,4) == 0).and.(ityp_offl(N,3) /= 0)) ityp_offl(N,4) = ityp_offl(N,3) + end do + deallocate (ityp_tmp, fveg_tmp) + endif + + call MPI_BCAST(ityp_offl,size(ityp_offl),MPI_REAL ,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(fveg_offl,size(fveg_offl),MPI_REAL ,0,MPI_COMM_WORLD,mpierr) + + call GetIds(lonc,latc,lonn,latt,id_loc_cn, tid_offl, & + CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & + fveg_offl, ityp_offl) + + if(master_proc) allocate (id_glb_cn (ntiles,nveg)) + + allocate (id_loc (ntiles)) + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2) + deallocate (CLMC_pt1, CLMC_pt2, CLMC_st1, CLMC_st2) + + do nv = 1, nveg + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + ! call MPI_GATHERV( & + ! id_loc (:,nv), nt_local(myid+1) , MPI_real, & + ! id_vec, nt_local,low_ind-1, MPI_real, & + ! 0, MPI_COMM_WORLD, mpierr ) + + do i = 1, numprocs + if((I == 1).and.(myid == 0)) then + id_loc(low_ind(i) : upp_ind(i)) = Id_loc_cn(:,nv) + else if (I > 1) then + if(I-1 == myid) then + ! send to root + call MPI_ISend(id_loc_cn(:,nv),nt_local(i),MPI_INTEGER,0,994,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + else if (myid == 0) then + ! root receives + call MPI_RECV(id_loc(low_ind(i) : upp_ind(i)),nt_local(i) , MPI_INTEGER, i-1,994,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + endif + endif + end do + + if(master_proc) id_glb_cn (:,nv) = id_loc + + end do + + if(master_proc) then + + allocate (var_off_col (1: NTILES_RST, 1 : nzone,1 : var_col)) + allocate (var_off_pft (1: NTILES_RST, 1 : nzone,1 : nveg, 1 : var_pft)) + allocate (var_dum2 (1:ntiles_rst)) + + i = 1 + do nv = 1,VAR_COL + do nz = 1,nzone + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CNCOL'), (/1,i/), (/NTILES_RST,1 /),VAR_DUM2) + do k = 1, NTILES_RST + var_off_col(k, nz,nv) = VAR_DUM2(ld_reorder(k)) + end do + i = i + 1 + end do + end do + + i = 1 + do iv = 1,VAR_PFT + do nv = 1,nveg + do nz = 1,nzone + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CNPFT'), (/1,i/), (/NTILES_RST,1 /),VAR_DUM2) + do k = 1, NTILES_RST + var_off_pft(K, nz,nv,iv) = VAR_DUM2(ld_reorder(k)) + end do + i = i + 1 + end do + end do + end do + + where(isnan(var_off_pft)) var_off_pft = 0. + where(var_off_pft /= var_off_pft) var_off_pft = 0. + + call write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb_cn, & + DAYX, var_off_col,var_off_pft, ityp_offl, fveg_offl) + deallocate (var_off_col,var_off_pft) + endif + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + endif + + END SUBROUTINE regrid_from_xgrid + + ! ***************************************************************************** + + SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL, ENS) + + implicit none + + real, intent (in) :: SURFLAY + character(*), intent (in) :: BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL, ENS + character(256) :: tile_coord + character(300) :: rst_file, out_rst_file + type(Netcdf4_FileFormatter) :: InFmt,OutFmt + type(FileMetadata) :: meta_data + integer :: NTILES, i,j,k,n, ndims,dimSizes(3) + integer, allocatable :: LDAS2BCS (:), g2d(:), tile_id(:) + real, allocatable :: var1(:), var2(:),wesn1(:), htsn1(:) + integer :: dim1,dim2 + type(StringVariableMap), pointer :: variables + type(Variable), pointer :: var + type(StringVariableMapIterator) :: var_iter + type(StringVector), pointer :: var_dimensions + character(len=:), pointer :: vname,dname + logical :: fexist, bin_out = .false. + + if(trim(MODEL) == 'CATCH') then + rst_file = trim(EXPDIR)//'rs/ens'//ENS//'/Y'//YYYYMMDD(1:4)//'/M'//YYYYMMDD(5:6)//'/' & + //trim(ExpName)//'.ens'//ENS//'.catch_ldas_rst.'// & + YYYYMMDD(1:8)//'_0000z.bin' + out_rst_file = 'catch'//ENS//'_internal_rst.'//trim(YYYYMMDD) + else + rst_file = trim(EXPDIR)//'rs/ens'//ENS//'/Y'//YYYYMMDD(1:4)//'/M'//YYYYMMDD(5:6)//'/'//trim(ExpName)//& + '.ens'//ENS//'.catchcn_ldas_rst.'//trim(YYYYMMDD)//'_0000z' + out_rst_file = 'catchcn'//ENS//'_internal_rst.'//trim(YYYYMMDD) + endif + + inquire(file = trim(rst_file), exist=fexist) + if (.not. fexist) then + print*, "WARNING!!" + print*, rst_file // "does not exsit" + print*, "MAY USE ENS0000 only!!" + return + endif + + + open (10,file =trim(BCSDIR)//"clsm/catchment.def",status='old',form='formatted') + read (10,*) ntiles + close (10, status = 'keep') + + ! read NTILES from BCs and tile_coord from LDASsa experiment + + tile_coord = trim(EXPDIR)//'rc_out/'//trim(expname)//'.ldas_tilecoord.bin' + open (10,file =trim(tile_coord),status='old',form='unformatted',convert='big_endian') + read (10) i + if (i /= ntiles) then + print *,'NTILES BCs/LDASsa mismatch:', i,ntiles + stop + endif + + if(trim(MODEL) == 'CATCH') then + call InFmt%open('/discover/nobackup/rreichle/l_data/LandRestarts_for_Regridding/Catch/catch_internal_rst' , pFIO_READ,rc=rc) + end if + if(trim(MODEL) == 'CATCHCN') then + call InFmt%open('/discover/nobackup/rreichle/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_dummy' , pFIO_READ, rc=rc) + end if + meta_data = InFmt%read(rc=rc) + call inFmt%close(rc=rc) + + call meta_data%modify_dimension('tile',ntiles,rc=rc) + + call OutFmt%create(trim(out_rst_file),rc=rc) + call OutFmt%write(meta_data, rc=rc) + + + allocate (tile_id (1:ntiles)) + allocate (LDAS2BCS (1:ntiles)) + allocate (g2d (1:ntiles)) + + read (10) LDAS2BCS + close (10, status = 'keep') + + ! ========================== + ! READ/WRITE LDASsa RESTARTS + ! ========================== + + allocate(var1(ntiles)) + allocate(var2(ntiles)) + allocate(wesn1 (ntiles)) + allocate(htsn1 (ntiles)) + ! CH CM CQ FR WW + ! WW + var1 = 0.1 + do j = 1,4 + call MAPL_VarWrite(OutFmt,'WW',var1 ,offset1=j) + end do + ! FR + var1 = 0.25 + do j = 1,4 + call MAPL_VarWrite(OutFmt,'FR',var1 ,offset1=j) + end do + ! CH CM CQ + var1 = 0.001 + do j = 1,4 + call MAPL_VarWrite(OutFmt,'CH',var1 ,offset1=j) + call MAPL_VarWrite(OutFmt,'CM',var1 ,offset1=j) + call MAPL_VarWrite(OutFmt,'CQ',var1 ,offset1=j) + end do + + tile_id = LDAS2BCS + do n = 1, NTILES + G2D(tile_id(n)) = n + end do + + if(trim(MODEL) == 'CATCH') then + + open(10, file=trim(rst_file), form='unformatted', status='old', & + convert='big_endian', action='read') + + var1 = real(tile_id) + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'TILE_ID' ,var2) + + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'TC' ,var2, offset1=1) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'TC' ,var2, offset1=2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'TC' ,var2, offset1=3) + + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'QC' ,var2, offset1=1) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'QC' ,var2, offset1=2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'QC' ,var2, offset1=3) + call MAPL_VarWrite(OutFmt,'QC' ,var2, offset1=4) + + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'CAPAC' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'CATDEF' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'RZEXC' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'SRFEXC' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT1' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT2' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT3' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT4' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT5' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT6' ,var2) + read(10) var1 + var2 = var1 (tile_id) + + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + wesn1 = var2 + call MAPL_VarWrite(OutFmt,'WESNN1' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'WESNN2' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'WESNN3' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + htsn1 = var2 + call MAPL_VarWrite(OutFmt,'HTSNNN1' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN2' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN3' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'SNDZN1' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'SNDZN2' ,var2) + read(10) var1 + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + call MAPL_VarWrite(OutFmt,'SNDZN3' ,var2) + call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSN1(:), WESN1(:), var2, var1) + var2 = var2 + 273.16 + call MAPL_VarWrite(OutFmt,'TC' ,var2, offset1=4) + deallocate (var1, var2) + call OutFmt%close() + close(10) + + else ! CATCHCN + + call InFmt%open(trim(rst_file),pFIO_READ,rc=rc) + meta_data = InFmt%read(rc=rc) + + call MAPL_VarRead ( InFmt,'TILE_ID',var1) + if(sum (nint(var1) - LDAS2BCS) /= 0) then + print *, 'Tile order mismatch ', sum(var1)/ntiles, sum(LDAS2BCS)/ntiles + stop + endif + + variables => meta_data%get_variables() + var_iter = variables%begin() + do while (var_iter /= variables%end()) + + vname => var_iter%key() + var => var_iter%value() + var_dimensions => var%get_dimensions() + + ndims = var_dimensions%size() + + if (ndims == 1) then + call MAPL_VarRead ( InFmt,vname,var1) + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + if(trim(vname) == 'SFMCM' ) var2 = 0. + if(trim(vname) == 'BFLOWM' ) var2 = 0. + if(trim(vname) == 'TOTWATM') var2 = 0. + if(trim(vname) == 'TAIRM' ) var2 = 0. + if(trim(vname) == 'TPM' ) var2 = 0. + if(trim(vname) == 'CNSUM' ) var2 = 0. + if(trim(vname) == 'SNDZM' ) var2 = 0. + if(trim(vname) == 'ASNOWM' ) var2 = 0. + if(trim(vname) == 'TSURF' ) var2 = 0. + + call MAPL_VarWrite(OutFmt,vname,var2) + + else if (ndims == 2) then + + dname => var%get_ith_dimension(2) + dim1=meta_data%get_dimension(dname) + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j) + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + if(trim(vname) == 'TGWM' ) var2 = 0. + if(trim(vname) == 'RZMM' ) var2 = 0. + if(trim(vname) == 'WW' ) var2 = 0.1 + if(trim(vname) == 'FR' ) var2 = 0.25 + if(trim(vname) == 'CQ' ) var2 = 0.001 + if(trim(vname) == 'CN' ) var2 = 0.001 + if(trim(vname) == 'CM' ) var2 = 0.001 + if(trim(vname) == 'CH' ) var2 = 0.001 + call MAPL_VarWrite(OutFmt,vname,var2 ,offset1=j) + enddo + + else if (ndims == 3) then + + dname => var%get_ith_dimension(2) + dim1=meta_data%get_dimension(dname) + dname => var%get_ith_dimension(3) + dim2=meta_data%get_dimension(dname) + do i=1,dim2 + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j,offset2=i) + var2 = var1 (tile_id) + do n = 1, NTILES + var2(n) = var1(g2d(n)) + end do + if(trim(vname) == 'PSNSUNM' ) var2 = 0. + if(trim(vname) == 'PSNSHAM' ) var2 = 0. + call MAPL_VarWrite(OutFmt,vname,var2 ,offset1=j,offset2=i) + enddo + enddo + + end if + call var_iter%next() + enddo + + call InFmt%close() + call OutFmt%close() + deallocate (var1, var2, tile_id) + endif + + call read_bcs_data (ntiles, SURFLAY, trim(MODEL), trim(BCSDIR)//'/clsm/',trim(out_rst_file)) + + if(bin_out) then + call InFmt%open(trim(out_rst_file),pFIO_READ,rc=rc) + open(unit=30, file=trim(out_rst_file)//'.bin', form='unformatted') + call write_bin (30, InFmt, NTILES) + close(30) + call InFmt%close() + endif + + END SUBROUTINE reorder_LDASsa_restarts + + ! ***************************************************************************** + + SUBROUTINE regrid_hyd_vars (NTILES, model) + + implicit none + integer, intent (in) :: NTILES + character(*), intent (in) :: model + + ! =============================================================================================== + + integer, allocatable, dimension(:) :: Id_glb, Id_loc + integer, allocatable, dimension(:) :: ld_reorder, tid_offl + real , allocatable, dimension(:) :: tmp_var + logical, allocatable, dimension(:) :: mask + real :: dw, min_lon, max_lon, min_lat, max_lat + integer :: n,i,nplus, STATUS,NCFID, req + integer :: local_id, ntiles_smap + integer, allocatable, dimension (:) :: sub_tid + real , allocatable, dimension (:) :: sub_lon, sub_lat, rev_dist, LATT, LONN + real , pointer , dimension (:) :: long, latg, lonc, latc + integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) + + logical :: all_found + + if(trim(MODEL) == 'CATCHCN') ntiles_smap = ntiles_cn + if(trim(MODEL) == 'CATCH' ) ntiles_smap = ntiles_cat + + allocate (tid_offl (ntiles_smap)) + allocate (tmp_var (ntiles_smap)) + allocate (mask (ntiles_smap)) + + allocate(low_ind ( numprocs)) + allocate(upp_ind ( numprocs)) + allocate(nt_local( numprocs)) + + low_ind (:) = 1 + upp_ind (:) = NTILES + nt_local(:) = NTILES + + ! Domain decomposition + ! -------------------- + + if (numprocs > 1) then + do i = 1, numprocs - 1 + upp_ind(i) = low_ind(i) + (ntiles/numprocs) - 1 + low_ind(i+1) = upp_ind(i) + 1 + nt_local(i) = upp_ind(i) - low_ind(i) + 1 + end do + nt_local(numprocs) = upp_ind(numprocs) - low_ind(numprocs) + 1 + endif + + allocate (id_loc (nt_local (myid + 1))) + allocate (lonn (nt_local (myid + 1))) + allocate (latt (nt_local (myid + 1))) + allocate (lonc (1:ntiles_smap)) + allocate (latc (1:ntiles_smap)) + + if (master_proc) then + + allocate (long (ntiles)) + allocate (latg (ntiles)) + allocate (ld_reorder(ntiles_smap)) + + call ReadCNTilFile ('OutData1/OutTileFile', i, long, latg); VERIFY_(i-ntiles) + + ! --------------------------------------------- + ! Read exact lonc, latc from offline .til File + ! --------------------------------------------- + + if(trim(MODEL) == 'CATCHCN') then + call ReadCNTilFile(trim(InCNTilFile ),i,lonc,latc) + VERIFY_(i-ntiles_smap) + endif + if(trim(MODEL) == 'CATCH' ) then + call ReadCNTilFile(trim(InCatTilFile),i,lonc,latc) + VERIFY_(i-ntiles_smap) + endif + if(trim(MODEL) == 'CATCHCN') then + STATUS = NF_OPEN (trim(InCNRestart ),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) + endif + if(trim(MODEL) == 'CATCH' ) then + STATUS = NF_OPEN (trim(InCatRestart),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) + endif + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TILE_ID' ), (/1/), (/NTILES_SMAP/),tmp_var) + STATUS = NF_CLOSE (NCFID) + + do n = 1, ntiles_smap + ld_reorder ( NINT(tmp_var(n))) = n + tid_offl(n) = n + end do + + deallocate (tmp_var) + + endif + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + + do i = 1, numprocs + if((I == 1).and.(myid == 0)) then + lonn(:) = long(low_ind(i) : upp_ind(i)) + latt(:) = latg(low_ind(i) : upp_ind(i)) + else if (I > 1) then + if(I-1 == myid) then + ! receiving from root + call MPI_RECV(lonn,nt_local(i) , MPI_REAL, 0,995,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(latt,nt_local(i) , MPI_REAL, 0,994,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + else if (myid == 0) then + ! root sends + call MPI_ISend(long(low_ind(i) : upp_ind(i)),nt_local(i),MPI_REAL,i-1,995,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + call MPI_ISend(latg(low_ind(i) : upp_ind(i)),nt_local(i),MPI_REAL,i-1,994,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + endif + endif + end do + +! call MPI_SCATTERV ( & +! long,nt_local,low_ind-1,MPI_real, & +! lonn,size(lonn),MPI_real , & +! 0,MPI_COMM_WORLD, mpierr ) +! +! call MPI_SCATTERV ( & +! latg,nt_local,low_ind-1,MPI_real, & +! latt,nt_local(myid+1),MPI_real , & +! 0,MPI_COMM_WORLD, mpierr ) + + if(master_proc) deallocate (long, latg) + + call MPI_BCAST(lonc,ntiles_smap,MPI_REAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(latc,ntiles_smap,MPI_REAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(tid_offl,size(tid_offl ),MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) + + ! -------------------------------------------------------------------------------- + ! Here we create transfer index array to map offline restarts to output tile space + ! -------------------------------------------------------------------------------- + + call GetIds(lonc,latc,lonn,latt,id_loc, tid_offl) + + ! Loop through NTILES (# of tiles in output array) find the nearest neighbor from Qing. + + if(master_proc) allocate (id_glb (ntiles)) + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) +! call MPI_GATHERV( & +! id_loc, nt_local(myid+1) , MPI_real, & +! id_glb, nt_local,low_ind-1, MPI_real, & +! 0, MPI_COMM_WORLD, mpierr ) + do i = 1, numprocs + if((I == 1).and.(myid == 0)) then + id_glb(low_ind(i) : upp_ind(i)) = Id_loc(:) + else if (I > 1) then + if(I-1 == myid) then + ! send to root + call MPI_ISend(id_loc,nt_local(i),MPI_INTEGER,0,993,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + else if (myid == 0) then + ! root receives + call MPI_RECV(id_glb(low_ind(i) : upp_ind(i)),nt_local(i) , MPI_INTEGER, i-1,993,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + endif + endif + end do + + if (master_proc) call put_land_vars (NTILES, ntiles_smap, id_glb, ld_reorder, model) + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + + END SUBROUTINE regrid_hyd_vars + + + ! ***************************************************************************** + + SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart) + + ! This subroutine : + ! 1) reads BCs from BCSDIR and hydrological varables from InRestart. + ! InRestart is a catchcn_internal_rst nc4 file. + ! + ! 2) writes out BCs and hydrological variables in catchcn_internal_rst (1:72). + ! output catchcn_internal_rst is nc4. + + implicit none + real, intent (in) :: SURFLAY + integer, intent (in) :: ntiles + character(*), intent (in) :: MODEL, DataDir, InRestart + real, allocatable :: CLMC_pf1(:), CLMC_pf2(:), CLMC_sf1(:), CLMC_sf2(:) + real, allocatable :: CLMC_pt1(:), CLMC_pt2(:), CLMC_st1(:), CLMC_st2(:) + real, allocatable :: CLMC45_pf1(:), CLMC45_pf2(:), CLMC45_sf1(:), CLMC45_sf2(:) + real, allocatable :: CLMC45_pt1(:), CLMC45_pt2(:), CLMC45_st1(:), CLMC45_st2(:) + real, allocatable :: BF1(:), BF2(:), BF3(:), VGWMAX(:) + real, allocatable :: CDCR1(:), CDCR2(:), PSIS(:), BEE(:) + real, allocatable :: POROS(:), WPWET(:), COND(:), GNU(:) + real, allocatable :: ARS1(:), ARS2(:), ARS3(:) + real, allocatable :: ARA1(:), ARA2(:), ARA3(:), ARA4(:) + real, allocatable :: ARW1(:), ARW2(:), ARW3(:), ARW4(:) + real, allocatable :: TSA1(:), TSA2(:), TSB1(:), TSB2(:) + real, allocatable :: ATAU2(:), BTAU2(:), DP2BR(:), CanopH(:) + real, allocatable :: NDEP(:), BVISDR(:), BVISDF(:), BNIRDR(:), BNIRDF(:) + real, allocatable :: T2(:), var1(:), hdm(:), fc(:), gdp(:), peatf(:), RITY(:) + integer, allocatable :: ity(:), abm (:) + integer :: NCFID, STATUS + integer :: idum, i,j,n, ib, nv + real :: rdum, zdep1, zdep2, zdep3, zmet, term1, term2, bare,fvg(4) + logical :: NEWLAND, isCatchCN + logical :: file_exists + type(NetCDF4_Fileformatter) :: CatchFmt,CatchCNFmt + + allocate ( BF1(ntiles), BF2 (ntiles), BF3(ntiles) ) + allocate (VGWMAX(ntiles), CDCR1(ntiles), CDCR2(ntiles) ) + allocate ( PSIS(ntiles), BEE(ntiles), POROS(ntiles) ) + allocate ( WPWET(ntiles), COND(ntiles), GNU(ntiles) ) + allocate ( ARS1(ntiles), ARS2(ntiles), ARS3(ntiles) ) + allocate ( ARA1(ntiles), ARA2(ntiles), ARA3(ntiles) ) + allocate ( ARA4(ntiles), ARW1(ntiles), ARW2(ntiles) ) + allocate ( ARW3(ntiles), ARW4(ntiles), TSA1(ntiles) ) + allocate ( TSA2(ntiles), TSB1(ntiles), TSB2(ntiles) ) + allocate ( ATAU2(ntiles), BTAU2(ntiles), DP2BR(ntiles) ) + allocate (BVISDR(ntiles), BVISDF(ntiles), BNIRDR(ntiles) ) + allocate (BNIRDF(ntiles), T2(ntiles), NDEP(ntiles) ) + allocate ( ity(ntiles), CanopH(ntiles) ) + allocate (CLMC_pf1(ntiles), CLMC_pf2(ntiles), CLMC_sf1(ntiles)) + allocate (CLMC_sf2(ntiles), CLMC_pt1(ntiles), CLMC_pt2(ntiles)) + allocate (CLMC45_pf1(ntiles), CLMC45_pf2(ntiles), CLMC45_sf1(ntiles)) + allocate (CLMC45_sf2(ntiles), CLMC45_pt1(ntiles), CLMC45_pt2(ntiles)) + allocate (CLMC_st1(ntiles), CLMC_st2(ntiles)) + allocate (CLMC45_st1(ntiles), CLMC45_st2(ntiles)) + allocate (hdm(ntiles), fc(ntiles), gdp(ntiles)) + allocate (peatf(ntiles), abm(ntiles), var1(ntiles), RITY(ntiles)) + + inquire(file = trim(DataDir)//'/catchcn_params.nc4', exist=file_exists) + inquire(file = trim(DataDir)//"CLM_veg_typs_fracs" ,exist=NewLand ) + + isCatchCN = (trim(model) == 'CATCHCN') + + if(file_exists) then + + print *,'FILE FORMAT FOR LAND BCS IS NC4' + call CatchFmt%Open(trim(DataDir)//'/catch_params.nc4', pFIO_READ, rc=rc) + call MAPL_VarRead ( CatchFmt ,'OLD_ITY', RITY) + ITY = NINT (RITY) + call MAPL_VarRead ( CatchFmt ,'ARA1', ARA1) + call MAPL_VarRead ( CatchFmt ,'ARA2', ARA2) + call MAPL_VarRead ( CatchFmt ,'ARA3', ARA3) + call MAPL_VarRead ( CatchFmt ,'ARA4', ARA4) + call MAPL_VarRead ( CatchFmt ,'ARS1', ARS1) + call MAPL_VarRead ( CatchFmt ,'ARS2', ARS2) + call MAPL_VarRead ( CatchFmt ,'ARS3', ARS3) + call MAPL_VarRead ( CatchFmt ,'ARW1', ARW1) + call MAPL_VarRead ( CatchFmt ,'ARW2', ARW2) + call MAPL_VarRead ( CatchFmt ,'ARW3', ARW3) + call MAPL_VarRead ( CatchFmt ,'ARW4', ARW4) + + if( SURFLAY.eq.20.0 ) then + call MAPL_VarRead ( CatchFmt ,'ATAU2', ATAU2) + call MAPL_VarRead ( CatchFmt ,'BTAU2', BTAU2) + endif + + if( SURFLAY.eq.50.0 ) then + call MAPL_VarRead ( CatchFmt ,'ATAU5', ATAU2) + call MAPL_VarRead ( CatchFmt ,'BTAU5', BTAU2) + endif + + call MAPL_VarRead ( CatchFmt ,'PSIS', PSIS) + call MAPL_VarRead ( CatchFmt ,'BEE', BEE) + call MAPL_VarRead ( CatchFmt ,'BF1', BF1) + call MAPL_VarRead ( CatchFmt ,'BF2', BF2) + call MAPL_VarRead ( CatchFmt ,'BF3', BF3) + call MAPL_VarRead ( CatchFmt ,'TSA1', TSA1) + call MAPL_VarRead ( CatchFmt ,'TSA2', TSA2) + call MAPL_VarRead ( CatchFmt ,'TSB1', TSB1) + call MAPL_VarRead ( CatchFmt ,'TSB2', TSB2) + call MAPL_VarRead ( CatchFmt ,'COND', COND) + call MAPL_VarRead ( CatchFmt ,'GNU', GNU) + call MAPL_VarRead ( CatchFmt ,'WPWET', WPWET) + call MAPL_VarRead ( CatchFmt ,'DP2BR', DP2BR) + call MAPL_VarRead ( CatchFmt ,'POROS', POROS) + call CatchFmt%close() + if(isCatchCN) then + call CatchCNFmt%Open(trim(DataDir)//'/catchcn_params.nc4', pFIO_READ, rc=rc) + call MAPL_VarRead ( CatchCNFmt ,'BGALBNF', BNIRDF) + call MAPL_VarRead ( CatchCNFmt ,'BGALBNR', BNIRDR) + call MAPL_VarRead ( CatchCNFmt ,'BGALBVF', BVISDF) + call MAPL_VarRead ( CatchCNFmt ,'BGALBVR', BVISDR) + call MAPL_VarRead ( CatchCNFmt ,'NDEP', NDEP) + call MAPL_VarRead ( CatchCNFmt ,'T2_M', T2) + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt1,offset1=1) ! 30 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt2,offset1=2) ! 31 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st1,offset1=3) ! 32 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st2,offset1=4) ! 33 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf1,offset1=1) ! 34 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf2,offset1=2) ! 35 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf1,offset1=3) ! 36 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf2,offset1=4) ! 37 + call CatchCNFmt%close() + endif + + + else + open(unit=21, file=trim(DataDir)//'mosaic_veg_typs_fracs',form='formatted') + open(unit=22, file=trim(DataDir)//'bf.dat' ,form='formatted') + open(unit=23, file=trim(DataDir)//'soil_param.dat' ,form='formatted') + open(unit=24, file=trim(DataDir)//'ar.new' ,form='formatted') + open(unit=25, file=trim(DataDir)//'ts.dat' ,form='formatted') + open(unit=26, file=trim(DataDir)//'tau_param.dat' ,form='formatted') + + if(NewLand .and. isCatchCN) then + open(unit=27, file=trim(DataDir)//'CLM_veg_typs_fracs' ,form='formatted') + open(unit=28, file=trim(DataDir)//'CLM_NDep_SoilAlb_T2m' ,form='formatted') + if(clm45) then + open(unit=29, file=trim(DataDir)//'CLM4.5_veg_typs_fracs',form='formatted') + open(unit=30, file=trim(DataDir)//'CLM4.5_abm_peatf_gdp_hdm_fc' ,form='formatted') + endif + endif + + do n=1,ntiles + var1 (n) = real (n) + ! W.J notes: CanopH is not used. If CLM_veg_typs_fracs exists, the read some dummy ???? Ask Sarith + if (NewLand) then + read(21,*) I, j, ITY(N),idum, rdum, rdum, CanopH(N) + else + read(21,*) I, j, ITY(N),idum, rdum, rdum + endif + + read (22, *) i,j, GNU(n), BF1(n), BF2(n), BF3(n) + + read (23, *) i,j, idum, idum, BEE(n), PSIS(n),& + POROS(n), COND(n), WPWET(n), DP2BR(n) + + read (24, *) i,j, rdum, ARS1(n), ARS2(n), ARS3(n), & + ARA1(n), ARA2(n), ARA3(n), ARA4(n), & + ARW1(n), ARW2(n), ARW3(n), ARW4(n) + + read (25, *) i,j, rdum, TSA1(n), TSA2(n), TSB1(n), TSB2(n) + + if( SURFLAY.eq.20.0 ) read (26, *) i,j, ATAU2(n), BTAU2(n), rdum, rdum ! for old soil params + if( SURFLAY.eq.50.0 ) read (26, *) i,j, rdum , rdum, ATAU2(n), BTAU2(n) ! for new soil params + + if (NewLand .and. isCatchCN) then + read (27, *) i,j, CLMC_pt1(n), CLMC_pt2(n), CLMC_st1(n), CLMC_st2(n), & + CLMC_pf1(n), CLMC_pf2(n), CLMC_sf1(n), CLMC_sf2(n) + + read (28, *) NDEP(n), BVISDR(n), BVISDF(n), BNIRDR(n), BNIRDF(n), T2(n) ! MERRA-2 Annual Mean Temp is default. + if(clm45) then + read (29, *) i,j, CLMC45_pt1(n), CLMC45_pt2(n), CLMC45_st1(n), CLMC45_st2(n), & + CLMC45_pf1(n), CLMC45_pf2(n), CLMC45_sf1(n), CLMC45_sf2(n) + + read (30,'(2I8, i3, f8.4, f8.2, f10.2, f8.4)' ) i, j, abm(n), peatf(n), & + gdp(n), hdm(n), fc(n) + endif + endif + end do + + CLOSE (21, STATUS = 'KEEP') + CLOSE (22, STATUS = 'KEEP') + CLOSE (23, STATUS = 'KEEP') + CLOSE (24, STATUS = 'KEEP') + CLOSE (25, STATUS = 'KEEP') + CLOSE (26, STATUS = 'KEEP') + + if(NewLand .and. isCatchCN) then + CLOSE (27, STATUS = 'KEEP') + CLOSE (28, STATUS = 'KEEP') + if(clm45) then + CLOSE (29, STATUS = 'KEEP') + CLOSE (30, STATUS = 'KEEP') + endif + endif + endif + + + do n=1,ntiles + var1 (n) = real (n) + + zdep2=1000. + zdep3=amax1(1000.,DP2BR(n)) + + if (zdep2 .gt.0.75*zdep3) then + zdep2 = 0.75*zdep3 + end if + + zdep1=20. + zmet=zdep3/1000. + + term1=-1.+((PSIS(n)-zmet)/PSIS(n))**((BEE(n)-1.)/BEE(n)) + term2=PSIS(n)*BEE(n)/(BEE(n)-1) + + VGWMAX(n) = POROS(n)*zdep2 + CDCR1(n) = 1000.*POROS(n)*(zmet-(-term2*term1)) + CDCR2(n) = (1.-WPWET(n))*POROS(n)*zdep3 + + if( isCatchCN) then + + BVISDR(n) = amax1(1.e-6, BVISDR(n)) + BVISDF(n) = amax1(1.e-6, BVISDF(n)) + BNIRDR(n) = amax1(1.e-6, BNIRDR(n)) + BNIRDF(n) = amax1(1.e-6, BNIRDF(n)) + + ! convert % to fractions + + CLMC_pf1(n) = CLMC_pf1(n) / 100. + CLMC_pf2(n) = CLMC_pf2(n) / 100. + CLMC_sf1(n) = CLMC_sf1(n) / 100. + CLMC_sf2(n) = CLMC_sf2(n) / 100. + + fvg(1) = CLMC_pf1(n) + fvg(2) = CLMC_pf2(n) + fvg(3) = CLMC_sf1(n) + fvg(4) = CLMC_sf2(n) + + BARE = 1. + + DO NV = 1, NVEG + BARE = BARE - FVG(NV)! subtract vegetated fractions + END DO + + if (BARE /= 0.) THEN + IB = MAXLOC(FVG(:),1) + FVG (IB) = FVG(IB) + BARE ! This also corrects all cases sum ne 0. + ENDIF + + CLMC_pf1(n) = fvg(1) + CLMC_pf2(n) = fvg(2) + CLMC_sf1(n) = fvg(3) + CLMC_sf2(n) = fvg(4) + + if(CLM45) then + ! CLM 45 + + CLMC45_pf1(n) = CLMC45_pf1(n) / 100. + CLMC45_pf2(n) = CLMC45_pf2(n) / 100. + CLMC45_sf1(n) = CLMC45_sf1(n) / 100. + CLMC45_sf2(n) = CLMC45_sf2(n) / 100. + + fvg(1) = CLMC45_pf1(n) + fvg(2) = CLMC45_pf2(n) + fvg(3) = CLMC45_sf1(n) + fvg(4) = CLMC45_sf2(n) + + BARE = 1. + + DO NV = 1, NVEG + BARE = BARE - FVG(NV)! subtract vegetated fractions + END DO + + if (BARE /= 0.) THEN + IB = MAXLOC(FVG(:),1) + FVG (IB) = FVG(IB) + BARE ! This also corrects all cases sum ne 0. + ENDIF + + CLMC45_pf1(n) = fvg(1) + CLMC45_pf2(n) = fvg(2) + CLMC45_sf1(n) = fvg(3) + CLMC45_sf2(n) = fvg(4) + endif + endif + enddo + + if( isCatchCN) then + + NDEP = NDEP * 1.e-9 + + ! prevent trivial fractions + ! ------------------------- + do n = 1,ntiles + if(CLMC_pf1(n) <= 1.e-4) then + CLMC_pf2(n) = CLMC_pf2(n) + CLMC_pf1(n) + CLMC_pf1(n) = 0. + endif + + if(CLMC_pf2(n) <= 1.e-4) then + CLMC_pf1(n) = CLMC_pf1(n) + CLMC_pf2(n) + CLMC_pf2(n) = 0. + endif + + if(CLMC_sf1(n) <= 1.e-4) then + if(CLMC_sf2(n) > 1.e-4) then + CLMC_sf2(n) = CLMC_sf2(n) + CLMC_sf1(n) + else if(CLMC_pf2(n) > 1.e-4) then + CLMC_pf2(n) = CLMC_pf2(n) + CLMC_sf1(n) + else if(CLMC_pf1(n) > 1.e-4) then + CLMC_pf1(n) = CLMC_pf1(n) + CLMC_sf1(n) + else + stop 'fveg3' + endif + CLMC_sf1(n) = 0. + endif + + if(CLMC_sf2(n) <= 1.e-4) then + if(CLMC_sf1(n) > 1.e-4) then + CLMC_sf1(n) = CLMC_sf1(n) + CLMC_sf2(n) + else if(CLMC_pf2(n) > 1.e-4) then + CLMC_pf2(n) = CLMC_pf2(n) + CLMC_sf2(n) + else if(CLMC_pf1(n) > 1.e-4) then + CLMC_pf1(n) = CLMC_pf1(n) + CLMC_sf2(n) + else + stop 'fveg4' + endif + CLMC_sf2(n) = 0. + endif + + if (clm45) then + ! CLM45 + if(CLMC45_pf1(n) <= 1.e-4) then + CLMC45_pf2(n) = CLMC45_pf2(n) + CLMC45_pf1(n) + CLMC45_pf1(n) = 0. + endif + + if(CLMC45_pf2(n) <= 1.e-4) then + CLMC45_pf1(n) = CLMC45_pf1(n) + CLMC45_pf2(n) + CLMC45_pf2(n) = 0. + endif + + if(CLMC45_sf1(n) <= 1.e-4) then + if(CLMC45_sf2(n) > 1.e-4) then + CLMC45_sf2(n) = CLMC45_sf2(n) + CLMC45_sf1(n) + else if(CLMC45_pf2(n) > 1.e-4) then + CLMC45_pf2(n) = CLMC45_pf2(n) + CLMC45_sf1(n) + else if(CLMC45_pf1(n) > 1.e-4) then + CLMC45_pf1(n) = CLMC45_pf1(n) + CLMC45_sf1(n) + else + stop 'fveg3' + endif + CLMC45_sf1(n) = 0. + endif + + if(CLMC45_sf2(n) <= 1.e-4) then + if(CLMC45_sf1(n) > 1.e-4) then + CLMC45_sf1(n) = CLMC45_sf1(n) + CLMC45_sf2(n) + else if(CLMC45_pf2(n) > 1.e-4) then + CLMC45_pf2(n) = CLMC45_pf2(n) + CLMC45_sf2(n) + else if(CLMC45_pf1(n) > 1.e-4) then + CLMC45_pf1(n) = CLMC45_pf1(n) + CLMC45_sf2(n) + else + stop 'fveg4' + endif + CLMC45_sf2(n) = 0. + endif + endif + end do + endif + + + ! Vegdyn Boundary Condition + ! ------------------------- + + ! open(20,file=trim("vegdyn_internal_rst"), & + ! status="unknown", & + ! form="unformatted",convert="little_endian") + ! write(20) real(ity) + ! if(NewLand) write(20) CanopH + ! close(20) + ! print *, "Wrote vegdyn_internal_restart" + + ! Now writing BCs (from BCSDIR) and regridded hydrological variables 1-72 + ! ----------------------------------------------------------------------- + + STATUS = NF_OPEN (trim(InRestart),NF_WRITE,NCFID) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BF1'), (/1/), (/NTILES/),BF1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BF2'), (/1/), (/NTILES/),BF2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BF3'), (/1/), (/NTILES/),BF3) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'VGWMAX'), (/1/), (/NTILES/),VGWMAX) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'CDCR1'), (/1/), (/NTILES/),CDCR1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'CDCR2'), (/1/), (/NTILES/),CDCR2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'PSIS'), (/1/), (/NTILES/),PSIS) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BEE'), (/1/), (/NTILES/),BEE) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'POROS'), (/1/), (/NTILES/),POROS) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'WPWET'), (/1/), (/NTILES/),WPWET) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'COND'), (/1/), (/NTILES/),COND) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'GNU'), (/1/), (/NTILES/),GNU) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARS1'), (/1/), (/NTILES/),ARS1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARS2'), (/1/), (/NTILES/),ARS2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARS3'), (/1/), (/NTILES/),ARS3) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARA1'), (/1/), (/NTILES/),ARA1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARA2'), (/1/), (/NTILES/),ARA2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARA3'), (/1/), (/NTILES/),ARA3) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARA4'), (/1/), (/NTILES/),ARA4) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARW1'), (/1/), (/NTILES/),ARW1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARW2'), (/1/), (/NTILES/),ARW2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARW3'), (/1/), (/NTILES/),ARW3) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ARW4'), (/1/), (/NTILES/),ARW4) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'TSA1'), (/1/), (/NTILES/),TSA1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'TSA2'), (/1/), (/NTILES/),TSA2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'TSB1'), (/1/), (/NTILES/),TSB1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'TSB2'), (/1/), (/NTILES/),TSB2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ATAU'), (/1/), (/NTILES/),ATAU2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BTAU'), (/1/), (/NTILES/),BTAU2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'TILE_ID'), (/1/), (/NTILES/),VAR1) + + if( isCatchCN ) then + + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ITY'), (/1,1/), (/NTILES,1/),CLMC_pt1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ITY'), (/1,2/), (/NTILES,1/),CLMC_pt2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ITY'), (/1,3/), (/NTILES,1/),CLMC_st1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ITY'), (/1,4/), (/NTILES,1/),CLMC_st2) + + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'FVG'), (/1,1/), (/NTILES,1/),CLMC_pf1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'FVG'), (/1,2/), (/NTILES,1/),CLMC_pf2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'FVG'), (/1,3/), (/NTILES,1/),CLMC_sf1) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'FVG'), (/1,4/), (/NTILES,1/),CLMC_sf2) + + + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'NDEP' ), (/1/), (/NTILES/),NDEP) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'CLI_T2M'), (/1/), (/NTILES/),T2) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BGALBVR'), (/1/), (/NTILES/),BVISDR) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BGALBVF'), (/1/), (/NTILES/),BVISDF) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BGALBNR'), (/1/), (/NTILES/),BNIRDR) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BGALBNF'), (/1/), (/NTILES/),BNIRDF) + + if(CLM45) then + + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ABM' ), (/1/), (/NTILES/),real(ABM)) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'FIELDCAP'), (/1/), (/NTILES/),FC) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'HDM' ), (/1/), (/NTILES/),HDM) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'GDP' ), (/1/), (/NTILES/),GDP) + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'PEATF' ), (/1/), (/NTILES/),PEATF) + endif + + else + STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'OLD_ITY'), (/1/), (/NTILES/),real(ITY)) + endif + + STATUS = NF_CLOSE ( NCFID) + + deallocate ( BF1, BF2, BF3 ) + deallocate (VGWMAX, CDCR1, CDCR2 ) + deallocate ( PSIS, BEE, POROS ) + deallocate ( WPWET, COND, GNU ) + deallocate ( ARS1, ARS2, ARS3 ) + deallocate ( ARA1, ARA2, ARA3 ) + deallocate ( ARA4, ARW1, ARW2 ) + deallocate ( ARW3, ARW4, TSA1 ) + deallocate ( TSA2, TSB1, TSB2 ) + deallocate ( ATAU2, BTAU2, DP2BR ) + deallocate (BVISDR, BVISDF, BNIRDR ) + deallocate (BNIRDF, T2, NDEP ) + deallocate ( ity, CanopH) + deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1) + deallocate (CLMC_sf2, CLMC_pt1, CLMC_pt2) + deallocate (CLMC_st1,CLMC_st2) + + END SUBROUTINE read_bcs_data + + ! ***************************************************************************** + + SUBROUTINE regrid_carbon_vars (NTILES) + + implicit none + + integer, intent (in) :: NTILES + character*300 :: OutTileFile = 'OutData1/OutTileFile', OutFileName='OutData2/catchcn_internal_rst' + integer :: AGCM_YY=2015,AGCM_MM=1,AGCM_DD=1,AGCM_HR=0 + real, allocatable, dimension (:) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & + CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2 + + ! =============================================================================================== + + integer, allocatable, dimension(:,:) :: Id_glb, Id_loc + integer, allocatable, dimension(:) :: tid_offl, id_vec + logical, allocatable, dimension(:) :: mask + real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl + integer :: n,i,j, k, nplus, nv, nx, nz, iv, offl_cell, STATUS,NCFID, req + integer :: outid, local_id + real , allocatable, dimension (:) :: LATT, LONN, DAYX, TILE_ID, var_dum2 + real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:) + integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) + real , pointer , dimension (:) :: long, latg, lonc, latc + + logical :: all_found + + allocate (tid_offl (ntiles_cn)) + allocate (mask (ntiles_cn)) + allocate (ityp_offl (ntiles_cn,nveg)) + allocate (fveg_offl (ntiles_cn,nveg)) + + allocate(low_ind ( numprocs)) + allocate(upp_ind ( numprocs)) + allocate(nt_local( numprocs)) + + low_ind (:) = 1 + upp_ind (:) = NTILES + nt_local(:) = NTILES + + ! Domain decomposition + ! -------------------- + + if (numprocs > 1) then + do i = 1, numprocs - 1 + upp_ind(i) = low_ind(i) + (ntiles/numprocs) - 1 + low_ind(i+1) = upp_ind(i) + 1 + nt_local(i) = upp_ind(i) - low_ind(i) + 1 + end do + nt_local(numprocs) = upp_ind(numprocs) - low_ind(numprocs) + 1 + endif + + allocate (id_loc (nt_local (myid + 1),4)) + allocate (lonn (nt_local (myid + 1))) + allocate (latt (nt_local (myid + 1))) + allocate (CLMC_pf1(nt_local (myid + 1))) + allocate (CLMC_pf2(nt_local (myid + 1))) + allocate (CLMC_sf1(nt_local (myid + 1))) + allocate (CLMC_sf2(nt_local (myid + 1))) + allocate (CLMC_pt1(nt_local (myid + 1))) + allocate (CLMC_pt2(nt_local (myid + 1))) + allocate (CLMC_st1(nt_local (myid + 1))) + allocate (CLMC_st2(nt_local (myid + 1))) + allocate (lonc (1:ntiles_cn)) + allocate (latc (1:ntiles_cn)) + + if (master_proc) then + + ! -------------------------------------------- + ! Read exact lonn, latt from output .til file + ! -------------------------------------------- + + allocate (long (ntiles)) + allocate (latg (ntiles)) + allocate (DAYX (NTILES)) + + call ReadCNTilFile (OutTileFile, i, long, latg); VERIFY_(i-ntiles) + + ! Compute DAYX + ! ------------ + + call compute_dayx ( & + NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & + LATG, DAYX) + + ! --------------------------------------------- + ! Read exact lonc, latc from offline .til File + ! --------------------------------------------- + + call ReadCNTilFile(trim(InCNTilFile),i,lonc,latc); VERIFY_(i-ntiles_cn) + + endif + +! call MPI_SCATTERV ( & +! long,nt_local,low_ind-1,MPI_real, & +! lonn,size(lonn),MPI_real , & +! 0,MPI_COMM_WORLD, mpierr ) + +! call MPI_SCATTERV ( & +! latg,nt_local,low_ind-1,MPI_real, & +! latt,nt_local(myid+1),MPI_real , & +! 0,MPI_COMM_WORLD, mpierr ) + + do i = 1, numprocs + if((I == 1).and.(myid == 0)) then + lonn(:) = long(low_ind(i) : upp_ind(i)) + latt(:) = latg(low_ind(i) : upp_ind(i)) + else if (I > 1) then + if(I-1 == myid) then + ! receiving from root + call MPI_RECV(lonn,nt_local(i) , MPI_REAL, 0,995,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(latt,nt_local(i) , MPI_REAL, 0,994,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + else if (myid == 0) then + ! root sends + call MPI_ISend(long(low_ind(i) : upp_ind(i)),nt_local(i),MPI_REAL,i-1,995,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + call MPI_ISend(latg(low_ind(i) : upp_ind(i)),nt_local(i),MPI_REAL,i-1,994,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + endif + endif + end do + + + if(master_proc) deallocate (long, latg) + + call MPI_BCAST(lonc,ntiles_cn,MPI_REAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(latc,ntiles_cn,MPI_REAL,0,MPI_COMM_WORLD,mpierr) + + ! Open GKW/Fzeng SMAP M09 catchcn_internal_rst and output catchcn_internal_rst + ! ---------------------------------------------------------------------------- + + ! NF_OPEN_PAR is no longer needed since IO is done by the root processor. + ! call MPI_Info_create(info, STATUS) + ! call MPI_Info_set(info, "romio_cb_read", "automatic", STATUS) + ! STATUS = NF_OPEN_PAR (trim(InCNRestart),IOR(NF_NOWRITE,NF_MPIIO),MPI_COMM_WORLD, info,NCFID) + ! STATUS = NF_OPEN_PAR (trim(OutFileName),IOR(NF_WRITE ,NF_MPIIO),MPI_COMM_WORLD, info,OUTID) + + STATUS = NF_OPEN (trim(InCNRestart),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS, 'INPUT RESTART FAILED') + STATUS = NF_OPEN (trim(OutFileName),NF_WRITE,OUTID) ; VERIFY_(STATUS) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS, 'OUTPUT RESTART FAILED') + + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),1/), (/nt_local(myid+1),1/),CLMC_pt1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),2/), (/nt_local(myid+1),1/),CLMC_pt2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_st1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_st2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),1/), (/nt_local(myid+1),1/),CLMC_pf1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),2/), (/nt_local(myid+1),1/),CLMC_pf2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_sf1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_sf2) + + if (master_proc) then + + allocate (TILE_ID (1:ntiles_cn)) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TILE_ID' ), (/1/), (/NTILES_CN/),TILE_ID) + + do n = 1,ntiles_cn + + K = NINT (TILE_ID (n)) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ITY'), (/n,1/), (/1,4/),ityp_offl(K,:)) + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'FVG'), (/n,1/), (/1,4/),fveg_offl(K,:)) + + tid_offl (n) = n + + do nv = 1,nveg + if(ityp_offl(K,nv)<0 .or. ityp_offl(K,nv)>npft) stop 'ityp' + if(fveg_offl(K,nv)<0..or. fveg_offl(K,nv)>1.00001) stop 'fveg' + end do + + if((ityp_offl(K,3) == 0).and.(ityp_offl(K,4) == 0)) then + if(ityp_offl(K,1) /= 0) then + ityp_offl(K,3) = ityp_offl(K,1) + else + ityp_offl(K,3) = ityp_offl(K,2) + endif + endif + + if((ityp_offl(K,1) == 0).and.(ityp_offl(K,2) /= 0)) ityp_offl(K,1) = ityp_offl(K,2) + if((ityp_offl(K,2) == 0).and.(ityp_offl(K,1) /= 0)) ityp_offl(K,2) = ityp_offl(K,1) + if((ityp_offl(K,3) == 0).and.(ityp_offl(K,4) /= 0)) ityp_offl(K,3) = ityp_offl(K,4) + if((ityp_offl(K,4) == 0).and.(ityp_offl(K,3) /= 0)) ityp_offl(K,4) = ityp_offl(K,3) + + end do + + endif + + call MPI_BCAST(tid_offl ,size(tid_offl ),MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(ityp_offl,size(ityp_offl),MPI_REAL ,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(fveg_offl,size(fveg_offl),MPI_REAL ,0,MPI_COMM_WORLD,mpierr) + + ! -------------------------------------------------------------------------------- + ! Here we create transfer index array to map offline restarts to output tile space + ! -------------------------------------------------------------------------------- + + call GetIds(lonc,latc,lonn,latt,id_loc, tid_offl, & + CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & + fveg_offl, ityp_offl) + + ! update id_glb in root + + if(master_proc) then + allocate (id_glb (ntiles, nveg)) + allocate (id_vec (ntiles)) + endif + + do nv = 1, nveg + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + ! call MPI_GATHERV( & + ! id_loc (:,nv), nt_local(myid+1) , MPI_real, & + ! id_vec, nt_local,low_ind-1, MPI_real, & + ! 0, MPI_COMM_WORLD, mpierr ) + + do i = 1, numprocs + if((I == 1).and.(myid == 0)) then + id_vec(low_ind(i) : upp_ind(i)) = Id_loc(:,nv) + else if (I > 1) then + if(I-1 == myid) then + ! send to root + call MPI_ISend(id_loc(:,nv),nt_local(i),MPI_INTEGER,0,993,MPI_COMM_WORLD,req,mpierr) + call MPI_WAIT (req,MPI_STATUS_IGNORE,mpierr) + else if (myid == 0) then + ! root receives + call MPI_RECV(id_vec(low_ind(i) : upp_ind(i)),nt_local(i) , MPI_INTEGER, i-1,993,MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + endif + endif + end do + + if(master_proc) id_glb (:,nv) = id_vec + + end do + + if(master_proc) then + + allocate (var_off_col (1: NTILES_CN, 1 : nzone,1 : var_col)) + allocate (var_off_pft (1: NTILES_CN, 1 : nzone,1 : nveg, 1 : var_pft)) + allocate (var_dum2 (1:ntiles_cn)) + i = 1 + do nv = 1,VAR_COL + do nz = 1,nzone + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CNCOL'), (/1,i/), (/NTILES_CN,1 /),VAR_DUM2) + do k = 1, NTILES_CN + var_off_col(TILE_ID(K), nz,nv) = VAR_DUM2(K) + end do + i = i + 1 + end do + end do + + i = 1 + do iv = 1,VAR_PFT + do nv = 1,nveg + do nz = 1,nzone + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CNPFT'), (/1,i/), (/NTILES_CN,1 /),VAR_DUM2) + do k = 1, NTILES_CN + var_off_pft(TILE_ID(K), nz,nv,iv) = VAR_DUM2(K) + end do + i = i + 1 + end do + end do + end do + + where(isnan(var_off_pft)) var_off_pft = 0. + where(var_off_pft /= var_off_pft) var_off_pft = 0. + + call write_regridded_carbon (NTILES, ntiles_cn, NCFID, OUTID, id_glb, & + DAYX, var_off_col, var_off_pft, ityp_offl, fveg_offl) + deallocate (var_off_col,var_off_pft) + endif + + call MPI_Barrier(MPI_COMM_WORLD, STATUS) + + END SUBROUTINE regrid_carbon_vars + +! --------------------------------------------------------------------------------------------------------- + + SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & + DAYX, var_off_col, var_off_pft, ityp_offl, fveg_offl) + + ! write out regridded carbon variables + implicit none + integer, intent (in) :: NTILES, ntiles_rst,NCFID, OUTID, id_glb (ntiles,nveg) + real, intent (in) :: DAYX (NTILES), var_off_col(NTILES_RST,NZONE,var_col), var_off_pft(NTILES_RST,NZONE, NVEG, var_pft) + real, intent (in), dimension(ntiles_rst,nveg) :: fveg_offl, ityp_offl + real, allocatable, dimension (:) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & + CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, var_dum + real, allocatable :: var_col_out (:,:,:), var_pft_out (:,:,:,:) + integer :: N, STATUS, nv, nx, offl_cell, ityp_new, i, j, nz, iv + real :: fveg_new + + allocate (CLMC_pf1(NTILES)) + allocate (CLMC_pf2(NTILES)) + allocate (CLMC_sf1(NTILES)) + allocate (CLMC_sf2(NTILES)) + allocate (CLMC_pt1(NTILES)) + allocate (CLMC_pt2(NTILES)) + allocate (CLMC_st1(NTILES)) + allocate (CLMC_st2(NTILES)) + allocate (VAR_DUM (NTILES)) + + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/1,1/), (/NTILES,1/),CLMC_pt1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/1,2/), (/NTILES,1/),CLMC_pt2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/1,3/), (/NTILES,1/),CLMC_st1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'ITY'), (/1,4/), (/NTILES,1/),CLMC_st2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/1,1/), (/NTILES,1/),CLMC_pf1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/1,2/), (/NTILES,1/),CLMC_pf2) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/1,3/), (/NTILES,1/),CLMC_sf1) + STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/1,4/), (/NTILES,1/),CLMC_sf2) + + allocate (var_col_out (1: NTILES, 1 : nzone,1 : var_col)) + allocate (var_pft_out (1: NTILES, 1 : nzone,1 : nveg, 1 : var_pft)) + + var_col_out = 0. + var_pft_out = NaN + + OUT_TILE : DO N = 1, NTILES + + ! if(mod (n,1000) == 0) print *, myid +1, n, Id_glb(n,:) + + NVLOOP2 : do nv = 1, nveg + + if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary + nx = nv + 2 + else + nx = nv - 2 + endif + + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_pt2(n) + if (nv == 2) fveg_new = CLMC_pf2(n) + if (nv == 3) ityp_new = CLMC_st1(n) + if (nv == 3) fveg_new = CLMC_sf1(n) + if (nv == 4) ityp_new = CLMC_st2(n) + if (nv == 4) fveg_new = CLMC_sf2(n) + + if (fveg_new > fmin) then + + offl_cell = Id_glb(n,nv) + + if(ityp_new == ityp_offl (offl_cell,nv) .and. fveg_offl (offl_cell,nv)> fmin) then + iv = nv ! same type fraction (primary of secondary) + else if(ityp_new == ityp_offl (offl_cell,nx) .and. fveg_offl (offl_cell,nx)> fmin) then + iv = nx ! not same fraction + else if(iclass(ityp_new)==iclass(ityp_offl(offl_cell,nv)) .and. fveg_offl (offl_cell,nv)> fmin) then + iv = nv ! primary, other type (same class) + else if(fveg_offl (offl_cell,nx)> fmin) then + iv = nx ! secondary, other type (same class) + endif + + ! Get col and pft variables for the Id_glb(nv) grid cell from offline catchcn_internal_rst + ! ---------------------------------------------------------------------------------------- + + ! call NCDF_reshape_getOput (NCFID,Id_glb(n,nv),var_off_col,var_off_pft,.true.) + + var_pft_out (n,:,nv,:) = var_off_pft(Id_glb(n,nv), :,iv,:) + var_col_out (n,:,:) = var_col_out(n,:,:) + fveg_new * var_off_col(Id_glb(n,nv), :,:) ! gkw: column state simple weighted mean; ! could use "woody" fraction? + + ! Check whether var_pft_out is realistic + do nz = 1, nzone + do j = 1, VAR_PFT + if (isnan(var_pft_out (n, nz,nv,j))) print *,j,nv,nz,n,var_pft_out (n, nz,nv,j),fveg_new + !if(isnan(var_pft_out (n, nz,nv,69))) var_pft_out (n, nz,nv,69) = 1.e-6 + !if(isnan(var_pft_out (n, nz,nv,70))) var_pft_out (n, nz,nv,70) = 1.e-6 + !if(isnan(var_pft_out (n, nz,nv,73))) var_pft_out (n, nz,nv,73) = 1.e-6 + !if(isnan(var_pft_out (n, nz,nv,74))) var_pft_out (n, nz,nv,74) = 1.e-6 + end do + end do + endif + + end do NVLOOP2 + + ! reset carbon if negative < 10g + ! ------------------------ + + NZLOOP : do nz = 1, nzone + + if(var_col_out (n, nz,14) < 10.) then + + var_col_out(n, nz, 1) = max(var_col_out(n, nz, 1), 0.) + var_col_out(n, nz, 2) = max(var_col_out(n, nz, 2), 0.) + var_col_out(n, nz, 3) = max(var_col_out(n, nz, 3), 0.) + var_col_out(n, nz, 4) = max(var_col_out(n, nz, 4), 0.) + var_col_out(n, nz, 5) = max(var_col_out(n, nz, 5), 0.) + var_col_out(n, nz,10) = max(var_col_out(n, nz,10), 0.) + var_col_out(n, nz,11) = max(var_col_out(n, nz,11), 0.) + var_col_out(n, nz,12) = max(var_col_out(n, nz,12), 0.) + var_col_out(n, nz,13) = max(var_col_out(n, nz,13),10.) ! soil4c + var_col_out(n, nz,14) = max(var_col_out(n, nz,14), 0.) + var_col_out(n, nz,15) = max(var_col_out(n, nz,15), 0.) + var_col_out(n, nz,16) = max(var_col_out(n, nz,16), 0.) + var_col_out(n, nz,17) = max(var_col_out(n, nz,17), 0.) + var_col_out(n, nz,18) = max(var_col_out(n, nz,18), 0.) + var_col_out(n, nz,19) = max(var_col_out(n, nz,19), 0.) + var_col_out(n, nz,20) = max(var_col_out(n, nz,20), 0.) + var_col_out(n, nz,24) = max(var_col_out(n, nz,24), 0.) + var_col_out(n, nz,25) = max(var_col_out(n, nz,25), 0.) + var_col_out(n, nz,26) = max(var_col_out(n, nz,26), 0.) + var_col_out(n, nz,27) = max(var_col_out(n, nz,27), 0.) + var_col_out(n, nz,28) = max(var_col_out(n, nz,28), 1.) + var_col_out(n, nz,29) = max(var_col_out(n, nz,29), 0.) + + NVLOOP3 : do nv = 1,nveg + + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_pt2(n) + if (nv == 2) fveg_new = CLMC_pf2(n) + if (nv == 3) ityp_new = CLMC_st1(n) + if (nv == 3) fveg_new = CLMC_sf1(n) + if (nv == 4) ityp_new = CLMC_st2(n) + if (nv == 4) fveg_new = CLMC_sf2(n) + + if(fveg_new > fmin) then + var_pft_out(n, nz,nv, 1) = max(var_pft_out(n, nz,nv, 1),0.) + var_pft_out(n, nz,nv, 2) = max(var_pft_out(n, nz,nv, 2),0.) + var_pft_out(n, nz,nv, 3) = max(var_pft_out(n, nz,nv, 3),0.) + var_pft_out(n, nz,nv, 4) = max(var_pft_out(n, nz,nv, 4),0.) + + if(ityp_new <= 12) then ! tree or shrub deadstemc + var_pft_out(n, nz,nv, 5) = max(var_pft_out(n, nz,nv, 5),0.1) + else + var_pft_out(n, nz,nv, 5) = max(var_pft_out(n, nz,nv, 5),0.0) + endif + + var_pft_out(n, nz,nv, 6) = max(var_pft_out(n, nz,nv, 6),0.) + var_pft_out(n, nz,nv, 7) = max(var_pft_out(n, nz,nv, 7),0.) + var_pft_out(n, nz,nv, 8) = max(var_pft_out(n, nz,nv, 8),0.) + var_pft_out(n, nz,nv, 9) = max(var_pft_out(n, nz,nv, 9),0.) + var_pft_out(n, nz,nv,10) = max(var_pft_out(n, nz,nv,10),0.) + var_pft_out(n, nz,nv,11) = max(var_pft_out(n, nz,nv,11),0.) + var_pft_out(n, nz,nv,12) = max(var_pft_out(n, nz,nv,12),0.) + + if(ityp_new <=2 .or. ityp_new ==4 .or. ityp_new ==5 .or. ityp_new == 9) then + var_pft_out(n, nz,nv,13) = max(var_pft_out(n, nz,nv,13),1.) ! leaf carbon display for evergreen + var_pft_out(n, nz,nv,14) = max(var_pft_out(n, nz,nv,14),0.) + else + var_pft_out(n, nz,nv,13) = max(var_pft_out(n, nz,nv,13),0.) + var_pft_out(n, nz,nv,14) = max(var_pft_out(n, nz,nv,14),1.) ! leaf carbon storage for deciduous + endif + + var_pft_out(n, nz,nv,15) = max(var_pft_out(n, nz,nv,15),0.) + var_pft_out(n, nz,nv,16) = max(var_pft_out(n, nz,nv,16),0.) + var_pft_out(n, nz,nv,17) = max(var_pft_out(n, nz,nv,17),0.) + var_pft_out(n, nz,nv,18) = max(var_pft_out(n, nz,nv,18),0.) + var_pft_out(n, nz,nv,19) = max(var_pft_out(n, nz,nv,19),0.) + var_pft_out(n, nz,nv,20) = max(var_pft_out(n, nz,nv,20),0.) + var_pft_out(n, nz,nv,21) = max(var_pft_out(n, nz,nv,21),0.) + var_pft_out(n, nz,nv,22) = max(var_pft_out(n, nz,nv,22),0.) + var_pft_out(n, nz,nv,23) = max(var_pft_out(n, nz,nv,23),0.) + var_pft_out(n, nz,nv,25) = max(var_pft_out(n, nz,nv,25),0.) + var_pft_out(n, nz,nv,26) = max(var_pft_out(n, nz,nv,26),0.) + var_pft_out(n, nz,nv,27) = max(var_pft_out(n, nz,nv,27),0.) + var_pft_out(n, nz,nv,41) = max(var_pft_out(n, nz,nv,41),0.) + var_pft_out(n, nz,nv,42) = max(var_pft_out(n, nz,nv,42),0.) + var_pft_out(n, nz,nv,44) = max(var_pft_out(n, nz,nv,44),0.) + var_pft_out(n, nz,nv,45) = max(var_pft_out(n, nz,nv,45),0.) + var_pft_out(n, nz,nv,46) = max(var_pft_out(n, nz,nv,46),0.) + var_pft_out(n, nz,nv,47) = max(var_pft_out(n, nz,nv,47),0.) + var_pft_out(n, nz,nv,48) = max(var_pft_out(n, nz,nv,48),0.) + var_pft_out(n, nz,nv,49) = max(var_pft_out(n, nz,nv,49),0.) + var_pft_out(n, nz,nv,50) = max(var_pft_out(n, nz,nv,50),0.) + var_pft_out(n, nz,nv,51) = max(var_pft_out(n, nz,nv, 5)/500.,0.) + var_pft_out(n, nz,nv,52) = max(var_pft_out(n, nz,nv,52),0.) + var_pft_out(n, nz,nv,53) = max(var_pft_out(n, nz,nv,53),0.) + var_pft_out(n, nz,nv,54) = max(var_pft_out(n, nz,nv,54),0.) + var_pft_out(n, nz,nv,55) = max(var_pft_out(n, nz,nv,55),0.) + var_pft_out(n, nz,nv,56) = max(var_pft_out(n, nz,nv,56),0.) + var_pft_out(n, nz,nv,57) = max(var_pft_out(n, nz,nv,13)/25.,0.) + var_pft_out(n, nz,nv,58) = max(var_pft_out(n, nz,nv,14)/25.,0.) + var_pft_out(n, nz,nv,59) = max(var_pft_out(n, nz,nv,59),0.) + var_pft_out(n, nz,nv,60) = max(var_pft_out(n, nz,nv,60),0.) + var_pft_out(n, nz,nv,61) = max(var_pft_out(n, nz,nv,61),0.) + var_pft_out(n, nz,nv,62) = max(var_pft_out(n, nz,nv,62),0.) + var_pft_out(n, nz,nv,63) = max(var_pft_out(n, nz,nv,63),0.) + var_pft_out(n, nz,nv,64) = max(var_pft_out(n, nz,nv,64),0.) + var_pft_out(n, nz,nv,65) = max(var_pft_out(n, nz,nv,65),0.) + var_pft_out(n, nz,nv,66) = max(var_pft_out(n, nz,nv,66),0.) + var_pft_out(n, nz,nv,67) = max(var_pft_out(n, nz,nv,67),0.) + var_pft_out(n, nz,nv,68) = max(var_pft_out(n, nz,nv,68),0.) + var_pft_out(n, nz,nv,69) = max(var_pft_out(n, nz,nv,69),0.) + var_pft_out(n, nz,nv,70) = max(var_pft_out(n, nz,nv,70),0.) + var_pft_out(n, nz,nv,73) = max(var_pft_out(n, nz,nv,73),0.) + var_pft_out(n, nz,nv,74) = max(var_pft_out(n, nz,nv,74),0.) + if(clm45) var_pft_out(n, nz,nv,75) = max(var_pft_out(n, nz,nv,75),0.) + endif + end do NVLOOP3 ! end veg loop + endif ! end carbon check + end do NZLOOP ! end zone loop + + ! Update dayx variable var_pft_out (:,:,28) + + do j = 28, 28 ! 1,VAR_PFT var_pft_out (:,:,:,28) + do nv = 1,nveg + do nz = 1,nzone + var_pft_out (n, nz,nv,j) = dayx(n) + end do + end do + end do + + ! call NCDF_reshape_getOput (OutID,N,var_col_out,var_pft_out,.false.) + + ! column vars clm40 clm45 + ! ----------------- --------------------- + ! 1 clm3%g%l%c%ccs%col_ctrunc ! 1 ccs%col_ctrunc_vr (:,1) + ! 2 clm3%g%l%c%ccs%cwdc ! 2 ccs%decomp_cpools_vr(:,1,4) ! cwdc + ! 3 clm3%g%l%c%ccs%litr1c ! 3 ccs%decomp_cpools_vr(:,1,1) ! litr1c + ! 4 clm3%g%l%c%ccs%litr2c ! 4 ccs%decomp_cpools_vr(:,1,2) ! litr2c + ! 5 clm3%g%l%c%ccs%litr3c ! 5 ccs%decomp_cpools_vr(:,1,3) ! litr3c + ! 6 clm3%g%l%c%ccs%pcs_a%totvegc ! 6 ccs%totvegc_col + ! 7 clm3%g%l%c%ccs%prod100c ! 7 ccs%prod100c + ! 8 clm3%g%l%c%ccs%prod10c ! 8 ccs%prod10c + ! 9 clm3%g%l%c%ccs%seedc ! 9 ccs%seedc + ! 10 clm3%g%l%c%ccs%soil1c ! 10 ccs%decomp_cpools_vr(:,1,5) ! soil1c + ! 11 clm3%g%l%c%ccs%soil2c ! 11 ccs%decomp_cpools_vr(:,1,6) ! soil2c + ! 12 clm3%g%l%c%ccs%soil3c ! 12 ccs%decomp_cpools_vr(:,1,7) ! soil3c + ! 13 clm3%g%l%c%ccs%soil4c ! 13 ccs%decomp_cpools_vr(:,1,8) ! soil4c + ! 14 clm3%g%l%c%ccs%totcolc ! 14 ccs%totcolc + ! 15 clm3%g%l%c%ccs%totlitc ! 15 ccs%totlitc + ! 16 clm3%g%l%c%cns%col_ntrunc ! 16 cns%col_ntrunc_vr (:,1) + ! 17 clm3%g%l%c%cns%cwdn ! 17 cns%decomp_npools_vr(:,1,4) ! cwdn + ! 18 clm3%g%l%c%cns%litr1n ! 18 cns%decomp_npools_vr(:,1,1) ! litr1n + ! 19 clm3%g%l%c%cns%litr2n ! 19 cns%decomp_npools_vr(:,1,2) ! litr2n + ! 20 clm3%g%l%c%cns%litr3n ! 20 cns%decomp_npools_vr(:,1,3) ! litr3n + ! 21 clm3%g%l%c%cns%prod100n ! 21 cns%prod100n + ! 22 clm3%g%l%c%cns%prod10n ! 22 cns%prod10n + ! 23 clm3%g%l%c%cns%seedn ! 23 cns%seedn + ! 24 clm3%g%l%c%cns%sminn ! 24 cns%sminn_vr (:,1) + ! 25 clm3%g%l%c%cns%soil1n ! 25 cns%decomp_npools_vr(:,1,5) ! soil1n + ! 26 clm3%g%l%c%cns%soil2n ! 26 cns%decomp_npools_vr(:,1,6) ! soil2n + ! 27 clm3%g%l%c%cns%soil3n ! 27 cns%decomp_npools_vr(:,1,7) ! soil3n + ! 28 clm3%g%l%c%cns%soil4n ! 28 cns%decomp_npools_vr(:,1,8) ! soil4n + ! 29 clm3%g%l%c%cns%totcoln ! 29 cns%totcoln + ! 30 clm3%g%l%c%cps%ann_farea_burned ! 30 cps%fpg + ! 31 clm3%g%l%c%cps%annsum_counter ! 31 cps%annsum_counter + ! 32 clm3%g%l%c%cps%cannavg_t2m ! 32 cps%cannavg_t2m + ! 33 clm3%g%l%c%cps%cannsum_npp ! 33 cps%cannsum_npp + ! 34 clm3%g%l%c%cps%farea_burned ! 34 cps%farea_burned + ! 35 clm3%g%l%c%cps%fire_prob ! 35 cps%fpi_vr (:,1) + ! 36 clm3%g%l%c%cps%fireseasonl ! OLD ! 30 cps%altmax + ! 37 clm3%g%l%c%cps%fpg ! OLD ! 31 cps%annsum_counter + ! 38 clm3%g%l%c%cps%fpi ! OLD ! 32 cps%cannavg_t2m + ! 39 clm3%g%l%c%cps%me ! OLD ! 33 cps%cannsum_npp + ! 40 clm3%g%l%c%cps%mean_fire_prob ! OLD ! 34 cps%farea_burned + ! OLD ! 35 cps%altmax_lastyear + ! OLD ! 36 cps%altmax_indx + ! OLD ! 37 cps%fpg + ! OLD ! 38 cps%fpi_vr (:,1) + ! OLD ! 39 cps%altmax_lastyear_indx + + ! PFT vars CLM40 CLM45 + ! -------------- ----- + ! 1 clm3%g%l%c%p%pcs%cpool ! 1 pcs%cpool + ! 2 clm3%g%l%c%p%pcs%deadcrootc ! 2 pcs%deadcrootc + ! 3 clm3%g%l%c%p%pcs%deadcrootc_storage ! 3 pcs%deadcrootc_storage + ! 4 clm3%g%l%c%p%pcs%deadcrootc_xfer ! 4 pcs%deadcrootc_xfer + ! 5 clm3%g%l%c%p%pcs%deadstemc ! 5 pcs%deadstemc + ! 6 clm3%g%l%c%p%pcs%deadstemc_storage ! 6 pcs%deadstemc_storage + ! 7 clm3%g%l%c%p%pcs%deadstemc_xfer ! 7 pcs%deadstemc_xfer + ! 8 clm3%g%l%c%p%pcs%frootc ! 8 pcs%frootc + ! 9 clm3%g%l%c%p%pcs%frootc_storage ! 9 pcs%frootc_storage + ! 10 clm3%g%l%c%p%pcs%frootc_xfer ! 10 pcs%frootc_xfer + ! 11 clm3%g%l%c%p%pcs%gresp_storage ! 11 pcs%gresp_storage + ! 12 clm3%g%l%c%p%pcs%gresp_xfer ! 12 pcs%gresp_xfer + ! 13 clm3%g%l%c%p%pcs%leafc ! 13 pcs%leafc + ! 14 clm3%g%l%c%p%pcs%leafc_storage ! 14 pcs%leafc_storage + ! 15 clm3%g%l%c%p%pcs%leafc_xfer ! 15 pcs%leafc_xfer + ! 16 clm3%g%l%c%p%pcs%livecrootc ! 16 pcs%livecrootc + ! 17 clm3%g%l%c%p%pcs%livecrootc_storage ! 17 pcs%livecrootc_storage + ! 18 clm3%g%l%c%p%pcs%livecrootc_xfer ! 18 pcs%livecrootc_xfer + ! 19 clm3%g%l%c%p%pcs%livestemc ! 19 pcs%livestemc + ! 20 clm3%g%l%c%p%pcs%livestemc_storage ! 20 pcs%livestemc_storage + ! 21 clm3%g%l%c%p%pcs%livestemc_xfer ! 21 pcs%livestemc_xfer + ! 22 clm3%g%l%c%p%pcs%pft_ctrunc ! 22 pcs%pft_ctrunc + ! 23 clm3%g%l%c%p%pcs%xsmrpool ! 23 pcs%xsmrpool + ! 24 clm3%g%l%c%p%pepv%annavg_t2m ! 24 pepv%annavg_t2m + ! 25 clm3%g%l%c%p%pepv%annmax_retransn ! 25 pepv%annmax_retransn + ! 26 clm3%g%l%c%p%pepv%annsum_npp ! 26 pepv%annsum_npp + ! 27 clm3%g%l%c%p%pepv%annsum_potential_gpp ! 27 pepv%annsum_potential_gpp + ! 28 clm3%g%l%c%p%pepv%dayl ! 28 pepv%dayl + ! 29 clm3%g%l%c%p%pepv%days_active ! 29 pepv%days_active + ! 30 clm3%g%l%c%p%pepv%dormant_flag ! 30 pepv%dormant_flag + ! 31 clm3%g%l%c%p%pepv%offset_counter ! 31 pepv%offset_counter + ! 32 clm3%g%l%c%p%pepv%offset_fdd ! 32 pepv%offset_fdd + ! 33 clm3%g%l%c%p%pepv%offset_flag ! 33 pepv%offset_flag + ! 34 clm3%g%l%c%p%pepv%offset_swi ! 34 pepv%offset_swi + ! 35 clm3%g%l%c%p%pepv%onset_counter ! 35 pepv%onset_counter + ! 36 clm3%g%l%c%p%pepv%onset_fdd ! 36 pepv%onset_fdd + ! 37 clm3%g%l%c%p%pepv%onset_flag ! 37 pepv%onset_flag + ! 38 clm3%g%l%c%p%pepv%onset_gdd ! 38 pepv%onset_gdd + ! 39 clm3%g%l%c%p%pepv%onset_gddflag ! 39 pepv%onset_gddflag + ! 40 clm3%g%l%c%p%pepv%onset_swi ! 40 pepv%onset_swi + ! 41 clm3%g%l%c%p%pepv%prev_frootc_to_litter ! 41 pepv%prev_frootc_to_litter + ! 42 clm3%g%l%c%p%pepv%prev_leafc_to_litter ! 42 pepv%prev_leafc_to_litter + ! 43 clm3%g%l%c%p%pepv%tempavg_t2m ! 43 pepv%tempavg_t2m + ! 44 clm3%g%l%c%p%pepv%tempmax_retransn ! 44 pepv%tempmax_retransn + ! 45 clm3%g%l%c%p%pepv%tempsum_npp ! 45 pepv%tempsum_npp + ! 46 clm3%g%l%c%p%pepv%tempsum_potential_gpp ! 46 pepv%tempsum_potential_gpp + ! 47 clm3%g%l%c%p%pepv%xsmrpool_recover ! 47 pepv%xsmrpool_recover + ! 48 clm3%g%l%c%p%pns%deadcrootn ! 48 pns%deadcrootn + ! 49 clm3%g%l%c%p%pns%deadcrootn_storage ! 49 pns%deadcrootn_storage + ! 50 clm3%g%l%c%p%pns%deadcrootn_xfer ! 50 pns%deadcrootn_xfer + ! 51 clm3%g%l%c%p%pns%deadstemn ! 51 pns%deadstemn + ! 52 clm3%g%l%c%p%pns%deadstemn_storage ! 52 pns%deadstemn_storage + ! 53 clm3%g%l%c%p%pns%deadstemn_xfer ! 53 pns%deadstemn_xfer + ! 54 clm3%g%l%c%p%pns%frootn ! 54 pns%frootn + ! 55 clm3%g%l%c%p%pns%frootn_storage ! 55 pns%frootn_storage + ! 56 clm3%g%l%c%p%pns%frootn_xfer ! 56 pns%frootn_xfer + ! 57 clm3%g%l%c%p%pns%leafn ! 57 pns%leafn + ! 58 clm3%g%l%c%p%pns%leafn_storage ! 58 pns%leafn_storage + ! 59 clm3%g%l%c%p%pns%leafn_xfer ! 59 pns%leafn_xfer + ! 60 clm3%g%l%c%p%pns%livecrootn ! 60 pns%livecrootn + ! 61 clm3%g%l%c%p%pns%livecrootn_storage ! 61 pns%livecrootn_storage + ! 62 clm3%g%l%c%p%pns%livecrootn_xfer ! 62 pns%livecrootn_xfer + ! 63 clm3%g%l%c%p%pns%livestemn ! 63 pns%livestemn + ! 64 clm3%g%l%c%p%pns%livestemn_storage ! 64 pns%livestemn_storage + ! 65 clm3%g%l%c%p%pns%livestemn_xfer ! 65 pns%livestemn_xfer + ! 66 clm3%g%l%c%p%pns%npool ! 66 pns%npool + ! 67 clm3%g%l%c%p%pns%pft_ntrunc ! 67 pns%pft_ntrunc + ! 68 clm3%g%l%c%p%pns%retransn ! 68 pns%retransn + ! 69 clm3%g%l%c%p%pps%elai ! 69 pps%elai + ! 70 clm3%g%l%c%p%pps%esai ! 70 pps%esai + ! 71 clm3%g%l%c%p%pps%hbot ! 71 pps%hbot + ! 72 clm3%g%l%c%p%pps%htop ! 72 pps%htop + ! 73 clm3%g%l%c%p%pps%tlai ! 73 pps%tlai + ! 74 clm3%g%l%c%p%pps%tsai ! 74 pps%tsai + ! 75 pepv%plant_ndemand + ! OLD ! 75 pps%gddplant + ! OLD ! 76 pps%gddtsoi + ! OLD ! 77 pps%peaklai + ! OLD ! 78 pps%idop + ! OLD ! 79 pps%aleaf + ! OLD ! 80 pps%aleafi + ! OLD ! 81 pps%astem + ! OLD ! 82 pps%astemi + ! OLD ! 83 pps%htmx + ! OLD ! 84 pps%hdidx + ! OLD ! 85 pps%vf + ! OLD ! 86 pps%cumvd + ! OLD ! 87 pps%croplive + ! OLD ! 88 pps%cropplant + ! OLD ! 89 pps%harvdate + ! OLD ! 90 pps%gdd1020 + ! OLD ! 91 pps%gdd820 + ! OLD ! 92 pps%gdd020 + ! OLD ! 93 pps%gddmaturity + ! OLD ! 94 pps%huileaf + ! OLD ! 95 pps%huigrain + ! OLD ! 96 pcs%grainc + ! OLD ! 97 pcs%grainc_storage + ! OLD ! 98 pcs%grainc_xfer + ! OLD ! 99 pns%grainn + ! OLD !100 pns%grainn_storage + ! OLD !101 pns%grainn_xfer + ! OLD !102 pepv%fert_counter + ! OLD !103 pnf%fert + ! OLD !104 pepv%grain_flag + + end do OUT_TILE + + i = 1 + do nv = 1,VAR_COL + do nz = 1,nzone + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNCOL'), (/1,i/), (/NTILES,1 /),var_col_out(:, nz,nv)) + i = i + 1 + end do + end do + + i = 1 + if(clm45) then + do iv = 1,VAR_PFT + do nv = 1,nveg + do nz = 1,nzone + if(iv <= 74) then + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_pft_out(:, nz,nv,iv)) + else + if((iv == 78) .OR. (iv == 89)) then ! idop and harvdate + var_dum = 999 + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_dum) + else + var_dum = 0. + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_dum) + endif + endif + i = i + 1 + end do + end do + end do + else + do iv = 1,VAR_PFT + do nv = 1,nveg + do nz = 1,nzone + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_pft_out(:, nz,nv,iv)) + i = i + 1 + end do + end do + end do + endif + + VAR_DUM = 0. + + do nz = 1,nzone + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TGWM'), (/1,nz/), (/NTILES,1 /),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RZMM'), (/1,nz/), (/NTILES,1 /),VAR_DUM(:)) + if(clm45) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SFMM'), (/1,nz/), (/NTILES,1 /),VAR_DUM(:)) + end do + + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'BFLOWM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TOTWATM'), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TAIRM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'CNSUM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SNDZM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'ASNOWM' ), (/1/), (/NTILES/),VAR_DUM(:)) + + if(clm45) then + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'AR1M' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RAINFM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RHM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RUNSRFM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SNOWFM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'WINDM' ), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC10D'), (/1/), (/NTILES/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC60D'), (/1/), (/NTILES/),VAR_DUM(:)) + else + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SFMCM'), (/1/), (/NTILES/),VAR_DUM(:)) + endif + + do nv = 1,nzone + do nz = 1,nveg + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'PSNSUNM'), (/1,nz,nv/), (/NTILES,1,1/),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'PSNSHAM'), (/1,nz,nv/), (/NTILES,1,1/),VAR_DUM(:)) + end do + end do + VAR_DUM = 0.1 + do i = 1,4 + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'WW'), (/1,i/), (/NTILES,1 /),VAR_DUM(:)) + end do + + VAR_DUM = 0.25 + do i = 1,4 + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'FR'), (/1,i/), (/NTILES,1 /),VAR_DUM(:)) + end do + + VAR_DUM = 0.001 + do i = 1,4 + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'CH'), (/1,i/), (/NTILES,1 /),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'CM'), (/1,i/), (/NTILES,1 /),VAR_DUM(:)) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'CQ'), (/1,i/), (/NTILES,1 /),VAR_DUM(:)) + end do + + STATUS = NF_CLOSE (NCFID) + STATUS = NF_CLOSE (OutID) + + deallocate (var_col_out,var_pft_out) + deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2) + deallocate (CLMC_pt1, CLMC_pt2, CLMC_st1, CLMC_st2) + + END SUBROUTINE write_regridded_carbon + + ! ***************************************************************************** + + SUBROUTINE put_land_vars (NTILES, ntiles_rst, id_glb, ld_reorder, model, rst_file) + + implicit none + character(*), intent (in) :: model + integer, intent (in) :: NTILES, ntiles_rst + integer, intent (in) :: id_glb(NTILES), ld_reorder (ntiles_rst) + integer :: k, rc + real , dimension (:), allocatable :: var_get, var_put + type(Netcdf4_FileFormatter):: OutFmt, InFmt + type(FileMetadata) :: meta_data + integer :: STATUS, NCFID + character(*), intent (in), optional :: rst_file + + allocate (var_get (NTILES_RST)) + allocate (var_put (NTILES)) + + ! create output catchcn_internal_rst + if(trim(model) == 'CATCHCN') then + if (clm45) then + call InFmt%open('/discover/nobackup/rreichle/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_clm45',PFIO_READ, rc=rc) + else + call InFmt%open(trim(InCNRestart ), pFIO_READ, rc=rc) + endif + endif + if(trim(model) == 'CATCH' ) then + call InFmt%open(trim(InCatRestart), pFIO_READ, rc=rc) + endif + meta_data = InFmt%read(rc=rc) + call InFmt%close(rc=rc) + + call meta_data%modify_dimension('tile', ntiles, rc=rc) + + if(trim(model) == 'CATCHCN') OutFileName = "OutData1/catchcn_internal_rst" + if(trim(model) == 'CATCH' ) OutFileName = "OutData1/catch_internal_rst" + + call OutFmt%create(trim(OutFileName),rc=rc) + call OutFmt%write(meta_data,rc=rc) + + if (present(rst_file)) then + STATUS = NF_OPEN (trim(rst_file ),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) + else + if(trim(model) == 'CATCHCN') then + STATUS = NF_OPEN (trim(InCNRestart ),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) + endif + if(trim(model) == 'CATCH') then + STATUS = NF_OPEN (trim(InCatRestart),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) + endif + endif + + ! Read catparam + ! ------------- + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'POROS' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'POROS',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'COND' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'COND',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'PSIS' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'PSIS',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'BEE' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BEE',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'WPWET' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WPWET',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'GNU' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GNU',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'VGWMAX' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'VGWMAX',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'BF1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BF1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'BF2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BF2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'BF3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BF3',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CDCR1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CDCR1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CDCR2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CDCR2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARS1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARS1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARS2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARS2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARS3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARS3',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARA1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARA2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARA3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA3',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARA4' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA4',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARW1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARW2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARW3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW3',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ARW4' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW4',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TSA1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSA1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TSA2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSA2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TSB1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSB1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TSB2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSB2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ATAU' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ATAU',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'BTAU' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BTAU',var_put) + + if(trim(model) == 'CATCHCN') then + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ITY' ), (/1,1/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ITY',var_put, offset1=1) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ITY' ), (/1,2/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ITY',var_put, offset1=2) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ITY' ), (/1,3/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ITY',var_put, offset1=3) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'ITY' ), (/1,4/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ITY',var_put, offset1=4) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'FVG' ), (/1,1/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'FVG',var_put, offset1=1) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'FVG' ), (/1,2/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'FVG',var_put, offset1=2) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'FVG' ), (/1,3/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'FVG',var_put, offset1=3) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'FVG' ), (/1,4/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'FVG',var_put, offset1=4) + + ! read restart and regrid + ! ----------------------- + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TG' ), (/1,1/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TG',var_put, offset1=1) ! if you see offset1=1 it is a 2-D var + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TG' ), (/1,2/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TG',var_put, offset1=2) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TG' ), (/1,3/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TG',var_put, offset1=3) + + endif + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TC' ), (/1,1/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TC',var_put, offset1=1) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TC' ), (/1,2/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TC',var_put, offset1=2) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'TC' ), (/1,3/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TC',var_put, offset1=3) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'QC' ), (/1,1/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'QC',var_put, offset1=1) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'QC' ), (/1,2/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'QC',var_put, offset1=2) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'QC' ), (/1,3/), (/NTILES_RST,1/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'QC',var_put, offset1=3) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CAPAC' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CAPAC',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'CATDEF' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CATDEF',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'RZEXC' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'RZEXC',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'SRFEXC' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SRFEXC',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'GHTCNT1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'GHTCNT2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'GHTCNT3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT3',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'GHTCNT4' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT4',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'GHTCNT5' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT5',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'GHTCNT6' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT6',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'WESNN1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WESNN1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'WESNN2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WESNN2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'WESNN3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WESNN3',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'HTSNNN1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'HTSNNN2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'HTSNNN3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN3',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'SNDZN1' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SNDZN1',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'SNDZN2' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SNDZN2',var_put) + + STATUS = NF_GET_VARA_REAL(NCFID,VarID(NCFID,'SNDZN3' ), (/1/), (/NTILES_RST/),var_get) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SNDZN3',var_put) + + ! CH CM CQ FR WW + ! WW + VAR_PUT = 0.1 + do k = 1,4 + call MAPL_VarWrite(OutFmt,'WW',VAR_PUT ,offset1=k) + end do + ! FR + VAR_PUT = 0.25 + do k = 1,4 + call MAPL_VarWrite(OutFmt,'FR',VAR_PUT ,offset1=k) + end do + ! CH CM CQ + VAR_PUT = 0.001 + do k = 1,4 + call MAPL_VarWrite(OutFmt,'CH',VAR_PUT ,offset1=k) + call MAPL_VarWrite(OutFmt,'CM',VAR_PUT ,offset1=k) + call MAPL_VarWrite(OutFmt,'CQ',VAR_PUT ,offset1=k) + end do + + call OutFmt%close(rc=rc) + STATUS = NF_CLOSE ( NCFID) + + deallocate (var_get, var_put) + + if(trim(MODEL) == 'CATCHCN') then + call system('/bin/cp OutData1/catchcn_internal_rst OutData2/catchcn_internal_rst') + endif + + if(trim(MODEL) == 'CATCH') then + call system('/bin/cp OutData1/catch_internal_rst OutData2/catch_internal_rst') + endif + + END SUBROUTINE put_land_vars + + ! ***************************************************************************** + + subroutine init_MPI() + + ! initialize MPI + + call MPI_INIT(mpierr) + + call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) + call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, mpierr ) + + if (myid .ne. 0) master_proc = .false. + +! call init_MPI_types() + + write (*,*) "MPI process ", myid, " of ", numprocs, " is alive" + write (*,*) "MPI process ", myid, ": master_proc=", master_proc + + end subroutine init_MPI + + ! ----------------------------------------------------------------------- + + SUBROUTINE HANDLE_ERR(STATUS, Line) + + INTEGER, INTENT (IN) :: STATUS + CHARACTER(*), INTENT (IN) :: Line + + IF (STATUS .NE. NF_NOERR) THEN + PRINT *, trim(Line),': ',NF_STRERROR(STATUS) + STOP 'Stopped' + ENDIF + + END SUBROUTINE HANDLE_ERR + + ! ***************************************************************************** + + subroutine compute_dayx ( & + NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & + LATT, DAYX) + + implicit none + + integer, intent (in) :: NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR + real, dimension (NTILES), intent (in) :: LATT + real, dimension (NTILES), intent (out) :: DAYX + integer, parameter :: DT = 900 + integer, parameter :: ncycle = 1461 ! number of days in a 4-year leap cycle (365*4 + 1) + real, dimension(ncycle) :: zc, zs + integer :: dofyr, sec,YEARS_PER_CYCLE, DAYS_PER_CYCLE, year, iday, idayp1, nn, n + real :: fac, YEARLEN, zsin, zcos, declin + + dofyr = AGCM_DD + if(AGCM_MM > 1) dofyr = dofyr + 31 + if(AGCM_MM > 2) then + dofyr = dofyr + 28 + if(mod(AGCM_YY,4) == 0) dofyr = dofyr + 1 + endif + if(AGCM_MM > 3) dofyr = dofyr + 31 + if(AGCM_MM > 4) dofyr = dofyr + 30 + if(AGCM_MM > 5) dofyr = dofyr + 31 + if(AGCM_MM > 6) dofyr = dofyr + 30 + if(AGCM_MM > 7) dofyr = dofyr + 31 + if(AGCM_MM > 8) dofyr = dofyr + 31 + if(AGCM_MM > 9) dofyr = dofyr + 30 + if(AGCM_MM > 10) dofyr = dofyr + 31 + if(AGCM_MM > 11) dofyr = dofyr + 30 + + sec = AGCM_HR * 3600 - DT ! subtract DT to get time of previous physics step + fac = real(sec) / 86400. + + call orbit_create(zs,zc,ncycle) ! GEOS5 leap cycle routine + + YEARLEN = 365.25 + + ! Compute length of leap cycle + !------------------------------ + + if(YEARLEN-int(YEARLEN) > 0.) then + YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) + else + YEARS_PER_CYCLE = 1 + endif + + DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) + + ! declination & daylength + ! ----------------------- + + YEAR = mod(AGCM_YY-1,YEARS_PER_CYCLE) + + IDAY = YEAR*int(YEARLEN)+dofyr + IDAYP1 = mod(IDAY,DAYS_PER_CYCLE) + 1 + + ZSin = ZS(IDAYP1)*FAC + ZS(IDAY)*(1.-FAC) ! sine of solar declination + ZCos = ZC(IDAYP1)*FAC + ZC(IDAY)*(1.-FAC) ! cosine of solar declination + + nn = 0 + do n = 1,days_per_cycle + nn = nn + 1 + if(nn > 365) nn = nn - 365 + ! print *, 'cycle:',n,nn,asin(ZS(n)) + end do + + declin = asin(ZSin) + + ! compute daylength on input tile space (accounts for any change in physics time step) + ! do n = 1,ntiles_cn + ! fac = -(sin((latc(n)/zoom)*(MAPL_PI/180.))*zsin)/(cos((latc(n)/zoom)*(MAPL_PI/180.))*zcos) + ! fac = min(1.,max(-1.,fac)) + ! dayl(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) + ! end do + + ! compute daylength on output tile space (accounts for lat shift due to split & change in time step) + + do n = 1,ntiles + fac = -(sin(latt(n)*(MAPL_PI/180.))*zsin)/(cos(latt(n)*(MAPL_PI/180.))*zcos) + fac = min(1.,max(-1.,fac)) + dayx(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) + end do + + ! print *,'DAYX : ', minval(dayx),maxval(dayx), minval(latt), maxval(latt), zsin, zcos, dofyr, iday, idayp1, declin + + end subroutine compute_dayx + + ! ***************************************************************************** + + subroutine orbit_create(zs,zc,ncycle) + + implicit none + + integer, intent(in) :: ncycle + real, intent(out), dimension(ncycle) :: zs, zc + + integer :: YEARS_PER_CYCLE, DAYS_PER_CYCLE + integer :: K, KP !, KM + real*8 :: T1, T2, T3, T4, FUN, Y, SOB, OMG, PRH, TT + real*8 :: YEARLEN + + ! STATEMENT FUNCTION + + FUN(Y) = OMG*(1.0-ECCENTRICITY*cos(Y-PRH))**2 + + YEARLEN = 365.25 + + ! Factors involving the orbital parameters + !------------------------------------------ + + OMG = (2.0*MAPL_PI/YEARLEN) / (sqrt(1.-ECCENTRICITY**2)**3) + PRH = PERIHELION*(MAPL_PI/180.) + SOB = sin(OBLIQUITY*(MAPL_PI/180.)) + + ! Compute length of leap cycle + !------------------------------ + + if(YEARLEN-int(YEARLEN) > 0.) then + YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) + else + YEARS_PER_CYCLE = 1 + endif + + DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) + + if(days_per_cycle /= ncycle) stop 'bad cycle' + + ! ZS: Sine of declination + ! ZC: Cosine of declination + + ! Begin integration at vernal equinox + + KP = EQUINOX + TT = 0.0 + ZS(KP) = sin(TT)*SOB + ZC(KP) = sqrt(1.0-ZS(KP)**2) + + ! Integrate orbit for entire leap cycle using Runge-Kutta + + do K=2,DAYS_PER_CYCLE + T1 = FUN(TT ) + T2 = FUN(TT+T1*0.5) + T3 = FUN(TT+T2*0.5) + T4 = FUN(TT+T3 ) + KP = mod(KP,DAYS_PER_CYCLE) + 1 + TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 + ZS(KP) = sin(TT)*SOB + ZC(KP) = sqrt(1.0-ZS(KP)**2) + end do + + end subroutine orbit_create + +! ***************************************************************************** + +! function to_radian(degree) result(rad) +! +! ! degrees to radians +! real,intent(in) :: degree +! real :: rad +! +! rad = degree*MAPL_PI/180. +! +! end function to_radian +! +! ! ***************************************************************************** +! +! real function haversine(deglat1,deglon1,deglat2,deglon2) +! ! great circle distance -- adapted from Matlab +! real,intent(in) :: deglat1,deglon1,deglat2,deglon2 +! real :: a,c, dlat,dlon,lat1,lat2 +! real,parameter :: radius = MAPL_radius +! +!! dlat = to_radian(deglat2-deglat1) +!! dlon = to_radian(deglon2-deglon1) +! ! lat1 = to_radian(deglat1) +!! lat2 = to_radian(deglat2) +! dlat = deglat2-deglat1 +! dlon = deglon2-deglon1 +! lat1 = deglat1 +! lat2 = deglat2 +! a = (sin(dlat/2))**2 + cos(lat1)*cos(lat2)*(sin(dlon/2))**2 +! if(a>=0. .and. a<=1.) then +! c = 2*atan2(sqrt(a),sqrt(1-a)) +! haversine = radius*c / 1000. +! else +! haversine = 1.e20 +! endif +! end function +! +! ! ---------------------------------------------------------------------- + + integer function VarID (NCFID, VNAME) + + integer, intent (in) :: NCFID + character(*), intent (in) :: VNAME + integer :: status + + STATUS = NF_INQ_VARID (NCFID, trim(VNAME) ,VarID) + IF (STATUS .NE. NF_NOERR) & + CALL HANDLE_ERR(STATUS, trim(VNAME)) + + end function VarID +! ! ----------------------------------------------------------------------------- +! + + FUNCTION StrUpCase ( Input_String ) RESULT ( Output_String ) + ! -- Argument and result + CHARACTER( * ), INTENT( IN ) :: Input_String + CHARACTER( LEN( Input_String ) ) :: Output_String + ! -- Local variables + INTEGER :: i, n + + + ! -- Copy input string + Output_String = Input_String + ! -- Loop over string elements + DO i = 1, LEN( Output_String ) + ! -- Find location of letter in lower case constant string + n = INDEX( LOWER_CASE, Output_String( i:i ) ) + ! -- If current substring is a lower case letter, make it upper case + IF ( n /= 0 ) Output_String( i:i ) = UPPER_CASE( n:n ) + END DO + END FUNCTION StrUpCase + + ! ----------------------------------------------------------------------------- + + FUNCTION StrLowCase ( Input_String ) RESULT ( Output_String ) + ! -- Argument and result + CHARACTER( * ), INTENT( IN ) :: Input_String + CHARACTER( LEN( Input_String ) ) :: Output_String + ! -- Local variables + INTEGER :: i, n + + ! -- Copy input string + Output_String = Input_String + ! -- Loop over string elements + DO i = 1, LEN( Output_String ) + ! -- Find location of letter in upper case constant string + n = INDEX( UPPER_CASE, Output_String( i:i ) ) + ! -- If current substring is an upper case letter, make it lower case + IF ( n /= 0 ) Output_String( i:i ) = LOWER_CASE( n:n ) + END DO + END FUNCTION StrLowCase + + ! ----------------------------------------------------------------------------- + + FUNCTION StrExtName ( Input_String ) RESULT ( Output_String ) + ! -- Argument and result + CHARACTER( * ), INTENT( IN ) :: Input_String + CHARACTER( LEN( Input_String ) ) :: Output_String + ! -- Local variables + INTEGER :: i, n1, n2, n3, n4, n5, n, k + + ! -- Copy input string + ! Output_String = Input_String + ! -- Loop over string elements + + k = 1 + + DO i = 1, LEN( Input_String ) + + ! -- Find location of letter in upper case constant string + n1 = INDEX( UPPER_CASE, Input_String( i:i ) ) + n2 = INDEX( LOWER_CASE, Input_String( i:i ) ) + n3 = INDEX( '.', Input_String( i:i ) ) + n4 = INDEX( '-', Input_String( i:i ) ) + n5 = INDEX( '_', Input_String( i:i ) ) + + n = 0 + Output_String(i:i) = '' + + if (n1 /= 0) n = n1 + if (n2 /= 0) n = n2 + if (n3 /= 0) n = n3 + if (n4 /= 0) n = n4 + if (n5 /= 0) n = n5 + + ! -- If current substring is acceptable + IF ( n /= 0 ) then + Output_String( k:k ) = Input_String( i:i ) + k = k + 1 + endif + + END DO + + END FUNCTION StrExtName + + ! ---------------------------------------------------------------------------- + + SUBROUTINE write_bin (unit, InFmt, NTILES) + + implicit none + integer :: ntiles + integer :: unit + type(Netcdf4_FileFormatter) :: InFmt + + + real :: bf1(ntiles) + real :: bf2(ntiles) + real :: bf3(ntiles) + real :: vgwmax(ntiles) + real :: cdcr1(ntiles) + real :: cdcr2(ntiles) + real :: psis(ntiles) + real :: bee(ntiles) + real :: poros(ntiles) + real :: wpwet(ntiles) + real :: cond(ntiles) + real :: gnu(ntiles) + real :: ars1(ntiles) + real :: ars2(ntiles) + real :: ars3(ntiles) + real :: ara1(ntiles) + real :: ara2(ntiles) + real :: ara3(ntiles) + real :: ara4(ntiles) + real :: arw1(ntiles) + real :: arw2(ntiles) + real :: arw3(ntiles) + real :: arw4(ntiles) + real :: tsa1(ntiles) + real :: tsa2(ntiles) + real :: tsb1(ntiles) + real :: tsb2(ntiles) + real :: atau(ntiles) + real :: btau(ntiles) + real :: ity(ntiles) + real :: tc(ntiles,4) + real :: qc(ntiles,4) + real :: capac(ntiles) + real :: catdef(ntiles) + real :: rzexc(ntiles) + real :: srfexc(ntiles) + real :: ghtcnt1(ntiles) + real :: ghtcnt2(ntiles) + real :: ghtcnt3(ntiles) + real :: ghtcnt4(ntiles) + real :: ghtcnt5(ntiles) + real :: ghtcnt6(ntiles) + real :: tsurf(ntiles) + real :: wesnn1(ntiles) + real :: wesnn2(ntiles) + real :: wesnn3(ntiles) + real :: htsnnn1(ntiles) + real :: htsnnn2(ntiles) + real :: htsnnn3(ntiles) + real :: sndzn1(ntiles) + real :: sndzn2(ntiles) + real :: sndzn3(ntiles) + real :: ch(ntiles,4) + real :: cm(ntiles,4) + real :: cq(ntiles,4) + real :: fr(ntiles,4) + real :: ww(ntiles,4) + + call MAPL_VarRead(InFmt,"BF1",bf1) + call MAPL_VarRead(InFmt,"BF2",bf2) + call MAPL_VarRead(InFmt,"BF3",bf3) + call MAPL_VarRead(InFmt,"VGWMAX",vgwmax) + call MAPL_VarRead(InFmt,"CDCR1",cdcr1) + call MAPL_VarRead(InFmt,"CDCR2",cdcr2) + call MAPL_VarRead(InFmt,"PSIS",psis) + call MAPL_VarRead(InFmt,"BEE",bee) + call MAPL_VarRead(InFmt,"POROS",poros) + call MAPL_VarRead(InFmt,"WPWET",wpwet) + call MAPL_VarRead(InFmt,"COND",cond) + call MAPL_VarRead(InFmt,"GNU",gnu) + call MAPL_VarRead(InFmt,"ARS1",ars1) + call MAPL_VarRead(InFmt,"ARS2",ars2) + call MAPL_VarRead(InFmt,"ARS3",ars3) + call MAPL_VarRead(InFmt,"ARA1",ara1) + call MAPL_VarRead(InFmt,"ARA2",ara2) + call MAPL_VarRead(InFmt,"ARA3",ara3) + call MAPL_VarRead(InFmt,"ARA4",ara4) + call MAPL_VarRead(InFmt,"ARW1",arw1) + call MAPL_VarRead(InFmt,"ARW2",arw2) + call MAPL_VarRead(InFmt,"ARW3",arw3) + call MAPL_VarRead(InFmt,"ARW4",arw4) + call MAPL_VarRead(InFmt,"TSA1",tsa1) + call MAPL_VarRead(InFmt,"TSA2",tsa2) + call MAPL_VarRead(InFmt,"TSB1",tsb1) + call MAPL_VarRead(InFmt,"TSB2",tsb2) + call MAPL_VarRead(InFmt,"ATAU",atau) + call MAPL_VarRead(InFmt,"BTAU",btau) + call MAPL_VarRead(InFmt,"OLD_ITY",ity) + call MAPL_VarRead(InFmt,"TC",tc) + call MAPL_VarRead(InFmt,"QC",qc) + call MAPL_VarRead(InFmt,"OLD_ITY",ity) + call MAPL_VarRead(InFmt,"CAPAC",capac) + call MAPL_VarRead(InFmt,"CATDEF",catdef) + call MAPL_VarRead(InFmt,"RZEXC",rzexc) + call MAPL_VarRead(InFmt,"SRFEXC",srfexc) + call MAPL_VarRead(InFmt,"GHTCNT1",ghtcnt1) + call MAPL_VarRead(InFmt,"GHTCNT2",ghtcnt2) + call MAPL_VarRead(InFmt,"GHTCNT3",ghtcnt3) + call MAPL_VarRead(InFmt,"GHTCNT4",ghtcnt4) + call MAPL_VarRead(InFmt,"GHTCNT5",ghtcnt5) + call MAPL_VarRead(InFmt,"GHTCNT6",ghtcnt6) + call MAPL_VarRead(InFmt,"TSURF",tsurf) + call MAPL_VarRead(InFmt,"WESNN1",wesnn1) + call MAPL_VarRead(InFmt,"WESNN2",wesnn2) + call MAPL_VarRead(InFmt,"WESNN3",wesnn3) + call MAPL_VarRead(InFmt,"HTSNNN1",htsnnn1) + call MAPL_VarRead(InFmt,"HTSNNN2",htsnnn2) + call MAPL_VarRead(InFmt,"HTSNNN3",htsnnn3) + call MAPL_VarRead(InFmt,"SNDZN1",sndzn1) + call MAPL_VarRead(InFmt,"SNDZN2",sndzn2) + call MAPL_VarRead(InFmt,"SNDZN3",sndzn3) + call MAPL_VarRead(InFmt,"CH",ch) + call MAPL_VarRead(InFmt,"CM",cm) + call MAPL_VarRead(InFmt,"CQ",cq) + call MAPL_VarRead(InFmt,"FR",fr) + call MAPL_VarRead(InFmt,"WW",ww) + + write(unit) bf1 + write(unit) bf2 + write(unit) bf3 + write(unit) vgwmax + write(unit) cdcr1 + write(unit) cdcr2 + write(unit) psis + write(unit) bee + write(unit) poros + write(unit) wpwet + write(unit) cond + write(unit) gnu + write(unit) ars1 + write(unit) ars2 + write(unit) ars3 + write(unit) ara1 + write(unit) ara2 + write(unit) ara3 + write(unit) ara4 + write(unit) arw1 + write(unit) arw2 + write(unit) arw3 + write(unit) arw4 + write(unit) tsa1 + write(unit) tsa2 + write(unit) tsb1 + write(unit) tsb2 + write(unit) atau + write(unit) btau + write(unit) ity + write(unit) tc + write(unit) qc + write(unit) capac + write(unit) catdef + write(unit) rzexc + write(unit) srfexc + write(unit) ghtcnt1 + write(unit) ghtcnt2 + write(unit) ghtcnt3 + write(unit) ghtcnt4 + write(unit) ghtcnt5 + write(unit) ghtcnt6 + write(unit) tsurf + write(unit) wesnn1 + write(unit) wesnn2 + write(unit) wesnn3 + write(unit) htsnnn1 + write(unit) htsnnn2 + write(unit) htsnnn3 + write(unit) sndzn1 + write(unit) sndzn2 + write(unit) sndzn3 + write(unit) ch + write(unit) cm + write(unit) cq + write(unit) fr + write(unit) ww + + END SUBROUTINE write_bin + + ! ---------------------------------------------------------------------------- + + SUBROUTINE read_ldas_restarts (NTILES, ntiles_rst, id_glb, ld_reorder, rst_file, pfile) + + implicit none + integer, intent (in) :: NTILES, ntiles_rst + integer, intent (in) :: id_glb(NTILES), ld_reorder (ntiles_rst) + integer :: k + character(*), intent (in) :: rst_file, pfile + real , dimension (:), allocatable :: var_get, var_put + type(Netcdf4_FileFormatter) :: OutFmt, InFmt + type(FileMetadata) :: meta_data + + allocate (var_get (NTILES_RST)) + allocate (var_put (NTILES)) + + call InFmt%Open(trim(InCatRestart), pFIO_READ, rc=rc) + meta_data = InFmt%read(rc=rc) + call InFmt%close() + call meta_data%modify_dimension('tile', ntiles, rc=rc) + + OutFileName = "OutData1/catch_internal_rst" + call OutFmt%create(OutFileName, rc=rc) + call OutFmt%write(meta_data, rc=rc) + + open(10, file=trim(rst_file), form='unformatted', status='old', & + convert='big_endian', action='read') + + read (10) var_get ! (cat_progn(n)%tc1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TC',var_put, offset1=1) + + read (10) var_get ! (cat_progn(n)%tc2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TC',var_put, offset1=2) + + read (10) var_get ! (cat_progn(n)%tc4, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TC',var_put, offset1=3) + + read (10) var_get ! (cat_progn(n)%qa1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'QC',var_put, offset1=1) + + read (10) var_get ! (cat_progn(n)%qa2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'QC',var_put, offset1=2) + + read (10) var_get ! (cat_progn(n)%qa4, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'QC',var_put, offset1=3) + call MAPL_VarWrite(OutFmt,'QC',var_put, offset1=4) + + read (10) var_get ! (cat_progn(n)%capac, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CAPAC',var_put) + + read (10) var_get ! (cat_progn(n)%catdef, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CATDEF',var_put) + + read (10) var_get ! (cat_progn(n)%rzexc, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'RZEXC',var_put) + + read (10) var_get ! (cat_progn(n)%srfexc, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SRFEXC',var_put) + + read (10) var_get ! (cat_progn(n)%ght(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT1',var_put) + read (10) var_get ! (cat_progn(n)%ght(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT2',var_put) + read (10) var_get ! (cat_progn(n)%ght(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT3',var_put) + read (10) var_get ! (cat_progn(n)%ght(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT4',var_put) + read (10) var_get ! (cat_progn(n)%ght(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT5',var_put) + read (10) var_get ! (cat_progn(n)%ght(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GHTCNT6',var_put) + + read (10) var_get !(cat_progn(n)%wesn(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WESNN1',var_put) + read (10) var_get !(cat_progn(n)%wesn(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WESNN2',var_put) + read (10) var_get !(cat_progn(n)%wesn(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WESNN3',var_put) + + read (10) var_get !(cat_progn(n)%htsn(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN1',var_put) + read (10) var_get !(cat_progn(n)%htsn(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN2',var_put) + read (10) var_get !(cat_progn(n)%htsn(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'HTSNNN3',var_put) + + read (10) var_get !(cat_progn(n)%sndz(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SNDZN1',var_put) + read (10) var_get !(cat_progn(n)%sndz(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SNDZN2',var_put) + read (10) var_get !(cat_progn(n)%sndz(k), n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'SNDZN3',var_put) + + close (10) + +! PARAM + + open(10, file=trim(pfile), form='unformatted', status='old', & + convert='big_endian', action='read') + + + read (10) var_get !(cat_param(n)%dpth, n=1,N_catd) + + read (10) var_get !(cat_param(n)%dzsf, n=1,N_catd) + read (10) var_get !(cat_param(n)%dzrz, n=1,N_catd) + read (10) var_get !(cat_param(n)%dzpr, n=1,N_catd) + + do k=1,6 + read (10) var_get !(cat_param(n)%dzgt(k), n=1,N_catd) + end do + do k = 1, NTILES + VAR_PUT(k) = id_glb(k) + end do + call MAPL_VarWrite(OutFmt,'TILE_ID',var_put) + + read (10) var_get !(cat_param(n)%poros, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'POROS',var_put) + + read (10) var_get !(cat_param(n)%cond, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'COND',var_put) + + read (10) var_get !(cat_param(n)%psis, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'PSIS',var_put) + + read (10) var_get !(cat_param(n)%bee, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BEE',var_put) + + read (10) var_get !(cat_param(n)%wpwet, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'WPWET',var_put) + + read (10) var_get !(cat_param(n)%gnu, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'GNU',var_put) + + read (10) var_get !(cat_param(n)%vgwmax, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'VGWMAX',var_put) + + read (10) var_get !(cat_param(n)%vegcls, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'OLD_ITY',var_put) + + read (10) var_get !(cat_param(n)%soilcls30, n=1,N_catd) + read (10) var_get !(cat_param(n)%soilcls100, n=1,N_catd) + + read (10) var_get !(cat_param(n)%bf1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BF1',var_put) + + read (10) var_get !(cat_param(n)%bf2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BF2',var_put) + + read (10) var_get !(cat_param(n)%bf3, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BF3',var_put) + + read (10) var_get !(cat_param(n)%cdcr1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CDCR1',var_put) + + read (10) var_get !(cat_param(n)%cdcr2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'CDCR2',var_put) + + read (10) var_get !(cat_param(n)%ars1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARS1',var_put) + + read (10) var_get !(cat_param(n)%ars2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARS2',var_put) + + read (10) var_get !(cat_param(n)%ars3, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARS3',var_put) + + read (10) var_get !(cat_param(n)%ara1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA1',var_put) + + read (10) var_get !(cat_param(n)%ara2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA2',var_put) + + read (10) var_get !(cat_param(n)%ara3, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA3',var_put) + + read (10) var_get !(cat_param(n)%ara4, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARA4',var_put) + + read (10) var_get !(cat_param(n)%arw1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW1',var_put) + + read (10) var_get !(cat_param(n)%arw2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW2',var_put) + + read (10) var_get !(cat_param(n)%arw3, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW3',var_put) + + read (10) var_get !(cat_param(n)%arw4, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ARW4',var_put) + + read (10) var_get !(cat_param(n)%tsa1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSA1',var_put) + + read (10) var_get !(cat_param(n)%tsa2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSA2',var_put) + + read (10) var_get !(cat_param(n)%tsb1, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSB1',var_put) + + read (10) var_get !(cat_param(n)%tsb2, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'TSB2',var_put) + + read (10) var_get !(cat_param(n)%atau, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'ATAU',var_put) + + read (10) var_get !(cat_param(n)%btau, n=1,N_catd) + do k = 1, NTILES + VAR_PUT(k) = var_get(ld_reorder(id_glb(k))) + end do + call MAPL_VarWrite(OutFmt,'BTAU',var_put) + + read (10) var_get !(cat_param(n)%gravel30, n=1,N_catd) + read (10) var_get !(cat_param(n)%orgC30 , n=1,N_catd) + read (10) var_get !(cat_param(n)%orgC , n=1,N_catd) + read (10) var_get !(cat_param(n)%sand30 , n=1,N_catd) + read (10) var_get !(cat_param(n)%clay30 , n=1,N_catd) + read (10) var_get !(cat_param(n)%sand , n=1,N_catd) + read (10) var_get !(cat_param(n)%clay , n=1,N_catd) + read (10) var_get !(cat_param(n)%wpwet30 , n=1,N_catd) + read (10) var_get !(cat_param(n)%poros30 , n=1,N_catd) + + close (10, status = 'keep') + deallocate (var_get, var_put) + + call OutFmt%close() + + call system('/bin/cp OutData1/catch_internal_rst OutData2/catch_internal_rst') + + END SUBROUTINE read_ldas_restarts + + ! ----------------------------------------------------------------------------- + +!----------------------------------------------- +! copy paset from getids.H under mk_restars in catchGrid Comp +! ----------------------------------------------------------------------------------- +! +subroutine ReadTileFile(Tf,Pf,Id,lon,lat,mask) + character*(*), intent(IN) :: Tf + integer, pointer :: Pf(:), Id(:), lon(:), lat(:) + integer, optional, intent(IN) :: mask + + integer, allocatable :: Pf1(:), Id1(:), ln1(:), lt1(:) + integer :: k, i, nt, pfs, ids,n,msk, umask + real :: dum(4),dum1,lnn,ltt + integer :: de, ce, st + logical :: old + + de=180*zoom + ce=360*zoom + st=2*zoom + if(present(mask)) then + umask = mask + else + umask = 100 + endif + + print *, "Reading tilefile ",trim(Tf) + + open(unit=20,file=trim(Tf),form='formatted') + + read(20,*,iostat=n) Nt,i,k + old=n<0 + close(20) + + open(unit=20,file=trim(Tf),form='formatted') + + read(20,*) Nt + + do i=1,7 + read(20,*) + enddo + + allocate(Pf1(Nt),Id1(Nt),ln1(Nt),lt1(Nt)) + + n=0 + do i=1,Nt + if(old) then + read(20,*,end=200) msk, Pfs, lnn, ltt + ids = 0 + else + read(20,*,end=200) msk, dum1, lnn, ltt, dum, Pfs, Ids + end if + if(msk/=umask) cycle + n = n+1 + pf1(n) = pfs + Id1(n) = ids + ln1(n) = nint(lnn*zoom) + Lt1(n)=max(min(nint(ltt*zoom),90*zoom),-90*zoom) + if(ln1(n)<-de) ln1(n) = ln1(n) + ce + if(ln1(n)> de) ln1(n) = ln1(n) - ce + enddo + +200 continue + + close(20) + + Nt=n + print *, "Found ",nt," land tiles." + + allocate(Pf(Nt),Id(Nt),lon(Nt),lat(Nt)) + Pf = Pf1(:Nt) + Id = Id1(:Nt) + lon = ln1(:Nt) + lat = lt1(:Nt) + deallocate(Pf1,Id1,ln1,lt1) + + return +end subroutine ReadTileFile + +subroutine GetStencil(ii,jj,st) + integer, intent(OUT) :: ii(0:), jj(0:) + integer, intent( IN) :: st + + integer :: n, i, j, iz, jz, di, dj + + n=-1 + do i=0,st + di = 0 + dj = 1 + jz = 0 + iz = i + n = n+1 + ii(n) = iz + jj(n) = jz + + do k=1,8*i-1 + if (iz==i.and.jz==-i) then + di = 0 + dj = 1 + elseif(iz==i.and.jz==i) then + di = -1 + dj = 0 + elseif(iz==-i.and.jz==i) then + di = 0 + dj = -1 + elseif(iz==-i.and.jz==-i) then + di = 1 + dj = 0 + endif + + iz = iz + di + jz = jz + dj + + if(jz==0 .and. iz == i) exit + n = n+1 + ii(n) = iz + jj(n) = jz + end do + end do + +! print *, 'ii = ',ii +! print * +! print *, 'jj = ',jj + +end subroutine GetStencil + + ! ***************************************************************************** + +subroutine GetIds_fast_1p (loni,lati,lon,lat,Id) + integer, dimension(:), intent( IN) :: loni,lati,lon,lat + integer, dimension(:), intent(OUT) :: Id + + integer, allocatable :: Idx(:) + integer :: i, k, l, last, iex, lonx, hash + integer, allocatable :: ii(:) + integer, allocatable :: jj(:) + integer :: jx(7) =(/0,1,-1,2,-2,3,-3/) + integer, allocatable :: ix(:) + logical :: found + integer :: de, ce, st + + de=180*zoom + ce=360*zoom + st=2*zoom + allocate(ix(ce),ii(0:(2*st+1)**2-1),jj(0:(2*st+1)**2-1)) + Hash = MAPL_HashCreate(8*1024) + + n = 1 + do i=1,ce-1,2 + ix(i ) = n + ix(i+1) = -n + n=n+1 + end do + + call GetStencil(ii,jj,st) + + allocate(Idx(size(loni))) + + do i=1,size(loni) + k = MAPL_HashIncrement(Hash,loni(i),lati(i)) + idx(k) = i + end do + + last = MAPL_HashSize(HASH) + + iex = 0 + + do i=1,size(lon) +! k = MAPL_HashIncrement(Hash,lon(i),lat(i)) +! if (k>last) then + do n=0,size(ii)-1 + lonx=lon(i)+ii(n) + if(lonx<-de)lonx=lonx+ce + if(lonx> de)lonx=lonx-ce + k = MAPL_HashIncrement(Hash,lonx,lat(i)+jj(n)) + if(k<=last) exit + end do + if (k>last) then + iex = iex + 1 + found=.false. + do l=1,7 + do n=1,ce + lonx=lon(i)+ix(n) + if(lonx<-de)lonx=lonx+ce + if(lonx> de)lonx=lonx-ce + lonx=lon(i)+ix(n) + k = MAPL_HashIncrement(Hash,lonx,lat(i)+jx(l)) + if(k<=last) then + found=.true. + exit + end if + end do + if(found) exit + end do + if(k>last) then + print *, 'Failed to find valid data for tile ',i, k, InRestart + print *, 'Thus using last' + k = last + endif + end if +! end if + Id(i) = Idx(k) + enddo + + deallocate(Idx,ix,ii,jj) + + print *, 'Used extreme measures ', iex, ' times' + print * + + end subroutine GetIds_fast_1p + + ! ***************************************************************************** + + subroutine GetIds_accurate_mpi (loni,lati,lono,lato,Id, tid_in) + + implicit none + + integer :: NT_IN, NT_OUT, n, i, nplus + real, dimension (:), intent (in) :: loni,lati,lono,lato + integer, dimension (:), intent (in) :: tid_in + integer, dimension (:), intent (inout) :: id + + logical :: tile_found + logical, allocatable, dimension(:) :: mask + integer, allocatable, dimension (:) :: sub_tid + real , allocatable, dimension (:) :: sub_lon, sub_lat, rev_dist + real :: dw, dx, dy, min_lon, max_lon, min_lat, max_lat + + NT_IN = SIZE (loni) + NT_OUT = SIZE (lono) + + allocate (mask (1: NT_IN)) + + Id = -9999 + + OUT_TILES : do n = 1, NT_OUT + + dw = 0.5 + + ZOOMOUT : do + + tile_found = .false. + + ! Min/Max lon/lat of the working window + ! ------------------------------------- + + min_lon = MAX(lono (n) - dw, -180.) + max_lon = MIN(lono (n) + dw, 180.) + min_lat = MAX(lato (n) - dw, -90.) + max_lat = MIN(lato (n) + dw, 90.) + + mask = .false. + mask = ((lati >= min_lat .and. lati <= max_lat).and.(loni >= min_lon .and. loni <= max_lon)) + nplus = count(mask = mask) + + if(nplus < 0) then + dw = dw + 0.5 + CYCLE + endif + + allocate (sub_tid (1:nplus)) + allocate (sub_lon (1:nplus)) + allocate (sub_lat (1:nplus)) + allocate (rev_dist (1:nplus)) + + sub_tid = PACK (tid_in , mask= mask) + sub_lon = PACK (loni , mask= mask) + sub_lat = PACK (lati , mask= mask) + + ! compute distance from the tile + + sub_lat = sub_lat * MAPL_PI/180. + sub_lon = sub_lon * MAPL_PI/180. + + SEEK : if(Id (n) < 0) then + + rev_dist = 1.e20 + + do i = 1,nplus + + rev_dist(i) = haversine(to_radian(lato(n)), to_radian(lono(n)), & + sub_lat(i), sub_lon(i)) + + end do + + FOUND : if(minval (rev_dist) < 1.e19) then + Id (n) = sub_tid(minloc(rev_dist,1)) + tile_found = .true. + endif FOUND + + endif SEEK + + deallocate (sub_tid, sub_lon, sub_lat, rev_dist) + + if(tile_found) GO TO 100 + + ! if not increase the window size + dw = dw + 0.5 + + end do ZOOMOUT + +100 continue + + if(mod (n,10000) == 0) print *, id(n), loni(id(n)), lono(n), lati(id(n)), lato(n) + END do OUT_TILES + + deallocate (mask) + + end subroutine GetIds_accurate_mpi + + ! ***************************************************************************** + + subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & + CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & + fveg_offl, ityp_offl) + + implicit none + integer, parameter :: npft = 19 + integer, parameter :: nveg = 4 + real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value + integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) + integer :: NT_IN, NT_OUT, n, i, nplus,nv, nx, ityp_new + integer, dimension (:), intent (in) :: tid_in + integer, dimension (:,:), intent (inout) :: id + real, dimension (:), intent (in) :: loni,lati,lono,lato + real, dimension (:), intent (in) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & + CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2 + real, dimension(:,:), intent (in) :: fveg_offl, ityp_offl + logical :: tile_found + logical, allocatable, dimension (:) :: mask + integer, allocatable, dimension (:) :: sub_tid + real , allocatable, dimension (:) :: sub_lon, sub_lat, rev_dist, sub_fevg1, sub_fevg2 + integer, allocatable, dimension (:) :: sub_ityp1, sub_ityp2,icl_ityp1 + real :: dw, dx, dy, min_lon, max_lon, min_lat, max_lat, fveg_new, sub_dist + + NT_IN = SIZE (loni) + NT_OUT = SIZE (lono) + + allocate (mask (1: NT_IN)) + + Id = -9999 + + OUT_TILES : do n = 1, NT_OUT + + dw = 0.5 + + ZOOMOUT : do + + tile_found = .false. + + ! Min/Max lon/lat of the working window + ! ------------------------------------- + + min_lon = MAX(lono (n) - dw, -180.) + max_lon = MIN(lono (n) + dw, 180.) + min_lat = MAX(lato (n) - dw, -90.) + max_lat = MIN(lato (n) + dw, 90.) + + mask = .false. + mask = ((lati >= min_lat .and. lati <= max_lat).and.(loni >= min_lon .and. loni <= max_lon)) + nplus = count(mask = mask) + + if(nplus < 0) then + dw = dw + 0.5 + CYCLE + endif + + allocate (sub_tid (1:nplus)) + allocate (sub_lon (1:nplus)) + allocate (sub_lat (1:nplus)) + allocate (rev_dist (1:nplus)) + allocate (sub_ityp1 (1:nplus)) + allocate (sub_fevg1 (1:nplus)) + allocate (sub_ityp2 (1:nplus)) + allocate (sub_fevg2 (1:nplus)) + allocate (icl_ityp1 (1:nplus)) + + sub_tid = PACK (tid_in , mask= mask) + sub_lon = PACK (loni , mask= mask) + sub_lat = PACK (lati , mask= mask) + + ! compute distance from the tile + + sub_lat = sub_lat * MAPL_PI/180. + sub_lon = sub_lon * MAPL_PI/180. + + NV_LOOP: do nv = 1, nveg + + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_pt2(n) + if (nv == 2) fveg_new = CLMC_pf2(n) + if (nv == 3) ityp_new = CLMC_st1(n) + if (nv == 3) fveg_new = CLMC_sf1(n) + if (nv == 4) ityp_new = CLMC_st2(n) + if (nv == 4) fveg_new = CLMC_sf2(n) + + SEEK : if((Id (n, nv) < 0).and.(fveg_new > fmin)) then + + if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary + nx = nv + 2 + else + nx = nv - 2 + endif + + sub_ityp1 = ityp_offl (sub_tid,nv) + sub_fevg1 = fveg_offl (sub_tid,nv) + sub_ityp2 = ityp_offl (sub_tid,nx) + sub_fevg2 = fveg_offl (sub_tid,nx) + + rev_dist = 1.e20 + icl_ityp1 = iclass(sub_ityp1) + + do i = 1,nplus + if((sub_ityp1(i)>fmin .and. (ityp_new ==sub_ityp1(i) .or. & + iclass(ityp_new) ==iclass(sub_ityp1(i)))) .or. & + (sub_fevg2(i)>fmin .and. (ityp_new ==sub_ityp2(i) .or. & + iclass(ityp_new)==iclass(sub_ityp2(i))))) then + + sub_dist = haversine(to_radian(lato(n)), to_radian(lono(n)), & + sub_lat(i), sub_lon(i)) + + if(ityp_new == sub_ityp1(i) .and. sub_fevg1(i) >fmin) then + rev_dist(i) = 1.*sub_dist ! give priority to same (primary if primary, secondary if secondary) + ! gkw: these weights are tunable + else if(ityp_new ==sub_ityp2(i) .and. sub_fevg2(i)>fmin) then + rev_dist(i) = 2.*sub_dist ! lower priority if not same (secondary if primary, primary if secondary) + else if(iclass(ityp_new)==iclass(sub_ityp1(i)) .and. sub_fevg1(i)>fmin) then + rev_dist(i) = 3.*sub_dist ! even lower priority if same of some other PFT in same class + else if(sub_fevg2(i)>fmin) then + rev_dist(i) = 4.*sub_dist ! even lower priority if not same of some other PFT in same class + else + rev_dist(i) = 1.e20 + endif + endif + + end do + + FOUND : if(minval (rev_dist) < 1.e19) then + Id (n, nv) = sub_tid(minloc(rev_dist,1)) + + endif FOUND + + endif SEEK + end do NV_LOOP + + deallocate (sub_tid, sub_lon, sub_lat, icl_ityp1) + deallocate (sub_ityp1, sub_fevg1, sub_ityp2, sub_fevg2, rev_dist) + + tile_found = .true. + if((tile_found).and.((CLMC_pf1(n) > fmin).and.(Id(n,1) < 0))) tile_found = .false. + if((tile_found).and.((CLMC_pf2(n) > fmin).and.(Id(n,2) < 0))) tile_found = .false. + if((tile_found).and.((CLMC_sf1(n) > fmin).and.(Id(n,3) < 0))) tile_found = .false. + if((tile_found).and.((CLMC_sf2(n) > fmin).and.(Id(n,4) < 0))) tile_found = .false. + + if(tile_found) GO TO 100 + + ! if not increase the window size + dw = dw + 0.5 + + end do ZOOMOUT + +100 continue + +! if(mod (n,10000) == 0) print *, id(n), loni(id(n)), lono(n), lati(id(n)), lato(n) + END do OUT_TILES + + deallocate (mask) + + end subroutine GetIds_carbon + + ! ***************************************************************************** + + function to_radian(degree) result(rad) + + ! degrees to radians + real,intent(in) :: degree + real :: rad + + rad = degree*MAPL_PI/180. + + end function to_radian + + ! ***************************************************************************** + + real function haversine(deglat1,deglon1,deglat2,deglon2) + ! great circle distance -- adapted from Matlab + real,intent(in) :: deglat1,deglon1,deglat2,deglon2 + real :: a,c, dlat,dlon,lat1,lat2 + real,parameter :: radius = MAPL_radius + +! dlat = to_radian(deglat2-deglat1) +! dlon = to_radian(deglon2-deglon1) + ! lat1 = to_radian(deglat1) +! lat2 = to_radian(deglat2) + dlat = deglat2-deglat1 + dlon = deglon2-deglon1 + lat1 = deglat1 + lat2 = deglat2 + a = (sin(dlat/2))**2 + cos(lat1)*cos(lat2)*(sin(dlon/2))**2 + if(a>=0. .and. a<=1.) then + c = 2*atan2(sqrt(a),sqrt(1-a)) + haversine = radius*c / 1000. + else + haversine = 1.e20 + endif + end function + + ! ***************************************************************************** + + subroutine ReadCNTilFile (InCNTileFile, ntiles, xlon, xlat,mask) + + implicit none + character(*), intent (in) :: InCNTileFile + integer , intent (inout) :: ntiles + real, pointer, dimension (:) :: xlon, xlat + integer, optional, intent(IN) :: mask + integer :: n,icnt,ityp, nt, umask, i + real :: xval,yval, pf + real, allocatable :: ln1(:), lt1(:) + + if(present(mask)) then + umask = mask + else + umask = 100 + endif + + open(11,file=InCNTileFile, & + form='formatted',action='read',status='old') + read (11,*, iostat=n) Nt + + allocate(ln1(Nt),lt1(Nt)) + + do n = 1,7 ! skip header + read(11,*) + end do + + icnt = 0 + + do i=1,Nt + read(11,*) ityp,pf,xval,yval + if(ityp == umask) then + icnt = icnt + 1 + ln1(icnt) = xval + Lt1(icnt) = yval + endif + end do + + close(11) + + Ntiles = icnt + if(.not.associated (xlon)) allocate(xlon(Ntiles)) + if(.not.associated (xlat)) allocate(xlat(Ntiles)) + xlon = ln1(:Ntiles) + xlat = lt1(:Ntiles) + + end subroutine ReadCNTilFile + + + END PROGRAM mk_GEOSldasRestarts diff --git a/src/Applications/LDAS_App/preprocess_ldas.F90 b/src/Applications/LDAS_App/preprocess_ldas.F90 index 54397f1c..69bb4678 100644 --- a/src/Applications/LDAS_App/preprocess_ldas.F90 +++ b/src/Applications/LDAS_App/preprocess_ldas.F90 @@ -26,6 +26,8 @@ module preprocess_module read_cat_param use LDAS_ensdrv_init_routines, only: io_domain_files use MAPL_IOMod + use gFTL_StringVector + use pFIO integer,parameter :: excluded_tile_typ_land=1100 end module @@ -522,8 +524,15 @@ subroutine createLocalCatchRestart(orig_catch, new_catch) integer :: n,istat, filetype, rc, nVars, i, j, ndims, dimSizes(3) real,allocatable :: tmp1(:) real,allocatable :: tmp2(:,:) - type(MAPL_NCIO) :: InNCIO, OutNCIO - character*256 :: vname + type(Netcdf4_FileFormatter) :: InFmt,OutFmt + type(FileMetadata) :: OutCfg + type(FileMetadata) :: InCfg + integer :: dim1,dim2 + type(StringVariableMap), pointer :: variables + type(Variable), pointer :: var + type(StringVariableMapIterator) :: var_iter + type(StringVector), pointer :: var_dimensions + character(len=:), pointer :: vname,dname integer :: N_catg,N_catf integer,dimension(:),allocatable :: f2g @@ -576,46 +585,62 @@ subroutine createLocalCatchRestart(orig_catch, new_catch) else ! filetype = 0 : nc4 output file will also be nc4 + + call InFmt%open(trim(orig_catch), pFIO_READ,rc=rc) + InCfg = InFmt%read(rc=rc) + OutCfg = InCfg + + call OutCfg%modify_dimension('tile', size(f2g), rc=rc) + + call OutFmt%create(trim(new_catch),rc=rc) + call OutFmt%write(OutCfg,rc=rc) + + variables => InCfg%get_variables() + var_iter = variables%begin() + do while (var_iter /= variables%end()) - InNCIO = MAPL_NCIOOpen(orig_catch,rc=rc) + vname => var_iter%key() + var => var_iter%value() + var_dimensions => var%get_dimensions() - call MAPL_NCIOGetDimSizes(InNCIO,nVars=nVars) - call MAPL_NCIOChangeRes(InNCIO,OutNCIO,tileSize=size(f2g),rc=rc) - call MAPL_NCIOSet( OutNCIO,filename=new_catch ) - call MAPL_NCIOCreateFile(OutNCIO) + ndims = var_dimensions%size() + + if (trim(vname) =='time') then + call var_iter%next() + cycle + endif - do n=1,nVars - - call MAPL_NCIOGetVarName(InNCIO,n,vname) - - call MAPL_NCIOVarGetDims(InNCIO,vname,nDims,dimSizes) if (ndims == 1) then - call MAPL_VarRead ( InNCIO,vname,tmp1) - call MAPL_VarWrite(OutNCIO,vname,tmp1(f2g)) - + call MAPL_VarRead (InFmt,vname,tmp1) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2g)) else if (ndims == 2) then - - do j=1,dimSizes(2) - call MAPL_VarRead ( InNCIO,vname,tmp1 ,offset1=j) - call MAPL_VarWrite(OutNCIO,vname,tmp1(f2g),offset1=j) + + dname => var%get_ith_dimension(2) + dim1=InCfg%get_dimension(dname) + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2g),offset1=j) enddo - + else if (ndims == 3) then - - do i=1,dimSizes(3) - do j=1,dimSizes(2) - call MAPL_VarRead ( InNCIO,vname,tmp1 ,offset1=j,offset2=i) - call MAPL_VarWrite(OutNCIO,vname,tmp1(f2g),offset1=j,offset2=i) - enddo - enddo - + + dname => var%get_ith_dimension(2) + dim1=InCfg%get_dimension(dname) + dname => var%get_ith_dimension(3) + dim2=InCfg%get_dimension(dname) + do i=1,dim2 + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j,offset2=i) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2g) ,offset1=j,offset2=i) + enddo + enddo + end if + call var_iter%next() enddo - - call MAPL_NCIOClose (InNCIO) - call MAPL_NCIOClose (OutNCIO) - - end if + call inFmt%close(rc=rc) + call OutFmt%close(rc=rc) + end if ! file type nc4 print*, "done create local catchment restart" end subroutine createLocalCatchRestart @@ -627,8 +652,13 @@ subroutine createLocalmwRTMRestart(orig_mwrtm, new_mwrtm) integer,parameter :: subtile=4 integer :: n,istat, filetype, rc, nVars, i, j, ndims, dimSizes(3) real,allocatable :: tmp1(:) - type(MAPL_NCIO) :: InNCIO, OutNCIO - character*256 :: vname + type(Netcdf4_FileFormatter) :: InFmt,OutFmt + type(FileMetadata) :: OutCfg + type(FileMetadata) :: InCfg + + type(StringVariableMap), pointer :: variables + type(StringVariableMapIterator) :: var_iter + character(len=:), pointer :: vname integer :: N_catg,N_catf integer,dimension(:),allocatable :: f2g @@ -640,26 +670,28 @@ subroutine createLocalmwRTMRestart(orig_mwrtm, new_mwrtm) allocate(tmp1(N_catg)) ! nc4 in and out file will also be nc4 - - InNCIO = MAPL_NCIOOpen(orig_mwrtm,rc=rc) - - call MAPL_NCIOGetDimSizes(InNCIO,nVars=nVars) - call MAPL_NCIOChangeRes(InNCIO,OutNCIO,tileSize=size(f2g),rc=rc) - call MAPL_NCIOSet( OutNCIO,filename=new_mwrtm ) - call MAPL_NCIOCreateFile(OutNCIO) - - do n=1,nVars - - call MAPL_NCIOGetVarName(InNCIO,n,vname) - - call MAPL_VarRead ( InNCIO,vname,tmp1) - call MAPL_VarWrite(OutNCIO,vname,tmp1(f2g)) - + call InFmt%open(trim(orig_mwrtm), pFIO_READ,rc=rc) + InCfg = InFmt%read(rc=rc) + OutCfg = InCfg + + call OutCfg%modify_dimension('tile', size(f2g), rc=rc) + + call OutFmt%create(trim(new_mwrtm),rc=rc) + call OutFmt%write(OutCfg,rc=rc) + + variables => InCfg%get_variables() + var_iter = variables%begin() + do while (var_iter /= variables%end()) + vname => var_iter%key() + call MAPL_VarRead (InFmt,vname,tmp1) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2g)) + call var_iter%next() enddo - call MAPL_NCIOClose (InNCIO) - call MAPL_NCIOClose (OutNCIO) - !deallocate(f2g,tmp1) + call inFmt%close(rc=rc) + call OutFmt%close(rc=rc) + + deallocate(f2g,tmp1) end subroutine createLocalmwRTMRestart @@ -672,10 +704,19 @@ subroutine createLocalVegRestart(orig_veg, new_veg) real,allocatable :: rity(:) real,allocatable :: z2(:) real,allocatable :: ascatz0(:) + real,allocatable :: tmp(:) integer :: N_catg,N_catf integer,dimension(:),allocatable :: f2g + integer :: filetype + type(Netcdf4_FileFormatter) :: InFmt,OutFmt + type(FileMetadata) :: OutCfg + type(FileMetadata) :: InCfg + type(StringVariableMap), pointer :: variables + type(StringVariableMapIterator) :: var_iter + character(len=:), pointer :: vname + integer :: rc call readsize(N_catg,N_catf) if(N_catg == N_catf) return @@ -685,17 +726,47 @@ subroutine createLocalVegRestart(orig_veg, new_veg) allocate(rity(N_catg)) allocate(z2(N_catg)) allocate(ascatz0(N_catg)) - open(10,file=trim(orig_veg),form='unformatted',action='read',status='old',iostat=istat) - open(20,file=trim(new_veg),form='unformatted',action='write') - read(10) rity - read(10) z2 - read(10) ascatz0 - write(20) rity(f2g) - write(20) z2(f2g) - write(20) ascatz0(f2g) - close(10) - close(20) + call MAPL_NCIOGetFileType(orig_veg, filetype,rc=rc) + + if (filetype /=0) then + open(10,file=trim(orig_veg),form='unformatted',action='read',status='old',iostat=istat) + open(20,file=trim(new_veg),form='unformatted',action='write') + read(10) rity + read(10) z2 + read(10) ascatz0 + write(20) rity(f2g) + write(20) z2(f2g) + write(20) ascatz0(f2g) + + close(10) + close(20) + else + ! nc4 in and out file will also be nc4 + call InFmt%open(trim(orig_veg), pFIO_READ,rc=rc) + InCfg = InFmt%read(rc=rc) + OutCfg = InCfg + + call OutCfg%modify_dimension('tile', size(f2g), rc=rc) + + call OutFmt%create(trim(new_veg),rc=rc) + call OutFmt%write(OutCfg,rc=rc) + + variables => InCfg%get_variables() + var_iter = variables%begin() + allocate(tmp(N_catg)) + do while (var_iter /= variables%end()) + vname => var_iter%key() + call MAPL_VarRead (InFmt,vname,tmp) + call MAPL_VarWrite(OutFmt,vname,tmp(f2g)) + call var_iter%next() + enddo + + call inFmt%close(rc=rc) + call OutFmt%close(rc=rc) + deallocate(tmp) + endif + deallocate(f2g) end subroutine createLocalVegRestart @@ -921,7 +992,7 @@ subroutine optimize_latlon(fname,arg) print*, "JMS.rc", JMS if( sum(JMS) /= JMGLOB) then print*, sum(JMS), JMGLOB - stop("wrong cs-domain distribution") + stop ("wrong cs-domain distribution") endif tmpint = 0 k = 0 @@ -939,14 +1010,11 @@ subroutine optimize_latlon(fname,arg) write(10,'(A)') "GEOSldas.GRIDNAME: " // trim(gridname) write(10,'(A)') "GEOSldas.GRID_TYPE: Cubed-Sphere" write(10,'(A)') "GEOSldas.NF: 6" - write(10,'(A,I5)') "GEOSldas.NY: ",N_proc - write(10,'(A)') "GEOSldas.NX: 1" + write(10,'(A,I6)') "GEOSldas.IM_WORLD: ", IMGLOB write(10,'(A)') "GEOSldas.LM: 1" write(10,'(A,I5)') "NY: ",N_proc write(10,'(A)') "NX: 1" - write(10,'(A,I6)') "GEOSldas.IM_WORLD: ", IMGLOB write(10,'(A)') "GEOSldas.JMS_FILE: JMS.rc" - write(10,'(A)') "JMS_FILE: JMS.rc" close(10) open(10,file="JMS.rc",action='write') @@ -1066,8 +1134,8 @@ subroutine optimize_latlon(fname,arg) print*,"land_distribute: ",local_land - if( sum(local_land) /= total_land) stop("wrong distribution") - if( sum(IMS) /= N_lon) stop("wrong domain distribution") + if( sum(local_land) /= total_land) stop ("wrong distribution") + if( sum(IMS) /= N_lon) stop ("wrong domain distribution") open(10,file="optimized_distribution",action='write') write(10,'(A)') "GEOSldas.GRID_TYPE: LatLon" @@ -1078,13 +1146,10 @@ subroutine optimize_latlon(fname,arg) write(10,'(A,I6)') "GEOSldas.IM_WORLD: ",N_lon write(10,'(A,I6)') "GEOSldas.JM_WORLD: ",N_lat - write(10,'(A,I5)') "GEOSldas.NX: ",N_proc - write(10,'(A)') "GEOSldas.NY: 1" write(10,'(A,I5)') "NX: ",N_proc write(10,'(A)') "NY: 1" write(10,'(A)') "GEOSldas.IMS_FILE: IMS.rc" - write(10,'(A)') "IMS_FILE: IMS.rc" close(10) open(10,file="IMS.rc",action='write') @@ -1314,7 +1379,7 @@ subroutine o_pert_GEOSldas(rc) dims(3)= Nforce status = NF90_DEF_VAR(NCFOutID,'fpert_ntrmdt',NF90_REAL, dims, forceid) - status = nf90_def_var_deflate(NCFOutID, forceid, shuffle, deflate, deflate_level) + !status = nf90_def_var_deflate(NCFOutID, forceid, shuffle, deflate, deflate_level) status = NF90_PUT_ATT(NCFOutID, forceid, 'long_name', 'force_pert_intermediate') status = NF90_PUT_ATT(NCFOutID, forceid, 'units', '1') status = nf90_put_att(NCFOutID, forceid, '_FillValue', fill_value) @@ -1323,7 +1388,7 @@ subroutine o_pert_GEOSldas(rc) dims(3)= Nprogn status = NF90_DEF_VAR(NCFOutID, 'ppert_ntrmdt', NF90_REAL, dims, prognid) - status = nf90_def_var_deflate(NCFOutID, prognid, shuffle, deflate, deflate_level) + !status = nf90_def_var_deflate(NCFOutID, prognid, shuffle, deflate, deflate_level) status = NF90_PUT_ATT(NCFOutID, prognid, 'long_name', 'progn_pert_intermediate') status = NF90_PUT_ATT(NCFOutID, prognid, 'units', '1') status = nf90_put_att(NCFOutID, prognid, '_FillValue', fill_value) diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index 131f2b39..d0a381ea 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -69,14 +69,22 @@ case [0] : #SBATCH --error=mkLDAS.e source $INSTDIR/bin/g5_modules -setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0 +if ( -e /etc/os-release ) then + module load nco/4.8.1 +else + module load other/nco-4.6.8-gcc-5.3-sp3 +endif +#setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0 #setenv MKL_CBWR SSE4_2 # ensure zero-diff across archs #setenv MV2_ON_DEMAND_THRESHOLD 8192 # MVAPICH2 setenv LAIFILE `find ${BCSDIR}/lai_clim*` -setenv PATH $PATH\:/usr/local/other/SLES11.3/nco/4.6.8/gcc-5.3-sp3/bin/ +setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib + limit stacksize unlimited -mpirun -map-by core --mca btl ^vader -np 56 bin/mk_LDASsaRestarts -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y +#mpirun -map-by core --mca btl ^vader -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y +$INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y + sleep 3 if($LSM_CHOICE == 1) then @@ -85,7 +93,8 @@ else /bin/cp OutData1/catchcn_internal_rst OutData2/catchcn_internal_rst endif -mpirun -map-by core --mca btl ^vader -np 56 bin/mk_LDASsaRestarts -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y +#mpirun -map-by core --mca btl ^vader -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y +$INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y _EOI_ @@ -119,7 +128,7 @@ _EOI2_ rm mkLDASsa.j2 sbatch mkLDASsa.j cd $PWD - breaksw + breaksw case [1]: set coordfile=${RESTART_short}/rc_out/${RESTART_ID}.ldas_tilecoord.bin @@ -142,13 +151,18 @@ case [1]: cd $EXPDIR/$EXPID/mk_restarts/ echo '#\!/bin/csh -f ' > this.file echo 'source $INSTDIR/bin/g5_modules' >> this.file - echo 'setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0' >> this.file - echo 'setenv PATH $PATH\:/usr/local/other/SLES11.3/nco/4.6.8/gcc-5.3-sp3/bin/' >> this.file + echo 'if ( -e /etc/os-release ) then' >> this.file + echo ' module load nco/4.8.1' >> this.file + echo 'else' >> this.file + echo 'module load other/nco-4.6.8-gcc-5.3-sp3 ' >> this.file + echo 'endif' >> this.file + #echo 'setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0' >> this.file + echo 'setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib' >> this.file set j = 0 while ($j < $NUMENS) set ENS = `printf '%04d' $j` - echo bin/mk_LDASsaRestarts -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k ${ENS} -l ${RESTART_short} -m ${MODEL} -s 50 -r Y -t ${TILFILE} >> this.file + echo $INSTDIR/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k ${ENS} -l ${RESTART_short} -m ${MODEL} -s 50 -r Y -t ${TILFILE} >> this.file echo ncks -4 -O -h -x -v IRRIGFRAC,PADDYFRAC,LAIMIN,LAIMAX,CLMPT,CLMST,CLMPF,CLMSF ${MODEL}${ENS}_internal_rst.${YYYYMMDD} ${MODEL}${ENS}_internal_rst.${YYYYMMDD} >> this.file @ j++ end diff --git a/src/Applications/LDAS_App/tile_bin2nc4.F90 b/src/Applications/LDAS_App/tile_bin2nc4.F90 index 0a68dddc..dcf0fb92 100644 --- a/src/Applications/LDAS_App/tile_bin2nc4.F90 +++ b/src/Applications/LDAS_App/tile_bin2nc4.F90 @@ -346,6 +346,33 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('RMELTOC001'); LONG_NAME = 'flushed_out_organic_carbon_mass_flux_from_the_bottom_layer_bin_1'; UNITS = 'kg m-2 s-1' case ('RMELTOC002'); LONG_NAME = 'flushed_out_organic_carbon_mass_flux_from_the_bottom_layer_bin_2'; UNITS = 'kg m-2 s-1' +!#sqz 2020-01 + case ('TCFSAT_INCR'); LONG_NAME = 'increment_canopy_temperature_saturated_zone'; UNITS = 'K' + case ('TCFTRN_INCR'); LONG_NAME = 'increment_canopy_temperature_transition_zone'; UNITS = 'K' + case ('TCFWLT_INCR'); LONG_NAME = 'increment_canopy_temperature_wilting_zone'; UNITS = 'K' + case ('QCFSAT_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone'; UNITS = 'kg kg-1' + case ('QCFTRN_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_transition_zone'; UNITS = 'kg kg-1' + case ('QCFWLT_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone'; UNITS = 'kg kg-1' + case ('CAPAC_INCR'); LONG_NAME = 'increment_interception_reservoir_capac'; UNITS = 'kg m-2' + case ('CATDEF_INCR'); LONG_NAME = 'increment_catchment_deficit'; UNITS = 'kg m-2' + case ('RZEXC_INCR'); LONG_NAME = 'increment_root_zone_excess'; UNITS = 'kg m-2' + case ('SRFEXC_INCR'); LONG_NAME = 'increment_surface_excess'; UNITS = 'kg m-2' + case ('GHTCNT1_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_1'; UNITS = 'J m-2' + case ('GHTCNT2_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_2'; UNITS = 'J m-2' + case ('GHTCNT3_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_3'; UNITS = 'J m-2' + case ('GHTCNT4_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_4'; UNITS = 'J m-2' + case ('GHTCNT5_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_5'; UNITS = 'J m-2' + case ('GHTCNT6_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_6'; UNITS = 'J m-2' + case ('WESNN1_INCR'); LONG_NAME = 'increment_snow_mass_layer_1'; UNITS = 'kg m-2' + case ('WESNN2_INCR'); LONG_NAME = 'increment_snow_mass_layer_2'; UNITS = 'kg m-2' + case ('WESNN3_INCR'); LONG_NAME = 'increment_snow_mass_layer_3'; UNITS = 'kg m-2' + case ('HTSNNN1_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_1'; UNITS = 'J m-2' + case ('HTSNNN2_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_2'; UNITS = 'J m-2' + case ('HTSNNN3_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_3'; UNITS = 'J m-2' + case ('SNDZN1_INCR'); LONG_NAME = 'increment_snow_depth_layer_1'; UNITS = 'm' + case ('SNDZN2_INCR'); LONG_NAME = 'increment_snow_depth_layer_2'; UNITS = 'm' + case ('SNDZN3_INCR'); LONG_NAME = 'increment_snow_depth_layer_3'; UNITS = 'm' + case default; LONG_NAME = 'Check_GridComp'; UNITS = 'No to fix getAttribute table in tile_bin2nc4.F90'; end select diff --git a/src/Components/GEOSldas_GridComp/CMakeLists.txt b/src/Components/GEOSldas_GridComp/CMakeLists.txt index 72b0b0b8..347cc295 100644 --- a/src/Components/GEOSldas_GridComp/CMakeLists.txt +++ b/src/Components/GEOSldas_GridComp/CMakeLists.txt @@ -1,6 +1,6 @@ esma_set_this () -esma_add_subdirectories (@GEOSgcm_GridComp @FVdycoreCubed_GridComp) +esma_add_subdirectories (@GEOSgcm_GridComp ) set (alldirs GEOSmetforce_GridComp @@ -13,5 +13,5 @@ esma_add_library(${this} SRCS GEOS_LdasGridComp.F90 SUBCOMPONENTS ${alldirs} SUBDIRS Shared - DEPENDENCIES GEOSland_GridComp FVdycoreCubed_GridComp MAPL_Base + DEPENDENCIES GEOSland_GridComp MAPL_Base INCLUDES ${INC_ESMF}) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index d61fc55d..fd5b2e09 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -8,11 +8,10 @@ module GEOS_LdasGridCompMod use ESMF use MAPL_Mod - use CubedSphereGridFactoryMod - use MAPL_GridManagerMod, only: grid_manager - use MAPL_RegridderManagerMod - use MAPL_AbstractRegridderMod - use MAPL_RegridderSpecMod + !use MAPL_GridManagerMod, only: grid_manager + !use MAPL_RegridderManagerMod + !use MAPL_AbstractRegridderMod + !use MAPL_RegridderSpecMod use GEOS_MetforceGridCompMod, only: MetforceSetServices => SetServices use GEOS_LandGridCompMod, only: LandSetServices => SetServices @@ -23,9 +22,9 @@ module GEOS_LdasGridCompMod use LDAS_EASE_conv, only: ease_inverse use LDAS_TileCoordType, only: tile_coord_type , T_TILECOORD_STATE, TILECOORD_WRAP use LDAS_TileCoordType, only: grid_def_type, io_grid_def_type - use LDAS_TileCoordRoutines, only: get_tile_grid + use LDAS_TileCoordRoutines, only: get_tile_grid, get_ij_ind_from_latlon use LDAS_ConvertMod, only: esmf2ldas - + use LDAS_PertRoutinesMod, only: get_pert_grid use LDAS_ensdrv_functions,ONLY: get_io_filename use LDAS_DateTimeMod,ONLY: date_time_type use LDAS_ensdrv_mpi, only: MPI_tile_coord_type, MPI_grid_def_type @@ -204,8 +203,9 @@ subroutine SetServices(gc, rc) ! -DATAATM-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & - SHORT_NAME = ['Tair', 'Qair','Psurf', 'Rainf_C', 'Rainf', 'Snowf', 'LWdown', & - 'SWdown', 'SWnet', 'PARdrct', 'PARdffs', 'Wind','RefH'], & + SHORT_NAME = ['Tair ', 'Qair ', 'Psurf ', 'Rainf_C', 'Rainf ', & + 'Snowf ', 'LWdown ', 'SWdown ', 'SWnet ', 'PARdrct', & + 'PARdffs', 'Wind ', 'RefH '], & ! SRC_ID = DATAATM(i), & SRC_ID = DATAATM(1), & DST_ID = LANDPERT(i), & @@ -215,29 +215,30 @@ subroutine SetServices(gc, rc) ! -LANDPERT-feeds-LAND's-imports- call MAPL_AddConnectivity( & gc, & - SRC_NAME = ['TApert', 'QApert', 'UUpert', 'UWINDLMTILEpert', & - 'VWINDLMTILEpert', 'PCUpert', 'PLSpert', 'SNOpert', 'DRPARpert', & - 'DFPARpert', 'DRNIRpert', 'DFNIRpert', 'DRUVRpert', 'DFUVRpert', & - 'LWDNSRFpert'], & - SRC_ID = LANDPERT(i), & - DST_NAME = ['TA', 'QA', 'UU', 'UWINDLMTILE', & - 'VWINDLMTILE', 'PCU', 'PLS', 'SNO', 'DRPAR', & - 'DFPAR', 'DRNIR', 'DFNIR', 'DRUVR', 'DFUVR', & - 'LWDNSRF'], & - DST_ID = LAND(i), & + SRC_NAME = ['TApert ', 'QApert ', 'UUpert ', & + 'UWINDLMTILEpert', 'VWINDLMTILEpert', 'PCUpert ', & + 'PLSpert ', 'SNOpert ', 'DRPARpert ', & + 'DFPARpert ', 'DRNIRpert ', 'DFNIRpert ', & + 'DRUVRpert ', 'DFUVRpert ', 'LWDNSRFpert '], & + SRC_ID = LANDPERT(i), & + DST_NAME = ['TA ', 'QA ', 'UU ', 'UWINDLMTILE',& + 'VWINDLMTILE', 'PCU ', 'PLS ', 'SNO ',& + 'DRPAR ', 'DFPAR ', 'DRNIR ', 'DFNIR ',& + 'DRUVR ', 'DFUVR ', 'LWDNSRF '], & + DST_ID = LAND(i), & rc = status & ) VERIFY_(status) ! -DATAATM-feeds-LAND's-imports- call MAPL_AddConnectivity( & gc, & - SRC_NAME = ['Psurf', 'RefH', & - 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & - 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & - 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & + SRC_NAME = ['Psurf', 'RefH ', & + 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & + 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & + 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & ! SRC_ID = DATAATM(i), & SRC_ID = DATAATM(1), & - DST_NAME = ['PS', 'DZ', & + DST_NAME = ['PS ', 'DZ ', & 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & @@ -248,16 +249,16 @@ subroutine SetServices(gc, rc) ! -CATCH-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & - SRC_NAME = ['TC','CATDEF','RZEXC','SRFEXC','WESNN1','WESNN2','WESNN3', & - 'GHTCNT1','GHTCNT2','GHTCNT3','GHTCNT4','GHTCNT5','GHTCNT6', & - 'HTSNNN1','HTSNNN2','HTSNNN3','SNDZN1','SNDZN2','SNDZN3'], & - SRC_ID = LAND(i), & - DST_NAME =['TCPert','CATDEFPert','RZEXCPert','SRFEXCPert','WESNN1Pert',& - 'WESNN2Pert','WESNN3Pert','GHTCNT1Pert','GHTCNT2Pert', & - 'GHTCNT3Pert','GHTCNT4Pert','GHTCNT5Pert','GHTCNT6Pert', & - 'HTSNNN1Pert','HTSNNN2Pert','HTSNNN3Pert','SNDZN1Pert', & - 'SNDZN2Pert','SNDZN3Pert'], & - DST_ID = LANDPERT(i), & + SRC_NAME = ['TC ','CATDEF ','RZEXC ','SRFEXC ','WESNN1 ','WESNN2 ','WESNN3 ', & + 'GHTCNT1','GHTCNT2','GHTCNT3','GHTCNT4','GHTCNT5','GHTCNT6', & + 'HTSNNN1','HTSNNN2','HTSNNN3','SNDZN1 ','SNDZN2 ','SNDZN3 '], & + SRC_ID = LAND(i), & + DST_NAME = ['TCPert ','CATDEFPert ','RZEXCPert ','SRFEXCPert ','WESNN1Pert ',& + 'WESNN2Pert ','WESNN3Pert ','GHTCNT1Pert','GHTCNT2Pert', & + 'GHTCNT3Pert','GHTCNT4Pert','GHTCNT5Pert','GHTCNT6Pert', & + 'HTSNNN1Pert','HTSNNN2Pert','HTSNNN3Pert','SNDZN1Pert ', & + 'SNDZN2Pert ','SNDZN3Pert '], & + DST_ID = LANDPERT(i), & rc = status & ) VERIFY_(status) @@ -266,11 +267,11 @@ subroutine SetServices(gc, rc) if(assim) then call MAPL_AddConnectivity( & gc, & - SHORT_NAME = ['POROS', 'COND','PSIS','BEE','WPWET','GNU','VGWMAX', & - 'BF1', 'BF2', 'BF3', 'CDCR1', 'CDCR2', 'ARS1', & - 'ARS2', 'ARS3', 'ARA1', 'ARA2', 'ARA3', 'ARA4', & - 'ARW1', 'ARW2', 'ARW3', 'ARW4', 'TSA1', 'TSA2','TSB1', & - 'TSB2','ATAU','BTAU','ITY','Z2CH' ], & + SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & + 'BF1 ', 'BF2 ','BF3 ','CDCR1 ','CDCR2 ','ARS1 ', & + 'ARS2 ', 'ARS3 ','ARA1 ','ARA2 ','ARA3 ','ARA4 ', & + 'ARW1 ', 'ARW2 ','ARW3 ','ARW4 ','TSA1 ','TSA2 ','TSB1 ', & + 'TSB2 ', 'ATAU ','BTAU ','ITY ','Z2CH ' ], & SRC_ID = LAND(1), & DST_ID = LANDASSIM, & rc = status & @@ -305,9 +306,9 @@ end subroutine SetServices ! !INTERFACE: subroutine Initialize(gc, import, export, clock, rc) - use LatLonToCubeRegridderMod - use CubeToLatLonRegridderMod - use CubeToCubeRegridderMod + !use MAPL_LatLonToCubeRegridderMod + !use MAPL_CubeToLatLonRegridderMod + !use MAPL_CubeToCubeRegridderMod ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: gc ! Gridded component @@ -381,10 +382,10 @@ subroutine Initialize(gc, import, export, clock, rc) type(grid_def_type) :: tile_grid_l type(date_time_type):: start_time type(ESMF_Time) :: CurrentTime - type(CubedSphereGridFactory) :: cubed_sphere_factory - type (CubeToLatLonRegridder) :: cube_to_latlon_prototype - type (LatLonToCubeRegridder) :: latlon_to_cube_prototype - type (CubeToCubeRegridder) :: cube_to_cube_prototype + !type(CubedSphereGridFactory) :: cubed_sphere_factory + !type (CubeToLatLonRegridder) :: cube_to_latlon_prototype + !type (LatLonToCubeRegridder) :: latlon_to_cube_prototype + !type (CubeToCubeRegridder) :: cube_to_cube_prototype real :: DT, DT_Solar type(ESMF_Alarm) :: SolarAlarm type(ESMF_TimeInterval) :: Solar_DT @@ -433,16 +434,16 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_GetResource(MAPL, grid_type,Label="GEOSldas.GRID_TYPE:",RC=STATUS) VERIFY_(STATUS) - if (trim(grid_type) == "Cubed-Sphere") then - call grid_manager%add_prototype("Cubed-Sphere", cubed_sphere_factory) - associate (method => REGRID_METHOD_BILINEAR, mgr => regridder_manager) - call mgr%add_prototype('Cubed-Sphere', 'LatLon', method, cube_to_latlon_prototype) - call mgr%add_prototype('LatLon', 'Cubed-Sphere', method, latlon_to_cube_prototype) - call mgr%add_prototype('Cubed-Sphere', 'Cubed-Sphere', method, cube_to_cube_prototype) - end associate + ! if (trim(grid_type) == "Cubed-Sphere") then + ! call grid_manager%add_prototype("Cubed-Sphere", cubed_sphere_factory) + ! associate (method => REGRID_METHOD_BILINEAR, mgr => regridder_manager) + ! call mgr%add_prototype('Cubed-Sphere', 'LatLon', method, cube_to_latlon_prototype) + ! call mgr%add_prototype('LatLon', 'Cubed-Sphere', method, latlon_to_cube_prototype) + ! call mgr%add_prototype('Cubed-Sphere', 'Cubed-Sphere', method, cube_to_cube_prototype) + ! end associate + ! endif - endif - ! Create atmospheric (single level atm grid covers all of surface) grid + ! Create atmospheric (single level atm grid covers all of surface) grid call MAPL_GridCreate(gc, rc=status) VERIFY_(status) @@ -586,6 +587,34 @@ subroutine Initialize(gc, import, export, clock, rc) write(10,*) N_catf close(10) call io_grid_def_type('w', logunit, tile_grid_f, 'tile_grid_f') + + block + type(grid_def_type) :: latlon_tmp_g + integer :: perturbations + + call MAPL_GetResource(MAPL, perturbations, 'PERTURBATIONS:', default=0, rc=status) + if(trim(grid_type) == "Cubed-Sphere" ) then + + ASSERT_(index(tile_grid_g%gridtype, 'c3') /=0) + !1) save original index + tile_coord_f%cs_i_indg = tile_coord_f%i_indg + tile_coord_f%cs_j_indg = tile_coord_f%j_indg + + !2) generate a lat-lon grid for landpert and land assim ( 4*N_lonX3*N_lon) + call get_pert_grid(tile_grid_g, latlon_tmp_g) + tile_grid_g = latlon_tmp_g + !3) change the index + ! need to chang min_lon, max_lon, min_lat , max_lat? + do i = 1, N_catf + call get_ij_ind_from_latlon(latlon_tmp_g,tile_coord_f(i)%com_lat,tile_coord_f(i)%com_lon, & + tile_coord_f(i)%i_indg,tile_coord_f(i)%j_indg) + enddo + !3) re-generate tile_grid_f in Lat-Lon + call get_tile_grid(N_catf, tile_coord_f, tile_grid_g, tile_grid_f) + + endif + end block + endif call MPI_BCAST(N_catf,1,MPI_INTEGER,0,mpicomm,mpierr) @@ -864,21 +893,14 @@ subroutine Run(gc, import, export, clock, rc) if (assim) then igc = LANDASSIM call MAPL_TimerOn(MAPL, gcnames(igc)) - ! get cat_param - ! it is moved to ensavg - ! call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) - ! VERIFY_(status) - !import state is the export from ens_GridComp - call ESMF_GridCompRun(gcs(igc), importState=gex(ENSAVG), exportState=gex(igc), clock=clock, phase=2, userRC=status) + !import state is the export from ens_GridComp, assimilation run + call ESMF_GridCompRun(gcs(igc), importState=gex(ENSAVG), exportState=gex(igc), clock=clock, phase=1, userRC=status) VERIFY_(status) do i = 1, NUM_ENSEMBLE - ! update catch_progn and pert_rseed - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(LAND(i)), clock=clock, phase=3, userRC=status) + ! update catch_progn + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(LAND(i)), clock=clock, phase=2, userRC=status) VERIFY_(status) - ! update pert_rseed - !call ESMF_GridCompRun(gcs(LANDPERT(i)), importState=gim(LANDPERT(i)), exportState=gex(LANDPERT(i)), clock=clock, phase=5, userRC=status) - !VERIFY_(status) enddo call MAPL_TimerOff(MAPL, gcnames(igc)) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index a809a883..615c8cfc 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -53,6 +53,7 @@ module GEOS_LandAssimGridCompMod use catch_bias_types, only: cat_bias_param_type use catch_types, only: cat_progn_type use catch_types, only: cat_param_type + use catch_types, only: assignment(=), operator (+), operator (/) use clsm_bias_routines, only: initialize_obs_bias use clsm_bias_routines, only: read_cat_bias_inputs @@ -78,6 +79,7 @@ module GEOS_LandAssimGridCompMod ! !EOP ! +integer, parameter :: NUM_SUBTILES = 4 integer :: NUM_ENSEMBLE integer :: FIRST_ENS_ID @@ -91,9 +93,7 @@ module GEOS_LandAssimGridCompMod integer :: N_obs_param logical :: out_obslog logical :: out_ObsFcstAna -logical :: out_incr logical :: out_smapL4SMaup -integer :: out_incr_format integer :: N_obsbias_max integer,dimension(:),pointer :: N_catl_vec,low_ind @@ -101,7 +101,6 @@ module GEOS_LandAssimGridCompMod !reordered tile_coord_rf and mapping l2rf integer,dimension(:),pointer :: l2rf, rf2l,rf2g type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() -!type(cat_param_type), allocatable :: cat_param(:) integer, allocatable :: Pert_rseed(:,:) real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) @@ -154,16 +153,7 @@ subroutine SetServices ( GC, RC ) ) VERIFY_(status) - !phase 1: get cat_param - call MAPL_GridCompSetEntryPoint( & - gc, & - ESMF_METHOD_RUN, & - GET_CAT_PARAM , & - rc=status & - ) - VERIFY_(status) - - !phase 2: assimilation run + !phase 1: assimilation run call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -172,7 +162,7 @@ subroutine SetServices ( GC, RC ) ) VERIFY_(status) - !phase 3: feed back to change catch_progn + !phase 2: feed back to change catch_progn call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -476,6 +466,257 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) +! +! Export for incr +! + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_saturated_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFSAT_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_transition_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFTRN_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_wilting_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFWLT_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFSAT_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_transition_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFTRN_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFWLT_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_interception_reservoir_capac',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CAPAC_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_catchment_deficit' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CATDEF_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_root_zone_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RZEXC_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_surface_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'SRFEXC_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT1_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_2' ,& + UNITS = 'J_m-2' ,& + SHORT_NAME = 'GHTCNT2_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT3_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_4' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT4_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_5' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT5_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_6' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT6_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_1' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN1_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_2' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN2_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_3' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN3_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN1_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_2' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN2_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN3_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_1' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN1_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_2' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN2_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_3' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN3_INCR' ,& +! FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + ! ! INTERNAL STATE ! @@ -685,7 +926,7 @@ subroutine Initialize(gc, import, export, clock, rc) type(MAPL_LocStream) :: locstream character(len=300) :: out_path,fname - character(len=ESMF_MAXSTR) :: exp_id + character(len=ESMF_MAXSTR) :: exp_id, GridName integer :: model_dtstep type(date_time_type) :: start_time @@ -810,13 +1051,6 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_Bcast(pert_rseed, NRANDSEED*NUM_ENSEMBLE, MPI_INTEGER, 0, mpicomm, mpierr) - !allocate(cat_param(land_nt_local)) - - !fname = get_io_filename(trim(out_path), trim(exp_id), 'ldas_catparam', date_time=start_time,& - ! dir_name='rc_out', file_ext='.bin') - - !call GEOS_read_catparam(GC,trim(fname),cat_param) - allocate(N_catl_vec(numprocs)) allocate(low_ind(numprocs)) allocate(l2rf(land_nt_local)) @@ -861,7 +1095,7 @@ subroutine Initialize(gc, import, export, clock, rc) rf2l( l2rf(i) ) = i end do - if (master_proc) & + if (master_proc) then call read_ens_upd_inputs( & trim(out_path), & trim(exp_id), & @@ -879,11 +1113,15 @@ subroutine Initialize(gc, import, export, clock, rc) obs_param, & out_obslog, & out_ObsFcstAna, & - out_incr, & - out_incr_format, & +! out_incr, & +! out_incr_format, & out_smapL4SMaup, & N_obsbias_max & ) + call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) + VERIFY_(STATUS) + if (index(GridName,"-CF") /=0) out_smapL4SMaup = .false. ! no out_smap for now if it is cs frid + endif call MPI_BCAST(need_mwRTM_param, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(update_type, 1, MPI_INTEGER, 0,MPICOMM,mpierr) @@ -894,8 +1132,8 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_BCAST(N_obs_param, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(out_obslog, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(out_ObsFcstAna, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) - call MPI_BCAST(out_incr, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) - call MPI_BCAST(out_incr_format, 1, MPI_INTEGER, 0,MPICOMM,mpierr) +! call MPI_BCAST(out_incr, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) +! call MPI_BCAST(out_incr_format, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr) @@ -914,195 +1152,6 @@ subroutine Initialize(gc, import, export, clock, rc) RETURN_(ESMF_SUCCESS) end subroutine Initialize -!BOP - -subroutine GET_CAT_PARAM( GC, IMPORT, EXPORT, CLOCK, RC ) - -! !ARGUMENTS: - - type(ESMF_GridComp),intent(inout) :: GC !Gridded component - type(ESMF_State), intent(inout) :: IMPORT !Import state - type(ESMF_State), intent(inout) :: EXPORT !Export state - type(ESMF_Clock), intent(inout) :: CLOCK !The clock - integer,optional, intent(out ) :: RC !Error code: - -!EOP -! ErrLog Variables - - character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME -! - -! Locals - type(MAPL_MetaComp), pointer :: MAPL=>null() - logical :: firsttime = .true. - - real, pointer :: poros(:) =>null() - real, pointer :: cond(:) =>null() - real, pointer :: psis(:) =>null() - real, pointer :: bee(:) =>null() - real, pointer :: wpwet(:) =>null() - real, pointer :: gnu(:) =>null() - real, pointer :: vgwmax(:) =>null() - real, pointer :: bf1(:) =>null() - real, pointer :: bf2(:) =>null() - real, pointer :: bf3(:) =>null() - real, pointer :: cdcr1(:) =>null() - real, pointer :: cdcr2(:) =>null() - real, pointer :: ars1(:) =>null() - real, pointer :: ars2(:) =>null() - real, pointer :: ars3(:) =>null() - real, pointer :: ara1(:) =>null() - real, pointer :: ara2(:) =>null() - real, pointer :: ara3(:) =>null() - real, pointer :: ara4(:) =>null() - real, pointer :: arw1(:) =>null() - real, pointer :: arw2(:) =>null() - real, pointer :: arw3(:) =>null() - real, pointer :: arw4(:) =>null() - real, pointer :: tsa1(:) =>null() - real, pointer :: tsa2(:) =>null() - real, pointer :: tsb1(:) =>null() - real, pointer :: tsb2(:) =>null() - real, pointer :: atau(:) =>null() - real, pointer :: btau(:) =>null() - real, pointer :: ity(:) =>null() - real, pointer :: z2ch(:) =>null() - - real :: SURFLAY, x - integer :: i - - if (firsttime) then - firsttime = .false. - call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_GetPointer(import, poros, 'POROS', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, cond, 'COND', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, psis, 'PSIS', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, bee, 'BEE', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, wpwet, 'WPWET', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, gnu, 'GNU', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, vgwmax, 'VGWMAX', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, bf1, 'BF1', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, bf2, 'BF2', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, bf3, 'BF3', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, cdcr1, 'CDCR1', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, cdcr2, 'CDCR2', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ars1, 'ARS1', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ars2, 'ARS2', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ars3, 'ARS3', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ara1, 'ARA1', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ara2, 'ARA2', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ara3, 'ARA3', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ara4, 'ARA4', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, arw1, 'ARW1', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, arw2, 'ARW2', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, arw3, 'ARW3', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, arw4, 'ARW4', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, tsa1, 'TSA1', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, tsa2, 'TSA2', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, tsb1, 'TSB1', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, tsb2, 'TSB2', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, atau, 'ATAU', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, btau, 'BTAU', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, ity, 'ITY', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, z2ch, 'Z2CH', rc=status) - VERIFY_(status) - - cat_param(:)%dzgt(1) = dzgt(1) - cat_param(:)%dzgt(2) = dzgt(2) - cat_param(:)%dzgt(3) = dzgt(3) - cat_param(:)%dzgt(4) = dzgt(4) - cat_param(:)%dzgt(5) = dzgt(5) - cat_param(:)%dzgt(6) = dzgt(6) - cat_param(:)%poros = poros - cat_param(:)%cond = cond - cat_param(:)%psis = psis - cat_param(:)%bee = bee - cat_param(:)%wpwet = wpwet - cat_param(:)%gnu = gnu - cat_param(:)%vgwmax= vgwmax - cat_param(:)%bf1 = bf1 - cat_param(:)%bf2 = bf2 - cat_param(:)%bf3 = bf3 - cat_param(:)%cdcr1 = cdcr1 - cat_param(:)%cdcr2 = cdcr2 - cat_param(:)%ars1 = ars1 - cat_param(:)%ars2 = ars2 - cat_param(:)%ars3 = ars3 - cat_param(:)%ara1 = ara1 - cat_param(:)%ara2 = ara2 - cat_param(:)%ara3 = ara3 - cat_param(:)%ara4 = ara4 - cat_param(:)%arw1 = arw1 - cat_param(:)%arw2 = arw2 - cat_param(:)%arw3 = arw3 - cat_param(:)%arw4 = arw4 - cat_param(:)%tsa1 = tsa1 - cat_param(:)%tsa2 = tsa2 - cat_param(:)%tsb1 = tsb1 - cat_param(:)%tsb2 = tsb2 - cat_param(:)%atau = atau - cat_param(:)%btau = btau - cat_param(:)%vegcls = nint(ity) - cat_param(:)%veghght = z2ch - - call MAPL_GetResource(MAPL, SURFLAY, Label="SURFLAY:", DEFAULT=50.0, rc=status) - - cat_param(:)%dzsf = SURFLAY - cat_param(:)%dzpr = (cdcr2/(1.-wpwet)) / poros - cat_param(:)%dzrz = vgwmax/poros - - !assign NaN to other fields - x = ieee_value(x,ieee_quiet_nan) - cat_param(:)%soilcls30 = transfer(x,i) - cat_param(:)%soilcls100 = transfer(x,i) - cat_param(:)%gravel30 = x - cat_param(:)%orgC30 = x - cat_param(:)%orgC = x - cat_param(:)%sand30 = x - cat_param(:)%clay30 = x - cat_param(:)%sand = x - cat_param(:)%clay = x - cat_param(:)%wpwet30 = x - cat_param(:)%poros30 = x - cat_param(:)%dpth = x - endif - RETURN_(ESMF_SUCCESS) -end subroutine GET_CAT_PARAM - ! !IROUTINE: RUN ! !INTERFACE: @@ -1142,7 +1191,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) type(date_time_type) :: date_time_new character(len=14) :: datestamp - integer :: N_catl, N_catg,N_obsl_max + integer :: N_catl, N_catg,N_obsl_max, n_e, i character(len=300) :: out_path character(len=ESMF_MAXSTR) :: exp_id @@ -1158,6 +1207,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) type(obs_bias_type), dimension(:,:,:), allocatable :: obs_bias type(cat_progn_type), dimension(:,:), allocatable :: cat_progn_incr + type(cat_progn_type), dimension(:), allocatable :: cat_progn_incr_ensavg type(obs_type), dimension(:), pointer :: Observations_l => null() logical :: fresh_incr integer :: N_obsf,N_obsl @@ -1205,6 +1255,35 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer :: SWLAND(:)=>null() real, pointer :: LAI(:)=>null() +!! export incr progn + + real, dimension(:),pointer :: TC1_incr=>null() + real, dimension(:),pointer :: TC2_incr=>null() + real, dimension(:),pointer :: TC4_incr=>null() + real, dimension(:),pointer :: QC1_incr=>null() + real, dimension(:),pointer :: QC2_incr=>null() + real, dimension(:),pointer :: QC4_incr=>null() + real, dimension(:),pointer :: CAPAC_incr=>null() + real, dimension(:),pointer :: CATDEF_incr=>null() + real, dimension(:),pointer :: RZEXC_incr=>null() + real, dimension(:),pointer :: SRFEXC_incr=>null() + real, dimension(:),pointer :: GHTCNT1_incr=>null() + real, dimension(:),pointer :: GHTCNT2_incr=>null() + real, dimension(:),pointer :: GHTCNT3_incr=>null() + real, dimension(:),pointer :: GHTCNT4_incr=>null() + real, dimension(:),pointer :: GHTCNT5_incr=>null() + real, dimension(:),pointer :: GHTCNT6_incr=>null() + real, dimension(:),pointer :: WESNN1_incr=>null() + real, dimension(:),pointer :: WESNN2_incr=>null() + real, dimension(:),pointer :: WESNN3_incr=>null() + real, dimension(:),pointer :: HTSNNN1_incr=>null() + real, dimension(:),pointer :: HTSNNN2_incr=>null() + real, dimension(:),pointer :: HTSNNN3_incr=>null() + real, dimension(:),pointer :: SNDZN1_incr=>null() + real, dimension(:),pointer :: SNDZN2_incr=>null() + real, dimension(:),pointer :: SNDZN3_incr=>null() + + logical :: spin logical, save :: firsttime=.true. type(cat_bias_param_type) :: cat_bias_param @@ -1213,7 +1292,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=300) :: fname_tpl character(len=4) :: id_string integer:: ens, nymd, nhms - + #ifdef DBG_LANDASSIM_INPUTS ! vars for debugging purposes type(ESMF_Grid) :: TILEGRID @@ -1375,7 +1454,6 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) !! get import from ens to get ensemble average forcing - ! Pointers to exports (allocate memory) call MAPL_GetPointer(import, TA_enavg, 'TA', rc=status) VERIFY_(status) call MAPL_GetPointer(import, QA_enavg, 'QA', rc=status) @@ -1410,6 +1488,59 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(status) call MAPL_GetPointer(import, LAI, 'LAI', rc=status) VERIFY_(status) +! +! export for incr +! + call MAPL_GetPointer(export, TC1_incr, 'TCFSAT_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, TC4_incr, 'TCFWLT_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, QC1_incr, 'QCFSAT_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, QC2_incr, 'QCFTRN_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, QC4_incr, 'QCFWLT_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, CAPAC_incr, 'CAPAC_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, CATDEF_incr, 'CATDEF_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, RZEXC_incr, 'RZEXC_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, SRFEXC_incr, 'SRFEXC_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, GHTCNT1_incr, 'GHTCNT1_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, GHTCNT2_incr, 'GHTCNT2_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, GHTCNT3_incr, 'GHTCNT3_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, GHTCNT4_incr, 'GHTCNT4_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, GHTCNT5_incr, 'GHTCNT5_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, GHTCNT6_incr, 'GHTCNT6_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, WESNN1_incr, 'WESNN1_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, WESNN2_incr, 'WESNN2_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, WESNN3_incr, 'WESNN3_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, HTSNNN1_incr, 'HTSNNN1_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, HTSNNN2_incr, 'HTSNNN2_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, HTSNNN3_incr, 'HTSNNN3_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, SNDZN1_incr, 'SNDZN1_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, SNDZN2_incr, 'SNDZN2_INCR' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, SNDZN3_incr, 'SNDZN3_INCR' ,rc=status) + VERIFY_(status) allocate(met_force(N_catl)) met_force(:)%Tair = TA_enavg(:) @@ -1440,6 +1571,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) end if allocate(cat_progn_incr(N_catl,NUM_ENSEMBLE)) + allocate(cat_progn_incr_ensavg(N_catl)) allocate(Observations_l(N_obsl_max)) !WY note: temportary @@ -1609,10 +1741,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Need to find the number N_catg = maxval(rf2g) - if (mod(secs_in_day, dtstep_assim)==0) then + if (mod(secs_in_day, dtstep_assim)==0) then - call output_incr_etc( out_ObsFcstAna, out_incr, & - out_incr_format, date_time_new, trim(out_path), trim(exp_id), & + call output_incr_etc( out_ObsFcstAna, & + date_time_new, trim(out_path), trim(exp_id), & N_obsl, N_obs_param, NUM_ENSEMBLE, & N_catl, tile_coord_l, & N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, & @@ -1623,6 +1755,48 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) Observations_l ) + do i = 1, N_catl + cat_progn_incr_ensavg(i) = 0.0 + do n_e=1, NUM_ENSEMBLE + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & + + cat_progn_incr(i,n_e) + end do + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) + enddo + + if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 + if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 + if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 + if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 + if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 + if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 + + if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac + if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef + if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc + if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc + + if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) + if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) + if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) + if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) + if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) + if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) + + if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) + if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) + if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) + + if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) + if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) + if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) + + if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) + if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) + if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) + + + ! write analysis fields into SMAP L4_SM aup file ! whenever it was time for assimilation (regardless ! of whether obs were actually assimilated and fresh @@ -1647,6 +1821,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Pointers to inputs !-------------------- deallocate(cat_progn_incr) + deallocate(cat_progn_incr_ensavg) deallocate(Observations_l) call MAPL_TimerOff ( MAPL, "RUN" ) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 index a5ef8731..f13b1563 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 @@ -106,7 +106,7 @@ subroutine clsm_adapt_get_command_line( & character(40) :: arg - external getarg, iargc + !external getarg, iargc ! ----------------------------------------------------------------- diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 index 0e4b12d8..c080889b 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 @@ -111,7 +111,7 @@ subroutine clsm_cat_bias_get_command_line( & character(40) :: arg - external getarg, iargc + !external getarg, iargc ! ----------------------------------------------------------------- @@ -1493,7 +1493,7 @@ subroutine obs_bias_corr_obs(date_time, N_catl, N_catf, N_obsl, N_obs_param, & Observations(i)%obs - & obs_bias(ind_catl, ind_spec, indv_time(ind_spec))%bias ) - if (Observations(i)%assim .EQ. .TRUE.) then + if (Observations(i)%assim) then ! determine of obs bias correction is good enough for use of ! obs in state update diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 index f5895ff4..9891b0e6 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 @@ -544,7 +544,7 @@ subroutine GEOS_output_smapL4SMlmc( GC, date_time, work_path, exp_id, & ! ! ------------------------------------------------------------------- use ESMF - USE GEOS_MOD + USE MAPL_MOD implicit none type(ESMF_GridComp),intent(inout) :: GC diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 88ef48f1..29b0cf75 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -796,7 +796,7 @@ subroutine get_enkf_increments( & ! Step 3b: nObs_ana -> nObsAna_vec (on root) call MPI_Gather(nObs_ana,1,MPI_INTEGER, & nObsAna_vec,1,MPI_INTEGER,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,I,A,I)') & + if (master_proc .and. logit) write (logunit,'(2A,I7,A,I7)') & 'AnaLoadBal: nObs_ana statistics: ', & 'max =', maxval(nObsAna_vec), ', min =', minval(nObsAna_vec) @@ -1596,8 +1596,8 @@ end subroutine output_ObsFcstAna ! ********************************************************************** - subroutine output_incr_etc( out_ObsFcstAna, out_incr, & - out_incr_format, date_time, work_path, exp_id, & + subroutine output_incr_etc( out_ObsFcstAna, & + date_time, work_path, exp_id, & N_obsl, N_obs_param, N_ens, & N_catl, tile_coord_l, & N_catf, tile_coord_f, tile_grid_f, tile_grid_g, & @@ -1615,9 +1615,8 @@ subroutine output_incr_etc( out_ObsFcstAna, out_incr, & ! major revisions for new obs handling and MPI - logical, intent(in) :: out_ObsFcstAna, out_incr + logical, intent(in) :: out_ObsFcstAna - integer, intent(in) :: out_incr_format type(date_time_type), intent(in) :: date_time @@ -1710,94 +1709,94 @@ subroutine output_incr_etc( out_ObsFcstAna, out_incr, & ! output ens avg increments - if (out_incr) then - - ! compute increments for local domain - - do i=1,N_catl - cat_progn_incr_ensavg(i) = 0. - do n_e=1,N_ens - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & - + cat_progn_incr(i,n_e) - end do - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(N_ens) - end do - - - ! gather and write to file - - file_tag = 'ldas_incr' - dir_name = 'ana' - - if (master_proc) allocate(cat_progn_incr_f(N_catf)) - -#ifdef LDAS_MPI - - call MPI_GATHERV( & - cat_progn_incr_ensavg, N_catl, MPI_cat_progn_type, & - cat_progn_incr_f, N_catl_vec, low_ind-1, MPI_cat_progn_type, & - 0, mpicomm, mpierr ) - -#else - cat_progn_incr_f = cat_progn_incr_ensavg -#endif - if (master_proc) then - - - select case (out_incr_format) - - case (0) - - ! output increments in LDASsa domain and in LDASsa tile order (standard LDASsa) - if(present(rf2f)) then - allocate(cat_progn_incr_tmp(N_catf)) - cat_progn_incr_tmp(:) = cat_progn_incr_f(rf2f(:)) - cat_progn_incr_f = cat_progn_incr_tmp - deallocate(cat_progn_incr_tmp) - endif - - call io_rstrt( 'w', work_path, exp_id, -1, date_time, & - N_catf, cat_progn_incr_f, file_tag, dir_name=dir_name) - - case (1) - - ! output increments on global domain in GEOS-5 global tile order - ! suitable for reading into GEOS-5 GCM as land incremental analysis - ! update (LIAU) - - allocate(cat_progn_incr_g(N_catg)) - - ! initialize - - do i=1,N_catg - cat_progn_incr_g(i) = 0.0 - end do - - ! reorder increments to GEOS-5 gcm global tile order - - do i=1,N_catf - cat_progn_incr_g(f2g(i)) = cat_progn_incr_f(i) - end do - - file_tag = trim(file_tag) // 'LIAU' - - call io_rstrt( 'w', work_path, exp_id, -1, date_time, & - N_catg, cat_progn_incr_g, file_tag, dir_name=dir_name, & - is_little_endian=.true. ) - - deallocate(cat_progn_incr_g) - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown out_incr_format') - - end select - - deallocate(cat_progn_incr_f) - - end if ! masterproc - - end if ! out_incr +!! if (out_incr) then +!! +!! ! compute increments for local domain +!! +!! do i=1,N_catl +!! cat_progn_incr_ensavg(i) = 0. +!! do n_e=1,N_ens +!! cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & +!! + cat_progn_incr(i,n_e) +!! end do +!! cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(N_ens) +!! end do +!! +!! +!! ! gather and write to file +!! +!! file_tag = 'ldas_incr' +!! dir_name = 'ana' +!! +!! if (master_proc) allocate(cat_progn_incr_f(N_catf)) +!! +!!#ifdef LDAS_MPI +!! +!! call MPI_GATHERV( & +!! cat_progn_incr_ensavg, N_catl, MPI_cat_progn_type, & +!! cat_progn_incr_f, N_catl_vec, low_ind-1, MPI_cat_progn_type, & +!! 0, mpicomm, mpierr ) +!! +!!#else +!! cat_progn_incr_f = cat_progn_incr_ensavg +!!#endif +!! if (master_proc) then +!! +!! +!! select case (out_incr_format) +!! +!! case (0) +!! +!! ! output increments in LDASsa domain and in LDASsa tile order (standard LDASsa) +!! if(present(rf2f)) then +!! allocate(cat_progn_incr_tmp(N_catf)) +!! cat_progn_incr_tmp(:) = cat_progn_incr_f(rf2f(:)) +!! cat_progn_incr_f = cat_progn_incr_tmp +!! deallocate(cat_progn_incr_tmp) +!! endif +!! +!! call io_rstrt( 'w', work_path, exp_id, -1, date_time, & +!! N_catf, cat_progn_incr_f, file_tag, dir_name=dir_name) +!! +!! case (1) +!! +!! ! output increments on global domain in GEOS-5 global tile order +!! ! suitable for reading into GEOS-5 GCM as land incremental analysis +!! ! update (LIAU) +!! +!! allocate(cat_progn_incr_g(N_catg)) +!! +!! ! initialize +!! +!! do i=1,N_catg +!! cat_progn_incr_g(i) = 0.0 +!! end do +!! +!! ! reorder increments to GEOS-5 gcm global tile order +!! +!! do i=1,N_catf +!! cat_progn_incr_g(f2g(i)) = cat_progn_incr_f(i) +!! end do +!! +!! file_tag = trim(file_tag) // 'LIAU' +!! +!! call io_rstrt( 'w', work_path, exp_id, -1, date_time, & +!! N_catg, cat_progn_incr_g, file_tag, dir_name=dir_name, & +!! is_little_endian=.true. ) +!! +!! deallocate(cat_progn_incr_g) +!! +!! case default +!! +!! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown out_incr_format') +!! +!! end select +!! +!! deallocate(cat_progn_incr_f) +!! +!! end if ! masterproc +!! +!! end if ! out_incr end subroutine output_incr_etc diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 index 2c743bc6..119fcc82 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 @@ -3612,7 +3612,7 @@ subroutine read_obs_isccp_ts_ceop3n4_hdASC( & ! the following mapping is produced with ! land01:/home/reichle/GMAO/station_data/CEOP/EOP3n4/matlab/map_GEOS5_to_ISCCP_halfdeg.m - integer, dimension(2,N_tiles) :: GEOS5_to_ISCCP = (/ & + integer, dimension(2,N_tiles) :: GEOS5_to_ISCCP = reshape( (/ & 64402, -999, & 68663, 12, & 68677, 11, & @@ -3653,7 +3653,7 @@ subroutine read_obs_isccp_ts_ceop3n4_hdASC( & 101896, 6, & 101899, 5, & 101901, 9, & - 106846, 1 /) + 106846, 1 /), (/2,N_tiles/)) ! ISCCP files are available every 3h diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 index 94620d8d..7b933fa5 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 @@ -174,8 +174,8 @@ subroutine read_ens_upd_inputs( & obs_param, & out_obslog, & out_ObsFcstAna, & - out_incr, & - out_incr_format, & +! out_incr, & +! out_incr_format, & out_smapL4SMaup, & N_obsbias_max & ) @@ -229,10 +229,10 @@ subroutine read_ens_upd_inputs( & logical, intent(out) :: out_obslog logical, intent(out) :: out_ObsFcstAna - logical, intent(out) :: out_incr +! logical, intent(out) :: out_incr logical, intent(out) :: out_smapL4SMaup - integer, intent(out) :: out_incr_format +! integer, intent(out) :: out_incr_format integer, intent(out) :: N_obsbias_max @@ -277,8 +277,8 @@ subroutine read_ens_upd_inputs( & centered_update, & out_obslog, & out_ObsFcstAna, & - out_incr, & - out_incr_format, & +! out_incr, & +! out_incr_format, & out_smapL4SMaup, & xcompact, ycompact, & obs_param_nml @@ -729,7 +729,7 @@ subroutine clsm_ensupd_get_command_line( & character(40) :: arg - external getarg, iargc + !external getarg, iargc ! ----------------------------------------------------------------- @@ -4445,7 +4445,7 @@ subroutine cat_enkf_increments( & ! set temperature increment for each component temperature ! (do nothing if deltaT=0. because cat_progn_incr was initialized to 0.) - if (abs(deltaT>0.)) then + if (abs(deltaT)>0.) then ! TO DO: SHOULD PHASE CHANGE BE PREVENTED FOR TC1, TC2, TC4 AS WELL? ! SHOULD PHASE CHANGE BE PREVENTED BASED ON LAND COVER/CSOIL? diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 index d59d0568..42387c89 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 @@ -320,7 +320,7 @@ subroutine mwRTM_get_Tb( N_tile, freq, inc_angle, mwp, elev, & !--------------------------------------------------- - if (logunit) write(logunit,*) 'entering mwRTM_get_Tb...' + if (logit) write(logunit,*) 'entering mwRTM_get_Tb...' ! check first element of elevation against no-data-value @@ -492,7 +492,7 @@ subroutine mwRTM_get_Tb( N_tile, freq, inc_angle, mwp, elev, & end do - if (logunit) write(logunit,*) 'exiting mwRTM_get_Tb.' + if (logit) write(logunit,*) 'exiting mwRTM_get_Tb.' end subroutine mwRTM_get_Tb diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 index 800024b1..32e9d5f4 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 @@ -38,7 +38,7 @@ module GEOS_LandPertGridCompMod use LDAS_PertRoutinesMod, only: GEOSldas_PROGN_PERT_DTSTEP use LDAS_PertRoutinesMod, only: GEOSldas_NUM_ENSEMBLE use LDAS_PertRoutinesMod, only: GEOSldas_FIRST_ENS_ID - use LDAS_TileCoordRoutines, only: grid2tile, tile_mask_grid + use LDAS_TileCoordRoutines, only: grid2tile, tile2grid, tile_mask_grid use LDAS_TileCoordRoutines, only: get_ij_ind_from_latlon use force_and_cat_progn_pert_types, only: N_FORCE_PERT_MAX use force_and_cat_progn_pert_types, only: N_PROGN_PERT_MAX @@ -876,7 +876,7 @@ subroutine Initialize(gc, import, export, clock, rc) integer :: land_nt_local,m,n, i1, in, j1, jn logical :: IAmRoot logical :: COLDSTART - integer :: ipert,n_lon,n_lat + integer :: ipert,n_lon,n_lat, n_lon_g, n_lat_g integer, allocatable :: pert_rseed(:) real :: dlon, dlat,locallat,locallon type(ESMF_Grid) :: Grid @@ -961,10 +961,10 @@ subroutine Initialize(gc, import, export, clock, rc) ! Pointers to mapl internals if ( internal%isCubedSphere ) then - n_lon = internal%pgrid_g%n_lon - n_lat = internal%pgrid_g%n_lat - allocate(internal%fpert_ntrmdt(n_lon, n_lat, N_FORCE_PERT_MAX), source=0.0) - allocate(internal%ppert_ntrmdt(n_lon, n_lat, N_PROGN_PERT_MAX), source=0.0) + n_lon_g = internal%pgrid_g%n_lon + n_lat_g = internal%pgrid_g%n_lat + allocate(internal%fpert_ntrmdt(n_lon_g, n_lat_g, N_FORCE_PERT_MAX), source=0.0) + allocate(internal%ppert_ntrmdt(n_lon_g, n_lat_g, N_PROGN_PERT_MAX), source=0.0) allocate(internal%pert_rseed_r8(NRANDSEED), source=0.0d0) call MAPL_GetResource(MAPL, rst_fname, trim(comp_name)//'_INTERNAL_RESTART_FILE:',DEFAULT='NONE', rc=status) @@ -975,13 +975,13 @@ subroutine Initialize(gc, import, export, clock, rc) if ( IAmRoot) then call read_pert_rst(trim(rst_fname),internal%fpert_ntrmdt,internal%ppert_ntrmdt, internal%pert_rseed_r8) endif - n = n_lat*N_lon*N_FORCE_PERT_MAX + n = n_lat_g*n_lon_g*N_FORCE_PERT_MAX call c_f_pointer(c_loc(internal%fpert_ntrmdt(1,1,1)), pert_ptr, [n]) call MAPL_CommsBcast(vm, data=pert_ptr, N=n, ROOT=0,rc=status) VERIFY_(status) pert_ptr=>null() - n = n_lat*N_lon*N_PROGN_PERT_MAX + n = n_lat_g*n_lon_g*N_PROGN_PERT_MAX call c_f_pointer(c_loc(internal%ppert_ntrmdt(1,1,1)), pert_ptr, [n]) call MAPL_CommsBcast(vm, data=pert_ptr, N=n, ROOT=0,rc=status) VERIFY_(status) @@ -993,10 +993,10 @@ subroutine Initialize(gc, import, export, clock, rc) fpert_ntrmdt => internal%fpert_ntrmdt ppert_ntrmdt => internal%ppert_ntrmdt pert_rseed_r8 => internal%pert_rseed_r8 - lon1 = 1 - lon2 = n_lon - lat1 = 1 - lat2 = n_lat + lon1 = internal%pgrid_l%i_offg + 1 + lon2 = internal%pgrid_l%i_offg + n_lon + lat1 = internal%pgrid_l%j_offg + 1 + lat2 = internal%pgrid_l%j_offg + n_lat else call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=MINTERNAL, rc=status) VERIFY_(status) @@ -1044,19 +1044,8 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) allocate(internal%j_indgs(land_nt_local),stat=status) VERIFY_(status) - ! if it cubbed-sphere grid, calculalte the mapping for grid2tile - if(index(tcwrap%ptr%grid_g%gridtype,"c3") /=0) then - do n=1,land_nt_local - call get_ij_ind_from_latlon(internal%pgrid_g,tile_coord(n)%com_lat,tile_coord(n)%com_lon, & - internal%i_indgs(n),internal%j_indgs(n)) - internal%i_indgs(n) = min( internal%pgrid_g%N_lon, max( 1, internal%i_indgs(n))) - internal%j_indgs(n) = min( internal%pgrid_g%N_lat, max( 1, internal%j_indgs(n))) - enddo - else - internal%i_indgs(:)=tile_coord(:)%i_indg - internal%j_indgs(:)=tile_coord(:)%j_indg - endif - + internal%i_indgs(:)=tile_coord(:)%i_indg + internal%j_indgs(:)=tile_coord(:)%j_indg ! Get pert options from *default* namelist files ! WARNING: get_force/progn_pert_param() calls allocate memory @@ -1514,6 +1503,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) ! Internal private state variables type(T_LANDPERT_STATE), pointer :: internal=>null() type(LANDPERT_WRAP) :: wrap + type(TILECOORD_WRAP) :: tcwrap type(MAPL_LocStream) :: locstream ! MAPL internal pointers @@ -1527,6 +1517,12 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) integer, allocatable :: pert_rseed(:) integer :: m,n_lon,n_lat, land_nt_local + integer :: nfpert, nppert, n_tile + type(tile_coord_type), pointer :: tile_coord_f(:)=>null() + type (ESMF_Grid) :: tilegrid + integer, pointer :: mask(:) + real, allocatable, dimension(:,:) :: tile_data_f, tile_data_p, tile_data_f_all, tile_data_p_all + ! Get component's name and setup traceback handle call ESMF_GridCompget(gc, name=comp_name, rc=status) VERIFY_(status) @@ -1590,8 +1586,61 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) pert_rseed = nint(pert_rseed_r8) - if (MAPL_RecordAlarmIsRinging(MAPL, rc=status)) then - if (internal%isCubedSphere .and. IamRoot) then + if (MAPL_RecordAlarmIsRinging(MAPL, rc=status) .and. internal%isCubedSphere) then + + call MAPL_LocStreamGet(LOCSTREAM, TILEGRID=TILEGRID, RC=STATUS) + VERIFY_(STATUS) + call MAPL_TileMaskGet(tilegrid, mask, rc=status) + VERIFY_(STATUS) + call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) + VERIFY_(status) + + nfpert = internal%ForcePert%npert + nppert = internal%PrognPert%npert + tile_coord_f => tcwrap%ptr%tile_coord_f + n_tile = size(tile_coord_f,1) + ! 1) grid2tile + allocate(tile_data_f(land_nt_local,nfpert)) + allocate(tile_data_p(land_nt_local,nppert)) + do m = 1, nfpert + call grid2tile(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), & + fpert_ntrmdt(lon1:lon2,lat1:lat2,m), tile_data_f(:,m)) + enddo + do m = 1, nppert + call grid2tile(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), & + ppert_ntrmdt(lon1:lon2,lat1:lat2,m), tile_data_p(:,m)) + enddo + ! 2) gather tiledata + if (IAmRoot) then + allocate(tile_data_f_all(n_tile,nfpert), stat=status) + VERIFY_(STATUS) + allocate(tile_data_p_all(n_tile,nppert), stat=status) + VERIFY_(STATUS) + else + allocate(tile_data_f_all(0,nfpert), stat=status) + VERIFY_(STATUS) + allocate(tile_data_p_all(0,nppert), stat=status) + VERIFY_(STATUS) + end if + + do m = 1, nfpert + call ArrayGather(tile_data_f(:,m), tile_data_f_all(:,m), tilegrid, mask=mask, rc=status) + VERIFY_(STATUS) + enddo + do m = 1, nppert + call ArrayGather(tile_data_p(:,m), tile_data_p_all(:,m), tilegrid, mask=mask, rc=status) + VERIFY_(STATUS) + enddo + if (IamRoot) then + ! 3) tile2grid + do m = 1, nfpert + call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_f_all(:,m), internal%fpert_ntrmdt(:,:,m)) + enddo + do m = 1, nppert + call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_p_all(:,m), internal%ppert_ntrmdt(:,:,m)) + enddo + + ! 4) writing call MAPL_DateStampGet(clock, datestamp, rc=status) VERIFY_(STATUS) @@ -1599,8 +1648,10 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) if(internal%NUM_ENSEMBLE ==1 ) id_string='' chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint.'//datestamp + call write_pert_checkpoint(trim(chk_fname),internal%fpert_ntrmdt, internal%ppert_ntrmdt, internal%pert_rseed_r8) endif + deallocate(tile_data_f, tile_data_p, tile_data_f_all, tile_data_p_all) endif if (ESMF_AlarmIsRinging(ForcePertAlarm)) then @@ -2619,7 +2670,15 @@ subroutine Finalize(gc, import, export, clock, rc) ! Internal private state variables type(T_LANDPERT_STATE), pointer :: internal=>null() type(LANDPERT_WRAP) :: wrap + type(MAPL_LocStream) :: locstream + type(TILECOORD_WRAP) :: tcwrap + integer :: m,n_lon,n_lat, land_nt_local + integer :: nfpert, nppert, n_tile + type(tile_coord_type), pointer :: tile_coord_f(:)=>null() + type (ESMF_Grid) :: tilegrid + integer, pointer :: mask(:) + real, allocatable, dimension(:,:) :: tile_data_f, tile_data_p, tile_data_f_all, tile_data_p_all ! Begin... @@ -2638,12 +2697,71 @@ subroutine Finalize(gc, import, export, clock, rc) VERIFY_(status) internal => wrap%ptr - if ( MAPL_Am_I_Root() .and. internal%isCubedSphere .and. internal%PERTURBATIONS /= 0) then - write(id_string,'(I4.4)') internal%ens_id - if(internal%NUM_ENSEMBLE ==1 ) id_string='' + if ( internal%isCubedSphere .and. internal%PERTURBATIONS /= 0) then + call MAPL_Get(MAPL, LocStream=locstream,rc=status) + VERIFY_(status) + call MAPL_LocStreamGet(locstream, NT_LOCAL=land_nt_local,rc=status) + VERIFY_(status) + call MAPL_LocStreamGet(LOCSTREAM, TILEGRID=TILEGRID, RC=STATUS) + VERIFY_(STATUS) + call MAPL_TileMaskGet(tilegrid, mask, rc=status) + VERIFY_(STATUS) + call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) + VERIFY_(status) - chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint' - call write_pert_checkpoint(trim(chk_fname),internal%fpert_ntrmdt, internal%ppert_ntrmdt, internal%pert_rseed_r8) + nfpert = internal%ForcePert%npert + nppert = internal%PrognPert%npert + tile_coord_f => tcwrap%ptr%tile_coord_f + n_tile = size(tile_coord_f,1) + ! 1) grid2tile + allocate(tile_data_f(land_nt_local,nfpert)) + allocate(tile_data_p(land_nt_local,nppert)) + do m = 1, nfpert + call grid2tile(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), & + internal%fpert_ntrmdt(lon1:lon2,lat1:lat2,m), tile_data_f(:,m)) + enddo + do m = 1, nppert + call grid2tile(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), & + internal%ppert_ntrmdt(lon1:lon2,lat1:lat2,m), tile_data_p(:,m)) + enddo + ! 2) gather tiledata + if (MAPL_am_I_Root()) then + allocate(tile_data_f_all(n_tile,nfpert), stat=status) + VERIFY_(STATUS) + allocate(tile_data_p_all(n_tile,nppert), stat=status) + VERIFY_(STATUS) + else + allocate(tile_data_f_all(0,nfpert), stat=status) + VERIFY_(STATUS) + allocate(tile_data_p_all(0,nppert), stat=status) + VERIFY_(STATUS) + end if + + do m = 1, nfpert + call ArrayGather(tile_data_f(:,m), tile_data_f_all(:,m), tilegrid, mask=mask, rc=status) + VERIFY_(STATUS) + enddo + do m = 1, nppert + call ArrayGather(tile_data_p(:,m), tile_data_p_all(:,m), tilegrid, mask=mask, rc=status) + VERIFY_(STATUS) + enddo + if (MAPL_am_I_Root()) then + ! 3) tile2grid + do m = 1, nfpert + call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_f_all(:,m), internal%fpert_ntrmdt(:,:,m)) + enddo + do m = 1, nppert + call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_p_all(:,m), internal%ppert_ntrmdt(:,:,m)) + enddo + + ! 4) writing + write(id_string,'(I4.4)') internal%ens_id + if(internal%NUM_ENSEMBLE ==1 ) id_string='' + + chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint' + call write_pert_checkpoint(trim(chk_fname),internal%fpert_ntrmdt, internal%ppert_ntrmdt, internal%pert_rseed_r8) + endif + deallocate(tile_data_f, tile_data_p, tile_data_f_all, tile_data_p_all) endif ! Clean up private internal state @@ -2779,6 +2897,8 @@ subroutine write_pert_checkpoint(chk_fname, fpert,ppert, pert_rseed_r8) call check( nf90_def_var(ncid, 'ppert_ntrmdt', NF90_REAL, dimids, p_varid) ) call check( nf90_def_var(ncid, 'pert_rseed', NF90_DOUBLE, seed_dimid, s_varid) ) + call check( nf90_def_var_deflate(ncid, f_varid, 1, 1, 2)) + call check( nf90_def_var_deflate(ncid, p_varid, 1, 1, 2)) ! Assign attribute call check( nf90_put_att(ncid, f_varid, UNITS, units_) ) call check( nf90_put_att(ncid, p_varid, UNITS, units_) ) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 index d78a0479..efb254d9 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 @@ -314,12 +314,6 @@ subroutine read_ens_prop_inputs( & ! ----------------------------------------------------------------- - call ESMF_VmGetCurrent(vm, rc=status) - VERIFY_(status) - call ESMF_VmGet(vm, mpicommunicator=mpicomm, rc=status) - VERIFY_(status) - master_proc = MAPL_Am_I_Root(vm) - namelist /ens_prop_inputs/ & N_ens, & first_ens_id, & @@ -350,6 +344,13 @@ subroutine read_ens_prop_inputs( & tcorr_force_pert, & ccorr_force_pert + + call ESMF_VmGetCurrent(vm, rc=status) + VERIFY_(status) + call ESMF_VmGet(vm, mpicommunicator=mpicomm, rc=status) + VERIFY_(status) + master_proc = MAPL_Am_I_Root(vm) + ! --------------------------------------------------------------------- ! ! initialize selected name list inputs @@ -716,8 +717,8 @@ subroutine get_pert_grid( tile_grid, pert_grid ) !for cubed-sphere grid, global lat_lon grid N_x=tile_grid%n_lon - n_lon=3*N_x - n_lat=2*N_x + n_lon=4*N_x + n_lat=3*N_x write(lattmp,'(I6.6)') n_lat write(lontmp,'(I6.6)') n_lon latlon_gridname = "DE"//lontmp//"x"//"PE"//lattmp diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index 52b97404..c5e10a33 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -1,10 +1,12 @@ #include "MAPL_Generic.h" + module LDAS_ForceMod ! collection of *forcing* subroutines for enkf_driver ! (originally these routines were in clsm_ensdrv_drv_routines.F90) ! reichle, 13 Aug 2008 + use, intrinsic :: iso_c_binding use ESMF use MAPL_Mod use MAPL_ShmemMod @@ -72,7 +74,7 @@ module LDAS_ForceMod character(10), private :: tmpstring10 character(40), private :: tmpstring40 - real,pointer :: ptrShForce(:,:)=>null() + real, contiguous, pointer :: ptrShForce(:,:)=>null() type local_grid integer :: N_lon = 0 @@ -2563,19 +2565,19 @@ subroutine get_GEOS(date_time, force_dtstep, & ! ! lfo_inst/tavg data available from 11 Jun 2013 (start of GEOS-5 ADAS version 5.11) - G5DAS_defs( 1,:)=(/'SWGDN ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 2,:)=(/'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 3,:)=(/'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 4,:)=(/'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 5,:)=(/'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 6,:)=(/'PRECCU ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 7,:)=(/'PRECLS ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 8,:)=(/'PRECSNO ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - G5DAS_defs( 9,:)=(/'PS ','inst','inst1_2d_lfo_Nx','diag','S'/) - G5DAS_defs(10,:)=(/'HLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - G5DAS_defs(11,:)=(/'TLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - G5DAS_defs(12,:)=(/'QLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - G5DAS_defs(13,:)=(/'SPEEDLML','inst','inst1_2d_lfo_Nx','diag','S'/) + G5DAS_defs( 1,:)=[character(len=40):: 'SWGDN ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 2,:)=[character(len=40):: 'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 3,:)=[character(len=40):: 'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 4,:)=[character(len=40):: 'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 5,:)=[character(len=40):: 'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 6,:)=[character(len=40):: 'PRECCU ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 7,:)=[character(len=40):: 'PRECLS ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 8,:)=[character(len=40):: 'PRECSNO ','tavg','tavg1_2d_lfo_Nx','diag','F'] + G5DAS_defs( 9,:)=[character(len=40):: 'PS ','inst','inst1_2d_lfo_Nx','diag','S'] + G5DAS_defs(10,:)=[character(len=40):: 'HLML ','inst','inst1_2d_lfo_Nx','diag','S'] + G5DAS_defs(11,:)=[character(len=40):: 'TLML ','inst','inst1_2d_lfo_Nx','diag','S'] + G5DAS_defs(12,:)=[character(len=40):: 'QLML ','inst','inst1_2d_lfo_Nx','diag','S'] + G5DAS_defs(13,:)=[character(len=40):: 'SPEEDLML','inst','inst1_2d_lfo_Nx','diag','S'] ! MERRA-2 file specs with uncorrected (AGCM) precip from the "int" Collection @@ -2588,80 +2590,80 @@ subroutine get_GEOS(date_time, force_dtstep, & ! which are global, as is SWGDN in the FP "lfo" files. ! - reichle, 7 Dec 2015 - M2INT_defs( 1,:)=(/'SWGDN ','tavg','tavg1_2d_rad_Nx','diag','F'/) ! use "rad" Collection - M2INT_defs( 2,:)=(/'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2INT_defs( 3,:)=(/'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2INT_defs( 4,:)=(/'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2INT_defs( 5,:)=(/'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2INT_defs( 6,:)=(/'PRECCU ','tavg','tavg1_2d_int_Nx','diag','F'/) ! uncorrected - M2INT_defs( 7,:)=(/'PRECLS ','tavg','tavg1_2d_int_Nx','diag','F'/) ! uncorrected - M2INT_defs( 8,:)=(/'PRECSN ','tavg','tavg1_2d_int_Nx','diag','F'/) ! uncorrected - M2INT_defs( 9,:)=(/'PS ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2INT_defs(10,:)=(/'HLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2INT_defs(11,:)=(/'TLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2INT_defs(12,:)=(/'QLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2INT_defs(13,:)=(/'SPEEDLML','inst','inst1_2d_lfo_Nx','diag','S'/) - - M2INT_defs(14,:)=(/'DUDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(15,:)=(/'DUDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(16,:)=(/'DUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(17,:)=(/'DUDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(18,:)=(/'DUDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(19,:)=(/'DUSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(20,:)=(/'DUSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(21,:)=(/'DUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(22,:)=(/'DUSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(23,:)=(/'DUSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(24,:)=(/'DUWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(25,:)=(/'DUWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(26,:)=(/'DUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(27,:)=(/'DUWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(28,:)=(/'DUWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(29,:)=(/'DUSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(30,:)=(/'DUSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(31,:)=(/'DUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(32,:)=(/'DUSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(33,:)=(/'DUSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(34,:)=(/'BCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(35,:)=(/'BCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(36,:)=(/'BCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(37,:)=(/'BCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(38,:)=(/'BCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(39,:)=(/'BCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(40,:)=(/'BCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(41,:)=(/'BCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(42,:)=(/'OCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(43,:)=(/'OCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(44,:)=(/'OCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(45,:)=(/'OCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(46,:)=(/'OCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(47,:)=(/'OCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(48,:)=(/'OCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(49,:)=(/'OCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(50,:)=(/'SUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(51,:)=(/'SUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(52,:)=(/'SUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(53,:)=(/'SUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(54,:)=(/'SSDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(55,:)=(/'SSDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(56,:)=(/'SSDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(57,:)=(/'SSDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(58,:)=(/'SSDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(59,:)=(/'SSSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(60,:)=(/'SSSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(61,:)=(/'SSSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(62,:)=(/'SSSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(63,:)=(/'SSSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(64,:)=(/'SSWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(65,:)=(/'SSWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(66,:)=(/'SSWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(67,:)=(/'SSWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(68,:)=(/'SSWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(69,:)=(/'SSSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(70,:)=(/'SSSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(71,:)=(/'SSSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(72,:)=(/'SSSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2INT_defs(73,:)=(/'SSSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) + M2INT_defs( 1,:)=[character(len=40):: 'SWGDN ','tavg','tavg1_2d_rad_Nx','diag','F'] ! use "rad" Collection + M2INT_defs( 2,:)=[character(len=40):: 'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2INT_defs( 3,:)=[character(len=40):: 'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2INT_defs( 4,:)=[character(len=40):: 'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2INT_defs( 5,:)=[character(len=40):: 'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2INT_defs( 6,:)=[character(len=40):: 'PRECCU ','tavg','tavg1_2d_int_Nx','diag','F'] ! uncorrected + M2INT_defs( 7,:)=[character(len=40):: 'PRECLS ','tavg','tavg1_2d_int_Nx','diag','F'] ! uncorrected + M2INT_defs( 8,:)=[character(len=40):: 'PRECSN ','tavg','tavg1_2d_int_Nx','diag','F'] ! uncorrected + M2INT_defs( 9,:)=[character(len=40):: 'PS ','inst','inst1_2d_lfo_Nx','diag','S'] + M2INT_defs(10,:)=[character(len=40):: 'HLML ','inst','inst1_2d_lfo_Nx','diag','S'] + M2INT_defs(11,:)=[character(len=40):: 'TLML ','inst','inst1_2d_lfo_Nx','diag','S'] + M2INT_defs(12,:)=[character(len=40):: 'QLML ','inst','inst1_2d_lfo_Nx','diag','S'] + M2INT_defs(13,:)=[character(len=40):: 'SPEEDLML','inst','inst1_2d_lfo_Nx','diag','S'] + + M2INT_defs(14,:)=[character(len=40):: 'DUDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(15,:)=[character(len=40):: 'DUDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(16,:)=[character(len=40):: 'DUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(17,:)=[character(len=40):: 'DUDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(18,:)=[character(len=40):: 'DUDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(19,:)=[character(len=40):: 'DUSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(20,:)=[character(len=40):: 'DUSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(21,:)=[character(len=40):: 'DUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(22,:)=[character(len=40):: 'DUSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(23,:)=[character(len=40):: 'DUSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(24,:)=[character(len=40):: 'DUWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(25,:)=[character(len=40):: 'DUWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(26,:)=[character(len=40):: 'DUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(27,:)=[character(len=40):: 'DUWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(28,:)=[character(len=40):: 'DUWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(29,:)=[character(len=40):: 'DUSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(30,:)=[character(len=40):: 'DUSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(31,:)=[character(len=40):: 'DUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(32,:)=[character(len=40):: 'DUSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(33,:)=[character(len=40):: 'DUSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(34,:)=[character(len=40):: 'BCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(35,:)=[character(len=40):: 'BCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(36,:)=[character(len=40):: 'BCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(37,:)=[character(len=40):: 'BCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(38,:)=[character(len=40):: 'BCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(39,:)=[character(len=40):: 'BCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(40,:)=[character(len=40):: 'BCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(41,:)=[character(len=40):: 'BCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(42,:)=[character(len=40):: 'OCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(43,:)=[character(len=40):: 'OCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(44,:)=[character(len=40):: 'OCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(45,:)=[character(len=40):: 'OCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(46,:)=[character(len=40):: 'OCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(47,:)=[character(len=40):: 'OCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(48,:)=[character(len=40):: 'OCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(49,:)=[character(len=40):: 'OCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(50,:)=[character(len=40):: 'SUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(51,:)=[character(len=40):: 'SUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(52,:)=[character(len=40):: 'SUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(53,:)=[character(len=40):: 'SUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(54,:)=[character(len=40):: 'SSDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(55,:)=[character(len=40):: 'SSDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(56,:)=[character(len=40):: 'SSDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(57,:)=[character(len=40):: 'SSDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(58,:)=[character(len=40):: 'SSDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(59,:)=[character(len=40):: 'SSSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(60,:)=[character(len=40):: 'SSSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(61,:)=[character(len=40):: 'SSSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(62,:)=[character(len=40):: 'SSSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(63,:)=[character(len=40):: 'SSSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(64,:)=[character(len=40):: 'SSWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(65,:)=[character(len=40):: 'SSWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(66,:)=[character(len=40):: 'SSWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(67,:)=[character(len=40):: 'SSWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(68,:)=[character(len=40):: 'SSWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(69,:)=[character(len=40):: 'SSSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(70,:)=[character(len=40):: 'SSSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(71,:)=[character(len=40):: 'SSSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(72,:)=[character(len=40):: 'SSSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2INT_defs(73,:)=[character(len=40):: 'SSSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'] ! MERRA-2 file specs with corrected precip, which could be either @@ -2676,80 +2678,80 @@ subroutine get_GEOS(date_time, force_dtstep, & ! ! NOTE: Use SWGDN from the "rad" Collection (see comment above). - M2COR_defs( 1,:)=(/'SWGDN ','tavg','tavg1_2d_rad_Nx','diag','F'/) ! use "rad" Collection - M2COR_defs( 2,:)=(/'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2COR_defs( 3,:)=(/'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2COR_defs( 4,:)=(/'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2COR_defs( 5,:)=(/'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'/) - M2COR_defs( 6,:)=(/'PRECCUCORR ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! MERRA-2 built-in corrections - M2COR_defs( 7,:)=(/'PRECLSCORR ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! MERRA-2 built-in corrections - M2COR_defs( 8,:)=(/'PRECSNOCORR','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! MERRA-2 built-in corrections - M2COR_defs( 9,:)=(/'PS ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2COR_defs(10,:)=(/'HLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2COR_defs(11,:)=(/'TLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2COR_defs(12,:)=(/'QLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - M2COR_defs(13,:)=(/'SPEEDLML ','inst','inst1_2d_lfo_Nx','diag','S'/) - - M2COR_defs(14,:)=(/'DUDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(15,:)=(/'DUDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(16,:)=(/'DUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(17,:)=(/'DUDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(18,:)=(/'DUDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(19,:)=(/'DUSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(20,:)=(/'DUSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(21,:)=(/'DUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(22,:)=(/'DUSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(23,:)=(/'DUSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(24,:)=(/'DUWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(25,:)=(/'DUWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(26,:)=(/'DUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(27,:)=(/'DUWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(28,:)=(/'DUWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(29,:)=(/'DUSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(30,:)=(/'DUSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(31,:)=(/'DUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(32,:)=(/'DUSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(33,:)=(/'DUSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(34,:)=(/'BCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(35,:)=(/'BCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(36,:)=(/'BCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(37,:)=(/'BCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(38,:)=(/'BCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(39,:)=(/'BCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(40,:)=(/'BCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(41,:)=(/'BCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(42,:)=(/'OCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(43,:)=(/'OCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(44,:)=(/'OCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(45,:)=(/'OCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(46,:)=(/'OCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(47,:)=(/'OCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(48,:)=(/'OCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(49,:)=(/'OCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(50,:)=(/'SUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(51,:)=(/'SUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(52,:)=(/'SUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(53,:)=(/'SUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(54,:)=(/'SSDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(55,:)=(/'SSDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(56,:)=(/'SSDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(57,:)=(/'SSDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(58,:)=(/'SSDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(59,:)=(/'SSSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(60,:)=(/'SSSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(61,:)=(/'SSSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(62,:)=(/'SSSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(63,:)=(/'SSSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(64,:)=(/'SSWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(65,:)=(/'SSWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(66,:)=(/'SSWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(67,:)=(/'SSWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(68,:)=(/'SSWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(69,:)=(/'SSSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(70,:)=(/'SSSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(71,:)=(/'SSSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(72,:)=(/'SSSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'/) - M2COR_defs(73,:)=(/'SSSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'/) + M2COR_defs( 1,:)=[character(len=40):: 'SWGDN ','tavg','tavg1_2d_rad_Nx','diag','F'] ! use "rad" Collection + M2COR_defs( 2,:)=[character(len=40):: 'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2COR_defs( 3,:)=[character(len=40):: 'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2COR_defs( 4,:)=[character(len=40):: 'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2COR_defs( 5,:)=[character(len=40):: 'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'] + M2COR_defs( 6,:)=[character(len=40):: 'PRECCUCORR ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! MERRA-2 built-in corrections + M2COR_defs( 7,:)=[character(len=40):: 'PRECLSCORR ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! MERRA-2 built-in corrections + M2COR_defs( 8,:)=[character(len=40):: 'PRECSNOCORR','tavg','tavg1_2d_lfo_Nx','diag','F'] ! MERRA-2 built-in corrections + M2COR_defs( 9,:)=[character(len=40):: 'PS ','inst','inst1_2d_lfo_Nx','diag','S'] + M2COR_defs(10,:)=[character(len=40):: 'HLML ','inst','inst1_2d_lfo_Nx','diag','S'] + M2COR_defs(11,:)=[character(len=40):: 'TLML ','inst','inst1_2d_lfo_Nx','diag','S'] + M2COR_defs(12,:)=[character(len=40):: 'QLML ','inst','inst1_2d_lfo_Nx','diag','S'] + M2COR_defs(13,:)=[character(len=40):: 'SPEEDLML ','inst','inst1_2d_lfo_Nx','diag','S'] + + M2COR_defs(14,:)=[character(len=40):: 'DUDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(15,:)=[character(len=40):: 'DUDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(16,:)=[character(len=40):: 'DUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(17,:)=[character(len=40):: 'DUDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(18,:)=[character(len=40):: 'DUDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(19,:)=[character(len=40):: 'DUSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(20,:)=[character(len=40):: 'DUSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(21,:)=[character(len=40):: 'DUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(22,:)=[character(len=40):: 'DUSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(23,:)=[character(len=40):: 'DUSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(24,:)=[character(len=40):: 'DUWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(25,:)=[character(len=40):: 'DUWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(26,:)=[character(len=40):: 'DUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(27,:)=[character(len=40):: 'DUWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(28,:)=[character(len=40):: 'DUWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(29,:)=[character(len=40):: 'DUSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(30,:)=[character(len=40):: 'DUSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(31,:)=[character(len=40):: 'DUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(32,:)=[character(len=40):: 'DUSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(33,:)=[character(len=40):: 'DUSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(34,:)=[character(len=40):: 'BCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(35,:)=[character(len=40):: 'BCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(36,:)=[character(len=40):: 'BCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(37,:)=[character(len=40):: 'BCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(38,:)=[character(len=40):: 'BCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(39,:)=[character(len=40):: 'BCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(40,:)=[character(len=40):: 'BCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(41,:)=[character(len=40):: 'BCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(42,:)=[character(len=40):: 'OCDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(43,:)=[character(len=40):: 'OCDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(44,:)=[character(len=40):: 'OCSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(45,:)=[character(len=40):: 'OCSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(46,:)=[character(len=40):: 'OCWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(47,:)=[character(len=40):: 'OCWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(48,:)=[character(len=40):: 'OCSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(49,:)=[character(len=40):: 'OCSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(50,:)=[character(len=40):: 'SUDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(51,:)=[character(len=40):: 'SUSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(52,:)=[character(len=40):: 'SUWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(53,:)=[character(len=40):: 'SUSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(54,:)=[character(len=40):: 'SSDP001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(55,:)=[character(len=40):: 'SSDP002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(56,:)=[character(len=40):: 'SSDP003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(57,:)=[character(len=40):: 'SSDP004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(58,:)=[character(len=40):: 'SSDP005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(59,:)=[character(len=40):: 'SSSV001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(60,:)=[character(len=40):: 'SSSV002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(61,:)=[character(len=40):: 'SSSV003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(62,:)=[character(len=40):: 'SSSV004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(63,:)=[character(len=40):: 'SSSV005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(64,:)=[character(len=40):: 'SSWT001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(65,:)=[character(len=40):: 'SSWT002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(66,:)=[character(len=40):: 'SSWT003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(67,:)=[character(len=40):: 'SSWT004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(68,:)=[character(len=40):: 'SSWT005 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(69,:)=[character(len=40):: 'SSSD001 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(70,:)=[character(len=40):: 'SSSD002 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(71,:)=[character(len=40):: 'SSSD003 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(72,:)=[character(len=40):: 'SSSD004 ','tavg','tavg1_2d_adg_Nx','diag','F'] + M2COR_defs(73,:)=[character(len=40):: 'SSSD005 ','tavg','tavg1_2d_adg_Nx','diag','F'] ! MERRA file specs @@ -2768,20 +2770,20 @@ subroutine get_GEOS(date_time, force_dtstep, & ! MERRA ! collection - MERRA_defs( 1,:)=(/'SWGDN ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "rad" - MERRA_defs( 2,:)=(/'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "lnd" - MERRA_defs( 3,:)=(/'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "rad" - MERRA_defs( 4,:)=(/'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "lnd" - MERRA_defs( 5,:)=(/'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "lnd" - MERRA_defs( 6,:)=(/'PRECTOT','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "lnd" - MERRA_defs( 7,:)=(/'PRECCON','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "flx" - MERRA_defs( 8,:)=(/'PRECSNO','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "lnd" - MERRA_defs( 9,:)=(/'PS ','tavg','tavg1_2d_lfo_Nx','diag','S'/) ! "slv" - MERRA_defs(10,:)=(/'HLML ','tavg','tavg1_2d_lfo_Nx','diag','S'/) ! "flx" - MERRA_defs(11,:)=(/'TLML ','tavg','tavg1_2d_lfo_Nx','diag','S'/) ! "flx" - MERRA_defs(12,:)=(/'QLML ','tavg','tavg1_2d_lfo_Nx','diag','S'/) ! "flx" - MERRA_defs(13,:)=(/'ULML ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "flx" - MERRA_defs(14,:)=(/'VLML ','tavg','tavg1_2d_lfo_Nx','diag','F'/) ! "flx" + MERRA_defs( 1,:)=[character(len=40):: 'SWGDN ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "rad" + MERRA_defs( 2,:)=[character(len=40):: 'SWLAND ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "lnd" + MERRA_defs( 3,:)=[character(len=40):: 'LWGAB ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "rad" + MERRA_defs( 4,:)=[character(len=40):: 'PARDR ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "lnd" + MERRA_defs( 5,:)=[character(len=40):: 'PARDF ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "lnd" + MERRA_defs( 6,:)=[character(len=40):: 'PRECTOT','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "lnd" + MERRA_defs( 7,:)=[character(len=40):: 'PRECCON','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "flx" + MERRA_defs( 8,:)=[character(len=40):: 'PRECSNO','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "lnd" + MERRA_defs( 9,:)=[character(len=40):: 'PS ','tavg','tavg1_2d_lfo_Nx','diag','S'] ! "slv" + MERRA_defs(10,:)=[character(len=40):: 'HLML ','tavg','tavg1_2d_lfo_Nx','diag','S'] ! "flx" + MERRA_defs(11,:)=[character(len=40):: 'TLML ','tavg','tavg1_2d_lfo_Nx','diag','S'] ! "flx" + MERRA_defs(12,:)=[character(len=40):: 'QLML ','tavg','tavg1_2d_lfo_Nx','diag','S'] ! "flx" + MERRA_defs(13,:)=[character(len=40):: 'ULML ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "flx" + MERRA_defs(14,:)=[character(len=40):: 'VLML ','tavg','tavg1_2d_lfo_Nx','diag','F'] ! "flx" ! -------------------------------------------------------------------- ! @@ -3030,7 +3032,7 @@ subroutine get_GEOS(date_time, force_dtstep, & end do ! j=1,2 - call GEOS_openfile(FileOpenedHash,fname_full,fid,tile_coord%com_lon,tile_coord%com_lat,met_hinterp) + call GEOS_openfile(FileOpenedHash,fname_full,fid,tile_coord,met_hinterp) !fid = ptrNode%fid @@ -3142,7 +3144,7 @@ subroutine get_GEOS(date_time, force_dtstep, & met_path_tmp, met_tag_tmp, & GEOSgcm_defs(GEOSgcm_var,:), met_file_ext) - call GEOS_openfile(FileOpenedHash,fname_full,fid,tile_coord%com_lon,tile_coord%com_lat,met_hinterp) + call GEOS_openfile(FileOpenedHash,fname_full,fid,tile_coord,met_hinterp) !fid = ptrNode%fid @@ -3433,6 +3435,9 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & ! real,allocatable :: tmp_grid(:,:) integer begDate, begTime, seconds, minutes, incSecs integer iistart(3), iicount(3), timeIndex + integer istart(4), icount(4) ! cs grid + real, pointer :: tmpShared(:,:,:,:) ! cs grid + type(c_ptr) :: c_address integer nv_id,imin, jmin, imax, jmax,ierr integer DiffDate @@ -3445,7 +3450,7 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & !integer :: rank,myid, io_rank, total_prcs !integer :: length character(*),parameter :: Iam="LDAS_getvar" - + logical :: isCubed ! call ESMF_VmGetCurrent(vm, rc=ierr) ! VERIFY_(ierr) ! call ESMF_VmGet(vm, mpicommunicator=comm, rc=ierr) @@ -3453,10 +3458,21 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & ! call MPI_COMM_SIZE(comm,total_prcs,ierr) ! call MPI_COMM_RANK(comm,myid,ierr) rc = 0 - iistart = 1 - iicount(1) = local_info%N_lon - iicount(2) = local_info%N_lat - iicount(3) = 1 + isCubed = .false. + if(local_info%N_lat == 6*local_info%N_lon) then + isCubed = .true. + istart = 1 + icount(1) = local_info%N_lon + icount(2) = local_info%N_lon + icount(3) = 6 + icount(4) = 1 + else + iistart = 1 + iicount(1) = local_info%N_lon + iicount(2) = local_info%N_lat + iicount(3) = 1 + endif + if (.not. notime ) then call GetBegDateTime ( fid, begDate, begTime, incSecs, rc ) if (rc .NE. 0) then @@ -3488,14 +3504,25 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & else timeIndex = seconds/incSecs + 1 endif - iistart(3) =timeIndex + iistart(3)=timeIndex + istart(4) =timeIndex endif ! node root read and share call MAPL_SyncSharedMemory(rc=status) + if (MAPL_AmNodeRoot .or. (.not. MAPL_ShmInitialized)) then rc= NF90_INQ_VARID( fid, vname, nv_id) - rc= NF90_GET_VAR( fid, nv_id, ptrShForce, start=iistart,count=iicount) + ASSERT_( rc == nf90_noerr) + if (isCubed) then + c_address = c_loc(ptrShForce(1,1)) + call c_f_pointer(c_address,tmpShared,shape=icount) + rc= NF90_GET_VAR( fid, nv_id, tmpShared, start=istart,count=icount) + else + rc= NF90_GET_VAR( fid, nv_id, ptrShForce, start=iistart,count=iicount) + endif + ASSERT_( rc == nf90_noerr) endif + call MAPL_SyncSharedMemory(rc=status) end subroutine LDAS_GetVar @@ -3963,6 +3990,7 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & ! reichle, 30 Oct 2017: added FP transition from f516 to f517 ! reichle, 9 Jul 2018: added FP transition from f517 to f521 ! reichle, 10 Oct 2019: added FP transition from f521 to f522 + ! reichle, 17 Jan 2020: added FP transition from f522 to f525 ! ! --------------------------------------------------------------------------- @@ -4002,6 +4030,7 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & type(date_time_type) :: dt_end_f517_fp type(date_time_type) :: dt_end_f521_fp type(date_time_type) :: dt_end_f522_fp + type(date_time_type) :: dt_end_f525_fp character(len=*), parameter :: Iam = 'parse_G5DAS_met_tag' character(len=400) :: err_msg @@ -4088,7 +4117,8 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & ! f516_fp | 24 Jan 2017 | 1 Nov 2017 ! f517_fp | 1 Nov 2017 | 11 Jul 2018 ! f521_fp | 11 Jul 2018 | 13 Mar 2019 - ! f522_fp | 13 Mar 2019 | (present) + ! f522_fp | 13 Mar 2019 | 30 Jan 2020 + ! f525_fp | 30 Jan 2020 | (present) ! ! Official stream transition times (as defined ! by GMAO ops group) are: @@ -4099,6 +4129,7 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & ! FP f516 --> f517 : 1 Nov 2017, 6z ADAS analysis ! FP f517 --> f521 : 11 Jul 2018, 6z ADAS analysis ! FP f521 --> f522 : 13 Mar 2019, 6z ADAS analysis + ! FP f522 --> f525 : 30 Jan 2020, 6z ADAS analysis ! ! Official stream transition times refer to the definition ! of the official FP files with generic file names on the @@ -4161,13 +4192,20 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & dt_end_f521_fp%min = 0 dt_end_f521_fp%sec = 0 - dt_end_f522_fp%year = 9999 + dt_end_f522_fp%year = 2020 dt_end_f522_fp%month = 1 - dt_end_f522_fp%day = 1 - dt_end_f522_fp%hour = 0 + dt_end_f522_fp%day = 30 + dt_end_f522_fp%hour = 3 dt_end_f522_fp%min = 0 dt_end_f522_fp%sec = 0 + dt_end_f525_fp%year = 9999 + dt_end_f525_fp%month = 1 + dt_end_f525_fp%day = 1 + dt_end_f525_fp%hour = 0 + dt_end_f525_fp%min = 0 + dt_end_f525_fp%sec = 0 + ! ---------------------------------------------------- ! initialize @@ -4308,10 +4346,16 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & stream = 'f521_fp' ! use GEOS-5.21.x output - else + elseif (datetime_le_refdatetime( date_time, dt_end_f522_fp )) then + + ! Note "less-than-or-equal" (_le_) above stream = 'f522_fp' ! use GEOS-5.22.x output + else + + stream = 'f525_fp' ! use GEOS-5.25.x output + end if else @@ -4486,32 +4530,32 @@ end subroutine get_GEOS_forcing_filename !********************************************************** - subroutine GEOS_openfile(FileOpenedHash,fname_full,fid,lons,lats,m_hinterp) + subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, rc) use netcdf implicit none include 'mpif.h' type(Hash_Table),intent(inout) :: FileOpenedHash character(*),intent(in) :: fname_full integer,intent(out) :: fid - real,intent(in) ::lats(:),lons(:) + type(tile_coord_type), dimension(:), intent(in) :: tile_coord integer,intent(in) :: m_hinterp + integer, optional, intent(out) :: rc - integer :: N_lat,N_lon,N_cat + integer :: N_lat,N_lon,N_cat, N_f integer,allocatable :: i1(:),i2(:),j1(:),j2(:) real,allocatable :: x1(:),x2(:),y1(:),y2(:) integer :: ierr,k - integer :: latid, lonid + integer :: latid, lonid, nfid, xdimid real :: dlon,dlat,ll_lon,ll_lat,this_lon,this_lat,tmp_lon,tmp_lat integer :: icur,jcur,inew,jnew real :: xcur,ycur,xnew,ynew character(len=100) :: err_msg character(*),parameter :: Iam="GEOS_openfile" + logical :: isCubed ! add mpi type(ESMF_VM) :: vm integer :: comm,total_prcs,myrank - integer :: rc,status - !integer :: imin,imax,jmin,jmax - !integer,allocatable :: imins(:),imaxs(:),jmins(:),jmaxs(:) + integer :: status call FileOpenedHash%init() @@ -4519,159 +4563,167 @@ subroutine GEOS_openfile(FileOpenedHash,fname_full,fid,lons,lats,m_hinterp) VERIFY_(status) call ESMF_VmGet(vm, mpicommunicator=comm, rc=status) VERIFY_(status) - !call MPI_COMM_SIZE(comm,total_prcs,ierr) - !call MPI_COMM_RANK(comm,myrank,ierr) - - !if(myrank == total_prcs -1) then - ! allocate(imins(0:total_prcs-1)) - ! allocate(jmins(0:total_prcs-1)) - ! allocate(imaxs(0:total_prcs-1)) - ! allocate(jmaxs(0:total_prcs-1)) - !else - ! allocate(imins(0)) - ! allocate(jmins(0)) - ! allocate(imaxs(0)) - ! allocate(jmaxs(0)) - !endif call FileOpenedHash%get(fname_full,fid) - if( fid < 0) then + + if( fid == -9999 ) then ! not open yet ierr=nf90_open(fname_full,IOR(NF90_NOWRITE, NF90_MPIIO), fid, & - comm = comm,info = MPI_INFO_NULL) + comm = comm,info = MPI_INFO_NULL) + if(master_logit) then - write(logunit,*) "opening file: "//trim(fname_full) + write(logunit,*) "opening file: "//trim(fname_full) endif - if(ierr /= nf90_noerr) then - print *, trim(nf90_strerror(ierr)) - write(logunit,*) "failed opening file: "//trim(fname_full) - stop 2 - end if + ASSERT_( ierr == nf90_noerr) + call FileOpenedHash%put(fname_full,fid) + endif + ! check if it is cs grid + ierr = nf90_inq_dimid(fid,"nf",nfid) + + if (ierr == nf90_noerr) then ! it is cs grid if face dimension is found + + ierr = nf90_inq_dimid(fid,"Xdim",xdimid) + ASSERT_( ierr == nf90_noerr) + ierr = nf90_Inquire_Dimension(fid,nfid, len=N_f) + ASSERT_( ierr == nf90_noerr) + ASSERT_( n_f == 6) + ierr = nf90_Inquire_Dimension(fid,xdimid,len=N_lon) + ASSERT_( ierr == nf90_noerr) + N_lat = N_f*N_lon + ASSERT_( m_hinterp == 0) + isCubed = .true. + else ierr = nf90_inq_dimid(fid,"lat",latid) ierr = nf90_inq_dimid(fid,"lon",lonid) ierr = nf90_Inquire_Dimension(fid,latid,len=N_lat) ierr = nf90_Inquire_Dimension(fid,lonid,len=N_lon) - N_cat = size(lats) - - ! if the forcing resolution changes, change the local info - if( local_info%N_lat /= N_lat .or. local_info%N_lon /= N_lon) then - - dlon = 360./real(N_lon) - dlat = 180./real(N_lat-1) - ll_lon = -180. - dlon/2. - ll_lat = -90. - dlat/2. - - allocate(i1(N_cat),j1(N_cat)) - allocate(i2(N_cat),j2(N_cat),x1(N_cat),x2(N_cat),y1(N_cat),y2(N_cat)) - - select case (m_hinterp) - - case (0) ! nearest-neighbor - - ! compute indices for nearest neighbor interpolation from GEOSgcm grid - ! to tile space - - do k=1,N_cat + isCubed = .false. + dlon = 360./real(N_lon) + dlat = 180./real(N_lat-1) + ll_lon = -180. - dlon/2. + ll_lat = -90. - dlat/2. + endif - ! ll_lon and ll_lat refer to lower left corner of grid cell - ! (as opposed to the grid point in the center of the grid cell) + N_cat = size(tile_coord,1) - this_lon = lons(k) - this_lat = lats(k) + ! if dimensions are the same, no need to recalculate the local_info + if( local_info%N_lat == N_lat .and. local_info%N_lon == N_lon ) then + RETURN_(ESMF_SUCCESS) + endif - i1(k) = ceiling((this_lon - ll_lon)/dlon) - j1(k) = ceiling((this_lat - ll_lat)/dlat) + allocate(i1(N_cat),j1(N_cat)) + allocate(i2(N_cat),j2(N_cat),x1(N_cat),x2(N_cat),y1(N_cat),y2(N_cat)) - ! NOTE: For a "date line on center" grid and (180-dlon/2) < lon < 180 - ! we now have i1=(grid%N_lon+1) - ! This needs to be fixed as follows: + select case (m_hinterp) + + case (0) ! nearest-neighbor + + ! compute indices for nearest neighbor interpolation from GEOSgcm grid + ! to tile space + if( isCubed ) then ! cs grid + ! i_indg and j_indg are changed to LatLon grid + do k=1,N_cat + i1(k) = tile_coord(k)%cs_i_indg + j1(k) = tile_coord(k)%cs_j_indg + enddo + else + do k=1,N_cat - if (i1(k)> N_lon) i1(k)=1 + ! ll_lon and ll_lat refer to lower left corner of grid cell + ! (as opposed to the grid point in the center of the grid cell) - end do + this_lon = tile_coord(k)%com_lon + this_lat = tile_coord(k)%com_lat - case (1) ! bilinear interpolation + i1(k) = ceiling((this_lon - ll_lon)/dlon) + j1(k) = ceiling((this_lat - ll_lat)/dlat) - ! compute indices of nearest neighbors needed for bilinear - ! interpolation from GEOSgcm grid to tile space + ! NOTE: For a "date line on center" grid and (180-dlon/2) < lon < 180 + ! we now have i1=(grid%N_lon+1) + ! This needs to be fixed as follows: + if (i1(k)> N_lon) i1(k)=1 - do k=1,N_cat + end do + endif ! cs grid + case (1) ! bilinear interpolation - ! ll_lon and ll_lat refer to lower left corner of grid cell - ! (as opposed to the grid point in the center of the grid cell) + ! compute indices of nearest neighbors needed for bilinear + ! interpolation from GEOSgcm grid to tile space - ! pchakrab: For bilinear interpolation, for each tile, we need: - ! x1, x2, y1, y2 (defining the co-ords of four neighbors) and - ! i1, i2, j1, j2 (defining the indices of four neighbors) - ! find nearest neighbor forcing grid cell ("1") + do k=1,N_cat - ! com of kth tile - this_lon = lons(k) - this_lat = lats(k) - icur = ceiling((this_lon - ll_lon)/dlon) - jcur = ceiling((this_lat - ll_lat)/dlat) + ! ll_lon and ll_lat refer to lower left corner of grid cell + ! (as opposed to the grid point in the center of the grid cell) - ! wrap-around - if (icur>N_lon) icur = 1 - if (jcur>N_lat) then - err_msg = "encountered tile near the poles" - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - xcur = real(icur-1)*dlon - 180.0 - ycur = real(jcur-1)*dlat - 90.0 - i1(k) = icur - j1(k) = jcur - x1(k) = xcur ! lon of grid cell center - y1(k) = ycur ! lat of grid cell center - - ! find forcing grid cell ("2") diagonally across from icur, jcur - - tmp_lon = this_lon + 0.5*dlon - tmp_lat = this_lat + 0.5*dlat - inew = ceiling((tmp_lon - ll_lon)/dlon) - jnew = ceiling((tmp_lat - ll_lat)/dlat) - if (inew==icur) inew = inew - 1 - if (jnew==jcur) jnew = jnew - 1 - xnew = real(inew-1)*dlon - 180.0 - ynew = real(jnew-1)*dlat - 90.0 - ! wrap-around - if (inew==0) inew = N_lon - if (inew>N_lon) inew = 1 - if ((jnew==0) .or. (jnew>N_lat)) then - err_msg = "encountered tile near the poles" - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if + ! pchakrab: For bilinear interpolation, for each tile, we need: + ! x1, x2, y1, y2 (defining the co-ords of four neighbors) and + ! i1, i2, j1, j2 (defining the indices of four neighbors) - i2(k) = inew - j2(k) = jnew - x2(k) = xnew ! lon of grid cell center - y2(k) = ynew ! lat of grid cell center - end do + ! find nearest neighbor forcing grid cell ("1") - case default - - err_msg = "unknown horizontal interpolation method" - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - local_info%N_lat = N_lat - local_info%N_lon = N_lon - local_info%N_cat = N_cat - call move_alloc(i1,local_info%i1) - call move_alloc(i2,local_info%i2) - call move_alloc(j1,local_info%j1) - call move_alloc(j2,local_info%j2) - call move_alloc(x1,local_info%x1) - call move_alloc(x2,local_info%x2) - call move_alloc(y1,local_info%y1) - call move_alloc(y2,local_info%y2) - endif ! new N_lon, N_lat + ! com of kth tile + this_lon = tile_coord(k)%com_lon + this_lat = tile_coord(k)%com_lat + icur = ceiling((this_lon - ll_lon)/dlon) + jcur = ceiling((this_lat - ll_lat)/dlat) - call FileOpenedHash%put(fname_full,fid) + ! wrap-around + if (icur>N_lon) icur = 1 + if (jcur>N_lat) then + err_msg = "encountered tile near the poles" + call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) + end if + xcur = real(icur-1)*dlon - 180.0 + ycur = real(jcur-1)*dlat - 90.0 + i1(k) = icur + j1(k) = jcur + x1(k) = xcur ! lon of grid cell center + y1(k) = ycur ! lat of grid cell center + + ! find forcing grid cell ("2") diagonally across from icur, jcur + + tmp_lon = this_lon + 0.5*dlon + tmp_lat = this_lat + 0.5*dlat + inew = ceiling((tmp_lon - ll_lon)/dlon) + jnew = ceiling((tmp_lat - ll_lat)/dlat) + if (inew==icur) inew = inew - 1 + if (jnew==jcur) jnew = jnew - 1 + xnew = real(inew-1)*dlon - 180.0 + ynew = real(jnew-1)*dlat - 90.0 + ! wrap-around + if (inew==0) inew = N_lon + if (inew>N_lon) inew = 1 + if ((jnew==0) .or. (jnew>N_lat)) then + err_msg = "encountered tile near the poles" + call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) + end if - endif + i2(k) = inew + j2(k) = jnew + x2(k) = xnew ! lon of grid cell center + y2(k) = ynew ! lat of grid cell center + end do + case default + + err_msg = "unknown horizontal interpolation method" + call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) + + end select + local_info%N_lat = N_lat + local_info%N_lon = N_lon + local_info%N_cat = N_cat + call move_alloc(i1,local_info%i1) + call move_alloc(i2,local_info%i2) + call move_alloc(j1,local_info%j1) + call move_alloc(j2,local_info%j2) + call move_alloc(x1,local_info%x1) + call move_alloc(x2,local_info%x2) + call move_alloc(y1,local_info%y1) + call move_alloc(y2,local_info%y2) + + RETURN_(ESMF_SUCCESS) end subroutine GEOS_openfile subroutine GEOS_closefile(fid) diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 index 72c1013a..3aea7652 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 @@ -2328,18 +2328,6 @@ subroutine get_ij_ind_from_latlon( tile_grid, lat, lon, i_ind, j_ind ) end if - - elseif( index(tile_grid%gridtype,'c3') /=0 ) then - - lats(1) = lat - lons(1) = lon - ! note: should call for many points instead of 1 for efficiency - call MAPL_GetHorzIJIndex(1, i_inds, j_inds, lon=lons, lat=lats, IMGlob=tile_grid%N_lon, JMGlob=tile_grid%N_lat, & - EdgeLons = tile_grid%LonEdge, EdgeLats = tile_grid%LatEdge) - i_ind = i_inds(1) - j_ind = j_inds(1) - - else call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown grid type') diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordType.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordType.F90 index db275ba1..20376344 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordType.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordType.F90 @@ -76,10 +76,15 @@ module LDAS_TileCoordType real :: max_lat ! maximum latitude (bounding box for tile) integer :: i_indg ! i index (w.r.t. *global* grid that cuts tiles) integer :: j_indg ! j index (w.r.t. *global* grid that cuts tiles) + !if it is Cubed-Sphere grid, the index will be saved here for forcing + !i_indg and j_indg will be changed to index that related to latlon grid + integer :: cs_i_indg ! i index (w.r.t. *global* grid that cuts tiles) + integer :: cs_j_indg ! j index (w.r.t. *global* grid that cuts tiles) real :: frac_cell ! area fraction of grid cell covered by tile real :: frac_pfaf ! fraction of Pfafstetter catchment for land tiles real :: area ! area [km^2] real :: elev ! elevation above sea level [m] + end type tile_coord_type @@ -180,7 +185,7 @@ module LDAS_TileCoordType ! -------------------------------------------------------------- - interface operator (.eq.) + interface operator (==) module procedure eq_grid_def_type end interface @@ -285,8 +290,8 @@ subroutine io_grid_def_type( action, unitnum, grid, varname ) case ('w','W') - if ( index(tmpstr40,'UNFORMATTED') .or. & - index(tmpstr40,'unformatted') ) then + if ( index(tmpstr40,'UNFORMATTED') /=0 .or. & + index(tmpstr40,'unformatted') /=0 ) then ! unformatted output @@ -323,8 +328,8 @@ subroutine io_grid_def_type( action, unitnum, grid, varname ) case ('r','R') - if ( index(tmpstr40,'UNFORMATTED') .or. & - index(tmpstr40,'unformatted') ) then + if ( index(tmpstr40,'UNFORMATTED') /=0 .or. & + index(tmpstr40,'unformatted') /=0 ) then ! unformatted output diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 index 269745a8..c22c4f72 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 @@ -2485,7 +2485,7 @@ subroutine clsm_ensdrv_get_command_line( & character(len=*), parameter :: Iam = 'clsm_ensdrv_get_command_line' character(len=400) :: err_msg - external getarg, iargc + !external getarg, iargc ! ----------------------------------------------------------------- diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 index d871bce5..323e1807 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 @@ -208,6 +208,8 @@ subroutine init_MPI_types() ! real :: max_lat ! maximum latitude (bounding box for tile) ! integer :: i_indg ! i index (w.r.t. *global* grid that cuts tiles) ! integer :: j_indg ! j index (w.r.t. *global* grid that cuts tiles) + ! integer :: cs_i_indg ! i index (w.r.t. *global* grid that cuts tiles) + ! integer :: cs_j_indg ! j index (w.r.t. *global* grid that cuts tiles) ! real :: frac_cell ! area fraction of grid cell covered by tile ! real :: frac_pfaf ! fraction of Pfafstetter catchment for land tiles ! real :: area ! area [km^2] @@ -226,7 +228,7 @@ subroutine init_MPI_types() iblock(1) = 4 iblock(2) = 6 - iblock(3) = 2 + iblock(3) = 4 ! add cs_i_indg and cs_j_indg iblock(4) = 4 idisp(1) = 0 diff --git a/src/Shared/CMakeLists.txt b/src/Shared/CMakeLists.txt index 841e4aec..d956e9fe 100644 --- a/src/Shared/CMakeLists.txt +++ b/src/Shared/CMakeLists.txt @@ -1,6 +1,2 @@ add_subdirectory (@MAPL) add_subdirectory (@GMAO_Shared) - -# Special case - FMS is built twice with two -add_subdirectory (@FMS fms_r4) -add_subdirectory (@FMS fms_r8) From 9766ef319969f9325ebe9aa1c8d264ae3aa161fd Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 26 Feb 2020 15:45:24 -0500 Subject: [PATCH 02/42] Pointing to tags of GCM_GridComp and GMAO_Shared --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index c645adba..62d03f47 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = master +tag = v1.1.0 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -branch = develop +tag = v1.6.0 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 356e4c2afd3a2e0058d138bcea3d49860c14d97a Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 18 Mar 2020 16:17:14 -0400 Subject: [PATCH 03/42] Sync develop to master (via tmp-master-branch-rreichle-20200318) (#155) --- Externals.cfg | 4 +- README.md | 18 +- doc/CHANGELOG.md | 42 +- src/Applications/LDAS_App/CMakeLists.txt | 2 +- src/Applications/LDAS_App/GEOSldas.F90 | 2 +- src/Applications/LDAS_App/ldas_setup | 255 +++++--- src/Applications/LDAS_App/lenkf.j.template | 49 +- .../LDAS_App/mk_GEOSldasRestarts.F90 | 578 +----------------- src/Applications/LDAS_App/preprocess_ldas.F90 | 62 +- src/Applications/LDAS_App/process_rst.csh | 253 +++++++- .../GEOS_LandAssimGridComp.F90 | 47 +- .../clsm_ensupd_enkf_update.F90 | 16 +- .../GEOS_LandPertGridComp.F90 | 6 +- 13 files changed, 610 insertions(+), 724 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 62d03f47..4684c83a 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -25,14 +25,14 @@ sparse = ../../../config/GMAO_Shared.sparse required = True repo_url = git@github.com:GEOS-ESM/MAPL.git local_path = ./src/Shared/@MAPL -tag = v2.0.0 +tag = v2.0.1 protocol = git [GEOSgcm_GridComp] required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.6.0 +tag = v1.8.1 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/README.md b/README.md index 962713c0..4b8e6698 100644 --- a/README.md +++ b/README.md @@ -6,13 +6,25 @@ #### Load Build Modules -In your `.bashrc` or `.tcshrc` or other rc file add a line: +Make sure the correct module from the GMAO SI team is loaded: -##### NCCS (SLES11) +##### NCCS (SLES11 or SLES12) ``` module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES11 ``` +or +``` +module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES12 +``` +or add the following to your `.cshrc`: +``` +if ( ! -f /etc/os-release ) then + module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES11 +else + module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES12 +endif +``` ##### NAS ``` @@ -118,6 +130,8 @@ make -j6 install --- ## Setup up a run +If you are using SLES12 at NCCS, you **must** run setup on an interactive compute node. SLES12 login nodes no longer allow running MPI. + ``` cd ../(some_architecture)/bin source g5_modules diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index aa49c808..2d5e2d03 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -41,10 +41,46 @@ _These are additions put in development, that will be in the next stable tag_ Overview of Git tags: ============================ -[v17.9.0-beta.1] - 2020-01-17 +[v17.9.0-beta.3](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.3) - 2020-03-18 +------------------------------ +- Additional RESTART options, incl. from re-tiling MERRA-2, FP, or other restarts on different tile space or with different boundary conditions +- Bug fixes + +------------------------------ +[v17.9.0-beta.2](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.2) - 2020-02-26 +------------------------------ +- New/Updated Science Functionality: + + - Assimilation when running on cube-sphere tiles. + - Read forcing from cube-sphere grid when running on matching cube-sphere tiles. + - Output of Catchment analysis increments via HISTORY. + - Added FP-5.25 upgrade (30 Jan 2020) to "cross-stream" forcing option. + - Functionality to create regional (non-global) nc4 vegdyn restart file. + - Configuration option to add extra variables into catch restart files (as needed by GCM). + - Allows processing of (assimilation) observations for innovations output *without* perturbations turned on. + +- New/Updated Infrastructure: + + - Support for SLES 12 in addition to SLES11 (ESMA_env v2.0.2). + - Updated to MAPL v2.0. + - Removed dycore and FMS + - Conforms to GNU compiler (gcc-9.1). + - Post-processing compression (gzip) of landpert restart files (except final time). + - Added LDAS_app/mk_GEOSldasRestarts.F90 (adapted from GCM GridComp's mk_LDASsaRestarts.F90 in preparation for re-tiling changes). + - Fixed output log file name and location. + +- Bug Fixes and Other Minor Changes: + + - Bug fix in select-update_type 9 (abs(deltaT)>0.) + - Bug fix for local mwRTM and time dimension restart. + - Replaced copy ("cp") with link ("ln") for catparam and mwrtm diagnostic output files. + +------------------------------ +[v17.9.0-beta.1](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.1) - 2020-01-17 ------------------------------ - Commented out call to check_catch_progn in apply_progn_pert. +------------------------------ [v17.9.0-beta.0] - 2019-12-20 ------------------------------ - First tag for SMAP L4_SM Version 5, Catchment model consistent with f525land_fpp @@ -54,11 +90,13 @@ Overview of Git tags: - Fix GEOS forcing stream boundaries bug - Changes to time stepping for sun angle +------------------------------ [v17.8.0] - 2019-12-10 ------------------------- +------------------------------ - Closest match to LDASsa CVS tag LDASsa_m3-16_6_p2, the LDASsa tag used for generating the Version 4 L4_SM product. - v17.8.0 is a debugged version of GEOSldas_m4-17_8. +------------------------------ diff --git a/src/Applications/LDAS_App/CMakeLists.txt b/src/Applications/LDAS_App/CMakeLists.txt index 345e4ced..a869ac90 100644 --- a/src/Applications/LDAS_App/CMakeLists.txt +++ b/src/Applications/LDAS_App/CMakeLists.txt @@ -13,7 +13,7 @@ foreach (prog ${executables}) ecbuild_add_executable ( TARGET ${prog}.x SOURCES ${prog}.F90 - LIBS GEOSldas_GridComp) + LIBS GEOSldas_GridComp mk_restarts) endforeach () install( diff --git a/src/Applications/LDAS_App/GEOSldas.F90 b/src/Applications/LDAS_App/GEOSldas.F90 index 7c6694cd..8e884936 100644 --- a/src/Applications/LDAS_App/GEOSldas.F90 +++ b/src/Applications/LDAS_App/GEOSldas.F90 @@ -6,7 +6,7 @@ program LDAS_Main ! !USES: - use MAPL_Mod + use MAPL use GEOS_LDASGridCompMod, only: ROOT_SetServices => SetServices implicit none diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 063602d9..4d2279e2 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -110,11 +110,20 @@ class LDASsetup: if 'RESTART' not in self.rqdExeInp : self.rqdExeInp['RESTART'] = 1 - if int(self.rqdExeInp['RESTART']) ==0 : - rqdExeInpKeys = rqdExeInpKeys_rst - self.rqdExeInp['RESTART_ID'] = "none" - self.rqdExeInp['RESTART_DOMAIN'] = "none" - self.rqdExeInp['RESTART_PATH'] = "none" + if self.rqdExeInp['RESTART'].isdigit() : + if int(self.rqdExeInp['RESTART']) ==0 : + rqdExeInpKeys = rqdExeInpKeys_rst + self.rqdExeInp['RESTART_ID'] = "none" + self.rqdExeInp['RESTART_DOMAIN'] = "none" + self.rqdExeInp['RESTART_PATH'] = "none" + else: + if self.rqdExeInp['RESTART'] =='G' : + rqdExeInpKeys = rqdExeInpKeys_rst + self.rqdExeInp['RESTART_DOMAIN'] = "none" + else: + self.rqdExeInp['RESTART_ID'] = "none" + self.rqdExeInp['RESTART_DOMAIN'] = "none" + self.rqdExeInp['RESTART_PATH'] = "none" for key in rqdExeInpKeys : assert key in self.rqdExeInp,' "%s" is required in the input file %s' % (key,self.exeinpfile) @@ -156,10 +165,11 @@ class LDASsetup: '%Y%m%d %H%M%S' ) ) - if int(self.rqdExeInp['RESTART']) == 0 : - # print "Starting date is forced to January 1st if there is no restart file" - year = self.begDates[0].year - self.begDates[0]=datetime(year =year,month=1,day =1,hour =0, minute= 0,second= 0) + if self.rqdExeInp['RESTART'].isdigit() : + if int(self.rqdExeInp['RESTART']) == 0 : + # print "Starting date is forced to January 1st if there is no restart file" + year = self.begDates[0].year + self.begDates[0]=datetime(year =year,month=1,day =1,hour =0, minute= 0,second= 0) assert self.endDates[0]>self.begDates[0], \ 'END_DATE <= BEG_DATE' @@ -215,17 +225,18 @@ class LDASsetup: assert os.path.isfile(self.rqdExeInp['CATCH_DEF_FILE']),"[%s] file does not exist " % self.rqdExeInp['CATCH_DEF_FILE'] self.rqdExeInp['RST_FROM_GLOBAL'] = 1 - if int(self.rqdExeInp['RESTART']) == 1 : - _numg = int(linecache.getline(self.rqdExeInp['CATCH_DEF_FILE'], 1).strip()) - _numd = _numg - ldas_domain = self.rqdExeInp['RESTART_PATH']+ \ - self.rqdExeInp['RESTART_ID'] + \ - '/output/'+self.rqdExeInp['RESTART_DOMAIN']+'/rc_out/'+self.rqdExeInp['RESTART_ID']+'.ldas_domain.txt' - if os.path.isfile(ldas_domain) : - _numd = int(linecache.getline(ldas_domain, 1).strip()) + if self.rqdExeInp['RESTART'].isdigit() : + if int(self.rqdExeInp['RESTART']) == 1 : + _numg = int(linecache.getline(self.rqdExeInp['CATCH_DEF_FILE'], 1).strip()) + _numd = _numg + ldas_domain = self.rqdExeInp['RESTART_PATH']+ \ + self.rqdExeInp['RESTART_ID'] + \ + '/output/'+self.rqdExeInp['RESTART_DOMAIN']+'/rc_out/'+self.rqdExeInp['RESTART_ID']+'.ldas_domain.txt' + if os.path.isfile(ldas_domain) : + _numd = int(linecache.getline(ldas_domain, 1).strip()) - if _numg != _numd : - self.rqdExeInp['RST_FROM_GLOBAL'] = 0 + if _numg != _numd : + self.rqdExeInp['RST_FROM_GLOBAL'] = 0 if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : self.rqdExeInp['TILING_FILE'] =glob.glob(self.rqdExeInp['BCS_PATH']+'*.til')[0] @@ -242,6 +253,21 @@ class LDASsetup: self.rqdExeInp['NDVI_FILE']= os.path.realpath(glob.glob(inpdir+'ndvi*data')[0]) self.rqdExeInp['NIRDF_FILE']= os.path.realpath(glob.glob(inpdir+'nirdf*data')[0]) self.rqdExeInp['VISDF_FILE']= os.path.realpath(glob.glob(inpdir+'visdf*data')[0]) + + if self.rqdExeInp['RESTART'].isdigit() : + if int(self.rqdExeInp['RESTART']) == 2 : + self.rqdExeInp['RST_FROM_GLOBAL'] = 1 + ldas_domain = self.rqdExeInp['RESTART_PATH']+ \ + self.rqdExeInp['RESTART_ID'] + \ + '/output/'+self.rqdExeInp['RESTART_DOMAIN']+'/rc_out/'+self.rqdExeInp['RESTART_ID']+'.ldas_domain.txt' + if os.path.isfile(ldas_domain) : + _numd = int(linecache.getline(ldas_domain, 1).strip()) + self.rqdExeInp['TILING_FILE'] =glob.glob(self.rqdExeInp['BCS_PATH']+'*.til')[0] + self.rqdExeInp['GRN_FILE']= glob.glob(self.rqdExeInp['BCS_PATH']+'green_clim_*.data')[0] + self.rqdExeInp['LAI_FILE']= glob.glob(self.rqdExeInp['BCS_PATH']+'lai_clim_*.data')[0] + self.rqdExeInp['NDVI_FILE']= glob.glob(self.rqdExeInp['BCS_PATH']+'ndvi_clim_*.data')[0] + self.rqdExeInp['NIRDF_FILE']= glob.glob(self.rqdExeInp['BCS_PATH']+'nirdf_*.dat')[0] + self.rqdExeInp['VISDF_FILE']= glob.glob(self.rqdExeInp['BCS_PATH']+'visdf_*.dat')[0] if 'GRIDNAME' not in self.rqdExeInp : tmptile =self.rqdExeInp['TILING_FILE'] @@ -290,39 +316,43 @@ class LDASsetup: fout.write('/\n') - # make sure bcs files exist - if int(self.rqdExeInp['RESTART']) == 1 : - y4m2='Y%4d/M%02d' % (self.begDates[0].year, self.begDates[0].month) - y4m2d2_h2m2='%4d%02d%02d_%02d%02d' % (self.begDates[0].year, self.begDates[0].month, - self.begDates[0].day,self.begDates[0].hour,self.begDates[0].minute) - tmpFile=self.rqdExeInp['RESTART_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 - tmpRstDir=self.rqdExeInp['RESTART_PATH']+'/'.join([self.rqdExeInp['RESTART_ID'],'output', - self.rqdExeInp['RESTART_DOMAIN'],'rs',self.ensdirs[0],y4m2]) - catchRstFile=tmpRstDir+'/'+tmpFile - ldassa_tmp=self.rqdExeInp['RESTART_ID']+'.ens0000.'+self.catch+'_ldas_rst.'+y4m2d2_h2m2+'z.bin' - LDASsa_catchRstFile=tmpRstDir+'/'+ldassa_tmp - - assert os.path.isfile(catchRstFile) or os.path.isfile(LDASsa_catchRstFile), \ - self.catch+'_internal_rst file [%s] or [%s] does not exist!' %(catchRstFile, LDASsa_catchRstFile) - - tmpFile=self.rqdExeInp['RESTART_ID']+'.vegdyn_internal_rst' - tmpRstDir=self.rqdExeInp['RESTART_PATH']+'/'.join([self.rqdExeInp['RESTART_ID'],'output', - self.rqdExeInp['RESTART_DOMAIN'],'rs',self.ensdirs[0]]) - vegdynRstFile=tmpRstDir+'/'+tmpFile - if not os.path.isfile(vegdynRstFile): - assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'restart from LDASsa should be global' + # make sure bcs files exist + if self.rqdExeInp['RESTART'].isdigit() : + if int(self.rqdExeInp['RESTART']) >= 1 : + y4m2='Y%4d/M%02d' % (self.begDates[0].year, self.begDates[0].month) + y4m2d2_h2m2='%4d%02d%02d_%02d%02d' % (self.begDates[0].year, self.begDates[0].month, + self.begDates[0].day,self.begDates[0].hour,self.begDates[0].minute) + tmpFile=self.rqdExeInp['RESTART_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 + tmpRstDir=self.rqdExeInp['RESTART_PATH']+'/'.join([self.rqdExeInp['RESTART_ID'],'output', + self.rqdExeInp['RESTART_DOMAIN'],'rs',self.ensdirs[0],y4m2]) + catchRstFile=tmpRstDir+'/'+tmpFile + ldassa_tmp=self.rqdExeInp['RESTART_ID']+'.ens0000.'+self.catch+'_ldas_rst.'+y4m2d2_h2m2+'z.bin' + ldassaCN_tmp=self.rqdExeInp['RESTART_ID']+'.ens0000.'+self.catch+'_ldas_rst.'+y4m2d2_h2m2+'z' + LDASsa_catchRstFile=tmpRstDir+'/'+ldassa_tmp + LDASsa_CNRstFile=tmpRstDir+'/'+ldassaCN_tmp + + assert os.path.isfile(catchRstFile) or os.path.isfile(LDASsa_catchRstFile) or os.path.isfile(LDASsa_CNRstFile), \ + self.catch+'_internal_rst file [%s] or [%s] does not exist!' %(catchRstFile, LDASsa_catchRstFile) + + if int(self.rqdExeInp['RESTART']) == 1 : + tmpFile=self.rqdExeInp['RESTART_ID']+'.vegdyn_internal_rst' + tmpRstDir=self.rqdExeInp['RESTART_PATH']+'/'.join([self.rqdExeInp['RESTART_ID'],'output', + self.rqdExeInp['RESTART_DOMAIN'],'rs',self.ensdirs[0]]) + vegdynRstFile=tmpRstDir+'/'+tmpFile + if not os.path.isfile(vegdynRstFile): + assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'restart from LDASsa should be global' - tmpFile=self.rqdExeInp['RESTART_ID']+'.landpert_internal_rst.'+y4m2d2_h2m2 - tmpRstDir=self.rqdExeInp['RESTART_PATH']+'/'.join([self.rqdExeInp['RESTART_ID'],'output', - self.rqdExeInp['RESTART_DOMAIN'],'rs',self.ensdirs[0],y4m2]) - landpertRstFile=tmpRstDir+'/'+tmpFile - if ( os.path.isfile(landpertRstFile)) : - self.has_geos_pert = True - else : - ldassa_tmp=self.rqdExeInp['RESTART_ID']+'.ens0000.pert_ldas_rst.'+y4m2d2_h2m2+'z.bin' - LDASsa_pertRstFile=tmpRstDir+'/'+ldassa_tmp - if (os.path.isfile(LDASsa_pertRstFile)) : - self.has_ldassa_pert = True + tmpFile=self.rqdExeInp['RESTART_ID']+'.landpert_internal_rst.'+y4m2d2_h2m2 + tmpRstDir=self.rqdExeInp['RESTART_PATH']+'/'.join([self.rqdExeInp['RESTART_ID'],'output', + self.rqdExeInp['RESTART_DOMAIN'],'rs',self.ensdirs[0],y4m2]) + landpertRstFile=tmpRstDir+'/'+tmpFile + if ( os.path.isfile(landpertRstFile)) : + self.has_geos_pert = True + else : + ldassa_tmp=self.rqdExeInp['RESTART_ID']+'.ens0000.pert_ldas_rst.'+y4m2d2_h2m2+'z.bin' + LDASsa_pertRstFile=tmpRstDir+'/'+ldassa_tmp + if (os.path.isfile(LDASsa_pertRstFile)) : + self.has_ldassa_pert = True # DEAL WITH mwRTM input from exec _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 @@ -674,6 +704,15 @@ class LDASsetup: if 'SURFLAY' in self.rqdExeInp : dzsf = self.rqdExeInp['SURFLAY'] + # These are dummy values for cold restart: + wemin_in = '13' # WEmin input/output for scale_catch(cn), + wemin_out = '13' # + if 'WEMIN_IN' in self.rqdExeInp : + wemin_in = self.rqdExeInp['WEMIN_IN'] + if 'WEMIN_OUT' in self.rqdExeInp : + wemin_out = self.rqdExeInp['WEMIN_OUT'] + + cmd = './preprocess_ldas.x c_f2g ' + tile + ' ' + domain_def + ' '+ self.out_path + ' ' + catchment_def + ' ' + exp_id + ' ' + _y4m2d2h2m2 + ' '+ dzsf print 'Creating f2g.txt....\n' @@ -747,7 +786,7 @@ class LDASsetup: '/output/'+self.rqdExeInp['RESTART_DOMAIN']+'/rc_out/' # pass into process_rst - sponserid = self.rqdRmInp['account'] + sponsorid = self.rqdRmInp['account'] exp_id = self.rqdExeInp['EXP_ID'] exp_dir = self.exphome bcdir = self.rqdExeInp['BCS_PATH'] @@ -757,7 +796,7 @@ class LDASsetup: YYYYMMDD = '%4d%02d%02d' % (_start.year, _start.month,_start.day) rstid = self.rqdExeInp['RESTART_ID'] rstdomain = self.rqdExeInp['RESTART_DOMAIN'] - rstpath0 = self.rqdExeInp['RESTART_PATH'] + rstpath0 = self.rqdExeInp['RESTART_PATH'] # just copy the landassim pert seed if it exist for iens in xrange(self.nens) : @@ -770,9 +809,10 @@ class LDASsetup: os.symlink(_seeds, myRstDir+ '/landassim_obspertrseed'+ensid +'_rst') self.has_landassim_seed = True - cmd= './process_rst.csh ' + sponserid +' ' + exp_id + ' ' + exp_dir + \ - ' ' + bcdir +' ' + tilefile +' ' + lsmchoice + ' ' + have_rst + ' ' +YYYYMMDD + \ - ' ' + rstid +' ' + rstdomain + ' ' + rstpath0 + ' ' + str(self.nens) +' ' + str(self.rqdExeInp['RUN_IRRIG']) + cmd= ' '.join(['./process_rst.csh', sponsorid, exp_id, exp_dir, + bcdir, tilefile, lsmchoice, have_rst, YYYYMMDD, + rstid, rstdomain, rstpath0, str(self.nens), str(self.rqdExeInp['RUN_IRRIG']), + dzsf, wemin_in, wemin_out]) print "cmd: " + cmd os.system(cmd) @@ -801,20 +841,24 @@ class LDASsetup: vegdynRstFile = '' pertRstFile = '' print "restart: " + self.rqdExeInp['RESTART'] - if int(self.rqdExeInp['RESTART']) == 0 : - vegdynRstFile = glob.glob(self.rqdExeInp['BCS_PATH']+'vegdyn_*.dat')[0] - catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'_internal_rst.'+YYYYMMDD + if self.rqdExeInp['RESTART'].isdigit() : + if int(self.rqdExeInp['RESTART']) == 0 or int(self.rqdExeInp['RESTART']) == 2 : + vegdynRstFile = glob.glob(self.rqdExeInp['BCS_PATH']+'vegdyn_*.dat')[0] + catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'_internal_rst.'+YYYYMMDD + else : + catchRstFile = rstpath+ens +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 + vegdynRstFile= rstpath+ens +'/'+self.rqdExeInp['RESTART_ID']+ '.vegdyn_internal_rst' + if not os.path.isfile(vegdynRstFile): # no vegdyn restart from LDASsa + vegdynRstFile = glob.glob(self.rqdExeInp['BCS_PATH']+'vegdyn_*.dat')[0] + _catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+ensid+'_internal_rst.'+YYYYMMDD + if (self.nens == 1) : + _catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'0000_internal_rst.'+YYYYMMDD + if os.path.isfile(_catchRstFile): # from LDASsa restart + catchRstFile = _catchRstFile + assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'restart from LDASsa should be global' else : - catchRstFile = rstpath+ens +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 - vegdynRstFile= rstpath+ens +'/'+self.rqdExeInp['RESTART_ID']+ '.vegdyn_internal_rst' - if not os.path.isfile(vegdynRstFile): # no vegdyn restart from LDASsa - vegdynRstFile = glob.glob(self.rqdExeInp['BCS_PATH']+'vegdyn_*.dat')[0] - _catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+ensid+'_internal_rst.'+YYYYMMDD - if (self.nens == 1) : - _catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'0000_internal_rst.'+YYYYMMDD - if os.path.isfile(_catchRstFile): # from LDASsa restart - catchRstFile = _catchRstFile - assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'restart from LDASsa should be global' + vegdynRstFile = glob.glob(self.rqdExeInp['BCS_PATH']+'vegdyn_*.dat')[0] + catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'_internal_rst.'+YYYYMMDD # catchment restart file print 'catchRstFile1: ' + catchRstFile @@ -1240,7 +1284,8 @@ class LDASsetup: ]), self.rundir) - fout.write("jobid%d=$(echo $(sbatch --dependency=afterany:$jobid%d --output=%s --error=%s lenkf.j) | cut -d' ' -f 4)\n"%(iseg,iseg-1,_logfile, _errfile)) + #fout.write("jobid%d=$(echo $(sbatch --dependency=afterany:$jobid%d --output=%s --error=%s lenkf.j) | cut -d' ' -f 4)\n"%(iseg,iseg-1,_logfile, _errfile)) + fout.write("jobid%d=$(echo $(sbatch --dependency=afterok:$jobid%d lenkf.j) | cut -d' ' -f 4)\n"%(iseg,iseg-1)) fout.write("echo $jobid%d\n"%iseg ) fout.write("\nsed -i 's/#if($capdate<$enddate) sbatch/if($capdate<$enddate) sbatch /g' lenkf.j") fout.close() @@ -1380,20 +1425,64 @@ def _printExeInputKeys(rqdExeInpKeys): print '# #' print '# RESTART INFO #' print '# #' - print '# RESTART: 0 #' - print '# NO, do not have restart file(s). #' - print '# RESTART_ID, RESTART_PATH, RESTART_DOMAIN are *not* #' - print '# required, use # sign to comment out these 3 keywords.#' + print '# (i) Select "RESTART" option: #' + print '# #' + print '# Use one of the following options if you *have* a #' + print '# GEOSldas- or LDASsa-produced restart file: #' print '# #' print '# RESTART: 1 #' - print '# YES, have restart file(s) from GEOSldas *or* LDASsa. #' - print '# Must specify RESTART_ID, RESTART_PATH, RESTART_DOMAIN, #' - print '# with restarts stored as follows: #' + print '# YES, have restart file from GEOSldas *or* LDASsa #' + print '# in SAME tile space (grid) with SAME boundary #' + print '# conditions and SAME snow model parameter (WEMIN). #' + print '# GEOSldas-produced restart can be for the same or #' + print '# a larger domain. #' + print '# LDASsa-produced restart *must* be for the GLOBAL #' + print '# domain. #' + print '# #' + print '# RESTART: 2 #' + print '# YES, have restart file from GEOSldas *or* LDASsa but #' + print '# in a DIFFERENT tile space (grid) or with #' + print '# DIFFERENT boundary conditions or DIFFERENT snow #' + print '# model parameter (WEMIN). #' + print '# Restart *must* be for the GLOBAL domain. #' + print '# #' + print '# Use one of the following options if you DO NOT have a #' + print '# GEOSldas- or LDASsa-produced restart file: #' + print '# #' + print '# RESTART: 0 #' + print '# Cold start from arbitrary some old restart. #' + print '# #' + print '# RESTART: M #' + print '# Re-tile from archived MERRA-2 restart file. #' + print '# #' + print '# RESTART: F #' + print '# Re-tile from FP (Forward Processing) restart file. #' + print '# #' + print '# RESTART: G #' + print '# Re-tile from any AGCM catch[cn]_internal_rst file. #' + print '# #' + print '# -------------------------------------------------------- #' + print '# IMPORTANT: #' + print '# Except for RESTART=1, SPIN-UP is REQUIRED in almost #' + print '# all cases. #' + print '# -------------------------------------------------------- #' + print '# #' + print '# #' + print '# (ii) Specify experiment ID/location of restart file: #' + print '# #' + print '# For RESTART=1 or RESTART=2: #' + print '# Specify RESTART_ID, RESTART_PATH, RESTART_DOMAIN with #' + print '# restarts stored as follows: #' print '# RESTART_PATH/RESTART_ID/output/RESTART_DOMAIN/rs/ #' - print '# GEOSldas-produced restarts must be on the same #' - print '# GRID and for the same or a larger domain. #' - print '# LDASsa-produced restarts must be on the same #' - print '# GRID and for the GLOBAL domain (only!). #' + print '# #' + print '# For RESTART=0 or RESTART=M or RESTART=F: #' + print '# There is no need to specify RESTART_ID, RESTART_PATH, #' + print '# and RESTART_DOMAIN. #' + print '# #' + print '# For RESTART=G: #' + print '# RESTART_ID : full_path_to_AGCM_experiment_directory #' + print '# RESTART_PATH : full_path_of_the_AGCM_restart_file #' + print '# RESTART_DOMAIN is NOT required. #' print '# #' print '############################################################' @@ -1406,7 +1495,7 @@ def _printExeInputKeys(rqdExeInpKeys): print print '############################################################' print '# #' - print '# METEOROLOGICAL FORCINGS #' + print '# SURFACE METEOROLOGICAL FORCING #' print '# #' print '# See README files in ./src/Applications/LDAS_App/doc #' print '# #' @@ -1420,7 +1509,7 @@ def _printExeInputKeys(rqdExeInpKeys): print print '############################################################' print '# #' - print '# LAND BOUNDARY CONDITIONS DIRECTORY #' + print '# LAND BOUNDARY CONDITIONS DIRECTORY #' print '# #' print '# See README files in ./src/Applications/LDAS_App/doc #' print '# #' diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index 440c2236..73dc1b1a 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -4,8 +4,8 @@ # Batch Parameters for Run Job ####################################################################### -#SBATCH --output=MY_LOGFILE -#SBATCH --error=MY_ERRFILE +#SBATCH --output=../scratch/GEOSldas_log_txt +#SBATCH --error=../scratch/GEOSldas_err_txt #SBATCH --account=MY_ACCOUNT #SBATCH --time=MY_WALLTIME #SBATCH --ntasks=MY_NTASKS @@ -79,7 +79,7 @@ set NUM_SGMT = `grep NUM_SGMT: $HOMDIR/CAP.rc | cut -d':' -f2` ####################################################################### cd $SCRDIR -/bin/rm -rf * +/bin/rm -rf *.* /bin/cp $HOMDIR/cap_restart . /bin/cp -f $HOMDIR/*.rc . /bin/cp -f $HOMDIR/*.nml . @@ -269,7 +269,14 @@ while ( $counter <= ${NUM_SGMT} ) set old_mwrtm_file = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_mwRTMparam.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.nc4 set old_catch_param = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_catparam.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.bin - + if ( -l "$old_mwrtm_file" ) then + set old_mwrtm_file = `/usr/bin/readlink -f $old_mwrtm_file` + endif + if ( -l "$old_catch_param" ) then + set old_catch_param = `/usr/bin/readlink -f $old_catch_param` + endif + + /bin/cp LDAS.rc $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_LDAS_rc.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.txt /bin/cp CAP.rc $EXPDIR/output/$EXPDOMAIN/rc_out/Y${bYEAR}/M${bMON}/${EXPID}.ldas_CAP_rc.${bYEAR}${bMON}${bDAY}_${bHour}${bMin}z.txt @@ -410,10 +417,12 @@ while ( $counter <= ${NUM_SGMT} ) if ($LEN != $LEN_AVAIL) continue # create the monly average - ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 - ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 - /bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 - + #ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 + #ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 + + #/bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 + ncra -h $EXPID.$ThisCol.${YYYY}${MM}??_*z.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 + # don't want a daily? delete the daily and sub-dailies and continue # if($NODAILIES == 2) then @@ -485,12 +494,18 @@ while ( $counter <= ${NUM_SGMT} ) set new_catch_param = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_catparam.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.bin if (-f $old_mwrtm_file) then + if ( -l "$new_mwrtm_file" ) then + /bin/rm -f $new_mwrtm_file + endif /bin/ln -s $old_mwrtm_file $new_mwrtm_file /bin/rm ../input/restart/mwrtm_param_rst /bin/ln -s $new_mwrtm_file ../input/restart/mwrtm_param_rst endif if (-f $old_catch_param) then + if ( -l "$new_catch_param" ) then + /bin/rm -f $new_catch_param + endif /bin/ln -s $old_catch_param $new_catch_param endif @@ -526,7 +541,7 @@ while ( $counter <= ${NUM_SGMT} ) set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} ncks -4 -O -C -x -v lat,lon ${rstf}${ENSID}_internal_checkpoint $tmp_file /bin/rm -f ${rstf}${ENSID}_internal_checkpoint - set old_rst = `/usr/bin/readlink $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst` + set old_rst = `/usr/bin/readlink -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst` /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst /bin/ln -s $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst /usr/bin/gzip $old_rst @@ -631,8 +646,18 @@ end # set next log and error file ####################################################################### -set logfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_log.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.txt -set errfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_err.${eYEAR}${eMON}${eDAY}_${eHour}${eMin}z.txt +set logfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${logYEAR}/M${logMON}/${EXPID}.ldas_log.${logYEAR}${logMON}${logDAY}_${logHour}${logMin}z.txt +set errfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${logYEAR}/M${logMON}/${EXPID}.ldas_err.${logYEAR}${logMON}${logDAY}_${logHour}${logMin}z.txt + +if (-f GEOSldas_log_txt) then + /bin/cp GEOSldas_log_txt $logfile + /bin/rm -f GEOSldas_log_txt +endif + +if(-f GEOSldas_err_txt) then + /bin/cp GEOSldas_err_txt $errfile + /bin/rm -f GEOSldas_err_txt +endif ####################################################################### # Re-Submit Job @@ -641,5 +666,5 @@ set errfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${eYEAR}/M${eMON}/${EXPID}.ldas_ if ( $rc == 0 ) then cd $HOMDIR #don't change below line(not even extra space) - if($capdate<$enddate) sbatch --output=$logfile --error=$errfile $HOMDIR/lenkf.j + if($capdate<$enddate) sbatch $HOMDIR/lenkf.j endif diff --git a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 index e573fdd2..dd28242d 100644 --- a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 +++ b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 @@ -16,6 +16,7 @@ PROGRAM mk_GEOSldasRestarts ! mpirun -np 1 bin/mk_GEOSldasRestarts.x -b BCSDIR -d YYYYMMDD -e EXPNAME -l EXPDIR -m MODEL -s SURFLAY(20/50) -r Y -t TILFILE -p PARAMFILE use MAPL + use mk_restarts_getidsMod, only: GetIDs, ReadTileFile_RealLatLon use gFTL_StringVector use ieee_arithmetic, only: isnan => ieee_is_nan USE STIEGLITZSNOW, ONLY : & @@ -115,12 +116,6 @@ PROGRAM mk_GEOSldasRestarts integer :: zoom, k, n character*100 :: InRestart - interface GetIds - procedure GetIds_fast_1p - procedure GetIds_accurate_mpi - procedure GetIds_carbon - end interface - VAR_COL = VAR_COL_CLM40 VAR_PFT = VAR_PFT_CLM40 @@ -417,7 +412,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL allocate (lon_rst (1:ntiles_rst)) allocate (lat_rst (1:ntiles_rst)) - call ReadCNTilFile ('OutData1/OutTileFile', i, long, latg); VERIFY_(i-ntiles) + call ReadTileFile_RealLatLon ('OutData1/OutTileFile', i, long, latg); VERIFY_(i-ntiles) read (10) LDAS2BCS read (10) tile_id @@ -1132,18 +1127,18 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) allocate (latg (ntiles)) allocate (ld_reorder(ntiles_smap)) - call ReadCNTilFile ('OutData1/OutTileFile', i, long, latg); VERIFY_(i-ntiles) + call ReadTileFile_RealLatLon ('OutData1/OutTileFile', i, long, latg); VERIFY_(i-ntiles) ! --------------------------------------------- ! Read exact lonc, latc from offline .til File ! --------------------------------------------- if(trim(MODEL) == 'CATCHCN') then - call ReadCNTilFile(trim(InCNTilFile ),i,lonc,latc) + call ReadTileFile_RealLatLon(trim(InCNTilFile ),i,lonc,latc) VERIFY_(i-ntiles_smap) endif if(trim(MODEL) == 'CATCH' ) then - call ReadCNTilFile(trim(InCatTilFile),i,lonc,latc) + call ReadTileFile_RealLatLon(trim(InCatTilFile),i,lonc,latc) VERIFY_(i-ntiles_smap) endif if(trim(MODEL) == 'CATCHCN') then @@ -1786,7 +1781,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) allocate (latg (ntiles)) allocate (DAYX (NTILES)) - call ReadCNTilFile (OutTileFile, i, long, latg); VERIFY_(i-ntiles) + call ReadTileFile_RealLatLon (OutTileFile, i, long, latg); VERIFY_(i-ntiles) ! Compute DAYX ! ------------ @@ -1799,7 +1794,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) ! Read exact lonc, latc from offline .til File ! --------------------------------------------- - call ReadCNTilFile(trim(InCNTilFile),i,lonc,latc); VERIFY_(i-ntiles_cn) + call ReadTileFile_RealLatLon(trim(InCNTilFile),i,lonc,latc); VERIFY_(i-ntiles_cn) endif @@ -3858,563 +3853,4 @@ SUBROUTINE read_ldas_restarts (NTILES, ntiles_rst, id_glb, ld_reorder, rst_file END SUBROUTINE read_ldas_restarts - ! ----------------------------------------------------------------------------- - -!----------------------------------------------- -! copy paset from getids.H under mk_restars in catchGrid Comp -! ----------------------------------------------------------------------------------- -! -subroutine ReadTileFile(Tf,Pf,Id,lon,lat,mask) - character*(*), intent(IN) :: Tf - integer, pointer :: Pf(:), Id(:), lon(:), lat(:) - integer, optional, intent(IN) :: mask - - integer, allocatable :: Pf1(:), Id1(:), ln1(:), lt1(:) - integer :: k, i, nt, pfs, ids,n,msk, umask - real :: dum(4),dum1,lnn,ltt - integer :: de, ce, st - logical :: old - - de=180*zoom - ce=360*zoom - st=2*zoom - if(present(mask)) then - umask = mask - else - umask = 100 - endif - - print *, "Reading tilefile ",trim(Tf) - - open(unit=20,file=trim(Tf),form='formatted') - - read(20,*,iostat=n) Nt,i,k - old=n<0 - close(20) - - open(unit=20,file=trim(Tf),form='formatted') - - read(20,*) Nt - - do i=1,7 - read(20,*) - enddo - - allocate(Pf1(Nt),Id1(Nt),ln1(Nt),lt1(Nt)) - - n=0 - do i=1,Nt - if(old) then - read(20,*,end=200) msk, Pfs, lnn, ltt - ids = 0 - else - read(20,*,end=200) msk, dum1, lnn, ltt, dum, Pfs, Ids - end if - if(msk/=umask) cycle - n = n+1 - pf1(n) = pfs - Id1(n) = ids - ln1(n) = nint(lnn*zoom) - Lt1(n)=max(min(nint(ltt*zoom),90*zoom),-90*zoom) - if(ln1(n)<-de) ln1(n) = ln1(n) + ce - if(ln1(n)> de) ln1(n) = ln1(n) - ce - enddo - -200 continue - - close(20) - - Nt=n - print *, "Found ",nt," land tiles." - - allocate(Pf(Nt),Id(Nt),lon(Nt),lat(Nt)) - Pf = Pf1(:Nt) - Id = Id1(:Nt) - lon = ln1(:Nt) - lat = lt1(:Nt) - deallocate(Pf1,Id1,ln1,lt1) - - return -end subroutine ReadTileFile - -subroutine GetStencil(ii,jj,st) - integer, intent(OUT) :: ii(0:), jj(0:) - integer, intent( IN) :: st - - integer :: n, i, j, iz, jz, di, dj - - n=-1 - do i=0,st - di = 0 - dj = 1 - jz = 0 - iz = i - n = n+1 - ii(n) = iz - jj(n) = jz - - do k=1,8*i-1 - if (iz==i.and.jz==-i) then - di = 0 - dj = 1 - elseif(iz==i.and.jz==i) then - di = -1 - dj = 0 - elseif(iz==-i.and.jz==i) then - di = 0 - dj = -1 - elseif(iz==-i.and.jz==-i) then - di = 1 - dj = 0 - endif - - iz = iz + di - jz = jz + dj - - if(jz==0 .and. iz == i) exit - n = n+1 - ii(n) = iz - jj(n) = jz - end do - end do - -! print *, 'ii = ',ii -! print * -! print *, 'jj = ',jj - -end subroutine GetStencil - - ! ***************************************************************************** - -subroutine GetIds_fast_1p (loni,lati,lon,lat,Id) - integer, dimension(:), intent( IN) :: loni,lati,lon,lat - integer, dimension(:), intent(OUT) :: Id - - integer, allocatable :: Idx(:) - integer :: i, k, l, last, iex, lonx, hash - integer, allocatable :: ii(:) - integer, allocatable :: jj(:) - integer :: jx(7) =(/0,1,-1,2,-2,3,-3/) - integer, allocatable :: ix(:) - logical :: found - integer :: de, ce, st - - de=180*zoom - ce=360*zoom - st=2*zoom - allocate(ix(ce),ii(0:(2*st+1)**2-1),jj(0:(2*st+1)**2-1)) - Hash = MAPL_HashCreate(8*1024) - - n = 1 - do i=1,ce-1,2 - ix(i ) = n - ix(i+1) = -n - n=n+1 - end do - - call GetStencil(ii,jj,st) - - allocate(Idx(size(loni))) - - do i=1,size(loni) - k = MAPL_HashIncrement(Hash,loni(i),lati(i)) - idx(k) = i - end do - - last = MAPL_HashSize(HASH) - - iex = 0 - - do i=1,size(lon) -! k = MAPL_HashIncrement(Hash,lon(i),lat(i)) -! if (k>last) then - do n=0,size(ii)-1 - lonx=lon(i)+ii(n) - if(lonx<-de)lonx=lonx+ce - if(lonx> de)lonx=lonx-ce - k = MAPL_HashIncrement(Hash,lonx,lat(i)+jj(n)) - if(k<=last) exit - end do - if (k>last) then - iex = iex + 1 - found=.false. - do l=1,7 - do n=1,ce - lonx=lon(i)+ix(n) - if(lonx<-de)lonx=lonx+ce - if(lonx> de)lonx=lonx-ce - lonx=lon(i)+ix(n) - k = MAPL_HashIncrement(Hash,lonx,lat(i)+jx(l)) - if(k<=last) then - found=.true. - exit - end if - end do - if(found) exit - end do - if(k>last) then - print *, 'Failed to find valid data for tile ',i, k, InRestart - print *, 'Thus using last' - k = last - endif - end if -! end if - Id(i) = Idx(k) - enddo - - deallocate(Idx,ix,ii,jj) - - print *, 'Used extreme measures ', iex, ' times' - print * - - end subroutine GetIds_fast_1p - - ! ***************************************************************************** - - subroutine GetIds_accurate_mpi (loni,lati,lono,lato,Id, tid_in) - - implicit none - - integer :: NT_IN, NT_OUT, n, i, nplus - real, dimension (:), intent (in) :: loni,lati,lono,lato - integer, dimension (:), intent (in) :: tid_in - integer, dimension (:), intent (inout) :: id - - logical :: tile_found - logical, allocatable, dimension(:) :: mask - integer, allocatable, dimension (:) :: sub_tid - real , allocatable, dimension (:) :: sub_lon, sub_lat, rev_dist - real :: dw, dx, dy, min_lon, max_lon, min_lat, max_lat - - NT_IN = SIZE (loni) - NT_OUT = SIZE (lono) - - allocate (mask (1: NT_IN)) - - Id = -9999 - - OUT_TILES : do n = 1, NT_OUT - - dw = 0.5 - - ZOOMOUT : do - - tile_found = .false. - - ! Min/Max lon/lat of the working window - ! ------------------------------------- - - min_lon = MAX(lono (n) - dw, -180.) - max_lon = MIN(lono (n) + dw, 180.) - min_lat = MAX(lato (n) - dw, -90.) - max_lat = MIN(lato (n) + dw, 90.) - - mask = .false. - mask = ((lati >= min_lat .and. lati <= max_lat).and.(loni >= min_lon .and. loni <= max_lon)) - nplus = count(mask = mask) - - if(nplus < 0) then - dw = dw + 0.5 - CYCLE - endif - - allocate (sub_tid (1:nplus)) - allocate (sub_lon (1:nplus)) - allocate (sub_lat (1:nplus)) - allocate (rev_dist (1:nplus)) - - sub_tid = PACK (tid_in , mask= mask) - sub_lon = PACK (loni , mask= mask) - sub_lat = PACK (lati , mask= mask) - - ! compute distance from the tile - - sub_lat = sub_lat * MAPL_PI/180. - sub_lon = sub_lon * MAPL_PI/180. - - SEEK : if(Id (n) < 0) then - - rev_dist = 1.e20 - - do i = 1,nplus - - rev_dist(i) = haversine(to_radian(lato(n)), to_radian(lono(n)), & - sub_lat(i), sub_lon(i)) - - end do - - FOUND : if(minval (rev_dist) < 1.e19) then - Id (n) = sub_tid(minloc(rev_dist,1)) - tile_found = .true. - endif FOUND - - endif SEEK - - deallocate (sub_tid, sub_lon, sub_lat, rev_dist) - - if(tile_found) GO TO 100 - - ! if not increase the window size - dw = dw + 0.5 - - end do ZOOMOUT - -100 continue - - if(mod (n,10000) == 0) print *, id(n), loni(id(n)), lono(n), lati(id(n)), lato(n) - END do OUT_TILES - - deallocate (mask) - - end subroutine GetIds_accurate_mpi - - ! ***************************************************************************** - - subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & - CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & - fveg_offl, ityp_offl) - - implicit none - integer, parameter :: npft = 19 - integer, parameter :: nveg = 4 - real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value - integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) - integer :: NT_IN, NT_OUT, n, i, nplus,nv, nx, ityp_new - integer, dimension (:), intent (in) :: tid_in - integer, dimension (:,:), intent (inout) :: id - real, dimension (:), intent (in) :: loni,lati,lono,lato - real, dimension (:), intent (in) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & - CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2 - real, dimension(:,:), intent (in) :: fveg_offl, ityp_offl - logical :: tile_found - logical, allocatable, dimension (:) :: mask - integer, allocatable, dimension (:) :: sub_tid - real , allocatable, dimension (:) :: sub_lon, sub_lat, rev_dist, sub_fevg1, sub_fevg2 - integer, allocatable, dimension (:) :: sub_ityp1, sub_ityp2,icl_ityp1 - real :: dw, dx, dy, min_lon, max_lon, min_lat, max_lat, fveg_new, sub_dist - - NT_IN = SIZE (loni) - NT_OUT = SIZE (lono) - - allocate (mask (1: NT_IN)) - - Id = -9999 - - OUT_TILES : do n = 1, NT_OUT - - dw = 0.5 - - ZOOMOUT : do - - tile_found = .false. - - ! Min/Max lon/lat of the working window - ! ------------------------------------- - - min_lon = MAX(lono (n) - dw, -180.) - max_lon = MIN(lono (n) + dw, 180.) - min_lat = MAX(lato (n) - dw, -90.) - max_lat = MIN(lato (n) + dw, 90.) - - mask = .false. - mask = ((lati >= min_lat .and. lati <= max_lat).and.(loni >= min_lon .and. loni <= max_lon)) - nplus = count(mask = mask) - - if(nplus < 0) then - dw = dw + 0.5 - CYCLE - endif - - allocate (sub_tid (1:nplus)) - allocate (sub_lon (1:nplus)) - allocate (sub_lat (1:nplus)) - allocate (rev_dist (1:nplus)) - allocate (sub_ityp1 (1:nplus)) - allocate (sub_fevg1 (1:nplus)) - allocate (sub_ityp2 (1:nplus)) - allocate (sub_fevg2 (1:nplus)) - allocate (icl_ityp1 (1:nplus)) - - sub_tid = PACK (tid_in , mask= mask) - sub_lon = PACK (loni , mask= mask) - sub_lat = PACK (lati , mask= mask) - - ! compute distance from the tile - - sub_lat = sub_lat * MAPL_PI/180. - sub_lon = sub_lon * MAPL_PI/180. - - NV_LOOP: do nv = 1, nveg - - if (nv == 1) ityp_new = CLMC_pt1(n) - if (nv == 1) fveg_new = CLMC_pf1(n) - if (nv == 2) ityp_new = CLMC_pt2(n) - if (nv == 2) fveg_new = CLMC_pf2(n) - if (nv == 3) ityp_new = CLMC_st1(n) - if (nv == 3) fveg_new = CLMC_sf1(n) - if (nv == 4) ityp_new = CLMC_st2(n) - if (nv == 4) fveg_new = CLMC_sf2(n) - - SEEK : if((Id (n, nv) < 0).and.(fveg_new > fmin)) then - - if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary - nx = nv + 2 - else - nx = nv - 2 - endif - - sub_ityp1 = ityp_offl (sub_tid,nv) - sub_fevg1 = fveg_offl (sub_tid,nv) - sub_ityp2 = ityp_offl (sub_tid,nx) - sub_fevg2 = fveg_offl (sub_tid,nx) - - rev_dist = 1.e20 - icl_ityp1 = iclass(sub_ityp1) - - do i = 1,nplus - if((sub_ityp1(i)>fmin .and. (ityp_new ==sub_ityp1(i) .or. & - iclass(ityp_new) ==iclass(sub_ityp1(i)))) .or. & - (sub_fevg2(i)>fmin .and. (ityp_new ==sub_ityp2(i) .or. & - iclass(ityp_new)==iclass(sub_ityp2(i))))) then - - sub_dist = haversine(to_radian(lato(n)), to_radian(lono(n)), & - sub_lat(i), sub_lon(i)) - - if(ityp_new == sub_ityp1(i) .and. sub_fevg1(i) >fmin) then - rev_dist(i) = 1.*sub_dist ! give priority to same (primary if primary, secondary if secondary) - ! gkw: these weights are tunable - else if(ityp_new ==sub_ityp2(i) .and. sub_fevg2(i)>fmin) then - rev_dist(i) = 2.*sub_dist ! lower priority if not same (secondary if primary, primary if secondary) - else if(iclass(ityp_new)==iclass(sub_ityp1(i)) .and. sub_fevg1(i)>fmin) then - rev_dist(i) = 3.*sub_dist ! even lower priority if same of some other PFT in same class - else if(sub_fevg2(i)>fmin) then - rev_dist(i) = 4.*sub_dist ! even lower priority if not same of some other PFT in same class - else - rev_dist(i) = 1.e20 - endif - endif - - end do - - FOUND : if(minval (rev_dist) < 1.e19) then - Id (n, nv) = sub_tid(minloc(rev_dist,1)) - - endif FOUND - - endif SEEK - end do NV_LOOP - - deallocate (sub_tid, sub_lon, sub_lat, icl_ityp1) - deallocate (sub_ityp1, sub_fevg1, sub_ityp2, sub_fevg2, rev_dist) - - tile_found = .true. - if((tile_found).and.((CLMC_pf1(n) > fmin).and.(Id(n,1) < 0))) tile_found = .false. - if((tile_found).and.((CLMC_pf2(n) > fmin).and.(Id(n,2) < 0))) tile_found = .false. - if((tile_found).and.((CLMC_sf1(n) > fmin).and.(Id(n,3) < 0))) tile_found = .false. - if((tile_found).and.((CLMC_sf2(n) > fmin).and.(Id(n,4) < 0))) tile_found = .false. - - if(tile_found) GO TO 100 - - ! if not increase the window size - dw = dw + 0.5 - - end do ZOOMOUT - -100 continue - -! if(mod (n,10000) == 0) print *, id(n), loni(id(n)), lono(n), lati(id(n)), lato(n) - END do OUT_TILES - - deallocate (mask) - - end subroutine GetIds_carbon - - ! ***************************************************************************** - - function to_radian(degree) result(rad) - - ! degrees to radians - real,intent(in) :: degree - real :: rad - - rad = degree*MAPL_PI/180. - - end function to_radian - - ! ***************************************************************************** - - real function haversine(deglat1,deglon1,deglat2,deglon2) - ! great circle distance -- adapted from Matlab - real,intent(in) :: deglat1,deglon1,deglat2,deglon2 - real :: a,c, dlat,dlon,lat1,lat2 - real,parameter :: radius = MAPL_radius - -! dlat = to_radian(deglat2-deglat1) -! dlon = to_radian(deglon2-deglon1) - ! lat1 = to_radian(deglat1) -! lat2 = to_radian(deglat2) - dlat = deglat2-deglat1 - dlon = deglon2-deglon1 - lat1 = deglat1 - lat2 = deglat2 - a = (sin(dlat/2))**2 + cos(lat1)*cos(lat2)*(sin(dlon/2))**2 - if(a>=0. .and. a<=1.) then - c = 2*atan2(sqrt(a),sqrt(1-a)) - haversine = radius*c / 1000. - else - haversine = 1.e20 - endif - end function - - ! ***************************************************************************** - - subroutine ReadCNTilFile (InCNTileFile, ntiles, xlon, xlat,mask) - - implicit none - character(*), intent (in) :: InCNTileFile - integer , intent (inout) :: ntiles - real, pointer, dimension (:) :: xlon, xlat - integer, optional, intent(IN) :: mask - integer :: n,icnt,ityp, nt, umask, i - real :: xval,yval, pf - real, allocatable :: ln1(:), lt1(:) - - if(present(mask)) then - umask = mask - else - umask = 100 - endif - - open(11,file=InCNTileFile, & - form='formatted',action='read',status='old') - read (11,*, iostat=n) Nt - - allocate(ln1(Nt),lt1(Nt)) - - do n = 1,7 ! skip header - read(11,*) - end do - - icnt = 0 - - do i=1,Nt - read(11,*) ityp,pf,xval,yval - if(ityp == umask) then - icnt = icnt + 1 - ln1(icnt) = xval - Lt1(icnt) = yval - endif - end do - - close(11) - - Ntiles = icnt - if(.not.associated (xlon)) allocate(xlon(Ntiles)) - if(.not.associated (xlat)) allocate(xlat(Ntiles)) - xlon = ln1(:Ntiles) - xlat = lt1(:Ntiles) - - end subroutine ReadCNTilFile - - END PROGRAM mk_GEOSldasRestarts diff --git a/src/Applications/LDAS_App/preprocess_ldas.F90 b/src/Applications/LDAS_App/preprocess_ldas.F90 index 69bb4678..c96e3ff9 100644 --- a/src/Applications/LDAS_App/preprocess_ldas.F90 +++ b/src/Applications/LDAS_App/preprocess_ldas.F90 @@ -3,7 +3,7 @@ ! module preprocess_module use netcdf - use MAPL_SortMod, only: MAPL_sort + use MAPL use LDAS_TileCoordType, ONLY: & tile_coord_type, & grid_def_type, & @@ -25,7 +25,6 @@ module preprocess_module domain_setup, & read_cat_param use LDAS_ensdrv_init_routines, only: io_domain_files - use MAPL_IOMod use gFTL_StringVector use pFIO integer,parameter :: excluded_tile_typ_land=1100 @@ -56,16 +55,12 @@ program main character(len=200) :: orig_BC character(len=200) :: new_BC character(len=200) :: orig_Veg - character(len=200) :: Veg_path character(len=200) :: new_veg character(len=200) :: orig_ease character(len=200) :: new_ease character(len=12) :: ymdhm character(len=12) :: SURFLAY - integer :: istat,n - logical :: file_exist - call get_command_argument(1,option) call get_command_argument(2,arg1) call get_command_argument(3,arg2) @@ -155,14 +150,10 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, real :: minlon,maxlon,minlat,maxlat character(len=200):: black_file,white_file character(len=300):: bcs_path - type(date_time_type) :: start_time logical :: file_exist logical :: d_exist,c_exist - integer :: gg_id, g_id, n,ty,stat,N_tile,N_grid, f_id,tym,N_cTile - character(len=200):: line,cline,res_ftag - - integer :: local_size + integer :: n type(grid_def_type) :: tile_grid_g,tile_grid_d type(tile_coord_type), dimension(:), pointer :: tile_coord_g => null() @@ -383,7 +374,7 @@ subroutine readf2g(N_catf,f2g) integer :: N_catg logical :: file_exist - integer :: local_size,n,status + integer :: local_size,n inquire(file=trim('f2g.txt'),exist=file_exist) if(file_exist) then @@ -417,12 +408,10 @@ subroutine createLocalTilefile(orig_tile,new_tile) character(len=200):: line logical :: file_exist - logical :: d_exist,c_exist - integer, dimension(:),allocatable :: f2g integer :: N_catg, N_catf,n,stat, ty - integer :: N_tile,N_grid,g_id,f_id + integer :: N_tile,N_grid,g_id inquire(file=trim(orig_tile),exist=file_exist) if( .not. file_exist) stop ("original tile file not exist") @@ -485,13 +474,9 @@ subroutine createLocalBC(orig_BC, new_BC) character(*),intent(in) :: orig_BC character(*),intent(in) :: new_BC - integer :: N_times - real,allocatable :: orig_data(:) - real,allocatable :: orig_new(:) - real,dimension(14) :: tmprealvec14 real,allocatable :: tmpvec(:) - integer :: n,istat, N_catg,N_catf + integer :: istat, N_catg,N_catf integer,dimension(:),allocatable :: f2g call readsize(N_catg,N_catf) @@ -521,7 +506,7 @@ subroutine createLocalCatchRestart(orig_catch, new_catch) character(*),intent(in):: orig_catch character(*),intent(in):: new_catch integer,parameter :: subtile=4 - integer :: n,istat, filetype, rc, nVars, i, j, ndims, dimSizes(3) + integer :: istat, filetype, rc,i, j, ndims real,allocatable :: tmp1(:) real,allocatable :: tmp2(:,:) type(Netcdf4_FileFormatter) :: InFmt,OutFmt @@ -533,7 +518,7 @@ subroutine createLocalCatchRestart(orig_catch, new_catch) type(StringVariableMapIterator) :: var_iter type(StringVector), pointer :: var_dimensions character(len=:), pointer :: vname,dname - integer :: N_catg,N_catf + integer ::n, N_catg,N_catf integer,dimension(:),allocatable :: f2g call readsize(N_catg,N_catf) @@ -650,7 +635,7 @@ subroutine createLocalmwRTMRestart(orig_mwrtm, new_mwrtm) character(*),intent(in):: orig_mwrtm character(*),intent(in):: new_mwrtm integer,parameter :: subtile=4 - integer :: n,istat, filetype, rc, nVars, i, j, ndims, dimSizes(3) + integer :: rc real,allocatable :: tmp1(:) type(Netcdf4_FileFormatter) :: InFmt,OutFmt type(FileMetadata) :: OutCfg @@ -774,9 +759,8 @@ subroutine correctEase(orig_ease,new_ease) implicit none character(*),intent(in) :: orig_ease character(*),intent(in) :: new_ease - integer :: istat,n,i logical :: file_exist,is_oldEASE - integer :: N_tile,N_grid + integer :: i, N_tile, N_grid character(len=200) :: tmpline inquire(file=trim(orig_ease),exist=file_exist) @@ -832,7 +816,7 @@ subroutine optimize_latlon(fname,arg) integer :: total_land integer :: n,typ,tmpint real :: tmpreal - integer :: avg_land,avg_lon,n0,local + integer :: avg_land,n0,local integer :: i,s,e,j,k,n1,n2 logical :: file_exist character(len=100):: tmpLine @@ -1280,8 +1264,8 @@ subroutine i_pert_ldas(rc) integer :: nrandseed_tmp type(grid_def_type) :: pert_grid_f_tmp character(len=*), parameter :: Iam = 'io_pert_rstrt' - integer :: itmp, jtmp,xstart,xend,ystart,yend - integer :: k, n, i,j + integer :: k + real, allocatable :: real_tmp(:) open(10, file=pfile_name, convert='big_endian',form='unformatted', status='old', & action='read', iostat=istat) @@ -1331,17 +1315,23 @@ subroutine i_pert_ldas(rc) end if ! reading - read (10) (Pert_rseed(n), n=1,NRANDSEED) + read (10) Pert_rseed(:) + allocate(real_tmp(N_lonf*N_latf)) do k=1,N_force_pert - read (10) ((Force_pert_ntrmdt_f(i,j,k), i=1,N_lonf),j=1,N_latf) + !read (10) ((Force_pert_ntrmdt_f(i,j,k), i=1,N_lonf),j=1,N_latf) + read (10) real_tmp(:) + Force_pert_ntrmdt_f(:,:,k) = reshape(real_tmp,[N_lonf, N_latf]) end do do k=1,N_progn_pert - read (10) ((Progn_pert_ntrmdt_f(i,j,k), i=1,N_lonf),j=1,N_latf) + !read (10) ((Progn_pert_ntrmdt_f(i,j,k), i=1,N_lonf),j=1,N_latf) + read (10) real_tmp(:) + Progn_pert_ntrmdt_f(:,:,k) = reshape(real_tmp,[N_lonf, N_latf]) end do - + close(10) - + deallocate(real_tmp) + rc = 0 end subroutine i_pert_ldas subroutine o_pert_GEOSldas(rc) @@ -1349,7 +1339,7 @@ subroutine o_pert_GEOSldas(rc) integer :: NCFOutID, STATUS integer :: seeddim,latdim, londim, Nforce,NProgn integer :: dims(3), seedid,forceid,prognid - integer :: xstart, ystart,i,j,k + integer :: xstart, ystart integer :: shuffle, deflate, deflate_level real :: fill_value @@ -1427,5 +1417,9 @@ subroutine o_pert_GEOSldas(rc) count=[N_lonf,N_latf,N_progn_pert]) STATUS = NF90_CLOSE (NCFOutID) + + deallocate(Force_pert_ntrmdt_f, Progn_pert_ntrmdt_f) + + rc = status end subroutine o_pert_GEOSldas end subroutine convert_pert_rst diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index d0a381ea..8bb95d0a 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -13,7 +13,11 @@ setenv RESTART_DOMAIN $10 setenv RESTART_PATH $11 setenv NUMENS $12 setenv RUN_IRRIG $13 +setenv SURFLAY $14 +setenv WEMIN_IN $15 +setenv WEMIN_OUT $16 setenv RESTART_short ${RESTART_PATH}/${RESTART_ID}/output/${RESTART_DOMAIN}/ +setenv PARAM_FILE `ls $RESTART_short/rc_out/*/*/*ldas_catparam* | head -1` set PWD=`pwd` setenv INSTDIR `echo $PWD | rev | cut -d'/' -f2- | rev` @@ -27,6 +31,7 @@ if($LSM_CHOICE == 2) then endif switch ($HAVE_RESTART) + case [0] : echo @@ -83,7 +88,7 @@ setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib limit stacksize unlimited #mpirun -map-by core --mca btl ^vader -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y -$INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y +$INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s ${SURFLAY} -j Y sleep 3 @@ -94,13 +99,12 @@ else endif #mpirun -map-by core --mca btl ^vader -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y -$INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y +$INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s ${SURFLAY} -j Y _EOI_ - if($LSM_CHOICE == 1) sed -i '$ a\bin/Scale_Catch OutData1/catch_internal_rst OutData2/catch_internal_rst catch_internal_rst 50 \' mkLDASsa.j - if($LSM_CHOICE == 2) sed -i '$ a\bin/Scale_CatchCN OutData1/catchcn_internal_rst OutData2/catchcn_internal_rst catchcn_internal_rst 50 \' mkLDASsa.j - #if($LSM_CHOICE == 2) sed -i '$ a\bin/Scale_Catch OutData1/catchcn_internal_clm45 OutData2/catchcn_internal_clm45 catchcn_internal_clm45 50 \' mkLDASsa.j + if($LSM_CHOICE == 1) sed -i '$ a\bin/Scale_Catch OutData1/catch_internal_rst OutData2/catch_internal_rst catch_internal_rst $SURFLAY $WEMIN_IN $WEMIN_OUT \' mkLDASsa.j + if($LSM_CHOICE == 2) sed -i '$ a\bin/Scale_CatchCN OutData1/catchcn_internal_rst OutData2/catchcn_internal_rst catchcn_internal_rst $SURFLAY $WEMIN_IN $WEMIN_OUT \' mkLDASsa.j sed -i '$ a\ \' mkLDASsa.j sed -i '$ a\## Done creating catch*_internal_rst file \' mkLDASsa.j @@ -128,7 +132,8 @@ _EOI2_ rm mkLDASsa.j2 sbatch mkLDASsa.j cd $PWD - breaksw + breaksw + case [1]: set coordfile=${RESTART_short}/rc_out/${RESTART_ID}.ldas_tilecoord.bin @@ -154,7 +159,7 @@ case [1]: echo 'if ( -e /etc/os-release ) then' >> this.file echo ' module load nco/4.8.1' >> this.file echo 'else' >> this.file - echo 'module load other/nco-4.6.8-gcc-5.3-sp3 ' >> this.file + echo ' module load other/nco-4.6.8-gcc-5.3-sp3 ' >> this.file echo 'endif' >> this.file #echo 'setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0' >> this.file echo 'setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib' >> this.file @@ -162,7 +167,7 @@ case [1]: set j = 0 while ($j < $NUMENS) set ENS = `printf '%04d' $j` - echo $INSTDIR/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k ${ENS} -l ${RESTART_short} -m ${MODEL} -s 50 -r Y -t ${TILFILE} >> this.file + echo $INSTDIR/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k ${ENS} -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE} >> this.file echo ncks -4 -O -h -x -v IRRIGFRAC,PADDYFRAC,LAIMIN,LAIMAX,CLMPT,CLMST,CLMPF,CLMSF ${MODEL}${ENS}_internal_rst.${YYYYMMDD} ${MODEL}${ENS}_internal_rst.${YYYYMMDD} >> this.file @ j++ end @@ -181,6 +186,238 @@ case [1]: endif breaksw + +case [2]: + + echo ' ' + mkdir -p $EXPDIR/$EXPID/mk_restarts/OutData1/ + mkdir -p $EXPDIR/$EXPID/mk_restarts/OutData2/ + ln -s $BCSDIR/$TILFILE $EXPDIR/$EXPID/mk_restarts/OutData1/OutTileFile + ln -s $BCSDIR/$TILFILE $EXPDIR/$EXPID/mk_restarts/OutData2/OutTileFile + ln -s $BCSDIR/clsm $EXPDIR/$EXPID/mk_restarts/OutData2/clsm + ln -s $INSTDIR/bin $EXPDIR/$EXPID/mk_restarts/ + + cd $EXPDIR/$EXPID/mk_restarts/ + + cat << _EOI3_ > mkLDASsa.j +#!/bin/csh -fx + +#SBATCH --account=${SPONSORID} +#SBATCH --time=1:00:00 +#SBATCH --ntasks=56 +#SBATCH --job-name=mkLDAS +#SBATCH --constraint=hasw +#SBATCH --qos=debug +#SBATCH --output=mkLDAS.o +#SBATCH --error=mkLDAS.e + +source $INSTDIR/bin/g5_modules +setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0 +if ( -e /etc/os-release ) then + module load nco/4.8.1 +else + module load other/nco-4.6.8-gcc-5.3-sp3 +endif +setenv LAIFILE `find ${BCSDIR}/lai_clim*` +limit stacksize unlimited + +$INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -l ${RESTART_short} -t ${TILFILE} -m ${MODEL} -s $SURFLAY -j Y -r R -p ${PARAM_FILE} +sleep 3 + +_EOI3_ + + if($LSM_CHOICE == 1) sed -i '$ a\bin/Scale_Catch OutData1/catch_internal_rst OutData2/catch_internal_rst catch_internal_rst $SURFLAY $WEMIN_IN $WEMIN_OUT \' mkLDASsa.j + if($LSM_CHOICE == 2) sed -i '$ a\bin/Scale_CatchCN OutData1/catchcn_internal_rst OutData2/catchcn_internal_rst catchcn_internal_rst $SURFLAY $WEMIN_IN $WEMIN_OUT \' mkLDASsa.j + + sed -i '$ a\ \' mkLDASsa.j + sed -i '$ a\## Done creating catch*_internal_rst file \' mkLDASsa.j + sed -i '$ a\ \' mkLDASsa.j + + cat << _EOI4_ > mkLDASsa.j2 +sleep 2 + +if($LSM_CHOICE == 1) then + if (-f irrigation_internal_rst && $RUN_IRRIG == 1) then + ncks -4 -v IRRIGFRAC,PADDYFRAC,LAIMIN,LAIMAX,CLMPT,CLMST,CLMPF,CLMSF irrigation_internal_rst -A catch_internal_rst + endif + ln -s catch_internal_rst catch_internal_rst.$YYYYMMDD +else + if (-f irrigation_internal_rst && $RUN_IRRIG == 1) then + ncks -4 -v IRRIGFRAC,PADDYFRAC,LAIMIN,LAIMAX,CLMPT,CLMST,CLMPF,CLMSF irrigation_internal_rst -A catchcn_internal_rst + endif + ln -s catchcn_internal_rst catchcn_internal_rst.$YYYYMMDD +endif + +echo DONE > done_rst_file +_EOI4_ + + cat mkLDASsa.j2 >>mkLDASsa.j + rm mkLDASsa.j2 + sbatch mkLDASsa.j + cd $PWD + breaksw + +case [FGM]: + + set YYYY = `echo $YYYYMMDD | cut -c1-4` + set MM = `echo $YYYYMMDD | cut -c5-6` + set DD = `echo $YYYYMMDD | cut -c7-8` + + mkdir -p $EXPDIR/$EXPID/mk_restarts/InData/ + mkdir -p $EXPDIR/$EXPID/mk_restarts/OutData.1/ + mkdir -p $EXPDIR/$EXPID/mk_restarts/OutData.2/ + + if ($HAVE_RESTART == M) then + set ARCDIR = /archive/users/gmao_ops/MERRA2/gmao_ops/GEOSadas-5_12_4/d5124_m2_jan79/rs/Y ; set mlable = jan79 + if ($YYYY > 1991) set ARCDIR = /archive/users/gmao_ops/MERRA2/gmao_ops/GEOSadas-5_12_4/d5124_m2_jan91/rs/Y ; set mlable = jan91 + if ($YYYY > 2000) set ARCDIR = /archive/users/gmao_ops/MERRA2/gmao_ops/GEOSadas-5_12_4/d5124_m2_jan00/rs/Y ; set mlable = jan00 + if ($YYYY > 2010) set ARCDIR = /archive/users/gmao_ops/MERRA2/gmao_ops/GEOSadas-5_12_4/d5124_m2_jan10/rs/Y ; set mlable = jan10 + set rstfile = ${ARCDIR}${YYYY}/M${MM}/d5124_m2_${mlable}.catch_internal_rst.${YYYYMMDD}_21z.bin + dmget $rstfile + set INTILFILE = /gpfsm/dnb02/ltakacs/bcs/Ganymed-4_0/Ganymed-4_0_MERRA-2/CF0180x6C_DE1440xPE0720/CF0180x6C_DE1440xPE0720-Pfafstetter.til + set WEMIN_IN = 26 + /bin/cp -p $rstfile $EXPDIR/$EXPID/mk_restarts/InData/M2Restart + endif + + if ($HAVE_RESTART == G) then + set rstfile = `echo $RESTART_PATH | rev | cut -c 2- | rev` + set INTILFILE = `readlink $RESTART_ID/scratch/tile.data` + if ( `echo $INTILFILE | grep -n 'NLv3'` == '' ) set WEMIN_IN = 26 + /bin/cp -p $rstfile $EXPDIR/$EXPID/mk_restarts/InData/M2Restart + endif + + if ($HAVE_RESTART == F) then + + set date_16 = `date -d"2017-1-24" +%Y%m%d` + set date_17 = `date -d"2017-11-1" +%Y%m%d` + set date_21 = `date -d"2018-7-11" +%Y%m%d` + set date_22 = `date -d"2019-3-13" +%Y%m%d` + set date_25 = `date -d"2020-1-30" +%Y%m%d` + set expdate = `date -d"$YYYY-$MM-$DD" +%Y%m%d` + + if ($expdate < $date_16) then + echo "WARNING : FP restarts before $date_16 are not availale." + echo " Please select RESTART: M and use MERRA-2, instead." + exit + endif + + if (($expdate >= $date_16) && ($expdate < $date_17)) then + set fpver = GEOS-5.16/GEOSadas-5_16/ + set fplab = f516_fp + set INTILFILE = /discover/nobackup/ltakacs/bcs/Ganymed-4_0/Ganymed-4_0_Ostia/CF0720x6C_DE2880xPE1440/CF0720x6C_DE2880xPE1440-Pfafstetter.til + set WEMIN_IN = 26 + set rstfile = /archive/u/dao_ops/$fpver/${fplab}/rs/Y${YYYY}/M${MM}/${fplab}.catch_internal_rst.${YYYYMMDD}_21z.bin + dmget $rstfile + /bin/cp -p $rstfile $EXPDIR/$EXPID/mk_restarts/InData/M2Restart + endif + if (($expdate >= $date_17) && ($expdate < $date_21)) then + set fpver = GEOS-5.17/GEOSadas-5_17/ + set fplab = f517_fp + set INTILFILE = /discover/nobackup/ltakacs/bcs/Icarus/Icarus_Ostia/CF0720x6C_CF0720x6C/CF0720x6C_CF0720x6C-Pfafstetter.til + set WEMIN_IN = 26 + set TARFILE = /archive/u/dao_ops/$fpver/${fplab}/rs/Y${YYYY}/M${MM}/${fplab}.rst.${YYYYMMDD}_21z.tar + dmget $TARFILE + set rstfile = ${fplab}.catch_internal_rst.${YYYYMMDD}_21z.nc4 + tar -xvf $TARFILE $rstfile && /bin/mv $rstfile $EXPDIR/$EXPID/mk_restarts/InData/M2Restart + endif + if (($expdate >= $date_21) && ($expdate < $date_22)) then + set fpver = GEOS-5.21/GEOSadas-5_21/ + set fplab = f521_fp + set INTILFILE = /discover/nobackup/ltakacs/bcs/Icarus/Icarus_Ostia/CF0720x6C_CF0720x6C/CF0720x6C_CF0720x6C-Pfafstetter.til + set WEMIN_IN = 26 + set TARFILE = /archive/u/dao_ops/$fpver/${fplab}/rs/Y${YYYY}/M${MM}/${fplab}.rst.${YYYYMMDD}_21z.tar + dmget $TARFILE + set rstfile = ${fplab}.catch_internal_rst.${YYYYMMDD}_21z.nc4 + tar -xvf $TARFILE $rstfile && /bin/mv $rstfile $EXPDIR/$EXPID/mk_restarts/InData/M2Restart + endif + if (($expdate >= $date_22) && ($expdate < $date_25)) then + set fpver = GEOS-5.22/GEOSadas-5_22/ + set fplab = f522_fpp + set INTILFILE = /discover/nobackup/ltakacs/bcs/Icarus/Icarus_Ostia/CF0720x6C_CF0720x6C/CF0720x6C_CF0720x6C-Pfafstetter.til + set WEMIN_IN = 26 + set TARFILE = /archive/u/dao_ops/$fpver/${fplab}/rs/Y${YYYY}/M${MM}/${fplab}.rst.${YYYYMMDD}_21z.tar + dmget $TARFILE + set rstfile = ${fplab}.catch_internal_rst.${YYYYMMDD}_21z.nc4 + tar -xvf $TARFILE $rstfile && /bin/mv $rstfile $EXPDIR/$EXPID/mk_restarts/InData/M2Restart + endif + if ($expdate >= $date_25) then + set fpver = GEOS-5.25/GEOSadas-5_25/ + set fplab = f525land_fpp + set INTILFILE = /discover/nobackup/ltakacs/bcs/Icarus-NLv3/Icarus-NLv3_Ostia/CF0720x6C_CF0720x6C/CF0720x6C_CF0720x6C-Pfafstetter.til + set WEMIN_IN = 13 + set TARFILE = /archive/u/dao_ops/$fpver/${fplab}/rs/Y${YYYY}/M${MM}/${fplab}.rst.${YYYYMMDD}_21z.tar + dmget $TARFILE + set rstfile = ${fplab}.catch_internal_rst.${YYYYMMDD}_21z.nc4 + tar -xvf $TARFILE $rstfile && /bin/mv $rstfile $EXPDIR/$EXPID/mk_restarts/InData/M2Restart + endif + + endif + + /bin/ln -s $INTILFILE $EXPDIR/$EXPID/mk_restarts/InData/InTilFile + /bin/ln -s $BCSDIR/$TILFILE $EXPDIR/$EXPID/mk_restarts/OutData.1/OutTilFile + /bin/ln -s $BCSDIR/$TILFILE $EXPDIR/$EXPID/mk_restarts/OutData.2/OutTilFile + /bin/ln -s $BCSDIR/clsm $EXPDIR/$EXPID/mk_restarts/OutData.2/clsm + /bin/ln -s $INSTDIR/bin $EXPDIR/$EXPID/mk_restarts/ + cd $EXPDIR/$EXPID/mk_restarts/ + + cat << _EOI5_ > mkLDASsa.j +#!/bin/csh -fx + +#SBATCH --account=${SPONSORID} +#SBATCH --time=1:00:00 +#SBATCH --ntasks=56 +#SBATCH --job-name=mkLDAS +#SBATCH --constraint=hasw +#SBATCH --qos=debug +#SBATCH --output=mkLDAS.o +#SBATCH --error=mkLDAS.e + +source $INSTDIR/bin/g5_modules +setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0 +#setenv MKL_CBWR SSE4_2 # ensure zero-diff across archs +#setenv MV2_ON_DEMAND_THRESHOLD 8192 # MVAPICH2 +setenv LAIFILE `find ${BCSDIR}/lai_clim*` +if ( -e /etc/os-release ) then + module load nco/4.8.1 +else + module load other/nco-4.6.8-gcc-5.3-sp3 +endif +limit stacksize unlimited + +/bin/ln -s OutData.1 OutData +if($LSM_CHOICE == 1) then +$INSTDIR/bin/esma_mpirun -np 56 bin/mk_CatchRestarts OutData/OutTilFile InData/InTilFile InData/M2Restart $SURFLAY 4 +else +$INSTDIR/bin/esma_mpirun -np 56 bin/mk_CatchCNRestarts OutData/OutTilFile InData/InTilFile InData/M2Restart $SURFLAY $YYYYMMDD 4 +endif +/bin/rm OutData + +/bin/ln -s OutData.2 OutData +if($LSM_CHOICE == 1) then +$INSTDIR/bin/esma_mpirun -np 1 bin/mk_CatchRestarts OutData/OutTilFile OutData.1/OutTilFile OutData.1/M2Restart $SURFLAY 4 +else +$INSTDIR/bin/esma_mpirun -np 1 bin/mk_CatchCNRestarts OutData/OutTilFile OutData.1/OutTilFile OutData.1/M2Restart $SURFLAY $YYYYMMDD 4 +endif +/bin/rm OutData + +if($LSM_CHOICE == 1) then +bin/Scale_Catch OutData.1/M2Restart OutData.2/M2Restart catch_internal_rst $SURFLAY 26 $WEMIN_OUT +else +bin/Scale_CatchCN OutData.1/M2Restart OutData.2/M2Restart catchcn_internal_rst $SURFLAY 26 $WEMIN_OUT +endif + +if (-f irrigation_internal_rst && $RUN_IRRIG == 1) then + ncks -4 -v IRRIGFRAC,PADDYFRAC,LAIMIN,LAIMAX,CLMPT,CLMST,CLMPF,CLMSF irrigation_internal_rst -A catch_internal_rst +endif +/bin/ln -s catch_internal_rst catch_internal_rst.$YYYYMMDD + +echo DONE > done_rst_file +_EOI5_ + + sbatch mkLDASsa.j + cd $PWD + breaksw + default : echo $HAVE_RESTART is not implemented endsw diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 615c8cfc..134f13eb 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -99,7 +99,7 @@ module GEOS_LandAssimGridCompMod integer,dimension(:),pointer :: N_catl_vec,low_ind integer :: N_catf !reordered tile_coord_rf and mapping l2rf -integer,dimension(:),pointer :: l2rf, rf2l,rf2g +integer,dimension(:),pointer :: l2rf, rf2l,rf2g, rf2f type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() integer, allocatable :: Pert_rseed(:,:) real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) @@ -940,7 +940,6 @@ subroutine Initialize(gc, import, export, clock, rc) integer :: land_nt_local,i,mpierr, ens ! mapping f to re-orderd f so it is continous for mpi_gather ! rf -- ordered by processors. Within the processor, ordered by MAPL grid - integer,allocatable :: rf2f(:) integer,allocatable :: f2rf(:) ! mapping re-orderd rf to f for the LDASsa output type(grid_def_type) :: tile_grid_g type(grid_def_type) :: tile_grid_f @@ -1752,7 +1751,49 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) obs_param, & met_force, lai, & cat_param, cat_progn, cat_progn_incr, mwRTM_param, & - Observations_l ) + Observations_l, rf2f=rf2f ) + + + do i = 1, N_catl + cat_progn_incr_ensavg(i) = 0.0 + do n_e=1, NUM_ENSEMBLE + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & + + cat_progn_incr(i,n_e) + end do + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) + enddo + + if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 + if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 + if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 + if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 + if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 + if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 + + if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac + if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef + if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc + if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc + + if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) + if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) + if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) + if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) + if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) + if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) + + if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) + if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) + if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) + + if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) + if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) + if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) + + if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) + if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) + if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) + do i = 1, N_catl diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 29b0cf75..9e46c25f 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -1380,7 +1380,7 @@ end subroutine apply_enkf_increments ! ******************************************************************** subroutine output_ObsFcstAna(date_time, work_path, exp_id, & - N_obsl, Observations_l, N_obs_param, obs_param ) + N_obsl, Observations_l, N_obs_param, obs_param, rf2f) ! obs space output: observations, obs space forecast, obs space analysis, and ! associated error variances @@ -1399,6 +1399,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & type(obs_type), dimension(N_obsl), intent(in) :: Observations_l type(obs_param_type), dimension(N_obs_param), intent(in) :: obs_param + integer, dimension(:), optional, intent(in) :: rf2f ! --------------------- @@ -1410,6 +1411,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & type(obs_type), dimension(:), allocatable :: Observations_f, Observations_tmp integer :: n, N_obsf + integer, dimension(:), allocatable :: rf_tilenums, tilenums integer, dimension(numprocs) :: N_obsl_vec, tmp_low_ind @@ -1541,10 +1543,18 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & end do + deallocate(Observations_tmp) #endif ! LDAS_MPI - + ! reorder tilenum, so it is consisten with the order in tile_coord.bin file + if(present(rf2f)) then + allocate(rf_tilenums(N_obsf), tilenums(N_obsf)) + rf_tilenums = Observations_f(:)%tilenum + tilenums = rf2f(rf_tilenums) + Observations_f(:)%tilenum =tilenums + deallocate(rf_tilenums, tilenums) + endif ! write to file fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & @@ -1701,7 +1711,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & ! write out model, observations, and "OminusA" information call output_ObsFcstAna( date_time, work_path, exp_id, N_obsl, & - Observations_l(1:N_obsl), N_obs_param, obs_param ) + Observations_l(1:N_obsl), N_obs_param, obs_param, rf2f=rf2f ) end if diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 index 32e9d5f4..f3af95b1 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 @@ -2166,8 +2166,10 @@ subroutine ApplyForcePert(gc, import, export, clock, rc) call MAPL_TimerOff(MAPL, '-MetForcing2Catch') ! Update the r8 version of pert_rseed - pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + if (internal%PERTURBATIONS /=0 ) then + pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) + pert_iseed(:,internal%ens_id+1) = pert_rseed + endif ! Clean up if (allocated(mfPert)) then From 3d1924c8f64b8c5c0c7635aa241132368c9db466 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 18 Mar 2020 16:48:58 -0400 Subject: [PATCH 04/42] Cleaning up sync from develop to master (tmp-master-branch-rreichle-20200318) (#156) --- src/Applications/LDAS_App/process_rst.csh | 2 - .../GEOS_LandAssimGridComp.F90 | 42 ------------------- 2 files changed, 44 deletions(-) diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index 8bb95d0a..063ca9cd 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -87,7 +87,6 @@ setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib limit stacksize unlimited -#mpirun -map-by core --mca btl ^vader -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y $INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s ${SURFLAY} -j Y sleep 3 @@ -98,7 +97,6 @@ else /bin/cp OutData1/catchcn_internal_rst OutData2/catchcn_internal_rst endif -#mpirun -map-by core --mca btl ^vader -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s 50 -j Y $INSTDIR/bin/esma_mpirun -np 56 bin/mk_GEOSldasRestarts.x -a ${SPONSORID} -b ${BCSDIR} -t ${TILFILE} -m ${MODEL} -s ${SURFLAY} -j Y _EOI_ diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 134f13eb..8171142f 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -1796,48 +1796,6 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) - do i = 1, N_catl - cat_progn_incr_ensavg(i) = 0.0 - do n_e=1, NUM_ENSEMBLE - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & - + cat_progn_incr(i,n_e) - end do - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) - enddo - - if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 - if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 - if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 - if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 - if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 - if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 - - if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac - if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef - if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc - if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc - - if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) - if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) - if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) - if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) - if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) - if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) - - if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) - if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) - if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) - - if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) - if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) - if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) - - if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) - if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) - if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) - - - ! write analysis fields into SMAP L4_SM aup file ! whenever it was time for assimilation (regardless ! of whether obs were actually assimilated and fresh From 6402a735c65c6069c71ebd4288bda2ac04e78196 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang <52509753+weiyuan-jiang@users.noreply.github.com> Date: Fri, 20 Mar 2020 12:03:08 -0400 Subject: [PATCH 05/42] bug fix. wrong indent (#157) bug fix: wrong indent in python script (ldas_setup) --- src/Applications/LDAS_App/ldas_setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 4d2279e2..d80eeeb0 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -847,10 +847,10 @@ class LDASsetup: catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'_internal_rst.'+YYYYMMDD else : catchRstFile = rstpath+ens +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 + _catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+ensid+'_internal_rst.'+YYYYMMDD vegdynRstFile= rstpath+ens +'/'+self.rqdExeInp['RESTART_ID']+ '.vegdyn_internal_rst' if not os.path.isfile(vegdynRstFile): # no vegdyn restart from LDASsa vegdynRstFile = glob.glob(self.rqdExeInp['BCS_PATH']+'vegdyn_*.dat')[0] - _catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+ensid+'_internal_rst.'+YYYYMMDD if (self.nens == 1) : _catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'0000_internal_rst.'+YYYYMMDD if os.path.isfile(_catchRstFile): # from LDASsa restart From 3b84db1ec7cbdb0f512cce3fa7fa1af29bff7f85 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang <52509753+weiyuan-jiang@users.noreply.github.com> Date: Fri, 3 Apr 2020 14:50:17 -0400 Subject: [PATCH 06/42] Update README.md (#162) Updated README.md --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 4b8e6698..8dde9a33 100644 --- a/README.md +++ b/README.md @@ -130,11 +130,11 @@ make -j6 install --- ## Setup up a run -If you are using SLES12 at NCCS, you **must** run setup on an interactive compute node. SLES12 login nodes no longer allow running MPI. +If you are using SLES12 at NCCS, you **must** run setup on an interactive compute node, then `source g5_modules` (csh) or `source g5_modules.sh` (bash). SLES12 login nodes no longer allow running MPI. ``` -cd ../(some_architecture)/bin -source g5_modules +cd [..]/install/bin +source g5_modules[.sh] ./ldas_setup setup [-v] [--runmodel] exp_path "exe"_input_filename "bat"_input_filename ``` where From 99060059e2902f5df5bdd3418c307d516b56a08b Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 15 Apr 2020 10:40:03 -0400 Subject: [PATCH 07/42] Merging develop into master (#172) New GEOS_SurfaceGridComp.rc file Cross-stream support for FP f525_p5 forcing Updated README.md Parallel post-processing Zero-diff for Catchment Non-zero diff for CatchCN (via v1.8.3 of GEOS_GCMGridComp) Bug fixes: - obspertrseed restart file name when restarting from existing run - subdaily2daily nc4 concatenation (indent error) --- Externals.cfg | 2 +- README.md | 193 ++++++------- src/Applications/LDAS_App/GEOSldas_LDAS.rc | 262 +++++++----------- src/Applications/LDAS_App/ldas_setup | 40 ++- src/Applications/LDAS_App/lenkf.j.template | 63 +++-- src/Applications/LDAS_App/process_rst.csh | 13 +- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 59 ++-- 7 files changed, 309 insertions(+), 323 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 4684c83a..ccfac927 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.1 +tag = v1.8.3 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/README.md b/README.md index 8dde9a33..1ac6c945 100644 --- a/README.md +++ b/README.md @@ -1,89 +1,135 @@ -# GEOS LDAS Fixture +# GEOSldas Fixture -## How to build GEOS LDAS +This document explains how to build, set up, and run the GEOS land modeling and data assimilation system (`GEOSldas`). -### Preliminary Steps +## How to Build GEOSldas -#### Load Build Modules +### Step 1: Load the Build Modules -Make sure the correct module from the GMAO SI team is loaded: +Load the `GEOSenv` module provided by the GMAO Software Infrastructure team. It contains the latest `git`, `CMake`, and `manage_externals` modules and must be loaded in any interactive window that is used to check out and build the model. -##### NCCS (SLES11 or SLES12) - -``` -module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES11 -``` -or ``` -module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES12 +module use -a (path) +module load GEOSenv ``` -or add the following to your `.cshrc`: + +where `(path)` depends on the computer and operating system: + +| System | Path | +| ------------- |---------------------------------------------------| +| NCCS SLES11 | `/discover/swdev/gmao_SIteam/modulefiles-SLES11` | +| NCCS SLES12 | `/discover/swdev/gmao_SIteam/modulefiles-SLES12` | +| NAS | `/nobackup/gmao_SIteam/modulefiles` | +| GMAO desktops | `/ford1/share/gmao_SIteam/modulefiles` | + + +For NCCS, you can add the following to your `.cshrc`: ``` if ( ! -f /etc/os-release ) then module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES11 else module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES12 endif +module load GEOSenv ``` -##### NAS + +### Step 2: Obtain the Model + +For development work, clone the _entire_ repository and use the `develop` branch as your starting point (equivalent to the `UNSTABLE` tag in the old CVS repository): ``` -module use -a /nobackup/gmao_SIteam/modulefiles +git clone -b develop git@github.com:GEOS-ESM/GEOSldas.git +``` +For science runs, you can also obtain a specific tag or branch _only_ (as opposed to the _entire_ repository), e.g.: +``` +git clone -b v17.9.0-beta.3 --single-branch git@github.com:GEOS-ESM/GEOSldas.git ``` -##### GMAO Desktops -On the GMAO desktops, the SI Team modulefiles should automatically be -part of running `module avail` but if not, they are in: +### Step 3: Build the Model + +To build the model in a single step, do the following: ``` -module use -a /ford1/share/gmao_SIteam/modulefiles -``` +cd ./GEOSldas +parallel_build.csh +``` +from a head node. Doing so will checkout all the external repositories of the model and build it. When done, the resulting model build will be found in `build/` and the installation will be found in `install/`, with setup scripts like `ldas_setup` in `install/bin`. + +To obtain a build that is suitable for debugging, you can run `parallel_build.csh -debug`, which will build in `build-Debug/` and install in `install-Debug/`. + +See below for how to build the model in multiple steps. + +--- + +## How to Set Up and Run GEOSldas -Also do this in any interactive window you have. This allows you to get module files needed to correctly checkout and build the model. +a) Obtain an interactive _compute_ node: -Now load the `GEOSenv` module: ``` -module load GEOSenv +xalloc --nodes=1 ``` -which obtains the latest `git`, `CMake`, and `manage_externals` modules. -#### Obtain the Model +The GEOSldas setup script uses MPI and **must** be run on a compute node. (For NCCS SLES11, a login node also works.) + + +b) On the _compute_ node, set up the job as follows: ``` -git clone git@github.com:GEOS-ESM/GEOSldas.git -``` +cd (build_path)/GEOSldas/install/bin +source g5_modules +./ldas_setup setup [-v] [--runmodel] (exp_path) ("exe"_input_filename) ("bat"_input_filename) +``` ---- +where -### Single Step Building of the Model +| Parameter | Description | +| -----------------------|----------------------------------------------------------| +| `build_path` | path to build directory | +| `exp_path` | path of desired experiment directory | +| `"exe"_input_filename` | filename (with path) of "experiment" inputs | +| `"bat"_input_filename` | filename (with path) of "batch" (job scheduler) inputs | -If all you wish is to build the model, you can run +The three arguments for `ldas_setup` are positional and must be ordered as indicated above. -`parallel_build.csh` +The latter two files contain essential information about the experiment setup. +Sample files can be generated as follows: +``` +ldas_setup sample --exeinp > YOUR_exeinp.txt +ldas_setup sample --batinp > YOUR_exeinp.txt +``` -from a head node. Doing so will checkout all the external repositories of the model and build it. When done, the resulting model build will be found in `build/` and the installation will be found in `install/` with setup scripts like `ldas_setup` in `install/bin`. +Edit these sample files following the examples and comments within the sample files. -#### Develop Version of LDAS +The ldas_setup script creates a run directory and other directories at: +`[exp_path]/[exp_name]` -By default, your clone will be one the `master` branch. To get the most recent -development (not quite ready for prime time), the user should checkout the -`develop` branch before building. +Configuration input files will be created at: +`[exp_path]/[exp_name]/run` +For more options and documentation, use any of the following: ``` -git checkout develop -parallel_build.csh +ldas_setup -h +ldas_setup sample -h +ldas_setup setup -h ``` -This is equivalent of the development `-UNSTABLE` tag in the CVS days. -#### Debug Version of LDAS +Configure the experiment output by editing the ```HISTORY.rc``` file. -To obtain a debug version, you can run `parallel_build.csh -debug` which will build with debugging flags. This will build in `build-Debug/` and install into `install-Debug/`. +c) Finally, run the job: +``` +cd [exp_path]/[exp_name]/run/ +sbatch lenkf.j +``` ---- +For more information, see the README files and ppt tutorial in `./src/Applications/LDAS_App/doc/`. + +----------------------------------------------------------------------------------- + +## Additional Information -### Multiple Steps for Building the Model +### How to Build the Model in Multiple Steps -The steps detailed below are essentially those that `parallel_build.csh` performs for you. Either method should yield identical builds. +The steps detailed below are essentially those performed by `parallel_build.csh` in Step 3 above. Either method should yield identical builds. ##### Checkout externals ``` @@ -91,8 +137,6 @@ cd GEOSldas checkout_externals ``` -#### Build the Model - ##### Load Compiler, MPI Stack, and Baselibs On tcsh: ``` @@ -126,60 +170,5 @@ and CMake will install there. ``` make -j6 install ``` - ---- - -## Setup up a run -If you are using SLES12 at NCCS, you **must** run setup on an interactive compute node, then `source g5_modules` (csh) or `source g5_modules.sh` (bash). SLES12 login nodes no longer allow running MPI. - -``` -cd [..]/install/bin -source g5_modules[.sh] -./ldas_setup setup [-v] [--runmodel] exp_path "exe"_input_filename "bat"_input_filename -``` -where - ->exp_path = path of desired experiment directory - ->"exe"_input_filename = filename (with path) of "experiment" inputs - ->"bat"_input_filename = filename (with path) of "batch" inputs - -must be ordered as above (positional arguments). - -The latter two files contain essential information about the experiment setup. -Sample files can be generated as follows: -``` -ldas_setup sample --exeinp > YOUR_exeinp.txt -ldas_setup sample --batinp > YOUR_exeinp.txt -``` - -Edit these sample files (see comments within sample files). See README files -and ppt tutorial (in ./src/Applications/LDAS_App/doc/) for more information. - -The ldas_setup script creates a run directory and other directories at: -```[exp_path]/[exp_name]``` - -Configuration input files will be created at: - -```[exp_path]/[exp_name]/run``` - -For more options and documentation run any of the following: -``` -ldas_setup -h -ldas_setup sample -h -ldas_setup setup -h -``` - -Configure experiment output by editing the ```HISTORY.rc``` file. - ---- - -## Run a job: - - cd [exp_path]/[exp_name]/run/ - - sbatch lenkf.j - -See ppt tutorial (in ./src/Applications/LDAS_App/doc/) for more information about how to run GEOSldas. +If you are using SLES12 at NCCS, you **should** run `make -j6 install` on an interactive _compute_ node. diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index 55224f68..b70f3417 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -1,61 +1,35 @@ -# -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# -# # -# DEFAULT parameters in GEOSldas_LDAS.rc # -# # -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# +# # +# GEOSldas Resource Parameters # +# # +# Values below override the hardcoded default values # +# in *.F90 calls to MAPL_GetResource(). # +# # +# Users can further override the values below by # +# editing the "exeinp" file during ldas setup. # +# # +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# -#--------------------------------------------------------# -# Rarely changed parameters in GEOSldas # -#--------------------------------------------------------# - -# ---- Using offline? -# -# 0: DEFAULT for GCM. (WW,CH,CM,CQ,FR) are required in catchment restart file -# 1: DEFAULT for GEOSldas (WW,CH,CM,CQ,FR) are optional -# 2: (WW,CH,CM,CQ,FR) are optional for input restart but will be in output restart -# -CATCHMENT_OFFLINE : 1 - -# ---- No dycore for offline -# -DYCORE : none -# ---- Only one surface level +# ---- Using Catchment/CatchmentCN offline? # -LM : 1 - -# ---- First ensemble ID +# 0: DEFAULT for GCM, (WW,CH,CM,CQ,FR) are required in Catchment restart file +# 1: DEFAULT for GEOSldas, (WW,CH,CM,CQ,FR) are optional +# 2: Option for GEOSldas, (WW,CH,CM,CQ,FR) are optional for input restart but will be in output +# restart; select when using GEOSldas to create restarts for the GCM. # -FIRST_ENS_ID : 0 +CATCHMENT_OFFLINE: 1 -# ---- For MAPL_RestartOptional +# ---- Choice of land surface model # -MAPL_ENABLE_BOOTSTRAP : YES - - -# ---- SURFLAY +# 1 : Catchment model (default) +# 2 : CatchmentCN model # -SURFLAY : 50.0 - -#--------------------------------------------------------# -# Optional parameters. Users can overwrite the defaults # -# through the user-generated exeinp file. # -#--------------------------------------------------------# +LSM_CHOICE: 1 -# ---- Metforce time step -# Should be set in the exeinp file where MET_PATH is defined -# 3600 = default -# -# FORCE_DTSTEP : 3600 -# ---- Choice of Land Surface Model: -# 1 : Catchment Model (Default) -# 2 : CatchmentCN Model +# ---- Domain definition # -LSM_CHOICE : 1 - -# ---- Domain definition: # The domain is determined by specifying a lat/lon rectangle in conjunction # with blacklist and whitelist files. The files contain the IDs of tiles to # be excluded and included in the domain. @@ -67,170 +41,132 @@ LSM_CHOICE : 1 # If only whitelist should be used, specify dummy valuessuch that: # MINLON > MAXLON and MINLAT > MAXLAT. # -# MINLON : -180. -# MAXLON : 180. -# MINLAT : -90. -# MAXLAT : 90. +# MINLON : -180. +# MAXLON : 180. +# MINLAT : -90. +# MAXLAT : 90. # # Specify path and filenames for blacklist and whitelist files: # (May leave blank.) # -# BLACK_FILE : '' -# WHITE_FILE : '' +# BLACK_FILE : '' +# WHITE_FILE : '' -# ---- Surface layer turbulence scheme: -# 0 : Louis (MERRA, Fortuna-DAS, SMAP NRv4/4.1/5/7.2) -# 1 : Helfand Monin-Obukhov (Fortuna-AR5, Ganymed, Heracles, Icarus-3_2, MERRA-2) -# -CHOOSEMOSFC : 0 -# ---- Formulation for turbulent roughness length (Z0): -# 0 : Fortuna, SMAP NRv3 -# 1 : Ganymed-4_1, SMAP NRv4/NRv4.1 -# 2 : Heracles-4_3, Icarus (AGCM default) -# 3 : SMAP NRv5/NRv7.2 -# 4 : f525land_fpp +# ---- Surface meteorological forcing: Time step # -Z0_FORMULATION : 4 - -# ---- ASCAT-derived roughness length: -# 0 : Default - do not use ASCAT information. -# 1 : Replace model roughness length with ASCAT Z0 where climatological NDVI<0.2. +# Should be set in the exeinp file where MET_PATH is defined +# 3600 = default # -USE_ASCATZ0 : 0 +# FORCE_DTSTEP : 3600 -# ---- Aerosol deposition on snow (available only with MERRA-2 forcings): -# 0 : DEFAULT, ALL GOCART Aerosol are NOT used -# 1 : use all GOCART aerosol data -# 2 : GOCART DUST is NOT used -# 3 : GOCART Black Carbon is NOT used -# 4 : GOCART Organic Carbon is NOT used +# ---- Surface meteorological forcing: Horizonal interpolation # -AEROSOL_DEPOSITION : 0 - -# ---- Run the irrigation model : -# 0 : Default - NO Do not run the irrigation model -# 1 : YES run the irrigation model -RUN_IRRIG : 0 +# 1 : bilinear interpolation (default) +# 0 : nearest neighbor +# +MET_HINTERP : 1 -# ---- irrigation model method : -# 0 : Default - Sprinkler and Flood irrigation combined -# 1 : sprinkler irrigation only -# 2 : flood irrigation only -IRRIG_METHOD : 0 -# ---- Number of constituents for GOSWIM (the GOddard SnoW Impurity Module) -# 0 : Default, GOSWIM snow albedo scheme is turned OFF for land -# 9 : GOSWIM snow albedo scheme is turned ON for land +# ---- Specify if running model only or data assimilation +# +# NO : model only (DEFAULT; with --runmodel option) +# YES : assimilation (without --runmodel option) # -N_CONST_LAND4SNWALB : 0 +LAND_ASSIM : NO -# ---- Perturbations (If num_ensemble > 1, PERTURBATIONS will automatically be set to 1): + +# ---- Perturbations: On/off +# +# If num_ensemble > 1, PERTURBATIONS will automatically be set to 1. +# # 0 : No perturbactions. # 1 : With perturbations. # PERTURBATIONS : 0 -# ---- Path to special namelist input files: -# This only applies for ensemble simulations. The variable values in special name list -# overwrite the DEFAULT values . There may be three files: -# LDASsa_SPECIAL_inputs_ensupd.nml, -# LDASsa_SPECIAL_inputs_ensprop.nml, and +# ---- Perturbations: ID of first ensemble member +# +FIRST_ENS_ID : 0 + + +# ---- Path to special namelist input files +# +# Applies only for ensemble simulations. The variable values in the special +# namelist overwrite the DEFAULT values. There may be three files: +# LDASsa_SPECIAL_inputs_ensupd.nml +# LDASsa_SPECIAL_inputs_ensprop.nml # LDASsa_SPECIAL_inputs_catbias.nml # -# NML_INPUT_PATH : '' +# NML_INPUT_PATH : '' + -# ---- Write log file (YES/NO)? +# ---- Microwave Radiative Transfer Model (mwRTM) parameter file name (nc4 format) used for Tb assimilation # -LDAS_logit : YES +# This file can be converted from binary with the program mwrtm_bin2nc4.x. +# If empty or commented out, GEOSldas will search the restart directory. +# +# MWRTM_FILE : '' -# ---- Job segment length: + +# ---- Job segments: Length +# # Specify period between output of restart files. (GEOSldas.x shuts down and restarts.) # Default is the entire simulation period (END_DATE minus BEG_DATE). # Format: yyyymmdd hhmmss # -# JOB_SGMT : 00000100 000000 +# JOB_SGMT : 00000100 000000 -# ---- Number of segments: +# ---- Job segments: Number +# # One lenkf.j job simulates NUM_SGMT*JOB_SGMT time, then re-submits itself, # so (NUM_SGMT*JOB_SGMT) should be done within the 12 hour CPU time limit (at NCCS). # Low values for NUM_SGMT are recommended for run-time and storage efficiency. # Default is 1. # -# NUM_SGMT : 1 +# NUM_SGMT : 1 + -# ---- User defined Path and filename of output (HISTORY) specification file: -# If it is empty, ldas_setup will generate default HISTORY.rc. +# ---- Output: Write log file (YES/NO)? # -# HISTRC_FILE : '' +LDAS_logit : YES + +# ---- Output: HISTORY definition of model diagnostics +# +# User-defined path and filename of output (HISTORY) specification file. +# If empty, ldas_setup will generate a default HISTORY.rc file. +# +# HISTRC_FILE : '' # ---- Write only monthly output? +# # Monthly files can be created from daily files. -# To have accurate monthly averages, the ref_time in HISTORY.rc should be 000000 +# Accurate monthly averages require setting "ref_time" in HISTORY.rc to "000000" # # 0 : Output bundled into daily files per HISTORY specifications (default). # 1 : Monthly files will be created. Daily files will *not* be deleted. # 2 : Monthly files will be created and daily files will be deleted automatically. # -# MONTHLY_OUTPUT : 0 +# MONTHLY_OUTPUT : 0 -# ---- Specify how to interpolate the forcing (Default is 1): -# 1 : bilinear interpolation -# 0 : nearest neighbor -# -MET_HINTERP : 1 -# ---- Specify if running model or assimilation: -# NO : model only (DEFAULT; with --runmodel option) -# YES : assimilation (without --runmodel option) +# ---- Name of file containing Surface GridComp resource parameters # -LAND_ASSIM : NO +SURFRC: LDAS.rc -# ---- Choose land model version -# Icarus : Current DEFAULT for the Icarus AGCM (Scientifically close to MERRA-2) -# V24_C05 : DEFAULT for GEOSldas_m4-17_0 -# NRv7.2 : Current DEFAULT beginning with GEOSldas_m4-17_6 -# -LAND_PARAMS : NRv7.2 - -# ---- File name for mwRTM parameter file (nc4 format) used in assimilation runs. -# This file can be converted from binary with the program mwrtm_bin2nc4.x. -# If empty or commented out, GEOSldas will search the restart directory. -# -# MWRTM_FILE : '' #--------------------------------------------------------# -# CatchCN Model specific parameters # +# Do not change the following parameters in GEOSldas # #--------------------------------------------------------# -# ---- Time step for carbon/nitrogen routines in CatchmentCN model (default 5400): -# (Time step for water/energy routines is controlled by HEARTBEAT_DT in CAP.rc) -# -# DTCN : 5400 - -# ---- Atmospheric CO2 -# Note that by default NOAA CT CO2 is scaled to the EEA global average -# CO2 linearly interpolated to the METFORCE year. -# For offline simulations : the default holds but with an optional -# parameter CO2_YEAR, which permits user to set the beginning year of the -# atmospheric CO2 concentration of the simulation if it's earlier than the METFORCE year. -# -# 0 : use a fix value as defined by CO2 (default=350.e-6) (Default) -# 1 : NOAA CT tracker monthly mean diurnal cycle -# 2 : NOAA CT tracker monthly mean diurnal cycle scaled to match EEA global average CO2 -# 3 : CMIP5 recommended annual average global mean concentrations from getco2.F90 (1765-2150) -# ATM_CO2: 2 - -# ---- Prescribe daily LAI and SAI data from an archived CATCHCN simulation -# 0 : NO Run CN Model interactively (Default) -# 1 : YES Prescribe interannually varying LAI and SAI -# 2 : YES Prescribe climatological LAI and SAI -# 3 : Estimated LAI/SAI using anomalies at the beginning of the foeecast and climatological LAI/SAI -# 4 : Write LAI/SAI anomalies in catchcn_internal_rst for above option 3 -# PRESCRIBE_DVG: 0 - -# ---- Scale CATCHCN ALBEDO and FPAR -# 0 : NO (Default) -# 1 : Scale albedo to match interannually varying MODIS NIRDF and VISDF anomaly -# 2 : Scale albedo to match interannually varying MODIS NIRDF and VISDF plus FPAR to match MODIS FPAR CDF -# SCALE_ALBFPAR: 0 +# ---- No dycore for offline +# +DYCORE : none + +# ---- Only one surface level +# +LM : 1 + +# ---- For MAPL_RestartOptional +# +MAPL_ENABLE_BOOTSTRAP : YES diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index d80eeeb0..d543a8e2 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -554,7 +554,12 @@ class LDASsetup: line = line.strip() # blank line if not line: - continue + continue + if '"GEOSldas=>"' in line: + continue + # get "GEOSldas=>" defalut in GEOS_LandGrid.rc + if 'GEOSldas=>' in line: + line = line.split('GEOSldas=>')[1] # handle comments position = line.find('#') if position==0: # comment line @@ -569,7 +574,9 @@ class LDASsetup: key = key.strip() val = val.strip() if not key or not val: - raise Exception(errstr % (linenum, inpfile)) + print "WARNING: " + errstr % (linenum, inpfile) + continue + #raise Exception(errstr % (linenum, inpfile)) if key in inpdict: raise Exception('Duplicate key [%s] in [%s]' % (key, inpfile)) inpdict[key] = val.strip() @@ -806,7 +813,7 @@ class LDASsetup: if os.path.isfile(landassim_seeds) and self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' : _seeds = self.rstdir + _ensdir + '/' + y4m2+'/' + exp_id + '.landassim_obspertrseed_rst.'+y4m2d2_h2m2 shutil.copy(landassim_seeds, _seeds) - os.symlink(_seeds, myRstDir+ '/landassim_obspertrseed'+ensid +'_rst') + os.symlink(_seeds, myRstDir+ '/landassim_obspertrseed'+ _ensid +'_rst') self.has_landassim_seed = True cmd= ' '.join(['./process_rst.csh', sponsorid, exp_id, exp_dir, @@ -1083,13 +1090,18 @@ class LDASsetup: print line.rstrip().replace('END_DATE:',self.endDates[-1].strftime('END_DATE: %Y%m%d %H%M%S')) if shortfile == 'LDAS.rc' : - default_ldasrcInp = self._parseInputFile(rcfile) ldasrcInp = OrderedDict() - # default + # land default + default_surfrcInp = self._parseInputFile(etcdir+'/GEOS_SurfaceGridComp.rc') + for key,val in default_surfrcInp.iteritems() : + ldasrcInp[key] = val + + # ldas default, may overiwrite land default + default_ldasrcInp = self._parseInputFile(rcfile) for key,val in default_ldasrcInp.iteritems() : ldasrcInp[key] = val - # overide by the exeinp + # exeinp, may overwrite ldas default for key,val in self.rqdExeInp.iteritems(): if key not in self.NoneLDASrcKeys: ldasrcInp[key]= val @@ -1527,6 +1539,22 @@ def _printExeInputKeys(rqdExeInpKeys): _f.close() print print + + _fn = '../etc/GEOS_SurfaceGridComp.rc' # run ldas_setup from /bin directory + + _f = open(_fn) + for line in _f: + if '"GEOSldas=>"' in line: + sys.stdout.write(line) + elif 'GEOSldas=>' in line: + line0 = line.split("GEOSldas=>")[1] + sys.stdout.write(line0) + elif not line.strip() or line.strip().startswith('#'): + sys.stdout.write(line) + sys.stdout.flush() + _f.close() + print + print def _printRmInputKeys(rqdRmInpKeys, optRmInpKeys): """ diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index 73dc1b1a..643cf842 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -335,12 +335,12 @@ while ( $counter <= ${NUM_SGMT} ) else set binfile = `echo $ofile | rev | cut -d'.' -f2- | rev` set decr_file = `echo $ofile | rev | cut -d'.' -f3- | rev`.ctl - $GEOSBIN/tile_bin2nc4.x $binfile $decr_file $TILECOORD - /bin/mv ${binfile}.nc4 $THISDIR/. - /bin/rm ${binfile}.bin + ($GEOSBIN/tile_bin2nc4.x $binfile $decr_file $TILECOORD ; \ + /bin/mv ${binfile}.nc4 $THISDIR/. ; \ + /bin/rm ${binfile}.bin) & endif end - + wait ####################################################################### # Create HISTORY Collection Directories ####################################################################### @@ -439,22 +439,28 @@ while ( $counter <= ${NUM_SGMT} ) set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" - - cat << EOF > timestamp.cdl - netcdf timestamp { - dimensions: - time = UNLIMITED ; // (NT currently) - string_length = 14 ; - variables: - char time_stamp (time, string_length) ; - - data: - - time_stamp = - DATAVALUES; - } - EOF - + +# ---------------------------------------------------------------------------- +# +# WARNING: The following block MUST begin in column 1!!! Do NOT indent!!! + +cat << EOF > timestamp.cdl +netcdf timestamp { +dimensions: +time = UNLIMITED ; // (NT currently) +string_length = 14 ; +variables: +char time_stamp (time, string_length) ; + +data: + +time_stamp = +DATAVALUES; +} +EOF + +# ---------------------------------------------------------------------------- + sed -i -e "s/NT/$LEN_SUB/g" timestamp.cdl sed -i -e "s/DATAVALUES/$tstep2/g" timestamp.cdl ncgen -k4 -o timestamp.nc4 timestamp.cdl @@ -544,7 +550,7 @@ while ( $counter <= ${NUM_SGMT} ) set old_rst = `/usr/bin/readlink -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst` /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst /bin/ln -s $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst - /usr/bin/gzip $old_rst + /usr/bin/gzip $old_rst & endif set rstf = 'landassim_obspertrseed' @@ -557,9 +563,9 @@ while ( $counter <= ${NUM_SGMT} ) # move intermediate check point files to output/$EXPDOMAIN/rs/$ENSDIR/Yyyyy/Mmm/ directories # ------------------------------------------------------------------------------------------- - set rstfiles1 = `ls ${MODEL}${ENSID}_internal_checkpoint*` - set rstfiles2 = `ls landpert${ENSID}_internal_checkpoint*` - set rstfiles3 = `ls landassim_obspertrseed${ENSID}_checkpoint*` + set rstfiles1 = `ls ${MODEL}${ENSID}_internal_checkpoint.*` + set rstfiles2 = `ls landpert${ENSID}_internal_checkpoint.*` + set rstfiles3 = `ls landassim_obspertrseed${ENSID}_checkpoint.*` set NFILES = `echo $#rstfiles1` if($NFILES > 0) then @@ -570,6 +576,7 @@ while ( $counter <= ${NUM_SGMT} ) set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ if (! -e $THISDIR ) mkdir -p $THISDIR /bin/mv $rfile ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 + /usr/bin/gzip ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 & end endif @@ -581,9 +588,9 @@ while ( $counter <= ${NUM_SGMT} ) set TM = `echo $ThisTime | cut -c5-6` set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ if (! -e $THISDIR ) mkdir -p $THISDIR - ncks -4 -O -C -x -v lat,lon $rfile ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4 - /usr/bin/gzip ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4 - /bin/rm -f $rfile + (ncks -4 -O -C -x -v lat,lon $rfile ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4;\ + /usr/bin/gzip ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4; \ + /bin/rm -f $rfile) & end endif @@ -601,7 +608,7 @@ while ( $counter <= ${NUM_SGMT} ) @ inens ++ end ## end of while ($inens < $NENS) - + wait ##################### # update cap_restart # ################## diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index 063ca9cd..ac95e4da 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -162,13 +162,22 @@ case [1]: #echo 'setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0' >> this.file echo 'setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib' >> this.file + set mpi_mpmd = "${INSTDIR}/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k 0000 -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE}" + set j = 1 + while ($j < $NUMENS) + set ENS = `printf '%04d' $j` + set mpi_mpmd = "${mpi_mpmd} : -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k ${ENS} -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE}" + @ j++ + end + echo $mpi_mpmd >> this.file + set j = 0 while ($j < $NUMENS) set ENS = `printf '%04d' $j` - echo $INSTDIR/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k ${ENS} -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE} >> this.file - echo ncks -4 -O -h -x -v IRRIGFRAC,PADDYFRAC,LAIMIN,LAIMAX,CLMPT,CLMST,CLMPF,CLMSF ${MODEL}${ENS}_internal_rst.${YYYYMMDD} ${MODEL}${ENS}_internal_rst.${YYYYMMDD} >> this.file + echo "ncks -4 -O -h -x -v IRRIGFRAC,PADDYFRAC,LAIMIN,LAIMAX,CLMPT,CLMST,CLMPF,CLMSF ${MODEL}${ENS}_internal_rst.${YYYYMMDD} ${MODEL}${ENS}_internal_rst.${YYYYMMDD} &" >> this.file @ j++ end + echo 'wait' >> this.file chmod +x this.file ./this.file diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index c5e10a33..3a7e1465 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -3991,6 +3991,7 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & ! reichle, 9 Jul 2018: added FP transition from f517 to f521 ! reichle, 10 Oct 2019: added FP transition from f521 to f522 ! reichle, 17 Jan 2020: added FP transition from f522 to f525 + ! reichle, 3 Apr 2020: added FP transition from f525 to f525_p5 ! ! --------------------------------------------------------------------------- @@ -4031,6 +4032,7 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & type(date_time_type) :: dt_end_f521_fp type(date_time_type) :: dt_end_f522_fp type(date_time_type) :: dt_end_f525_fp + type(date_time_type) :: dt_end_f525_p5_fp character(len=*), parameter :: Iam = 'parse_G5DAS_met_tag' character(len=400) :: err_msg @@ -4068,12 +4070,12 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & dt_end_d591_rpit3%min = 0 dt_end_d591_rpit3%sec = 0 - dt_end_d591_fpit%year = 9999 - dt_end_d591_fpit%month = 1 - dt_end_d591_fpit%day = 1 - dt_end_d591_fpit%hour = 0 - dt_end_d591_fpit%min = 0 - dt_end_d591_fpit%sec = 0 + dt_end_d591_fpit%year = 9999 + dt_end_d591_fpit%month = 1 + dt_end_d591_fpit%day = 1 + dt_end_d591_fpit%hour = 0 + dt_end_d591_fpit%min = 0 + dt_end_d591_fpit%sec = 0 ! | stream start | stream end (as of 28 Dec 2016) ! ---------------------------------------- @@ -4118,18 +4120,20 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & ! f517_fp | 1 Nov 2017 | 11 Jul 2018 ! f521_fp | 11 Jul 2018 | 13 Mar 2019 ! f522_fp | 13 Mar 2019 | 30 Jan 2020 - ! f525_fp | 30 Jan 2020 | (present) + ! f525_fp | 30 Jan 2020 | 7 Apr 2020 + ! f525_p5_fp | 7 Apr 2020 | (present) ! ! Official stream transition times (as defined ! by GMAO ops group) are: ! - ! FP e5110 --> e5130 : 20 Aug 2014, 6z ADAS analysis - ! FP e5130 --> e5131 : 1 May 2015, 6z ADAS analysis - ! FP e5131 --> f516 : 24 Jan 2017, 6z ADAS analysis - ! FP f516 --> f517 : 1 Nov 2017, 6z ADAS analysis - ! FP f517 --> f521 : 11 Jul 2018, 6z ADAS analysis - ! FP f521 --> f522 : 13 Mar 2019, 6z ADAS analysis - ! FP f522 --> f525 : 30 Jan 2020, 6z ADAS analysis + ! FP e5110 --> e5130 : 20 Aug 2014, 6z ADAS analysis + ! FP e5130 --> e5131 : 1 May 2015, 6z ADAS analysis + ! FP e5131 --> f516 : 24 Jan 2017, 6z ADAS analysis + ! FP f516 --> f517 : 1 Nov 2017, 6z ADAS analysis + ! FP f517 --> f521 : 11 Jul 2018, 6z ADAS analysis + ! FP f521 --> f522 : 13 Mar 2019, 6z ADAS analysis + ! FP f522 --> f525 : 30 Jan 2020, 6z ADAS analysis + ! FP f525 --> f525_p5 : 7 Apr 2020, 6z ADAS analysis ! ! Official stream transition times refer to the definition ! of the official FP files with generic file names on the @@ -4199,13 +4203,20 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & dt_end_f522_fp%min = 0 dt_end_f522_fp%sec = 0 - dt_end_f525_fp%year = 9999 - dt_end_f525_fp%month = 1 - dt_end_f525_fp%day = 1 - dt_end_f525_fp%hour = 0 + dt_end_f525_fp%year = 2020 + dt_end_f525_fp%month = 4 + dt_end_f525_fp%day = 7 + dt_end_f525_fp%hour = 3 dt_end_f525_fp%min = 0 dt_end_f525_fp%sec = 0 + dt_end_f525_p5_fp%year = 9999 + dt_end_f525_p5_fp%month= 1 + dt_end_f525_p5_fp%day = 1 + dt_end_f525_p5_fp%hour = 0 + dt_end_f525_p5_fp%min = 0 + dt_end_f525_p5_fp%sec = 0 + ! ---------------------------------------------------- ! initialize @@ -4340,22 +4351,28 @@ subroutine parse_G5DAS_met_tag( met_path_in, met_tag_in, date_time, & stream = 'f517_fp' ! use GEOS-5.17.x output - elseif (datetime_le_refdatetime( date_time, dt_end_f521_fp )) then + elseif (datetime_le_refdatetime( date_time, dt_end_f521_fp )) then ! Note "less-than-or-equal" (_le_) above stream = 'f521_fp' ! use GEOS-5.21.x output - elseif (datetime_le_refdatetime( date_time, dt_end_f522_fp )) then + elseif (datetime_le_refdatetime( date_time, dt_end_f522_fp )) then ! Note "less-than-or-equal" (_le_) above stream = 'f522_fp' ! use GEOS-5.22.x output - else + elseif (datetime_le_refdatetime( date_time, dt_end_f525_fp )) then + + ! Note "less-than-or-equal" (_le_) above stream = 'f525_fp' ! use GEOS-5.25.x output + else + + stream = 'f525_p5_fp' ! use GEOS-5.25_p5.x output + end if else From f424f435359ef26ee374abe2fe7929584e036411 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 15 Apr 2020 10:46:57 -0400 Subject: [PATCH 08/42] Merging master into BRIDGE_FROM_DEVELOP_TO_MASTER From 4e8d4cf12912df69c52cc45f06ca3134c8e6e9b4 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 23 Apr 2020 09:05:54 -0400 Subject: [PATCH 09/42] Syncing develop into BRIDGE_FROM_DEVELOP_TO_MASTER (#188) * fix gnu debug (#178) * checkpoint files are geneareted by GEOSldas (#182) * checkpoint files are generated by GEOSldas ( not MAPL) when on cubed-sphere tile space * create year/month directories for ldas_ObsFcstAna from within GEOSldas executable * change system() calls to Fortran2008 standard Execute_command_line() * subdaily2daily concatenation; SLES12 sbatch fix - Added sbatch submission for pre-processing of restarts to comply with SLES12 requirements. - Subdaily-to-daily nc4 file concatenation now processes before the month is complete. * pass in optional account through ldas_setup (#184) * updating to MAPL 2.1.1 (updated ESMA_env and cmake) * Resurrecting SMAP L1C Tb fore-minus-aft check --- Externals.cfg | 6 +- src/Applications/LDAS_App/ldas_setup | 11 ++- src/Applications/LDAS_App/lenkf.j.template | 85 ++++++++++--------- src/Applications/LDAS_App/process_rst.csh | 16 ++-- .../GEOSens_GridComp/GEOS_EnsGridComp.F90 | 4 +- .../clsm_ensupd_enkf_update.F90 | 5 +- .../clsm_ensupd_read_obs.F90 | 69 ++++++++++++--- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 9 +- .../GEOSmetforce_GridComp/LDAS_HashTable.F90 | 46 ++++++---- .../Shared/LDAS_TileCoordRoutines.F90 | 2 +- 10 files changed, 166 insertions(+), 87 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index ccfac927..b397822a 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -2,14 +2,14 @@ required = True repo_url = git@github.com:GEOS-ESM/ESMA_env.git local_path = ./@env -tag = v2.0.2 +tag = v2.1.1 protocol = git [ESMA_cmake] required = True repo_url = git@github.com:GEOS-ESM/ESMA_cmake.git local_path = ./@cmake -tag = v2.1.2 +tag = v3.0.1 externals = Externals.cfg protocol = git @@ -25,7 +25,7 @@ sparse = ../../../config/GMAO_Shared.sparse required = True repo_url = git@github.com:GEOS-ESM/MAPL.git local_path = ./src/Shared/@MAPL -tag = v2.0.1 +tag = v2.1.1 protocol = git [GEOSgcm_GridComp] diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index d543a8e2..9e8b5a5b 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -389,6 +389,8 @@ class LDASsetup: assert self.rqdRmInp['rm_name'].upper() == 'SLURM' ## account and walltime should exist assert self.rqdRmInp['account'] + if cmdLineArgs['account'] != 'None': + self.rqdRmInp['account'] = cmdLineArgs['account'] assert self.rqdRmInp['walltime'] ## ntasks is a +ve integer _ntasks = int(self.rqdRmInp['ntasks']) @@ -1180,7 +1182,9 @@ class LDASsetup: valn = self.catch+ensid+'_internal_checkpoint' ldasrcInp[keyn]= valn - if((self.has_ldassa_pert or self.has_geos_pert) and _perturb == 1): + # for lat/lon and EASE tile space, specify LANDPERT checkpoint file here (via MAPL); + # for cube-sphere tile space, Landpert GC will set up LANDPERT checkpoint file + if('-CF' not in self.rqdExeInp['GRIDNAME'] and _perturb == 1): keyn = 'LANDPERT_INTERNAL_CHECKPOINT_FILE' valn = 'landpert'+ensid+'_internal_checkpoint' ldasrcInp[keyn]= valn @@ -1643,6 +1647,11 @@ def parseCmdLine(): help='model run (no assimilation)', action='store_true', ) + p_setup.add_argument( + '--account', + help='replace the account in batinpfile)', + type=str, default='None' + ) #p_setup.add_argument( # '--ForceReuseDir', # help='force re-use existing exp dir', diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index 643cf842..1a2ce3cb 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -395,55 +395,23 @@ while ( $counter <= ${NUM_SGMT} ) # if monthly exists, move on to the next collection if (-f $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4) continue - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` - set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" - set LEN = `echo $#time_steps` - # no file? move on - if ($LEN == 0) continue - - set dayl = `echo $time_steps[$LEN] | cut -c1-8` - set day1 = `echo $time_steps[1] | cut -c1-8` - @ NAVAIL = ($dayl - $day1) + 1 - - # not enough days? move on to the next collection - if($NAVAIL != $NDAYS) continue - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` - set LEN_SUB = `echo $#time_steps` - @ LEN_AVAIL = $LEN_SUB * $NDAYS - - # not enough sub-daylies? move on to the next collection - if ($LEN != $LEN_AVAIL) continue - - # create the monly average - #ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 - #ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 - - #/bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 - ncra -h $EXPID.$ThisCol.${YYYY}${MM}??_*z.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 - - # don't want a daily? delete the daily and sub-dailies and continue - # - if($NODAILIES == 2) then - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* - continue - endif - + # create daily and remove the sub-daily # ------------------------------------------------------------------ set day=1 while ($day <= $NDAYS && $LEN_SUB > 1) if ( $day < 10 ) set DD=0${day} if ( $day >= 10 ) set DD=${day} - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` + @ day++ + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | rev` + set LEN_SUB = `echo $#time_steps` + if ($LEN_SUB <= 1) continue set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" # ---------------------------------------------------------------------------- # # WARNING: The following block MUST begin in column 1!!! Do NOT indent!!! - + cat << EOF > timestamp.cdl netcdf timestamp { dimensions: @@ -458,9 +426,7 @@ time_stamp = DATAVALUES; } EOF - -# ---------------------------------------------------------------------------- - + sed -i -e "s/NT/$LEN_SUB/g" timestamp.cdl sed -i -e "s/DATAVALUES/$tstep2/g" timestamp.cdl ncgen -k4 -o timestamp.nc4 timestamp.cdl @@ -469,8 +435,43 @@ EOF /bin/rm timestamp.cdl /bin/rm timestamp.nc4 /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 - @ day++ + end # concatenate for each day + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | rev` + set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" + set LEN = `echo $#time_steps` + # no file? move on + if ($LEN == 0) continue + + set dayl = `echo $time_steps[$LEN] | cut -c1-8` + set day1 = `echo $time_steps[1] | cut -c1-8` + @ NAVAIL = ($dayl - $day1) + 1 + + # not enough days? move on to the next collection + if($NAVAIL != $NDAYS) continue + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | rev` + set LEN_SUB = `echo $#time_steps` + @ LEN_AVAIL = $LEN_SUB * $NDAYS + + # not enough sub-daylies? move on to the next collection + if ($LEN != $LEN_AVAIL) continue + + # create the monly average + #ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 + #ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 + + #/bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 + ncra -h $EXPID.$ThisCol.${YYYY}${MM}??.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 + + # don't want a daily? delete the daily and sub-dailies and continue + # + if($NODAILIES == 2) then + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* + continue + endif + end # each collection end # each month cd $PWD diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index ac95e4da..5e59c93e 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -153,13 +153,20 @@ case [1]: cd $EXPDIR/$EXPID/mk_restarts/ echo '#\!/bin/csh -f ' > this.file + + echo "#SBATCH --account=${SPONSORID}">> this.file + echo "#SBATCH --time=1:00:00" >> this.file + echo "#SBATCH --ntasks=$NUMENS" >> this.file + echo "#SBATCH --job-name=mkRst" >> this.file + echo "#SBATCH --qos=debug" >> this.file + echo "#SBATCH --output=mkRst.o" >> this.file + echo "#SBATCH --error=mkRst.e" >> this.file echo 'source $INSTDIR/bin/g5_modules' >> this.file echo 'if ( -e /etc/os-release ) then' >> this.file echo ' module load nco/4.8.1' >> this.file echo 'else' >> this.file echo ' module load other/nco-4.6.8-gcc-5.3-sp3 ' >> this.file echo 'endif' >> this.file - #echo 'setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0' >> this.file echo 'setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib' >> this.file set mpi_mpmd = "${INSTDIR}/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k 0000 -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE}" @@ -178,11 +185,8 @@ case [1]: @ j++ end echo 'wait' >> this.file - - chmod +x this.file - ./this.file - rm -f this.file - echo DONE > done_rst_file + echo 'echo DONE > done_rst_file' >> this.file + sbatch this.file cd $PWD sleep 1 else diff --git a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 index 27932fe6..e43a9692 100644 --- a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 @@ -3549,8 +3549,8 @@ subroutine Finalize(gc, import, export, clock, rc) VERIFY_(status) Iam = trim(comp_name) // "::Finalize" - ! Get MAPL obj - call MAPL_GetObjectFromGC(gc, MAPL, rc=status) + ! Call Finalize for every child + call MAPL_GenericFinalize(gc, import, export, clock, rc=status) VERIFY_(status) ! End diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 9e46c25f..58d2543c 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -1416,7 +1416,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & integer, dimension(numprocs) :: N_obsl_vec, tmp_low_ind character(300) :: fname - + integer :: i #ifdef LDAS_MPI integer :: this_species, ind_tmp, j @@ -1559,7 +1559,10 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & dir_name=dir_name, ens_id=-1 ) + i = index(fname, '/', .true.) + if( i >0) call Execute_command_line('mkdir -p '//fname(1:i)) + open( 10, file=fname, form='unformatted', action='write') ! write header diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 index 119fcc82..d25edb88 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 @@ -524,7 +524,7 @@ subroutine read_obs_ae_l2_sm( & cmd = '/bin/rm -f ' // tmpfname - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) ! identify all files within current assimilation interval ! (list all files within hourly intervals) @@ -554,7 +554,7 @@ subroutine read_obs_ae_l2_sm( & cmd = trim(cmd) // ' >> ' // trim(tmpfname) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) call augment_date_time( 3600, date_time_tmp ) @@ -566,7 +566,7 @@ subroutine read_obs_ae_l2_sm( & cmd = 'wc -w ' // trim(tmpfname) // ' > ' // trim(tmpfname2) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) open(10, file=tmpfname2, form='formatted', action='read') @@ -1037,7 +1037,7 @@ subroutine read_obs_ae_sm_LPRM( & cmd = '/bin/rm -f ' // tmpfname - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) ! identify all files within current assimilation interval ! (list all files within hourly intervals) @@ -1070,7 +1070,7 @@ subroutine read_obs_ae_sm_LPRM( & cmd = trim(cmd) // ' >> ' // trim(tmpfname) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) call augment_date_time( 3600, date_time_tmp ) @@ -1082,7 +1082,7 @@ subroutine read_obs_ae_sm_LPRM( & cmd = 'wc -w ' // trim(tmpfname) // ' > ' // trim(tmpfname2) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) open(10, file=tmpfname2, form='formatted', action='read') @@ -1348,7 +1348,7 @@ subroutine read_obs_sm_ASCAT( & cmd = '/bin/rm -f ' // tmpfname - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) ! identify all files within current assimilation interval ! (list all files within hourly intervals) @@ -1379,7 +1379,7 @@ subroutine read_obs_sm_ASCAT( & cmd = trim(cmd) // ' >> ' // trim(tmpfname) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) call augment_date_time( 3600, date_time_tmp ) @@ -1392,7 +1392,7 @@ subroutine read_obs_sm_ASCAT( & cmd = 'wc -w ' // trim(tmpfname) // ' > ' // trim(tmpfname2) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) open(10, file=tmpfname2, form='formatted', action='read') @@ -5282,6 +5282,9 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & ! reichle, 23 Jan 2018: removed stats check for L1C fore-minus-aft Tb differences; ! use avg fore/aft timestamp so that fore and aft Tbs for same ! location are never used in different assimilation windows + ! reichle, 22 Apr 2020: resurrected check for L1C fore-minus-aft Tb differences + ! after antenna-scan-angle (ASA) issues continued and the + ! SMAP Project declined to address these issues in L1 ops implicit none @@ -5338,6 +5341,8 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & real, parameter :: Tb_min = 100.0 ! min allowed Tb real, parameter :: Tb_max = 320.0 ! max allowed Tb + real, parameter :: max_std_tb_fore_minus_aft = 20. ! max std-dev L1C[E] fore-minus-aft Tb diffs + integer, parameter :: L1CE_spacing = 3 ! thinning of L1C_TB_E in units of 9-km indices ("3" => 27 km) ! temporarily shift lat/lon of obs for computation of nearest tile to @@ -5369,7 +5374,7 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & type(date_time_type) :: date_time_low, date_time_upp type(date_time_type) :: date_time_low_fname, date_time_tmp - integer :: ii, jj, kk, nn + integer :: ii, jj, kk, nn, mm integer :: N_fnames, N_fnames_tmp, N_obs_tmp integer :: dset_rank integer :: ind_tile, ind_start, ind_end @@ -5377,6 +5382,7 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & real :: M36_col_ind_tile, M36_row_ind_tile real :: M36_col_ind_obs, M36_row_ind_obs real :: tmpreal + real :: tmp_tb_diff, tmp_tb_diff_Sum, tmp_tb_diff_SumOfSq, tmp_var real*8 :: J2000_seconds_low, J2000_seconds_upp @@ -5957,6 +5963,13 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & if (L1C_files .or. L1CE_files) then + ! initialize stats check for fore-minus-aft Tb diffs + + mm = 0 + + tmp_tb_diff_Sum = 0. + tmp_tb_diff_SumOfSq = 0. + do nn=1,N_obs_tmp ! QC @@ -5995,6 +6008,19 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & tmp_tb_1( nn) = 0.5 *( tmp_tb_1( nn) + tmp_tb_2( nn) ) tmp_time_1(nn) = 0.5D0*( tmp_time_1(nn) + tmp_time_2(nn) ) + ! Compute stats for fore-minus-aft Tb differences. + ! Excessive diffs are found in bad L1C_TB files, which occur + ! occasionally due to bad ANT_AZ files in L1B processing. + ! Includes ALL SURFACES!!! + ! - reichle, 22 Apr 2020 (resurrected) + + mm=mm+1 + + tmp_tb_diff = tmp_tb_1(nn) - tmp_tb_2(nn) + + tmp_tb_diff_Sum = tmp_tb_diff_Sum + tmp_tb_diff + tmp_tb_diff_SumOfSq = tmp_tb_diff_SumOfSq + tmp_tb_diff**2 + elseif (keep_data_1) then tmp_tb_1( nn) = tmp_tb_1( nn) @@ -6028,6 +6054,29 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & end do + ! finalize stats check for fore-minus-aft differences (ALL SURFACES!!!) + ! - reichle, 22 Apr 2020 (resurrected) + + if (mm>1) then + + tmp_var = ( tmp_tb_diff_SumOfSq - (tmp_tb_diff_Sum**2)/real(mm) )/(real(mm-1)) + + if ( tmp_var > max_std_tb_fore_minus_aft**2 ) then + + write(err_msg, '(e12.5)') sqrt(tmp_var) + + err_msg = & + 'Ignoring ALL obs in halforbit file b/c of excessive std-dev in fore-minus-aft Tbs. ' // & + 'std-dev( tb_fore - tb_aft ) = ' // trim(err_msg) + + call ldas_warn(LDAS_GENERIC_WARNING, Iam, err_msg) + + jj = 0 ! results in N_obs_kept=0 below + + end if + + end if + else ! L2_SM_AP do nn=1,N_obs_tmp diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index 3a7e1465..2f49a98e 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -4584,8 +4584,9 @@ subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, call FileOpenedHash%get(fname_full,fid) if( fid == -9999 ) then ! not open yet - ierr=nf90_open(fname_full,IOR(NF90_NOWRITE, NF90_MPIIO), fid, & - comm = comm,info = MPI_INFO_NULL) + !ierr=nf90_open(fname_full,IOR(NF90_NOWRITE, NF90_MPIIO), fid, & + ! comm = comm,info = MPI_INFO_NULL) + ierr=nf90_open(fname_full,NF90_NOWRITE, fid) if(master_logit) then write(logunit,*) "opening file: "//trim(fname_full) @@ -4746,14 +4747,14 @@ end subroutine GEOS_openfile subroutine GEOS_closefile(fid) use netcdf implicit none - integer,intent (inout) :: fid + integer,intent (in) :: fid integer :: ierr + ierr = nf90_close(fid) if(ierr /= nf90_noerr) then print *, " error GEOS_closefile" stop 2 endif - fid = -9999 endsubroutine ! **************************************************************** diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 index 30cb69d7..67cf8604 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 @@ -3,6 +3,7 @@ MODULE LDAS_HashTable IMPLICIT NONE ! Use strong typing private INTEGER, PARAMETER :: tbl_size = 50 + integer, parameter :: keylen = 512 TYPE nodelist TYPE(nodelist), POINTER :: child => NULL() @@ -35,11 +36,16 @@ RECURSIVE SUBROUTINE put_nodeinfo(list,key,fid) CHARACTER(len=*), INTENT(in) :: key integer, INTENT(in) :: fid ! local - INTEGER :: keylen + INTEGER :: klen + + klen = LEN(key) + if ( klen > keylen) then + print*, key + stop (' key loo long') + endif - keylen = LEN(key) IF (ALLOCATED(list%key)) THEN - IF (list%key /= key) THEN + IF (trim(list%key) /= trim(key)) THEN IF ( .NOT. ASSOCIATED(list%child) ) then ALLOCATE(list%child) ENDIF @@ -60,28 +66,34 @@ RECURSIVE SUBROUTINE get_nodeinfo(list,key,fid) CHARACTER(len=*), INTENT(in) :: key integer, INTENT(out) :: fid - IF (ALLOCATED(list%key) .AND. (list%key == key)) THEN - fid = list%fid - ELSE IF(ASSOCIATED(list%child)) THEN ! keep going - CALL get_nodeinfo(list%child,key,fid) - ELSE ! At the end of the list, no key found - fid = -9999 - RETURN - END IF + if (ALLOCATED(list%key)) then + if (trim(list%key) == trim(key)) THEN + fid = list%fid + return + endif + endif + + IF(ASSOCIATED(list%child)) THEN ! keep going + CALL get_nodeinfo(list%child,key,fid) + ELSE ! At the end of the list, no key found + fid = -9999 + END IF + END SUBROUTINE get_nodeinfo RECURSIVE SUBROUTINE free_nodeinfo(list,closefile) CLASS(nodelist), INTENT(inout) :: list external :: closefile integer :: rc + IF (ASSOCIATED(list%child)) THEN CALL free_nodeinfo(list%child, closefile ) DEALLOCATE(list%child) END IF - list%child => NULL() - if (list%fid > 0) call closefile(list%fid) + IF (ALLOCATED(list%key)) then - DEALLOCATE(list%key) + call closefile(list%fid) + DEALLOCATE(list%key) ENDIF END SUBROUTINE free_nodeinfo @@ -119,10 +131,10 @@ END FUNCTION sum_string SUBROUTINE put_hash_table(tbl,key,fid) CLASS(hash_table), INTENT(inout) :: tbl - CHARACTER(len=*), INTENT(in) :: key - integer, INTENT(in) :: fid + CHARACTER(len=*), INTENT(in) :: key + integer, INTENT(in) :: fid !local - INTEGER :: hash + INTEGER :: hash hash = MOD(sum_string(key),tbl%vec_len) CALL tbl%vec(hash)%put(key,fid) diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 index 3aea7652..b82a3ccd 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 @@ -475,7 +475,7 @@ subroutine LDAS_read_land_tile( tile_file,catch_file, tile_grid_g, tile_coord_la i=index(catch_file,'/clsm/') fname = catch_file(1:i)//'topo_DYN_ave_*.data' - call system('ls '//trim(fname) // ' >topo_DYN_ave.file') + call Execute_command_line('ls '//trim(fname) // ' >topo_DYN_ave.file') open(10,file='topo_DYN_ave.file', action='read') fname= '' read(10,'(A)') fname From 26e1e7674d300080e01102e96bdaa0c9822411e9 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 23 Apr 2020 16:46:35 -0400 Subject: [PATCH 10/42] Updating Externals.cfg for the develop branch so we can merge develop into this feature branch --- Externals.cfg | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index b397822a..c35439a9 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.0 +branch = master protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,8 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.3 +branch = develop +#tag = v1.6.0 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 9c51ec2f0775fbf0b6939df561f8f469be21ea21 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 23 Apr 2020 17:02:01 -0400 Subject: [PATCH 11/42] New Externals.cfg in prep for v17.9.0-beta.4 tag --- Externals.cfg | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index c35439a9..e835c344 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = master +tag = v1.1.3 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,8 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -branch = develop -#tag = v1.6.0 +tag = v1.8.3 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 1f9f8f1847754c1737cf9baed8c3c6e217a3a59f Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 23 Apr 2020 17:12:46 -0400 Subject: [PATCH 12/42] removing white space that was inadvertently... added during resolving of conflict --- src/Applications/LDAS_App/process_rst.csh | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index 2b9e96f8..5e59c93e 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -171,7 +171,6 @@ case [1]: set mpi_mpmd = "${INSTDIR}/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k 0000 -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE}" set j = 1 - while ($j < $NUMENS) set ENS = `printf '%04d' $j` set mpi_mpmd = "${mpi_mpmd} : -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k ${ENS} -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE}" From 7031d52999abdf320815d308d0826b511504e576 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 23 Apr 2020 17:20:40 -0400 Subject: [PATCH 13/42] Merging Bridge_from_develop_to_master into master MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Science: * Resurrected SMAP L1C Tb fore-minus-aft check. Infrastructure: * Updated utilities to MAPL v2.1.1, ESMA_env v2.1.1., ESMA_cmake v3.0.1 * Parallel post-processing * “sbatch” submission for pre-processing of restarts to comply with SLES12 requirements. * Subdaily-to-daily concatenation processes before month is complete. * Temporary solution to create directories for ObsFcstAna files to enable extending an existing GEOSldas run without going through setup. Documentation: * Updated README.md Bug fixes: * “obspertrseed” restart file name when restarting from existing run * Subdaily-to-daily nc4 concatenation (indent error) * Fixes for GNU compiler in debug mode * Fixed “landpert” checkpoint output when on cube-sphere tiles --- Externals.cfg | 8 +- src/Applications/LDAS_App/ldas_setup | 11 ++- src/Applications/LDAS_App/lenkf.j.template | 85 ++++++++++--------- src/Applications/LDAS_App/process_rst.csh | 16 ++-- .../GEOSens_GridComp/GEOS_EnsGridComp.F90 | 4 +- .../clsm_ensupd_enkf_update.F90 | 5 +- .../clsm_ensupd_read_obs.F90 | 69 ++++++++++++--- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 9 +- .../GEOSmetforce_GridComp/LDAS_HashTable.F90 | 46 ++++++---- .../Shared/LDAS_TileCoordRoutines.F90 | 2 +- 10 files changed, 167 insertions(+), 88 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index ccfac927..e835c344 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -2,14 +2,14 @@ required = True repo_url = git@github.com:GEOS-ESM/ESMA_env.git local_path = ./@env -tag = v2.0.2 +tag = v2.1.1 protocol = git [ESMA_cmake] required = True repo_url = git@github.com:GEOS-ESM/ESMA_cmake.git local_path = ./@cmake -tag = v2.1.2 +tag = v3.0.1 externals = Externals.cfg protocol = git @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.0 +tag = v1.1.3 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -25,7 +25,7 @@ sparse = ../../../config/GMAO_Shared.sparse required = True repo_url = git@github.com:GEOS-ESM/MAPL.git local_path = ./src/Shared/@MAPL -tag = v2.0.1 +tag = v2.1.1 protocol = git [GEOSgcm_GridComp] diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index d543a8e2..9e8b5a5b 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -389,6 +389,8 @@ class LDASsetup: assert self.rqdRmInp['rm_name'].upper() == 'SLURM' ## account and walltime should exist assert self.rqdRmInp['account'] + if cmdLineArgs['account'] != 'None': + self.rqdRmInp['account'] = cmdLineArgs['account'] assert self.rqdRmInp['walltime'] ## ntasks is a +ve integer _ntasks = int(self.rqdRmInp['ntasks']) @@ -1180,7 +1182,9 @@ class LDASsetup: valn = self.catch+ensid+'_internal_checkpoint' ldasrcInp[keyn]= valn - if((self.has_ldassa_pert or self.has_geos_pert) and _perturb == 1): + # for lat/lon and EASE tile space, specify LANDPERT checkpoint file here (via MAPL); + # for cube-sphere tile space, Landpert GC will set up LANDPERT checkpoint file + if('-CF' not in self.rqdExeInp['GRIDNAME'] and _perturb == 1): keyn = 'LANDPERT_INTERNAL_CHECKPOINT_FILE' valn = 'landpert'+ensid+'_internal_checkpoint' ldasrcInp[keyn]= valn @@ -1643,6 +1647,11 @@ def parseCmdLine(): help='model run (no assimilation)', action='store_true', ) + p_setup.add_argument( + '--account', + help='replace the account in batinpfile)', + type=str, default='None' + ) #p_setup.add_argument( # '--ForceReuseDir', # help='force re-use existing exp dir', diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index 643cf842..1a2ce3cb 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -395,55 +395,23 @@ while ( $counter <= ${NUM_SGMT} ) # if monthly exists, move on to the next collection if (-f $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4) continue - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` - set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" - set LEN = `echo $#time_steps` - # no file? move on - if ($LEN == 0) continue - - set dayl = `echo $time_steps[$LEN] | cut -c1-8` - set day1 = `echo $time_steps[1] | cut -c1-8` - @ NAVAIL = ($dayl - $day1) + 1 - - # not enough days? move on to the next collection - if($NAVAIL != $NDAYS) continue - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` - set LEN_SUB = `echo $#time_steps` - @ LEN_AVAIL = $LEN_SUB * $NDAYS - - # not enough sub-daylies? move on to the next collection - if ($LEN != $LEN_AVAIL) continue - - # create the monly average - #ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 - #ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 - - #/bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 - ncra -h $EXPID.$ThisCol.${YYYY}${MM}??_*z.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 - - # don't want a daily? delete the daily and sub-dailies and continue - # - if($NODAILIES == 2) then - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* - continue - endif - + # create daily and remove the sub-daily # ------------------------------------------------------------------ set day=1 while ($day <= $NDAYS && $LEN_SUB > 1) if ( $day < 10 ) set DD=0${day} if ( $day >= 10 ) set DD=${day} - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | cut -d'.' -f1 | rev` + @ day++ + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | rev` + set LEN_SUB = `echo $#time_steps` + if ($LEN_SUB <= 1) continue set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" # ---------------------------------------------------------------------------- # # WARNING: The following block MUST begin in column 1!!! Do NOT indent!!! - + cat << EOF > timestamp.cdl netcdf timestamp { dimensions: @@ -458,9 +426,7 @@ time_stamp = DATAVALUES; } EOF - -# ---------------------------------------------------------------------------- - + sed -i -e "s/NT/$LEN_SUB/g" timestamp.cdl sed -i -e "s/DATAVALUES/$tstep2/g" timestamp.cdl ncgen -k4 -o timestamp.nc4 timestamp.cdl @@ -469,8 +435,43 @@ EOF /bin/rm timestamp.cdl /bin/rm timestamp.nc4 /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 - @ day++ + end # concatenate for each day + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | rev` + set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" + set LEN = `echo $#time_steps` + # no file? move on + if ($LEN == 0) continue + + set dayl = `echo $time_steps[$LEN] | cut -c1-8` + set day1 = `echo $time_steps[1] | cut -c1-8` + @ NAVAIL = ($dayl - $day1) + 1 + + # not enough days? move on to the next collection + if($NAVAIL != $NDAYS) continue + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | rev` + set LEN_SUB = `echo $#time_steps` + @ LEN_AVAIL = $LEN_SUB * $NDAYS + + # not enough sub-daylies? move on to the next collection + if ($LEN != $LEN_AVAIL) continue + + # create the monly average + #ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 + #ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 + + #/bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 + ncra -h $EXPID.$ThisCol.${YYYY}${MM}??.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 + + # don't want a daily? delete the daily and sub-dailies and continue + # + if($NODAILIES == 2) then + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* + continue + endif + end # each collection end # each month cd $PWD diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index ac95e4da..5e59c93e 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -153,13 +153,20 @@ case [1]: cd $EXPDIR/$EXPID/mk_restarts/ echo '#\!/bin/csh -f ' > this.file + + echo "#SBATCH --account=${SPONSORID}">> this.file + echo "#SBATCH --time=1:00:00" >> this.file + echo "#SBATCH --ntasks=$NUMENS" >> this.file + echo "#SBATCH --job-name=mkRst" >> this.file + echo "#SBATCH --qos=debug" >> this.file + echo "#SBATCH --output=mkRst.o" >> this.file + echo "#SBATCH --error=mkRst.e" >> this.file echo 'source $INSTDIR/bin/g5_modules' >> this.file echo 'if ( -e /etc/os-release ) then' >> this.file echo ' module load nco/4.8.1' >> this.file echo 'else' >> this.file echo ' module load other/nco-4.6.8-gcc-5.3-sp3 ' >> this.file echo 'endif' >> this.file - #echo 'setenv OMPI_MCA_shmem_mmap_enable_nfs_warning 0' >> this.file echo 'setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${BASEDIR}/Linux/lib' >> this.file set mpi_mpmd = "${INSTDIR}/bin/esma_mpirun -np 1 bin/mk_GEOSldasRestarts.x -b ${BCSDIR} -d ${YYYYMMDD} -e ${RESTART_ID} -k 0000 -l ${RESTART_short} -m ${MODEL} -s ${SURFLAY} -r Y -t ${TILFILE}" @@ -178,11 +185,8 @@ case [1]: @ j++ end echo 'wait' >> this.file - - chmod +x this.file - ./this.file - rm -f this.file - echo DONE > done_rst_file + echo 'echo DONE > done_rst_file' >> this.file + sbatch this.file cd $PWD sleep 1 else diff --git a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 index 27932fe6..e43a9692 100644 --- a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 @@ -3549,8 +3549,8 @@ subroutine Finalize(gc, import, export, clock, rc) VERIFY_(status) Iam = trim(comp_name) // "::Finalize" - ! Get MAPL obj - call MAPL_GetObjectFromGC(gc, MAPL, rc=status) + ! Call Finalize for every child + call MAPL_GenericFinalize(gc, import, export, clock, rc=status) VERIFY_(status) ! End diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 9e46c25f..3072ab05 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -1416,7 +1416,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & integer, dimension(numprocs) :: N_obsl_vec, tmp_low_ind character(300) :: fname - + integer :: i #ifdef LDAS_MPI integer :: this_species, ind_tmp, j @@ -1559,7 +1559,10 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & dir_name=dir_name, ens_id=-1 ) + i = index(fname, '/', .true.) + if( i >0) call Execute_command_line('/bin/mkdir -p '//fname(1:i)) + open( 10, file=fname, form='unformatted', action='write') ! write header diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 index 119fcc82..d25edb88 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 @@ -524,7 +524,7 @@ subroutine read_obs_ae_l2_sm( & cmd = '/bin/rm -f ' // tmpfname - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) ! identify all files within current assimilation interval ! (list all files within hourly intervals) @@ -554,7 +554,7 @@ subroutine read_obs_ae_l2_sm( & cmd = trim(cmd) // ' >> ' // trim(tmpfname) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) call augment_date_time( 3600, date_time_tmp ) @@ -566,7 +566,7 @@ subroutine read_obs_ae_l2_sm( & cmd = 'wc -w ' // trim(tmpfname) // ' > ' // trim(tmpfname2) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) open(10, file=tmpfname2, form='formatted', action='read') @@ -1037,7 +1037,7 @@ subroutine read_obs_ae_sm_LPRM( & cmd = '/bin/rm -f ' // tmpfname - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) ! identify all files within current assimilation interval ! (list all files within hourly intervals) @@ -1070,7 +1070,7 @@ subroutine read_obs_ae_sm_LPRM( & cmd = trim(cmd) // ' >> ' // trim(tmpfname) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) call augment_date_time( 3600, date_time_tmp ) @@ -1082,7 +1082,7 @@ subroutine read_obs_ae_sm_LPRM( & cmd = 'wc -w ' // trim(tmpfname) // ' > ' // trim(tmpfname2) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) open(10, file=tmpfname2, form='formatted', action='read') @@ -1348,7 +1348,7 @@ subroutine read_obs_sm_ASCAT( & cmd = '/bin/rm -f ' // tmpfname - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) ! identify all files within current assimilation interval ! (list all files within hourly intervals) @@ -1379,7 +1379,7 @@ subroutine read_obs_sm_ASCAT( & cmd = trim(cmd) // ' >> ' // trim(tmpfname) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) call augment_date_time( 3600, date_time_tmp ) @@ -1392,7 +1392,7 @@ subroutine read_obs_sm_ASCAT( & cmd = 'wc -w ' // trim(tmpfname) // ' > ' // trim(tmpfname2) - call system(trim(cmd)) + call Execute_command_line(trim(cmd)) open(10, file=tmpfname2, form='formatted', action='read') @@ -5282,6 +5282,9 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & ! reichle, 23 Jan 2018: removed stats check for L1C fore-minus-aft Tb differences; ! use avg fore/aft timestamp so that fore and aft Tbs for same ! location are never used in different assimilation windows + ! reichle, 22 Apr 2020: resurrected check for L1C fore-minus-aft Tb differences + ! after antenna-scan-angle (ASA) issues continued and the + ! SMAP Project declined to address these issues in L1 ops implicit none @@ -5338,6 +5341,8 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & real, parameter :: Tb_min = 100.0 ! min allowed Tb real, parameter :: Tb_max = 320.0 ! max allowed Tb + real, parameter :: max_std_tb_fore_minus_aft = 20. ! max std-dev L1C[E] fore-minus-aft Tb diffs + integer, parameter :: L1CE_spacing = 3 ! thinning of L1C_TB_E in units of 9-km indices ("3" => 27 km) ! temporarily shift lat/lon of obs for computation of nearest tile to @@ -5369,7 +5374,7 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & type(date_time_type) :: date_time_low, date_time_upp type(date_time_type) :: date_time_low_fname, date_time_tmp - integer :: ii, jj, kk, nn + integer :: ii, jj, kk, nn, mm integer :: N_fnames, N_fnames_tmp, N_obs_tmp integer :: dset_rank integer :: ind_tile, ind_start, ind_end @@ -5377,6 +5382,7 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & real :: M36_col_ind_tile, M36_row_ind_tile real :: M36_col_ind_obs, M36_row_ind_obs real :: tmpreal + real :: tmp_tb_diff, tmp_tb_diff_Sum, tmp_tb_diff_SumOfSq, tmp_var real*8 :: J2000_seconds_low, J2000_seconds_upp @@ -5957,6 +5963,13 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & if (L1C_files .or. L1CE_files) then + ! initialize stats check for fore-minus-aft Tb diffs + + mm = 0 + + tmp_tb_diff_Sum = 0. + tmp_tb_diff_SumOfSq = 0. + do nn=1,N_obs_tmp ! QC @@ -5995,6 +6008,19 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & tmp_tb_1( nn) = 0.5 *( tmp_tb_1( nn) + tmp_tb_2( nn) ) tmp_time_1(nn) = 0.5D0*( tmp_time_1(nn) + tmp_time_2(nn) ) + ! Compute stats for fore-minus-aft Tb differences. + ! Excessive diffs are found in bad L1C_TB files, which occur + ! occasionally due to bad ANT_AZ files in L1B processing. + ! Includes ALL SURFACES!!! + ! - reichle, 22 Apr 2020 (resurrected) + + mm=mm+1 + + tmp_tb_diff = tmp_tb_1(nn) - tmp_tb_2(nn) + + tmp_tb_diff_Sum = tmp_tb_diff_Sum + tmp_tb_diff + tmp_tb_diff_SumOfSq = tmp_tb_diff_SumOfSq + tmp_tb_diff**2 + elseif (keep_data_1) then tmp_tb_1( nn) = tmp_tb_1( nn) @@ -6028,6 +6054,29 @@ subroutine read_obs_SMAP_halforbit_Tb( date_time, N_catd, this_obs_param, & end do + ! finalize stats check for fore-minus-aft differences (ALL SURFACES!!!) + ! - reichle, 22 Apr 2020 (resurrected) + + if (mm>1) then + + tmp_var = ( tmp_tb_diff_SumOfSq - (tmp_tb_diff_Sum**2)/real(mm) )/(real(mm-1)) + + if ( tmp_var > max_std_tb_fore_minus_aft**2 ) then + + write(err_msg, '(e12.5)') sqrt(tmp_var) + + err_msg = & + 'Ignoring ALL obs in halforbit file b/c of excessive std-dev in fore-minus-aft Tbs. ' // & + 'std-dev( tb_fore - tb_aft ) = ' // trim(err_msg) + + call ldas_warn(LDAS_GENERIC_WARNING, Iam, err_msg) + + jj = 0 ! results in N_obs_kept=0 below + + end if + + end if + else ! L2_SM_AP do nn=1,N_obs_tmp diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index 3a7e1465..2f49a98e 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -4584,8 +4584,9 @@ subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, call FileOpenedHash%get(fname_full,fid) if( fid == -9999 ) then ! not open yet - ierr=nf90_open(fname_full,IOR(NF90_NOWRITE, NF90_MPIIO), fid, & - comm = comm,info = MPI_INFO_NULL) + !ierr=nf90_open(fname_full,IOR(NF90_NOWRITE, NF90_MPIIO), fid, & + ! comm = comm,info = MPI_INFO_NULL) + ierr=nf90_open(fname_full,NF90_NOWRITE, fid) if(master_logit) then write(logunit,*) "opening file: "//trim(fname_full) @@ -4746,14 +4747,14 @@ end subroutine GEOS_openfile subroutine GEOS_closefile(fid) use netcdf implicit none - integer,intent (inout) :: fid + integer,intent (in) :: fid integer :: ierr + ierr = nf90_close(fid) if(ierr /= nf90_noerr) then print *, " error GEOS_closefile" stop 2 endif - fid = -9999 endsubroutine ! **************************************************************** diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 index 30cb69d7..67cf8604 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_HashTable.F90 @@ -3,6 +3,7 @@ MODULE LDAS_HashTable IMPLICIT NONE ! Use strong typing private INTEGER, PARAMETER :: tbl_size = 50 + integer, parameter :: keylen = 512 TYPE nodelist TYPE(nodelist), POINTER :: child => NULL() @@ -35,11 +36,16 @@ RECURSIVE SUBROUTINE put_nodeinfo(list,key,fid) CHARACTER(len=*), INTENT(in) :: key integer, INTENT(in) :: fid ! local - INTEGER :: keylen + INTEGER :: klen + + klen = LEN(key) + if ( klen > keylen) then + print*, key + stop (' key loo long') + endif - keylen = LEN(key) IF (ALLOCATED(list%key)) THEN - IF (list%key /= key) THEN + IF (trim(list%key) /= trim(key)) THEN IF ( .NOT. ASSOCIATED(list%child) ) then ALLOCATE(list%child) ENDIF @@ -60,28 +66,34 @@ RECURSIVE SUBROUTINE get_nodeinfo(list,key,fid) CHARACTER(len=*), INTENT(in) :: key integer, INTENT(out) :: fid - IF (ALLOCATED(list%key) .AND. (list%key == key)) THEN - fid = list%fid - ELSE IF(ASSOCIATED(list%child)) THEN ! keep going - CALL get_nodeinfo(list%child,key,fid) - ELSE ! At the end of the list, no key found - fid = -9999 - RETURN - END IF + if (ALLOCATED(list%key)) then + if (trim(list%key) == trim(key)) THEN + fid = list%fid + return + endif + endif + + IF(ASSOCIATED(list%child)) THEN ! keep going + CALL get_nodeinfo(list%child,key,fid) + ELSE ! At the end of the list, no key found + fid = -9999 + END IF + END SUBROUTINE get_nodeinfo RECURSIVE SUBROUTINE free_nodeinfo(list,closefile) CLASS(nodelist), INTENT(inout) :: list external :: closefile integer :: rc + IF (ASSOCIATED(list%child)) THEN CALL free_nodeinfo(list%child, closefile ) DEALLOCATE(list%child) END IF - list%child => NULL() - if (list%fid > 0) call closefile(list%fid) + IF (ALLOCATED(list%key)) then - DEALLOCATE(list%key) + call closefile(list%fid) + DEALLOCATE(list%key) ENDIF END SUBROUTINE free_nodeinfo @@ -119,10 +131,10 @@ END FUNCTION sum_string SUBROUTINE put_hash_table(tbl,key,fid) CLASS(hash_table), INTENT(inout) :: tbl - CHARACTER(len=*), INTENT(in) :: key - integer, INTENT(in) :: fid + CHARACTER(len=*), INTENT(in) :: key + integer, INTENT(in) :: fid !local - INTEGER :: hash + INTEGER :: hash hash = MOD(sum_string(key),tbl%vec_len) CALL tbl%vec(hash)%put(key,fid) diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 index 3aea7652..b82a3ccd 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 @@ -475,7 +475,7 @@ subroutine LDAS_read_land_tile( tile_file,catch_file, tile_grid_g, tile_coord_la i=index(catch_file,'/clsm/') fname = catch_file(1:i)//'topo_DYN_ave_*.data' - call system('ls '//trim(fname) // ' >topo_DYN_ave.file') + call Execute_command_line('ls '//trim(fname) // ' >topo_DYN_ave.file') open(10,file='topo_DYN_ave.file', action='read') fname= '' read(10,'(A)') fname From c34355d13d490c7f73880845a396859843e25157 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 23 Apr 2020 17:23:29 -0400 Subject: [PATCH 14/42] Syncing master into Bridge_from_develop_to_master no changes to merge, just syncing From c42cd927f6c579c20e59d596bf8131711ffd2ad9 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 23 Apr 2020 17:27:06 -0400 Subject: [PATCH 15/42] Edit Externals.cfg in prep for sync with develop --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index e835c344..33d29c54 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.3 +branch = master protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.3 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From eafec5797af34a30b2099635b09ff1d66f43716d Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 24 Apr 2020 14:57:46 -0400 Subject: [PATCH 16/42] Use EMSA_env v2.1.1+intel19.1.0 (#197) - works on SLES11 with Intel-18 and on SLES12 with Intel-19 - NOT zero-diff across operating systems --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index e835c344..abbfd6e2 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -2,7 +2,7 @@ required = True repo_url = git@github.com:GEOS-ESM/ESMA_env.git local_path = ./@env -tag = v2.1.1 +tag = v2.1.1+intel19.1.0 protocol = git [ESMA_cmake] From 44d7e173748123a43e388ae01cb1ed6ca12d9246 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 29 Apr 2020 15:01:13 -0400 Subject: [PATCH 17/42] hotfix for subdaily2daily nc4 file concatenation (post-proc) (#200) --- src/Applications/LDAS_App/lenkf.j.template | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index 1a2ce3cb..b8f4595c 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -399,7 +399,7 @@ while ( $counter <= ${NUM_SGMT} ) # create daily and remove the sub-daily # ------------------------------------------------------------------ set day=1 - while ($day <= $NDAYS && $LEN_SUB > 1) + while ($day <= $NDAYS) if ( $day < 10 ) set DD=0${day} if ( $day >= 10 ) set DD=${day} @ day++ @@ -450,19 +450,9 @@ EOF # not enough days? move on to the next collection if($NAVAIL != $NDAYS) continue - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | rev` - set LEN_SUB = `echo $#time_steps` - @ LEN_AVAIL = $LEN_SUB * $NDAYS - - # not enough sub-daylies? move on to the next collection - if ($LEN != $LEN_AVAIL) continue - + # create the monly average - #ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 - #ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 - - #/bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 + ncra -h $EXPID.$ThisCol.${YYYY}${MM}??.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 # don't want a daily? delete the daily and sub-dailies and continue From 4695c6a59907837775e3a6f906bacafc225f7a3a Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Mon, 11 May 2020 15:03:48 -0400 Subject: [PATCH 18/42] Sync develop into bridge branch (#215) --- Externals.cfg | 4 +- doc/CHANGELOG.md | 71 +- doc/README.metforcing_and_bcs.md | 32 +- src/Applications/LDAS_App/GEOSldas_LDAS.rc | 64 +- .../LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml | 27 +- src/Applications/LDAS_App/ldas_setup | 208 +- src/Applications/LDAS_App/lenkf.j.template | 204 +- .../GEOS_LandAssimGridComp.F90 | 12 +- .../clsm_ensdrv_drv_routines.F90 | 853 +------ .../clsm_ensdrv_out_routines.F90 | 1969 +---------------- .../clsm_ensupd_enkf_update.F90 | 42 +- .../clsm_ensupd_upd_routines.F90 | 92 +- .../GEOSlandassim_GridComp/enkf_general.F90 | 63 +- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 367 +-- .../Shared/LDAS_DriverTypes.F90 | 76 - .../Shared/LDAS_ensdrv_Globals.F90 | 13 - .../Shared/LDAS_ensdrv_functions.F90 | 55 +- .../Shared/LDAS_ensdrv_init_routines.F90 | 1176 +--------- .../Shared/LDAS_ensdrv_mpi.F90 | 72 +- 19 files changed, 720 insertions(+), 4680 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 33d29c54..f9970364 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -2,7 +2,7 @@ required = True repo_url = git@github.com:GEOS-ESM/ESMA_env.git local_path = ./@env -tag = v2.1.1 +tag = v2.1.3+intel19.1.0 protocol = git [ESMA_cmake] @@ -25,7 +25,7 @@ sparse = ../../../config/GMAO_Shared.sparse required = True repo_url = git@github.com:GEOS-ESM/MAPL.git local_path = ./src/Shared/@MAPL -tag = v2.1.1 +tag = v2.1.3 protocol = git [GEOSgcm_GridComp] diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index 2d5e2d03..116048bf 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -30,17 +30,69 @@ In 2019, GEOS LDAS version control transferred from CVS to Git. This README file contains the history of stable GEOSldas versions ("tags") in Git, followed by older, CVS LDASsa and GEOSldas versions and change logs. -[Unreleased] Features: --------------------- -_These are additions put in development, that will be in the next stable tag_ +Overview of Git Releases: +============================ +[v17.9.0-beta.5](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.5) - 2020-05-11 +------------------------------ +- Pre-release meant for use under SLES12 at NCCS. Still works for SLES11. +- New/Updated Science Functionality: + - Forecast error covariance inflation with scalar (globally constant) factor. +- New/Updated Infrastructure: -Overview of Git tags: -============================ + - Support for GEOS FP forcing with generic ("seamless") file names. + - Resource parameter changes: + - Renamed NUM_ENSEMBLE to NUM_LDAS_ENSEMBLE in "exeinp" file to be consistent with LDAS.rc. + - Renamed MONTHLY_OUTPUT to POSTPROC_HIST. + - Updated utilities to MAPL v2.1.3, ESMA_env v2.1.3+intel19.1.0. + +- Bug Fixes and Other Minor Changes: + + - Added basic protections for concatenation of sub-daily into daily nc4 files and for generation of monthly-mean nc4 files. + - Write ObsFcstAna and smapL4SMaup files into ./scratch, then move to ana/ens_avg/year/month dir in postprocessing. + - Some cleanup of obsolete LDASsa code. + +------------------------------ +[v17.9.0-beta.4-SLES12](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.4-SLES12) - 2020-04-24 +------------------------------ +- Pre-release meant for use under SLES12 at NCCS, otherwise identical to v17.9.0-beta.4-SLES11. +- Works under SLES12 using the Intel-19 compiler. +- Also works under SLES11 using the Intel-18 compiler but is not zero-diff across compilers/operating systems. + +------------------------------ +[v17.9.0-beta.4-SLES11](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.4-SLES11) - 2020-04-23 +------------------------------ +- Pre-release meant for use under SLES11 at NCCS. Under SLES12, use v17.9.0-beta.4-SLES12 (or newer). +- Uses the Intel-18 compiler and also appears to work under SLES12. However, LDASsa with Intel-18 under SLES12 was found to create bad Fortran sequential binary files out of a subroutine that is very similar in LDASsa and GEOSldas. +- Zero-diff vs. v17.9.0-beta.3 for Catchment only (except SMAP L1C Tb fore-minus-aft check). +- Not zero-diff for CatchCN (via v1.8.3 of GEOS_GCMGridComp). + +- New/Updated Science Functionality: + + - Resurrected SMAP L1C Tb fore-minus-aft check. + +- New/Updated Infrastructure: + + - Updated utilities to MAPL v2.1.1, ESMA_env v2.1.1., ESMA_cmake v3.0.1. + - New GEOS_SurfaceGridComp.rc file (via v1.8.3 of GEOS_GCMGridComp). + - Parallel post-processing. + - Cross-stream support for FP f525_p5 forcing. + - ~sbatch~ submission for pre-processing of restarts to comply with SLES12 requirements. + - Subdaily-to-daily concatenation processes before month is complete. + - Temporary solution to create directories for ObsFcstAna files to enable extending an existing GEOSldas run without going through setup. + +- Bug Fixes and Other Minor Changes: + + - Updated README.md. + - ~obspertrseed~ restart file name when restarting from existing run. + - Subdaily-to-daily nc4 concatenation (indent error). + - Fixes for GNU compiler in debug mode. + - Fixed ~landpert~ checkpoint output when on cube-sphere tiles. +------------------------------ [v17.9.0-beta.3](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.3) - 2020-03-18 ------------------------------ - Additional RESTART options, incl. from re-tiling MERRA-2, FP, or other restarts on different tile space or with different boundary conditions @@ -240,6 +292,15 @@ reichle-LDASsa_m3-16_6_p1 9 Jul 2018 Added GEOS-5.21 FP function - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - reichle-LDASsa_m3-16_6_p2 7 Mar 2019 Added GEOS-5.22 FP functionality (patch targeted for NRv7.2 and SMAP L4_SM ops) +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +reichle-LDASsa_m3-16_6_p3 30 Jan 2020 Added GEOS-5.25 FP functionality + (patch targeted for NRv7.2 and SMAP L4_SM ops) +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +reichle-LDASsa_m3-16_6_p4 3 Apr 2020 Added GEOS-5.25_p5 FP functionality + (patch targeted for NRv7.2 and SMAP L4_SM ops) +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +reichle-LDASsa_m3-16_6_p4_SLES12 14 Apr 2020 SLES12 version of *_p4 tag -- NOT zero-diff!! + (patch targeted for NRv7.2 and SMAP L4_SM ops) ------------------------------------------------------------------------------------- ------------------------------------------------------------------------------------- diff --git a/doc/README.metforcing_and_bcs.md b/doc/README.metforcing_and_bcs.md index d2d60956..24de37c6 100644 --- a/doc/README.metforcing_and_bcs.md +++ b/doc/README.metforcing_and_bcs.md @@ -72,7 +72,7 @@ SMAP_Nature_v04, SMAP_Nature_v04.1 MET_PATH : /discover/nobackup/projects/gmao/merra/iau/merra_land/GEOS5_land_forcing/ ``` -SMAP_Nature_v05 +SMAP_Nature_v05, v7.2, v8.1; SMAP L4_SM Version 4, Version 5 ``` MET_PATH : /discover/nobackup/projects/gmao/merra/iau/merra_land/MERRA2_land_forcing/ ! before 1/1/2015 MET_PATH : /discover/nobackup/projects/gmao/merra/iau/merra_land/GEOS5_land_forcing/ ! after 1/1/2015 @@ -168,12 +168,21 @@ COMMONLY USED values for `MET_TAG`: MET_TAG : cross_d5124_RPFPIT ! uses "late-look" through present ``` -#### FP +#### GEOS FP ``` - MET_TAG : e5110_fp - MET_TAG : e5130_fp - MET_TAG : e5131_fp - MET_TAG : cross_FP + MET_TAG : e5110_fp ! starting 11 Jun 2013 + MET_TAG : e5130_fp ! starting 20 Aug 2014 + MET_TAG : e5131_fp ! starting 1 May 2015 + MET_TAG : f516_fp ! starting 24 Jan 2017 + MET_TAG : f517_fp ! starting 1 Nov 2017 + MET_TAG : f521_fp ! starting 11 Jul 2018 + MET_TAG : f522_fp ! starting 13 Mar 2019 + MET_TAG : f525_fp ! starting 30 Jan 2020 + MET_TAG : f525_p5_fp ! starting 7 Apr 2020 + + MET_TAG : cross_FP ! stitch FP experiment names across years + + MET_TAG : GEOS.fp.asm ! "seamless" FP files (published/generic file names, ~same result as cross_FP) ``` #### FP with precip corrections as in pre-beta SMAP L4_SM products @@ -184,7 +193,7 @@ COMMONLY USED values for `MET_TAG`: #### SMAP_Nature_v03 ``` MET_TAG : cross_RPFPIT__precCPCUG5RPFPITv1 ! before 1/1/2014 - MET_TAG : cross_FP__precCPCUG5FPv1 ! after 1/1/2014 + MET_TAG : cross_FP__precCPCUG5FPv1 ! after 1/1/2014 ``` #### SMAP_Nature_v04 @@ -199,7 +208,7 @@ COMMONLY USED values for `MET_TAG`: MET_TAG : cross_FP__precCPCUG5FPv2 ! after 1/1/2015 ``` -#### SMAP_Nature_v05 +#### SMAP_Nature_v05, v7.2, v8.1; SMAP L4_SM Version 4, Version 5 ``` MET_TAG : M2COR_cross__precCPCUGPCP22clim_MERRA2_BMTXS ! before 1/1/2015 MET_TAG : cross_FP__precCPCUG5FPv3 ! after 1/1/2015 @@ -259,7 +268,7 @@ COMMONLY USED boundary conditions (bcs): BCS_PATH = /discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v002/ ``` -#### Icarus-NL ("New Land") +#### Icarus-NL ("New Land"), SMAP_Nature_v7.2 ``` BCS_PATH = /discover/nobackup/ltakacs/bcs/Icarus-NL/ ``` @@ -269,8 +278,7 @@ Notes: - This path remains in place to permit recreating experiments that have used this path. - The sub-directory "Icarus-NL_MERRA-2/" contains the "new land" bcs. The string "MERRA-2" in this sub-directory name refers to ocean bcs that are not relevant for GEOSldas. - -#### Icarus-NL ("New Land") v2 +#### Icarus-NLv2, SMAP L4_SM Version 4 ``` BCS_PATH = /discover/nobackup/ltakacs/bcs/Icarus-NLv2/ ``` @@ -279,7 +287,7 @@ Notes: - Icarus-NLv2 is a update to Icarus-NL bcs. A patch has been applied to files green*.data, nirdf*.dat, and visdf*.dat. - DEFAULT for GEOSldas v17.8.0 -#### Icarus-NL ("New Land") v3 +#### Icarus-NLv3, SMAP_Nature_v8.1, SMAP L4_SM Version 5 ``` BCS_PATH = /discover/nobackup/ltakacs/bcs/Icarus-NLv3/ ``` diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index b70f3417..801cdde4 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -41,31 +41,24 @@ LSM_CHOICE: 1 # If only whitelist should be used, specify dummy valuessuch that: # MINLON > MAXLON and MINLAT > MAXLAT. # -# MINLON : -180. -# MAXLON : 180. -# MINLAT : -90. -# MAXLAT : 90. +# MINLON: -180. +# MAXLON: 180. +# MINLAT: -90. +# MAXLAT: 90. # # Specify path and filenames for blacklist and whitelist files: # (May leave blank.) # -# BLACK_FILE : '' -# WHITE_FILE : '' +# BLACK_FILE: '' +# WHITE_FILE: '' -# ---- Surface meteorological forcing: Time step -# -# Should be set in the exeinp file where MET_PATH is defined -# 3600 = default -# -# FORCE_DTSTEP : 3600 - # ---- Surface meteorological forcing: Horizonal interpolation # # 1 : bilinear interpolation (default) # 0 : nearest neighbor # -MET_HINTERP : 1 +MET_HINTERP: 1 # ---- Specify if running model only or data assimilation @@ -73,7 +66,7 @@ MET_HINTERP : 1 # NO : model only (DEFAULT; with --runmodel option) # YES : assimilation (without --runmodel option) # -LAND_ASSIM : NO +LAND_ASSIM: NO # ---- Perturbations: On/off @@ -83,11 +76,11 @@ LAND_ASSIM : NO # 0 : No perturbactions. # 1 : With perturbations. # -PERTURBATIONS : 0 +PERTURBATIONS: 0 # ---- Perturbations: ID of first ensemble member # -FIRST_ENS_ID : 0 +FIRST_ENS_ID: 0 # ---- Path to special namelist input files @@ -98,7 +91,7 @@ FIRST_ENS_ID : 0 # LDASsa_SPECIAL_inputs_ensprop.nml # LDASsa_SPECIAL_inputs_catbias.nml # -# NML_INPUT_PATH : '' +# NML_INPUT_PATH: '' # ---- Microwave Radiative Transfer Model (mwRTM) parameter file name (nc4 format) used for Tb assimilation @@ -106,7 +99,7 @@ FIRST_ENS_ID : 0 # This file can be converted from binary with the program mwrtm_bin2nc4.x. # If empty or commented out, GEOSldas will search the restart directory. # -# MWRTM_FILE : '' +# MWRTM_FILE: '' # ---- Job segments: Length @@ -115,7 +108,7 @@ FIRST_ENS_ID : 0 # Default is the entire simulation period (END_DATE minus BEG_DATE). # Format: yyyymmdd hhmmss # -# JOB_SGMT : 00000100 000000 +# JOB_SGMT: 00000100 000000 # ---- Job segments: Number # @@ -124,31 +117,34 @@ FIRST_ENS_ID : 0 # Low values for NUM_SGMT are recommended for run-time and storage efficiency. # Default is 1. # -# NUM_SGMT : 1 +# NUM_SGMT: 1 # ---- Output: Write log file (YES/NO)? # -LDAS_logit : YES +LDAS_logit: YES # ---- Output: HISTORY definition of model diagnostics # # User-defined path and filename of output (HISTORY) specification file. # If empty, ldas_setup will generate a default HISTORY.rc file. # -# HISTRC_FILE : '' +# HISTRC_FILE: '' -# ---- Write only monthly output? +# ---- Concatenate sub-daily nc4 files into daily nc4 files and write monthly-mean output? # -# Monthly files can be created from daily files. -# Accurate monthly averages require setting "ref_time" in HISTORY.rc to "000000" +# Optional post-processing of model diagnostics output into bundled daily files and monthly means. +# Reduces the file count and (optionally) the output volume. # -# 0 : Output bundled into daily files per HISTORY specifications (default). -# 1 : Monthly files will be created. Daily files will *not* be deleted. -# 2 : Monthly files will be created and daily files will be deleted automatically. +# Accurate monthly-means of time-average Collections require setting "ref_time" to "000000" in HISTRC_FILE! # -# MONTHLY_OUTPUT : 0 - +# 0 : No post-processing (default). +# 1 : For complete days, concatenate (bundle) sub-daily nc4 files, if any, into daily nc4 files. +# For complete months, write monthly-mean nc4 files. +# 2 : As in 1, but delete daily nc4 files. +# +# POSTPROC_HIST: 0 + # ---- Name of file containing Surface GridComp resource parameters # @@ -161,12 +157,12 @@ SURFRC: LDAS.rc # ---- No dycore for offline # -DYCORE : none +DYCORE: none # ---- Only one surface level # -LM : 1 +LM: 1 # ---- For MAPL_RestartOptional # -MAPL_ENABLE_BOOTSTRAP : YES +MAPL_ENABLE_BOOTSTRAP: YES diff --git a/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml b/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml index 4b08d676..73947a35 100644 --- a/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml +++ b/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml @@ -1,9 +1,10 @@ ! ! namelist of EnKF inputs for land EnKF update ! -! reichle, 28 Jan 2005 -! reichle, 13 Jun 2011 - updated for SMOS angles and downscaling ("FOV") -! reichle, 8 Jun 2017 - added "%flistpath" and "%flistname"; updated comments +! reichle, 28 Jan 2005 +! reichle, 13 Jun 2011 - updated for SMOS angles and downscaling ("FOV") +! reichle, 8 Jun 2017 - added "%flistpath" and "%flistname"; updated comments +! qliu+reichle, 29 Apr 2020 - added forecast error covariance inflation ! ! -------------------------------------------------------------------- @@ -42,17 +43,8 @@ centered_update = .false. out_obslog = .true. out_ObsFcstAna = .false. -!out_incr = .false. out_smapL4SMaup = .false. -! select format of increments output -! 0: standard LDASsa -! (output in LDASsa domain and LDASsa tile order) -! 1: suitable for land incremental analysis update (LIAU) in GEOS-5 GCM -! (output on global domain in GEOS-5 global tile order) - -!out_incr_format = 0 - ! --------------------------------------------------------------------- ! ! Compact support parameters - for 3d updates @@ -63,6 +55,17 @@ out_smapL4SMaup = .false. xcompact = 0. ! [deg] longitude ycompact = 0. ! [deg] latitude +! --------------------------------------------------------------------- +! +! forecast error covariance inflaction factor +! +! - assigns more weight to observations in analysis by inflating forecast error covariance +! - works on std-dev, i.e., var_inflated = var * inflation_fac**2 +! - typical values: 1 <= inflation_fac <= 1.5 +! - to turn off, set to any negative real number + +fcsterr_inflation_fac = -9999. + ! --------------------------------------------------------------------- ! ! Definition of measurement species and parameters diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 9e8b5a5b..94e94cb7 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -32,18 +32,18 @@ class LDASsetup: # Required exe input fields # These fields are needed to pre-compute exp dir structure # ------ - rqdExeInpKeys = ['EXP_ID', 'EXP_DOMAIN', 'NUM_ENSEMBLE', + rqdExeInpKeys = ['EXP_ID', 'EXP_DOMAIN', 'NUM_LDAS_ENSEMBLE', 'BEG_DATE', 'END_DATE','RESTART_PATH', 'RESTART_DOMAIN','RESTART_ID','MET_TAG','MET_PATH','FORCE_DTSTEP','BCS_PATH'] - rqdExeInpKeys_rst = ['EXP_ID', 'EXP_DOMAIN', 'NUM_ENSEMBLE', + rqdExeInpKeys_rst = ['EXP_ID', 'EXP_DOMAIN', 'NUM_LDAS_ENSEMBLE', 'BEG_DATE', 'END_DATE','MET_TAG','MET_PATH','FORCE_DTSTEP','BCS_PATH'] - # These keywords are excluded from LDAS.rc + # These keywords are excluded from LDAS.rc (i.e., only needed in pre- or post-processing) self.NoneLDASrcKeys=['EXP_ID', 'EXP_DOMAIN', 'BEG_DATE', 'END_DATE','RESTART','RESTART_PATH', 'RESTART_DOMAIN','RESTART_ID','BCS_PATH','TILING_FILE','GRN_FILE','LAI_FILE','NIRDF_FILE', 'VISDF_FILE','CATCH_DEF_FILE','NDVI_FILE', - 'NML_INPUT_PATH','HISTRC_FILE','RST_FROM_GLOBAL','JOB_SGMT','NUM_SGMT','MONTHLY_OUTPUT', + 'NML_INPUT_PATH','HISTRC_FILE','RST_FROM_GLOBAL','JOB_SGMT','NUM_SGMT','POSTPROC_HIST', 'MINLON','MAXLON','MINLAT','MAXLAT','BLACK_FILE','WHITE_FILE','MWRTM_FILE'] @@ -62,7 +62,7 @@ class LDASsetup: if 'exeinp' in cmdLineArgs: # sample sub-command # by construction, we can have - # either: {'exeinp': False, 'batinp': 'lasgh'} + # either: {'exeinp': False, 'batinp': 'lasgh'} <-- 'lasgh'??? # or: {'exeinp': True, 'batinp': None} if cmdLineArgs['exeinp']: _printExeInputKeys(rqdExeInpKeys) @@ -84,7 +84,6 @@ class LDASsetup: self.runmodel = cmdLineArgs['runmodel'] self.daysperjob = cmdLineArgs['daysperjob'] self.monthsperjob = cmdLineArgs['monthsperjob'] - #self.ForceReuseDir = cmdLineArgs['ForceReuseDir'] self.rqdExeInp = OrderedDict() self.rqdRmInp = OrderedDict() self.optRmInp = OrderedDict() @@ -103,7 +102,7 @@ class LDASsetup: self.has_ldassa_pert = False self.nSegments = 1 # ------ - # Read exe input file which is required to setup the dir + # Read exe input file which is required to set up the dir # ------ self.rqdExeInp = self._parseInputFile(cmdLineArgs['exeinpfile']) # verifing the required input @@ -134,8 +133,8 @@ class LDASsetup: _printdict(self.rqdExeInp) # nens is an integer and =1 for model run - self.nens = int(self.rqdExeInp['NUM_ENSEMBLE']) # fail if Nens's val is not int - assert self.nens>0, 'NUM_ENSEMBLE [%d] <= 0' % self.nens + self.nens = int(self.rqdExeInp['NUM_LDAS_ENSEMBLE']) # fail if Nens's val is not int + assert self.nens>0, 'NUM_LDAS_ENSEMBLE [%d] <= 0' % self.nens _mydir = self.exphome + '/' + self.rqdExeInp['EXP_ID'] assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None @@ -167,7 +166,7 @@ class LDASsetup: ) if self.rqdExeInp['RESTART'].isdigit() : if int(self.rqdExeInp['RESTART']) == 0 : - # print "Starting date is forced to January 1st if there is no restart file" + print "No restart file (cold restart): Forcing start date to January 1, 0z" year = self.begDates[0].year self.begDates[0]=datetime(year =year,month=1,day =1,hour =0, minute= 0,second= 0) @@ -283,12 +282,8 @@ class LDASsetup: else : self.catch = 'catchcn' - if 'MONTHLY_OUTPUT' not in self.rqdExeInp: - self.rqdExeInp['MONTHLY_OUTPUT'] = 0 - - #if int(self.rqdExeInp['MONTHLY_OUTPUT']) > 0: - # assert self.begDates[0].day == 1 and self.begDates[0].hour == 0 and self.begDates[0].minute == 0 and self.begDates[0].second == 0, "monthly output should start from day 1 and 0Z" - # assert self.endDates[0].day == 1 and self.endDates[0].hour == 0 and self.endDates[0].minute == 0 and self.endDates[0].second == 0, "monthly output should end at day 1 and 0Z" + if 'POSTPROC_HIST' not in self.rqdExeInp: + self.rqdExeInp['POSTPROC_HIST'] = 0 if 'RUN_IRRIG' not in self.rqdExeInp: self.rqdExeInp['RUN_IRRIG'] = 0 @@ -443,101 +438,6 @@ class LDASsetup: tmp_expid = None tmp_expdir = None - # ------ - # If daysperjob>0, split duration of - # start/end_times are now lists of len > 1 - # ------ - # wj notes: disable daysperjob -# self.daysperjob = 0 -# if self.daysperjob: -# # shorthands -# _dpj = self.daysperjob -# _start = self.begDates[0] -# _end = self.endDates[0] -# assert _dpj>0, 'daysperjob = %d' % _dpj -# # total number of days for the given job -# nDays = (_end - _start).days -# assert nDays>_dpj, \ -# 'Days per job [%d] >= Duration [%d days]' %\ -# (_dpj, nDays) -# # number of job segments -# q = nDays/_dpj -# r = nDays%_dpj -# if r>0: -# nSegments = q+1 -# else: -# nSegments = q -# # lists of start times, end times -# _start_list = list() -# _end_list = list() -# for iseg in xrange(nSegments): -# _start_list.append(_start+timedelta(days=iseg*_dpj)) -# for iseg in xrange(nSegments-1): -# _end_list.append(_start_list[iseg+1]) -# _end_list.append(_end) -# -# #update beg dates and end dates -# self.begDates = _start_list -# self.endDates = _end_list -# self.job_sgmt = list() -# for iseg in xrange(nSegments): -# self.job_sgmt.append("JOB_SGMT: 000000%02d 000000"%(self.endDates[iseg]-self.begDates[iseg]).days) -# -# # print, if requested -# if self.verbose: -# print '\nn start end' -# for iseg in xrange(nSegments): -# print iseg, ':', _start_list[iseg], '-', _end_list[iseg] -# -# # wj notes: disable monthsperjob -# self.monthsperjob = 0 -# if self.monthsperjob: -# # shorthands -# _mpj = self.monthsperjob -# assert _mpj>0, 'monthsperjob = %d' % _mpj -# _start = self.begDates[0] -# _end = self.endDates[0] -# # for this option the start/end dates have to be -# # 0z on the first of the month -# assert (_start.day==1 and _start.hour==0 and -# _start.minute==0 and _start.second==0 -# ), 'invalid start_time: %s for --monthsperjob' % \ -# _start.strftime('%Y-%m-%d-%H-%M-%S') -# assert (_end.day==1 and _end.hour==0 and -# _end.minute==0 and _end.second==0 -# ), 'invalid end_time: %s for --monthsperjob' % \ -# _end.strftime('%Y-%m-%d-%H-%M-%S') -# _start_list = list() -# _end_list = list() -# for dt in rrule.rrule(rrule.MONTHLY, interval=_mpj, dtstart=_start, until=_end): -# seg_start = dt -# seg_end = dt+relativedelta(months=_mpj) -# if seg_end>_end: -# seg_end = _end -# if(seg_start>=seg_end) : -# break -# _start_list.append(seg_start) -# _end_list.append(seg_end) -# -# #update beg dates and end dates -# -# self.begDates = _start_list -# self.endDates = _end_list -# self.job_sgmt =list() -# for iseg in xrange(len(_start_list)): -# months = 0 -# dt = relativedelta(months=+1) -# d = self.begDates[iseg] -# while d "' in line: continue - # get "GEOSldas=>" defalut in GEOS_LandGrid.rc + # get "GEOSldas=>" default in GEOS_LandGrid.rc if 'GEOSldas=>' in line: line = line.split('GEOSldas=>')[1] # handle comments @@ -713,7 +613,7 @@ class LDASsetup: if 'SURFLAY' in self.rqdExeInp : dzsf = self.rqdExeInp['SURFLAY'] - # These are dummy values for cold restart: + # These are dummy values for *cold* restart: wemin_in = '13' # WEmin input/output for scale_catch(cn), wemin_out = '13' # if 'WEMIN_IN' in self.rqdExeInp : @@ -807,7 +707,7 @@ class LDASsetup: rstdomain = self.rqdExeInp['RESTART_DOMAIN'] rstpath0 = self.rqdExeInp['RESTART_PATH'] - # just copy the landassim pert seed if it exist + # just copy the landassim pert seed if it exists for iens in xrange(self.nens) : _ensdir = self.ensdirs[iens] _ensid = self.ensids[iens] @@ -1072,7 +972,7 @@ class LDASsetup: #sp.call(cmd) for line in fileinput.input(tmprcfile,inplace=True): print line.rstrip().replace('GEOSldas_expid',self.rqdExeInp['EXP_ID']) - # just copy en emty ExtData.rc + # just copy an empty ExtData.rc if shortfile=='ExtData.rc' : shutil.copy2(rcfile, self.rundir+'/'+shortfile) @@ -1098,7 +998,7 @@ class LDASsetup: for key,val in default_surfrcInp.iteritems() : ldasrcInp[key] = val - # ldas default, may overiwrite land default + # ldas default, may overwrite land default default_ldasrcInp = self._parseInputFile(rcfile) for key,val in default_ldasrcInp.iteritems() : ldasrcInp[key] = val @@ -1192,7 +1092,7 @@ class LDASsetup: # write LDAS.rc fout =open(self.rundir+'/'+shortfile,'w') - ldasrcInp['NUM_LDAS_ENSEMBLE']=ldasrcInp.pop('NUM_ENSEMBLE') + # ldasrcInp['NUM_LDAS_ENSEMBLE']=ldasrcInp.pop('NUM_ENSEMBLE') for key,val in optinxny.iteritems(): keyn=(key+":").ljust(36) fout.write(keyn+str(val)+'\n') @@ -1216,7 +1116,6 @@ class LDASsetup: _rm_name = self.rqdRmInp['rm_name'] expid = self.rqdExeInp['EXP_ID'] - #expdomain = self.rqdExeInp['EXP_DOMAIN'] if _rm_name=='SLURM': directives = '' # REQUIRED directives account/time/ntasks @@ -1378,18 +1277,16 @@ class LDASsetup: fout.write(line.replace('MY_EXPID',self.rqdExeInp['EXP_ID'])) elif 'MY_EXPDOMAIN' in line : fout.write(line.replace('MY_EXPDOMAIN',self.rqdExeInp['EXP_DOMAIN'])) - #elif 'MY_ESMADIR' in line : - # fout.write(line.replace('MY_ESMADIR',self.blddir)) elif 'MY_ENSEMBLE' in line : - fout.write(line.replace('MY_ENSEMBLE',str(self.rqdExeInp['NUM_ENSEMBLE']))) + fout.write(line.replace('MY_ENSEMBLE',str(self.rqdExeInp['NUM_LDAS_ENSEMBLE']))) elif 'MY_LOGFILE' in line : fout.write(line.replace('MY_LOGFILE',my_logfile)) elif 'MY_ERRFILE' in line : fout.write(line.replace('MY_ERRFILE',my_errfile)) elif 'MY_MODEL' in line : fout.write(line.replace('MY_MODEL',self.catch)) - elif 'MY_MONTHLY' in line : - fout.write(line.replace('MY_MONTHLY',str(self.rqdExeInp['MONTHLY_OUTPUT']))) + elif 'MY_POSTPROC_HIST' in line : + fout.write(line.replace('MY_POSTPROC_HIST',str(self.rqdExeInp['POSTPROC_HIST']))) else : fout.write(line.replace('MY_EXPDIR',self.exphome+'/$EXPID')) @@ -1430,11 +1327,11 @@ def _printExeInputKeys(rqdExeInpKeys): print '# #' print '############################################################' print - print 'EXP_ID :' - print 'EXP_DOMAIN :' - print 'NUM_ENSEMBLE :' - print 'BEG_DATE :' - print 'END_DATE :' + print 'EXP_ID:' + print 'EXP_DOMAIN:' + print 'NUM_LDAS_ENSEMBLE:' + print 'BEG_DATE:' + print 'END_DATE:' print print '############################################################' @@ -1503,10 +1400,10 @@ def _printExeInputKeys(rqdExeInpKeys): print '############################################################' print - print 'RESTART :' - print '#RESTART_ID :' - print '#RESTART_PATH :' - print '#RESTART_DOMAIN :' + print 'RESTART:' + print '#RESTART_ID:' + print '#RESTART_PATH:' + print '#RESTART_DOMAIN:' print print '############################################################' @@ -1515,12 +1412,14 @@ def _printExeInputKeys(rqdExeInpKeys): print '# #' print '# See README files in ./src/Applications/LDAS_App/doc #' print '# #' + print '# Surface meteorological forcing time step is in seconds. #' + print '# #' print '############################################################' print - print 'MET_TAG :' - print 'MET_PATH :' - print 'FORCE_DTSTEP :' + print 'MET_TAG:' + print 'MET_PATH:' + print 'FORCE_DTSTEP:' print print '############################################################' @@ -1531,32 +1430,38 @@ def _printExeInputKeys(rqdExeInpKeys): print '# #' print '############################################################' print - print 'BCS_PATH :' + print 'BCS_PATH:' print _fn = '../etc/GEOSldas_LDAS.rc' # run ldas_setup from /bin directory - _f = open(_fn) - for line in _f: - sys.stdout.write(line) - sys.stdout.flush() - _f.close() + with open(_fn) as _f: + i_ = 1 + for line in _f: + if ( i_ < 5 or i_ >10): # ignore lines 5-10 - may need to change if GEOSldas_LDAS.rc is edited + sys.stdout.write(line) + sys.stdout.flush() + i_ += 1 print print _fn = '../etc/GEOS_SurfaceGridComp.rc' # run ldas_setup from /bin directory - _f = open(_fn) - for line in _f: - if '"GEOSldas=>"' in line: + with open(_fn) as _f : + i_ = 1 + for line in _f: + if ( 5<=i_ and i_<=21) : # ignore lines 5-21 - may need to change if GEOS_SurfaceGridComp.rc is edited + i_ +=1 + continue + if '"GEOSldas=>"' in line: sys.stdout.write(line) - elif 'GEOSldas=>' in line: + elif 'GEOSldas=>' in line: line0 = line.split("GEOSldas=>")[1] sys.stdout.write(line0) - elif not line.strip() or line.strip().startswith('#'): - sys.stdout.write(line) - sys.stdout.flush() - _f.close() + elif not line.strip() or line.strip().startswith('#'): + sys.stdout.write(line) + sys.stdout.flush() + i_ += 1 print print @@ -1652,11 +1557,6 @@ def parseCmdLine(): help='replace the account in batinpfile)', type=str, default='None' ) - #p_setup.add_argument( - # '--ForceReuseDir', - # help='force re-use existing exp dir', - # action='store_true', - # ) spltgrp = p_setup.add_mutually_exclusive_group() spltgrp.add_argument( '--daysperjob', diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index 1a2ce3cb..07748581 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -41,12 +41,12 @@ setenv RUN_CMD "$GEOSBIN/esma_mpirun -np " # Experiment Specific Environment Variables ####################################################################### -setenv HOMDIR $EXPDIR/run/ -setenv SCRDIR $EXPDIR/scratch -setenv MODEL MY_MODEL -@ NENS = MY_ENSEMBLE -setenv MYNAME `finger $USER | cut -d: -f3 | head -1` -setenv NODAILIES MY_MONTHLY +setenv HOMDIR $EXPDIR/run/ +setenv SCRDIR $EXPDIR/scratch +setenv MODEL MY_MODEL +@ NENS = MY_ENSEMBLE +setenv MYNAME `finger $USER | cut -d: -f3 | head -1` +setenv POSTPROC_HIST MY_POSTPROC_HIST # # DEBUGGER : 0 -- no debugger @@ -308,7 +308,34 @@ while ( $counter <= ${NUM_SGMT} ) ####################################################################### - # Move HISTORY Files to cat/ens Directory + # Move Legacy LDASsa Files to ana/ens_avg Directory + ####################################################################### + + # must be done before moving HISTORY files + + set ObsFcses = `ls *.ldas_ObsFcstAna.*.bin` + foreach obsfcs ( $ObsFcses ) + set ThisTime = `echo $obsfcs | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/ana/ens_avg/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $obsfcs ${THISDIR}$obsfcs + end + + set smapL4s = `ls *.ldas_tile_inst_smapL4SMaup.*.bin` + foreach smapl4 ( $smapL4s ) + set ThisTime = `echo $smapl4 | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/ana/ens_avg/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $smapl4 ${THISDIR}$smapl4 + end + + + ####################################################################### + # Move HISTORY Files to cat/ens Directory ####################################################################### set outfiles = `ls $EXPID.*[bin,nc4]` @@ -367,11 +394,12 @@ while ( $counter <= ${NUM_SGMT} ) done: ####################################################################### - # (1) Concatenating Sub-daily Files to Daily Files - # (2) Write monthly means + # Post-Process model diagnostic output + # (1) Concatenate sub-daily files to daily files + # (2) Write monthly means ####################################################################### - if ($NODAILIES > 0) then + if ($POSTPROC_HIST > 0) then set PWD = `pwd` @@ -399,13 +427,26 @@ while ( $counter <= ${NUM_SGMT} ) # create daily and remove the sub-daily # ------------------------------------------------------------------ set day=1 - while ($day <= $NDAYS && $LEN_SUB > 1) + while ($day <= $NDAYS) if ( $day < 10 ) set DD=0${day} if ( $day >= 10 ) set DD=${day} @ day++ set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | rev` set LEN_SUB = `echo $#time_steps` + + # no file or just one file? nothing to concatenate, move on to the next collection if ($LEN_SUB <= 1) continue + + # check if day is complete (get HISTORY time step from first two files) + set hour1 = `echo $time_steps[1] | cut -c10-11` + set min1 = `echo $time_steps[1] | cut -c12-13` + set hour2 = `echo $time_steps[2] | cut -c10-11` + set min2 = `echo $time_steps[2] | cut -c12-13` + @ dt_hist = ($hour2 - $hour1) * 60 + ($min2 - $min1) + @ N_per_day = (24 * 60) / $dt_hist + # not enough sub-daily files? move on to the next collection + if($LEN_SUB < $N_per_day) continue + set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" # ---------------------------------------------------------------------------- @@ -434,55 +475,67 @@ EOF ncks -4 -h -v time_stamp timestamp.nc4 -A ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 /bin/rm timestamp.cdl /bin/rm timestamp.nc4 - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 - + # rudimentary check for desired nc4 file; if ok, delete sub-daily files + if ( -f ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 ) then + if ( ! -z ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 ) then + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 + endif + endif end # concatenate for each day - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | rev` - set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" - set LEN = `echo $#time_steps` - # no file? move on - if ($LEN == 0) continue - - set dayl = `echo $time_steps[$LEN] | cut -c1-8` - set day1 = `echo $time_steps[1] | cut -c1-8` - @ NAVAIL = ($dayl - $day1) + 1 - - # not enough days? move on to the next collection + + # write monthly mean file and (optionally) remove daily files + # ------------------------------------------------------------------ + + # NOTE: Collections written with daily frequency ("tavg24" and "inst24") have not + # been concatenated into daily files. There are two possibilities for the + # time stamps of files to be averaged: + # *.YYYYMMDD.* daily files from concatenation of sub-daily files + # *.YYYYMMDD_HHMM.* daily (avg or inst) files written directly by HISTORY.rc + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}??.* | rev | cut -d'.' -f2 | rev` + set time_steps_ = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}??_* | rev | cut -d'.' -f2 | cut -d'_' -f2 | rev` + set LEN = `echo $#time_steps` + set LEN_ = `echo $#time_steps_` + + # check if month is complete + if ($LEN != 0) then + set dayl = `echo $time_steps[$LEN] | cut -c1-8` + set day1 = `echo $time_steps[1] | cut -c1-8` + @ NAVAIL = ($dayl - $day1) + 1 + else if( $LEN_ !=0 ) then + set dayl = `echo $time_steps_[$LEN] | cut -c1-8` + set day1 = `echo $time_steps_[1] | cut -c1-8` + @ NAVAIL = ($dayl - $day1) + 1 + else + @ NAVAIL = 0 + endif + + # not enough days for monthly mean? move on to the next collection if($NAVAIL != $NDAYS) continue - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}01* | rev | cut -d'.' -f2 | rev` - set LEN_SUB = `echo $#time_steps` - @ LEN_AVAIL = $LEN_SUB * $NDAYS - - # not enough sub-daylies? move on to the next collection - if ($LEN != $LEN_AVAIL) continue - - # create the monly average - #ncrcat -h $EXPID.$ThisCol.${YYYY}${MM}* ${EXPID}.${ThisCol}.$YYYY$MM.nc4 - #ncra -h $EXPID.${ThisCol}.$YYYY$MM.nc4 $EXPID.${ThisCol}.monthly.$YYYY$MM.nc4 + # create monthly-mean nc4 file + ncra -h $EXPID.$ThisCol.${YYYY}${MM}*.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 - #/bin/rm $EXPID.${ThisCol}.$YYYY$MM.nc4 - ncra -h $EXPID.$ThisCol.${YYYY}${MM}??.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 - - # don't want a daily? delete the daily and sub-dailies and continue - # - if($NODAILIES == 2) then - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* + if($POSTPROC_HIST == 2) then + # rudimentary check for desired nc4 file; if ok, delete daily files + if ( -f ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 ) then + if ( ! -z ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 ) then + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* + endif + endif continue endif end # each collection end # each month cd $PWD - endif # dailies > 0 + endif # POSTPROC_HIST > 0 ####################################################################### # Rename Final Checkpoints => Restarts for Next Segment and Archive # Note: cap_restart contains the current NYMD and NHMS ####################################################################### - set edate = e`cat cap_restart | cut -c1-8`_`cat cap_restart | cut -c10-11`z set eYEAR = `cat cap_restart | cut -c1-4` set eMON = `cat cap_restart | cut -c5-6` set eDAY = `cat cap_restart | cut -c7-8` @@ -568,45 +621,36 @@ EOF set rstfiles2 = `ls landpert${ENSID}_internal_checkpoint.*` set rstfiles3 = `ls landassim_obspertrseed${ENSID}_checkpoint.*` - set NFILES = `echo $#rstfiles1` - if($NFILES > 0) then - foreach rfile ( $rstfiles1 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR - /bin/mv $rfile ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 - /usr/bin/gzip ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 & - end - endif + foreach rfile ( $rstfiles1 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $rfile ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 + /usr/bin/gzip ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 & + end - set NFILES = `echo $#rstfiles2` - if($NFILES > 0) then - foreach rfile ( $rstfiles2 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR + foreach rfile ( $rstfiles2 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR (ncks -4 -O -C -x -v lat,lon $rfile ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4;\ /usr/bin/gzip ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4; \ /bin/rm -f $rfile) & - end - endif + end - set NFILES = `echo $#rstfiles3` - if($NFILES > 0) then - foreach rfile ( $rstfiles3 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR + foreach rfile ( $rstfiles3 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR /bin/mv $rfile ${THISDIR}${EXPID}.landassim_obspertrseed_rst.${ThisTime}.nc4 - end - endif - + end + @ inens ++ end ## end of while ($inens < $NENS) wait @@ -635,7 +679,7 @@ EOF /bin/cp cap_restart $HOMDIR/cap_restart ####################################################################### - # Update Iteration Counter + # Update Iteration Counter ####################################################################### set enddate = `echo $END_DATE | cut -c1-8` @@ -651,7 +695,7 @@ EOF end ####################################################################### -# set next log and error file +# Set Next Log and Error Files ####################################################################### set logfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${logYEAR}/M${logMON}/${EXPID}.ldas_log.${logYEAR}${logMON}${logDAY}_${logHour}${logMin}z.txt @@ -668,7 +712,7 @@ if(-f GEOSldas_err_txt) then endif ####################################################################### -# Re-Submit Job +# Re-Submit Job ####################################################################### if ( $rc == 0 ) then diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 8171142f..b0e7636b 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -31,9 +31,6 @@ module GEOS_LandAssimGridCompMod use LDAS_ensdrv_mpi, only: MPI_obs_param_type use LDAS_DateTimeMod,ONLY: date_time_type - use LDAS_ensdrv_functions, ONLY: & - get_io_filename - use LDAS_ensdrv_init_routines, only : GEOS_read_catparam use LDAS_ensdrv_Globals, only: logunit use LDAS_ConvertMod, ONLY: esmf2ldas @@ -90,6 +87,7 @@ module GEOS_LandAssimGridCompMod integer :: update_type, dtstep_assim logical :: centered_update real :: xcompact, ycompact +real :: fcsterr_inflation_fac integer :: N_obs_param logical :: out_obslog logical :: out_ObsFcstAna @@ -1108,12 +1106,11 @@ subroutine Initialize(gc, import, export, clock, rc) dtstep_assim, & centered_update, & xcompact, ycompact, & + fcsterr_inflation_fac, & N_obs_param, & obs_param, & out_obslog, & out_ObsFcstAna, & -! out_incr, & -! out_incr_format, & out_smapL4SMaup, & N_obsbias_max & ) @@ -1128,11 +1125,10 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_BCAST(centered_update, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(xcompact, 1, MPI_REAL, 0,MPICOMM,mpierr) call MPI_BCAST(ycompact, 1, MPI_REAL, 0,MPICOMM,mpierr) + call MPI_BCAST(fcsterr_inflation_fac, 1, MPI_REAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obs_param, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(out_obslog, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(out_ObsFcstAna, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) -! call MPI_BCAST(out_incr, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) -! call MPI_BCAST(out_incr_format, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr) @@ -1703,7 +1699,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & update_type, & dtstep_assim, centered_update, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & N_obs_param, obs_param, N_obsbias_max, & out_obslog, out_smapL4SMaup, & cat_progn, & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 index 700226e7..080246f2 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 @@ -11,84 +11,30 @@ module clsm_ensdrv_drv_routines ! - optimized restart-to-exp-domain mapping in initialize_model() ! reichle, 5 Apr 2013 - revised treatment of output collections - use LDAS_ensdrv_globals, ONLY: & - logunit, & - logit, & - nodata_generic, & - nodata_tol_generic - use catch_constants, ONLY: & N_snow => CATCH_N_SNOW, & N_gt => CATCH_N_GT - use catch_incr, ONLY: & + use catch_incr, ONLY: & check_catch_progn - use MAPL_ConstantsMod, ONLY: & - stefan_boltzmann => MAPL_STFBOL, & - alhe => MAPL_ALHL, & - alhs => MAPL_ALHS, & - alhm => MAPL_ALHF, & - Tzero => MAPL_TICE - - use LDAS_DriverTypes, ONLY: & - met_force_type, & - veg_param_type, & - alb_param_type, & - bal_diagn_type, & - assignment (=), & - operator (+), & - operator (*) - use catch_types, ONLY: & cat_param_type, & - cat_progn_type, & - cat_diagS_type, & - cat_diagF_type, & - catprogn2wesn, & - catprogn2htsn, & - catprogn2ghtcnt - - use LDAS_DateTimeMod, ONLY: & - date_time_type, & - datetime2_minus_datetime1 + cat_progn_type use LDAS_ensdrv_mpi, ONLY: & - mpicomm, & + mpicomm, & mpierr, & numprocs, & master_proc - use catchment_model, ONLY: & - catch_calc_tsurf, & - catch_calc_etotl - - use lsm_routines, ONLY: & - catch_calc_soil_moist, & - catch_calc_tp, & - catch_calc_wtotl - - use StieglitzSnow, ONLY: & - StieglitzSnow_calc_asnow, & - StieglitzSnow_calc_tpsnow - - use LDAS_ExceptionsMod, ONLY: & - ldas_abort, & - LDAS_GENERIC_ERROR - implicit none include 'mpif.h' private - public :: spin_stuff public :: check_cat_progn - public :: recompute_diagS -!! public :: interpolate_to_timestep -!! public :: zenith - public :: remove_snow - public :: balance_calcs public :: l2f_real public :: f2l_real public :: f2l_real8 @@ -101,70 +47,6 @@ module clsm_ensdrv_drv_routines ! ******************************************************************** - subroutine spin_stuff( start_time, end_time, N_ens, N_force_pert, N_progn_pert, & - spin_loop, restart ) - - implicit none - - type(date_time_type), intent(in) :: start_time, end_time - - integer, intent(in) :: N_ens, N_force_pert, N_progn_pert - - integer, intent(inout) :: spin_loop - - logical, intent(inout) :: restart - - ! local - character(len=*), parameter :: Iam = 'spin_stuff' - character(len=400) :: err_msg - - ! ------------------------------------------------------------------ - - ! consistency checks - - ! make sure end time is exactly n years after start time - - if ( start_time%month /= end_time%month .or. & - start_time%day /= end_time%day .or. & - start_time%hour /= end_time%hour .or. & - start_time%min /= end_time%min .or. & - start_time%sec /= end_time%sec ) then - err_msg = 'spin up only for full years' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! do not allow N_ens>1 during spin-up - - if ((N_ens>1) .or. (N_force_pert>1) .or. (N_progn_pert>1)) then - err_msg = 'spin-up only for N_ens=1 and N_force_pert=N_progn_pert=0' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! use restart files - - if (spin_loop==0) then - - restart = .false. - - else - - restart = .true. - - end if - - ! augment counter for spin years - - spin_loop = spin_loop + 1 - - ! echo spin_loop - - if (logit) write (logunit,*) - if (logit) write (logunit,*) 'at beginning of spin_loop ', spin_loop - - end subroutine spin_stuff - - ! ********************************************************************* - subroutine check_cat_progn( N_cat, cat_param, cat_progn ) ! wrapper for subroutine check_catch_progn() which has been @@ -240,737 +122,8 @@ subroutine check_cat_progn( N_cat, cat_param, cat_progn ) end subroutine check_cat_progn - ! ********************************************************************* - - subroutine recompute_diagS( N_catd, cat_param, cat_progn, cat_diagS ) - - ! replace cat_diagS with updated diagnostics - ! - ! typically call after prognostics perturbations, EnKF update, and/or cat - ! bias correction - ! - ! IMPORTANT: cat_progn is intent(inout) because srfexc, rzexc, and catdef - ! fields *might* be changed! Such changes can be prevented by first calling - ! subroutine check_cat_progn(). - ! - ! reichle, 20 Oct 2004 - ! reichle, 14 Feb 2013 - added recomputation of soil temperature - ! reichle, 30 Oct 2013 - moved from clsm_ensupd_upd_routines.F90 - ! - removed dependency on "update_type" - ! - added recompute of snow diagnostics - - integer, intent(in) :: N_catd - - ! note: cat_progn must be "inout" because call to calc_soil_moist - ! might reset inconsistent sets of srfexc, rzexc, catdef - - type(cat_param_type), dimension(N_catd), intent(in) :: cat_param - type(cat_progn_type), dimension(N_catd), intent(inout) :: cat_progn - type(cat_diagS_type), dimension(N_catd), intent(inout) :: cat_diagS - - ! local variables - - integer :: i - - real, dimension( N_catd) :: ar4, fices - - real, dimension(N_gt,N_catd) :: tp - - ! ------------------------------------------------------------------ - - ! update soil moisture diagnostics - - ! note that the call to calc_soil_moist resets srfexc, rzexc, and - ! catdef if they are not consistent! - - ! updated to new interface - reichle, 3 Apr 2012 - - call catch_calc_soil_moist( & - N_catd, & - cat_param%vegcls, cat_param%dzsf, cat_param%vgwmax, & - cat_param%cdcr1, cat_param%cdcr2, cat_param%psis, & - cat_param%bee, cat_param%poros, cat_param%wpwet, & - cat_param%ars1, cat_param%ars2, cat_param%ars3, & - cat_param%ara1, cat_param%ara2, cat_param%ara3, & - cat_param%ara4, cat_param%arw1, cat_param%arw2, & - cat_param%arw3, cat_param%arw4, & - cat_progn%srfexc, cat_progn%rzexc, cat_progn%catdef, & - cat_diagS%ar1, cat_diagS%ar2, ar4, & - cat_diagS%sfmc, cat_diagS%rzmc, cat_diagS%prmc) - - - ! update snow cover fraction and snow temperatures - - call StieglitzSnow_calc_asnow( & - N_snow, N_catd, catprogn2wesn(N_catd,cat_progn), cat_diagS%asnow ) - - do i=1,N_snow - - call StieglitzSnow_calc_tpsnow( N_catd, & - cat_progn(1:N_catd)%htsn(i), & - cat_progn(1:N_catd)%wesn(i), & - cat_diagS(1:N_catd)%tpsn(i), & - fices ) - - cat_diagS%tpsn(i) = cat_diagS%tpsn(i) + Tzero ! convert to Kelvin - - end do - - ! update surface temperature - - ! updated to new interface, - ! need ar1, ar2, ar4 from call to catch_calc_soil_moist() above - ! - reichle, 3 Apr 2012 - - call catch_calc_tsurf( N_catd, & - cat_progn%tc1, cat_progn%tc2, cat_progn%tc4, & - catprogn2wesn(N_catd,cat_progn), & - catprogn2htsn(N_catd,cat_progn), & - cat_diagS%ar1, cat_diagS%ar2, ar4, & - cat_diagS%tsurf ) - - ! update soil temperature - - ! NOTE: "tp" is returned in CELSIUS [for consistency w/ catchment.F90] - - call catch_calc_tp( N_catd, cat_param%poros, & - catprogn2ghtcnt(N_catd,cat_progn), tp ) - - do i=1,N_gt - - cat_diagS(:)%tp(i) = tp(i,:) - - end do - - end subroutine recompute_diagS - - ! ******************************************************************** - - ! ****************************************************************** - -!! subroutine interpolate_to_timestep( & -!! N_catd, vegcls, lat, lon, zenav, date_time_new, & -!! force_time_old, force_dtstep, & -!! grn_time_old, grn_time_new, & -!! lai_time_old, lai_time_new, & -!! alb_time_old, alb_time_new, & -!! mf_old, mf_new, & -!! veg_param_old, veg_param_new, & -!! alb_param_old, alb_param_new, & -!! mf_ntp, sunang_ntp, veg_param_ntp, alb_param_ntp ) -!! -!! ! Interpolates the forcing, vegetation and albedo data to current timestep. -!! ! -!! ! date_time_new = date_time at end of model integration time step -!! ! -!! ! "mf" = "met_force" -!! ! -!! ! "mf_old" = at old forcing time -!! ! "mf_new" = at new forcing time -!! ! "mf_ntp" = at current ("interpolated") time -!! ! -!! ! NOTE: time avg radiative fluxes for the interval between "old" -!! ! and "new" time must be stored in mf_old -!! ! -!! ! reichle, 14 May 2003 -!! ! reichle, 11 Sep 2007 - albedo changes -!! ! reichle, 23 Feb 2009 - add ParDrct, ParDffs from MERRA forcing -!! ! reichle, 6 Mar 2009 - added fractional day-of-year (fdofyr) for monthly interp -!! ! - deleted ParDrct, ParDffs after testing found no impact -!! ! reichle, 20 Dec 2011 - reinstated "PARdrct", "PARdffs" for MERRA-Land file specs -!! ! - cleanup -!! ! reichle, 26 Jul 2013 - revised GRN, LAI and albedo scaling parameter inputs -!! -!! implicit none -!! -!! integer, intent(in) :: N_catd -!! -!! integer, dimension(N_catd), intent(in) :: vegcls -!! -!! real, dimension(N_catd), intent(in) :: lat, lon, zenav -!! -!! type(date_time_type), intent(in) :: date_time_new -!! type(date_time_type), intent(in) :: force_time_old -!! -!! integer, intent(in) :: force_dtstep -!! -!! type(date_time_type), intent(in) :: grn_time_old, grn_time_new -!! type(date_time_type), intent(in) :: lai_time_old, lai_time_new -!! type(date_time_type), intent(in) :: alb_time_old, alb_time_new -!! -!! type(met_force_type), dimension(N_catd), intent(in) :: mf_old -!! type(met_force_type), dimension(N_catd), intent(in) :: mf_new -!! -!! type(veg_param_type), dimension(N_catd), intent(in) :: veg_param_old -!! type(veg_param_type), dimension(N_catd), intent(in) :: veg_param_new -!! -!! type(alb_param_type), dimension(N_catd), intent(in) :: alb_param_old -!! type(alb_param_type), dimension(N_catd), intent(in) :: alb_param_new -!! -!! type(met_force_type), dimension(N_catd), intent(out) :: mf_ntp -!! -!! real, dimension(N_catd), intent(out) :: sunang_ntp -!! -!! type(veg_param_type), dimension(N_catd), intent(out) :: veg_param_ntp -!! -!! type(alb_param_type), dimension(N_catd), intent(out) :: alb_param_ntp -!! -!! ! ---------------- -!! -!! ! local variables -!! -!! real, parameter :: min_grn = 0.0001 ! per GEOS_CatchGridComp.F90 (Ganymed-4_0) -!! real, parameter :: min_lai = 0.0001 ! per GEOS_CatchGridComp.F90 (Ganymed-4_0) -!! real, parameter :: min_zth = 0.01 ! per testing Feb 2009 (see below) -!! -!! integer :: n, secs_since_old, secs_in_day -!! -!! real :: zth, slr, w, w_old, w_new, tmpreal -!! -!! character(len=*), parameter :: Iam = 'interpolate_to_timestep' -!! -!! ! ------------------------------------------------------------ -!! ! -!! ! met forcing interpolation -!! ! -!! ! get secs_in_day from hh:mm:ss -!! -!! secs_in_day = date_time_new%hour*3600 + date_time_new%min*60 & -!! + date_time_new%sec -!! -!! ! weight for forcing "states" interpolation -!! ! (temperature, humidity, pressure, wind) -!! -!! secs_since_old = datetime2_minus_datetime1( force_time_old, date_time_new ) -!! -!! ! use integer division such that w changes from 0. to 1. -!! ! halfway through the current forcing interval, that is, -!! ! -!! ! w = 0. if secs_since_old < force_dtstep/2 -!! ! w = 0.5 if secs_since_old == force_dtstep/2 -!! ! w = 1. if force_dtstep/2 < secs_since_old <= force_dtstep -!! ! -!! ! For example, using 15 min model time steps and hourly forcing, -!! ! the time interpolation weights are as follows: -!! ! -!! ! secs_since_old: 900 1800 2700 3600 -!! ! w: 0. 0.5 1. 1. -!! ! -!! ! Note that w=0.5 for secs_since_old==force_dtstep/2 (at the mid-point). -!! -!! if (secs_since_old==force_dtstep/2) then -!! -!! w = 0.5 -!! -!! else -!! -!! w = real( (secs_since_old-1)/(force_dtstep/2) ) -!! -!! end if -!! -!! ! --------------------- -!! -!! do n=1,N_catd -!! -!! ! initialize -!! -!! mf_ntp(n) = nodata_generic -!! -!! ! STATES -!! ! -!! ! temperature, humidity, pressure and wind -!! -!! mf_ntp(n)%Tair = (1.-w)*mf_old(n)%Tair + w*mf_new(n)%Tair -!! mf_ntp(n)%Qair = (1.-w)*mf_old(n)%Qair + w*mf_new(n)%Qair -!! mf_ntp(n)%Psurf = (1.-w)*mf_old(n)%Psurf + w*mf_new(n)%Psurf -!! mf_ntp(n)%RefH = (1.-w)*mf_old(n)%RefH + w*mf_new(n)%RefH -!! -!! ! Wind -!! -!! ! LDASsa CVS tags between reichle-LDASsa_m2-10 and reichle-LDASsa_m2-13_p2 -!! ! worked with *inst*lfo* and *tavg*lfo* G5DAS forcing (as opposed to just -!! ! *tavg*lfo* from MERRA) and G5DAS Wind was read from *inst*lfo* files. -!! ! But for G5DAS forcing (as for MERRA), Wind was treated as a time-average -!! ! field, which implied that, e.g., the instantaneous G5DAS Wind at 0z was -!! ! used to force the land at 0:20z, 0:40z, and 1z. -!! ! In these tags, Wind was treated as a time-average field whenever -!! ! force_dtstep<=3601, which included MERRA, G5DAS, RedArk, and CONUS -!! ! forcing. -!! ! To make things more consistent for G5DAS winds, the "if" statement now -!! ! checks whether Wind at date_time_new is available (which is true G5DAS -!! ! and false for MERRA). The revised "if" statement does not change how -!! ! Wind is interpolated in MERRA (because Wind is unavailable at date_time_new) -!! ! and in GLDAS, Princeton, and GWSP (because force_dtstep>3601). -!! ! The revised "if" statement does change how CONUS and RedArk Wind data -!! ! are interpolated (now treated as instantaneous, previously treated as -!! ! time-average). -!! ! In summary, as of this change, Wind is treated as instantaneous for all -!! ! forcing data *except* MERRA. -!! ! -!! ! - reichle, 31 Jan 2014 -!! -!! ! if (force_dtstep_real > 3601.) then -!! if (abs(mf_new(n)%Wind-nodata_generic)>nodata_tol_generic) then -!! -!! ! treat Wind as instantaneous fields (all forcing data sets *except* MERRA) -!! -!! mf_ntp(n)%Wind = (1.-w)*mf_old(n)%Wind + w*mf_new(n)%Wind -!! -!! else -!! -!! ! treat Wind as time-average fields (MERRA) -!! -!! mf_ntp(n)%Wind = mf_old(n)%Wind -!! -!! end if -!! -!! ! FLUXES -!! -!! ! precipitation -!! -!! mf_ntp(n)%Rainf_C = mf_old(n)%Rainf_C -!! mf_ntp(n)%Rainf = mf_old(n)%Rainf -!! mf_ntp(n)%Snowf = mf_old(n)%Snowf -!! -!! ! incoming radiation -!! -!! mf_ntp(n)%LWdown = mf_old(n)%LWdown -!! -!! call solar(lon(n),lat(n),date_time_new%dofyr,secs_in_day,zth,slr) -!! -!! ! changed min sun-angle from 0.01 to 0.0001 for consistency with CatchGridComp -!! ! reichle, 23 Feb 2009 -!! ! changed min sun-angle back to 0.01 after testing -!! ! reichle, 27 Feb 2009 -!! -!! sunang_ntp(n) = max(zth, min_zth) -!! -!! ! changed minimum SWdown to 0. from 0.00001 - reichle, 28 Aug 2008 -!! -!! if (zth > 0.) then -!! -!! if (zenav(n) <= 0.) then -!! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'Problem with solar') -!! end if -!! -!! tmpreal = zth/zenav(n) -!! -!! mf_ntp(n)%SWdown = mf_old(n)%SWdown*tmpreal -!! -!! ! mf_ntp%SWnet only used if mf_old%SWnet is not no-data value; -!! ! protect multiplication for any no-data-value because it could -!! ! fail (floating point excess) if huge number is used as nodata value -!! -!! if(abs(mf_old(n)%SWnet -nodata_generic)>nodata_tol_generic) & -!! mf_ntp(n)%SWnet = mf_old(n)%SWnet*tmpreal -!! -!! if(abs(mf_old(n)%PARdrct-nodata_generic)>nodata_tol_generic) then -!! -!! ! assume that PARdffs is available whenever PARdrct is -!! -!! mf_ntp(n)%PARdrct = mf_old(n)%PARdrct*tmpreal -!! mf_ntp(n)%PARdffs = mf_old(n)%PARdffs*tmpreal -!! -!! end if -!! -!! elseif ((zth <= 0.) .and. (zenav(n) <= 0.)) then -!! -!! mf_ntp(n)%SWdown = max(0., mf_old(n)%SWdown) -!! mf_ntp(n)%SWnet = max(0., mf_old(n)%SWnet) ! no-data handling done below -!! mf_ntp(n)%PARdrct = max(0., mf_old(n)%PARdrct) ! no-data handling done below -!! mf_ntp(n)%PARdffs = max(0., mf_old(n)%PARdffs) ! no-data handling done below -!! -!! else -!! -!! mf_ntp(n)%SWdown = 0. -!! mf_ntp(n)%SWnet = 0. ! no-data handling done below -!! mf_ntp(n)%PARdrct = 0. ! no-data handling done below -!! mf_ntp(n)%PARdffs = 0. ! no-data handling done below -!! -!! end if -!! -!! ! cap shortwave radiation at (cosine of) sun angle times solar constant -!! ! reichle, 14 Aug 2002 -!! -!! mf_ntp(n)%SWdown = min( mf_ntp(n)%SWdown, 1360.*sunang_ntp(n) ) -!! -!! ! cap SWnet at SWdown -!! -!! mf_ntp(n)%SWnet = min( mf_ntp(n)%SWnet, mf_ntp(n)%SWdown ) -!! -!! ! reinstate no-data-values -!! -!! if(abs(mf_old(n)%SWnet-nodata_generic) CATCH_N_SNOW, & - N_gt => CATCH_N_GT - - use MAPL_ConstantsMod, ONLY: & - alhe => MAPL_ALHL, & - alhs => MAPL_ALHS, & - Tzero => MAPL_TICE - - use LDAS_DriverTypes, ONLY: & - met_force_type, & - veg_param_type, & - bal_diagn_type, & - out_choice_type, & - out_choice_time_type, & - out_dtstep_type, & - assignment (=), & - operator (+), & - operator (/) - use catch_types, ONLY: & cat_param_type, & - cat_progn_type, & - cat_diagS_type, & - cat_diagF_type, & assignment (=), & operator (+), & operator (/) - use LDAS_TileCoordType, ONLY: & - tile_coord_type, & - grid_def_type, & - io_grid_def_type + use LDAS_TileCoordType, ONLY: & + tile_coord_type use mwRTM_types, ONLY: & - mwRTM_param_type, & - io_mwRTM_param_type - - use mwRTM_routines, ONLY: & - catch2mwRTM_vars, & - mwRTM_get_Tb + mwRTM_param_type use LDAS_ensdrv_mpi, ONLY: & master_proc, & numprocs - use LDAS_DateTimeMod, ONLY: & - date_time_type, & - is_leap_year, & - days_in_month, & - datetime_eq_refdatetime, & - augment_date_time + use LDAS_DateTimeMod, ONLY: & + date_time_type - use clsm_ensdrv_drv_routines, ONLY: & - l2f_real - use LDAS_ensdrv_init_routines, ONLY: & clsm_ensdrv_get_command_line, & add_domain_to_path @@ -79,10 +39,7 @@ module clsm_ensdrv_out_routines use LDAS_ensdrv_functions, ONLY: & get_io_filename - use LDAS_TileCoordRoutines, ONLY: & - tile2grid - - use LDAS_ExceptionsMod, ONLY: & + use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -93,15 +50,7 @@ module clsm_ensdrv_out_routines private public :: init_log - public :: output_catparam - public :: output_mwRTMparam - public :: output_smapL4SMlmc public :: GEOS_output_smapL4SMlmc - public :: output_calcs - public :: output_write - public :: get_ensstd_filenames - public :: check_output_times - public :: get_land_mask_ij contains @@ -249,288 +198,6 @@ end subroutine init_log ! ******************************************************************** - subroutine output_catparam( date_time, work_path, exp_id, N_catd, cat_param ) - - ! writes cat_param for domain to file - ! - ! reichle, 21 Jan 2004 - ! - ! ------------------------------------------------------------------- - - implicit none - - type(date_time_type), intent(in) :: date_time - - character(200), intent(in) :: work_path - - character(40), intent(in) :: exp_id - - integer, intent(in) :: N_catd - - type(cat_param_type), dimension(N_catd), intent(in) :: cat_param - - ! ---------------------------- - - ! local variables - - character(300) :: fname - character( 40) :: file_tag, dir_name - - integer :: n, k - - ! ------------------------------------------------------------------ - - file_tag = 'ldas_catparam' - dir_name = 'rc_out' - - fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & - dir_name=dir_name ) - - open(10, file=fname, form='unformatted', status='unknown', action='write') - - if (logit) write (logunit,'(400A)') 'Writing catparam file ' // trim(fname) - - write (10) (cat_param(n)%dpth, n=1,N_catd) - - write (10) (cat_param(n)%dzsf, n=1,N_catd) - write (10) (cat_param(n)%dzrz, n=1,N_catd) - write (10) (cat_param(n)%dzpr, n=1,N_catd) - - do k=1,N_gt - write (10) (cat_param(n)%dzgt(k), n=1,N_catd) - end do - - write (10) (cat_param(n)%poros, n=1,N_catd) - write (10) (cat_param(n)%cond, n=1,N_catd) - write (10) (cat_param(n)%psis, n=1,N_catd) - write (10) (cat_param(n)%bee, n=1,N_catd) - - write (10) (cat_param(n)%wpwet, n=1,N_catd) - - write (10) (cat_param(n)%gnu, n=1,N_catd) - - write (10) (cat_param(n)%vgwmax, n=1,N_catd) - - write (10) (cat_param(n)%vegcls, n=1,N_catd) - write (10) (cat_param(n)%soilcls30, n=1,N_catd) - write (10) (cat_param(n)%soilcls100, n=1,N_catd) - - write (10) (cat_param(n)%bf1, n=1,N_catd) - write (10) (cat_param(n)%bf2, n=1,N_catd) - write (10) (cat_param(n)%bf3, n=1,N_catd) - write (10) (cat_param(n)%cdcr1, n=1,N_catd) - write (10) (cat_param(n)%cdcr2, n=1,N_catd) - write (10) (cat_param(n)%ars1, n=1,N_catd) - write (10) (cat_param(n)%ars2, n=1,N_catd) - write (10) (cat_param(n)%ars3, n=1,N_catd) - write (10) (cat_param(n)%ara1, n=1,N_catd) - write (10) (cat_param(n)%ara2, n=1,N_catd) - write (10) (cat_param(n)%ara3, n=1,N_catd) - write (10) (cat_param(n)%ara4, n=1,N_catd) - write (10) (cat_param(n)%arw1, n=1,N_catd) - write (10) (cat_param(n)%arw2, n=1,N_catd) - write (10) (cat_param(n)%arw3, n=1,N_catd) - write (10) (cat_param(n)%arw4, n=1,N_catd) - write (10) (cat_param(n)%tsa1, n=1,N_catd) - write (10) (cat_param(n)%tsa2, n=1,N_catd) - write (10) (cat_param(n)%tsb1, n=1,N_catd) - write (10) (cat_param(n)%tsb2, n=1,N_catd) - write (10) (cat_param(n)%atau, n=1,N_catd) - write (10) (cat_param(n)%btau, n=1,N_catd) - - write (10) (cat_param(n)%gravel30, n=1,N_catd) - write (10) (cat_param(n)%orgC30 , n=1,N_catd) - write (10) (cat_param(n)%orgC , n=1,N_catd) - write (10) (cat_param(n)%sand30 , n=1,N_catd) - write (10) (cat_param(n)%clay30 , n=1,N_catd) - write (10) (cat_param(n)%sand , n=1,N_catd) - write (10) (cat_param(n)%clay , n=1,N_catd) - write (10) (cat_param(n)%wpwet30 , n=1,N_catd) - write (10) (cat_param(n)%poros30 , n=1,N_catd) - - write (10) (cat_param(n)%veghght , n=1,N_catd) - - close (10,status='keep') - - if (logit) write (logunit,*) 'done writing' - if (logit) write (logunit,*) - - end subroutine output_catparam - - ! ******************************************************************** - - subroutine output_mwRTMparam( date_time, work_path, exp_id, N_catd, mwRTM_param ) - - ! writes mwRTM_param for domain to file - ! - ! reichle, 1 Jun 2011 - ! - ! ------------------------------------------------------------------- - - implicit none - - type(date_time_type), intent(in ) :: date_time - - character(200), intent(in ) :: work_path - - character(40), intent(in ) :: exp_id - - integer, intent(in ) :: N_catd - - type(mwRTM_param_type), dimension(N_catd), intent(inout) :: mwRTM_param - - ! ---------------------------- - - ! local variables - - character(300) :: fname - character( 40) :: file_tag, dir_name - - ! ------------------------------------------------------------------ - - file_tag = 'ldas_mwRTMparam' - dir_name = 'rc_out' - - fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & - dir_name=dir_name ) - - open(10, file=fname, form='unformatted', status='unknown', action='write') - - if (logit) write (logunit,'(400A)') 'Writing mwRTMparam file ' // trim(fname) - - call io_mwRTM_param_type( 'w', 10, N_catd, mwRTM_param ) - - close (10,status='keep') - - if (logit) write (logunit,*) 'done writing' - if (logit) write (logunit,*) - - end subroutine output_mwRTMparam - - ! ******************************************************************** - - subroutine output_smapL4SMlmc( date_time, work_path, exp_id, & - N_catf, tile_coord, cat_param, mwRTM_param ) - - ! write SMAP L4_SM "lmc" (land model constants) file collection - ! as binary, tile-space output - ! - ! requires "full" domain inputs - ! - ! reichle, 26 Apr 2012 - ! reichle, 27 May 2014: - changed wilting point output from "clsm_wpwet" to "clsm_wp" - ! - ! ------------------------------------------------------------------- - - implicit none - - type(date_time_type), intent(in) :: date_time - - character(200), intent(in) :: work_path - - character(40), intent(in) :: exp_id - - integer, intent(in) :: N_catf - - type(tile_coord_type), dimension(N_catf), intent(in) :: tile_coord - - type(cat_param_type), dimension(N_catf), intent(in) :: cat_param - - type(mwRTM_param_type), dimension(N_catf), intent(in) :: mwRTM_param - - ! ---------------------------- - - ! local variables - - character(300) :: fname - character( 40) :: file_tag, dir_name - - integer :: n - - real, dimension(N_catf) :: dztsurf, clsm_wp - - ! ------------------------------------------------------------------ - ! - ! compute dztsurf - - dztsurf = 0.05 ! now 0.05 m everywhere due to revised CSOIL_2 in subroutine catchment() - - ! convert wilting point from wetness units to volumetric units - - clsm_wp = cat_param%wpwet * cat_param%poros - - ! ------------------- - - file_tag = 'ldas_smapL4SMlmc' - dir_name = 'rc_out' - - fname = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, dir_name=dir_name ) - - open(10, file=fname, form='unformatted', status='unknown', action='write') - - if (logit) write (logunit,'(400A)') 'Writing SMAP L4_SM lmc file ' // trim(fname) - - ! -------------------- - - write (10) (tile_coord(n)%frac_cell, n=1,N_catf) ! 1: real - write (10) (tile_coord(n)%elev, n=1,N_catf) ! 2: real - - ! for dzsf, dzrz, and dzpr change units from mm (or kg/m2) to m - - write (10) (cat_param(n)%dzsf/1000., n=1,N_catf) ! 3: real - write (10) (cat_param(n)%dzrz/1000., n=1,N_catf) ! 4: real - write (10) (cat_param(n)%dzpr/1000., n=1,N_catf) ! 5: real - - write (10) (dztsurf(n), n=1,N_catf) ! 6: real - - write (10) (cat_param(n)%dzgt(1), n=1,N_catf) ! 7: real - write (10) (cat_param(n)%dzgt(2), n=1,N_catf) ! 8: real - write (10) (cat_param(n)%dzgt(3), n=1,N_catf) ! 9: real - write (10) (cat_param(n)%dzgt(4), n=1,N_catf) ! 10: real - write (10) (cat_param(n)%dzgt(5), n=1,N_catf) ! 11: real - write (10) (cat_param(n)%dzgt(6), n=1,N_catf) ! 12: real - - write (10) (cat_param(n)%poros, n=1,N_catf) ! 13: real - write (10) (clsm_wp(n), n=1,N_catf) ! 14: real - - write (10) (cat_param(n)%cdcr1, n=1,N_catf) ! 15: real - write (10) (cat_param(n)%cdcr2, n=1,N_catf) ! 16: real - - write (10) (mwRTM_param(n)%vegcls, n=1,N_catf) ! 17: integer !!! - write (10) (mwRTM_param(n)%soilcls, n=1,N_catf) ! 18: integer !!! - - write (10) (mwRTM_param(n)%sand, n=1,N_catf) ! 19: real - write (10) (mwRTM_param(n)%clay, n=1,N_catf) ! 20: real - - write (10) (mwRTM_param(n)%poros, n=1,N_catf) ! 21: real - - write (10) (mwRTM_param(n)%wang_wt, n=1,N_catf) ! 22: real - write (10) (mwRTM_param(n)%wang_wp, n=1,N_catf) ! 23: real - - write (10) (mwRTM_param(n)%rgh_hmin, n=1,N_catf) ! 24: real - write (10) (mwRTM_param(n)%rgh_hmax, n=1,N_catf) ! 25: real - write (10) (mwRTM_param(n)%rgh_wmin, n=1,N_catf) ! 26: real - write (10) (mwRTM_param(n)%rgh_wmax, n=1,N_catf) ! 27: real - write (10) (mwRTM_param(n)%rgh_Nrh, n=1,N_catf) ! 28: real - write (10) (mwRTM_param(n)%rgh_Nrv, n=1,N_catf) ! 29: real - write (10) (mwRTM_param(n)%rgh_polmix, n=1,N_catf) ! 30: real - - write (10) (mwRTM_param(n)%omega, n=1,N_catf) ! 31: real - - write (10) (mwRTM_param(n)%bh, n=1,N_catf) ! 32: real - write (10) (mwRTM_param(n)%bv, n=1,N_catf) ! 33: real - write (10) (mwRTM_param(n)%lewt, n=1,N_catf) ! 34: real - - write (10) (cat_param(n)%veghght, n=1,N_catf) ! 35: real - - close (10,status='keep') - - if (logit) write (logunit,*) 'done writing' - if (logit) write (logunit,*) - - end subroutine output_smapL4SMlmc - subroutine GEOS_output_smapL4SMlmc( GC, date_time, work_path, exp_id, & N_catl, tile_coord_l, cat_param, mwRTM_param ) @@ -660,1626 +327,6 @@ subroutine GEOS_output_smapL4SMlmc( GC, date_time, work_path, exp_id, & if (logit) write (logunit,*) end subroutine GEOS_output_smapL4SMlmc - ! ******************************************************************** - - subroutine output_calcs( & - option, out_collection_ID, Nt, & - cat_progn, cat_diagS, cat_diagF, & - met_force, veg_param, bal_diagn, & - cat_progn_avg, cat_diagS_avg, cat_diagF_avg, & - met_force_avg, veg_param_avg, bal_diagn_avg, & - cat_param, mwRTM_param, tile_coord, & - out_choice, date_time, work_path, exp_id, interval, & - model_dtstep, & - out_tile, out_grid, fname_tile, fname_grid, tile_data, & - out_dtstep_xhourly, ens_id ) - - ! calculations and preparation for inst, xhourly, daily, pentad, - ! and monthly output - ! - ! option = 'ini' : initialize - ! option = 'add' : add values of current time step into "_avg" - ! option = 'out' : normalize and output avg - ! - ! reichle, 29 Sep 2009 - reformulated based on old subroutine calc_tavg() - ! see also new subroutine write_output() - ! reichle, 9 Dec 2011 - revised using new types "veg_param" and "bal_diagn" - ! reichle, 28 Dec 2011 - removed field "totalb" from "cat_diagn" structure - ! reichle, 31 Oct 2013 - split "cat_diagn" structure into "cat_diagS" and "cat_diagF" - ! - ! --------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: out_collection_ID - - integer, intent(in) :: Nt ! previously named N_catd - - character(3), intent(in) :: option - - type(cat_progn_type), dimension(Nt), intent(in) :: cat_progn - type(cat_diagS_type), dimension(Nt), intent(in) :: cat_diagS - type(cat_diagF_type), dimension(Nt), intent(in) :: cat_diagF - type(met_force_type), dimension(Nt), intent(in) :: met_force - type(veg_param_type), dimension(Nt), intent(in) :: veg_param - type(bal_diagn_type), dimension(Nt), intent(in) :: bal_diagn - - type(cat_progn_type), dimension(Nt), intent(inout) :: cat_progn_avg - type(cat_diagS_type), dimension(Nt), intent(inout) :: cat_diagS_avg - type(cat_diagF_type), dimension(Nt), intent(inout) :: cat_diagF_avg - type(met_force_type), dimension(Nt), intent(inout) :: met_force_avg - type(veg_param_type), dimension(Nt), intent(inout) :: veg_param_avg - type(bal_diagn_type), dimension(Nt), intent(inout) :: bal_diagn_avg - - ! optional inputs (needed when writing average to file) - - type(cat_param_type), dimension(Nt), intent(in), optional :: cat_param - - type(mwRTM_param_type), dimension(Nt), intent(in), optional :: mwRTM_param - - type(tile_coord_type), dimension(Nt), intent(in), optional :: tile_coord - - type(out_choice_type), intent(in), optional :: out_choice - - type(date_time_type), intent(in), optional :: date_time - - character(200), intent(in), optional :: work_path - character(40), intent(in), optional :: exp_id - - ! what averaging interval is used? (need to know to construct file name) - ! - ! inst : interval = 'i' -- for inst output ONLY call with option 'out' - ! xhourly: interval = 'x' - ! daily : interval = 'd' - ! pentad : interval = 'p' - ! monthly: interval = 'm' - - character, intent(in), optional :: interval - - logical, intent(out), optional :: out_tile, out_grid - - character(300), intent(out), optional :: fname_tile, fname_grid - - ! changed tile_data to pointer so that compile with "-check bounds" works - ! - reichle, 8 Feb 2013 - - real, dimension(:,:), pointer, optional :: tile_data ! intent(out) - ! dimension(Nt,N_out_fields) - - integer, intent(in), optional :: model_dtstep, out_dtstep_xhourly, ens_id - - ! ---------------------------------------- - - ! local variables - - integer :: n, k, ens_id_tmp - - real :: n_steps, totalb, ar4, freq, inc_angle - - real, parameter :: daylen = 86400. - - character(40) :: file_tag - - logical :: out_wetness, muststop, incl_atm_terms - - type(date_time_type) :: date_time_tmp - - real, dimension(Nt) :: tmpreal, SWE, sfmc_mwRTM, tsoil_mwRTM, Tb_h, Tb_v - - type(cat_diagS_type) :: cat_diagS_tmp - - character(len=*), parameter :: Iam = 'output_calcs' - character(len=400) :: err_msg - - ! ------------------------------------------------------------ - - out_wetness = .false. - - ! Removed "out_wetness" from LDASsa nml inputs and hard-wired - ! to "false". - ! If needed for backward compatibility, add replicates of - ! Collections 1, 2, 3, or 10, assign new Collection IDs, - ! and set out_wetness=.true. below. - ! - ! - reichle, 27 Aug 2014 - - !select case (out_collection_ID) - ! - ! case ( "list of new_collection_IDs" ) - ! - !case default - ! - ! out_wetness = .false. - ! - !end select - - ! ------------------------------------------------------------ - - if (option=='ini') then ! initialize - - do n=1,Nt - - cat_progn_avg(n) = 0. - cat_diagS_avg(n) = 0. - cat_diagF_avg(n) = 0. - met_force_avg(n) = 0. - veg_param_avg(n) = 0. - bal_diagn_avg(n) = 0. - - end do - - else if (option=='add') then ! sum up for average - - do n=1,Nt - - cat_progn_avg(n) = cat_progn_avg(n) + cat_progn(n) - - ! ---------------- - - ! In catchment() the snow temperature is set to TSURF if ASNOW=0. - ! Exclude snow-free temperatures from longer-term (eg, monthly) - ! time averages by weighting snow temperature with snow cover - ! fraction. - ! - reichle, 29 Feb 2012 - - cat_diagS_tmp = cat_diagS(n) - - cat_diagS_tmp%tpsn(1:N_snow) = cat_diagS(n)%tpsn(1:N_snow)*cat_diagS(n)%asnow - - cat_diagS_avg(n) = cat_diagS_avg(n) + cat_diagS_tmp - - ! ---------------- - - cat_diagF_avg(n) = cat_diagF_avg(n) + cat_diagF(n) - - met_force_avg(n) = met_force_avg(n) + met_force(n) - - veg_param_avg(n) = veg_param_avg(n) + veg_param(n) - - bal_diagn_avg(n) = bal_diagn_avg(n) + bal_diagn(n) - - end do - - else if (option=='out') then ! finalize, output, re-initialize averages - - ! prepare for output - - ! make sure all optional arguments are present that are required for 'out' - - muststop = .false. - - if (.not. present(out_choice)) muststop=.true. - if (.not. present(date_time)) muststop=.true. - if (.not. present(work_path)) muststop=.true. - if (.not. present(exp_id)) muststop=.true. - if (.not. present(interval)) muststop=.true. - if (.not. present(model_dtstep)) muststop=.true. - - if (muststop) then - err_msg = 'optional input arguments missing' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if (.not. present(ens_id)) then - - ens_id_tmp = -1 ! default to ensemble average - - else - - ens_id_tmp = ens_id - - end if - - - ! put together normalization factors and file names, also determine - ! whether tile or grid output is desired - - out_tile = .false. - out_grid = .false. - - select case (interval) - - case ('i') ! instantaneous - - n_steps = 1. - - if (out_choice%inst%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_inst_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, ens_id=ens_id_tmp ) - - end if - - if (out_choice%inst%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_inst_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, ens_id=ens_id_tmp ) - - end if - - case ('x') ! xhourly - - if (present(out_dtstep_xhourly)) then - - n_steps = real(out_dtstep_xhourly/model_dtstep) - - else - - err_msg = 'need out_dtstep_xhourly' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end if - - ! shift date/time so that mid-point of time averaging interval is - ! used for time-tagging the output file - - date_time_tmp = date_time - - call augment_date_time( -out_dtstep_xhourly/2, date_time_tmp ) - - if (out_choice%xhourly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_xhourly_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, ens_id=ens_id_tmp ) - - end if - - if (out_choice%xhourly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_xhourly_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, ens_id=ens_id_tmp ) - - end if - - case ('d') ! daily - - n_steps = real(86400/model_dtstep) - - if (out_choice%daily%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_daily_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=4, ens_id=ens_id_tmp ) - - end if - - if (out_choice%daily%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_daily_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=4, ens_id=ens_id_tmp ) - - end if - - case ('p') ! pentad - - if (date_time%pentad==12 .and. is_leap_year(date_time%year)) then - - n_steps = real(6*86400/model_dtstep) - - else - n_steps = real(5*86400/model_dtstep) - - end if - - if (out_choice%pentad%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_pentad_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=3, ens_id=ens_id_tmp ) - - end if - - if (out_choice%pentad%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_pentad_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=3, ens_id=ens_id_tmp ) - - end if - - case ('m') ! monthly - - n_steps = real(days_in_month(date_time%year,date_time%month)*86400/model_dtstep) - - if (out_choice%monthly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_monthly_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=2, ens_id=ens_id_tmp ) - - end if - - if (out_choice%monthly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_monthly_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=2, ens_id=ens_id_tmp ) - - end if - - case default - - err_msg = 'unknown averaging interval' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select ! case (interval) - - ! ----------------------- - ! - ! normalize, fix no-data-values, change units - - do n=1,Nt - - ! normalize by number of time steps - - cat_progn_avg(n) = cat_progn_avg(n) / n_steps - cat_diagS_avg(n) = cat_diagS_avg(n) / n_steps - cat_diagF_avg(n) = cat_diagF_avg(n) / n_steps - met_force_avg(n) = met_force_avg(n) / n_steps - veg_param_avg(n) = veg_param_avg(n) / n_steps - bal_diagn_avg(n) = bal_diagn_avg(n) / n_steps - - ! In catchment() the snow temperature is set to TSURF if ASNOW=0. - ! Exclude snow-free temperatures from longer-term (eg, monthly) - ! time averages by weighting snow temperature with snow cover - ! fraction. - ! - reichle, 29 Feb 2012 - - if (cat_diagS_avg(n)%asnow>0.) then - - ! normalize asnow-weighted time-average - ! (except for instantaneous ('i') output) - ! -reichle+csdraper, 31 Oct 2013 - - if (interval/='i') & - cat_diagS_avg(n)%tpsn(1:N_snow) = & - cat_diagS_avg(n)%tpsn(1:N_snow)/cat_diagS_avg(n)%asnow - - else - - cat_diagS_avg(n)%tpsn(1:N_snow) = nodata_generic - - end if - - ! change sub-tile canopy temperatures and spec humidities to - ! no-data-values when corresponding area fraction is zero - ! reichle, 29 Feb 2012 - - ar4 = 1. - cat_diagS_avg(n)%ar1 - cat_diagS_avg(n)%ar2 - - if (cat_diagS_avg(n)%ar1<=0.) cat_progn_avg(n)%tc1 = nodata_generic - if (cat_diagS_avg(n)%ar2<=0.) cat_progn_avg(n)%tc2 = nodata_generic - if ( ar4<=0.) cat_progn_avg(n)%tc4 = nodata_generic - - if (cat_diagS_avg(n)%ar1<=0.) cat_progn_avg(n)%qa1 = nodata_generic - if (cat_diagS_avg(n)%ar2<=0.) cat_progn_avg(n)%qa2 = nodata_generic - if ( ar4<=0.) cat_progn_avg(n)%qa4 = nodata_generic - - - ! change units for selected outputs - ! - ! reichle, 29 Feb 2012: MUST add no-data-check if changing units of - ! tpsn, tc1, tc2, tc4, qa1, qa2, qa4 - - select case (out_collection_ID) - - case (1,2,3,10) - - ! convert [kg/m2/s] into [mm/day] - - met_force_avg(n)%Rainf_C = met_force_avg(n)%Rainf_C * daylen - met_force_avg(n)%Rainf = met_force_avg(n)%Rainf * daylen - met_force_avg(n)%Snowf = met_force_avg(n)%Snowf * daylen - - cat_diagF_avg(n)%evap = cat_diagF_avg(n)%evap * daylen - - cat_diagF_avg(n)%runoff = cat_diagF_avg(n)%runoff * daylen - cat_diagF_avg(n)%runsrf = cat_diagF_avg(n)%runsrf * daylen - cat_diagF_avg(n)%bflow = cat_diagF_avg(n)%bflow * daylen - - cat_diagF_avg(n)%snmelt = cat_diagF_avg(n)%snmelt * daylen - - bal_diagn_avg(n)%wchng = bal_diagn_avg(n)%wchng * daylen - bal_diagn_avg(n)%wincr = bal_diagn_avg(n)%wincr * daylen - - ! convert [W/m2] into [mm/day] - - cat_diagF_avg(n)%eint = cat_diagF_avg(n)%eint * daylen/alhe - cat_diagF_avg(n)%eveg = cat_diagF_avg(n)%eveg * daylen/alhe - cat_diagF_avg(n)%esno = cat_diagF_avg(n)%esno * daylen/alhs - cat_diagF_avg(n)%esoi = cat_diagF_avg(n)%esoi * daylen/alhe - - ! units of qinfil should probably be changed - - ! why are units of energy_bal not changed? - ! perhaps b/c division by seconds works out just fine (Joule -> Watts )?? - - case (4,5,6,7,8,9,11) - - ! no unit changes - - case default - - err_msg = 'unknown out_collection_ID' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - - ! ALWAYS convert units of tp from deg C to Kelvin - - do k=1,N_gt - - cat_diagS_avg(n)%tp(k) = cat_diagS_avg(n)%tp(k) + Tzero - - end do - - end do - - ! ---------------------------------------------------------- - ! - ! assemble data that are actually output - - select case (out_collection_ID) - - case (1,10) ! 1 - N_out_fields_inst = N_out_fields_tavg = 44 - ! 10 - N_out_fields_inst = N_out_fields_tavg = 46 - - ! 1 - Legacy LDASsa off-line output specs ("44 variables") - ! 10 - Legacy plus t2m, q2m - - do n=1,Nt - - if (met_force_avg(n)%SWdown > 1e-4) then - totalb = cat_diagF_avg(n)%swup/met_force_avg(n)%SWdown - else - totalb = nodata_generic - end if - - tile_data(n, 1) = met_force_avg(n)%Tair - tile_data(n, 2) = met_force_avg(n)%Qair - tile_data(n, 3) = met_force_avg(n)%Psurf - tile_data(n, 4) = met_force_avg(n)%Rainf_C - tile_data(n, 5) = met_force_avg(n)%Rainf - tile_data(n, 6) = met_force_avg(n)%Snowf - tile_data(n, 7) = met_force_avg(n)%LWdown - tile_data(n, 8) = met_force_avg(n)%SWdown - tile_data(n, 9) = met_force_avg(n)%Wind - - tile_data(n,10) = cat_progn_avg(n)%capac - tile_data(n,11) = cat_progn_avg(n)%srfexc - tile_data(n,12) = cat_progn_avg(n)%rzexc - tile_data(n,13) = cat_progn_avg(n)%catdef - tile_data(n,14) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - tile_data(n,15) = sum(cat_progn_avg(n)%sndz(1:N_snow)) - - tile_data(n,16) = cat_diagS_avg(n)%ar1 - tile_data(n,17) = cat_diagS_avg(n)%ar2 - tile_data(n,18) = cat_diagS_avg(n)%asnow - - if (out_wetness) then - - tile_data(n,19) = max(min(cat_diagS_avg(n)%sfmc/cat_param(n)%poros,1.),0.) - tile_data(n,20) = max(min(cat_diagS_avg(n)%rzmc/cat_param(n)%poros,1.),0.) - tile_data(n,21) = max(min(cat_diagS_avg(n)%prmc/cat_param(n)%poros,1.),0.) - - else - - tile_data(n,19) = cat_diagS_avg(n)%sfmc - tile_data(n,20) = cat_diagS_avg(n)%rzmc - tile_data(n,21) = cat_diagS_avg(n)%prmc - - end if - - tile_data(n,22) = cat_diagS_avg(n)%tsurf - tile_data(n,23) = cat_diagS_avg(n)%tp(1) - tile_data(n,24) = cat_diagS_avg(n)%tp(N_gt) - tile_data(n,25) = cat_diagS_avg(n)%tpsn(1) - tile_data(n,26) = cat_diagS_avg(n)%tpsn(N_snow) - - tile_data(n,27) = cat_diagF_avg(n)%shflux - tile_data(n,28) = cat_diagF_avg(n)%lhflux - tile_data(n,29) = cat_diagF_avg(n)%ghflux - tile_data(n,30) = cat_diagF_avg(n)%evap - tile_data(n,31) = cat_diagF_avg(n)%eint - tile_data(n,32) = cat_diagF_avg(n)%eveg - tile_data(n,33) = cat_diagF_avg(n)%esoi - tile_data(n,34) = cat_diagF_avg(n)%esno - tile_data(n,35) = cat_diagF_avg(n)%runoff - tile_data(n,36) = cat_diagF_avg(n)%runsrf - tile_data(n,37) = cat_diagF_avg(n)%bflow - tile_data(n,38) = cat_diagF_avg(n)%snmelt - tile_data(n,39) = cat_diagF_avg(n)%lwup - tile_data(n,40) = cat_diagF_avg(n)%swup - tile_data(n,41) = cat_diagF_avg(n)%qinfil - - tile_data(n,42) = totalb - - tile_data(n,43) = bal_diagn_avg(n)%wincr - tile_data(n,44) = bal_diagn_avg(n)%eincr - - if (out_collection_ID==10) then - - tile_data(n,45) = cat_diagF_avg(n)%t2m - tile_data(n,46) = cat_diagF_avg(n)%q2m - - end if - - end do - - case (2) ! N_out_fields_inst = N_out_fields_tavg = 6 - - ! Specs for SMAP Nature Run v02 (Feb 2011) - - do n=1,Nt - - if (out_wetness) then - - tile_data(n,1) = max(min(cat_diagS_avg(n)%sfmc/cat_param(n)%poros,1.),0.) - tile_data(n,2) = max(min(cat_diagS_avg(n)%rzmc/cat_param(n)%poros,1.),0.) - - else - - tile_data(n,1) = cat_diagS_avg(n)%sfmc - tile_data(n,2) = cat_diagS_avg(n)%rzmc - - end if - - tile_data(n,3) = cat_diagS_avg(n)%tsurf - tile_data(n,4) = cat_diagS_avg(n)%tp(1) - tile_data(n,5) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - tile_data(n,6) = met_force_avg(n)%Rainf+met_force_avg(n)%Snowf - - end do - - case (3) ! N_out_fields_inst = N_out_fields_tavg = 8 - - ! for L-band mwRTM calibration (before Dec 2013), SMOS DA - - do n=1,Nt - - if (out_wetness) then - - tile_data(n,1) = max(min(cat_diagS_avg(n)%sfmc/cat_param(n)%poros,1.),0.) - tile_data(n,2) = max(min(cat_diagS_avg(n)%rzmc/cat_param(n)%poros,1.),0.) - - else - - tile_data(n,1) = cat_diagS_avg(n)%sfmc - tile_data(n,2) = cat_diagS_avg(n)%rzmc - - end if - - tile_data(n,3) = cat_diagS_avg(n)%tsurf - tile_data(n,4) = cat_diagS_avg(n)%tp(1) - tile_data(n,5) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - tile_data(n,6) = met_force_avg(n)%Rainf+met_force_avg(n)%Snowf - tile_data(n,7) = met_force_avg(n)%Tair - tile_data(n,8) = cat_progn_avg(n)%capac - - end do - - - case (4,5) ! N_out_fields_inst = N_out_fields_tavg = 50, 59 - - ! 50 MERRA-Land "mld" outputs *or* 59 = 50 MERRA-Land "mld" outputs plus 9 additional fields - ! - ! reichle, 29 Feb 2012: updated to reflect final "mld" file specs (incl TSURF) - - tile_data(1:Nt, 1) = veg_param_avg%grn ! GRN Fraction - tile_data(1:Nt, 2) = veg_param_avg%lai ! LAI m2 m-2 - - tile_data(1:Nt, 3) = max(min(cat_diagS_avg%prmc/cat_param%poros,1.),0.) ! GWETPROF Fraction - tile_data(1:Nt, 4) = max(min(cat_diagS_avg%rzmc/cat_param%poros,1.),0.) ! GWETROOT Fraction - tile_data(1:Nt, 5) = max(min(cat_diagS_avg%sfmc/cat_param%poros,1.),0.) ! GWETTOP Fraction - - tile_data(1:Nt, 6) = cat_diagS_avg%prmc ! PRMC m3/m3 - tile_data(1:Nt, 7) = cat_diagS_avg%rzmc ! RZMC m3/m3 - tile_data(1:Nt, 8) = cat_diagS_avg%sfmc ! SFMC m3/m3 - - tile_data(1:Nt, 9) = cat_diagS_avg%tsurf ! TSURF K - tile_data(1:Nt,10) = cat_diagS_avg%tpsn(1) ! TPSNOW K - - tile_data(1:Nt,11) = cat_progn_avg%tc2 ! TUNST K - tile_data(1:Nt,12) = cat_progn_avg%tc1 ! TSAT K - tile_data(1:Nt,13) = cat_progn_avg%tc4 ! TWLT K - - tile_data(1:Nt,14) = cat_diagS_avg%tp(1) ! TSOIL1 K - tile_data(1:Nt,15) = cat_diagS_avg%tp(2) ! TSOIL2 K - tile_data(1:Nt,16) = cat_diagS_avg%tp(3) ! TSOIL3 K - tile_data(1:Nt,17) = cat_diagS_avg%tp(4) ! TSOIL4 K - tile_data(1:Nt,18) = cat_diagS_avg%tp(5) ! TSOIL5 K - tile_data(1:Nt,19) = cat_diagS_avg%tp(6) ! TSOIL6 K - - tile_data(1:Nt,20) = met_force_avg%Snowf ! PRECSNO kg m-2 s-1 - tile_data(1:Nt,21) = met_force_avg%Rainf + met_force_avg%Snowf ! PRECTOT kg m-2 s-1 - - do n=1,Nt - - tile_data(n,22) = sum(cat_progn_avg(n)%wesn(1:N_snow)) ! SNOMAS kg m-2 - tile_data(n,23) = sum(cat_progn_avg(n)%sndz(1:N_snow)) ! SNODP m - - end do - - tile_data(1:Nt,24) = cat_diagF_avg%esoi ! EVPSOIL W m-2 - tile_data(1:Nt,25) = cat_diagF_avg%eveg ! EVPTRNS W m-2 - tile_data(1:Nt,26) = cat_diagF_avg%eint ! EVPINTR W m-2 - tile_data(1:Nt,27) = cat_diagF_avg%esno ! EVPSBLN W m-2 - - tile_data(1:Nt,28) = cat_diagF_avg%runsrf ! RUNOFF kg m-2 s-1 - tile_data(1:Nt,29) = cat_diagF_avg%bflow ! BASEFLOW kg m-2 s-1 - tile_data(1:Nt,30) = cat_diagF_avg%snmelt ! SMLAND kg m-2 s-1 - tile_data(1:Nt,31) = cat_diagF_avg%qinfil ! QINFIL kg m-2 s-1 - - ! Note: ar1+ar2+ar4=1 but need FRSAT+FRUNST+FRWLT+FRSNO=1 - - tmpreal(1:Nt) = max(min((1.-cat_diagS_avg%asnow),1.),0.) ! precompute snow-free fraction - - tile_data(1:Nt,32) = max(min(tmpreal*cat_diagS_avg%ar2, 1.),0.) ! FRUNST Fraction - tile_data(1:Nt,33) = max(min(tmpreal*cat_diagS_avg%ar1, 1.),0.) ! FRSAT Fraction - tile_data(1:Nt,34) = max(min( cat_diagS_avg%asnow,1.),0.) ! FRSNO Fraction - - tmpreal = tmpreal-tile_data(1:Nt,32)-tile_data(1:Nt,33) ! compute wilting fraction - - ! tmpreal = 1.-sum(tile_data(1:Nt,31:33),dim=2) - ! tmpreal = tmpreal * (1.-cat_diagS_avg%ar1-cat_diagS_avg%ar2) - - tile_data(1:Nt,35) = max(min(tmpreal, 1.),0.) ! FRWLT fraction - - - tile_data(1:Nt,36) = met_force_avg%PARdffs ! PARDF W m-2 - tile_data(1:Nt,37) = met_force_avg%PARdrct ! PARDR W m-2 - - tile_data(1:Nt,38) = cat_diagF_avg%shflux ! SHLAND W m-2 - tile_data(1:Nt,39) = cat_diagF_avg%lhflux ! LHLAND W m-2 - tile_data(1:Nt,40) = cat_diagF_avg%evap ! EVLAND kg m-2 s-1 - - tile_data(1:Nt,41) = met_force_avg%LWdown - cat_diagF_avg%lwup ! LWLAND W m-2 - tile_data(1:Nt,42) = met_force_avg%SWdown - cat_diagF_avg%swup ! SWLAND W m-2 - - tile_data(1:Nt,43) = cat_diagF_avg%ghflux ! GHLAND W m-2 - - tile_data(1:Nt,44) = bal_diagn_avg%wtotl ! TWLAND kg m-2 - tile_data(1:Nt,45) = bal_diagn_avg%etotl ! TELAND J m-2 - tile_data(1:Nt,46) = bal_diagn_avg%wchng ! WCHANGE kg m-2 s-1 - tile_data(1:Nt,47) = bal_diagn_avg%echng ! ECHANGE W m-2 - - tile_data(1:Nt,48) = 0. ! SPLAND W m-2 - tile_data(1:Nt,49) = 0. ! SPWATR kg m-2 s-1 - tile_data(1:Nt,50) = cat_diagF_avg%hsnacc ! SPSNOW W m-2 - - if (out_collection_ID==5) then - - ! select additional outputs - - tile_data(1:Nt,51) = met_force_avg%Tair ! TLML K - tile_data(1:Nt,52) = met_force_avg%Qair ! QLML kg kg-1 - tile_data(1:Nt,53) = met_force_avg%LWdown ! LWGAB W m-2 - tile_data(1:Nt,54) = met_force_avg%SWdown ! SWGDN W m-2 - - tile_data(1:Nt,55) = cat_progn_avg%srfexc ! kg m-2 - tile_data(1:Nt,56) = cat_progn_avg%rzexc ! kg m-2 - tile_data(1:Nt,57) = cat_progn_avg%catdef ! kg m-2 - - tile_data(1:Nt,58) = bal_diagn_avg%wincr ! kg m-2 - tile_data(1:Nt,59) = bal_diagn_avg%eincr ! J m-2 - - end if - - - case (6) ! N_out_fields_inst = N_out_fields_tavg = 40 (EXCL sm in pctl units!) - - ! output fields of SMAP L4_SM gph collection, - ! order follows Table 9 of SMAP L4_SM Data Products Specification Document (PSD; revised Jun 2014) - ! - ! NOTE: rootzone and profile soil moisture outputs in units of percentiles are appended in post-processing - ! - ! - reichle, 9 Apr 2013 - ! - reichle, 26 May 2014 - revised output specs: replaced sm in pctl units (fields 1-3) with sm in volumetric units - - tile_data(1:Nt, 1) = cat_diagS_avg%sfmc ! sm_surface m3 m-3 - tile_data(1:Nt, 2) = cat_diagS_avg%rzmc ! sm_rootzone m3 m-3 - tile_data(1:Nt, 3) = cat_diagS_avg%prmc ! sm_profile m3 m-3 - - tile_data(1:Nt, 4) = max(min(cat_diagS_avg%sfmc/cat_param%poros,1.),0.) ! sm_surface_wetness dimensionless - tile_data(1:Nt, 5) = max(min(cat_diagS_avg%rzmc/cat_param%poros,1.),0.) ! sm_rootzone_wetness dimensionless - tile_data(1:Nt, 6) = max(min(cat_diagS_avg%prmc/cat_param%poros,1.),0.) ! sm_profile_wetness dimensionless - - tile_data(1:Nt, 7) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt, 8) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt, 9) = cat_diagS_avg%tp(2) ! soil_temp_layer2 K - tile_data(1:Nt,10) = cat_diagS_avg%tp(3) ! soil_temp_layer3 K - tile_data(1:Nt,11) = cat_diagS_avg%tp(4) ! soil_temp_layer4 K - tile_data(1:Nt,12) = cat_diagS_avg%tp(5) ! soil_temp_layer5 K - tile_data(1:Nt,13) = cat_diagS_avg%tp(6) ! soil_temp_layer6 K - - do n=1,Nt - - tile_data(n,14) = sum(cat_progn_avg(n)%wesn(1:N_snow)) ! snow_mass kg m-2 - tile_data(n,15) = sum(cat_progn_avg(n)%sndz(1:N_snow)) ! snow_depth m - - end do - - tile_data(1:Nt,16) = cat_diagF_avg%evap ! land_evapotranspiration_flux kg m-2 s-1 - tile_data(1:Nt,17) = cat_diagF_avg%runsrf ! overland_runoff_flux kg m-2 s-1 - tile_data(1:Nt,18) = cat_diagF_avg%bflow ! baseflow_flux kg m-2 s-1 - tile_data(1:Nt,19) = cat_diagF_avg%snmelt ! snow_melt_flux kg m-2 s-1 - tile_data(1:Nt,20) = cat_diagF_avg%qinfil ! soil_water_infiltration_flux kg m-2 s-1 - - - ! Note: ar1+ar2+ar4=1 but need FRSAT+FRUNST+FRWLT+FRSNO=1 - - tmpreal(1:Nt) = max(min((1.-cat_diagS_avg%asnow),1.),0.) ! precompute snow-free fraction - - tile_data(1:Nt,21) = max(min(tmpreal*cat_diagS_avg%ar1, 1.),0.) ! land_fraction_saturated dimensionless - tile_data(1:Nt,22) = max(min(tmpreal*cat_diagS_avg%ar2, 1.),0.) ! land_fraction_unsaturated dimensionless - - tmpreal = tmpreal-tile_data(1:Nt,21)-tile_data(1:Nt,22) ! compute wilting fraction - - tile_data(1:Nt,23) = max(min(tmpreal, 1.),0.) ! land_fraction_wilting dimensionless - - tile_data(1:Nt,24) = max(min( cat_diagS_avg%asnow,1.),0.) ! land_fraction_snow_covered dimensionless - - tile_data(1:Nt,25) = cat_diagF_avg%shflux ! heat_flux_sensible W m-2 - tile_data(1:Nt,26) = cat_diagF_avg%lhflux ! heat_flux_latent W m-2 - tile_data(1:Nt,27) = cat_diagF_avg%ghflux ! heat_flux_ground W m-2 - - tile_data(1:Nt,28) = met_force_avg%SWdown - cat_diagF_avg%swup ! net_downward_shortwave_flux W m-2 - tile_data(1:Nt,29) = met_force_avg%LWdown - cat_diagF_avg%lwup ! net_downward_longwave_flux W m-2 - - tile_data(1:Nt,30) = met_force_avg%SWdown ! radiation_shortwave_downward_flux W m-2 - tile_data(1:Nt,31) = met_force_avg%LWdown ! radiation_longwave_absorbed_flux W m-2 - - tile_data(1:Nt,32) = met_force_avg%Rainf + met_force_avg%Snowf ! precipitation_total_surface_flux kg m-2 s-1 - tile_data(1:Nt,33) = met_force_avg%Snowf ! snowfall_surface_flux kg m-2 s-1 - - tile_data(1:Nt,34) = met_force_avg%Psurf ! surface_pressure Pa - - tile_data(1:Nt,35) = met_force_avg%RefH ! height_lowatmmodlay m - tile_data(1:Nt,36) = met_force_avg%Tair ! temp_lowatmmodlay K - tile_data(1:Nt,37) = met_force_avg%Qair ! specific_humidity_lowatmmodlay kg kg-1 - tile_data(1:Nt,38) = met_force_avg%Wind ! windspeed_lowatmmodlay m s-1 - - tile_data(1:Nt,39) = veg_param_avg%grn ! vegetation_greenness_fraction dimensionless - tile_data(1:Nt,40) = veg_param_avg%lai ! leaf_area_index m2 m-2 - - - case (7,8) ! N_out_fields_inst = 4; N_out_fields_tavg = 4, 6 - - ! Specs for SMAP Nature Run v03 - reichle, 11 Dec 2013 - ! Modified - reichle, 6 Feb 2014 - ! Bug fix: units of tp(1) - reichle, 19 Feb 2014 - ! Added tpsn(1) - reichle, 4 Mar 2014 - - ! compute snow mass - - do n=1,Nt - - SWE(n) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - - end do - - ! generate different output for "inst" and "tavg" files - - select case(interval) - - case ('i') ! instantaneous - - ! convert Catchment model variables into inputs suitable for the mwRTM - ! NOTE: input tp must be in degree Celsius! - - call catch2mwRTM_vars( Nt, cat_param%vegcls, cat_param%poros, & - mwRTM_param%poros, cat_diagS_avg%sfmc, cat_diagS_avg%tsurf, & - cat_diagS_avg%tp(1)-Tzero, sfmc_mwRTM, tsoil_mwRTM ) - - ! calculate brightness temperatures - ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] - ! but without Pellarin atmospheric corrections) - - freq = 1.41e9 - - inc_angle = 40. - - incl_atm_terms = .false. - - call mwRTM_get_Tb(Nt, freq, inc_angle, mwRTM_param, tile_coord%elev, & - veg_param_avg%lai, sfmc_mwRTM, tsoil_mwRTM, SWE, met_force_avg%Tair, & - incl_atm_terms, & - Tb_h, Tb_v ) - - ! fill tile_data - - tile_data(1:Nt,1) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt,2) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt,3) = Tb_h ! tb_h [at above freq, inc_angle] K - tile_data(1:Nt,4) = Tb_v ! tb_v [at above freq, inc_angle] K - - if (out_collection_ID==8) then - - tile_data(1:Nt,5) = cat_diagS_avg%tpsn(1) ! snow_temp_layer1 K - - end if - - case default ! time-average output (any averaging interval) - - tile_data(1:Nt,1) = cat_diagS_avg%sfmc ! sm_surface m3 m-3 - tile_data(1:Nt,2) = cat_diagS_avg%rzmc ! sm_rootzone m3 m-3 - tile_data(1:Nt,3) = cat_diagS_avg%prmc ! sm_profile m3 m-3 - tile_data(1:Nt,4) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - - if (out_collection_ID==8) then - - tile_data(1:Nt,5) = SWE ! snow_mass kg m-2 - tile_data(1:Nt,6) = met_force_avg%Rainf + met_force_avg%Snowf ! precipitation_total_surface_flux kg m-2 s-1 - - end if - - end select - - case (9) ! N_out_fields_inst = 6; N_out_fields_tavg = 2 - - ! for L-band mwRTM calibration (Dec 2013) - ! Renamed from 8 to 9 - reichle, 6 Feb 2014 - - ! generate different output for "inst" and "tavg" files - - select case(interval) - - case ('i') ! instantaneous - - tile_data(1:Nt,1) = cat_diagS_avg%sfmc ! sm_surface m3 m-3 - tile_data(1:Nt,2) = cat_diagS_avg%rzmc ! sm_rootzone m3 m-3 - tile_data(1:Nt,3) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt,4) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt,5) = met_force_avg%Tair ! temp_lowatmmodlay K - tile_data(1:Nt,6) = veg_param_avg%lai ! leaf_area_index m2 m-2 - - case default ! time-average output (any averaging interval) - - ! compute snow mass - - do n=1,Nt - - SWE(n) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - - end do - - tile_data(1:Nt,1) = SWE ! snow_mass kg m-2 - tile_data(1:Nt,2) = met_force_avg%Rainf + met_force_avg%Snowf ! precipitation_total_surface_flux kg m-2 s-1 - - end select - - case (11) ! N_out_fields_inst = N_out_fields_tavg = 5 - - ! for SMOS pre-processing using Gabrielle De Lannoy's matlab routines (Dec 2014) - ! - reichle, 30 Mar 2015 - - tile_data(1:Nt,1) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt,2) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt,3) = met_force_avg%Psurf ! surface_pressure Pa - tile_data(1:Nt,4) = cat_diagF_avg%t2m ! temp_2m K - tile_data(1:Nt,5) = cat_diagF_avg%q2m ! specific_humidity_2m kg kg-1 - - case default - - err_msg = 'unknown out_collection_ID' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select ! case (out_collection_ID) - - ! ---------------------------------------------------------------- - ! - ! re-initialize - - do n=1,Nt - - cat_progn_avg(n) = 0. - cat_diagS_avg(n) = 0. - cat_diagF_avg(n) = 0. - met_force_avg(n) = 0. - veg_param_avg(n) = 0. - bal_diagn_avg(n) = 0. - - end do - - ! ---------------------------------------------------------------- - - else - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'bad option') - - end if ! option 'ini', 'add', or 'out' - - end subroutine output_calcs - - ! ******************************************************************** - - subroutine output_write( out_tile, out_grid, fname_tile, fname_grid, & - out_collection_ID, N_out_fields, & - N_catl, N_catf, N_land_mask, tile_coord_f, tile_grid_f, & - N_catl_vec, low_ind, land_mask_i, land_mask_j, tile_data_l ) - - ! reichle, 23 Dec 2011 - - ! revised output subroutines to accomodate LAI-weighted greenness (GRN) and - ! for general clean-up - - implicit none - - logical, intent(in) :: out_tile, out_grid - - character(300), intent(in) :: fname_tile, fname_grid - - integer, intent(in) :: out_collection_ID, N_out_fields - integer, intent(in) :: N_catl, N_catf, N_land_mask - - type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! intent(in), N_catf - - type(grid_def_type), intent(in) :: tile_grid_f - - integer, dimension(:), intent(in) :: N_catl_vec, low_ind - - integer, dimension(tile_grid_f%N_lon*tile_grid_f%N_lat), intent(in) :: & - land_mask_i, land_mask_j - - real, dimension(N_catl,N_out_fields), intent(in) :: tile_data_l - - ! local variables - - integer :: i - real, dimension(N_catf) :: tile_data_f - real, dimension(N_catf) :: tile_data_f_tmp - real, dimension(tile_grid_f%N_lon,tile_grid_f%N_lat) :: grid_data - real, dimension(tile_grid_f%N_lon,tile_grid_f%N_lat) :: grid_data_tmp - - ! --------------------------------------------------------- - - do i=1,N_out_fields ! write output one field at a time - - ! gatherv tile data from local to full domain and map to grid - - call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, & - tile_data_l(:,i), tile_data_f) - - if (master_proc) & - call tile2grid( N_catf, tile_coord_f, tile_grid_f, tile_data_f, & - grid_data, & - no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - ! special case: LAI-weighted greenness for MERRA-Land and SMAP file specs - - if ( (i==1) .and. & - ( & - out_collection_ID==4 .or. & - out_collection_ID==5 .or. & - out_collection_ID==6 & - ) ) then - - ! i=1: GRN - ! i=2: LAI - - ! gatherv LAI into tile_data_f_tmp - - call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, tile_data_l(:,2), & - tile_data_f_tmp) - - if (master_proc) then - - ! get gridded LAI - - call tile2grid( N_catf, tile_coord_f, tile_grid_f, tile_data_f_tmp, & - grid_data_tmp, & - no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - ! get LAI-weighted GRN - - tile_data_f_tmp = tile_data_f*tile_data_f_tmp ! = GRN*LAI - - call tile2grid( N_catf, tile_coord_f, tile_grid_f, tile_data_f_tmp, & - grid_data, & - no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - ! set to no-data-values when gridded LAI is zero or no-data, - ! otherwise normalize, ie., compute [GRN*LAI] / LAI - ! [edited to avoid division by zero, -reichle+csdraper, 29 Jan 2016] - - where ( & - grid_data_tmp < 1.e-10 .or. & - abs(grid_data_tmp-nodata_generic)0 .and. N_bits_shaved<=12) then - - rc = ShaveMantissa32( data_shaved, data, N_data, & - N_bits_shaved, .true., nodata_generic, N_data ) - - else - - err_msg = 'shaving more than 12 bits is not recommended' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end if - - if (rc/=0) call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'rc/=0') - - end subroutine shave_bits - - ! ******************************************************************** - - subroutine get_ensstd_filenames( out_choice, date_time_new, work_path, exp_id, & - interval, out_tile, out_grid, fname_tile, fname_grid, out_dtstep_xhourly ) - - implicit none - - type(out_choice_type), intent(in) :: out_choice - - type(date_time_type), intent(in) :: date_time_new - - character(200), intent(in) :: work_path - character(40), intent(in) :: exp_id - - ! what averaging interval is used? (need to know to construct file name) - ! - ! inst : interval = 'i' -- for inst output ONLY call with option 'out' - ! xhourly: interval = 'x' - ! daily : interval = 'd' - ! pentad : interval = 'p' - ! monthly: interval = 'm' - - character, intent(in) :: interval - - logical, intent(out) :: out_tile, out_grid - - character(300), intent(out) :: fname_tile, fname_grid - - integer, intent(in), optional :: out_dtstep_xhourly - - ! local variables - - character(40) :: dir_name, file_tag - - type(date_time_type) :: date_time_tmp - - character(len=*), parameter :: Iam = 'get_ensstd_filenames' - character(len=400) :: err_msg - - ! ------------------------------------------------------ - - out_tile = .false. - out_grid = .false. - - dir_name = 'ana' - - select case (interval) - - case ('i') ! instantaneous - - if (out_choice%inst%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_inst_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%inst%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_inst_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('x') ! xhourly - - if (.not. present(out_dtstep_xhourly)) then - err_msg = 'optional input argument missing' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! shift date/time so that mid-point of time averaging interval is - ! used for time-tagging the output file - - date_time_tmp = date_time_new - - call augment_date_time( -out_dtstep_xhourly/2, date_time_tmp ) - - if (out_choice%xhourly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_xhourly_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%xhourly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_xhourly_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('d') ! daily - - if (out_choice%daily%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_daily_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=4, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%daily%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_daily_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=4, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('p') ! pentad - - if (out_choice%pentad%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_pentad_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=3, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%pentad%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_pentad_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=3, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('m') ! monthly - - if (out_choice%monthly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_monthly_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=2, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%monthly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_monthly_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=2, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case default - - err_msg = 'unknown averaging interval' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - - end subroutine get_ensstd_filenames - - ! ******************************************************************** - - subroutine check_output_times( out_dtstep, date_time_new, date_time_old, end_time, & - out_time ) - - ! reichle, 2 Oct 2009 - - implicit none - - type(out_dtstep_type), intent(in) :: out_dtstep - - type(date_time_type), intent(in) :: date_time_new, date_time_old, end_time - - type(out_choice_time_type), intent(out) :: out_time - - ! local variables - - integer :: secs_in_day - - logical :: new_day, new_pentad, new_month - - ! -------------------------------------------------- - - out_time%rstrt = .false. - out_time%inst = .false. - out_time%xhourly = .false. - out_time%daily = .false. - out_time%pentad = .false. - out_time%monthly = .false. - out_time%any_non_rstrt = .false. - - secs_in_day = date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec - - new_day = (secs_in_day==0) - - new_pentad = (date_time_new%pentad /= date_time_old%pentad) - - new_month = (new_day .and. date_time_new%day==1) - - ! check if rstrt output is needed - - ! write restarts - ! - at beginning of month (always) - ! - at appropriate time steps as requested - ! - at end_time of simulation (always) - - if ( new_month & - .or. & - (out_dtstep%rstrt>0 .and. mod(secs_in_day,out_dtstep%rstrt)==0) & - .or. & - datetime_eq_refdatetime(date_time_new,end_time) & - ) & - out_time%rstrt = .true. - - ! inst - - if (out_dtstep%inst/=0) then - - if (mod(secs_in_day,out_dtstep%inst) ==0) out_time%inst = .true. - - end if - - ! xhourly - - if (out_dtstep%xhourly/=0) then - - if (mod(secs_in_day,out_dtstep%xhourly)==0) out_time%xhourly = .true. - - end if - - ! daily, pentad, monthly - - if (new_day) out_time%daily = .true. - - if (date_time_new%pentad /= date_time_old%pentad) out_time%pentad = .true. - - if (new_month) out_time%monthly = .true. - - ! is there any non-rstrt output? - - if ( out_time%inst .or. & - out_time%xhourly .or. & - out_time%daily .or. & - out_time%pentad .or. & - out_time%monthly ) out_time%any_non_rstrt = .true. - - end subroutine check_output_times - - ! ******************************************************************** - - subroutine get_land_mask_ij( N_catd, tile_coord, tile_grid_d, & - N_land_mask, land_mask_i, land_mask_j ) - - implicit none - - integer, intent(in) :: N_catd - - type(tile_coord_type), dimension(:), pointer :: tile_coord ! input - - type(grid_def_type), intent(in) :: tile_grid_d - - integer, intent(inout) :: N_land_mask - - integer, dimension(tile_grid_d%N_lon*tile_grid_d%N_lat), intent(out) :: & - land_mask_i, land_mask_j - - ! ----------------------------------------------------- - - ! local variables - - integer :: i, j - - real, dimension(:), allocatable :: tile_data_tmp - - real, dimension(tile_grid_d%N_lon,tile_grid_d%N_lat) :: grid_data - - ! ------------------------------------------------------------- - - ! map a vector full of "good" tiles to grid - - allocate(tile_data_tmp(N_catd)) - - tile_data_tmp = (nodata_generic + 1000.*nodata_tol_generic) - - call tile2grid( N_catd, tile_coord, tile_grid_d, tile_data_tmp, & - grid_data, no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - deallocate(tile_data_tmp) - - ! see which grid boxes are "good" - - N_land_mask = 0 - - do j=1,tile_grid_d%N_lat - do i=1,tile_grid_d%N_lon - - if (abs(grid_data(i,j)-nodata_generic)>nodata_tol_generic) then - - N_land_mask = N_land_mask+1 - - land_mask_i(N_land_mask) = i - land_mask_j(N_land_mask) = j - - end if - - end do - end do - - end subroutine get_land_mask_ij ! ******************************************************************** diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 3072ab05..4502a216 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -25,7 +25,7 @@ module clsm_ensupd_enkf_update catch_calc_soil_moist, & catch_calc_tp - use LDAS_ensdrv_globals, ONLY: & + use LDAS_ensdrv_globals, ONLY: & logit, & logunit, & nodata_generic, & @@ -39,7 +39,7 @@ module clsm_ensupd_enkf_update obs_param_type, & obs_type - use LDAS_DriverTypes, ONLY: & + use LDAS_DriverTypes, ONLY: & met_force_type use catch_types, ONLY: & @@ -55,10 +55,10 @@ module clsm_ensupd_enkf_update use mwRTM_types, ONLY: & mwRTM_param_type - use LDAS_PertTypes, ONLY: & + use LDAS_PertTypes, ONLY: & pert_param_type - use LDAS_TilecoordType, ONLY: & + use LDAS_TilecoordType, ONLY: & tile_coord_type, & grid_def_type @@ -74,7 +74,7 @@ module clsm_ensupd_enkf_update use nr_ran2_gasdev, ONLY: & NRANDSEED - use LDAS_ease_conv, ONLY: & + use LDAS_ease_conv, ONLY: & easeV1_convert, & easeV2_convert @@ -103,9 +103,6 @@ module clsm_ensupd_enkf_update use clsm_ensupd_read_obs, ONLY: & collect_obs - use LDAS_ensdrv_init_routines, ONLY: & - io_rstrt - use clsm_bias_routines, ONLY: & obs_bias_upd_tcount, & obs_bias_corr_obs, & @@ -121,7 +118,7 @@ module clsm_ensupd_enkf_update numprocs, & myid, & mpierr, & - mpicomm, & + mpicomm, & MPI_obs_type, & mpistatus @@ -148,12 +145,12 @@ subroutine get_enkf_increments( & work_path, exp_id, exp_domain, & met_force, lai, cat_param, mwRTM_param, & tile_coord_l, tile_coord_f, tile_grid_f, & - pert_grid_f, pert_grid_l_NotUsed, tile_grid_g, & + pert_grid_f, pert_grid_l_NotUsed, tile_grid_g, & N_catl_vec, low_ind, l2f, f2l, & N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & update_type, & dtstep_assim, centered_update, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & N_obs_param, obs_param, N_obsbias_max, & out_obslog, out_smapL4SMaup, & cat_progn, & @@ -214,7 +211,7 @@ subroutine get_enkf_increments( & logical, intent(in) :: centered_update - real, intent(in) :: xcompact, ycompact + real, intent(in) :: xcompact, ycompact, fcsterr_inflation_fac integer, intent(in) :: N_obs_param @@ -527,7 +524,8 @@ subroutine get_enkf_increments( & N_catl_vec, low_ind, tile_grid_g, & obs_param, & met_force, lai, cat_param, cat_progn, mwRTM_param, & - N_obsl, Observations_l, Obs_pred_l, obsbias_ok ) + N_obsl, Observations_l, Obs_pred_l, obsbias_ok, & + fcsterr_inflation_fac ) deallocate(obsbias_ok) @@ -1037,7 +1035,7 @@ subroutine get_enkf_increments( & Obs_pred_ana, & ! size: (nObs_ana,N_ens) Obs_pert_tmp, & cat_param_ana, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & cat_progn_ana, cat_progn_incr_ana) call cpu_time(t_end) @@ -1065,7 +1063,7 @@ subroutine get_enkf_increments( & Obs_pred_lH(1:N_obslH,1:N_ens), & Obs_pert_tmp, & cat_param, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & cat_progn, cat_progn_incr ) #endif @@ -1557,11 +1555,8 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & endif ! write to file - fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & - dir_name=dir_name, ens_id=-1 ) - i = index(fname, '/', .true.) - - if( i >0) call Execute_command_line('/bin/mkdir -p '//fname(1:i)) + fname = get_io_filename( './', exp_id, file_tag, date_time=date_time, & + dir_name=dir_name, ens_id=-1, no_subdirs=.true. ) open( 10, file=fname, form='unformatted', action='write') @@ -1617,7 +1612,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & N_catl_vec, low_ind, f2l, N_catg, f2g, & obs_param, & met_force, lai, cat_param, cat_progn, cat_progn_incr, mwRTM_param, & - Observations_l,rf2f ) + Observations_l, rf2f ) implicit none @@ -1665,6 +1660,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & type(obs_type), dimension(:), pointer :: Observations_l ! inout + integer, dimension(N_catf), optional, intent(in) :: rf2f ! re-ordered to LDASsa ! local variables @@ -2102,8 +2098,8 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & if (master_proc) then - fname = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, dir_name=dir_name, ens_id=-1) + fname = get_io_filename( './', exp_id, file_tag, & + date_time=date_time, dir_name=dir_name, ens_id=-1, no_subdirs=.true.) if (option=='orig_obs') then diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 index 7b933fa5..36d07f06 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 @@ -14,7 +14,7 @@ module clsm_ensupd_upd_routines MAPL_RADIUS, & MAPL_PI - use LDAS_ensdrv_Globals, ONLY: & + use LDAS_ensdrv_Globals, ONLY: & logit, & logunit, & nodata_generic, & @@ -44,7 +44,7 @@ module clsm_ensupd_upd_routines use LDAS_ensdrv_init_routines, ONLY: & clsm_ensdrv_get_command_line - use LDAS_DateTimeMod, ONLY: & + use LDAS_DateTimeMod, ONLY: & date_time_type use catch_types, ONLY: & @@ -63,22 +63,22 @@ module clsm_ensupd_upd_routines write_obs_param, & N_obs_ang_max - use LDAS_DriverTypes, ONLY: & + use LDAS_DriverTypes, ONLY: & met_force_type use mwRTM_types, ONLY: & mwRTM_param_type - use LDAS_PertTypes, ONLY: & + use LDAS_PertTypes, ONLY: & pert_param_type, & allocate_pert_param, & deallocate_pert_param - use LDAS_TileCoordType, ONLY: & + use LDAS_TileCoordType, ONLY: & tile_coord_type, & grid_def_type - use LDAS_TilecoordRoutines, ONLY: & + use LDAS_TilecoordRoutines, ONLY: & get_tile_num_in_ellipse, & get_number_of_tiles_in_cell_ij, & get_tile_num_in_cell_ij, & @@ -96,7 +96,7 @@ module clsm_ensupd_upd_routines catch_calc_tsurf, & catch_calc_tsurf_excl_snow - use lsm_routines, ONLY: & + use lsm_routines, ONLY: & catch_calc_soil_moist, & catch_calc_tp, & catch_calc_ght, & @@ -117,7 +117,7 @@ module clsm_ensupd_upd_routines mpistatus, & mpierr - use LDAS_ExceptionsMod, ONLY: & + use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -170,12 +170,11 @@ subroutine read_ens_upd_inputs( & dtstep_assim, & centered_update, & xcompact, ycompact, & + fcsterr_inflation_fac, & N_obs_param, & obs_param, & out_obslog, & out_ObsFcstAna, & -! out_incr, & -! out_incr_format, & out_smapL4SMaup, & N_obsbias_max & ) @@ -201,8 +200,8 @@ subroutine read_ens_upd_inputs( & implicit none - character(*), intent(in) :: work_path - character(*), intent(in) :: exp_id + character(*), intent(in) :: work_path + character(*), intent(in) :: exp_id type(date_time_type), intent(in) :: date_time @@ -222,6 +221,7 @@ subroutine read_ens_upd_inputs( & logical, intent(out) :: centered_update real, intent(out) :: xcompact, ycompact + real, intent(out) :: fcsterr_inflation_fac integer, intent(out) :: N_obs_param @@ -229,11 +229,8 @@ subroutine read_ens_upd_inputs( & logical, intent(out) :: out_obslog logical, intent(out) :: out_ObsFcstAna -! logical, intent(out) :: out_incr logical, intent(out) :: out_smapL4SMaup -! integer, intent(out) :: out_incr_format - integer, intent(out) :: N_obsbias_max ! ------------------------ @@ -277,10 +274,9 @@ subroutine read_ens_upd_inputs( & centered_update, & out_obslog, & out_ObsFcstAna, & -! out_incr, & -! out_incr_format, & out_smapL4SMaup, & xcompact, ycompact, & + fcsterr_inflation_fac, & obs_param_nml ! ------------------------------------------------------------------ @@ -1013,7 +1009,8 @@ subroutine get_obs_pred( & N_catl_vec, low_ind, tile_grid_g, & obs_param, & met_force, lai, cat_param, cat_progn, mwRTM_param, & - N_obsl, Observations_l, Obs_pred_l, obsbias_ok ) + N_obsl, Observations_l, Obs_pred_l, obsbias_ok, & + fcsterr_inflation_fac ) ! Compute ensemble of measurement predictions from ensemble ! of tile-space Catchment prognostics. @@ -1066,6 +1063,8 @@ subroutine get_obs_pred( & real, dimension(:,:), pointer :: Obs_pred_l ! output logical, intent(in), dimension(N_obsl), optional :: obsbias_ok + + real, intent(in), optional :: fcsterr_inflation_fac ! -------------------------------------------------------------------------------- ! @@ -1164,13 +1163,15 @@ subroutine get_obs_pred( & logical, dimension(N_obsl) :: obsbias_ok_tmp + real :: inflation_factor + character(len=*), parameter :: Iam = 'get_obs_pred' character(len=400) :: err_msg character(len= 10) :: tmpstring10 ! -------------------------------------------------------------- ! - ! deal with optional argument + ! deal with optional arguments if (present(obsbias_ok)) then @@ -1181,7 +1182,18 @@ subroutine get_obs_pred( & obsbias_ok_tmp = .false. end if - + + if (present(fcsterr_inflation_fac) .and. beforeEnKFupdate) then + + ! ONLY inflate *before* EnKF update!!! + + inflation_factor = fcsterr_inflation_fac + + else + + inflation_factor = -9999. + + end if ! -------------------------------------------------------------- ! @@ -1978,6 +1990,10 @@ subroutine get_obs_pred( & call row_variance( 1, N_ens, Obs_pred_l(j,1:N_ens), tmpvar, tmpmean ) + ! inflate fcstvar + + if (inflation_factor > 0.) tmpvar(1) = tmpvar(1) * inflation_factor**2 + else tmpmean(1) = Obs_pred_l(j,1) @@ -2017,6 +2033,9 @@ subroutine get_obs_pred( & call row_variance( 1, N_ens, Obs_pred_l(i,1:N_ens), tmpvar, tmpmean ) + ! no need to inflate analysis Obs_pred because state increments already included + ! impact of inflation + end if else @@ -3457,7 +3476,7 @@ subroutine cat_enkf_increments( & tile_grid_f, tile_coord, l2f, & Observations, Obs_pred, Obs_pert, & cat_param, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & cat_progn, cat_progn_incr ) ! get increments for Catchment prognostic variables @@ -3506,7 +3525,7 @@ subroutine cat_enkf_increments( & type(cat_param_type), dimension(N_catd), intent(in) :: cat_param - real, intent(in) :: xcompact, ycompact + real, intent(in) :: xcompact, ycompact, fcsterr_inflation_fac type(cat_progn_type), intent(in), dimension(N_catd,N_ens) :: cat_progn @@ -3748,14 +3767,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -3836,7 +3856,8 @@ subroutine cat_enkf_increments( & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov, & - State_incr, State_lon, State_lat, xcompact, ycompact ) + State_incr, State_lon, State_lat, xcompact, ycompact, & + fcsterr_inflation_fac ) deallocate(Obs_cov) @@ -3901,14 +3922,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -3973,14 +3995,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -4047,14 +4070,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -4146,7 +4170,8 @@ subroutine cat_enkf_increments( & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov, & - State_incr, State_lon, State_lat, xcompact, ycompact ) + State_incr, State_lon, State_lat, xcompact, ycompact, & + fcsterr_inflation_fac ) deallocate(Obs_cov) @@ -4271,7 +4296,8 @@ subroutine cat_enkf_increments( & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov, & - State_incr, State_lon, State_lat, xcompact, ycompact ) + State_incr, State_lon, State_lat, xcompact, ycompact, & + fcsterr_inflation_fac ) deallocate(Obs_cov) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 index af525872..c678a378 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 @@ -2,12 +2,13 @@ ! this file contains a collection of general Ensemble Kalman filter ! subroutines and compact support subroutines ! -! reichle, 20 Apr 2001 -! reichle, 18 Mar 2004 - optional arguments -! reichle, 27 Jan 2005 - eliminated use of module select_kinds -! reichle, 19 Jul 2005 - merged compact_support.f90 and enkf_general.f90 -! reichle, 1 Aug 2005 - eliminated tile_coord -! reichle, 18 Oct 2005 - return increments instead of updated State +! reichle, 20 Apr 2001 +! reichle, 18 Mar 2004 - optional arguments +! reichle, 27 Jan 2005 - eliminated use of module select_kinds +! reichle, 19 Jul 2005 - merged compact_support.f90 and enkf_general.f90 +! reichle, 1 Aug 2005 - eliminated tile_coord +! reichle, 18 Oct 2005 - return increments instead of updated State +! reichle+qliu, 29 Apr 2020 - added forecast error covariance inflation ! use intel mkl lapack when available #ifdef MKL_AVAILABLE @@ -23,7 +24,7 @@ module enkf_general use enkf_types, ONLY: & obs_type - use LDAS_ExceptionsMod, ONLY: & + use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -41,7 +42,7 @@ subroutine enkf_increments( & N_state, N_obs, N_ens, & Observations, Obs_pred, Obs_err, Obs_cov, & State_incr, & - State_lon, State_lat, xcompact, ycompact ) + State_lon, State_lat, xcompact, ycompact, fcsterr_inflation_fac ) ! perform EnKF update ! @@ -51,6 +52,11 @@ subroutine enkf_increments( & ! ! if optional inputs State_lon, State_lat, xcompact, and ycompact ! are present, Hadamard product is applied to HPHt and PHt + ! + ! if optional input fcsterr_inflation_fac is present, this subroutine inflates + ! the forecast error covariance and returns increments that must be applied to + ! the state vector *before* inflation + ! (i.e., do not inflate the state vector outside of this subroutine) implicit none @@ -68,8 +74,9 @@ subroutine enkf_increments( & real, dimension(N_state), intent(in), optional :: State_lon, State_lat - real, intent(in), optional :: xcompact ! [deg] longitude - real, intent(in), optional :: ycompact ! [deg] latitude + real, intent(in), optional :: xcompact ! [deg] longitude + real, intent(in), optional :: ycompact ! [deg] latitude + real, intent(in), optional :: fcsterr_inflation_fac ! forecast error covariance inflation ! ----------------------------- @@ -80,6 +87,8 @@ subroutine enkf_increments( & integer :: n_e, i, ii, jj, kk, lapack_info real :: PHt_ij, dx, dy + + real :: inflation_factor real, dimension(N_state,N_ens) :: State_prime real, dimension(N_state) :: State_bar @@ -99,6 +108,18 @@ subroutine enkf_increments( & ! ------------------------------------------------------------------ + ! deal with optional argument + + if (present(fcsterr_inflation_fac)) then + + inflation_factor = fcsterr_inflation_fac + + else + + inflation_factor = -9999. + + end if + ! find out whether Hadamard product should be applied apply_hadamard = ( & @@ -122,7 +143,9 @@ subroutine enkf_increments( & State_prime(:,n_e) = State_incr(:,n_e) - State_bar end do - + + if (inflation_factor > 0.) State_prime = inflation_factor * State_prime + ! -------------------- ! compute ensemble mean H*Ybar @@ -137,6 +160,8 @@ subroutine enkf_increments( & end do + if (inflation_factor > 0.) Obs_pred_prime = inflation_factor * Obs_pred_prime + ! -------------------- ! form repr matrix HPHt = Q_prime*(Q_prime)t/(N_e-1) @@ -181,9 +206,14 @@ subroutine enkf_increments( & ! compute right hand side rhs = Zpert - H*y^f for system equation, do i=1,N_obs - + rhs(i) = Observations(i)%obs + Obs_err(i,n_e) - Obs_pred(i,n_e) + ! in case of inflation, correct for the fact that "Obs_pred" was not inflated above + ! because it is intent(in) + + if (inflation_factor > 0.) rhs(i) = rhs(i) - (1.-inflation_factor)*Obs_pred_prime(i,n_e) + end do ! solve W*b = Zpert - H*y^f @@ -253,8 +283,15 @@ subroutine enkf_increments( & ! finish computation of increment for ensemble member n_e ! (normalization is NOT ensemble average, see Eq above) - + State_incr(:,n_e) = State_incr(:,n_e)/real(N_ens-1) + + ! correct for the fact that the increment will be applied to + ! the un-inflated state vector outside of this subroutine + ! (note also that State_prime here has been inflated!) + + if (inflation_factor > 0.) & + State_incr(:,n_e) = State_incr(:,n_e) + (1.-1./inflation_factor)*State_prime(:,n_e) end do diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index 2f49a98e..968fb84e 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -11,10 +11,10 @@ module LDAS_ForceMod use MAPL_Mod use MAPL_ShmemMod - use LDAS_ensdrv_Globals, ONLY: & + use LDAS_ensdrv_Globals, ONLY: & logunit, & - logit, & - master_logit, & + logit, & + master_logit, & nodata_generic, & nodata_tol_generic, & nodata_tolfrac_generic @@ -2527,8 +2527,6 @@ subroutine get_GEOS(date_time, force_dtstep, & real :: xcur, ycur, xnew, ynew, fnbr(2,2) - ! real, dimension(:,:), allocatable :: tmp_grid - integer, pointer :: i1(:), i2(:), j1(:), j2(:) real, pointer :: x1(:), x2(:), y1(:), y2(:) @@ -2545,10 +2543,8 @@ subroutine get_GEOS(date_time, force_dtstep, & character(len=*), parameter :: Iam = 'get_GEOS' integer :: status character(len=400) :: err_msg - !external :: GEOS_closefile character(len=300) :: fname_full - logical :: file_exists,notime - ! type(nodelist),pointer :: ptrNode + logical :: file_exists, single_time_in_file ! ----------------------------------------------------------------------- ! @@ -2984,18 +2980,14 @@ subroutine get_GEOS(date_time, force_dtstep, & YYYYMMDD = date_time_tmp%year*10000+date_time_tmp%month*100+date_time_tmp%day HHMMSS = date_time_tmp%hour*10000+date_time_tmp%min*100 +date_time_tmp%sec - ! use gfio to open standard MERRA or G5DAS files, - ! use netcdf to open corrected precip files - + ! determine forcing file name (with path) if ( (use_prec_corr) .and. (GEOSgcm_defs(GEOSgcm_var,1)(1:4)=='PREC') ) then - if (j==1) GEOSgcm_defs(GEOSgcm_var,3) = trim(GEOSgcm_defs(GEOSgcm_var,3)) // '_corr' - - call get_GEOS_prec_filename(fname_full,file_exists,date_time_tmp, & + call get_GEOS_corr_prec_filename(fname_full,file_exists,date_time_tmp, & prec_path_tmp, met_tag_tmp, GEOSgcm_defs(GEOSgcm_var,:), precip_corr_file_ext ) - notime = file_exists + single_time_in_file = .true. ! corr precip files are always hourly (incl. MERRA-2) else @@ -3003,35 +2995,38 @@ subroutine get_GEOS(date_time, force_dtstep, & daily_met_files, met_path_tmp, met_tag_tmp, & GEOSgcm_defs(GEOSgcm_var,:), met_file_ext) - notime = .not. file_exists + single_time_in_file = .not. daily_met_files ! MERRA-2 files are daily files end if if ( file_exists) then - exit ! exit j loop after successfully opening file + exit ! exit j loop after successfully finding file elseif ( & (j==1) .and. & (tmp_init) .and. & - (trim(GEOSgcm_defs(GEOSgcm_var,2))=='tavg') ) then + (trim(GEOSgcm_defs(GEOSgcm_var,2))=='tavg') .and. & + (master_logit) ) then - if ((.not. MERRA_file_specs) ) write (logunit,'(400A)') & + if (.not. MERRA_file_specs) write (logunit,'(400A)') & 'NOTE: Initialization. Data from tavg file are not used ' // & 'with lfo inst/tavg forcing, but dummy values must be ' // & 'read from some file for backward compatibility with ' // & 'MERRA forcing.' - if(master_logit) write (logunit,*) 'try again with different file...' + write (logunit,*) 'try again with different file...' else - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'error opening file') + call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'error finding met forcing file') end if end do ! j=1,2 + ! open file, extract coord info, prep horizontal interpolation info (if not done already) + call GEOS_openfile(FileOpenedHash,fname_full,fid,tile_coord,met_hinterp) !fid = ptrNode%fid @@ -3047,7 +3042,7 @@ subroutine get_GEOS(date_time, force_dtstep, & ! ---------------------------------------------- ! - ! for first variable, read and process grid dimensions + ! for first variable, process grid dimensions if (GEOSgcm_var==1) then @@ -3056,8 +3051,6 @@ subroutine get_GEOS(date_time, force_dtstep, & call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - ! allocate tmp_grid - ! allocate(tmp_grid( local_info%N_lon,local_info%N_lat)) ! init share memory if( size(ptrShForce,1) /= local_info%N_lon .or. & size(ptrShForce,2) /= local_info%N_lat ) then @@ -3077,10 +3070,9 @@ subroutine get_GEOS(date_time, force_dtstep, & ! ---------------------------------------------- ! ! read global gridded field of given variable - - call LDAS_GetVar( fid, trim(GEOSgcm_defs(GEOSgcm_var,1)), & - YYYYMMDD, HHMMSS, ptrShForce, notime,local_info, rc) + call LDAS_GetVar( fid, trim(GEOSgcm_defs(GEOSgcm_var,1)), & + YYYYMMDD, HHMMSS, ptrShForce, single_time_in_file, local_info, rc) if (rc<0) then call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'error reading gfio file') endif @@ -3225,10 +3217,8 @@ subroutine get_GEOS(date_time, force_dtstep, & call FileOpenedHash%free( GEOS_closefile,.false. ) - !if(allocated(tmp_grid)) deallocate(tmp_grid) deallocate(GEOSgcm_defs) - !call MAPL_SyncSharedMemory(rc=status) - !call MAPL_DeallocNodeArray(ptrShForce,rc=status) + ! -------------------------------------------------------------------- ! convert variables and units of force_array to match met_force_type, @@ -3416,47 +3406,33 @@ end subroutine get_GEOS ! ****************************************************************** subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & - ptrShForce,notime,local_info, rc) + ptrShForce,single_time_in_file,local_info, rc) use netcdf implicit none include 'mpif.h' - integer,intent(in) :: fid ! File handle - character(len=*), intent(in) :: vname ! Variable name - integer, intent(in) :: yyyymmdd ! Year-month-day, e.g., 19971003 - integer,intent(in) :: hhmmss ! Hour-minute-second, e.g., 120000 - logical,intent(in) :: notime ! if true, no time index is necessary, from PREC files + integer,intent(in) :: fid ! File handle + character(len=*), intent(in) :: vname ! Variable name + integer, intent(in) :: yyyymmdd ! Year-month-day, e.g., 19971003 + integer,intent(in) :: hhmmss ! Hour-minute-second, e.g., 120000 + logical,intent(in) :: single_time_in_file ! if true, no time index is necessary type(local_grid),intent(in) :: local_info !OUTPUT PARAMETERS: - real,pointer,intent(inout) :: ptrShForce(:,:) ! Gridded data read for this time + real,pointer,intent(inout) :: ptrShForce(:,:) ! Gridded data read for this time integer,intent(out) :: rc ! local - ! real,allocatable :: tmp_grid(:,:) - integer begDate, begTime, seconds, minutes, incSecs - integer iistart(3), iicount(3), timeIndex - integer istart(4), icount(4) ! cs grid - real, pointer :: tmpShared(:,:,:,:) ! cs grid - type(c_ptr) :: c_address - integer nv_id,imin, jmin, imax, jmax,ierr - integer DiffDate - - integer :: status - !real,allocatable :: grid(:,:) - ! mpi support - !type(ESMF_VM) :: vm - !integer :: comm - !integer status(MPI_STATUS_SIZE) - !integer :: rank,myid, io_rank, total_prcs - !integer :: length - character(*),parameter :: Iam="LDAS_getvar" - logical :: isCubed - ! call ESMF_VmGetCurrent(vm, rc=ierr) - ! VERIFY_(ierr) - ! call ESMF_VmGet(vm, mpicommunicator=comm, rc=ierr) - ! VERIFY_(ierr) - ! call MPI_COMM_SIZE(comm,total_prcs,ierr) - ! call MPI_COMM_RANK(comm,myid,ierr) + integer :: begDate, begTime, seconds, minutes, incSecs + integer :: iistart(3), iicount(3), timeIndex + integer :: istart(4), icount(4) ! cs grid + real, pointer :: tmpShared(:,:,:,:) ! cs grid + type(c_ptr) :: c_address + integer :: nv_id,imin, jmin, imax, jmax,ierr + integer :: DiffDate + integer :: status + character(*), parameter :: Iam="LDAS_getvar" + logical :: isCubed + rc = 0 isCubed = .false. if(local_info%N_lat == 6*local_info%N_lon) then @@ -3473,7 +3449,7 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & iicount(3) = 1 endif - if (.not. notime ) then + if (.not. single_time_in_file ) then ! determine start index call GetBegDateTime ( fid, begDate, begTime, incSecs, rc ) if (rc .NE. 0) then print* ,"LDAS_GetVar: could not determine begin_date/begin_time" @@ -3495,7 +3471,7 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & return endif - ! Determine the time index from the offset and time increment. + ! Determine the time index from the offset and time increment. if ( MOD (seconds, incSecs) .ne. 0 ) then print *, 'GFIO_getvar: Absolute time of ',seconds,' not ', & 'possible with an interval of ',incSecs @@ -4453,29 +4429,29 @@ subroutine get_GEOS_forcing_filename(fname_full,file_exists, date_time, daily_fi ! reichle, 27 Jul 2015 - added "daily_file" option ! (because MERRA-2 provides aggregated daily files that contain 24 hourly fields) + ! reichle, 7 May 2020 - added "seamless" GEOS FP file names (so far, only "asm" assimilation files) + implicit none - character(*),intent(inout) :: fname_full - logical,intent(out) :: file_exists - type(date_time_type), intent(in) :: date_time - logical, intent(in) :: daily_file - character(*), intent(in) :: met_path - character(*), intent(in) :: met_tag - character( 40), dimension(5), intent(in) :: GEOSgcm_defs - character(*), intent(in) :: file_ext + character(*), intent(inout) :: fname_full + logical, intent(out) :: file_exists + type(date_time_type), intent(in) :: date_time + logical, intent(in) :: daily_file + character(*), intent(in) :: met_path + character(*), intent(in) :: met_tag + character( 40), dimension(5), intent(in) :: GEOSgcm_defs + character(*), intent(in) :: file_ext ! local variables - character(300) :: fname, fname_full_tmp + character(300) :: fname, fname_full_tmp1, fname_full_tmp2 character( 14) :: time_stamp - character( 4) :: YYYY, HHMM + character( 4) :: YYYY, HHMM, day_dir character( 2) :: MM, DD - integer :: i, rc - + integer :: tmpind, tmpindend character(len=*), parameter :: Iam = 'get_GEOS_forcing_filename' - character :: err_msg ! assemble date/time strings @@ -4499,55 +4475,115 @@ subroutine get_GEOS_forcing_filename(fname_full,file_exists, date_time, daily_fi else - time_stamp = YYYY // MM // DD // '_' // trim(HHMM) // 'z' + time_stamp = YYYY // MM // DD // '_' // trim(HHMM) // 'z' end if - fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '.' // & - trim(time_stamp) // '.' // file_ext - + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + ! GEOS FP with generic file names, e.g., + ! + ! GEOS.fp.asm.inst1_2d_lfo_Nx.20200507_0000.V01.nc4 + ! + ! for now, always use product counter V01 + ! (as of 7 May 2020, no V02 or higher was issued for GEOS FP "lfo" products + ! going back to Jun 2013) + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '.' // & + trim(time_stamp(1:13)) // '.V01.' // trim(file_ext) + + ! archived files are stored in daily directories + + day_dir = 'D' // DD // '/' + + else + + ! GEOS FP with experiment-specific file names and MERRA-2, e.g., + ! + ! f525_p5_fp.inst1_2d_lfo_Nx.20200507_0000z.nc4 + ! MERRA2_400.inst1_2d_lfo_Nx.20200507.nc4 + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '.' // & + trim(time_stamp) // '.' // trim(file_ext) + + ! archived files are stored in monthly directories + ! (per LDAS legacy convention for GEOS FP with experiment-specific file names) + + day_dir = repeat(' ', len(day_dir)) + + end if ! ---------------------------------------------- - ! - ! Try getting the files directly inside directory "met_path/" first (because in - ! coupled DAS mode met_path=workdir, and the files are simply sitting there). - ! If this fails, try reading the files in "met_path/met_tag/*/Yyyyy/Mmm/" - ! as in the archived directory structure. - file_exists = .false. + ! + ! find suitable file in a couple of places - do i=1,2 - - if (i==1) then - - fname_full = trim(met_path) // '/' // trim(fname) + file_exists = .false. ! initialize + - fname_full_tmp = fname_full ! remember for error log below + ! first try: year/month[/day] directory - elseif (i==2) then + fname_full = trim(met_path) // '/' // trim(met_tag) // '/' // & + trim(GEOSgcm_defs(4)) // '/Y' // YYYY // '/M' // MM // '/' // & + trim(day_dir) // trim(fname) + + inquire(file=fname_full, exist=file_exists) + + if (file_exists) return ! done + + fname_full_tmp1 = trim(fname_full) ! remember for error log below - fname_full = trim(met_path) // '/' // trim(met_tag) // '/' // & - trim(GEOSgcm_defs(4)) // '/Y' // YYYY // '/M' // MM // '/' // trim(fname) - end if + + ! second try: ./met_path (coupled land-atm DAS) + + fname_full = trim(met_path) // '/' // trim(fname) + + inquire(file=fname_full, exist=file_exists) + + if (file_exists) return ! done + + fname_full_tmp2 = trim(fname_full) ! remember for error log below + + + ! last try: for GEOS FP with generic file names, try product counter '.V02.' in year/month/day dir + + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + fname_full = fname_full_tmp1 ! from first try + + ! GEOS.fp.asm.inst1_2d_lfo_Nx.20200507_0000.V01.nc4 + ! 1234567 + tmpindend = len_trim(fname_full) + tmpind = len_trim(file_ext) + + tmpind = tmpindend - tmpind - 3 + + fname_full( tmpind:tmpind+2 ) = 'V02' ! --> *.V02.nc4 + inquire(file=fname_full, exist=file_exists) - if (file_exists) return - - end do + end if + + ! if no file was found, report file names that were tried + if (.not. file_exists) then if(master_logit) then - print*, 'get_GEOS_forcing_filename: Unsuccessfully tried to get files:' - print*, "both files don't exist" - print*, fname_full - print*, fname_full_tmp + print '(400A)', trim(Iam) // ': Could not find any of the following files:' + print '(400A)', trim(fname_full_tmp1) + print '(400A)', trim(fname_full_tmp2) + print '(400A)', trim(fname_full) endif endif + end subroutine get_GEOS_forcing_filename -!********************************************************** + !********************************************************** subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, rc) + + ! open file, extract coord info, prep horizontal interpolation info (if not done already) + use netcdf implicit none include 'mpif.h' @@ -4584,17 +4620,15 @@ subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, call FileOpenedHash%get(fname_full,fid) if( fid == -9999 ) then ! not open yet - !ierr=nf90_open(fname_full,IOR(NF90_NOWRITE, NF90_MPIIO), fid, & - ! comm = comm,info = MPI_INFO_NULL) ierr=nf90_open(fname_full,NF90_NOWRITE, fid) if(master_logit) then - write(logunit,*) "opening file: "//trim(fname_full) + write(logunit,'(400A)') "opening file: "//trim(fname_full) endif ASSERT_( ierr == nf90_noerr) call FileOpenedHash%put(fname_full,fid) endif - ! check if it is cs grid + ! check if it is cs grid ierr = nf90_inq_dimid(fid,"nf",nfid) if (ierr == nf90_noerr) then ! it is cs grid if face dimension is found @@ -4757,28 +4791,33 @@ subroutine GEOS_closefile(fid) endif endsubroutine -! **************************************************************** + + ! **************************************************************** - subroutine get_GEOS_prec_filename(fname_full,file_exists, date_time, met_path, met_tag, & + subroutine get_GEOS_corr_prec_filename(fname_full,file_exists, date_time, met_path, met_tag, & GEOSgcm_defs, file_ext ) implicit none - character(*),intent(inout) :: fname_full - logical,intent(out) :: file_exists - type(date_time_type), intent(in) :: date_time - character(*), intent(in) :: met_path - character(*), intent(in) :: met_tag - character( 40), dimension(5), intent(in) :: GEOSgcm_defs - character(*), intent(in) :: file_ext + character(*), intent(inout) :: fname_full + logical,intent(out) :: file_exists + type(date_time_type), intent(in) :: date_time + character(*), intent(in) :: met_path + character(*), intent(in) :: met_tag + character( 40), dimension(5), intent(in) :: GEOSgcm_defs + character(*), intent(in) :: file_ext ! local variables + character(100) :: fname character(200) :: fdir - character(300) :: fname_full_tmp + character(300) :: fname_full_tmp1, fname_full_tmp2 character( 4) :: YYYY, HHMM character( 2) :: MM, DD - character(len=*), parameter :: Iam = 'get_GEOS_prec_filename' - ! + + integer :: tmpind, tmpindend + + character(len=*), parameter :: Iam = 'get_GEOS_corr_prec_filename' + ! assemble date/time strings write (YYYY,'(i4.4)') date_time%year @@ -4788,43 +4827,93 @@ subroutine get_GEOS_prec_filename(fname_full,file_exists, date_time, met_path, m ! assemble file name - fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // & - '.' // YYYY // MM // DD // '_' // trim(HHMM) // 'z.' // & - trim(file_ext) + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + ! for now, always use product counter V01 + ! (as of 7 May 2020, no V02 or higher was issued for GEOS FP "lfo" products + ! going back to Jun 2013) + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '_corr.' // & + YYYY // MM // DD // '_' // trim(HHMM) // '.V01.' // trim(file_ext) + + else + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '_corr.' // & + YYYY // MM // DD // '_' // trim(HHMM) // 'z.' // trim(file_ext) + + end if - ! assemble dir name without "/Mmm" (month) dir + ! assemble dir name with "/Yyy" (year) dir but without "/Mmm" (month) dir - fdir = trim(met_path) // '/' // trim(met_tag) // '/' // & + fdir = trim(met_path) // '/' // trim(met_tag) // '/' // & trim(GEOSgcm_defs(4)) // '/' // 'Y' // YYYY // '/' ! ----------------------------------------------------------------------- - ! try opening file with "/Mmm" (month) dir - ! (standard for corrected G5DAS precip) + file_exists = .false. ! initialize + + ! first try: look for file in year/month dir + ! (LDAS standard for corrected G5DAS precip) + fname_full = trim(fdir) // 'M' // MM // '/' // trim(fname) - - file_exists = .false. - + inquire(file=fname_full, exist=file_exists) + + if (file_exists) return ! done + + fname_full_tmp1 = trim(fname_full) ! remember for error log below + + + ! second try: *without* "/Mmm" (month) dir + + ! THIS TRY IS PROBABLY OBSOLETE BUT COULD EASILY BE TWEAKED TO LOOK + ! IN year/month/day DIRECTORY (WHICH POSSIBLY APPLIES TO CORRECTED + ! PRECIP FROM GMAO OPS THAT IS INPUT INTO MERRA-2) + ! - reichle 10 May 2020 - if(file_exists) return - - fname_full_tmp = fname_full ! remember for error log below fname_full = trim(fdir) // trim(fname) inquire(file=fname_full, exist=file_exists) + if (file_exists) return ! done + + fname_full_tmp2 = trim(fname_full) ! remember for error log below + + + ! last try: for GEOS FP with generic file names, try product counter '.V02.' in year/month dir + + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + fname_full = fname_full_tmp1 ! from first try + + ! GEOS.fp.asm.inst1_2d_lfo_Nx.20200507_0000.V01.nc4 + ! 1234567 + + tmpindend = len_trim(fname_full) + tmpind = len_trim(file_ext) + + tmpind = tmpindend - tmpind - 3 + + fname_full( tmpind:tmpind+2 ) = 'V02' ! --> *.V02.nc4 + + inquire(file=fname_full, exist=file_exists) + + end if + + + ! if no file was found, report file names that were tried + if( .not. file_exists ) then if(master_logit) then - print*, 'get_GEOS_prec_filename: Unsuccessfully tried to get files:' - print*, "both files don't exist" - print*, fname_full - print*, fname_full_tmp + print '(400A)', trim(Iam) // ': Could not find any of the following files:' + print '(400A)', trim(fname_full_tmp1) + print '(400A)', trim(fname_full_tmp2) + print '(400A)', trim(fname_full) endif endif - end subroutine get_GEOS_prec_filename + end subroutine get_GEOS_corr_prec_filename ! **************************************************************** diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 index f17f52b0..a37b1e98 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 @@ -31,9 +31,6 @@ module LDAS_DriverTypes private public :: met_force_type, veg_param_type, bal_diagn_type - public :: out_dtstep_type - public :: out_select_type, out_select_sub_type - public :: out_choice_type, out_choice_time_type public :: alb_param_type public :: assignment (=), operator (/), operator (+), operator (*) @@ -169,79 +166,6 @@ module LDAS_DriverTypes real :: wincr ! water analysis increment per unit time [kg/m2/s] end type bal_diagn_type - ! --------------------------------------------------------------- - ! - ! type output time steps - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: When modifying this derived type make sure that the corresponding - ! MPI STRUCTURE in module CLSM_ENSDRV_MPI is also updated, as are - ! any subroutines or operators defined herein - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - type :: out_dtstep_type - integer :: rstrt - integer :: inst - integer :: xhourly - end type out_dtstep_type - - ! --------------------------------------------------------------- - ! - ! type for reading in output choices from namelist file - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: When modifying this derived type make sure that the corresponding - ! MPI STRUCTURE in module CLSM_ENSDRV_MPI is also updated, as are - ! any subroutines or operators defined herein - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - type :: out_select_sub_type - logical :: inst - logical :: xhourly - logical :: daily - logical :: pentad - logical :: monthly - end type out_select_sub_type - - type :: out_select_type - type(out_select_sub_type) :: tile - type(out_select_sub_type) :: grid - end type out_select_type - - ! --------------------------------------------------------------- - ! - ! type for output choices *after* processing in read_driver_inputs() - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: When modifying this derived type make sure that the corresponding - ! MPI STRUCTURE in module CLSM_ENSDRV_MPI is also updated, as are - ! any subroutines or operators defined herein - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - type :: out_choice_space_type - logical :: tile - logical :: grid - logical :: any - end type out_choice_space_type - - type :: out_choice_type - type(out_choice_space_type) :: inst - type(out_choice_space_type) :: xhourly - type(out_choice_space_type) :: daily - type(out_choice_space_type) :: pentad - type(out_choice_space_type) :: monthly - type(out_choice_space_type) :: any - end type out_choice_type - - type :: out_choice_time_type - logical :: rstrt - logical :: inst - logical :: xhourly - logical :: daily - logical :: pentad - logical :: monthly - logical :: any_non_rstrt - end type out_choice_time_type ! --------------------------------------------------------------- ! diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 index 5bddad28..d539e241 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 @@ -20,7 +20,6 @@ module LDAS_ensdrv_Globals public :: nodata_generic public :: nodata_tolfrac_generic public :: nodata_tol_generic - public :: N_bits_shaved public :: logunit public :: logit public :: master_logit @@ -38,16 +37,6 @@ module LDAS_ensdrv_Globals real :: nodata_tol_generic = abs(nodata_generic*nodata_tolfrac_generic) - ! ---------------------------------------------------------------------- - ! - ! bit shaving for better gzip compression of output files: - ! - degrade least significant digits in floating point output - ! in return for better gzip compression rates; - ! - real*4 reserves 24 bits for Mantissa, the N_bits_shaved - ! least significant of these 24 bits will be altered) - - integer, parameter :: N_bits_shaved = 12 ! useful range: 0-12 (0=no shaving) - ! ---------------------------------------------------------------- ! ! log file @@ -88,8 +77,6 @@ subroutine echo_clsm_ensdrv_glob_param() write (logunit,*) write (logunit,*) 'nodata_tol_generic = ', nodata_tol_generic write (logunit,*) - write (logunit,*) 'N_bits_shaved = ', N_bits_shaved - write (logunit,*) write (logunit,*) 'logunit = ', logunit write (logunit,*) write (logunit,*) 'log_master_only = ', log_master_only diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 index 6d0b8caa..8495cd6b 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 @@ -33,9 +33,9 @@ module LDAS_ensdrv_functions ! ******************************************************************** character(300) function get_io_filename( io_path, exp_id, file_tag, & - date_time, dir_name, ens_id, option, file_ext ) + date_time, dir_name, ens_id, option, file_ext, no_subdirs ) - ! compose file name for input/output, create dir if needed + ! compose file name for input/output ! ! file name = io_path/dir_name/[ensXXXX]/Yyyyy/Mmm/ ! "exp_id"."file_tag".[ensXXXX.]YYYYMMDD_HHMMz"file_ext" @@ -56,37 +56,41 @@ character(300) function get_io_filename( io_path, exp_id, file_tag, & ! ! optional arguments: ! - ! date_time date and time info (must be present unless option=1) - ! option default=5 controls date/time directories and string - ! dir_name default='cat' what type of output (eg "rs/", "rc_out/", "ana/") - ! ens_id default='' (see note above) - ! file_ext default='.bin' file name extension + ! date_time date and time info (must be present unless option=1) + ! option default=5 controls date/time directories and string + ! dir_name default='cat' what type of output (eg "rs/", "rc_out/", "ana/") + ! ens_id default='' (see note above) + ! file_ext default='.bin' file name extension + ! no_subdirs default=.false. if .true., omit all sub-directories after "io_path" ! ! reichle, 2 Sep 2008 - overhaul for new dir and file name conventions - + ! reichle, 28 Apr 2020 - added optional "no_subdirs" to facilitate writing to ./scratch + implicit none - character(*) :: io_path - character(*) :: exp_id, file_tag ! (eg "catch_ldas_rst") + character(*) :: io_path + character(*) :: exp_id, file_tag ! (eg "catch_ldas_rst") type(date_time_type), optional :: date_time - integer, optional :: ens_id - integer, optional :: option + integer, optional :: ens_id + integer, optional :: option - character(*), optional :: dir_name ! default = 'cat' - character(*), optional :: file_ext ! default = '.bin' + character(*), optional :: dir_name ! default = 'cat' + character(*), optional :: file_ext ! default = '.bin' + + logical, optional :: no_subdirs ! default = .false. ! locals integer :: tmp_option character(300) :: tmp_string - character(300) :: tmp_string2 character( 40) :: tmp_dir_name, tmp_file_ext, date_time_string character( 8) :: ens_id_string character( 4) :: YYYY, MMDD, HHMM, tmpstring4 character( 2) :: PP + logical :: tmp_no_subdirs ! -------------------------------------------------------- ! @@ -109,6 +113,12 @@ character(300) function get_io_filename( io_path, exp_id, file_tag, & else tmp_file_ext = '.bin' end if + + if (present(no_subdirs)) then + tmp_no_subdirs = no_subdirs + else + tmp_no_subdirs = .false. + end if ! create date/time strings @@ -179,12 +189,19 @@ character(300) function get_io_filename( io_path, exp_id, file_tag, & end if ! compose output path - tmp_string = trim(io_path) // '/' // trim(tmp_dir_name) // '/' // & - trim(ens_id_string(2:8)) // '/' - if (tmp_option>1) & - tmp_string = trim(tmp_string) // '/Y'// YYYY // '/M'//MMDD(1:2) // '/' + tmp_string = trim(io_path) // '/' + if (.not. tmp_no_subdirs) then + + tmp_string = trim(tmp_string) // trim(tmp_dir_name) // '/' // & + trim(ens_id_string(2:8)) // '/' + + if (tmp_option>1) & + tmp_string = trim(tmp_string) // '/Y'// YYYY // '/M'//MMDD(1:2) // '/' + + end if + ! append file name to path get_io_filename = trim(tmp_string) // trim(exp_id) // & diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 index c22c4f72..91e0319c 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 @@ -24,11 +24,6 @@ module LDAS_ensdrv_init_routines use MAPL_BaseMod, ONLY: & NTYPS => MAPL_NumVegTypes - use LDAS_DriverTypes, ONLY: & - out_select_type, & - out_choice_type, & - out_dtstep_type - use LDAS_TileCoordType, ONLY: & tile_coord_type, & grid_def_type, & @@ -77,15 +72,11 @@ module LDAS_ensdrv_init_routines private - public :: read_driver_inputs public :: add_domain_to_path public :: domain_setup - public :: domain_decomp public :: read_cat_param - public :: GEOS_read_catparam public :: clsm_ensdrv_get_command_line public :: io_domain_files - public :: io_rstrt !integer ,parameter :: N_gt=6, N_snow=3 @@ -95,650 +86,7 @@ module LDAS_ensdrv_init_routines contains ! ******************************************************************** - ! ******************************************************************** - - subroutine read_driver_inputs( & - restart, spin, spin_loop, & - start_time, end_time, & - model_dtstep, force_dtstep, out_dtstep, & - out_collection_ID, N_out_fields_inst, N_out_fields_tavg, & - out_ensavg, out_ensstd, out_ensall, & - dzsf, res_ftag, met_hinterp, alb_from_SWnet, & - exp_domain, exp_id, work_path, & - restart_path, restart_domain, restart_id, & - file_format_VEG, file_format_ALB, & - met_path, met_tag, veg_path, alb_path, & - soil_path, top_path, mwRTM_param_path, & - tile_coord_path, tile_coord_file, & - catchment_def_path, catchment_def_file, & - black_path, black_file, & - white_path, white_file, & - minlon, maxlon, minlat, maxlat ) - - ! read and process runtime options - ! - ! runtime options are read in three steps: - ! - ! 1.) read options from default namelist file called - ! driver_inputs.nml in working directory (must be present) - ! - ! 2.) overwrite options from special namelist file (if present) - ! specified at the command line using -driver_inputs_path - ! and -driver_inputs_file - ! - ! 3.) overwrite options from command line (if present) - ! see subroutine clsm_ensdrv_get_command_line() - ! - ! after options are read, runtime inputs are processed and - ! output from subroutine - ! - ! reichle, 12 Jun 2003 - ! reichle, 6 May 2005 - ! reichle, 16 Oct 2008 - eliminated "restart_pert" - - implicit none - - ! ---------------------------------------------------------------------- - - logical, intent(out) :: restart, spin - - integer, intent(out) :: spin_loop - - type(date_time_type), intent(out) :: start_time, end_time - - integer, intent(out) :: model_dtstep, force_dtstep - - type(out_dtstep_type), intent(out) :: out_dtstep - - integer, intent(out) :: out_collection_ID - integer, intent(out) :: N_out_fields_inst, N_out_fields_tavg - - type(out_choice_type), intent(out) :: out_ensavg, out_ensstd, out_ensall - - real, intent(out) :: dzsf - - integer, intent(out) :: met_hinterp - - logical, intent(out) :: alb_from_SWnet - - character(200), intent(out) :: work_path, restart_path - - character(40), intent(out) :: exp_domain, exp_id, res_ftag - character(40), intent(out) :: restart_domain, restart_id - - integer, intent(out) :: file_format_VEG, file_format_ALB - - character(200), intent(out) :: met_path, veg_path, alb_path - character(200), intent(out) :: soil_path, top_path, mwRTM_param_path - character(80), intent(out) :: met_tag - - character(200), intent(out) :: tile_coord_path, catchment_def_path - character(80), intent(out) :: tile_coord_file - character(40), intent(out) :: catchment_def_file - - character(200), intent(out) :: black_path, white_path - character(80), intent(out) :: black_file, white_file - - real, intent(out) :: minlon, maxlon, minlat, maxlat - - ! --------------------- - ! - ! local variables - - character(300) :: fname - - character(200) :: driver_inputs_path - character( 40) :: driver_inputs_file, dir_name, file_tag, file_ext, resolution - - type(out_select_type) :: out_select_ensavg, out_select_ensstd, out_select_ensall - - character(len=*), parameter :: Iam = 'read_driver_inputs' - character(len=400) :: err_msg - - ! -------------------------------------------------------------------- - - namelist / driver_inputs / & - restart, spin, spin_loop, & - start_time, end_time, & - model_dtstep, force_dtstep, out_dtstep, & - out_collection_ID, & - out_select_ensavg, out_select_ensstd, out_select_ensall, & - dzsf, resolution, met_hinterp, alb_from_SWnet, & - work_path, exp_domain, exp_id, & - restart_path, restart_domain, restart_id, & - file_format_VEG, file_format_ALB, & - met_path, met_tag, veg_path, alb_path, & - soil_path, top_path, mwRTM_param_path, & - tile_coord_path, tile_coord_file, & - catchment_def_path, catchment_def_file, & - black_path, black_file, & - white_path, white_file, & - minlon, maxlon, minlat, maxlat - - ! --------------------------------------------------------------------- - ! - ! Set default file name for driver inputs namelist file - - driver_inputs_path = './' ! set default - call clsm_ensdrv_get_command_line(run_path=driver_inputs_path) - driver_inputs_file = 'LDASsa_DEFAULT_inputs_driver.nml' - - ! Read data from default driver_inputs namelist file - - fname = trim(driver_inputs_path) // '/' // trim(driver_inputs_file) - open (10, file=fname, delim='apostrophe', action='read', status='old') - - if (logit) write (logunit,*) - if (logit) write (logunit,'(400A)') 'reading *default* driver inputs from ' // trim(fname) - if (logit) write (logunit,*) - - read (10, nml=driver_inputs) - - close(10,status='keep') - - ! Get name and path for special driver inputs file from - ! command line (if present) - - driver_inputs_path = '' - driver_inputs_file = '' - - call clsm_ensdrv_get_command_line( & - driver_inputs_path=driver_inputs_path, & - driver_inputs_file=driver_inputs_file ) - - if ( trim(driver_inputs_path) /= '' .and. & - trim(driver_inputs_file) /= '' ) then - - ! Read data from special driver_inputs namelist file - - fname = trim(driver_inputs_path) // '/' // trim(driver_inputs_file) - - open (10, file=fname, delim='apostrophe', action='read', status='old') - - if (logit) write (logunit,*) - if (logit) write (logunit,'(400A)') 'reading *special* driver inputs from ' // trim(fname) - if (logit) write (logunit,*) - - read (10, nml=driver_inputs) - - close(10,status='keep') - - end if - - ! Overwrite inputs with command line options, if any - - if (logit) write (logunit,*) & - 'overwriting driver inputs with command line args (if present)' - - call clsm_ensdrv_get_command_line( & - start_time=start_time, & - end_time=end_time, & - resolution=resolution, & - exp_domain=exp_domain, & - exp_id=exp_id, work_path=work_path, & - restart_path=restart_path, restart_domain=restart_domain, & - restart_id=restart_id, & - tile_coord_path=tile_coord_path, & - tile_coord_file=tile_coord_file, & - catchment_def_path=catchment_def_path, & - catchment_def_file=catchment_def_file, & - met_tag=met_tag, & - met_path=met_path, & - force_dtstep=force_dtstep, & - restart=restart, & - spin=spin & - ) - - ! echo variables of driver_inputs - - if (logit) write (logunit,*) 'driver inputs are:' - if (logit) write (logunit,*) - if (logit) write (logunit, nml=driver_inputs) - if (logit) write (logunit,*) - - ! ------------------------------------------------------------- - - ! make sure day-of-year and pentad are correctly initialized - - call get_dofyr_pentad( start_time ) - call get_dofyr_pentad( end_time ) - - ! during spin-up, restart_path/_domain/_id must match work_path/_domain/_id - - if (spin) then - - restart_path = work_path - restart_domain = exp_domain - restart_id = exp_id - - end if - - ! ------------------------------------------------------------- - - ! process paths and file names - - ! Add "domain" to work_path - - work_path = add_domain_to_path( work_path, exp_domain ) - - met_path = trim(met_path) // '/' - - ! append "resolution" to input paths - ! ("resolution" = dir name where Catchment model params are stored) - - veg_path = trim(veg_path) // '/' // trim(resolution) - alb_path = trim(alb_path) // '/' // trim(resolution) - soil_path = trim(soil_path) // '/' // trim(resolution) - top_path = trim(top_path) // '/' // trim(resolution) - - mwRTM_param_path = trim(mwRTM_param_path) // '/' // trim(resolution) - - tile_coord_path = trim(tile_coord_path) // '/' // trim(resolution) - catchment_def_path = trim(catchment_def_path) // '/' // trim(resolution) - - black_path = trim(black_path) // '/' // trim(resolution) - white_path = trim(white_path) // '/' // trim(resolution) - - ! ------------------------------------------------------------- - - ! extract "res_ftag" from "resolution" - ! ("res_ftag" is part of the file name for vegetation, albedo, and elev data) - - select case (trim(resolution)) - - ! GEOS-5 lat/lon tile space - - case( '144x91', & - 'FV_144x91', & - 'DC0144xPC0091_DE0360xPE0180', & - 'DC0144xPC0091_DE1440xPE0720', & - 'DC0144xPC0091_DE2880xPE1440' ); res_ftag= '144x91_DC' - - case( '288x181', & - 'FV_288x181', & - 'DC0288xPC0181_DE0360xPE0180', & - 'DC0288xPC0181_DE1440xPE0720', & - 'DC0288xPC0181_DE2880xPE1440' ); res_ftag= '288x181_DC' - - case( '540x361', & - 'FV_540x361', & - 'DC0540xPC0361_DE0360xPE0180' ); res_ftag= '540x361_DC' - - case( '576x361', & - 'FV_576x361', & - 'DC0576xPC0361_DE0360xPE0180', & - 'DC0576xPC0361_DE1440xPE0720', & - 'DC0576xPC0361_DE2880xPE1440' ); res_ftag= '576x361_DC' - - case( '1152x721', & - 'FV_1152x721', & - 'DC1152xPC0721_DE0360xPE0180', & - 'DC1152xPC0721_DE1440xPE0720', & - 'DC1152xPC0721_DE2880xPE1440' ); res_ftag= '1152x721_DC' - - ! GEOS-5 cube-sphere tile space - - case('CF0048x6C_DE0360xPE0180', & - 'CF0048x6C_DE1440xPE0720', & - 'CF0048x6C_DE2880xPE1440' ); res_ftag = '48x288' - - case('CF0090x6C_DE0360xPE0180', & - 'CF0090x6C_DE1440xPE0720', & - 'CF0090x6C_DE2880xPE1440' ); res_ftag = '90x540' - - case('CF0180x6C_DE0360xPE0180', & - 'CF0180x6C_DE1440xPE0720', & - 'CF0180x6C_DE2880xPE1440' ); res_ftag = '180x1080' - - case('CF0360x6C_DE0360xPE0180', & - 'CF0360x6C_DE1440xPE0720', & - 'CF0360x6C_DE2880xPE1440' ); res_ftag = '360x2160' - - case('CF0720x6C_DE0360xPE0180', & - 'CF0720x6C_DE1440xPE0720', & - 'CF0720x6C_DE2880xPE1440' ); res_ftag = '720x4320' - - case('CF1000x6C_DE0360xPE0180', & - 'CF1000x6C_DE1440xPE0720', & - 'CF1000x6C_DE2880xPE1440' ); res_ftag = '1000x6000' - - case('CF1440x6C_DE0360xPE0180', & - 'CF1440x6C_DE1440xPE0720', & - 'CF1440x6C_DE2880xPE1440' ); res_ftag = '1440x8640' - - ! (SMAP) EASE tile space, non-GEOS-5 tile space - - case ('SMAP_EASEv2_M09'); res_ftag = '3856x1624_DE' - case ('SMAP_EASEv2_M36'); res_ftag = '964x406_DE' - case ('SMAP_EASE_M09'); res_ftag = '3852x1632_DE' - case ('SMAP_EASE_M36'); res_ftag = '963x408_DE' - - ! default (for backward compatibility in case an old bcs directory is used) - - case default; res_ftag = '' - - end select - - ! ------------------------------------------------------------------------ - ! - ! obtain total number of output fields in output file collection - ! for time-avg or instantaneous output (tile or grid) - ! - ! *must* be consistent with what is defined in subroutine output_calcs() - - select case (out_collection_ID) - - case ( 1) ! legacy LDASsa output collection - - N_out_fields_inst = 44 - N_out_fields_tavg = N_out_fields_inst - - case ( 2) ! SMAP Nature (v02) - - N_out_fields_inst = 6 - N_out_fields_tavg = N_out_fields_inst - - case ( 3) ! mwRTM calibration (before Dec 2013), SMOS DA - - N_out_fields_inst = 8 - N_out_fields_tavg = N_out_fields_inst - - case ( 4) ! MERRA-Land - - N_out_fields_inst = 50 - N_out_fields_tavg = N_out_fields_inst - - case ( 5) ! MERRA-Land (with additional files) - - N_out_fields_inst = 59 - N_out_fields_tavg = N_out_fields_inst - - case ( 6) ! SMAP L4_SM gph collection - - N_out_fields_inst = 40 ! EXCL sm in pctl units! - N_out_fields_tavg = N_out_fields_inst - - case ( 7,8) ! SMAP Nature (v03) - - ! These output collections have *different* variables for inst and tavg output!! - ! (see subroutine output_calcs() for details) - - if (out_collection_ID==7) then - - N_out_fields_inst = 4 ! SMAP_Nature_v03: 2001-2009 - N_out_fields_tavg = 4 ! SMAP_Nature_v03: n/a - - elseif (out_collection_ID==8) then - - N_out_fields_inst = 5 ! SMAP_Nature_v03: 2010-201? - N_out_fields_tavg = 6 ! SMAP_Nature_v03: 2010-201? - - end if - - case ( 9) ! mwRTM calibration (Dec 2013) - - ! This output collection has *different* variables for inst and tavg output!! - ! (see subroutine output_calcs() for details) - - N_out_fields_inst = 6 - N_out_fields_tavg = 2 - - case (10) ! legacy LDASsa output collection, plus t2m and q2m - - N_out_fields_inst = 46 - N_out_fields_tavg = N_out_fields_inst - - case (11) ! SMOS preprocessing (Mar 2015) - - N_out_fields_inst = 5 - N_out_fields_tavg = N_out_fields_inst - - case default - - err_msg = 'Error: unknown out_collection_ID' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - - ! ------------------------------------------------------------------------ - ! - ! process ensavg output choices - - call get_out_choice( out_select_ensavg, out_ensavg ) - call get_out_choice( out_select_ensstd, out_ensstd ) - call get_out_choice( out_select_ensall, out_ensall ) - - ! ------------------------------------------------------------------------ - - ! Check timestep parameters - - ! force_dtstep = forcing time step in seconds - ! model_dtstep = model time step in seconds - - if (model_dtstep>450) then - err_msg = 'model time step too large, 450s suggested' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (model_dtstep<30) then - err_msg = 'model time step very small. Are you sure?' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,model_dtstep)/=0) then - err_msg = 'day not evenly divided by model time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if (mod(force_dtstep,model_dtstep)/=0) then - err_msg = 'model and forcing time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,force_dtstep)/=0) then - err_msg = 'day not evenly divided by forcing time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if (mod(out_dtstep%rstrt,model_dtstep)/=0) then - err_msg = 'model and restart time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (out_dtstep%rstrt>0) then - if (mod(86400,out_dtstep%rstrt)/=0) then - err_msg = 'day not evenly divided by restart time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - end if - - if ( out_ensavg%inst%any .or. & - out_ensstd%inst%any .or. & - out_ensall%inst%any ) then - - if (mod(out_dtstep%inst,model_dtstep)/=0) then - err_msg = 'model and inst time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,out_dtstep%inst)/=0) then - err_msg = 'day not evenly divided by inst time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (out_dtstep%inst>86400) then - err_msg = 'inst time step > 1 day not allowed' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(start_time%hour*3600,out_dtstep%inst)/=0) .or. & - (start_time%min/=0) .or. & - (start_time%sec/=0) ) then - err_msg = 'inst time step clashes with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(end_time%hour*3600,out_dtstep%inst)/=0) .or. & - (end_time%min/=0) .or. & - (end_time%sec/=0) ) then - err_msg = 'inst time step clashes with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%xhourly%any .or. & - out_ensstd%xhourly%any .or. & - out_ensall%xhourly%any ) then - - if (mod(out_dtstep%xhourly,model_dtstep)/=0) then - err_msg = 'model and xhourly time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,out_dtstep%xhourly)/=0) then - err_msg = 'day not evenly divided by xhourly time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (out_dtstep%xhourly>86400) then - err_msg = 'xhourly time step > 1 day not allowed' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(start_time%hour*3600,out_dtstep%xhourly)/=0) .or. & - (start_time%min/=0) .or. & - (start_time%sec/=0) ) then - err_msg = 'xhourly time step clashes with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(end_time%hour*3600,out_dtstep%xhourly)/=0) .or. & - (end_time%min/=0) .or. & - (end_time%sec/=0) ) then - err_msg = 'xhourly time step clashes with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%daily%any .or. & - out_ensstd%daily%any .or. & - out_ensall%daily%any ) then - - if ((start_time%hour/=0) .or. & - (start_time%min/=0) .or. (start_time%sec/=0) ) then - err_msg = 'out_daily incompatible with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((end_time%hour/=0) .or. & - (end_time%min/=0) .or. (end_time%sec/=0) ) then - err_msg = 'out_daily incompatible with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%pentad%any .or. & - out_ensstd%pentad%any .or. & - out_ensall%pentad%any ) then - - ! these checks are VERY incomplete!!! - - if ((start_time%hour/=0) .or. & - (start_time%min/=0) .or. (start_time%sec/=0) ) then - err_msg = 'out_pentad incompatible with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((end_time%hour/=0) .or. & - (end_time%min/=0) .or. (end_time%sec/=0) ) then - err_msg = 'out_pentad incompatible with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%monthly%any .or. & - out_ensstd%monthly%any .or. & - out_ensall%monthly%any ) then - - if ((start_time%day/=1) .or. (start_time%hour/=0) .or. & - (start_time%min/=0) .or. (start_time%sec/=0) ) then - err_msg = 'out_monthly incompatible with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((end_time%day/=1) .or. (end_time%hour/=0) .or. & - (end_time%min/=0) .or. (end_time%sec/=0) ) then - err_msg = 'out_monthly incompatible with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - ! ------------------------------------------------------------- - ! - ! save driver inputs into *driver_inputs.nml file - - dir_name = 'rc_out' - file_tag = 'ldas_driver_inputs' - file_ext = '.nml' - fname = get_io_filename( work_path, exp_id, file_tag, date_time=start_time, & - dir_name=dir_name, file_ext=file_ext ) - - if (logit) write (logunit,'(400A)') 'writing driver inputs to ' // trim(fname) - if (logit) write (logunit,*) - - open (10, file=fname, status='unknown', action='write', delim='apostrophe') - - write(10, nml=driver_inputs) - - close(10, status='keep') - - end subroutine read_driver_inputs - - ! **************************************************************** - - subroutine get_out_choice( out_select_x, out_x ) - - ! reichle, 23 Dec 2011 - - implicit none - - type(out_select_type), intent(in) :: out_select_x - type(out_choice_type), intent(out) :: out_x - - ! ------------------------------------------------------------------ - - out_x%inst%tile = out_select_x%tile%inst - out_x%xhourly%tile = out_select_x%tile%xhourly - out_x%daily%tile = out_select_x%tile%daily - out_x%pentad%tile = out_select_x%tile%pentad - out_x%monthly%tile = out_select_x%tile%monthly - - out_x%inst%grid = out_select_x%grid%inst - out_x%xhourly%grid = out_select_x%grid%xhourly - out_x%daily%grid = out_select_x%grid%daily - out_x%pentad%grid = out_select_x%grid%pentad - out_x%monthly%grid = out_select_x%grid%monthly - - out_x%inst%any = out_x%inst%tile .or. out_x%inst%grid - out_x%xhourly%any = out_x%xhourly%tile .or. out_x%xhourly%grid - out_x%daily%any = out_x%daily%tile .or. out_x%daily%grid - out_x%pentad%any = out_x%pentad%tile .or. out_x%pentad%grid - out_x%monthly%any = out_x%monthly%tile .or. out_x%monthly%grid - - out_x%any%tile = & - out_x%inst%tile .or. & - out_x%xhourly%tile .or. & - out_x%daily%tile .or. & - out_x%pentad%tile .or. & - out_x%monthly%tile - - out_x%any%grid = & - out_x%inst%grid .or. & - out_x%xhourly%grid .or. & - out_x%daily%grid .or. & - out_x%pentad%grid .or. & - out_x%monthly%grid - - out_x%any%any = & - out_x%inst%any .or. & - out_x%xhourly%any .or. & - out_x%daily%any .or. & - out_x%pentad%any .or. & - out_x%monthly%any - - end subroutine get_out_choice - - ! **************************************************************** character(200) function add_domain_to_path( pathname, exp_domain ) @@ -1010,267 +358,6 @@ end subroutine domain_setup ! ********************************************************************** - subroutine domain_decomp(numprocs, N_tile, tile_coord, N_tiles_cont, & - work_path, exp_domain, exp_id, date_time, low_ind, upp_ind, N_catl_vec ) - - ! decompose the *re-ordered* tile_coord structure into numprocs sub-domains. - ! Do NOT include tiles from different continents within same local domain. - ! - ! IMPORTANT: tiles in tile_coord must in order of (re-assigned) continents - ! and Level 1 Pfafstetter basin IDs - see subroutine reorder_tiles() - ! - ! reichle, 26 June 2012 - ! - ! --------------------------------------------------------------- - - implicit none - - integer, intent(in) :: numprocs, N_tile - - type(tile_coord_type), dimension(N_tile), intent(in) :: tile_coord - - integer, dimension(N_cont_max), intent(in) :: N_tiles_cont - - character(200), intent(in) :: work_path - character(40), intent(in) :: exp_domain - character(40), intent(in) :: exp_id - - type(date_time_type), intent(in) :: date_time - - integer, dimension(numprocs), intent(out) :: low_ind, upp_ind - integer, dimension(numprocs), intent(out) :: N_catl_vec - - ! local variables - - integer :: i, j, k, k_keep, N_cont_tmp, istat - integer :: N_target, N_tmp, N_tmp_cum, N_missing - - integer, dimension(N_cont_max) :: numprocs_cont, N_tiles_cont_tmp - - integer, dimension(:), allocatable :: d2p ! domain-to-processor - - integer, parameter :: unitnumber = 10 - - character(300) :: fname - character( 40) :: file_tag, dir_name, file_ext - - character(len=*), parameter :: Iam = 'domain_decomp' - character(len=400) :: err_msg - type(ESMF_VM) :: vm - integer :: status - - ! ----------------------------------------------------------------------------- - call ESMF_VmGetCurrent(vm, rc=status) - master_proc = MAPL_Am_I_Root(vm) - ! - ! make sure there is at least one tile per processor - - - if (numprocs>N_tile) then - err_msg = 'Number of processors cannot exceed number of tiles' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! ------------------------------------------------------------------------- - - if (numprocs==1) then ! sequential - - low_ind(1) = 1 - upp_ind(1) = N_tile - - N_catl_vec(1) = N_tile - - else ! MPI parallel - - ! zoom into continents that have at least one tile - - N_tiles_cont_tmp = -9999 - - k_keep = 0 - - do k=1,N_cont_max - - if (N_tiles_cont(k)>0) then - - k_keep = k_keep + 1 - - N_tiles_cont_tmp(k_keep) = N_tiles_cont(k) - - end if - - end do - - N_cont_tmp = k_keep - - ! determine target number of tiles assigned to each processor - - N_target = nint( real(N_tile) / real(numprocs) ) - - ! determine number of processors assigned to each continent - - do k=1,N_cont_tmp - - ! ensure that each continent gets at least one processor - - numprocs_cont(k) = max( nint(real(N_tiles_cont_tmp(k))/real(N_target)), 1) - - end do - - ! ensure that all available processors are used (and none extra) - - numprocs_cont(N_cont_tmp) = numprocs - sum(numprocs_cont(1:N_cont_tmp-1)) - - ! make sure the final continent also gets at least one processor - - if (numprocs_cont(N_cont_tmp)<=0) then - - if (all(numprocs_cont<=1)) then - - err_msg = 'too many continents, not enough processors' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - ! NOTE: could iterate and merge continents - - else - - ! At this point numprocs_cont(N_cont_tmp) could be zero - ! or negative. - ! - ! Reallocate processors from the first continent with "spare" - ! processors such that numprocs_cont(N_cont_tmp)=1 and - ! sum(numprocs_cont(1:N_cont_tmp))=numprocs - ! - ! (could be improved by taking the "spares" from the - ! continent with at least two processors and the lowest ratio - ! of N_tiles/numprocs_cont) - - N_missing = 1 - numprocs_cont(N_cont_tmp) - - do k=1,(N_cont_tmp-1) - - if (numprocs_cont(k)>=N_missing+1) then - - numprocs_cont(k) = numprocs_cont(k) - N_missing - - numprocs_cont(N_cont_tmp) = 1 - - exit - - end if - - end do - - end if - - end if - - ! double-check one more time - - if ( any(numprocs_cont(1:N_cont_tmp)<=0) .or. & - sum(numprocs_cont(1:N_cont_tmp))/=numprocs ) then - err_msg = 'error in allocation of processors to continents' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! map tiles to processors by continent - - low_ind(1) = 1 - upp_ind(numprocs) = N_tile - - j = 0 - - do k=1,N_cont_tmp - - N_tmp_cum = 0 ! cumulative number of tiles assigned to continent so far - - do i=1,numprocs_cont(k) - - j=j+1 ! counter for all processors (independent of continent) - - if (jnull() - type(MAPL_LocStream) :: locstream - type(ESMF_Grid) :: TILEGRID - integer, pointer :: mask(:) - integer :: rc, status,unit, N_catl - character(*),parameter :: Iam="GEOS_read_catparam" - real,allocatable :: tmp(:) - logical :: file_exists - - call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_Get(MAPL, LocStream=locstream,rc=status) - VERIFY_(status) - - call MAPL_LocStreamGet(LOCSTREAM, NT_LOCAL=N_catl,TILEGRID=TILEGRID, RC=STATUS) - VERIFY_(STATUS) - - call MAPL_TileMaskGet(tilegrid, mask, rc=status) - VERIFY_(STATUS) - - inquire (file=trim(fname), exist=file_exists) - - if (.not. file_exists) then - if (logit) write (logunit,*) 'The file does not exist: ', trim(fname) - call ldas_abort(LDAS_GENERIC_ERROR, Iam, "should have"//trim(fname)) - endif - - - unit = GETFILE( trim(fname), form="unformatted", RC=STATUS ) - VERIFY_(STATUS) - - allocate(tmp(N_catl)) - - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dpth , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzsf , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzrz , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzpr , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(1) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(2) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(3) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(4) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(5) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(6) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%poros , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%cond , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%psis , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bee , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%wpwet , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%gnu , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%vgwmax, mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarRead(unit, tilegrid,tmp(:), mask=mask, rc=status); VERIFY_(STATUS) - cat_param(:)%vegcls = nint(tmp) - call MAPL_VarRead(unit, tilegrid,tmp(:), mask=mask, rc=status); VERIFY_(STATUS) - cat_param(:)%soilcls30 = nint(tmp) - call MAPL_VarRead(unit, tilegrid,tmp(:), mask=mask, rc=status); VERIFY_(STATUS) - cat_param(:)%soilcls100 = nint(tmp) - - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bf1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bf2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bf3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%cdcr1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%cdcr2, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ars1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ars2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ars3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara4 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw4 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsa1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsa2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsb1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsb2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%atau , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%btau , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%gravel30, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%orgC30 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%orgC , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%sand30 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%clay30 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%sand , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%clay , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%wpwet30, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%poros30, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%veghght, mask=mask, rc=status); VERIFY_(STATUS) - - call FREE_FILE(unit, RC=STATUS); VERIFY_(STATUS) - - end subroutine GEOS_read_catparam + ! ************************************************************************* subroutine read_VEG_Height( & N_catg, veg_path, V_HEIGHT ) @@ -2720,168 +1708,6 @@ end subroutine clsm_ensdrv_get_command_line ! *********************************************************************** - subroutine io_rstrt( action, work_path, exp_id, ens_id, date_time, & - N_catd, cat_progn, file_tag, dir_name, is_little_endian ) - - ! read or write re-start file. - ! - ! reichle, 11 May 2005 - ! reichle, 5 Jun 2006 - adapted for output of increments - - implicit none - - character, intent(in) :: action ! read or write - - character(*), intent(in) :: work_path - character(*), intent(in) :: exp_id - - type(date_time_type), intent(in) :: date_time - - integer, intent(in) :: ens_id, N_catd - - type(cat_progn_type), dimension(N_catd), intent(inout) :: cat_progn - - character(*), optional, intent(in) :: file_tag, dir_name - - logical, optional, intent(in) :: is_little_endian - - ! local variables - - character(40), parameter :: file_tag_default = 'catch_ldas_rst' - character(40), parameter :: dir_name_default = 'rs' - - integer :: n, k - - character(300) :: filename - character(40) :: file_tag_tmp, dir_name_tmp, endian_string - - character(len=*), parameter :: Iam = 'io_rstrt' - character(len=400) :: err_msg - - ! -------------------------------------------------------------------- - - if (present(file_tag)) then - file_tag_tmp = file_tag - - else - - file_tag_tmp = file_tag_default - - end if - - if (present(dir_name)) then - - dir_name_tmp = dir_name - - else - - dir_name_tmp = dir_name_default - - end if - - endian_string = 'big_endian' ! default - - if (present(is_little_endian)) then - - if (is_little_endian) endian_string = 'little_endian' - - end if - - ! ---------------------------------------------------------- - - select case (action) - - case ('r','R') - - filename = get_io_filename( work_path, exp_id, & - file_tag_tmp, date_time=date_time, & - dir_name=dir_name_tmp, ens_id=ens_id ) - - if (logit) write (logunit,'(400A)') 'Reading restart file ' // trim(filename) - - open(10, file=filename, form='unformatted', status='old', & - convert=trim(endian_string), action='read') - - read (10) (cat_progn(n)%tc1, n=1,N_catd) - read (10) (cat_progn(n)%tc2, n=1,N_catd) - read (10) (cat_progn(n)%tc4, n=1,N_catd) - - - read (10) (cat_progn(n)%qa1, n=1,N_catd) - read (10) (cat_progn(n)%qa2, n=1,N_catd) - read (10) (cat_progn(n)%qa4, n=1,N_catd) - - read (10) (cat_progn(n)%capac, n=1,N_catd) - - read (10) (cat_progn(n)%catdef, n=1,N_catd) - read (10) (cat_progn(n)%rzexc, n=1,N_catd) - read (10) (cat_progn(n)%srfexc, n=1,N_catd) - - do k=1,N_gt - read (10) (cat_progn(n)%ght(k), n=1,N_catd) - end do - - do k=1,N_snow - read (10) (cat_progn(n)%wesn(k), n=1,N_catd) - end do - do k=1,N_snow - read (10) (cat_progn(n)%htsn(k), n=1,N_catd) - end do - do k=1,N_snow - read (10) (cat_progn(n)%sndz(k), n=1,N_catd) - end do - - - case ('w','W') - - filename = get_io_filename( work_path, exp_id, & - file_tag_tmp, date_time=date_time, & - dir_name=dir_name_tmp, ens_id=ens_id ) - - if (logit) write (logunit,'(400A)') 'Writing restart (or incr) file ' // trim(filename) - - open(10, file=filename, form='unformatted', status='unknown', & - convert=trim(endian_string), action='write') - - write (10) (cat_progn(n)%tc1, n=1,N_catd) - write (10) (cat_progn(n)%tc2, n=1,N_catd) - write (10) (cat_progn(n)%tc4, n=1,N_catd) - - write (10) (cat_progn(n)%qa1, n=1,N_catd) - write (10) (cat_progn(n)%qa2, n=1,N_catd) - write (10) (cat_progn(n)%qa4, n=1,N_catd) - - - write (10) (cat_progn(n)%capac, n=1,N_catd) - - write (10) (cat_progn(n)%catdef, n=1,N_catd) - write (10) (cat_progn(n)%rzexc, n=1,N_catd) - write (10) (cat_progn(n)%srfexc, n=1,N_catd) - - do k=1,N_gt - write (10) (cat_progn(n)%ght(k), n=1,N_catd) - end do - - do k=1,N_snow - write (10) (cat_progn(n)%wesn(k), n=1,N_catd) - end do - do k=1,N_snow - write (10) (cat_progn(n)%htsn(k), n=1,N_catd) - end do - do k=1,N_snow - write (10) (cat_progn(n)%sndz(k), n=1,N_catd) - end do - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown action') - - end select - - close (10,status='keep') - - end subroutine io_rstrt - end module LDAS_ensdrv_init_routines ! *********** EOF ****************************************************** diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 index 323e1807..3574dab3 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 @@ -66,7 +66,7 @@ module LDAS_ensdrv_mpi integer, public :: MPI_cat_diagS_type, MPI_cat_diagF_type integer, public :: MPI_met_force_type, MPI_veg_param_type integer, public :: MPI_bal_diagn_type, MPI_alb_param_type - integer, public :: MPI_date_time_type, MPI_out_dtstep_type, MPI_out_choice_type + integer, public :: MPI_date_time_type integer, public :: MPI_mwRTM_param_type,MPI_obs_type, MPI_obs_param_type integer, public :: MPI_cat_progn_int_type, MPI_cat_bias_param_type integer, public :: MPI_obs_bias_type @@ -121,76 +121,6 @@ subroutine init_MPI_types() deallocate(idisp) deallocate(itype) - ! --------------------------------------------------------------- - ! - ! type output time steps - ! - ! type :: out_dtstep_type - ! integer :: rstrt - ! integer :: inst - ! integer :: xhourly - ! end type out_dtstep_type - - icount = 1 - - allocate(iblock(icount)) - allocate(idisp( icount)) - allocate(itype( icount)) - - itype(1) = MPI_INTEGER - - iblock(1) = 3 - - idisp(1) = 0 - - call MPI_TYPE_CREATE_STRUCT( icount, iblock, idisp, itype, & - MPI_out_dtstep_type, mpierr ) - - call MPI_TYPE_COMMIT(MPI_out_dtstep_type, mpierr) - - deallocate(iblock) - deallocate(idisp) - deallocate(itype) - - ! --------------------------------------------------------------- - ! - ! type for output choices *after* processing in read_driver_inputs() - ! - ! type :: out_choice_space_type - ! logical :: tile - ! logical :: grid - ! logical :: any - ! end type out_choice_space_type - ! - ! type :: out_choice_type - ! type(out_choice_space_type) :: inst - ! type(out_choice_space_type) :: xhourly - ! type(out_choice_space_type) :: daily - ! type(out_choice_space_type) :: pentad - ! type(out_choice_space_type) :: monthly - ! type(out_choice_space_type) :: any - ! end type out_choice_type - - icount = 1 - - allocate(iblock(icount)) - allocate(idisp( icount)) - allocate(itype( icount)) - - itype(1) = MPI_LOGICAL - - iblock(1) = 18 - - idisp(1) = 0 - - call MPI_TYPE_CREATE_STRUCT( icount, iblock, idisp, itype, & - MPI_out_choice_type, mpierr ) - - call MPI_TYPE_COMMIT(MPI_out_choice_type, mpierr) - - deallocate(iblock) - deallocate(idisp) - deallocate(itype) ! -------------------------------------------------------------------------------- ! From acec6c74073de77a9c6605177770f5df182bd11a Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Mon, 11 May 2020 15:08:55 -0400 Subject: [PATCH 19/42] Update Externals.cfg in prep for beta.5 pre-release --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index f9970364..60601a4e 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = master +tag = v1.1.3 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -branch = develop +tag = v1.8.3 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From f34d5ba57a1be42f61b8fefe0cab1c8b08a0e1d8 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Mon, 11 May 2020 15:26:36 -0400 Subject: [PATCH 20/42] Sync BRIDGE_FROM_DEVELOP_TO_MASTER into master (#216) --- Externals.cfg | 4 +- doc/CHANGELOG.md | 71 +- doc/README.metforcing_and_bcs.md | 32 +- src/Applications/LDAS_App/GEOSldas_LDAS.rc | 64 +- .../LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml | 27 +- src/Applications/LDAS_App/ldas_setup | 208 +- src/Applications/LDAS_App/lenkf.j.template | 194 +- .../GEOS_LandAssimGridComp.F90 | 12 +- .../clsm_ensdrv_drv_routines.F90 | 853 +------ .../clsm_ensdrv_out_routines.F90 | 1969 +---------------- .../clsm_ensupd_enkf_update.F90 | 42 +- .../clsm_ensupd_upd_routines.F90 | 92 +- .../GEOSlandassim_GridComp/enkf_general.F90 | 63 +- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 367 +-- .../Shared/LDAS_DriverTypes.F90 | 76 - .../Shared/LDAS_ensdrv_Globals.F90 | 13 - .../Shared/LDAS_ensdrv_functions.F90 | 55 +- .../Shared/LDAS_ensdrv_init_routines.F90 | 1176 +--------- .../Shared/LDAS_ensdrv_mpi.F90 | 72 +- 19 files changed, 720 insertions(+), 4670 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index abbfd6e2..60601a4e 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -2,7 +2,7 @@ required = True repo_url = git@github.com:GEOS-ESM/ESMA_env.git local_path = ./@env -tag = v2.1.1+intel19.1.0 +tag = v2.1.3+intel19.1.0 protocol = git [ESMA_cmake] @@ -25,7 +25,7 @@ sparse = ../../../config/GMAO_Shared.sparse required = True repo_url = git@github.com:GEOS-ESM/MAPL.git local_path = ./src/Shared/@MAPL -tag = v2.1.1 +tag = v2.1.3 protocol = git [GEOSgcm_GridComp] diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index 2d5e2d03..116048bf 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -30,17 +30,69 @@ In 2019, GEOS LDAS version control transferred from CVS to Git. This README file contains the history of stable GEOSldas versions ("tags") in Git, followed by older, CVS LDASsa and GEOSldas versions and change logs. -[Unreleased] Features: --------------------- -_These are additions put in development, that will be in the next stable tag_ +Overview of Git Releases: +============================ +[v17.9.0-beta.5](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.5) - 2020-05-11 +------------------------------ +- Pre-release meant for use under SLES12 at NCCS. Still works for SLES11. +- New/Updated Science Functionality: + - Forecast error covariance inflation with scalar (globally constant) factor. +- New/Updated Infrastructure: -Overview of Git tags: -============================ + - Support for GEOS FP forcing with generic ("seamless") file names. + - Resource parameter changes: + - Renamed NUM_ENSEMBLE to NUM_LDAS_ENSEMBLE in "exeinp" file to be consistent with LDAS.rc. + - Renamed MONTHLY_OUTPUT to POSTPROC_HIST. + - Updated utilities to MAPL v2.1.3, ESMA_env v2.1.3+intel19.1.0. + +- Bug Fixes and Other Minor Changes: + + - Added basic protections for concatenation of sub-daily into daily nc4 files and for generation of monthly-mean nc4 files. + - Write ObsFcstAna and smapL4SMaup files into ./scratch, then move to ana/ens_avg/year/month dir in postprocessing. + - Some cleanup of obsolete LDASsa code. + +------------------------------ +[v17.9.0-beta.4-SLES12](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.4-SLES12) - 2020-04-24 +------------------------------ +- Pre-release meant for use under SLES12 at NCCS, otherwise identical to v17.9.0-beta.4-SLES11. +- Works under SLES12 using the Intel-19 compiler. +- Also works under SLES11 using the Intel-18 compiler but is not zero-diff across compilers/operating systems. + +------------------------------ +[v17.9.0-beta.4-SLES11](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.4-SLES11) - 2020-04-23 +------------------------------ +- Pre-release meant for use under SLES11 at NCCS. Under SLES12, use v17.9.0-beta.4-SLES12 (or newer). +- Uses the Intel-18 compiler and also appears to work under SLES12. However, LDASsa with Intel-18 under SLES12 was found to create bad Fortran sequential binary files out of a subroutine that is very similar in LDASsa and GEOSldas. +- Zero-diff vs. v17.9.0-beta.3 for Catchment only (except SMAP L1C Tb fore-minus-aft check). +- Not zero-diff for CatchCN (via v1.8.3 of GEOS_GCMGridComp). + +- New/Updated Science Functionality: + + - Resurrected SMAP L1C Tb fore-minus-aft check. + +- New/Updated Infrastructure: + + - Updated utilities to MAPL v2.1.1, ESMA_env v2.1.1., ESMA_cmake v3.0.1. + - New GEOS_SurfaceGridComp.rc file (via v1.8.3 of GEOS_GCMGridComp). + - Parallel post-processing. + - Cross-stream support for FP f525_p5 forcing. + - ~sbatch~ submission for pre-processing of restarts to comply with SLES12 requirements. + - Subdaily-to-daily concatenation processes before month is complete. + - Temporary solution to create directories for ObsFcstAna files to enable extending an existing GEOSldas run without going through setup. + +- Bug Fixes and Other Minor Changes: + + - Updated README.md. + - ~obspertrseed~ restart file name when restarting from existing run. + - Subdaily-to-daily nc4 concatenation (indent error). + - Fixes for GNU compiler in debug mode. + - Fixed ~landpert~ checkpoint output when on cube-sphere tiles. +------------------------------ [v17.9.0-beta.3](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.3) - 2020-03-18 ------------------------------ - Additional RESTART options, incl. from re-tiling MERRA-2, FP, or other restarts on different tile space or with different boundary conditions @@ -240,6 +292,15 @@ reichle-LDASsa_m3-16_6_p1 9 Jul 2018 Added GEOS-5.21 FP function - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - reichle-LDASsa_m3-16_6_p2 7 Mar 2019 Added GEOS-5.22 FP functionality (patch targeted for NRv7.2 and SMAP L4_SM ops) +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +reichle-LDASsa_m3-16_6_p3 30 Jan 2020 Added GEOS-5.25 FP functionality + (patch targeted for NRv7.2 and SMAP L4_SM ops) +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +reichle-LDASsa_m3-16_6_p4 3 Apr 2020 Added GEOS-5.25_p5 FP functionality + (patch targeted for NRv7.2 and SMAP L4_SM ops) +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +reichle-LDASsa_m3-16_6_p4_SLES12 14 Apr 2020 SLES12 version of *_p4 tag -- NOT zero-diff!! + (patch targeted for NRv7.2 and SMAP L4_SM ops) ------------------------------------------------------------------------------------- ------------------------------------------------------------------------------------- diff --git a/doc/README.metforcing_and_bcs.md b/doc/README.metforcing_and_bcs.md index d2d60956..24de37c6 100644 --- a/doc/README.metforcing_and_bcs.md +++ b/doc/README.metforcing_and_bcs.md @@ -72,7 +72,7 @@ SMAP_Nature_v04, SMAP_Nature_v04.1 MET_PATH : /discover/nobackup/projects/gmao/merra/iau/merra_land/GEOS5_land_forcing/ ``` -SMAP_Nature_v05 +SMAP_Nature_v05, v7.2, v8.1; SMAP L4_SM Version 4, Version 5 ``` MET_PATH : /discover/nobackup/projects/gmao/merra/iau/merra_land/MERRA2_land_forcing/ ! before 1/1/2015 MET_PATH : /discover/nobackup/projects/gmao/merra/iau/merra_land/GEOS5_land_forcing/ ! after 1/1/2015 @@ -168,12 +168,21 @@ COMMONLY USED values for `MET_TAG`: MET_TAG : cross_d5124_RPFPIT ! uses "late-look" through present ``` -#### FP +#### GEOS FP ``` - MET_TAG : e5110_fp - MET_TAG : e5130_fp - MET_TAG : e5131_fp - MET_TAG : cross_FP + MET_TAG : e5110_fp ! starting 11 Jun 2013 + MET_TAG : e5130_fp ! starting 20 Aug 2014 + MET_TAG : e5131_fp ! starting 1 May 2015 + MET_TAG : f516_fp ! starting 24 Jan 2017 + MET_TAG : f517_fp ! starting 1 Nov 2017 + MET_TAG : f521_fp ! starting 11 Jul 2018 + MET_TAG : f522_fp ! starting 13 Mar 2019 + MET_TAG : f525_fp ! starting 30 Jan 2020 + MET_TAG : f525_p5_fp ! starting 7 Apr 2020 + + MET_TAG : cross_FP ! stitch FP experiment names across years + + MET_TAG : GEOS.fp.asm ! "seamless" FP files (published/generic file names, ~same result as cross_FP) ``` #### FP with precip corrections as in pre-beta SMAP L4_SM products @@ -184,7 +193,7 @@ COMMONLY USED values for `MET_TAG`: #### SMAP_Nature_v03 ``` MET_TAG : cross_RPFPIT__precCPCUG5RPFPITv1 ! before 1/1/2014 - MET_TAG : cross_FP__precCPCUG5FPv1 ! after 1/1/2014 + MET_TAG : cross_FP__precCPCUG5FPv1 ! after 1/1/2014 ``` #### SMAP_Nature_v04 @@ -199,7 +208,7 @@ COMMONLY USED values for `MET_TAG`: MET_TAG : cross_FP__precCPCUG5FPv2 ! after 1/1/2015 ``` -#### SMAP_Nature_v05 +#### SMAP_Nature_v05, v7.2, v8.1; SMAP L4_SM Version 4, Version 5 ``` MET_TAG : M2COR_cross__precCPCUGPCP22clim_MERRA2_BMTXS ! before 1/1/2015 MET_TAG : cross_FP__precCPCUG5FPv3 ! after 1/1/2015 @@ -259,7 +268,7 @@ COMMONLY USED boundary conditions (bcs): BCS_PATH = /discover/nobackup/projects/gmao/ssd/land/l_data/geos5/bcs/CLSM_params/mkCatchParam_SMAP_L4SM_v002/ ``` -#### Icarus-NL ("New Land") +#### Icarus-NL ("New Land"), SMAP_Nature_v7.2 ``` BCS_PATH = /discover/nobackup/ltakacs/bcs/Icarus-NL/ ``` @@ -269,8 +278,7 @@ Notes: - This path remains in place to permit recreating experiments that have used this path. - The sub-directory "Icarus-NL_MERRA-2/" contains the "new land" bcs. The string "MERRA-2" in this sub-directory name refers to ocean bcs that are not relevant for GEOSldas. - -#### Icarus-NL ("New Land") v2 +#### Icarus-NLv2, SMAP L4_SM Version 4 ``` BCS_PATH = /discover/nobackup/ltakacs/bcs/Icarus-NLv2/ ``` @@ -279,7 +287,7 @@ Notes: - Icarus-NLv2 is a update to Icarus-NL bcs. A patch has been applied to files green*.data, nirdf*.dat, and visdf*.dat. - DEFAULT for GEOSldas v17.8.0 -#### Icarus-NL ("New Land") v3 +#### Icarus-NLv3, SMAP_Nature_v8.1, SMAP L4_SM Version 5 ``` BCS_PATH = /discover/nobackup/ltakacs/bcs/Icarus-NLv3/ ``` diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index b70f3417..801cdde4 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -41,31 +41,24 @@ LSM_CHOICE: 1 # If only whitelist should be used, specify dummy valuessuch that: # MINLON > MAXLON and MINLAT > MAXLAT. # -# MINLON : -180. -# MAXLON : 180. -# MINLAT : -90. -# MAXLAT : 90. +# MINLON: -180. +# MAXLON: 180. +# MINLAT: -90. +# MAXLAT: 90. # # Specify path and filenames for blacklist and whitelist files: # (May leave blank.) # -# BLACK_FILE : '' -# WHITE_FILE : '' +# BLACK_FILE: '' +# WHITE_FILE: '' -# ---- Surface meteorological forcing: Time step -# -# Should be set in the exeinp file where MET_PATH is defined -# 3600 = default -# -# FORCE_DTSTEP : 3600 - # ---- Surface meteorological forcing: Horizonal interpolation # # 1 : bilinear interpolation (default) # 0 : nearest neighbor # -MET_HINTERP : 1 +MET_HINTERP: 1 # ---- Specify if running model only or data assimilation @@ -73,7 +66,7 @@ MET_HINTERP : 1 # NO : model only (DEFAULT; with --runmodel option) # YES : assimilation (without --runmodel option) # -LAND_ASSIM : NO +LAND_ASSIM: NO # ---- Perturbations: On/off @@ -83,11 +76,11 @@ LAND_ASSIM : NO # 0 : No perturbactions. # 1 : With perturbations. # -PERTURBATIONS : 0 +PERTURBATIONS: 0 # ---- Perturbations: ID of first ensemble member # -FIRST_ENS_ID : 0 +FIRST_ENS_ID: 0 # ---- Path to special namelist input files @@ -98,7 +91,7 @@ FIRST_ENS_ID : 0 # LDASsa_SPECIAL_inputs_ensprop.nml # LDASsa_SPECIAL_inputs_catbias.nml # -# NML_INPUT_PATH : '' +# NML_INPUT_PATH: '' # ---- Microwave Radiative Transfer Model (mwRTM) parameter file name (nc4 format) used for Tb assimilation @@ -106,7 +99,7 @@ FIRST_ENS_ID : 0 # This file can be converted from binary with the program mwrtm_bin2nc4.x. # If empty or commented out, GEOSldas will search the restart directory. # -# MWRTM_FILE : '' +# MWRTM_FILE: '' # ---- Job segments: Length @@ -115,7 +108,7 @@ FIRST_ENS_ID : 0 # Default is the entire simulation period (END_DATE minus BEG_DATE). # Format: yyyymmdd hhmmss # -# JOB_SGMT : 00000100 000000 +# JOB_SGMT: 00000100 000000 # ---- Job segments: Number # @@ -124,31 +117,34 @@ FIRST_ENS_ID : 0 # Low values for NUM_SGMT are recommended for run-time and storage efficiency. # Default is 1. # -# NUM_SGMT : 1 +# NUM_SGMT: 1 # ---- Output: Write log file (YES/NO)? # -LDAS_logit : YES +LDAS_logit: YES # ---- Output: HISTORY definition of model diagnostics # # User-defined path and filename of output (HISTORY) specification file. # If empty, ldas_setup will generate a default HISTORY.rc file. # -# HISTRC_FILE : '' +# HISTRC_FILE: '' -# ---- Write only monthly output? +# ---- Concatenate sub-daily nc4 files into daily nc4 files and write monthly-mean output? # -# Monthly files can be created from daily files. -# Accurate monthly averages require setting "ref_time" in HISTORY.rc to "000000" +# Optional post-processing of model diagnostics output into bundled daily files and monthly means. +# Reduces the file count and (optionally) the output volume. # -# 0 : Output bundled into daily files per HISTORY specifications (default). -# 1 : Monthly files will be created. Daily files will *not* be deleted. -# 2 : Monthly files will be created and daily files will be deleted automatically. +# Accurate monthly-means of time-average Collections require setting "ref_time" to "000000" in HISTRC_FILE! # -# MONTHLY_OUTPUT : 0 - +# 0 : No post-processing (default). +# 1 : For complete days, concatenate (bundle) sub-daily nc4 files, if any, into daily nc4 files. +# For complete months, write monthly-mean nc4 files. +# 2 : As in 1, but delete daily nc4 files. +# +# POSTPROC_HIST: 0 + # ---- Name of file containing Surface GridComp resource parameters # @@ -161,12 +157,12 @@ SURFRC: LDAS.rc # ---- No dycore for offline # -DYCORE : none +DYCORE: none # ---- Only one surface level # -LM : 1 +LM: 1 # ---- For MAPL_RestartOptional # -MAPL_ENABLE_BOOTSTRAP : YES +MAPL_ENABLE_BOOTSTRAP: YES diff --git a/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml b/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml index 4b08d676..73947a35 100644 --- a/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml +++ b/src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml @@ -1,9 +1,10 @@ ! ! namelist of EnKF inputs for land EnKF update ! -! reichle, 28 Jan 2005 -! reichle, 13 Jun 2011 - updated for SMOS angles and downscaling ("FOV") -! reichle, 8 Jun 2017 - added "%flistpath" and "%flistname"; updated comments +! reichle, 28 Jan 2005 +! reichle, 13 Jun 2011 - updated for SMOS angles and downscaling ("FOV") +! reichle, 8 Jun 2017 - added "%flistpath" and "%flistname"; updated comments +! qliu+reichle, 29 Apr 2020 - added forecast error covariance inflation ! ! -------------------------------------------------------------------- @@ -42,17 +43,8 @@ centered_update = .false. out_obslog = .true. out_ObsFcstAna = .false. -!out_incr = .false. out_smapL4SMaup = .false. -! select format of increments output -! 0: standard LDASsa -! (output in LDASsa domain and LDASsa tile order) -! 1: suitable for land incremental analysis update (LIAU) in GEOS-5 GCM -! (output on global domain in GEOS-5 global tile order) - -!out_incr_format = 0 - ! --------------------------------------------------------------------- ! ! Compact support parameters - for 3d updates @@ -63,6 +55,17 @@ out_smapL4SMaup = .false. xcompact = 0. ! [deg] longitude ycompact = 0. ! [deg] latitude +! --------------------------------------------------------------------- +! +! forecast error covariance inflaction factor +! +! - assigns more weight to observations in analysis by inflating forecast error covariance +! - works on std-dev, i.e., var_inflated = var * inflation_fac**2 +! - typical values: 1 <= inflation_fac <= 1.5 +! - to turn off, set to any negative real number + +fcsterr_inflation_fac = -9999. + ! --------------------------------------------------------------------- ! ! Definition of measurement species and parameters diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 9e8b5a5b..94e94cb7 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -32,18 +32,18 @@ class LDASsetup: # Required exe input fields # These fields are needed to pre-compute exp dir structure # ------ - rqdExeInpKeys = ['EXP_ID', 'EXP_DOMAIN', 'NUM_ENSEMBLE', + rqdExeInpKeys = ['EXP_ID', 'EXP_DOMAIN', 'NUM_LDAS_ENSEMBLE', 'BEG_DATE', 'END_DATE','RESTART_PATH', 'RESTART_DOMAIN','RESTART_ID','MET_TAG','MET_PATH','FORCE_DTSTEP','BCS_PATH'] - rqdExeInpKeys_rst = ['EXP_ID', 'EXP_DOMAIN', 'NUM_ENSEMBLE', + rqdExeInpKeys_rst = ['EXP_ID', 'EXP_DOMAIN', 'NUM_LDAS_ENSEMBLE', 'BEG_DATE', 'END_DATE','MET_TAG','MET_PATH','FORCE_DTSTEP','BCS_PATH'] - # These keywords are excluded from LDAS.rc + # These keywords are excluded from LDAS.rc (i.e., only needed in pre- or post-processing) self.NoneLDASrcKeys=['EXP_ID', 'EXP_DOMAIN', 'BEG_DATE', 'END_DATE','RESTART','RESTART_PATH', 'RESTART_DOMAIN','RESTART_ID','BCS_PATH','TILING_FILE','GRN_FILE','LAI_FILE','NIRDF_FILE', 'VISDF_FILE','CATCH_DEF_FILE','NDVI_FILE', - 'NML_INPUT_PATH','HISTRC_FILE','RST_FROM_GLOBAL','JOB_SGMT','NUM_SGMT','MONTHLY_OUTPUT', + 'NML_INPUT_PATH','HISTRC_FILE','RST_FROM_GLOBAL','JOB_SGMT','NUM_SGMT','POSTPROC_HIST', 'MINLON','MAXLON','MINLAT','MAXLAT','BLACK_FILE','WHITE_FILE','MWRTM_FILE'] @@ -62,7 +62,7 @@ class LDASsetup: if 'exeinp' in cmdLineArgs: # sample sub-command # by construction, we can have - # either: {'exeinp': False, 'batinp': 'lasgh'} + # either: {'exeinp': False, 'batinp': 'lasgh'} <-- 'lasgh'??? # or: {'exeinp': True, 'batinp': None} if cmdLineArgs['exeinp']: _printExeInputKeys(rqdExeInpKeys) @@ -84,7 +84,6 @@ class LDASsetup: self.runmodel = cmdLineArgs['runmodel'] self.daysperjob = cmdLineArgs['daysperjob'] self.monthsperjob = cmdLineArgs['monthsperjob'] - #self.ForceReuseDir = cmdLineArgs['ForceReuseDir'] self.rqdExeInp = OrderedDict() self.rqdRmInp = OrderedDict() self.optRmInp = OrderedDict() @@ -103,7 +102,7 @@ class LDASsetup: self.has_ldassa_pert = False self.nSegments = 1 # ------ - # Read exe input file which is required to setup the dir + # Read exe input file which is required to set up the dir # ------ self.rqdExeInp = self._parseInputFile(cmdLineArgs['exeinpfile']) # verifing the required input @@ -134,8 +133,8 @@ class LDASsetup: _printdict(self.rqdExeInp) # nens is an integer and =1 for model run - self.nens = int(self.rqdExeInp['NUM_ENSEMBLE']) # fail if Nens's val is not int - assert self.nens>0, 'NUM_ENSEMBLE [%d] <= 0' % self.nens + self.nens = int(self.rqdExeInp['NUM_LDAS_ENSEMBLE']) # fail if Nens's val is not int + assert self.nens>0, 'NUM_LDAS_ENSEMBLE [%d] <= 0' % self.nens _mydir = self.exphome + '/' + self.rqdExeInp['EXP_ID'] assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None @@ -167,7 +166,7 @@ class LDASsetup: ) if self.rqdExeInp['RESTART'].isdigit() : if int(self.rqdExeInp['RESTART']) == 0 : - # print "Starting date is forced to January 1st if there is no restart file" + print "No restart file (cold restart): Forcing start date to January 1, 0z" year = self.begDates[0].year self.begDates[0]=datetime(year =year,month=1,day =1,hour =0, minute= 0,second= 0) @@ -283,12 +282,8 @@ class LDASsetup: else : self.catch = 'catchcn' - if 'MONTHLY_OUTPUT' not in self.rqdExeInp: - self.rqdExeInp['MONTHLY_OUTPUT'] = 0 - - #if int(self.rqdExeInp['MONTHLY_OUTPUT']) > 0: - # assert self.begDates[0].day == 1 and self.begDates[0].hour == 0 and self.begDates[0].minute == 0 and self.begDates[0].second == 0, "monthly output should start from day 1 and 0Z" - # assert self.endDates[0].day == 1 and self.endDates[0].hour == 0 and self.endDates[0].minute == 0 and self.endDates[0].second == 0, "monthly output should end at day 1 and 0Z" + if 'POSTPROC_HIST' not in self.rqdExeInp: + self.rqdExeInp['POSTPROC_HIST'] = 0 if 'RUN_IRRIG' not in self.rqdExeInp: self.rqdExeInp['RUN_IRRIG'] = 0 @@ -443,101 +438,6 @@ class LDASsetup: tmp_expid = None tmp_expdir = None - # ------ - # If daysperjob>0, split duration of - # start/end_times are now lists of len > 1 - # ------ - # wj notes: disable daysperjob -# self.daysperjob = 0 -# if self.daysperjob: -# # shorthands -# _dpj = self.daysperjob -# _start = self.begDates[0] -# _end = self.endDates[0] -# assert _dpj>0, 'daysperjob = %d' % _dpj -# # total number of days for the given job -# nDays = (_end - _start).days -# assert nDays>_dpj, \ -# 'Days per job [%d] >= Duration [%d days]' %\ -# (_dpj, nDays) -# # number of job segments -# q = nDays/_dpj -# r = nDays%_dpj -# if r>0: -# nSegments = q+1 -# else: -# nSegments = q -# # lists of start times, end times -# _start_list = list() -# _end_list = list() -# for iseg in xrange(nSegments): -# _start_list.append(_start+timedelta(days=iseg*_dpj)) -# for iseg in xrange(nSegments-1): -# _end_list.append(_start_list[iseg+1]) -# _end_list.append(_end) -# -# #update beg dates and end dates -# self.begDates = _start_list -# self.endDates = _end_list -# self.job_sgmt = list() -# for iseg in xrange(nSegments): -# self.job_sgmt.append("JOB_SGMT: 000000%02d 000000"%(self.endDates[iseg]-self.begDates[iseg]).days) -# -# # print, if requested -# if self.verbose: -# print '\nn start end' -# for iseg in xrange(nSegments): -# print iseg, ':', _start_list[iseg], '-', _end_list[iseg] -# -# # wj notes: disable monthsperjob -# self.monthsperjob = 0 -# if self.monthsperjob: -# # shorthands -# _mpj = self.monthsperjob -# assert _mpj>0, 'monthsperjob = %d' % _mpj -# _start = self.begDates[0] -# _end = self.endDates[0] -# # for this option the start/end dates have to be -# # 0z on the first of the month -# assert (_start.day==1 and _start.hour==0 and -# _start.minute==0 and _start.second==0 -# ), 'invalid start_time: %s for --monthsperjob' % \ -# _start.strftime('%Y-%m-%d-%H-%M-%S') -# assert (_end.day==1 and _end.hour==0 and -# _end.minute==0 and _end.second==0 -# ), 'invalid end_time: %s for --monthsperjob' % \ -# _end.strftime('%Y-%m-%d-%H-%M-%S') -# _start_list = list() -# _end_list = list() -# for dt in rrule.rrule(rrule.MONTHLY, interval=_mpj, dtstart=_start, until=_end): -# seg_start = dt -# seg_end = dt+relativedelta(months=_mpj) -# if seg_end>_end: -# seg_end = _end -# if(seg_start>=seg_end) : -# break -# _start_list.append(seg_start) -# _end_list.append(seg_end) -# -# #update beg dates and end dates -# -# self.begDates = _start_list -# self.endDates = _end_list -# self.job_sgmt =list() -# for iseg in xrange(len(_start_list)): -# months = 0 -# dt = relativedelta(months=+1) -# d = self.begDates[iseg] -# while d "' in line: continue - # get "GEOSldas=>" defalut in GEOS_LandGrid.rc + # get "GEOSldas=>" default in GEOS_LandGrid.rc if 'GEOSldas=>' in line: line = line.split('GEOSldas=>')[1] # handle comments @@ -713,7 +613,7 @@ class LDASsetup: if 'SURFLAY' in self.rqdExeInp : dzsf = self.rqdExeInp['SURFLAY'] - # These are dummy values for cold restart: + # These are dummy values for *cold* restart: wemin_in = '13' # WEmin input/output for scale_catch(cn), wemin_out = '13' # if 'WEMIN_IN' in self.rqdExeInp : @@ -807,7 +707,7 @@ class LDASsetup: rstdomain = self.rqdExeInp['RESTART_DOMAIN'] rstpath0 = self.rqdExeInp['RESTART_PATH'] - # just copy the landassim pert seed if it exist + # just copy the landassim pert seed if it exists for iens in xrange(self.nens) : _ensdir = self.ensdirs[iens] _ensid = self.ensids[iens] @@ -1072,7 +972,7 @@ class LDASsetup: #sp.call(cmd) for line in fileinput.input(tmprcfile,inplace=True): print line.rstrip().replace('GEOSldas_expid',self.rqdExeInp['EXP_ID']) - # just copy en emty ExtData.rc + # just copy an empty ExtData.rc if shortfile=='ExtData.rc' : shutil.copy2(rcfile, self.rundir+'/'+shortfile) @@ -1098,7 +998,7 @@ class LDASsetup: for key,val in default_surfrcInp.iteritems() : ldasrcInp[key] = val - # ldas default, may overiwrite land default + # ldas default, may overwrite land default default_ldasrcInp = self._parseInputFile(rcfile) for key,val in default_ldasrcInp.iteritems() : ldasrcInp[key] = val @@ -1192,7 +1092,7 @@ class LDASsetup: # write LDAS.rc fout =open(self.rundir+'/'+shortfile,'w') - ldasrcInp['NUM_LDAS_ENSEMBLE']=ldasrcInp.pop('NUM_ENSEMBLE') + # ldasrcInp['NUM_LDAS_ENSEMBLE']=ldasrcInp.pop('NUM_ENSEMBLE') for key,val in optinxny.iteritems(): keyn=(key+":").ljust(36) fout.write(keyn+str(val)+'\n') @@ -1216,7 +1116,6 @@ class LDASsetup: _rm_name = self.rqdRmInp['rm_name'] expid = self.rqdExeInp['EXP_ID'] - #expdomain = self.rqdExeInp['EXP_DOMAIN'] if _rm_name=='SLURM': directives = '' # REQUIRED directives account/time/ntasks @@ -1378,18 +1277,16 @@ class LDASsetup: fout.write(line.replace('MY_EXPID',self.rqdExeInp['EXP_ID'])) elif 'MY_EXPDOMAIN' in line : fout.write(line.replace('MY_EXPDOMAIN',self.rqdExeInp['EXP_DOMAIN'])) - #elif 'MY_ESMADIR' in line : - # fout.write(line.replace('MY_ESMADIR',self.blddir)) elif 'MY_ENSEMBLE' in line : - fout.write(line.replace('MY_ENSEMBLE',str(self.rqdExeInp['NUM_ENSEMBLE']))) + fout.write(line.replace('MY_ENSEMBLE',str(self.rqdExeInp['NUM_LDAS_ENSEMBLE']))) elif 'MY_LOGFILE' in line : fout.write(line.replace('MY_LOGFILE',my_logfile)) elif 'MY_ERRFILE' in line : fout.write(line.replace('MY_ERRFILE',my_errfile)) elif 'MY_MODEL' in line : fout.write(line.replace('MY_MODEL',self.catch)) - elif 'MY_MONTHLY' in line : - fout.write(line.replace('MY_MONTHLY',str(self.rqdExeInp['MONTHLY_OUTPUT']))) + elif 'MY_POSTPROC_HIST' in line : + fout.write(line.replace('MY_POSTPROC_HIST',str(self.rqdExeInp['POSTPROC_HIST']))) else : fout.write(line.replace('MY_EXPDIR',self.exphome+'/$EXPID')) @@ -1430,11 +1327,11 @@ def _printExeInputKeys(rqdExeInpKeys): print '# #' print '############################################################' print - print 'EXP_ID :' - print 'EXP_DOMAIN :' - print 'NUM_ENSEMBLE :' - print 'BEG_DATE :' - print 'END_DATE :' + print 'EXP_ID:' + print 'EXP_DOMAIN:' + print 'NUM_LDAS_ENSEMBLE:' + print 'BEG_DATE:' + print 'END_DATE:' print print '############################################################' @@ -1503,10 +1400,10 @@ def _printExeInputKeys(rqdExeInpKeys): print '############################################################' print - print 'RESTART :' - print '#RESTART_ID :' - print '#RESTART_PATH :' - print '#RESTART_DOMAIN :' + print 'RESTART:' + print '#RESTART_ID:' + print '#RESTART_PATH:' + print '#RESTART_DOMAIN:' print print '############################################################' @@ -1515,12 +1412,14 @@ def _printExeInputKeys(rqdExeInpKeys): print '# #' print '# See README files in ./src/Applications/LDAS_App/doc #' print '# #' + print '# Surface meteorological forcing time step is in seconds. #' + print '# #' print '############################################################' print - print 'MET_TAG :' - print 'MET_PATH :' - print 'FORCE_DTSTEP :' + print 'MET_TAG:' + print 'MET_PATH:' + print 'FORCE_DTSTEP:' print print '############################################################' @@ -1531,32 +1430,38 @@ def _printExeInputKeys(rqdExeInpKeys): print '# #' print '############################################################' print - print 'BCS_PATH :' + print 'BCS_PATH:' print _fn = '../etc/GEOSldas_LDAS.rc' # run ldas_setup from /bin directory - _f = open(_fn) - for line in _f: - sys.stdout.write(line) - sys.stdout.flush() - _f.close() + with open(_fn) as _f: + i_ = 1 + for line in _f: + if ( i_ < 5 or i_ >10): # ignore lines 5-10 - may need to change if GEOSldas_LDAS.rc is edited + sys.stdout.write(line) + sys.stdout.flush() + i_ += 1 print print _fn = '../etc/GEOS_SurfaceGridComp.rc' # run ldas_setup from /bin directory - _f = open(_fn) - for line in _f: - if '"GEOSldas=>"' in line: + with open(_fn) as _f : + i_ = 1 + for line in _f: + if ( 5<=i_ and i_<=21) : # ignore lines 5-21 - may need to change if GEOS_SurfaceGridComp.rc is edited + i_ +=1 + continue + if '"GEOSldas=>"' in line: sys.stdout.write(line) - elif 'GEOSldas=>' in line: + elif 'GEOSldas=>' in line: line0 = line.split("GEOSldas=>")[1] sys.stdout.write(line0) - elif not line.strip() or line.strip().startswith('#'): - sys.stdout.write(line) - sys.stdout.flush() - _f.close() + elif not line.strip() or line.strip().startswith('#'): + sys.stdout.write(line) + sys.stdout.flush() + i_ += 1 print print @@ -1652,11 +1557,6 @@ def parseCmdLine(): help='replace the account in batinpfile)', type=str, default='None' ) - #p_setup.add_argument( - # '--ForceReuseDir', - # help='force re-use existing exp dir', - # action='store_true', - # ) spltgrp = p_setup.add_mutually_exclusive_group() spltgrp.add_argument( '--daysperjob', diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index b8f4595c..07748581 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -41,12 +41,12 @@ setenv RUN_CMD "$GEOSBIN/esma_mpirun -np " # Experiment Specific Environment Variables ####################################################################### -setenv HOMDIR $EXPDIR/run/ -setenv SCRDIR $EXPDIR/scratch -setenv MODEL MY_MODEL -@ NENS = MY_ENSEMBLE -setenv MYNAME `finger $USER | cut -d: -f3 | head -1` -setenv NODAILIES MY_MONTHLY +setenv HOMDIR $EXPDIR/run/ +setenv SCRDIR $EXPDIR/scratch +setenv MODEL MY_MODEL +@ NENS = MY_ENSEMBLE +setenv MYNAME `finger $USER | cut -d: -f3 | head -1` +setenv POSTPROC_HIST MY_POSTPROC_HIST # # DEBUGGER : 0 -- no debugger @@ -308,7 +308,34 @@ while ( $counter <= ${NUM_SGMT} ) ####################################################################### - # Move HISTORY Files to cat/ens Directory + # Move Legacy LDASsa Files to ana/ens_avg Directory + ####################################################################### + + # must be done before moving HISTORY files + + set ObsFcses = `ls *.ldas_ObsFcstAna.*.bin` + foreach obsfcs ( $ObsFcses ) + set ThisTime = `echo $obsfcs | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/ana/ens_avg/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $obsfcs ${THISDIR}$obsfcs + end + + set smapL4s = `ls *.ldas_tile_inst_smapL4SMaup.*.bin` + foreach smapl4 ( $smapL4s ) + set ThisTime = `echo $smapl4 | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/ana/ens_avg/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $smapl4 ${THISDIR}$smapl4 + end + + + ####################################################################### + # Move HISTORY Files to cat/ens Directory ####################################################################### set outfiles = `ls $EXPID.*[bin,nc4]` @@ -367,11 +394,12 @@ while ( $counter <= ${NUM_SGMT} ) done: ####################################################################### - # (1) Concatenating Sub-daily Files to Daily Files - # (2) Write monthly means + # Post-Process model diagnostic output + # (1) Concatenate sub-daily files to daily files + # (2) Write monthly means ####################################################################### - if ($NODAILIES > 0) then + if ($POSTPROC_HIST > 0) then set PWD = `pwd` @@ -405,7 +433,20 @@ while ( $counter <= ${NUM_SGMT} ) @ day++ set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}${DD}_* | rev | cut -d'.' -f2 | rev` set LEN_SUB = `echo $#time_steps` + + # no file or just one file? nothing to concatenate, move on to the next collection if ($LEN_SUB <= 1) continue + + # check if day is complete (get HISTORY time step from first two files) + set hour1 = `echo $time_steps[1] | cut -c10-11` + set min1 = `echo $time_steps[1] | cut -c12-13` + set hour2 = `echo $time_steps[2] | cut -c10-11` + set min2 = `echo $time_steps[2] | cut -c12-13` + @ dt_hist = ($hour2 - $hour1) * 60 + ($min2 - $min1) + @ N_per_day = (24 * 60) / $dt_hist + # not enough sub-daily files? move on to the next collection + if($LEN_SUB < $N_per_day) continue + set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" # ---------------------------------------------------------------------------- @@ -434,45 +475,67 @@ EOF ncks -4 -h -v time_stamp timestamp.nc4 -A ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 /bin/rm timestamp.cdl /bin/rm timestamp.nc4 - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 - + # rudimentary check for desired nc4 file; if ok, delete sub-daily files + if ( -f ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 ) then + if ( ! -z ${EXPID}.${ThisCol}.$YYYY$MM$DD.nc4 ) then + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}${DD}_*.nc4 + endif + endif end # concatenate for each day - - set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}* | rev | cut -d'.' -f2 | rev` - set tstep2 = \"`echo $time_steps | sed 's/\ /\","/g'`\" - set LEN = `echo $#time_steps` - # no file? move on - if ($LEN == 0) continue - - set dayl = `echo $time_steps[$LEN] | cut -c1-8` - set day1 = `echo $time_steps[1] | cut -c1-8` - @ NAVAIL = ($dayl - $day1) + 1 - - # not enough days? move on to the next collection - if($NAVAIL != $NDAYS) continue - - # create the monly average - ncra -h $EXPID.$ThisCol.${YYYY}${MM}??.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 + # write monthly mean file and (optionally) remove daily files + # ------------------------------------------------------------------ + + # NOTE: Collections written with daily frequency ("tavg24" and "inst24") have not + # been concatenated into daily files. There are two possibilities for the + # time stamps of files to be averaged: + # *.YYYYMMDD.* daily files from concatenation of sub-daily files + # *.YYYYMMDD_HHMM.* daily (avg or inst) files written directly by HISTORY.rc + + set time_steps = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}??.* | rev | cut -d'.' -f2 | rev` + set time_steps_ = `ls -1 $EXPID.$ThisCol.${YYYY}${MM}??_* | rev | cut -d'.' -f2 | cut -d'_' -f2 | rev` + set LEN = `echo $#time_steps` + set LEN_ = `echo $#time_steps_` + + # check if month is complete + if ($LEN != 0) then + set dayl = `echo $time_steps[$LEN] | cut -c1-8` + set day1 = `echo $time_steps[1] | cut -c1-8` + @ NAVAIL = ($dayl - $day1) + 1 + else if( $LEN_ !=0 ) then + set dayl = `echo $time_steps_[$LEN] | cut -c1-8` + set day1 = `echo $time_steps_[1] | cut -c1-8` + @ NAVAIL = ($dayl - $day1) + 1 + else + @ NAVAIL = 0 + endif + + # not enough days for monthly mean? move on to the next collection + if($NAVAIL != $NDAYS) continue + + # create monthly-mean nc4 file + ncra -h $EXPID.$ThisCol.${YYYY}${MM}*.nc4 ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 - # don't want a daily? delete the daily and sub-dailies and continue - # - if($NODAILIES == 2) then - /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* + if($POSTPROC_HIST == 2) then + # rudimentary check for desired nc4 file; if ok, delete daily files + if ( -f ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 ) then + if ( ! -z ${EXPID}.${ThisCol}.monthly.$YYYY$MM.nc4 ) then + /bin/rm $EXPID.${ThisCol}.${YYYY}${MM}* + endif + endif continue endif end # each collection end # each month cd $PWD - endif # dailies > 0 + endif # POSTPROC_HIST > 0 ####################################################################### # Rename Final Checkpoints => Restarts for Next Segment and Archive # Note: cap_restart contains the current NYMD and NHMS ####################################################################### - set edate = e`cat cap_restart | cut -c1-8`_`cat cap_restart | cut -c10-11`z set eYEAR = `cat cap_restart | cut -c1-4` set eMON = `cat cap_restart | cut -c5-6` set eDAY = `cat cap_restart | cut -c7-8` @@ -558,45 +621,36 @@ EOF set rstfiles2 = `ls landpert${ENSID}_internal_checkpoint.*` set rstfiles3 = `ls landassim_obspertrseed${ENSID}_checkpoint.*` - set NFILES = `echo $#rstfiles1` - if($NFILES > 0) then - foreach rfile ( $rstfiles1 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR - /bin/mv $rfile ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 - /usr/bin/gzip ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 & - end - endif + foreach rfile ( $rstfiles1 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR + /bin/mv $rfile ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 + /usr/bin/gzip ${THISDIR}${EXPID}.${MODEL}_internal_rst.${ThisTime}.nc4 & + end - set NFILES = `echo $#rstfiles2` - if($NFILES > 0) then - foreach rfile ( $rstfiles2 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR + foreach rfile ( $rstfiles2 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR (ncks -4 -O -C -x -v lat,lon $rfile ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4;\ /usr/bin/gzip ${THISDIR}${EXPID}.landpert_internal_rst.${ThisTime}.nc4; \ /bin/rm -f $rfile) & - end - endif + end - set NFILES = `echo $#rstfiles3` - if($NFILES > 0) then - foreach rfile ( $rstfiles3 ) - set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` - set TY = `echo $ThisTime | cut -c1-4` - set TM = `echo $ThisTime | cut -c5-6` - set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ - if (! -e $THISDIR ) mkdir -p $THISDIR + foreach rfile ( $rstfiles3 ) + set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` + set TY = `echo $ThisTime | cut -c1-4` + set TM = `echo $ThisTime | cut -c5-6` + set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${TY}/M${TM}/ + if (! -e $THISDIR ) mkdir -p $THISDIR /bin/mv $rfile ${THISDIR}${EXPID}.landassim_obspertrseed_rst.${ThisTime}.nc4 - end - endif - + end + @ inens ++ end ## end of while ($inens < $NENS) wait @@ -625,7 +679,7 @@ EOF /bin/cp cap_restart $HOMDIR/cap_restart ####################################################################### - # Update Iteration Counter + # Update Iteration Counter ####################################################################### set enddate = `echo $END_DATE | cut -c1-8` @@ -641,7 +695,7 @@ EOF end ####################################################################### -# set next log and error file +# Set Next Log and Error Files ####################################################################### set logfile = $EXPDIR/output/$EXPDOMAIN/rc_out/Y${logYEAR}/M${logMON}/${EXPID}.ldas_log.${logYEAR}${logMON}${logDAY}_${logHour}${logMin}z.txt @@ -658,7 +712,7 @@ if(-f GEOSldas_err_txt) then endif ####################################################################### -# Re-Submit Job +# Re-Submit Job ####################################################################### if ( $rc == 0 ) then diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 8171142f..b0e7636b 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -31,9 +31,6 @@ module GEOS_LandAssimGridCompMod use LDAS_ensdrv_mpi, only: MPI_obs_param_type use LDAS_DateTimeMod,ONLY: date_time_type - use LDAS_ensdrv_functions, ONLY: & - get_io_filename - use LDAS_ensdrv_init_routines, only : GEOS_read_catparam use LDAS_ensdrv_Globals, only: logunit use LDAS_ConvertMod, ONLY: esmf2ldas @@ -90,6 +87,7 @@ module GEOS_LandAssimGridCompMod integer :: update_type, dtstep_assim logical :: centered_update real :: xcompact, ycompact +real :: fcsterr_inflation_fac integer :: N_obs_param logical :: out_obslog logical :: out_ObsFcstAna @@ -1108,12 +1106,11 @@ subroutine Initialize(gc, import, export, clock, rc) dtstep_assim, & centered_update, & xcompact, ycompact, & + fcsterr_inflation_fac, & N_obs_param, & obs_param, & out_obslog, & out_ObsFcstAna, & -! out_incr, & -! out_incr_format, & out_smapL4SMaup, & N_obsbias_max & ) @@ -1128,11 +1125,10 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_BCAST(centered_update, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(xcompact, 1, MPI_REAL, 0,MPICOMM,mpierr) call MPI_BCAST(ycompact, 1, MPI_REAL, 0,MPICOMM,mpierr) + call MPI_BCAST(fcsterr_inflation_fac, 1, MPI_REAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obs_param, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(out_obslog, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(out_ObsFcstAna, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) -! call MPI_BCAST(out_incr, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) -! call MPI_BCAST(out_incr_format, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr) @@ -1703,7 +1699,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & update_type, & dtstep_assim, centered_update, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & N_obs_param, obs_param, N_obsbias_max, & out_obslog, out_smapL4SMaup, & cat_progn, & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 index 700226e7..080246f2 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 @@ -11,84 +11,30 @@ module clsm_ensdrv_drv_routines ! - optimized restart-to-exp-domain mapping in initialize_model() ! reichle, 5 Apr 2013 - revised treatment of output collections - use LDAS_ensdrv_globals, ONLY: & - logunit, & - logit, & - nodata_generic, & - nodata_tol_generic - use catch_constants, ONLY: & N_snow => CATCH_N_SNOW, & N_gt => CATCH_N_GT - use catch_incr, ONLY: & + use catch_incr, ONLY: & check_catch_progn - use MAPL_ConstantsMod, ONLY: & - stefan_boltzmann => MAPL_STFBOL, & - alhe => MAPL_ALHL, & - alhs => MAPL_ALHS, & - alhm => MAPL_ALHF, & - Tzero => MAPL_TICE - - use LDAS_DriverTypes, ONLY: & - met_force_type, & - veg_param_type, & - alb_param_type, & - bal_diagn_type, & - assignment (=), & - operator (+), & - operator (*) - use catch_types, ONLY: & cat_param_type, & - cat_progn_type, & - cat_diagS_type, & - cat_diagF_type, & - catprogn2wesn, & - catprogn2htsn, & - catprogn2ghtcnt - - use LDAS_DateTimeMod, ONLY: & - date_time_type, & - datetime2_minus_datetime1 + cat_progn_type use LDAS_ensdrv_mpi, ONLY: & - mpicomm, & + mpicomm, & mpierr, & numprocs, & master_proc - use catchment_model, ONLY: & - catch_calc_tsurf, & - catch_calc_etotl - - use lsm_routines, ONLY: & - catch_calc_soil_moist, & - catch_calc_tp, & - catch_calc_wtotl - - use StieglitzSnow, ONLY: & - StieglitzSnow_calc_asnow, & - StieglitzSnow_calc_tpsnow - - use LDAS_ExceptionsMod, ONLY: & - ldas_abort, & - LDAS_GENERIC_ERROR - implicit none include 'mpif.h' private - public :: spin_stuff public :: check_cat_progn - public :: recompute_diagS -!! public :: interpolate_to_timestep -!! public :: zenith - public :: remove_snow - public :: balance_calcs public :: l2f_real public :: f2l_real public :: f2l_real8 @@ -101,70 +47,6 @@ module clsm_ensdrv_drv_routines ! ******************************************************************** - subroutine spin_stuff( start_time, end_time, N_ens, N_force_pert, N_progn_pert, & - spin_loop, restart ) - - implicit none - - type(date_time_type), intent(in) :: start_time, end_time - - integer, intent(in) :: N_ens, N_force_pert, N_progn_pert - - integer, intent(inout) :: spin_loop - - logical, intent(inout) :: restart - - ! local - character(len=*), parameter :: Iam = 'spin_stuff' - character(len=400) :: err_msg - - ! ------------------------------------------------------------------ - - ! consistency checks - - ! make sure end time is exactly n years after start time - - if ( start_time%month /= end_time%month .or. & - start_time%day /= end_time%day .or. & - start_time%hour /= end_time%hour .or. & - start_time%min /= end_time%min .or. & - start_time%sec /= end_time%sec ) then - err_msg = 'spin up only for full years' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! do not allow N_ens>1 during spin-up - - if ((N_ens>1) .or. (N_force_pert>1) .or. (N_progn_pert>1)) then - err_msg = 'spin-up only for N_ens=1 and N_force_pert=N_progn_pert=0' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! use restart files - - if (spin_loop==0) then - - restart = .false. - - else - - restart = .true. - - end if - - ! augment counter for spin years - - spin_loop = spin_loop + 1 - - ! echo spin_loop - - if (logit) write (logunit,*) - if (logit) write (logunit,*) 'at beginning of spin_loop ', spin_loop - - end subroutine spin_stuff - - ! ********************************************************************* - subroutine check_cat_progn( N_cat, cat_param, cat_progn ) ! wrapper for subroutine check_catch_progn() which has been @@ -240,737 +122,8 @@ subroutine check_cat_progn( N_cat, cat_param, cat_progn ) end subroutine check_cat_progn - ! ********************************************************************* - - subroutine recompute_diagS( N_catd, cat_param, cat_progn, cat_diagS ) - - ! replace cat_diagS with updated diagnostics - ! - ! typically call after prognostics perturbations, EnKF update, and/or cat - ! bias correction - ! - ! IMPORTANT: cat_progn is intent(inout) because srfexc, rzexc, and catdef - ! fields *might* be changed! Such changes can be prevented by first calling - ! subroutine check_cat_progn(). - ! - ! reichle, 20 Oct 2004 - ! reichle, 14 Feb 2013 - added recomputation of soil temperature - ! reichle, 30 Oct 2013 - moved from clsm_ensupd_upd_routines.F90 - ! - removed dependency on "update_type" - ! - added recompute of snow diagnostics - - integer, intent(in) :: N_catd - - ! note: cat_progn must be "inout" because call to calc_soil_moist - ! might reset inconsistent sets of srfexc, rzexc, catdef - - type(cat_param_type), dimension(N_catd), intent(in) :: cat_param - type(cat_progn_type), dimension(N_catd), intent(inout) :: cat_progn - type(cat_diagS_type), dimension(N_catd), intent(inout) :: cat_diagS - - ! local variables - - integer :: i - - real, dimension( N_catd) :: ar4, fices - - real, dimension(N_gt,N_catd) :: tp - - ! ------------------------------------------------------------------ - - ! update soil moisture diagnostics - - ! note that the call to calc_soil_moist resets srfexc, rzexc, and - ! catdef if they are not consistent! - - ! updated to new interface - reichle, 3 Apr 2012 - - call catch_calc_soil_moist( & - N_catd, & - cat_param%vegcls, cat_param%dzsf, cat_param%vgwmax, & - cat_param%cdcr1, cat_param%cdcr2, cat_param%psis, & - cat_param%bee, cat_param%poros, cat_param%wpwet, & - cat_param%ars1, cat_param%ars2, cat_param%ars3, & - cat_param%ara1, cat_param%ara2, cat_param%ara3, & - cat_param%ara4, cat_param%arw1, cat_param%arw2, & - cat_param%arw3, cat_param%arw4, & - cat_progn%srfexc, cat_progn%rzexc, cat_progn%catdef, & - cat_diagS%ar1, cat_diagS%ar2, ar4, & - cat_diagS%sfmc, cat_diagS%rzmc, cat_diagS%prmc) - - - ! update snow cover fraction and snow temperatures - - call StieglitzSnow_calc_asnow( & - N_snow, N_catd, catprogn2wesn(N_catd,cat_progn), cat_diagS%asnow ) - - do i=1,N_snow - - call StieglitzSnow_calc_tpsnow( N_catd, & - cat_progn(1:N_catd)%htsn(i), & - cat_progn(1:N_catd)%wesn(i), & - cat_diagS(1:N_catd)%tpsn(i), & - fices ) - - cat_diagS%tpsn(i) = cat_diagS%tpsn(i) + Tzero ! convert to Kelvin - - end do - - ! update surface temperature - - ! updated to new interface, - ! need ar1, ar2, ar4 from call to catch_calc_soil_moist() above - ! - reichle, 3 Apr 2012 - - call catch_calc_tsurf( N_catd, & - cat_progn%tc1, cat_progn%tc2, cat_progn%tc4, & - catprogn2wesn(N_catd,cat_progn), & - catprogn2htsn(N_catd,cat_progn), & - cat_diagS%ar1, cat_diagS%ar2, ar4, & - cat_diagS%tsurf ) - - ! update soil temperature - - ! NOTE: "tp" is returned in CELSIUS [for consistency w/ catchment.F90] - - call catch_calc_tp( N_catd, cat_param%poros, & - catprogn2ghtcnt(N_catd,cat_progn), tp ) - - do i=1,N_gt - - cat_diagS(:)%tp(i) = tp(i,:) - - end do - - end subroutine recompute_diagS - - ! ******************************************************************** - - ! ****************************************************************** - -!! subroutine interpolate_to_timestep( & -!! N_catd, vegcls, lat, lon, zenav, date_time_new, & -!! force_time_old, force_dtstep, & -!! grn_time_old, grn_time_new, & -!! lai_time_old, lai_time_new, & -!! alb_time_old, alb_time_new, & -!! mf_old, mf_new, & -!! veg_param_old, veg_param_new, & -!! alb_param_old, alb_param_new, & -!! mf_ntp, sunang_ntp, veg_param_ntp, alb_param_ntp ) -!! -!! ! Interpolates the forcing, vegetation and albedo data to current timestep. -!! ! -!! ! date_time_new = date_time at end of model integration time step -!! ! -!! ! "mf" = "met_force" -!! ! -!! ! "mf_old" = at old forcing time -!! ! "mf_new" = at new forcing time -!! ! "mf_ntp" = at current ("interpolated") time -!! ! -!! ! NOTE: time avg radiative fluxes for the interval between "old" -!! ! and "new" time must be stored in mf_old -!! ! -!! ! reichle, 14 May 2003 -!! ! reichle, 11 Sep 2007 - albedo changes -!! ! reichle, 23 Feb 2009 - add ParDrct, ParDffs from MERRA forcing -!! ! reichle, 6 Mar 2009 - added fractional day-of-year (fdofyr) for monthly interp -!! ! - deleted ParDrct, ParDffs after testing found no impact -!! ! reichle, 20 Dec 2011 - reinstated "PARdrct", "PARdffs" for MERRA-Land file specs -!! ! - cleanup -!! ! reichle, 26 Jul 2013 - revised GRN, LAI and albedo scaling parameter inputs -!! -!! implicit none -!! -!! integer, intent(in) :: N_catd -!! -!! integer, dimension(N_catd), intent(in) :: vegcls -!! -!! real, dimension(N_catd), intent(in) :: lat, lon, zenav -!! -!! type(date_time_type), intent(in) :: date_time_new -!! type(date_time_type), intent(in) :: force_time_old -!! -!! integer, intent(in) :: force_dtstep -!! -!! type(date_time_type), intent(in) :: grn_time_old, grn_time_new -!! type(date_time_type), intent(in) :: lai_time_old, lai_time_new -!! type(date_time_type), intent(in) :: alb_time_old, alb_time_new -!! -!! type(met_force_type), dimension(N_catd), intent(in) :: mf_old -!! type(met_force_type), dimension(N_catd), intent(in) :: mf_new -!! -!! type(veg_param_type), dimension(N_catd), intent(in) :: veg_param_old -!! type(veg_param_type), dimension(N_catd), intent(in) :: veg_param_new -!! -!! type(alb_param_type), dimension(N_catd), intent(in) :: alb_param_old -!! type(alb_param_type), dimension(N_catd), intent(in) :: alb_param_new -!! -!! type(met_force_type), dimension(N_catd), intent(out) :: mf_ntp -!! -!! real, dimension(N_catd), intent(out) :: sunang_ntp -!! -!! type(veg_param_type), dimension(N_catd), intent(out) :: veg_param_ntp -!! -!! type(alb_param_type), dimension(N_catd), intent(out) :: alb_param_ntp -!! -!! ! ---------------- -!! -!! ! local variables -!! -!! real, parameter :: min_grn = 0.0001 ! per GEOS_CatchGridComp.F90 (Ganymed-4_0) -!! real, parameter :: min_lai = 0.0001 ! per GEOS_CatchGridComp.F90 (Ganymed-4_0) -!! real, parameter :: min_zth = 0.01 ! per testing Feb 2009 (see below) -!! -!! integer :: n, secs_since_old, secs_in_day -!! -!! real :: zth, slr, w, w_old, w_new, tmpreal -!! -!! character(len=*), parameter :: Iam = 'interpolate_to_timestep' -!! -!! ! ------------------------------------------------------------ -!! ! -!! ! met forcing interpolation -!! ! -!! ! get secs_in_day from hh:mm:ss -!! -!! secs_in_day = date_time_new%hour*3600 + date_time_new%min*60 & -!! + date_time_new%sec -!! -!! ! weight for forcing "states" interpolation -!! ! (temperature, humidity, pressure, wind) -!! -!! secs_since_old = datetime2_minus_datetime1( force_time_old, date_time_new ) -!! -!! ! use integer division such that w changes from 0. to 1. -!! ! halfway through the current forcing interval, that is, -!! ! -!! ! w = 0. if secs_since_old < force_dtstep/2 -!! ! w = 0.5 if secs_since_old == force_dtstep/2 -!! ! w = 1. if force_dtstep/2 < secs_since_old <= force_dtstep -!! ! -!! ! For example, using 15 min model time steps and hourly forcing, -!! ! the time interpolation weights are as follows: -!! ! -!! ! secs_since_old: 900 1800 2700 3600 -!! ! w: 0. 0.5 1. 1. -!! ! -!! ! Note that w=0.5 for secs_since_old==force_dtstep/2 (at the mid-point). -!! -!! if (secs_since_old==force_dtstep/2) then -!! -!! w = 0.5 -!! -!! else -!! -!! w = real( (secs_since_old-1)/(force_dtstep/2) ) -!! -!! end if -!! -!! ! --------------------- -!! -!! do n=1,N_catd -!! -!! ! initialize -!! -!! mf_ntp(n) = nodata_generic -!! -!! ! STATES -!! ! -!! ! temperature, humidity, pressure and wind -!! -!! mf_ntp(n)%Tair = (1.-w)*mf_old(n)%Tair + w*mf_new(n)%Tair -!! mf_ntp(n)%Qair = (1.-w)*mf_old(n)%Qair + w*mf_new(n)%Qair -!! mf_ntp(n)%Psurf = (1.-w)*mf_old(n)%Psurf + w*mf_new(n)%Psurf -!! mf_ntp(n)%RefH = (1.-w)*mf_old(n)%RefH + w*mf_new(n)%RefH -!! -!! ! Wind -!! -!! ! LDASsa CVS tags between reichle-LDASsa_m2-10 and reichle-LDASsa_m2-13_p2 -!! ! worked with *inst*lfo* and *tavg*lfo* G5DAS forcing (as opposed to just -!! ! *tavg*lfo* from MERRA) and G5DAS Wind was read from *inst*lfo* files. -!! ! But for G5DAS forcing (as for MERRA), Wind was treated as a time-average -!! ! field, which implied that, e.g., the instantaneous G5DAS Wind at 0z was -!! ! used to force the land at 0:20z, 0:40z, and 1z. -!! ! In these tags, Wind was treated as a time-average field whenever -!! ! force_dtstep<=3601, which included MERRA, G5DAS, RedArk, and CONUS -!! ! forcing. -!! ! To make things more consistent for G5DAS winds, the "if" statement now -!! ! checks whether Wind at date_time_new is available (which is true G5DAS -!! ! and false for MERRA). The revised "if" statement does not change how -!! ! Wind is interpolated in MERRA (because Wind is unavailable at date_time_new) -!! ! and in GLDAS, Princeton, and GWSP (because force_dtstep>3601). -!! ! The revised "if" statement does change how CONUS and RedArk Wind data -!! ! are interpolated (now treated as instantaneous, previously treated as -!! ! time-average). -!! ! In summary, as of this change, Wind is treated as instantaneous for all -!! ! forcing data *except* MERRA. -!! ! -!! ! - reichle, 31 Jan 2014 -!! -!! ! if (force_dtstep_real > 3601.) then -!! if (abs(mf_new(n)%Wind-nodata_generic)>nodata_tol_generic) then -!! -!! ! treat Wind as instantaneous fields (all forcing data sets *except* MERRA) -!! -!! mf_ntp(n)%Wind = (1.-w)*mf_old(n)%Wind + w*mf_new(n)%Wind -!! -!! else -!! -!! ! treat Wind as time-average fields (MERRA) -!! -!! mf_ntp(n)%Wind = mf_old(n)%Wind -!! -!! end if -!! -!! ! FLUXES -!! -!! ! precipitation -!! -!! mf_ntp(n)%Rainf_C = mf_old(n)%Rainf_C -!! mf_ntp(n)%Rainf = mf_old(n)%Rainf -!! mf_ntp(n)%Snowf = mf_old(n)%Snowf -!! -!! ! incoming radiation -!! -!! mf_ntp(n)%LWdown = mf_old(n)%LWdown -!! -!! call solar(lon(n),lat(n),date_time_new%dofyr,secs_in_day,zth,slr) -!! -!! ! changed min sun-angle from 0.01 to 0.0001 for consistency with CatchGridComp -!! ! reichle, 23 Feb 2009 -!! ! changed min sun-angle back to 0.01 after testing -!! ! reichle, 27 Feb 2009 -!! -!! sunang_ntp(n) = max(zth, min_zth) -!! -!! ! changed minimum SWdown to 0. from 0.00001 - reichle, 28 Aug 2008 -!! -!! if (zth > 0.) then -!! -!! if (zenav(n) <= 0.) then -!! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'Problem with solar') -!! end if -!! -!! tmpreal = zth/zenav(n) -!! -!! mf_ntp(n)%SWdown = mf_old(n)%SWdown*tmpreal -!! -!! ! mf_ntp%SWnet only used if mf_old%SWnet is not no-data value; -!! ! protect multiplication for any no-data-value because it could -!! ! fail (floating point excess) if huge number is used as nodata value -!! -!! if(abs(mf_old(n)%SWnet -nodata_generic)>nodata_tol_generic) & -!! mf_ntp(n)%SWnet = mf_old(n)%SWnet*tmpreal -!! -!! if(abs(mf_old(n)%PARdrct-nodata_generic)>nodata_tol_generic) then -!! -!! ! assume that PARdffs is available whenever PARdrct is -!! -!! mf_ntp(n)%PARdrct = mf_old(n)%PARdrct*tmpreal -!! mf_ntp(n)%PARdffs = mf_old(n)%PARdffs*tmpreal -!! -!! end if -!! -!! elseif ((zth <= 0.) .and. (zenav(n) <= 0.)) then -!! -!! mf_ntp(n)%SWdown = max(0., mf_old(n)%SWdown) -!! mf_ntp(n)%SWnet = max(0., mf_old(n)%SWnet) ! no-data handling done below -!! mf_ntp(n)%PARdrct = max(0., mf_old(n)%PARdrct) ! no-data handling done below -!! mf_ntp(n)%PARdffs = max(0., mf_old(n)%PARdffs) ! no-data handling done below -!! -!! else -!! -!! mf_ntp(n)%SWdown = 0. -!! mf_ntp(n)%SWnet = 0. ! no-data handling done below -!! mf_ntp(n)%PARdrct = 0. ! no-data handling done below -!! mf_ntp(n)%PARdffs = 0. ! no-data handling done below -!! -!! end if -!! -!! ! cap shortwave radiation at (cosine of) sun angle times solar constant -!! ! reichle, 14 Aug 2002 -!! -!! mf_ntp(n)%SWdown = min( mf_ntp(n)%SWdown, 1360.*sunang_ntp(n) ) -!! -!! ! cap SWnet at SWdown -!! -!! mf_ntp(n)%SWnet = min( mf_ntp(n)%SWnet, mf_ntp(n)%SWdown ) -!! -!! ! reinstate no-data-values -!! -!! if(abs(mf_old(n)%SWnet-nodata_generic) CATCH_N_SNOW, & - N_gt => CATCH_N_GT - - use MAPL_ConstantsMod, ONLY: & - alhe => MAPL_ALHL, & - alhs => MAPL_ALHS, & - Tzero => MAPL_TICE - - use LDAS_DriverTypes, ONLY: & - met_force_type, & - veg_param_type, & - bal_diagn_type, & - out_choice_type, & - out_choice_time_type, & - out_dtstep_type, & - assignment (=), & - operator (+), & - operator (/) - use catch_types, ONLY: & cat_param_type, & - cat_progn_type, & - cat_diagS_type, & - cat_diagF_type, & assignment (=), & operator (+), & operator (/) - use LDAS_TileCoordType, ONLY: & - tile_coord_type, & - grid_def_type, & - io_grid_def_type + use LDAS_TileCoordType, ONLY: & + tile_coord_type use mwRTM_types, ONLY: & - mwRTM_param_type, & - io_mwRTM_param_type - - use mwRTM_routines, ONLY: & - catch2mwRTM_vars, & - mwRTM_get_Tb + mwRTM_param_type use LDAS_ensdrv_mpi, ONLY: & master_proc, & numprocs - use LDAS_DateTimeMod, ONLY: & - date_time_type, & - is_leap_year, & - days_in_month, & - datetime_eq_refdatetime, & - augment_date_time + use LDAS_DateTimeMod, ONLY: & + date_time_type - use clsm_ensdrv_drv_routines, ONLY: & - l2f_real - use LDAS_ensdrv_init_routines, ONLY: & clsm_ensdrv_get_command_line, & add_domain_to_path @@ -79,10 +39,7 @@ module clsm_ensdrv_out_routines use LDAS_ensdrv_functions, ONLY: & get_io_filename - use LDAS_TileCoordRoutines, ONLY: & - tile2grid - - use LDAS_ExceptionsMod, ONLY: & + use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -93,15 +50,7 @@ module clsm_ensdrv_out_routines private public :: init_log - public :: output_catparam - public :: output_mwRTMparam - public :: output_smapL4SMlmc public :: GEOS_output_smapL4SMlmc - public :: output_calcs - public :: output_write - public :: get_ensstd_filenames - public :: check_output_times - public :: get_land_mask_ij contains @@ -249,288 +198,6 @@ end subroutine init_log ! ******************************************************************** - subroutine output_catparam( date_time, work_path, exp_id, N_catd, cat_param ) - - ! writes cat_param for domain to file - ! - ! reichle, 21 Jan 2004 - ! - ! ------------------------------------------------------------------- - - implicit none - - type(date_time_type), intent(in) :: date_time - - character(200), intent(in) :: work_path - - character(40), intent(in) :: exp_id - - integer, intent(in) :: N_catd - - type(cat_param_type), dimension(N_catd), intent(in) :: cat_param - - ! ---------------------------- - - ! local variables - - character(300) :: fname - character( 40) :: file_tag, dir_name - - integer :: n, k - - ! ------------------------------------------------------------------ - - file_tag = 'ldas_catparam' - dir_name = 'rc_out' - - fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & - dir_name=dir_name ) - - open(10, file=fname, form='unformatted', status='unknown', action='write') - - if (logit) write (logunit,'(400A)') 'Writing catparam file ' // trim(fname) - - write (10) (cat_param(n)%dpth, n=1,N_catd) - - write (10) (cat_param(n)%dzsf, n=1,N_catd) - write (10) (cat_param(n)%dzrz, n=1,N_catd) - write (10) (cat_param(n)%dzpr, n=1,N_catd) - - do k=1,N_gt - write (10) (cat_param(n)%dzgt(k), n=1,N_catd) - end do - - write (10) (cat_param(n)%poros, n=1,N_catd) - write (10) (cat_param(n)%cond, n=1,N_catd) - write (10) (cat_param(n)%psis, n=1,N_catd) - write (10) (cat_param(n)%bee, n=1,N_catd) - - write (10) (cat_param(n)%wpwet, n=1,N_catd) - - write (10) (cat_param(n)%gnu, n=1,N_catd) - - write (10) (cat_param(n)%vgwmax, n=1,N_catd) - - write (10) (cat_param(n)%vegcls, n=1,N_catd) - write (10) (cat_param(n)%soilcls30, n=1,N_catd) - write (10) (cat_param(n)%soilcls100, n=1,N_catd) - - write (10) (cat_param(n)%bf1, n=1,N_catd) - write (10) (cat_param(n)%bf2, n=1,N_catd) - write (10) (cat_param(n)%bf3, n=1,N_catd) - write (10) (cat_param(n)%cdcr1, n=1,N_catd) - write (10) (cat_param(n)%cdcr2, n=1,N_catd) - write (10) (cat_param(n)%ars1, n=1,N_catd) - write (10) (cat_param(n)%ars2, n=1,N_catd) - write (10) (cat_param(n)%ars3, n=1,N_catd) - write (10) (cat_param(n)%ara1, n=1,N_catd) - write (10) (cat_param(n)%ara2, n=1,N_catd) - write (10) (cat_param(n)%ara3, n=1,N_catd) - write (10) (cat_param(n)%ara4, n=1,N_catd) - write (10) (cat_param(n)%arw1, n=1,N_catd) - write (10) (cat_param(n)%arw2, n=1,N_catd) - write (10) (cat_param(n)%arw3, n=1,N_catd) - write (10) (cat_param(n)%arw4, n=1,N_catd) - write (10) (cat_param(n)%tsa1, n=1,N_catd) - write (10) (cat_param(n)%tsa2, n=1,N_catd) - write (10) (cat_param(n)%tsb1, n=1,N_catd) - write (10) (cat_param(n)%tsb2, n=1,N_catd) - write (10) (cat_param(n)%atau, n=1,N_catd) - write (10) (cat_param(n)%btau, n=1,N_catd) - - write (10) (cat_param(n)%gravel30, n=1,N_catd) - write (10) (cat_param(n)%orgC30 , n=1,N_catd) - write (10) (cat_param(n)%orgC , n=1,N_catd) - write (10) (cat_param(n)%sand30 , n=1,N_catd) - write (10) (cat_param(n)%clay30 , n=1,N_catd) - write (10) (cat_param(n)%sand , n=1,N_catd) - write (10) (cat_param(n)%clay , n=1,N_catd) - write (10) (cat_param(n)%wpwet30 , n=1,N_catd) - write (10) (cat_param(n)%poros30 , n=1,N_catd) - - write (10) (cat_param(n)%veghght , n=1,N_catd) - - close (10,status='keep') - - if (logit) write (logunit,*) 'done writing' - if (logit) write (logunit,*) - - end subroutine output_catparam - - ! ******************************************************************** - - subroutine output_mwRTMparam( date_time, work_path, exp_id, N_catd, mwRTM_param ) - - ! writes mwRTM_param for domain to file - ! - ! reichle, 1 Jun 2011 - ! - ! ------------------------------------------------------------------- - - implicit none - - type(date_time_type), intent(in ) :: date_time - - character(200), intent(in ) :: work_path - - character(40), intent(in ) :: exp_id - - integer, intent(in ) :: N_catd - - type(mwRTM_param_type), dimension(N_catd), intent(inout) :: mwRTM_param - - ! ---------------------------- - - ! local variables - - character(300) :: fname - character( 40) :: file_tag, dir_name - - ! ------------------------------------------------------------------ - - file_tag = 'ldas_mwRTMparam' - dir_name = 'rc_out' - - fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & - dir_name=dir_name ) - - open(10, file=fname, form='unformatted', status='unknown', action='write') - - if (logit) write (logunit,'(400A)') 'Writing mwRTMparam file ' // trim(fname) - - call io_mwRTM_param_type( 'w', 10, N_catd, mwRTM_param ) - - close (10,status='keep') - - if (logit) write (logunit,*) 'done writing' - if (logit) write (logunit,*) - - end subroutine output_mwRTMparam - - ! ******************************************************************** - - subroutine output_smapL4SMlmc( date_time, work_path, exp_id, & - N_catf, tile_coord, cat_param, mwRTM_param ) - - ! write SMAP L4_SM "lmc" (land model constants) file collection - ! as binary, tile-space output - ! - ! requires "full" domain inputs - ! - ! reichle, 26 Apr 2012 - ! reichle, 27 May 2014: - changed wilting point output from "clsm_wpwet" to "clsm_wp" - ! - ! ------------------------------------------------------------------- - - implicit none - - type(date_time_type), intent(in) :: date_time - - character(200), intent(in) :: work_path - - character(40), intent(in) :: exp_id - - integer, intent(in) :: N_catf - - type(tile_coord_type), dimension(N_catf), intent(in) :: tile_coord - - type(cat_param_type), dimension(N_catf), intent(in) :: cat_param - - type(mwRTM_param_type), dimension(N_catf), intent(in) :: mwRTM_param - - ! ---------------------------- - - ! local variables - - character(300) :: fname - character( 40) :: file_tag, dir_name - - integer :: n - - real, dimension(N_catf) :: dztsurf, clsm_wp - - ! ------------------------------------------------------------------ - ! - ! compute dztsurf - - dztsurf = 0.05 ! now 0.05 m everywhere due to revised CSOIL_2 in subroutine catchment() - - ! convert wilting point from wetness units to volumetric units - - clsm_wp = cat_param%wpwet * cat_param%poros - - ! ------------------- - - file_tag = 'ldas_smapL4SMlmc' - dir_name = 'rc_out' - - fname = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, dir_name=dir_name ) - - open(10, file=fname, form='unformatted', status='unknown', action='write') - - if (logit) write (logunit,'(400A)') 'Writing SMAP L4_SM lmc file ' // trim(fname) - - ! -------------------- - - write (10) (tile_coord(n)%frac_cell, n=1,N_catf) ! 1: real - write (10) (tile_coord(n)%elev, n=1,N_catf) ! 2: real - - ! for dzsf, dzrz, and dzpr change units from mm (or kg/m2) to m - - write (10) (cat_param(n)%dzsf/1000., n=1,N_catf) ! 3: real - write (10) (cat_param(n)%dzrz/1000., n=1,N_catf) ! 4: real - write (10) (cat_param(n)%dzpr/1000., n=1,N_catf) ! 5: real - - write (10) (dztsurf(n), n=1,N_catf) ! 6: real - - write (10) (cat_param(n)%dzgt(1), n=1,N_catf) ! 7: real - write (10) (cat_param(n)%dzgt(2), n=1,N_catf) ! 8: real - write (10) (cat_param(n)%dzgt(3), n=1,N_catf) ! 9: real - write (10) (cat_param(n)%dzgt(4), n=1,N_catf) ! 10: real - write (10) (cat_param(n)%dzgt(5), n=1,N_catf) ! 11: real - write (10) (cat_param(n)%dzgt(6), n=1,N_catf) ! 12: real - - write (10) (cat_param(n)%poros, n=1,N_catf) ! 13: real - write (10) (clsm_wp(n), n=1,N_catf) ! 14: real - - write (10) (cat_param(n)%cdcr1, n=1,N_catf) ! 15: real - write (10) (cat_param(n)%cdcr2, n=1,N_catf) ! 16: real - - write (10) (mwRTM_param(n)%vegcls, n=1,N_catf) ! 17: integer !!! - write (10) (mwRTM_param(n)%soilcls, n=1,N_catf) ! 18: integer !!! - - write (10) (mwRTM_param(n)%sand, n=1,N_catf) ! 19: real - write (10) (mwRTM_param(n)%clay, n=1,N_catf) ! 20: real - - write (10) (mwRTM_param(n)%poros, n=1,N_catf) ! 21: real - - write (10) (mwRTM_param(n)%wang_wt, n=1,N_catf) ! 22: real - write (10) (mwRTM_param(n)%wang_wp, n=1,N_catf) ! 23: real - - write (10) (mwRTM_param(n)%rgh_hmin, n=1,N_catf) ! 24: real - write (10) (mwRTM_param(n)%rgh_hmax, n=1,N_catf) ! 25: real - write (10) (mwRTM_param(n)%rgh_wmin, n=1,N_catf) ! 26: real - write (10) (mwRTM_param(n)%rgh_wmax, n=1,N_catf) ! 27: real - write (10) (mwRTM_param(n)%rgh_Nrh, n=1,N_catf) ! 28: real - write (10) (mwRTM_param(n)%rgh_Nrv, n=1,N_catf) ! 29: real - write (10) (mwRTM_param(n)%rgh_polmix, n=1,N_catf) ! 30: real - - write (10) (mwRTM_param(n)%omega, n=1,N_catf) ! 31: real - - write (10) (mwRTM_param(n)%bh, n=1,N_catf) ! 32: real - write (10) (mwRTM_param(n)%bv, n=1,N_catf) ! 33: real - write (10) (mwRTM_param(n)%lewt, n=1,N_catf) ! 34: real - - write (10) (cat_param(n)%veghght, n=1,N_catf) ! 35: real - - close (10,status='keep') - - if (logit) write (logunit,*) 'done writing' - if (logit) write (logunit,*) - - end subroutine output_smapL4SMlmc - subroutine GEOS_output_smapL4SMlmc( GC, date_time, work_path, exp_id, & N_catl, tile_coord_l, cat_param, mwRTM_param ) @@ -660,1626 +327,6 @@ subroutine GEOS_output_smapL4SMlmc( GC, date_time, work_path, exp_id, & if (logit) write (logunit,*) end subroutine GEOS_output_smapL4SMlmc - ! ******************************************************************** - - subroutine output_calcs( & - option, out_collection_ID, Nt, & - cat_progn, cat_diagS, cat_diagF, & - met_force, veg_param, bal_diagn, & - cat_progn_avg, cat_diagS_avg, cat_diagF_avg, & - met_force_avg, veg_param_avg, bal_diagn_avg, & - cat_param, mwRTM_param, tile_coord, & - out_choice, date_time, work_path, exp_id, interval, & - model_dtstep, & - out_tile, out_grid, fname_tile, fname_grid, tile_data, & - out_dtstep_xhourly, ens_id ) - - ! calculations and preparation for inst, xhourly, daily, pentad, - ! and monthly output - ! - ! option = 'ini' : initialize - ! option = 'add' : add values of current time step into "_avg" - ! option = 'out' : normalize and output avg - ! - ! reichle, 29 Sep 2009 - reformulated based on old subroutine calc_tavg() - ! see also new subroutine write_output() - ! reichle, 9 Dec 2011 - revised using new types "veg_param" and "bal_diagn" - ! reichle, 28 Dec 2011 - removed field "totalb" from "cat_diagn" structure - ! reichle, 31 Oct 2013 - split "cat_diagn" structure into "cat_diagS" and "cat_diagF" - ! - ! --------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: out_collection_ID - - integer, intent(in) :: Nt ! previously named N_catd - - character(3), intent(in) :: option - - type(cat_progn_type), dimension(Nt), intent(in) :: cat_progn - type(cat_diagS_type), dimension(Nt), intent(in) :: cat_diagS - type(cat_diagF_type), dimension(Nt), intent(in) :: cat_diagF - type(met_force_type), dimension(Nt), intent(in) :: met_force - type(veg_param_type), dimension(Nt), intent(in) :: veg_param - type(bal_diagn_type), dimension(Nt), intent(in) :: bal_diagn - - type(cat_progn_type), dimension(Nt), intent(inout) :: cat_progn_avg - type(cat_diagS_type), dimension(Nt), intent(inout) :: cat_diagS_avg - type(cat_diagF_type), dimension(Nt), intent(inout) :: cat_diagF_avg - type(met_force_type), dimension(Nt), intent(inout) :: met_force_avg - type(veg_param_type), dimension(Nt), intent(inout) :: veg_param_avg - type(bal_diagn_type), dimension(Nt), intent(inout) :: bal_diagn_avg - - ! optional inputs (needed when writing average to file) - - type(cat_param_type), dimension(Nt), intent(in), optional :: cat_param - - type(mwRTM_param_type), dimension(Nt), intent(in), optional :: mwRTM_param - - type(tile_coord_type), dimension(Nt), intent(in), optional :: tile_coord - - type(out_choice_type), intent(in), optional :: out_choice - - type(date_time_type), intent(in), optional :: date_time - - character(200), intent(in), optional :: work_path - character(40), intent(in), optional :: exp_id - - ! what averaging interval is used? (need to know to construct file name) - ! - ! inst : interval = 'i' -- for inst output ONLY call with option 'out' - ! xhourly: interval = 'x' - ! daily : interval = 'd' - ! pentad : interval = 'p' - ! monthly: interval = 'm' - - character, intent(in), optional :: interval - - logical, intent(out), optional :: out_tile, out_grid - - character(300), intent(out), optional :: fname_tile, fname_grid - - ! changed tile_data to pointer so that compile with "-check bounds" works - ! - reichle, 8 Feb 2013 - - real, dimension(:,:), pointer, optional :: tile_data ! intent(out) - ! dimension(Nt,N_out_fields) - - integer, intent(in), optional :: model_dtstep, out_dtstep_xhourly, ens_id - - ! ---------------------------------------- - - ! local variables - - integer :: n, k, ens_id_tmp - - real :: n_steps, totalb, ar4, freq, inc_angle - - real, parameter :: daylen = 86400. - - character(40) :: file_tag - - logical :: out_wetness, muststop, incl_atm_terms - - type(date_time_type) :: date_time_tmp - - real, dimension(Nt) :: tmpreal, SWE, sfmc_mwRTM, tsoil_mwRTM, Tb_h, Tb_v - - type(cat_diagS_type) :: cat_diagS_tmp - - character(len=*), parameter :: Iam = 'output_calcs' - character(len=400) :: err_msg - - ! ------------------------------------------------------------ - - out_wetness = .false. - - ! Removed "out_wetness" from LDASsa nml inputs and hard-wired - ! to "false". - ! If needed for backward compatibility, add replicates of - ! Collections 1, 2, 3, or 10, assign new Collection IDs, - ! and set out_wetness=.true. below. - ! - ! - reichle, 27 Aug 2014 - - !select case (out_collection_ID) - ! - ! case ( "list of new_collection_IDs" ) - ! - !case default - ! - ! out_wetness = .false. - ! - !end select - - ! ------------------------------------------------------------ - - if (option=='ini') then ! initialize - - do n=1,Nt - - cat_progn_avg(n) = 0. - cat_diagS_avg(n) = 0. - cat_diagF_avg(n) = 0. - met_force_avg(n) = 0. - veg_param_avg(n) = 0. - bal_diagn_avg(n) = 0. - - end do - - else if (option=='add') then ! sum up for average - - do n=1,Nt - - cat_progn_avg(n) = cat_progn_avg(n) + cat_progn(n) - - ! ---------------- - - ! In catchment() the snow temperature is set to TSURF if ASNOW=0. - ! Exclude snow-free temperatures from longer-term (eg, monthly) - ! time averages by weighting snow temperature with snow cover - ! fraction. - ! - reichle, 29 Feb 2012 - - cat_diagS_tmp = cat_diagS(n) - - cat_diagS_tmp%tpsn(1:N_snow) = cat_diagS(n)%tpsn(1:N_snow)*cat_diagS(n)%asnow - - cat_diagS_avg(n) = cat_diagS_avg(n) + cat_diagS_tmp - - ! ---------------- - - cat_diagF_avg(n) = cat_diagF_avg(n) + cat_diagF(n) - - met_force_avg(n) = met_force_avg(n) + met_force(n) - - veg_param_avg(n) = veg_param_avg(n) + veg_param(n) - - bal_diagn_avg(n) = bal_diagn_avg(n) + bal_diagn(n) - - end do - - else if (option=='out') then ! finalize, output, re-initialize averages - - ! prepare for output - - ! make sure all optional arguments are present that are required for 'out' - - muststop = .false. - - if (.not. present(out_choice)) muststop=.true. - if (.not. present(date_time)) muststop=.true. - if (.not. present(work_path)) muststop=.true. - if (.not. present(exp_id)) muststop=.true. - if (.not. present(interval)) muststop=.true. - if (.not. present(model_dtstep)) muststop=.true. - - if (muststop) then - err_msg = 'optional input arguments missing' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if (.not. present(ens_id)) then - - ens_id_tmp = -1 ! default to ensemble average - - else - - ens_id_tmp = ens_id - - end if - - - ! put together normalization factors and file names, also determine - ! whether tile or grid output is desired - - out_tile = .false. - out_grid = .false. - - select case (interval) - - case ('i') ! instantaneous - - n_steps = 1. - - if (out_choice%inst%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_inst_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, ens_id=ens_id_tmp ) - - end if - - if (out_choice%inst%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_inst_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, ens_id=ens_id_tmp ) - - end if - - case ('x') ! xhourly - - if (present(out_dtstep_xhourly)) then - - n_steps = real(out_dtstep_xhourly/model_dtstep) - - else - - err_msg = 'need out_dtstep_xhourly' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end if - - ! shift date/time so that mid-point of time averaging interval is - ! used for time-tagging the output file - - date_time_tmp = date_time - - call augment_date_time( -out_dtstep_xhourly/2, date_time_tmp ) - - if (out_choice%xhourly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_xhourly_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, ens_id=ens_id_tmp ) - - end if - - if (out_choice%xhourly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_xhourly_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, ens_id=ens_id_tmp ) - - end if - - case ('d') ! daily - - n_steps = real(86400/model_dtstep) - - if (out_choice%daily%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_daily_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=4, ens_id=ens_id_tmp ) - - end if - - if (out_choice%daily%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_daily_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=4, ens_id=ens_id_tmp ) - - end if - - case ('p') ! pentad - - if (date_time%pentad==12 .and. is_leap_year(date_time%year)) then - - n_steps = real(6*86400/model_dtstep) - - else - n_steps = real(5*86400/model_dtstep) - - end if - - if (out_choice%pentad%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_pentad_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=3, ens_id=ens_id_tmp ) - - end if - - if (out_choice%pentad%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_pentad_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=3, ens_id=ens_id_tmp ) - - end if - - case ('m') ! monthly - - n_steps = real(days_in_month(date_time%year,date_time%month)*86400/model_dtstep) - - if (out_choice%monthly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_monthly_out' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=2, ens_id=ens_id_tmp ) - - end if - - if (out_choice%monthly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_monthly_out' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, option=2, ens_id=ens_id_tmp ) - - end if - - case default - - err_msg = 'unknown averaging interval' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select ! case (interval) - - ! ----------------------- - ! - ! normalize, fix no-data-values, change units - - do n=1,Nt - - ! normalize by number of time steps - - cat_progn_avg(n) = cat_progn_avg(n) / n_steps - cat_diagS_avg(n) = cat_diagS_avg(n) / n_steps - cat_diagF_avg(n) = cat_diagF_avg(n) / n_steps - met_force_avg(n) = met_force_avg(n) / n_steps - veg_param_avg(n) = veg_param_avg(n) / n_steps - bal_diagn_avg(n) = bal_diagn_avg(n) / n_steps - - ! In catchment() the snow temperature is set to TSURF if ASNOW=0. - ! Exclude snow-free temperatures from longer-term (eg, monthly) - ! time averages by weighting snow temperature with snow cover - ! fraction. - ! - reichle, 29 Feb 2012 - - if (cat_diagS_avg(n)%asnow>0.) then - - ! normalize asnow-weighted time-average - ! (except for instantaneous ('i') output) - ! -reichle+csdraper, 31 Oct 2013 - - if (interval/='i') & - cat_diagS_avg(n)%tpsn(1:N_snow) = & - cat_diagS_avg(n)%tpsn(1:N_snow)/cat_diagS_avg(n)%asnow - - else - - cat_diagS_avg(n)%tpsn(1:N_snow) = nodata_generic - - end if - - ! change sub-tile canopy temperatures and spec humidities to - ! no-data-values when corresponding area fraction is zero - ! reichle, 29 Feb 2012 - - ar4 = 1. - cat_diagS_avg(n)%ar1 - cat_diagS_avg(n)%ar2 - - if (cat_diagS_avg(n)%ar1<=0.) cat_progn_avg(n)%tc1 = nodata_generic - if (cat_diagS_avg(n)%ar2<=0.) cat_progn_avg(n)%tc2 = nodata_generic - if ( ar4<=0.) cat_progn_avg(n)%tc4 = nodata_generic - - if (cat_diagS_avg(n)%ar1<=0.) cat_progn_avg(n)%qa1 = nodata_generic - if (cat_diagS_avg(n)%ar2<=0.) cat_progn_avg(n)%qa2 = nodata_generic - if ( ar4<=0.) cat_progn_avg(n)%qa4 = nodata_generic - - - ! change units for selected outputs - ! - ! reichle, 29 Feb 2012: MUST add no-data-check if changing units of - ! tpsn, tc1, tc2, tc4, qa1, qa2, qa4 - - select case (out_collection_ID) - - case (1,2,3,10) - - ! convert [kg/m2/s] into [mm/day] - - met_force_avg(n)%Rainf_C = met_force_avg(n)%Rainf_C * daylen - met_force_avg(n)%Rainf = met_force_avg(n)%Rainf * daylen - met_force_avg(n)%Snowf = met_force_avg(n)%Snowf * daylen - - cat_diagF_avg(n)%evap = cat_diagF_avg(n)%evap * daylen - - cat_diagF_avg(n)%runoff = cat_diagF_avg(n)%runoff * daylen - cat_diagF_avg(n)%runsrf = cat_diagF_avg(n)%runsrf * daylen - cat_diagF_avg(n)%bflow = cat_diagF_avg(n)%bflow * daylen - - cat_diagF_avg(n)%snmelt = cat_diagF_avg(n)%snmelt * daylen - - bal_diagn_avg(n)%wchng = bal_diagn_avg(n)%wchng * daylen - bal_diagn_avg(n)%wincr = bal_diagn_avg(n)%wincr * daylen - - ! convert [W/m2] into [mm/day] - - cat_diagF_avg(n)%eint = cat_diagF_avg(n)%eint * daylen/alhe - cat_diagF_avg(n)%eveg = cat_diagF_avg(n)%eveg * daylen/alhe - cat_diagF_avg(n)%esno = cat_diagF_avg(n)%esno * daylen/alhs - cat_diagF_avg(n)%esoi = cat_diagF_avg(n)%esoi * daylen/alhe - - ! units of qinfil should probably be changed - - ! why are units of energy_bal not changed? - ! perhaps b/c division by seconds works out just fine (Joule -> Watts )?? - - case (4,5,6,7,8,9,11) - - ! no unit changes - - case default - - err_msg = 'unknown out_collection_ID' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - - ! ALWAYS convert units of tp from deg C to Kelvin - - do k=1,N_gt - - cat_diagS_avg(n)%tp(k) = cat_diagS_avg(n)%tp(k) + Tzero - - end do - - end do - - ! ---------------------------------------------------------- - ! - ! assemble data that are actually output - - select case (out_collection_ID) - - case (1,10) ! 1 - N_out_fields_inst = N_out_fields_tavg = 44 - ! 10 - N_out_fields_inst = N_out_fields_tavg = 46 - - ! 1 - Legacy LDASsa off-line output specs ("44 variables") - ! 10 - Legacy plus t2m, q2m - - do n=1,Nt - - if (met_force_avg(n)%SWdown > 1e-4) then - totalb = cat_diagF_avg(n)%swup/met_force_avg(n)%SWdown - else - totalb = nodata_generic - end if - - tile_data(n, 1) = met_force_avg(n)%Tair - tile_data(n, 2) = met_force_avg(n)%Qair - tile_data(n, 3) = met_force_avg(n)%Psurf - tile_data(n, 4) = met_force_avg(n)%Rainf_C - tile_data(n, 5) = met_force_avg(n)%Rainf - tile_data(n, 6) = met_force_avg(n)%Snowf - tile_data(n, 7) = met_force_avg(n)%LWdown - tile_data(n, 8) = met_force_avg(n)%SWdown - tile_data(n, 9) = met_force_avg(n)%Wind - - tile_data(n,10) = cat_progn_avg(n)%capac - tile_data(n,11) = cat_progn_avg(n)%srfexc - tile_data(n,12) = cat_progn_avg(n)%rzexc - tile_data(n,13) = cat_progn_avg(n)%catdef - tile_data(n,14) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - tile_data(n,15) = sum(cat_progn_avg(n)%sndz(1:N_snow)) - - tile_data(n,16) = cat_diagS_avg(n)%ar1 - tile_data(n,17) = cat_diagS_avg(n)%ar2 - tile_data(n,18) = cat_diagS_avg(n)%asnow - - if (out_wetness) then - - tile_data(n,19) = max(min(cat_diagS_avg(n)%sfmc/cat_param(n)%poros,1.),0.) - tile_data(n,20) = max(min(cat_diagS_avg(n)%rzmc/cat_param(n)%poros,1.),0.) - tile_data(n,21) = max(min(cat_diagS_avg(n)%prmc/cat_param(n)%poros,1.),0.) - - else - - tile_data(n,19) = cat_diagS_avg(n)%sfmc - tile_data(n,20) = cat_diagS_avg(n)%rzmc - tile_data(n,21) = cat_diagS_avg(n)%prmc - - end if - - tile_data(n,22) = cat_diagS_avg(n)%tsurf - tile_data(n,23) = cat_diagS_avg(n)%tp(1) - tile_data(n,24) = cat_diagS_avg(n)%tp(N_gt) - tile_data(n,25) = cat_diagS_avg(n)%tpsn(1) - tile_data(n,26) = cat_diagS_avg(n)%tpsn(N_snow) - - tile_data(n,27) = cat_diagF_avg(n)%shflux - tile_data(n,28) = cat_diagF_avg(n)%lhflux - tile_data(n,29) = cat_diagF_avg(n)%ghflux - tile_data(n,30) = cat_diagF_avg(n)%evap - tile_data(n,31) = cat_diagF_avg(n)%eint - tile_data(n,32) = cat_diagF_avg(n)%eveg - tile_data(n,33) = cat_diagF_avg(n)%esoi - tile_data(n,34) = cat_diagF_avg(n)%esno - tile_data(n,35) = cat_diagF_avg(n)%runoff - tile_data(n,36) = cat_diagF_avg(n)%runsrf - tile_data(n,37) = cat_diagF_avg(n)%bflow - tile_data(n,38) = cat_diagF_avg(n)%snmelt - tile_data(n,39) = cat_diagF_avg(n)%lwup - tile_data(n,40) = cat_diagF_avg(n)%swup - tile_data(n,41) = cat_diagF_avg(n)%qinfil - - tile_data(n,42) = totalb - - tile_data(n,43) = bal_diagn_avg(n)%wincr - tile_data(n,44) = bal_diagn_avg(n)%eincr - - if (out_collection_ID==10) then - - tile_data(n,45) = cat_diagF_avg(n)%t2m - tile_data(n,46) = cat_diagF_avg(n)%q2m - - end if - - end do - - case (2) ! N_out_fields_inst = N_out_fields_tavg = 6 - - ! Specs for SMAP Nature Run v02 (Feb 2011) - - do n=1,Nt - - if (out_wetness) then - - tile_data(n,1) = max(min(cat_diagS_avg(n)%sfmc/cat_param(n)%poros,1.),0.) - tile_data(n,2) = max(min(cat_diagS_avg(n)%rzmc/cat_param(n)%poros,1.),0.) - - else - - tile_data(n,1) = cat_diagS_avg(n)%sfmc - tile_data(n,2) = cat_diagS_avg(n)%rzmc - - end if - - tile_data(n,3) = cat_diagS_avg(n)%tsurf - tile_data(n,4) = cat_diagS_avg(n)%tp(1) - tile_data(n,5) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - tile_data(n,6) = met_force_avg(n)%Rainf+met_force_avg(n)%Snowf - - end do - - case (3) ! N_out_fields_inst = N_out_fields_tavg = 8 - - ! for L-band mwRTM calibration (before Dec 2013), SMOS DA - - do n=1,Nt - - if (out_wetness) then - - tile_data(n,1) = max(min(cat_diagS_avg(n)%sfmc/cat_param(n)%poros,1.),0.) - tile_data(n,2) = max(min(cat_diagS_avg(n)%rzmc/cat_param(n)%poros,1.),0.) - - else - - tile_data(n,1) = cat_diagS_avg(n)%sfmc - tile_data(n,2) = cat_diagS_avg(n)%rzmc - - end if - - tile_data(n,3) = cat_diagS_avg(n)%tsurf - tile_data(n,4) = cat_diagS_avg(n)%tp(1) - tile_data(n,5) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - tile_data(n,6) = met_force_avg(n)%Rainf+met_force_avg(n)%Snowf - tile_data(n,7) = met_force_avg(n)%Tair - tile_data(n,8) = cat_progn_avg(n)%capac - - end do - - - case (4,5) ! N_out_fields_inst = N_out_fields_tavg = 50, 59 - - ! 50 MERRA-Land "mld" outputs *or* 59 = 50 MERRA-Land "mld" outputs plus 9 additional fields - ! - ! reichle, 29 Feb 2012: updated to reflect final "mld" file specs (incl TSURF) - - tile_data(1:Nt, 1) = veg_param_avg%grn ! GRN Fraction - tile_data(1:Nt, 2) = veg_param_avg%lai ! LAI m2 m-2 - - tile_data(1:Nt, 3) = max(min(cat_diagS_avg%prmc/cat_param%poros,1.),0.) ! GWETPROF Fraction - tile_data(1:Nt, 4) = max(min(cat_diagS_avg%rzmc/cat_param%poros,1.),0.) ! GWETROOT Fraction - tile_data(1:Nt, 5) = max(min(cat_diagS_avg%sfmc/cat_param%poros,1.),0.) ! GWETTOP Fraction - - tile_data(1:Nt, 6) = cat_diagS_avg%prmc ! PRMC m3/m3 - tile_data(1:Nt, 7) = cat_diagS_avg%rzmc ! RZMC m3/m3 - tile_data(1:Nt, 8) = cat_diagS_avg%sfmc ! SFMC m3/m3 - - tile_data(1:Nt, 9) = cat_diagS_avg%tsurf ! TSURF K - tile_data(1:Nt,10) = cat_diagS_avg%tpsn(1) ! TPSNOW K - - tile_data(1:Nt,11) = cat_progn_avg%tc2 ! TUNST K - tile_data(1:Nt,12) = cat_progn_avg%tc1 ! TSAT K - tile_data(1:Nt,13) = cat_progn_avg%tc4 ! TWLT K - - tile_data(1:Nt,14) = cat_diagS_avg%tp(1) ! TSOIL1 K - tile_data(1:Nt,15) = cat_diagS_avg%tp(2) ! TSOIL2 K - tile_data(1:Nt,16) = cat_diagS_avg%tp(3) ! TSOIL3 K - tile_data(1:Nt,17) = cat_diagS_avg%tp(4) ! TSOIL4 K - tile_data(1:Nt,18) = cat_diagS_avg%tp(5) ! TSOIL5 K - tile_data(1:Nt,19) = cat_diagS_avg%tp(6) ! TSOIL6 K - - tile_data(1:Nt,20) = met_force_avg%Snowf ! PRECSNO kg m-2 s-1 - tile_data(1:Nt,21) = met_force_avg%Rainf + met_force_avg%Snowf ! PRECTOT kg m-2 s-1 - - do n=1,Nt - - tile_data(n,22) = sum(cat_progn_avg(n)%wesn(1:N_snow)) ! SNOMAS kg m-2 - tile_data(n,23) = sum(cat_progn_avg(n)%sndz(1:N_snow)) ! SNODP m - - end do - - tile_data(1:Nt,24) = cat_diagF_avg%esoi ! EVPSOIL W m-2 - tile_data(1:Nt,25) = cat_diagF_avg%eveg ! EVPTRNS W m-2 - tile_data(1:Nt,26) = cat_diagF_avg%eint ! EVPINTR W m-2 - tile_data(1:Nt,27) = cat_diagF_avg%esno ! EVPSBLN W m-2 - - tile_data(1:Nt,28) = cat_diagF_avg%runsrf ! RUNOFF kg m-2 s-1 - tile_data(1:Nt,29) = cat_diagF_avg%bflow ! BASEFLOW kg m-2 s-1 - tile_data(1:Nt,30) = cat_diagF_avg%snmelt ! SMLAND kg m-2 s-1 - tile_data(1:Nt,31) = cat_diagF_avg%qinfil ! QINFIL kg m-2 s-1 - - ! Note: ar1+ar2+ar4=1 but need FRSAT+FRUNST+FRWLT+FRSNO=1 - - tmpreal(1:Nt) = max(min((1.-cat_diagS_avg%asnow),1.),0.) ! precompute snow-free fraction - - tile_data(1:Nt,32) = max(min(tmpreal*cat_diagS_avg%ar2, 1.),0.) ! FRUNST Fraction - tile_data(1:Nt,33) = max(min(tmpreal*cat_diagS_avg%ar1, 1.),0.) ! FRSAT Fraction - tile_data(1:Nt,34) = max(min( cat_diagS_avg%asnow,1.),0.) ! FRSNO Fraction - - tmpreal = tmpreal-tile_data(1:Nt,32)-tile_data(1:Nt,33) ! compute wilting fraction - - ! tmpreal = 1.-sum(tile_data(1:Nt,31:33),dim=2) - ! tmpreal = tmpreal * (1.-cat_diagS_avg%ar1-cat_diagS_avg%ar2) - - tile_data(1:Nt,35) = max(min(tmpreal, 1.),0.) ! FRWLT fraction - - - tile_data(1:Nt,36) = met_force_avg%PARdffs ! PARDF W m-2 - tile_data(1:Nt,37) = met_force_avg%PARdrct ! PARDR W m-2 - - tile_data(1:Nt,38) = cat_diagF_avg%shflux ! SHLAND W m-2 - tile_data(1:Nt,39) = cat_diagF_avg%lhflux ! LHLAND W m-2 - tile_data(1:Nt,40) = cat_diagF_avg%evap ! EVLAND kg m-2 s-1 - - tile_data(1:Nt,41) = met_force_avg%LWdown - cat_diagF_avg%lwup ! LWLAND W m-2 - tile_data(1:Nt,42) = met_force_avg%SWdown - cat_diagF_avg%swup ! SWLAND W m-2 - - tile_data(1:Nt,43) = cat_diagF_avg%ghflux ! GHLAND W m-2 - - tile_data(1:Nt,44) = bal_diagn_avg%wtotl ! TWLAND kg m-2 - tile_data(1:Nt,45) = bal_diagn_avg%etotl ! TELAND J m-2 - tile_data(1:Nt,46) = bal_diagn_avg%wchng ! WCHANGE kg m-2 s-1 - tile_data(1:Nt,47) = bal_diagn_avg%echng ! ECHANGE W m-2 - - tile_data(1:Nt,48) = 0. ! SPLAND W m-2 - tile_data(1:Nt,49) = 0. ! SPWATR kg m-2 s-1 - tile_data(1:Nt,50) = cat_diagF_avg%hsnacc ! SPSNOW W m-2 - - if (out_collection_ID==5) then - - ! select additional outputs - - tile_data(1:Nt,51) = met_force_avg%Tair ! TLML K - tile_data(1:Nt,52) = met_force_avg%Qair ! QLML kg kg-1 - tile_data(1:Nt,53) = met_force_avg%LWdown ! LWGAB W m-2 - tile_data(1:Nt,54) = met_force_avg%SWdown ! SWGDN W m-2 - - tile_data(1:Nt,55) = cat_progn_avg%srfexc ! kg m-2 - tile_data(1:Nt,56) = cat_progn_avg%rzexc ! kg m-2 - tile_data(1:Nt,57) = cat_progn_avg%catdef ! kg m-2 - - tile_data(1:Nt,58) = bal_diagn_avg%wincr ! kg m-2 - tile_data(1:Nt,59) = bal_diagn_avg%eincr ! J m-2 - - end if - - - case (6) ! N_out_fields_inst = N_out_fields_tavg = 40 (EXCL sm in pctl units!) - - ! output fields of SMAP L4_SM gph collection, - ! order follows Table 9 of SMAP L4_SM Data Products Specification Document (PSD; revised Jun 2014) - ! - ! NOTE: rootzone and profile soil moisture outputs in units of percentiles are appended in post-processing - ! - ! - reichle, 9 Apr 2013 - ! - reichle, 26 May 2014 - revised output specs: replaced sm in pctl units (fields 1-3) with sm in volumetric units - - tile_data(1:Nt, 1) = cat_diagS_avg%sfmc ! sm_surface m3 m-3 - tile_data(1:Nt, 2) = cat_diagS_avg%rzmc ! sm_rootzone m3 m-3 - tile_data(1:Nt, 3) = cat_diagS_avg%prmc ! sm_profile m3 m-3 - - tile_data(1:Nt, 4) = max(min(cat_diagS_avg%sfmc/cat_param%poros,1.),0.) ! sm_surface_wetness dimensionless - tile_data(1:Nt, 5) = max(min(cat_diagS_avg%rzmc/cat_param%poros,1.),0.) ! sm_rootzone_wetness dimensionless - tile_data(1:Nt, 6) = max(min(cat_diagS_avg%prmc/cat_param%poros,1.),0.) ! sm_profile_wetness dimensionless - - tile_data(1:Nt, 7) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt, 8) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt, 9) = cat_diagS_avg%tp(2) ! soil_temp_layer2 K - tile_data(1:Nt,10) = cat_diagS_avg%tp(3) ! soil_temp_layer3 K - tile_data(1:Nt,11) = cat_diagS_avg%tp(4) ! soil_temp_layer4 K - tile_data(1:Nt,12) = cat_diagS_avg%tp(5) ! soil_temp_layer5 K - tile_data(1:Nt,13) = cat_diagS_avg%tp(6) ! soil_temp_layer6 K - - do n=1,Nt - - tile_data(n,14) = sum(cat_progn_avg(n)%wesn(1:N_snow)) ! snow_mass kg m-2 - tile_data(n,15) = sum(cat_progn_avg(n)%sndz(1:N_snow)) ! snow_depth m - - end do - - tile_data(1:Nt,16) = cat_diagF_avg%evap ! land_evapotranspiration_flux kg m-2 s-1 - tile_data(1:Nt,17) = cat_diagF_avg%runsrf ! overland_runoff_flux kg m-2 s-1 - tile_data(1:Nt,18) = cat_diagF_avg%bflow ! baseflow_flux kg m-2 s-1 - tile_data(1:Nt,19) = cat_diagF_avg%snmelt ! snow_melt_flux kg m-2 s-1 - tile_data(1:Nt,20) = cat_diagF_avg%qinfil ! soil_water_infiltration_flux kg m-2 s-1 - - - ! Note: ar1+ar2+ar4=1 but need FRSAT+FRUNST+FRWLT+FRSNO=1 - - tmpreal(1:Nt) = max(min((1.-cat_diagS_avg%asnow),1.),0.) ! precompute snow-free fraction - - tile_data(1:Nt,21) = max(min(tmpreal*cat_diagS_avg%ar1, 1.),0.) ! land_fraction_saturated dimensionless - tile_data(1:Nt,22) = max(min(tmpreal*cat_diagS_avg%ar2, 1.),0.) ! land_fraction_unsaturated dimensionless - - tmpreal = tmpreal-tile_data(1:Nt,21)-tile_data(1:Nt,22) ! compute wilting fraction - - tile_data(1:Nt,23) = max(min(tmpreal, 1.),0.) ! land_fraction_wilting dimensionless - - tile_data(1:Nt,24) = max(min( cat_diagS_avg%asnow,1.),0.) ! land_fraction_snow_covered dimensionless - - tile_data(1:Nt,25) = cat_diagF_avg%shflux ! heat_flux_sensible W m-2 - tile_data(1:Nt,26) = cat_diagF_avg%lhflux ! heat_flux_latent W m-2 - tile_data(1:Nt,27) = cat_diagF_avg%ghflux ! heat_flux_ground W m-2 - - tile_data(1:Nt,28) = met_force_avg%SWdown - cat_diagF_avg%swup ! net_downward_shortwave_flux W m-2 - tile_data(1:Nt,29) = met_force_avg%LWdown - cat_diagF_avg%lwup ! net_downward_longwave_flux W m-2 - - tile_data(1:Nt,30) = met_force_avg%SWdown ! radiation_shortwave_downward_flux W m-2 - tile_data(1:Nt,31) = met_force_avg%LWdown ! radiation_longwave_absorbed_flux W m-2 - - tile_data(1:Nt,32) = met_force_avg%Rainf + met_force_avg%Snowf ! precipitation_total_surface_flux kg m-2 s-1 - tile_data(1:Nt,33) = met_force_avg%Snowf ! snowfall_surface_flux kg m-2 s-1 - - tile_data(1:Nt,34) = met_force_avg%Psurf ! surface_pressure Pa - - tile_data(1:Nt,35) = met_force_avg%RefH ! height_lowatmmodlay m - tile_data(1:Nt,36) = met_force_avg%Tair ! temp_lowatmmodlay K - tile_data(1:Nt,37) = met_force_avg%Qair ! specific_humidity_lowatmmodlay kg kg-1 - tile_data(1:Nt,38) = met_force_avg%Wind ! windspeed_lowatmmodlay m s-1 - - tile_data(1:Nt,39) = veg_param_avg%grn ! vegetation_greenness_fraction dimensionless - tile_data(1:Nt,40) = veg_param_avg%lai ! leaf_area_index m2 m-2 - - - case (7,8) ! N_out_fields_inst = 4; N_out_fields_tavg = 4, 6 - - ! Specs for SMAP Nature Run v03 - reichle, 11 Dec 2013 - ! Modified - reichle, 6 Feb 2014 - ! Bug fix: units of tp(1) - reichle, 19 Feb 2014 - ! Added tpsn(1) - reichle, 4 Mar 2014 - - ! compute snow mass - - do n=1,Nt - - SWE(n) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - - end do - - ! generate different output for "inst" and "tavg" files - - select case(interval) - - case ('i') ! instantaneous - - ! convert Catchment model variables into inputs suitable for the mwRTM - ! NOTE: input tp must be in degree Celsius! - - call catch2mwRTM_vars( Nt, cat_param%vegcls, cat_param%poros, & - mwRTM_param%poros, cat_diagS_avg%sfmc, cat_diagS_avg%tsurf, & - cat_diagS_avg%tp(1)-Tzero, sfmc_mwRTM, tsoil_mwRTM ) - - ! calculate brightness temperatures - ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] - ! but without Pellarin atmospheric corrections) - - freq = 1.41e9 - - inc_angle = 40. - - incl_atm_terms = .false. - - call mwRTM_get_Tb(Nt, freq, inc_angle, mwRTM_param, tile_coord%elev, & - veg_param_avg%lai, sfmc_mwRTM, tsoil_mwRTM, SWE, met_force_avg%Tair, & - incl_atm_terms, & - Tb_h, Tb_v ) - - ! fill tile_data - - tile_data(1:Nt,1) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt,2) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt,3) = Tb_h ! tb_h [at above freq, inc_angle] K - tile_data(1:Nt,4) = Tb_v ! tb_v [at above freq, inc_angle] K - - if (out_collection_ID==8) then - - tile_data(1:Nt,5) = cat_diagS_avg%tpsn(1) ! snow_temp_layer1 K - - end if - - case default ! time-average output (any averaging interval) - - tile_data(1:Nt,1) = cat_diagS_avg%sfmc ! sm_surface m3 m-3 - tile_data(1:Nt,2) = cat_diagS_avg%rzmc ! sm_rootzone m3 m-3 - tile_data(1:Nt,3) = cat_diagS_avg%prmc ! sm_profile m3 m-3 - tile_data(1:Nt,4) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - - if (out_collection_ID==8) then - - tile_data(1:Nt,5) = SWE ! snow_mass kg m-2 - tile_data(1:Nt,6) = met_force_avg%Rainf + met_force_avg%Snowf ! precipitation_total_surface_flux kg m-2 s-1 - - end if - - end select - - case (9) ! N_out_fields_inst = 6; N_out_fields_tavg = 2 - - ! for L-band mwRTM calibration (Dec 2013) - ! Renamed from 8 to 9 - reichle, 6 Feb 2014 - - ! generate different output for "inst" and "tavg" files - - select case(interval) - - case ('i') ! instantaneous - - tile_data(1:Nt,1) = cat_diagS_avg%sfmc ! sm_surface m3 m-3 - tile_data(1:Nt,2) = cat_diagS_avg%rzmc ! sm_rootzone m3 m-3 - tile_data(1:Nt,3) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt,4) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt,5) = met_force_avg%Tair ! temp_lowatmmodlay K - tile_data(1:Nt,6) = veg_param_avg%lai ! leaf_area_index m2 m-2 - - case default ! time-average output (any averaging interval) - - ! compute snow mass - - do n=1,Nt - - SWE(n) = sum(cat_progn_avg(n)%wesn(1:N_snow)) - - end do - - tile_data(1:Nt,1) = SWE ! snow_mass kg m-2 - tile_data(1:Nt,2) = met_force_avg%Rainf + met_force_avg%Snowf ! precipitation_total_surface_flux kg m-2 s-1 - - end select - - case (11) ! N_out_fields_inst = N_out_fields_tavg = 5 - - ! for SMOS pre-processing using Gabrielle De Lannoy's matlab routines (Dec 2014) - ! - reichle, 30 Mar 2015 - - tile_data(1:Nt,1) = cat_diagS_avg%tsurf ! surface_temp K - tile_data(1:Nt,2) = cat_diagS_avg%tp(1) ! soil_temp_layer1 K - tile_data(1:Nt,3) = met_force_avg%Psurf ! surface_pressure Pa - tile_data(1:Nt,4) = cat_diagF_avg%t2m ! temp_2m K - tile_data(1:Nt,5) = cat_diagF_avg%q2m ! specific_humidity_2m kg kg-1 - - case default - - err_msg = 'unknown out_collection_ID' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select ! case (out_collection_ID) - - ! ---------------------------------------------------------------- - ! - ! re-initialize - - do n=1,Nt - - cat_progn_avg(n) = 0. - cat_diagS_avg(n) = 0. - cat_diagF_avg(n) = 0. - met_force_avg(n) = 0. - veg_param_avg(n) = 0. - bal_diagn_avg(n) = 0. - - end do - - ! ---------------------------------------------------------------- - - else - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'bad option') - - end if ! option 'ini', 'add', or 'out' - - end subroutine output_calcs - - ! ******************************************************************** - - subroutine output_write( out_tile, out_grid, fname_tile, fname_grid, & - out_collection_ID, N_out_fields, & - N_catl, N_catf, N_land_mask, tile_coord_f, tile_grid_f, & - N_catl_vec, low_ind, land_mask_i, land_mask_j, tile_data_l ) - - ! reichle, 23 Dec 2011 - - ! revised output subroutines to accomodate LAI-weighted greenness (GRN) and - ! for general clean-up - - implicit none - - logical, intent(in) :: out_tile, out_grid - - character(300), intent(in) :: fname_tile, fname_grid - - integer, intent(in) :: out_collection_ID, N_out_fields - integer, intent(in) :: N_catl, N_catf, N_land_mask - - type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! intent(in), N_catf - - type(grid_def_type), intent(in) :: tile_grid_f - - integer, dimension(:), intent(in) :: N_catl_vec, low_ind - - integer, dimension(tile_grid_f%N_lon*tile_grid_f%N_lat), intent(in) :: & - land_mask_i, land_mask_j - - real, dimension(N_catl,N_out_fields), intent(in) :: tile_data_l - - ! local variables - - integer :: i - real, dimension(N_catf) :: tile_data_f - real, dimension(N_catf) :: tile_data_f_tmp - real, dimension(tile_grid_f%N_lon,tile_grid_f%N_lat) :: grid_data - real, dimension(tile_grid_f%N_lon,tile_grid_f%N_lat) :: grid_data_tmp - - ! --------------------------------------------------------- - - do i=1,N_out_fields ! write output one field at a time - - ! gatherv tile data from local to full domain and map to grid - - call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, & - tile_data_l(:,i), tile_data_f) - - if (master_proc) & - call tile2grid( N_catf, tile_coord_f, tile_grid_f, tile_data_f, & - grid_data, & - no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - ! special case: LAI-weighted greenness for MERRA-Land and SMAP file specs - - if ( (i==1) .and. & - ( & - out_collection_ID==4 .or. & - out_collection_ID==5 .or. & - out_collection_ID==6 & - ) ) then - - ! i=1: GRN - ! i=2: LAI - - ! gatherv LAI into tile_data_f_tmp - - call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, tile_data_l(:,2), & - tile_data_f_tmp) - - if (master_proc) then - - ! get gridded LAI - - call tile2grid( N_catf, tile_coord_f, tile_grid_f, tile_data_f_tmp, & - grid_data_tmp, & - no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - ! get LAI-weighted GRN - - tile_data_f_tmp = tile_data_f*tile_data_f_tmp ! = GRN*LAI - - call tile2grid( N_catf, tile_coord_f, tile_grid_f, tile_data_f_tmp, & - grid_data, & - no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - ! set to no-data-values when gridded LAI is zero or no-data, - ! otherwise normalize, ie., compute [GRN*LAI] / LAI - ! [edited to avoid division by zero, -reichle+csdraper, 29 Jan 2016] - - where ( & - grid_data_tmp < 1.e-10 .or. & - abs(grid_data_tmp-nodata_generic)0 .and. N_bits_shaved<=12) then - - rc = ShaveMantissa32( data_shaved, data, N_data, & - N_bits_shaved, .true., nodata_generic, N_data ) - - else - - err_msg = 'shaving more than 12 bits is not recommended' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end if - - if (rc/=0) call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'rc/=0') - - end subroutine shave_bits - - ! ******************************************************************** - - subroutine get_ensstd_filenames( out_choice, date_time_new, work_path, exp_id, & - interval, out_tile, out_grid, fname_tile, fname_grid, out_dtstep_xhourly ) - - implicit none - - type(out_choice_type), intent(in) :: out_choice - - type(date_time_type), intent(in) :: date_time_new - - character(200), intent(in) :: work_path - character(40), intent(in) :: exp_id - - ! what averaging interval is used? (need to know to construct file name) - ! - ! inst : interval = 'i' -- for inst output ONLY call with option 'out' - ! xhourly: interval = 'x' - ! daily : interval = 'd' - ! pentad : interval = 'p' - ! monthly: interval = 'm' - - character, intent(in) :: interval - - logical, intent(out) :: out_tile, out_grid - - character(300), intent(out) :: fname_tile, fname_grid - - integer, intent(in), optional :: out_dtstep_xhourly - - ! local variables - - character(40) :: dir_name, file_tag - - type(date_time_type) :: date_time_tmp - - character(len=*), parameter :: Iam = 'get_ensstd_filenames' - character(len=400) :: err_msg - - ! ------------------------------------------------------ - - out_tile = .false. - out_grid = .false. - - dir_name = 'ana' - - select case (interval) - - case ('i') ! instantaneous - - if (out_choice%inst%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_inst_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%inst%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_inst_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('x') ! xhourly - - if (.not. present(out_dtstep_xhourly)) then - err_msg = 'optional input argument missing' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! shift date/time so that mid-point of time averaging interval is - ! used for time-tagging the output file - - date_time_tmp = date_time_new - - call augment_date_time( -out_dtstep_xhourly/2, date_time_tmp ) - - if (out_choice%xhourly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_xhourly_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%xhourly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_xhourly_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_tmp, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('d') ! daily - - if (out_choice%daily%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_daily_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=4, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%daily%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_daily_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=4, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('p') ! pentad - - if (out_choice%pentad%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_pentad_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=3, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%pentad%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_pentad_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=3, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case ('m') ! monthly - - if (out_choice%monthly%tile) then - - out_tile = .true. - - file_tag = 'ldas_tile_monthly_ensstd' - - fname_tile = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=2, & - dir_name=dir_name, ens_id=-1 ) - - end if - - if (out_choice%monthly%grid) then - - out_grid = .true. - - file_tag = 'ldas_grid_monthly_ensstd' - - fname_grid = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time_new, option=2, & - dir_name=dir_name, ens_id=-1 ) - - end if - - case default - - err_msg = 'unknown averaging interval' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - - end subroutine get_ensstd_filenames - - ! ******************************************************************** - - subroutine check_output_times( out_dtstep, date_time_new, date_time_old, end_time, & - out_time ) - - ! reichle, 2 Oct 2009 - - implicit none - - type(out_dtstep_type), intent(in) :: out_dtstep - - type(date_time_type), intent(in) :: date_time_new, date_time_old, end_time - - type(out_choice_time_type), intent(out) :: out_time - - ! local variables - - integer :: secs_in_day - - logical :: new_day, new_pentad, new_month - - ! -------------------------------------------------- - - out_time%rstrt = .false. - out_time%inst = .false. - out_time%xhourly = .false. - out_time%daily = .false. - out_time%pentad = .false. - out_time%monthly = .false. - out_time%any_non_rstrt = .false. - - secs_in_day = date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec - - new_day = (secs_in_day==0) - - new_pentad = (date_time_new%pentad /= date_time_old%pentad) - - new_month = (new_day .and. date_time_new%day==1) - - ! check if rstrt output is needed - - ! write restarts - ! - at beginning of month (always) - ! - at appropriate time steps as requested - ! - at end_time of simulation (always) - - if ( new_month & - .or. & - (out_dtstep%rstrt>0 .and. mod(secs_in_day,out_dtstep%rstrt)==0) & - .or. & - datetime_eq_refdatetime(date_time_new,end_time) & - ) & - out_time%rstrt = .true. - - ! inst - - if (out_dtstep%inst/=0) then - - if (mod(secs_in_day,out_dtstep%inst) ==0) out_time%inst = .true. - - end if - - ! xhourly - - if (out_dtstep%xhourly/=0) then - - if (mod(secs_in_day,out_dtstep%xhourly)==0) out_time%xhourly = .true. - - end if - - ! daily, pentad, monthly - - if (new_day) out_time%daily = .true. - - if (date_time_new%pentad /= date_time_old%pentad) out_time%pentad = .true. - - if (new_month) out_time%monthly = .true. - - ! is there any non-rstrt output? - - if ( out_time%inst .or. & - out_time%xhourly .or. & - out_time%daily .or. & - out_time%pentad .or. & - out_time%monthly ) out_time%any_non_rstrt = .true. - - end subroutine check_output_times - - ! ******************************************************************** - - subroutine get_land_mask_ij( N_catd, tile_coord, tile_grid_d, & - N_land_mask, land_mask_i, land_mask_j ) - - implicit none - - integer, intent(in) :: N_catd - - type(tile_coord_type), dimension(:), pointer :: tile_coord ! input - - type(grid_def_type), intent(in) :: tile_grid_d - - integer, intent(inout) :: N_land_mask - - integer, dimension(tile_grid_d%N_lon*tile_grid_d%N_lat), intent(out) :: & - land_mask_i, land_mask_j - - ! ----------------------------------------------------- - - ! local variables - - integer :: i, j - - real, dimension(:), allocatable :: tile_data_tmp - - real, dimension(tile_grid_d%N_lon,tile_grid_d%N_lat) :: grid_data - - ! ------------------------------------------------------------- - - ! map a vector full of "good" tiles to grid - - allocate(tile_data_tmp(N_catd)) - - tile_data_tmp = (nodata_generic + 1000.*nodata_tol_generic) - - call tile2grid( N_catd, tile_coord, tile_grid_d, tile_data_tmp, & - grid_data, no_data_value=nodata_generic, no_data_tol=nodata_tol_generic) - - deallocate(tile_data_tmp) - - ! see which grid boxes are "good" - - N_land_mask = 0 - - do j=1,tile_grid_d%N_lat - do i=1,tile_grid_d%N_lon - - if (abs(grid_data(i,j)-nodata_generic)>nodata_tol_generic) then - - N_land_mask = N_land_mask+1 - - land_mask_i(N_land_mask) = i - land_mask_j(N_land_mask) = j - - end if - - end do - end do - - end subroutine get_land_mask_ij ! ******************************************************************** diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 3072ab05..4502a216 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -25,7 +25,7 @@ module clsm_ensupd_enkf_update catch_calc_soil_moist, & catch_calc_tp - use LDAS_ensdrv_globals, ONLY: & + use LDAS_ensdrv_globals, ONLY: & logit, & logunit, & nodata_generic, & @@ -39,7 +39,7 @@ module clsm_ensupd_enkf_update obs_param_type, & obs_type - use LDAS_DriverTypes, ONLY: & + use LDAS_DriverTypes, ONLY: & met_force_type use catch_types, ONLY: & @@ -55,10 +55,10 @@ module clsm_ensupd_enkf_update use mwRTM_types, ONLY: & mwRTM_param_type - use LDAS_PertTypes, ONLY: & + use LDAS_PertTypes, ONLY: & pert_param_type - use LDAS_TilecoordType, ONLY: & + use LDAS_TilecoordType, ONLY: & tile_coord_type, & grid_def_type @@ -74,7 +74,7 @@ module clsm_ensupd_enkf_update use nr_ran2_gasdev, ONLY: & NRANDSEED - use LDAS_ease_conv, ONLY: & + use LDAS_ease_conv, ONLY: & easeV1_convert, & easeV2_convert @@ -103,9 +103,6 @@ module clsm_ensupd_enkf_update use clsm_ensupd_read_obs, ONLY: & collect_obs - use LDAS_ensdrv_init_routines, ONLY: & - io_rstrt - use clsm_bias_routines, ONLY: & obs_bias_upd_tcount, & obs_bias_corr_obs, & @@ -121,7 +118,7 @@ module clsm_ensupd_enkf_update numprocs, & myid, & mpierr, & - mpicomm, & + mpicomm, & MPI_obs_type, & mpistatus @@ -148,12 +145,12 @@ subroutine get_enkf_increments( & work_path, exp_id, exp_domain, & met_force, lai, cat_param, mwRTM_param, & tile_coord_l, tile_coord_f, tile_grid_f, & - pert_grid_f, pert_grid_l_NotUsed, tile_grid_g, & + pert_grid_f, pert_grid_l_NotUsed, tile_grid_g, & N_catl_vec, low_ind, l2f, f2l, & N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & update_type, & dtstep_assim, centered_update, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & N_obs_param, obs_param, N_obsbias_max, & out_obslog, out_smapL4SMaup, & cat_progn, & @@ -214,7 +211,7 @@ subroutine get_enkf_increments( & logical, intent(in) :: centered_update - real, intent(in) :: xcompact, ycompact + real, intent(in) :: xcompact, ycompact, fcsterr_inflation_fac integer, intent(in) :: N_obs_param @@ -527,7 +524,8 @@ subroutine get_enkf_increments( & N_catl_vec, low_ind, tile_grid_g, & obs_param, & met_force, lai, cat_param, cat_progn, mwRTM_param, & - N_obsl, Observations_l, Obs_pred_l, obsbias_ok ) + N_obsl, Observations_l, Obs_pred_l, obsbias_ok, & + fcsterr_inflation_fac ) deallocate(obsbias_ok) @@ -1037,7 +1035,7 @@ subroutine get_enkf_increments( & Obs_pred_ana, & ! size: (nObs_ana,N_ens) Obs_pert_tmp, & cat_param_ana, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & cat_progn_ana, cat_progn_incr_ana) call cpu_time(t_end) @@ -1065,7 +1063,7 @@ subroutine get_enkf_increments( & Obs_pred_lH(1:N_obslH,1:N_ens), & Obs_pert_tmp, & cat_param, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & cat_progn, cat_progn_incr ) #endif @@ -1557,11 +1555,8 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & endif ! write to file - fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & - dir_name=dir_name, ens_id=-1 ) - i = index(fname, '/', .true.) - - if( i >0) call Execute_command_line('/bin/mkdir -p '//fname(1:i)) + fname = get_io_filename( './', exp_id, file_tag, date_time=date_time, & + dir_name=dir_name, ens_id=-1, no_subdirs=.true. ) open( 10, file=fname, form='unformatted', action='write') @@ -1617,7 +1612,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & N_catl_vec, low_ind, f2l, N_catg, f2g, & obs_param, & met_force, lai, cat_param, cat_progn, cat_progn_incr, mwRTM_param, & - Observations_l,rf2f ) + Observations_l, rf2f ) implicit none @@ -1665,6 +1660,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & type(obs_type), dimension(:), pointer :: Observations_l ! inout + integer, dimension(N_catf), optional, intent(in) :: rf2f ! re-ordered to LDASsa ! local variables @@ -2102,8 +2098,8 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & if (master_proc) then - fname = get_io_filename( work_path, exp_id, file_tag, & - date_time=date_time, dir_name=dir_name, ens_id=-1) + fname = get_io_filename( './', exp_id, file_tag, & + date_time=date_time, dir_name=dir_name, ens_id=-1, no_subdirs=.true.) if (option=='orig_obs') then diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 index 7b933fa5..36d07f06 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 @@ -14,7 +14,7 @@ module clsm_ensupd_upd_routines MAPL_RADIUS, & MAPL_PI - use LDAS_ensdrv_Globals, ONLY: & + use LDAS_ensdrv_Globals, ONLY: & logit, & logunit, & nodata_generic, & @@ -44,7 +44,7 @@ module clsm_ensupd_upd_routines use LDAS_ensdrv_init_routines, ONLY: & clsm_ensdrv_get_command_line - use LDAS_DateTimeMod, ONLY: & + use LDAS_DateTimeMod, ONLY: & date_time_type use catch_types, ONLY: & @@ -63,22 +63,22 @@ module clsm_ensupd_upd_routines write_obs_param, & N_obs_ang_max - use LDAS_DriverTypes, ONLY: & + use LDAS_DriverTypes, ONLY: & met_force_type use mwRTM_types, ONLY: & mwRTM_param_type - use LDAS_PertTypes, ONLY: & + use LDAS_PertTypes, ONLY: & pert_param_type, & allocate_pert_param, & deallocate_pert_param - use LDAS_TileCoordType, ONLY: & + use LDAS_TileCoordType, ONLY: & tile_coord_type, & grid_def_type - use LDAS_TilecoordRoutines, ONLY: & + use LDAS_TilecoordRoutines, ONLY: & get_tile_num_in_ellipse, & get_number_of_tiles_in_cell_ij, & get_tile_num_in_cell_ij, & @@ -96,7 +96,7 @@ module clsm_ensupd_upd_routines catch_calc_tsurf, & catch_calc_tsurf_excl_snow - use lsm_routines, ONLY: & + use lsm_routines, ONLY: & catch_calc_soil_moist, & catch_calc_tp, & catch_calc_ght, & @@ -117,7 +117,7 @@ module clsm_ensupd_upd_routines mpistatus, & mpierr - use LDAS_ExceptionsMod, ONLY: & + use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -170,12 +170,11 @@ subroutine read_ens_upd_inputs( & dtstep_assim, & centered_update, & xcompact, ycompact, & + fcsterr_inflation_fac, & N_obs_param, & obs_param, & out_obslog, & out_ObsFcstAna, & -! out_incr, & -! out_incr_format, & out_smapL4SMaup, & N_obsbias_max & ) @@ -201,8 +200,8 @@ subroutine read_ens_upd_inputs( & implicit none - character(*), intent(in) :: work_path - character(*), intent(in) :: exp_id + character(*), intent(in) :: work_path + character(*), intent(in) :: exp_id type(date_time_type), intent(in) :: date_time @@ -222,6 +221,7 @@ subroutine read_ens_upd_inputs( & logical, intent(out) :: centered_update real, intent(out) :: xcompact, ycompact + real, intent(out) :: fcsterr_inflation_fac integer, intent(out) :: N_obs_param @@ -229,11 +229,8 @@ subroutine read_ens_upd_inputs( & logical, intent(out) :: out_obslog logical, intent(out) :: out_ObsFcstAna -! logical, intent(out) :: out_incr logical, intent(out) :: out_smapL4SMaup -! integer, intent(out) :: out_incr_format - integer, intent(out) :: N_obsbias_max ! ------------------------ @@ -277,10 +274,9 @@ subroutine read_ens_upd_inputs( & centered_update, & out_obslog, & out_ObsFcstAna, & -! out_incr, & -! out_incr_format, & out_smapL4SMaup, & xcompact, ycompact, & + fcsterr_inflation_fac, & obs_param_nml ! ------------------------------------------------------------------ @@ -1013,7 +1009,8 @@ subroutine get_obs_pred( & N_catl_vec, low_ind, tile_grid_g, & obs_param, & met_force, lai, cat_param, cat_progn, mwRTM_param, & - N_obsl, Observations_l, Obs_pred_l, obsbias_ok ) + N_obsl, Observations_l, Obs_pred_l, obsbias_ok, & + fcsterr_inflation_fac ) ! Compute ensemble of measurement predictions from ensemble ! of tile-space Catchment prognostics. @@ -1066,6 +1063,8 @@ subroutine get_obs_pred( & real, dimension(:,:), pointer :: Obs_pred_l ! output logical, intent(in), dimension(N_obsl), optional :: obsbias_ok + + real, intent(in), optional :: fcsterr_inflation_fac ! -------------------------------------------------------------------------------- ! @@ -1164,13 +1163,15 @@ subroutine get_obs_pred( & logical, dimension(N_obsl) :: obsbias_ok_tmp + real :: inflation_factor + character(len=*), parameter :: Iam = 'get_obs_pred' character(len=400) :: err_msg character(len= 10) :: tmpstring10 ! -------------------------------------------------------------- ! - ! deal with optional argument + ! deal with optional arguments if (present(obsbias_ok)) then @@ -1181,7 +1182,18 @@ subroutine get_obs_pred( & obsbias_ok_tmp = .false. end if - + + if (present(fcsterr_inflation_fac) .and. beforeEnKFupdate) then + + ! ONLY inflate *before* EnKF update!!! + + inflation_factor = fcsterr_inflation_fac + + else + + inflation_factor = -9999. + + end if ! -------------------------------------------------------------- ! @@ -1978,6 +1990,10 @@ subroutine get_obs_pred( & call row_variance( 1, N_ens, Obs_pred_l(j,1:N_ens), tmpvar, tmpmean ) + ! inflate fcstvar + + if (inflation_factor > 0.) tmpvar(1) = tmpvar(1) * inflation_factor**2 + else tmpmean(1) = Obs_pred_l(j,1) @@ -2017,6 +2033,9 @@ subroutine get_obs_pred( & call row_variance( 1, N_ens, Obs_pred_l(i,1:N_ens), tmpvar, tmpmean ) + ! no need to inflate analysis Obs_pred because state increments already included + ! impact of inflation + end if else @@ -3457,7 +3476,7 @@ subroutine cat_enkf_increments( & tile_grid_f, tile_coord, l2f, & Observations, Obs_pred, Obs_pert, & cat_param, & - xcompact, ycompact, & + xcompact, ycompact, fcsterr_inflation_fac, & cat_progn, cat_progn_incr ) ! get increments for Catchment prognostic variables @@ -3506,7 +3525,7 @@ subroutine cat_enkf_increments( & type(cat_param_type), dimension(N_catd), intent(in) :: cat_param - real, intent(in) :: xcompact, ycompact + real, intent(in) :: xcompact, ycompact, fcsterr_inflation_fac type(cat_progn_type), intent(in), dimension(N_catd,N_ens) :: cat_progn @@ -3748,14 +3767,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -3836,7 +3856,8 @@ subroutine cat_enkf_increments( & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov, & - State_incr, State_lon, State_lat, xcompact, ycompact ) + State_incr, State_lon, State_lat, xcompact, ycompact, & + fcsterr_inflation_fac ) deallocate(Obs_cov) @@ -3901,14 +3922,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -3973,14 +3995,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -4047,14 +4070,15 @@ subroutine cat_enkf_increments( & ! EnKF update - call enkf_increments( & + call enkf_increments( & N_state, N_selected_obs, N_ens, & Observations(ind_obs(1:N_selected_obs)), & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov( & ind_obs(1:N_selected_obs), ind_obs(1:N_selected_obs)), & - State_incr ) + State_incr, & + fcsterr_inflation_fac=fcsterr_inflation_fac ) ! assemble cat_progn increments @@ -4146,7 +4170,8 @@ subroutine cat_enkf_increments( & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov, & - State_incr, State_lon, State_lat, xcompact, ycompact ) + State_incr, State_lon, State_lat, xcompact, ycompact, & + fcsterr_inflation_fac ) deallocate(Obs_cov) @@ -4271,7 +4296,8 @@ subroutine cat_enkf_increments( & Obs_pred(ind_obs(1:N_selected_obs),:), & Obs_pert(ind_obs(1:N_selected_obs),:), & Obs_cov, & - State_incr, State_lon, State_lat, xcompact, ycompact ) + State_incr, State_lon, State_lat, xcompact, ycompact, & + fcsterr_inflation_fac ) deallocate(Obs_cov) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 index af525872..c678a378 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/enkf_general.F90 @@ -2,12 +2,13 @@ ! this file contains a collection of general Ensemble Kalman filter ! subroutines and compact support subroutines ! -! reichle, 20 Apr 2001 -! reichle, 18 Mar 2004 - optional arguments -! reichle, 27 Jan 2005 - eliminated use of module select_kinds -! reichle, 19 Jul 2005 - merged compact_support.f90 and enkf_general.f90 -! reichle, 1 Aug 2005 - eliminated tile_coord -! reichle, 18 Oct 2005 - return increments instead of updated State +! reichle, 20 Apr 2001 +! reichle, 18 Mar 2004 - optional arguments +! reichle, 27 Jan 2005 - eliminated use of module select_kinds +! reichle, 19 Jul 2005 - merged compact_support.f90 and enkf_general.f90 +! reichle, 1 Aug 2005 - eliminated tile_coord +! reichle, 18 Oct 2005 - return increments instead of updated State +! reichle+qliu, 29 Apr 2020 - added forecast error covariance inflation ! use intel mkl lapack when available #ifdef MKL_AVAILABLE @@ -23,7 +24,7 @@ module enkf_general use enkf_types, ONLY: & obs_type - use LDAS_ExceptionsMod, ONLY: & + use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -41,7 +42,7 @@ subroutine enkf_increments( & N_state, N_obs, N_ens, & Observations, Obs_pred, Obs_err, Obs_cov, & State_incr, & - State_lon, State_lat, xcompact, ycompact ) + State_lon, State_lat, xcompact, ycompact, fcsterr_inflation_fac ) ! perform EnKF update ! @@ -51,6 +52,11 @@ subroutine enkf_increments( & ! ! if optional inputs State_lon, State_lat, xcompact, and ycompact ! are present, Hadamard product is applied to HPHt and PHt + ! + ! if optional input fcsterr_inflation_fac is present, this subroutine inflates + ! the forecast error covariance and returns increments that must be applied to + ! the state vector *before* inflation + ! (i.e., do not inflate the state vector outside of this subroutine) implicit none @@ -68,8 +74,9 @@ subroutine enkf_increments( & real, dimension(N_state), intent(in), optional :: State_lon, State_lat - real, intent(in), optional :: xcompact ! [deg] longitude - real, intent(in), optional :: ycompact ! [deg] latitude + real, intent(in), optional :: xcompact ! [deg] longitude + real, intent(in), optional :: ycompact ! [deg] latitude + real, intent(in), optional :: fcsterr_inflation_fac ! forecast error covariance inflation ! ----------------------------- @@ -80,6 +87,8 @@ subroutine enkf_increments( & integer :: n_e, i, ii, jj, kk, lapack_info real :: PHt_ij, dx, dy + + real :: inflation_factor real, dimension(N_state,N_ens) :: State_prime real, dimension(N_state) :: State_bar @@ -99,6 +108,18 @@ subroutine enkf_increments( & ! ------------------------------------------------------------------ + ! deal with optional argument + + if (present(fcsterr_inflation_fac)) then + + inflation_factor = fcsterr_inflation_fac + + else + + inflation_factor = -9999. + + end if + ! find out whether Hadamard product should be applied apply_hadamard = ( & @@ -122,7 +143,9 @@ subroutine enkf_increments( & State_prime(:,n_e) = State_incr(:,n_e) - State_bar end do - + + if (inflation_factor > 0.) State_prime = inflation_factor * State_prime + ! -------------------- ! compute ensemble mean H*Ybar @@ -137,6 +160,8 @@ subroutine enkf_increments( & end do + if (inflation_factor > 0.) Obs_pred_prime = inflation_factor * Obs_pred_prime + ! -------------------- ! form repr matrix HPHt = Q_prime*(Q_prime)t/(N_e-1) @@ -181,9 +206,14 @@ subroutine enkf_increments( & ! compute right hand side rhs = Zpert - H*y^f for system equation, do i=1,N_obs - + rhs(i) = Observations(i)%obs + Obs_err(i,n_e) - Obs_pred(i,n_e) + ! in case of inflation, correct for the fact that "Obs_pred" was not inflated above + ! because it is intent(in) + + if (inflation_factor > 0.) rhs(i) = rhs(i) - (1.-inflation_factor)*Obs_pred_prime(i,n_e) + end do ! solve W*b = Zpert - H*y^f @@ -253,8 +283,15 @@ subroutine enkf_increments( & ! finish computation of increment for ensemble member n_e ! (normalization is NOT ensemble average, see Eq above) - + State_incr(:,n_e) = State_incr(:,n_e)/real(N_ens-1) + + ! correct for the fact that the increment will be applied to + ! the un-inflated state vector outside of this subroutine + ! (note also that State_prime here has been inflated!) + + if (inflation_factor > 0.) & + State_incr(:,n_e) = State_incr(:,n_e) + (1.-1./inflation_factor)*State_prime(:,n_e) end do diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index 2f49a98e..968fb84e 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -11,10 +11,10 @@ module LDAS_ForceMod use MAPL_Mod use MAPL_ShmemMod - use LDAS_ensdrv_Globals, ONLY: & + use LDAS_ensdrv_Globals, ONLY: & logunit, & - logit, & - master_logit, & + logit, & + master_logit, & nodata_generic, & nodata_tol_generic, & nodata_tolfrac_generic @@ -2527,8 +2527,6 @@ subroutine get_GEOS(date_time, force_dtstep, & real :: xcur, ycur, xnew, ynew, fnbr(2,2) - ! real, dimension(:,:), allocatable :: tmp_grid - integer, pointer :: i1(:), i2(:), j1(:), j2(:) real, pointer :: x1(:), x2(:), y1(:), y2(:) @@ -2545,10 +2543,8 @@ subroutine get_GEOS(date_time, force_dtstep, & character(len=*), parameter :: Iam = 'get_GEOS' integer :: status character(len=400) :: err_msg - !external :: GEOS_closefile character(len=300) :: fname_full - logical :: file_exists,notime - ! type(nodelist),pointer :: ptrNode + logical :: file_exists, single_time_in_file ! ----------------------------------------------------------------------- ! @@ -2984,18 +2980,14 @@ subroutine get_GEOS(date_time, force_dtstep, & YYYYMMDD = date_time_tmp%year*10000+date_time_tmp%month*100+date_time_tmp%day HHMMSS = date_time_tmp%hour*10000+date_time_tmp%min*100 +date_time_tmp%sec - ! use gfio to open standard MERRA or G5DAS files, - ! use netcdf to open corrected precip files - + ! determine forcing file name (with path) if ( (use_prec_corr) .and. (GEOSgcm_defs(GEOSgcm_var,1)(1:4)=='PREC') ) then - if (j==1) GEOSgcm_defs(GEOSgcm_var,3) = trim(GEOSgcm_defs(GEOSgcm_var,3)) // '_corr' - - call get_GEOS_prec_filename(fname_full,file_exists,date_time_tmp, & + call get_GEOS_corr_prec_filename(fname_full,file_exists,date_time_tmp, & prec_path_tmp, met_tag_tmp, GEOSgcm_defs(GEOSgcm_var,:), precip_corr_file_ext ) - notime = file_exists + single_time_in_file = .true. ! corr precip files are always hourly (incl. MERRA-2) else @@ -3003,35 +2995,38 @@ subroutine get_GEOS(date_time, force_dtstep, & daily_met_files, met_path_tmp, met_tag_tmp, & GEOSgcm_defs(GEOSgcm_var,:), met_file_ext) - notime = .not. file_exists + single_time_in_file = .not. daily_met_files ! MERRA-2 files are daily files end if if ( file_exists) then - exit ! exit j loop after successfully opening file + exit ! exit j loop after successfully finding file elseif ( & (j==1) .and. & (tmp_init) .and. & - (trim(GEOSgcm_defs(GEOSgcm_var,2))=='tavg') ) then + (trim(GEOSgcm_defs(GEOSgcm_var,2))=='tavg') .and. & + (master_logit) ) then - if ((.not. MERRA_file_specs) ) write (logunit,'(400A)') & + if (.not. MERRA_file_specs) write (logunit,'(400A)') & 'NOTE: Initialization. Data from tavg file are not used ' // & 'with lfo inst/tavg forcing, but dummy values must be ' // & 'read from some file for backward compatibility with ' // & 'MERRA forcing.' - if(master_logit) write (logunit,*) 'try again with different file...' + write (logunit,*) 'try again with different file...' else - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'error opening file') + call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'error finding met forcing file') end if end do ! j=1,2 + ! open file, extract coord info, prep horizontal interpolation info (if not done already) + call GEOS_openfile(FileOpenedHash,fname_full,fid,tile_coord,met_hinterp) !fid = ptrNode%fid @@ -3047,7 +3042,7 @@ subroutine get_GEOS(date_time, force_dtstep, & ! ---------------------------------------------- ! - ! for first variable, read and process grid dimensions + ! for first variable, process grid dimensions if (GEOSgcm_var==1) then @@ -3056,8 +3051,6 @@ subroutine get_GEOS(date_time, force_dtstep, & call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - ! allocate tmp_grid - ! allocate(tmp_grid( local_info%N_lon,local_info%N_lat)) ! init share memory if( size(ptrShForce,1) /= local_info%N_lon .or. & size(ptrShForce,2) /= local_info%N_lat ) then @@ -3077,10 +3070,9 @@ subroutine get_GEOS(date_time, force_dtstep, & ! ---------------------------------------------- ! ! read global gridded field of given variable - - call LDAS_GetVar( fid, trim(GEOSgcm_defs(GEOSgcm_var,1)), & - YYYYMMDD, HHMMSS, ptrShForce, notime,local_info, rc) + call LDAS_GetVar( fid, trim(GEOSgcm_defs(GEOSgcm_var,1)), & + YYYYMMDD, HHMMSS, ptrShForce, single_time_in_file, local_info, rc) if (rc<0) then call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'error reading gfio file') endif @@ -3225,10 +3217,8 @@ subroutine get_GEOS(date_time, force_dtstep, & call FileOpenedHash%free( GEOS_closefile,.false. ) - !if(allocated(tmp_grid)) deallocate(tmp_grid) deallocate(GEOSgcm_defs) - !call MAPL_SyncSharedMemory(rc=status) - !call MAPL_DeallocNodeArray(ptrShForce,rc=status) + ! -------------------------------------------------------------------- ! convert variables and units of force_array to match met_force_type, @@ -3416,47 +3406,33 @@ end subroutine get_GEOS ! ****************************************************************** subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & - ptrShForce,notime,local_info, rc) + ptrShForce,single_time_in_file,local_info, rc) use netcdf implicit none include 'mpif.h' - integer,intent(in) :: fid ! File handle - character(len=*), intent(in) :: vname ! Variable name - integer, intent(in) :: yyyymmdd ! Year-month-day, e.g., 19971003 - integer,intent(in) :: hhmmss ! Hour-minute-second, e.g., 120000 - logical,intent(in) :: notime ! if true, no time index is necessary, from PREC files + integer,intent(in) :: fid ! File handle + character(len=*), intent(in) :: vname ! Variable name + integer, intent(in) :: yyyymmdd ! Year-month-day, e.g., 19971003 + integer,intent(in) :: hhmmss ! Hour-minute-second, e.g., 120000 + logical,intent(in) :: single_time_in_file ! if true, no time index is necessary type(local_grid),intent(in) :: local_info !OUTPUT PARAMETERS: - real,pointer,intent(inout) :: ptrShForce(:,:) ! Gridded data read for this time + real,pointer,intent(inout) :: ptrShForce(:,:) ! Gridded data read for this time integer,intent(out) :: rc ! local - ! real,allocatable :: tmp_grid(:,:) - integer begDate, begTime, seconds, minutes, incSecs - integer iistart(3), iicount(3), timeIndex - integer istart(4), icount(4) ! cs grid - real, pointer :: tmpShared(:,:,:,:) ! cs grid - type(c_ptr) :: c_address - integer nv_id,imin, jmin, imax, jmax,ierr - integer DiffDate - - integer :: status - !real,allocatable :: grid(:,:) - ! mpi support - !type(ESMF_VM) :: vm - !integer :: comm - !integer status(MPI_STATUS_SIZE) - !integer :: rank,myid, io_rank, total_prcs - !integer :: length - character(*),parameter :: Iam="LDAS_getvar" - logical :: isCubed - ! call ESMF_VmGetCurrent(vm, rc=ierr) - ! VERIFY_(ierr) - ! call ESMF_VmGet(vm, mpicommunicator=comm, rc=ierr) - ! VERIFY_(ierr) - ! call MPI_COMM_SIZE(comm,total_prcs,ierr) - ! call MPI_COMM_RANK(comm,myid,ierr) + integer :: begDate, begTime, seconds, minutes, incSecs + integer :: iistart(3), iicount(3), timeIndex + integer :: istart(4), icount(4) ! cs grid + real, pointer :: tmpShared(:,:,:,:) ! cs grid + type(c_ptr) :: c_address + integer :: nv_id,imin, jmin, imax, jmax,ierr + integer :: DiffDate + integer :: status + character(*), parameter :: Iam="LDAS_getvar" + logical :: isCubed + rc = 0 isCubed = .false. if(local_info%N_lat == 6*local_info%N_lon) then @@ -3473,7 +3449,7 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & iicount(3) = 1 endif - if (.not. notime ) then + if (.not. single_time_in_file ) then ! determine start index call GetBegDateTime ( fid, begDate, begTime, incSecs, rc ) if (rc .NE. 0) then print* ,"LDAS_GetVar: could not determine begin_date/begin_time" @@ -3495,7 +3471,7 @@ subroutine LDAS_GetVar(fid, vname, yyyymmdd, hhmmss, & return endif - ! Determine the time index from the offset and time increment. + ! Determine the time index from the offset and time increment. if ( MOD (seconds, incSecs) .ne. 0 ) then print *, 'GFIO_getvar: Absolute time of ',seconds,' not ', & 'possible with an interval of ',incSecs @@ -4453,29 +4429,29 @@ subroutine get_GEOS_forcing_filename(fname_full,file_exists, date_time, daily_fi ! reichle, 27 Jul 2015 - added "daily_file" option ! (because MERRA-2 provides aggregated daily files that contain 24 hourly fields) + ! reichle, 7 May 2020 - added "seamless" GEOS FP file names (so far, only "asm" assimilation files) + implicit none - character(*),intent(inout) :: fname_full - logical,intent(out) :: file_exists - type(date_time_type), intent(in) :: date_time - logical, intent(in) :: daily_file - character(*), intent(in) :: met_path - character(*), intent(in) :: met_tag - character( 40), dimension(5), intent(in) :: GEOSgcm_defs - character(*), intent(in) :: file_ext + character(*), intent(inout) :: fname_full + logical, intent(out) :: file_exists + type(date_time_type), intent(in) :: date_time + logical, intent(in) :: daily_file + character(*), intent(in) :: met_path + character(*), intent(in) :: met_tag + character( 40), dimension(5), intent(in) :: GEOSgcm_defs + character(*), intent(in) :: file_ext ! local variables - character(300) :: fname, fname_full_tmp + character(300) :: fname, fname_full_tmp1, fname_full_tmp2 character( 14) :: time_stamp - character( 4) :: YYYY, HHMM + character( 4) :: YYYY, HHMM, day_dir character( 2) :: MM, DD - integer :: i, rc - + integer :: tmpind, tmpindend character(len=*), parameter :: Iam = 'get_GEOS_forcing_filename' - character :: err_msg ! assemble date/time strings @@ -4499,55 +4475,115 @@ subroutine get_GEOS_forcing_filename(fname_full,file_exists, date_time, daily_fi else - time_stamp = YYYY // MM // DD // '_' // trim(HHMM) // 'z' + time_stamp = YYYY // MM // DD // '_' // trim(HHMM) // 'z' end if - fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '.' // & - trim(time_stamp) // '.' // file_ext - + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + ! GEOS FP with generic file names, e.g., + ! + ! GEOS.fp.asm.inst1_2d_lfo_Nx.20200507_0000.V01.nc4 + ! + ! for now, always use product counter V01 + ! (as of 7 May 2020, no V02 or higher was issued for GEOS FP "lfo" products + ! going back to Jun 2013) + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '.' // & + trim(time_stamp(1:13)) // '.V01.' // trim(file_ext) + + ! archived files are stored in daily directories + + day_dir = 'D' // DD // '/' + + else + + ! GEOS FP with experiment-specific file names and MERRA-2, e.g., + ! + ! f525_p5_fp.inst1_2d_lfo_Nx.20200507_0000z.nc4 + ! MERRA2_400.inst1_2d_lfo_Nx.20200507.nc4 + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '.' // & + trim(time_stamp) // '.' // trim(file_ext) + + ! archived files are stored in monthly directories + ! (per LDAS legacy convention for GEOS FP with experiment-specific file names) + + day_dir = repeat(' ', len(day_dir)) + + end if ! ---------------------------------------------- - ! - ! Try getting the files directly inside directory "met_path/" first (because in - ! coupled DAS mode met_path=workdir, and the files are simply sitting there). - ! If this fails, try reading the files in "met_path/met_tag/*/Yyyyy/Mmm/" - ! as in the archived directory structure. - file_exists = .false. + ! + ! find suitable file in a couple of places - do i=1,2 - - if (i==1) then - - fname_full = trim(met_path) // '/' // trim(fname) + file_exists = .false. ! initialize + - fname_full_tmp = fname_full ! remember for error log below + ! first try: year/month[/day] directory - elseif (i==2) then + fname_full = trim(met_path) // '/' // trim(met_tag) // '/' // & + trim(GEOSgcm_defs(4)) // '/Y' // YYYY // '/M' // MM // '/' // & + trim(day_dir) // trim(fname) + + inquire(file=fname_full, exist=file_exists) + + if (file_exists) return ! done + + fname_full_tmp1 = trim(fname_full) ! remember for error log below - fname_full = trim(met_path) // '/' // trim(met_tag) // '/' // & - trim(GEOSgcm_defs(4)) // '/Y' // YYYY // '/M' // MM // '/' // trim(fname) - end if + + ! second try: ./met_path (coupled land-atm DAS) + + fname_full = trim(met_path) // '/' // trim(fname) + + inquire(file=fname_full, exist=file_exists) + + if (file_exists) return ! done + + fname_full_tmp2 = trim(fname_full) ! remember for error log below + + + ! last try: for GEOS FP with generic file names, try product counter '.V02.' in year/month/day dir + + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + fname_full = fname_full_tmp1 ! from first try + + ! GEOS.fp.asm.inst1_2d_lfo_Nx.20200507_0000.V01.nc4 + ! 1234567 + tmpindend = len_trim(fname_full) + tmpind = len_trim(file_ext) + + tmpind = tmpindend - tmpind - 3 + + fname_full( tmpind:tmpind+2 ) = 'V02' ! --> *.V02.nc4 + inquire(file=fname_full, exist=file_exists) - if (file_exists) return - - end do + end if + + ! if no file was found, report file names that were tried + if (.not. file_exists) then if(master_logit) then - print*, 'get_GEOS_forcing_filename: Unsuccessfully tried to get files:' - print*, "both files don't exist" - print*, fname_full - print*, fname_full_tmp + print '(400A)', trim(Iam) // ': Could not find any of the following files:' + print '(400A)', trim(fname_full_tmp1) + print '(400A)', trim(fname_full_tmp2) + print '(400A)', trim(fname_full) endif endif + end subroutine get_GEOS_forcing_filename -!********************************************************** + !********************************************************** subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, rc) + + ! open file, extract coord info, prep horizontal interpolation info (if not done already) + use netcdf implicit none include 'mpif.h' @@ -4584,17 +4620,15 @@ subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, call FileOpenedHash%get(fname_full,fid) if( fid == -9999 ) then ! not open yet - !ierr=nf90_open(fname_full,IOR(NF90_NOWRITE, NF90_MPIIO), fid, & - ! comm = comm,info = MPI_INFO_NULL) ierr=nf90_open(fname_full,NF90_NOWRITE, fid) if(master_logit) then - write(logunit,*) "opening file: "//trim(fname_full) + write(logunit,'(400A)') "opening file: "//trim(fname_full) endif ASSERT_( ierr == nf90_noerr) call FileOpenedHash%put(fname_full,fid) endif - ! check if it is cs grid + ! check if it is cs grid ierr = nf90_inq_dimid(fid,"nf",nfid) if (ierr == nf90_noerr) then ! it is cs grid if face dimension is found @@ -4757,28 +4791,33 @@ subroutine GEOS_closefile(fid) endif endsubroutine -! **************************************************************** + + ! **************************************************************** - subroutine get_GEOS_prec_filename(fname_full,file_exists, date_time, met_path, met_tag, & + subroutine get_GEOS_corr_prec_filename(fname_full,file_exists, date_time, met_path, met_tag, & GEOSgcm_defs, file_ext ) implicit none - character(*),intent(inout) :: fname_full - logical,intent(out) :: file_exists - type(date_time_type), intent(in) :: date_time - character(*), intent(in) :: met_path - character(*), intent(in) :: met_tag - character( 40), dimension(5), intent(in) :: GEOSgcm_defs - character(*), intent(in) :: file_ext + character(*), intent(inout) :: fname_full + logical,intent(out) :: file_exists + type(date_time_type), intent(in) :: date_time + character(*), intent(in) :: met_path + character(*), intent(in) :: met_tag + character( 40), dimension(5), intent(in) :: GEOSgcm_defs + character(*), intent(in) :: file_ext ! local variables + character(100) :: fname character(200) :: fdir - character(300) :: fname_full_tmp + character(300) :: fname_full_tmp1, fname_full_tmp2 character( 4) :: YYYY, HHMM character( 2) :: MM, DD - character(len=*), parameter :: Iam = 'get_GEOS_prec_filename' - ! + + integer :: tmpind, tmpindend + + character(len=*), parameter :: Iam = 'get_GEOS_corr_prec_filename' + ! assemble date/time strings write (YYYY,'(i4.4)') date_time%year @@ -4788,43 +4827,93 @@ subroutine get_GEOS_prec_filename(fname_full,file_exists, date_time, met_path, m ! assemble file name - fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // & - '.' // YYYY // MM // DD // '_' // trim(HHMM) // 'z.' // & - trim(file_ext) + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + ! for now, always use product counter V01 + ! (as of 7 May 2020, no V02 or higher was issued for GEOS FP "lfo" products + ! going back to Jun 2013) + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '_corr.' // & + YYYY // MM // DD // '_' // trim(HHMM) // '.V01.' // trim(file_ext) + + else + + fname = trim(met_tag) // '.' // trim(GEOSgcm_defs(3)) // '_corr.' // & + YYYY // MM // DD // '_' // trim(HHMM) // 'z.' // trim(file_ext) + + end if - ! assemble dir name without "/Mmm" (month) dir + ! assemble dir name with "/Yyy" (year) dir but without "/Mmm" (month) dir - fdir = trim(met_path) // '/' // trim(met_tag) // '/' // & + fdir = trim(met_path) // '/' // trim(met_tag) // '/' // & trim(GEOSgcm_defs(4)) // '/' // 'Y' // YYYY // '/' ! ----------------------------------------------------------------------- - ! try opening file with "/Mmm" (month) dir - ! (standard for corrected G5DAS precip) + file_exists = .false. ! initialize + + ! first try: look for file in year/month dir + ! (LDAS standard for corrected G5DAS precip) + fname_full = trim(fdir) // 'M' // MM // '/' // trim(fname) - - file_exists = .false. - + inquire(file=fname_full, exist=file_exists) + + if (file_exists) return ! done + + fname_full_tmp1 = trim(fname_full) ! remember for error log below + + + ! second try: *without* "/Mmm" (month) dir + + ! THIS TRY IS PROBABLY OBSOLETE BUT COULD EASILY BE TWEAKED TO LOOK + ! IN year/month/day DIRECTORY (WHICH POSSIBLY APPLIES TO CORRECTED + ! PRECIP FROM GMAO OPS THAT IS INPUT INTO MERRA-2) + ! - reichle 10 May 2020 - if(file_exists) return - - fname_full_tmp = fname_full ! remember for error log below fname_full = trim(fdir) // trim(fname) inquire(file=fname_full, exist=file_exists) + if (file_exists) return ! done + + fname_full_tmp2 = trim(fname_full) ! remember for error log below + + + ! last try: for GEOS FP with generic file names, try product counter '.V02.' in year/month dir + + if (trim(met_tag(1:11))=='GEOS.fp.asm') then + + fname_full = fname_full_tmp1 ! from first try + + ! GEOS.fp.asm.inst1_2d_lfo_Nx.20200507_0000.V01.nc4 + ! 1234567 + + tmpindend = len_trim(fname_full) + tmpind = len_trim(file_ext) + + tmpind = tmpindend - tmpind - 3 + + fname_full( tmpind:tmpind+2 ) = 'V02' ! --> *.V02.nc4 + + inquire(file=fname_full, exist=file_exists) + + end if + + + ! if no file was found, report file names that were tried + if( .not. file_exists ) then if(master_logit) then - print*, 'get_GEOS_prec_filename: Unsuccessfully tried to get files:' - print*, "both files don't exist" - print*, fname_full - print*, fname_full_tmp + print '(400A)', trim(Iam) // ': Could not find any of the following files:' + print '(400A)', trim(fname_full_tmp1) + print '(400A)', trim(fname_full_tmp2) + print '(400A)', trim(fname_full) endif endif - end subroutine get_GEOS_prec_filename + end subroutine get_GEOS_corr_prec_filename ! **************************************************************** diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 index f17f52b0..a37b1e98 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_DriverTypes.F90 @@ -31,9 +31,6 @@ module LDAS_DriverTypes private public :: met_force_type, veg_param_type, bal_diagn_type - public :: out_dtstep_type - public :: out_select_type, out_select_sub_type - public :: out_choice_type, out_choice_time_type public :: alb_param_type public :: assignment (=), operator (/), operator (+), operator (*) @@ -169,79 +166,6 @@ module LDAS_DriverTypes real :: wincr ! water analysis increment per unit time [kg/m2/s] end type bal_diagn_type - ! --------------------------------------------------------------- - ! - ! type output time steps - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: When modifying this derived type make sure that the corresponding - ! MPI STRUCTURE in module CLSM_ENSDRV_MPI is also updated, as are - ! any subroutines or operators defined herein - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - type :: out_dtstep_type - integer :: rstrt - integer :: inst - integer :: xhourly - end type out_dtstep_type - - ! --------------------------------------------------------------- - ! - ! type for reading in output choices from namelist file - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: When modifying this derived type make sure that the corresponding - ! MPI STRUCTURE in module CLSM_ENSDRV_MPI is also updated, as are - ! any subroutines or operators defined herein - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - type :: out_select_sub_type - logical :: inst - logical :: xhourly - logical :: daily - logical :: pentad - logical :: monthly - end type out_select_sub_type - - type :: out_select_type - type(out_select_sub_type) :: tile - type(out_select_sub_type) :: grid - end type out_select_type - - ! --------------------------------------------------------------- - ! - ! type for output choices *after* processing in read_driver_inputs() - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: When modifying this derived type make sure that the corresponding - ! MPI STRUCTURE in module CLSM_ENSDRV_MPI is also updated, as are - ! any subroutines or operators defined herein - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - type :: out_choice_space_type - logical :: tile - logical :: grid - logical :: any - end type out_choice_space_type - - type :: out_choice_type - type(out_choice_space_type) :: inst - type(out_choice_space_type) :: xhourly - type(out_choice_space_type) :: daily - type(out_choice_space_type) :: pentad - type(out_choice_space_type) :: monthly - type(out_choice_space_type) :: any - end type out_choice_type - - type :: out_choice_time_type - logical :: rstrt - logical :: inst - logical :: xhourly - logical :: daily - logical :: pentad - logical :: monthly - logical :: any_non_rstrt - end type out_choice_time_type ! --------------------------------------------------------------- ! diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 index 5bddad28..d539e241 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 @@ -20,7 +20,6 @@ module LDAS_ensdrv_Globals public :: nodata_generic public :: nodata_tolfrac_generic public :: nodata_tol_generic - public :: N_bits_shaved public :: logunit public :: logit public :: master_logit @@ -38,16 +37,6 @@ module LDAS_ensdrv_Globals real :: nodata_tol_generic = abs(nodata_generic*nodata_tolfrac_generic) - ! ---------------------------------------------------------------------- - ! - ! bit shaving for better gzip compression of output files: - ! - degrade least significant digits in floating point output - ! in return for better gzip compression rates; - ! - real*4 reserves 24 bits for Mantissa, the N_bits_shaved - ! least significant of these 24 bits will be altered) - - integer, parameter :: N_bits_shaved = 12 ! useful range: 0-12 (0=no shaving) - ! ---------------------------------------------------------------- ! ! log file @@ -88,8 +77,6 @@ subroutine echo_clsm_ensdrv_glob_param() write (logunit,*) write (logunit,*) 'nodata_tol_generic = ', nodata_tol_generic write (logunit,*) - write (logunit,*) 'N_bits_shaved = ', N_bits_shaved - write (logunit,*) write (logunit,*) 'logunit = ', logunit write (logunit,*) write (logunit,*) 'log_master_only = ', log_master_only diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 index 6d0b8caa..8495cd6b 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_functions.F90 @@ -33,9 +33,9 @@ module LDAS_ensdrv_functions ! ******************************************************************** character(300) function get_io_filename( io_path, exp_id, file_tag, & - date_time, dir_name, ens_id, option, file_ext ) + date_time, dir_name, ens_id, option, file_ext, no_subdirs ) - ! compose file name for input/output, create dir if needed + ! compose file name for input/output ! ! file name = io_path/dir_name/[ensXXXX]/Yyyyy/Mmm/ ! "exp_id"."file_tag".[ensXXXX.]YYYYMMDD_HHMMz"file_ext" @@ -56,37 +56,41 @@ character(300) function get_io_filename( io_path, exp_id, file_tag, & ! ! optional arguments: ! - ! date_time date and time info (must be present unless option=1) - ! option default=5 controls date/time directories and string - ! dir_name default='cat' what type of output (eg "rs/", "rc_out/", "ana/") - ! ens_id default='' (see note above) - ! file_ext default='.bin' file name extension + ! date_time date and time info (must be present unless option=1) + ! option default=5 controls date/time directories and string + ! dir_name default='cat' what type of output (eg "rs/", "rc_out/", "ana/") + ! ens_id default='' (see note above) + ! file_ext default='.bin' file name extension + ! no_subdirs default=.false. if .true., omit all sub-directories after "io_path" ! ! reichle, 2 Sep 2008 - overhaul for new dir and file name conventions - + ! reichle, 28 Apr 2020 - added optional "no_subdirs" to facilitate writing to ./scratch + implicit none - character(*) :: io_path - character(*) :: exp_id, file_tag ! (eg "catch_ldas_rst") + character(*) :: io_path + character(*) :: exp_id, file_tag ! (eg "catch_ldas_rst") type(date_time_type), optional :: date_time - integer, optional :: ens_id - integer, optional :: option + integer, optional :: ens_id + integer, optional :: option - character(*), optional :: dir_name ! default = 'cat' - character(*), optional :: file_ext ! default = '.bin' + character(*), optional :: dir_name ! default = 'cat' + character(*), optional :: file_ext ! default = '.bin' + + logical, optional :: no_subdirs ! default = .false. ! locals integer :: tmp_option character(300) :: tmp_string - character(300) :: tmp_string2 character( 40) :: tmp_dir_name, tmp_file_ext, date_time_string character( 8) :: ens_id_string character( 4) :: YYYY, MMDD, HHMM, tmpstring4 character( 2) :: PP + logical :: tmp_no_subdirs ! -------------------------------------------------------- ! @@ -109,6 +113,12 @@ character(300) function get_io_filename( io_path, exp_id, file_tag, & else tmp_file_ext = '.bin' end if + + if (present(no_subdirs)) then + tmp_no_subdirs = no_subdirs + else + tmp_no_subdirs = .false. + end if ! create date/time strings @@ -179,12 +189,19 @@ character(300) function get_io_filename( io_path, exp_id, file_tag, & end if ! compose output path - tmp_string = trim(io_path) // '/' // trim(tmp_dir_name) // '/' // & - trim(ens_id_string(2:8)) // '/' - if (tmp_option>1) & - tmp_string = trim(tmp_string) // '/Y'// YYYY // '/M'//MMDD(1:2) // '/' + tmp_string = trim(io_path) // '/' + if (.not. tmp_no_subdirs) then + + tmp_string = trim(tmp_string) // trim(tmp_dir_name) // '/' // & + trim(ens_id_string(2:8)) // '/' + + if (tmp_option>1) & + tmp_string = trim(tmp_string) // '/Y'// YYYY // '/M'//MMDD(1:2) // '/' + + end if + ! append file name to path get_io_filename = trim(tmp_string) // trim(exp_id) // & diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 index c22c4f72..91e0319c 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 @@ -24,11 +24,6 @@ module LDAS_ensdrv_init_routines use MAPL_BaseMod, ONLY: & NTYPS => MAPL_NumVegTypes - use LDAS_DriverTypes, ONLY: & - out_select_type, & - out_choice_type, & - out_dtstep_type - use LDAS_TileCoordType, ONLY: & tile_coord_type, & grid_def_type, & @@ -77,15 +72,11 @@ module LDAS_ensdrv_init_routines private - public :: read_driver_inputs public :: add_domain_to_path public :: domain_setup - public :: domain_decomp public :: read_cat_param - public :: GEOS_read_catparam public :: clsm_ensdrv_get_command_line public :: io_domain_files - public :: io_rstrt !integer ,parameter :: N_gt=6, N_snow=3 @@ -95,650 +86,7 @@ module LDAS_ensdrv_init_routines contains ! ******************************************************************** - ! ******************************************************************** - - subroutine read_driver_inputs( & - restart, spin, spin_loop, & - start_time, end_time, & - model_dtstep, force_dtstep, out_dtstep, & - out_collection_ID, N_out_fields_inst, N_out_fields_tavg, & - out_ensavg, out_ensstd, out_ensall, & - dzsf, res_ftag, met_hinterp, alb_from_SWnet, & - exp_domain, exp_id, work_path, & - restart_path, restart_domain, restart_id, & - file_format_VEG, file_format_ALB, & - met_path, met_tag, veg_path, alb_path, & - soil_path, top_path, mwRTM_param_path, & - tile_coord_path, tile_coord_file, & - catchment_def_path, catchment_def_file, & - black_path, black_file, & - white_path, white_file, & - minlon, maxlon, minlat, maxlat ) - - ! read and process runtime options - ! - ! runtime options are read in three steps: - ! - ! 1.) read options from default namelist file called - ! driver_inputs.nml in working directory (must be present) - ! - ! 2.) overwrite options from special namelist file (if present) - ! specified at the command line using -driver_inputs_path - ! and -driver_inputs_file - ! - ! 3.) overwrite options from command line (if present) - ! see subroutine clsm_ensdrv_get_command_line() - ! - ! after options are read, runtime inputs are processed and - ! output from subroutine - ! - ! reichle, 12 Jun 2003 - ! reichle, 6 May 2005 - ! reichle, 16 Oct 2008 - eliminated "restart_pert" - - implicit none - - ! ---------------------------------------------------------------------- - - logical, intent(out) :: restart, spin - - integer, intent(out) :: spin_loop - - type(date_time_type), intent(out) :: start_time, end_time - - integer, intent(out) :: model_dtstep, force_dtstep - - type(out_dtstep_type), intent(out) :: out_dtstep - - integer, intent(out) :: out_collection_ID - integer, intent(out) :: N_out_fields_inst, N_out_fields_tavg - - type(out_choice_type), intent(out) :: out_ensavg, out_ensstd, out_ensall - - real, intent(out) :: dzsf - - integer, intent(out) :: met_hinterp - - logical, intent(out) :: alb_from_SWnet - - character(200), intent(out) :: work_path, restart_path - - character(40), intent(out) :: exp_domain, exp_id, res_ftag - character(40), intent(out) :: restart_domain, restart_id - - integer, intent(out) :: file_format_VEG, file_format_ALB - - character(200), intent(out) :: met_path, veg_path, alb_path - character(200), intent(out) :: soil_path, top_path, mwRTM_param_path - character(80), intent(out) :: met_tag - - character(200), intent(out) :: tile_coord_path, catchment_def_path - character(80), intent(out) :: tile_coord_file - character(40), intent(out) :: catchment_def_file - - character(200), intent(out) :: black_path, white_path - character(80), intent(out) :: black_file, white_file - - real, intent(out) :: minlon, maxlon, minlat, maxlat - - ! --------------------- - ! - ! local variables - - character(300) :: fname - - character(200) :: driver_inputs_path - character( 40) :: driver_inputs_file, dir_name, file_tag, file_ext, resolution - - type(out_select_type) :: out_select_ensavg, out_select_ensstd, out_select_ensall - - character(len=*), parameter :: Iam = 'read_driver_inputs' - character(len=400) :: err_msg - - ! -------------------------------------------------------------------- - - namelist / driver_inputs / & - restart, spin, spin_loop, & - start_time, end_time, & - model_dtstep, force_dtstep, out_dtstep, & - out_collection_ID, & - out_select_ensavg, out_select_ensstd, out_select_ensall, & - dzsf, resolution, met_hinterp, alb_from_SWnet, & - work_path, exp_domain, exp_id, & - restart_path, restart_domain, restart_id, & - file_format_VEG, file_format_ALB, & - met_path, met_tag, veg_path, alb_path, & - soil_path, top_path, mwRTM_param_path, & - tile_coord_path, tile_coord_file, & - catchment_def_path, catchment_def_file, & - black_path, black_file, & - white_path, white_file, & - minlon, maxlon, minlat, maxlat - - ! --------------------------------------------------------------------- - ! - ! Set default file name for driver inputs namelist file - - driver_inputs_path = './' ! set default - call clsm_ensdrv_get_command_line(run_path=driver_inputs_path) - driver_inputs_file = 'LDASsa_DEFAULT_inputs_driver.nml' - - ! Read data from default driver_inputs namelist file - - fname = trim(driver_inputs_path) // '/' // trim(driver_inputs_file) - open (10, file=fname, delim='apostrophe', action='read', status='old') - - if (logit) write (logunit,*) - if (logit) write (logunit,'(400A)') 'reading *default* driver inputs from ' // trim(fname) - if (logit) write (logunit,*) - - read (10, nml=driver_inputs) - - close(10,status='keep') - - ! Get name and path for special driver inputs file from - ! command line (if present) - - driver_inputs_path = '' - driver_inputs_file = '' - - call clsm_ensdrv_get_command_line( & - driver_inputs_path=driver_inputs_path, & - driver_inputs_file=driver_inputs_file ) - - if ( trim(driver_inputs_path) /= '' .and. & - trim(driver_inputs_file) /= '' ) then - - ! Read data from special driver_inputs namelist file - - fname = trim(driver_inputs_path) // '/' // trim(driver_inputs_file) - - open (10, file=fname, delim='apostrophe', action='read', status='old') - - if (logit) write (logunit,*) - if (logit) write (logunit,'(400A)') 'reading *special* driver inputs from ' // trim(fname) - if (logit) write (logunit,*) - - read (10, nml=driver_inputs) - - close(10,status='keep') - - end if - - ! Overwrite inputs with command line options, if any - - if (logit) write (logunit,*) & - 'overwriting driver inputs with command line args (if present)' - - call clsm_ensdrv_get_command_line( & - start_time=start_time, & - end_time=end_time, & - resolution=resolution, & - exp_domain=exp_domain, & - exp_id=exp_id, work_path=work_path, & - restart_path=restart_path, restart_domain=restart_domain, & - restart_id=restart_id, & - tile_coord_path=tile_coord_path, & - tile_coord_file=tile_coord_file, & - catchment_def_path=catchment_def_path, & - catchment_def_file=catchment_def_file, & - met_tag=met_tag, & - met_path=met_path, & - force_dtstep=force_dtstep, & - restart=restart, & - spin=spin & - ) - - ! echo variables of driver_inputs - - if (logit) write (logunit,*) 'driver inputs are:' - if (logit) write (logunit,*) - if (logit) write (logunit, nml=driver_inputs) - if (logit) write (logunit,*) - - ! ------------------------------------------------------------- - - ! make sure day-of-year and pentad are correctly initialized - - call get_dofyr_pentad( start_time ) - call get_dofyr_pentad( end_time ) - - ! during spin-up, restart_path/_domain/_id must match work_path/_domain/_id - - if (spin) then - - restart_path = work_path - restart_domain = exp_domain - restart_id = exp_id - - end if - - ! ------------------------------------------------------------- - - ! process paths and file names - - ! Add "domain" to work_path - - work_path = add_domain_to_path( work_path, exp_domain ) - - met_path = trim(met_path) // '/' - - ! append "resolution" to input paths - ! ("resolution" = dir name where Catchment model params are stored) - - veg_path = trim(veg_path) // '/' // trim(resolution) - alb_path = trim(alb_path) // '/' // trim(resolution) - soil_path = trim(soil_path) // '/' // trim(resolution) - top_path = trim(top_path) // '/' // trim(resolution) - - mwRTM_param_path = trim(mwRTM_param_path) // '/' // trim(resolution) - - tile_coord_path = trim(tile_coord_path) // '/' // trim(resolution) - catchment_def_path = trim(catchment_def_path) // '/' // trim(resolution) - - black_path = trim(black_path) // '/' // trim(resolution) - white_path = trim(white_path) // '/' // trim(resolution) - - ! ------------------------------------------------------------- - - ! extract "res_ftag" from "resolution" - ! ("res_ftag" is part of the file name for vegetation, albedo, and elev data) - - select case (trim(resolution)) - - ! GEOS-5 lat/lon tile space - - case( '144x91', & - 'FV_144x91', & - 'DC0144xPC0091_DE0360xPE0180', & - 'DC0144xPC0091_DE1440xPE0720', & - 'DC0144xPC0091_DE2880xPE1440' ); res_ftag= '144x91_DC' - - case( '288x181', & - 'FV_288x181', & - 'DC0288xPC0181_DE0360xPE0180', & - 'DC0288xPC0181_DE1440xPE0720', & - 'DC0288xPC0181_DE2880xPE1440' ); res_ftag= '288x181_DC' - - case( '540x361', & - 'FV_540x361', & - 'DC0540xPC0361_DE0360xPE0180' ); res_ftag= '540x361_DC' - - case( '576x361', & - 'FV_576x361', & - 'DC0576xPC0361_DE0360xPE0180', & - 'DC0576xPC0361_DE1440xPE0720', & - 'DC0576xPC0361_DE2880xPE1440' ); res_ftag= '576x361_DC' - - case( '1152x721', & - 'FV_1152x721', & - 'DC1152xPC0721_DE0360xPE0180', & - 'DC1152xPC0721_DE1440xPE0720', & - 'DC1152xPC0721_DE2880xPE1440' ); res_ftag= '1152x721_DC' - - ! GEOS-5 cube-sphere tile space - - case('CF0048x6C_DE0360xPE0180', & - 'CF0048x6C_DE1440xPE0720', & - 'CF0048x6C_DE2880xPE1440' ); res_ftag = '48x288' - - case('CF0090x6C_DE0360xPE0180', & - 'CF0090x6C_DE1440xPE0720', & - 'CF0090x6C_DE2880xPE1440' ); res_ftag = '90x540' - - case('CF0180x6C_DE0360xPE0180', & - 'CF0180x6C_DE1440xPE0720', & - 'CF0180x6C_DE2880xPE1440' ); res_ftag = '180x1080' - - case('CF0360x6C_DE0360xPE0180', & - 'CF0360x6C_DE1440xPE0720', & - 'CF0360x6C_DE2880xPE1440' ); res_ftag = '360x2160' - - case('CF0720x6C_DE0360xPE0180', & - 'CF0720x6C_DE1440xPE0720', & - 'CF0720x6C_DE2880xPE1440' ); res_ftag = '720x4320' - - case('CF1000x6C_DE0360xPE0180', & - 'CF1000x6C_DE1440xPE0720', & - 'CF1000x6C_DE2880xPE1440' ); res_ftag = '1000x6000' - - case('CF1440x6C_DE0360xPE0180', & - 'CF1440x6C_DE1440xPE0720', & - 'CF1440x6C_DE2880xPE1440' ); res_ftag = '1440x8640' - - ! (SMAP) EASE tile space, non-GEOS-5 tile space - - case ('SMAP_EASEv2_M09'); res_ftag = '3856x1624_DE' - case ('SMAP_EASEv2_M36'); res_ftag = '964x406_DE' - case ('SMAP_EASE_M09'); res_ftag = '3852x1632_DE' - case ('SMAP_EASE_M36'); res_ftag = '963x408_DE' - - ! default (for backward compatibility in case an old bcs directory is used) - - case default; res_ftag = '' - - end select - - ! ------------------------------------------------------------------------ - ! - ! obtain total number of output fields in output file collection - ! for time-avg or instantaneous output (tile or grid) - ! - ! *must* be consistent with what is defined in subroutine output_calcs() - - select case (out_collection_ID) - - case ( 1) ! legacy LDASsa output collection - - N_out_fields_inst = 44 - N_out_fields_tavg = N_out_fields_inst - - case ( 2) ! SMAP Nature (v02) - - N_out_fields_inst = 6 - N_out_fields_tavg = N_out_fields_inst - - case ( 3) ! mwRTM calibration (before Dec 2013), SMOS DA - - N_out_fields_inst = 8 - N_out_fields_tavg = N_out_fields_inst - - case ( 4) ! MERRA-Land - - N_out_fields_inst = 50 - N_out_fields_tavg = N_out_fields_inst - - case ( 5) ! MERRA-Land (with additional files) - - N_out_fields_inst = 59 - N_out_fields_tavg = N_out_fields_inst - - case ( 6) ! SMAP L4_SM gph collection - - N_out_fields_inst = 40 ! EXCL sm in pctl units! - N_out_fields_tavg = N_out_fields_inst - - case ( 7,8) ! SMAP Nature (v03) - - ! These output collections have *different* variables for inst and tavg output!! - ! (see subroutine output_calcs() for details) - - if (out_collection_ID==7) then - - N_out_fields_inst = 4 ! SMAP_Nature_v03: 2001-2009 - N_out_fields_tavg = 4 ! SMAP_Nature_v03: n/a - - elseif (out_collection_ID==8) then - - N_out_fields_inst = 5 ! SMAP_Nature_v03: 2010-201? - N_out_fields_tavg = 6 ! SMAP_Nature_v03: 2010-201? - - end if - - case ( 9) ! mwRTM calibration (Dec 2013) - - ! This output collection has *different* variables for inst and tavg output!! - ! (see subroutine output_calcs() for details) - - N_out_fields_inst = 6 - N_out_fields_tavg = 2 - - case (10) ! legacy LDASsa output collection, plus t2m and q2m - - N_out_fields_inst = 46 - N_out_fields_tavg = N_out_fields_inst - - case (11) ! SMOS preprocessing (Mar 2015) - - N_out_fields_inst = 5 - N_out_fields_tavg = N_out_fields_inst - - case default - - err_msg = 'Error: unknown out_collection_ID' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - - ! ------------------------------------------------------------------------ - ! - ! process ensavg output choices - - call get_out_choice( out_select_ensavg, out_ensavg ) - call get_out_choice( out_select_ensstd, out_ensstd ) - call get_out_choice( out_select_ensall, out_ensall ) - - ! ------------------------------------------------------------------------ - - ! Check timestep parameters - - ! force_dtstep = forcing time step in seconds - ! model_dtstep = model time step in seconds - - if (model_dtstep>450) then - err_msg = 'model time step too large, 450s suggested' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (model_dtstep<30) then - err_msg = 'model time step very small. Are you sure?' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,model_dtstep)/=0) then - err_msg = 'day not evenly divided by model time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if (mod(force_dtstep,model_dtstep)/=0) then - err_msg = 'model and forcing time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,force_dtstep)/=0) then - err_msg = 'day not evenly divided by forcing time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if (mod(out_dtstep%rstrt,model_dtstep)/=0) then - err_msg = 'model and restart time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (out_dtstep%rstrt>0) then - if (mod(86400,out_dtstep%rstrt)/=0) then - err_msg = 'day not evenly divided by restart time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - end if - - if ( out_ensavg%inst%any .or. & - out_ensstd%inst%any .or. & - out_ensall%inst%any ) then - - if (mod(out_dtstep%inst,model_dtstep)/=0) then - err_msg = 'model and inst time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,out_dtstep%inst)/=0) then - err_msg = 'day not evenly divided by inst time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (out_dtstep%inst>86400) then - err_msg = 'inst time step > 1 day not allowed' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(start_time%hour*3600,out_dtstep%inst)/=0) .or. & - (start_time%min/=0) .or. & - (start_time%sec/=0) ) then - err_msg = 'inst time step clashes with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(end_time%hour*3600,out_dtstep%inst)/=0) .or. & - (end_time%min/=0) .or. & - (end_time%sec/=0) ) then - err_msg = 'inst time step clashes with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%xhourly%any .or. & - out_ensstd%xhourly%any .or. & - out_ensall%xhourly%any ) then - - if (mod(out_dtstep%xhourly,model_dtstep)/=0) then - err_msg = 'model and xhourly time steps incompatible' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (mod(86400,out_dtstep%xhourly)/=0) then - err_msg = 'day not evenly divided by xhourly time step' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else if (out_dtstep%xhourly>86400) then - err_msg = 'xhourly time step > 1 day not allowed' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(start_time%hour*3600,out_dtstep%xhourly)/=0) .or. & - (start_time%min/=0) .or. & - (start_time%sec/=0) ) then - err_msg = 'xhourly time step clashes with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((mod(end_time%hour*3600,out_dtstep%xhourly)/=0) .or. & - (end_time%min/=0) .or. & - (end_time%sec/=0) ) then - err_msg = 'xhourly time step clashes with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%daily%any .or. & - out_ensstd%daily%any .or. & - out_ensall%daily%any ) then - - if ((start_time%hour/=0) .or. & - (start_time%min/=0) .or. (start_time%sec/=0) ) then - err_msg = 'out_daily incompatible with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((end_time%hour/=0) .or. & - (end_time%min/=0) .or. (end_time%sec/=0) ) then - err_msg = 'out_daily incompatible with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%pentad%any .or. & - out_ensstd%pentad%any .or. & - out_ensall%pentad%any ) then - - ! these checks are VERY incomplete!!! - - if ((start_time%hour/=0) .or. & - (start_time%min/=0) .or. (start_time%sec/=0) ) then - err_msg = 'out_pentad incompatible with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((end_time%hour/=0) .or. & - (end_time%min/=0) .or. (end_time%sec/=0) ) then - err_msg = 'out_pentad incompatible with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - if ( out_ensavg%monthly%any .or. & - out_ensstd%monthly%any .or. & - out_ensall%monthly%any ) then - - if ((start_time%day/=1) .or. (start_time%hour/=0) .or. & - (start_time%min/=0) .or. (start_time%sec/=0) ) then - err_msg = 'out_monthly incompatible with start_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ((end_time%day/=1) .or. (end_time%hour/=0) .or. & - (end_time%min/=0) .or. (end_time%sec/=0) ) then - err_msg = 'out_monthly incompatible with end_time' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - ! ------------------------------------------------------------- - ! - ! save driver inputs into *driver_inputs.nml file - - dir_name = 'rc_out' - file_tag = 'ldas_driver_inputs' - file_ext = '.nml' - fname = get_io_filename( work_path, exp_id, file_tag, date_time=start_time, & - dir_name=dir_name, file_ext=file_ext ) - - if (logit) write (logunit,'(400A)') 'writing driver inputs to ' // trim(fname) - if (logit) write (logunit,*) - - open (10, file=fname, status='unknown', action='write', delim='apostrophe') - - write(10, nml=driver_inputs) - - close(10, status='keep') - - end subroutine read_driver_inputs - - ! **************************************************************** - - subroutine get_out_choice( out_select_x, out_x ) - - ! reichle, 23 Dec 2011 - - implicit none - - type(out_select_type), intent(in) :: out_select_x - type(out_choice_type), intent(out) :: out_x - - ! ------------------------------------------------------------------ - - out_x%inst%tile = out_select_x%tile%inst - out_x%xhourly%tile = out_select_x%tile%xhourly - out_x%daily%tile = out_select_x%tile%daily - out_x%pentad%tile = out_select_x%tile%pentad - out_x%monthly%tile = out_select_x%tile%monthly - - out_x%inst%grid = out_select_x%grid%inst - out_x%xhourly%grid = out_select_x%grid%xhourly - out_x%daily%grid = out_select_x%grid%daily - out_x%pentad%grid = out_select_x%grid%pentad - out_x%monthly%grid = out_select_x%grid%monthly - - out_x%inst%any = out_x%inst%tile .or. out_x%inst%grid - out_x%xhourly%any = out_x%xhourly%tile .or. out_x%xhourly%grid - out_x%daily%any = out_x%daily%tile .or. out_x%daily%grid - out_x%pentad%any = out_x%pentad%tile .or. out_x%pentad%grid - out_x%monthly%any = out_x%monthly%tile .or. out_x%monthly%grid - - out_x%any%tile = & - out_x%inst%tile .or. & - out_x%xhourly%tile .or. & - out_x%daily%tile .or. & - out_x%pentad%tile .or. & - out_x%monthly%tile - - out_x%any%grid = & - out_x%inst%grid .or. & - out_x%xhourly%grid .or. & - out_x%daily%grid .or. & - out_x%pentad%grid .or. & - out_x%monthly%grid - - out_x%any%any = & - out_x%inst%any .or. & - out_x%xhourly%any .or. & - out_x%daily%any .or. & - out_x%pentad%any .or. & - out_x%monthly%any - - end subroutine get_out_choice - - ! **************************************************************** character(200) function add_domain_to_path( pathname, exp_domain ) @@ -1010,267 +358,6 @@ end subroutine domain_setup ! ********************************************************************** - subroutine domain_decomp(numprocs, N_tile, tile_coord, N_tiles_cont, & - work_path, exp_domain, exp_id, date_time, low_ind, upp_ind, N_catl_vec ) - - ! decompose the *re-ordered* tile_coord structure into numprocs sub-domains. - ! Do NOT include tiles from different continents within same local domain. - ! - ! IMPORTANT: tiles in tile_coord must in order of (re-assigned) continents - ! and Level 1 Pfafstetter basin IDs - see subroutine reorder_tiles() - ! - ! reichle, 26 June 2012 - ! - ! --------------------------------------------------------------- - - implicit none - - integer, intent(in) :: numprocs, N_tile - - type(tile_coord_type), dimension(N_tile), intent(in) :: tile_coord - - integer, dimension(N_cont_max), intent(in) :: N_tiles_cont - - character(200), intent(in) :: work_path - character(40), intent(in) :: exp_domain - character(40), intent(in) :: exp_id - - type(date_time_type), intent(in) :: date_time - - integer, dimension(numprocs), intent(out) :: low_ind, upp_ind - integer, dimension(numprocs), intent(out) :: N_catl_vec - - ! local variables - - integer :: i, j, k, k_keep, N_cont_tmp, istat - integer :: N_target, N_tmp, N_tmp_cum, N_missing - - integer, dimension(N_cont_max) :: numprocs_cont, N_tiles_cont_tmp - - integer, dimension(:), allocatable :: d2p ! domain-to-processor - - integer, parameter :: unitnumber = 10 - - character(300) :: fname - character( 40) :: file_tag, dir_name, file_ext - - character(len=*), parameter :: Iam = 'domain_decomp' - character(len=400) :: err_msg - type(ESMF_VM) :: vm - integer :: status - - ! ----------------------------------------------------------------------------- - call ESMF_VmGetCurrent(vm, rc=status) - master_proc = MAPL_Am_I_Root(vm) - ! - ! make sure there is at least one tile per processor - - - if (numprocs>N_tile) then - err_msg = 'Number of processors cannot exceed number of tiles' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! ------------------------------------------------------------------------- - - if (numprocs==1) then ! sequential - - low_ind(1) = 1 - upp_ind(1) = N_tile - - N_catl_vec(1) = N_tile - - else ! MPI parallel - - ! zoom into continents that have at least one tile - - N_tiles_cont_tmp = -9999 - - k_keep = 0 - - do k=1,N_cont_max - - if (N_tiles_cont(k)>0) then - - k_keep = k_keep + 1 - - N_tiles_cont_tmp(k_keep) = N_tiles_cont(k) - - end if - - end do - - N_cont_tmp = k_keep - - ! determine target number of tiles assigned to each processor - - N_target = nint( real(N_tile) / real(numprocs) ) - - ! determine number of processors assigned to each continent - - do k=1,N_cont_tmp - - ! ensure that each continent gets at least one processor - - numprocs_cont(k) = max( nint(real(N_tiles_cont_tmp(k))/real(N_target)), 1) - - end do - - ! ensure that all available processors are used (and none extra) - - numprocs_cont(N_cont_tmp) = numprocs - sum(numprocs_cont(1:N_cont_tmp-1)) - - ! make sure the final continent also gets at least one processor - - if (numprocs_cont(N_cont_tmp)<=0) then - - if (all(numprocs_cont<=1)) then - - err_msg = 'too many continents, not enough processors' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - ! NOTE: could iterate and merge continents - - else - - ! At this point numprocs_cont(N_cont_tmp) could be zero - ! or negative. - ! - ! Reallocate processors from the first continent with "spare" - ! processors such that numprocs_cont(N_cont_tmp)=1 and - ! sum(numprocs_cont(1:N_cont_tmp))=numprocs - ! - ! (could be improved by taking the "spares" from the - ! continent with at least two processors and the lowest ratio - ! of N_tiles/numprocs_cont) - - N_missing = 1 - numprocs_cont(N_cont_tmp) - - do k=1,(N_cont_tmp-1) - - if (numprocs_cont(k)>=N_missing+1) then - - numprocs_cont(k) = numprocs_cont(k) - N_missing - - numprocs_cont(N_cont_tmp) = 1 - - exit - - end if - - end do - - end if - - end if - - ! double-check one more time - - if ( any(numprocs_cont(1:N_cont_tmp)<=0) .or. & - sum(numprocs_cont(1:N_cont_tmp))/=numprocs ) then - err_msg = 'error in allocation of processors to continents' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! map tiles to processors by continent - - low_ind(1) = 1 - upp_ind(numprocs) = N_tile - - j = 0 - - do k=1,N_cont_tmp - - N_tmp_cum = 0 ! cumulative number of tiles assigned to continent so far - - do i=1,numprocs_cont(k) - - j=j+1 ! counter for all processors (independent of continent) - - if (jnull() - type(MAPL_LocStream) :: locstream - type(ESMF_Grid) :: TILEGRID - integer, pointer :: mask(:) - integer :: rc, status,unit, N_catl - character(*),parameter :: Iam="GEOS_read_catparam" - real,allocatable :: tmp(:) - logical :: file_exists - - call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_Get(MAPL, LocStream=locstream,rc=status) - VERIFY_(status) - - call MAPL_LocStreamGet(LOCSTREAM, NT_LOCAL=N_catl,TILEGRID=TILEGRID, RC=STATUS) - VERIFY_(STATUS) - - call MAPL_TileMaskGet(tilegrid, mask, rc=status) - VERIFY_(STATUS) - - inquire (file=trim(fname), exist=file_exists) - - if (.not. file_exists) then - if (logit) write (logunit,*) 'The file does not exist: ', trim(fname) - call ldas_abort(LDAS_GENERIC_ERROR, Iam, "should have"//trim(fname)) - endif - - - unit = GETFILE( trim(fname), form="unformatted", RC=STATUS ) - VERIFY_(STATUS) - - allocate(tmp(N_catl)) - - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dpth , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzsf , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzrz , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzpr , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(1) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(2) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(3) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(4) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(5) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%dzgt(6) , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%poros , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%cond , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%psis , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bee , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%wpwet , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%gnu , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%vgwmax, mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarRead(unit, tilegrid,tmp(:), mask=mask, rc=status); VERIFY_(STATUS) - cat_param(:)%vegcls = nint(tmp) - call MAPL_VarRead(unit, tilegrid,tmp(:), mask=mask, rc=status); VERIFY_(STATUS) - cat_param(:)%soilcls30 = nint(tmp) - call MAPL_VarRead(unit, tilegrid,tmp(:), mask=mask, rc=status); VERIFY_(STATUS) - cat_param(:)%soilcls100 = nint(tmp) - - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bf1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bf2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%bf3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%cdcr1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%cdcr2, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ars1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ars2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ars3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%ara4 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw3 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%arw4 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsa1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsa2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsb1 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%tsb2 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%atau , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%btau , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%gravel30, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%orgC30 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%orgC , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%sand30 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%clay30 , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%sand , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%clay , mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%wpwet30, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%poros30, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarRead(unit, tilegrid,cat_param(:)%veghght, mask=mask, rc=status); VERIFY_(STATUS) - - call FREE_FILE(unit, RC=STATUS); VERIFY_(STATUS) - - end subroutine GEOS_read_catparam + ! ************************************************************************* subroutine read_VEG_Height( & N_catg, veg_path, V_HEIGHT ) @@ -2720,168 +1708,6 @@ end subroutine clsm_ensdrv_get_command_line ! *********************************************************************** - subroutine io_rstrt( action, work_path, exp_id, ens_id, date_time, & - N_catd, cat_progn, file_tag, dir_name, is_little_endian ) - - ! read or write re-start file. - ! - ! reichle, 11 May 2005 - ! reichle, 5 Jun 2006 - adapted for output of increments - - implicit none - - character, intent(in) :: action ! read or write - - character(*), intent(in) :: work_path - character(*), intent(in) :: exp_id - - type(date_time_type), intent(in) :: date_time - - integer, intent(in) :: ens_id, N_catd - - type(cat_progn_type), dimension(N_catd), intent(inout) :: cat_progn - - character(*), optional, intent(in) :: file_tag, dir_name - - logical, optional, intent(in) :: is_little_endian - - ! local variables - - character(40), parameter :: file_tag_default = 'catch_ldas_rst' - character(40), parameter :: dir_name_default = 'rs' - - integer :: n, k - - character(300) :: filename - character(40) :: file_tag_tmp, dir_name_tmp, endian_string - - character(len=*), parameter :: Iam = 'io_rstrt' - character(len=400) :: err_msg - - ! -------------------------------------------------------------------- - - if (present(file_tag)) then - file_tag_tmp = file_tag - - else - - file_tag_tmp = file_tag_default - - end if - - if (present(dir_name)) then - - dir_name_tmp = dir_name - - else - - dir_name_tmp = dir_name_default - - end if - - endian_string = 'big_endian' ! default - - if (present(is_little_endian)) then - - if (is_little_endian) endian_string = 'little_endian' - - end if - - ! ---------------------------------------------------------- - - select case (action) - - case ('r','R') - - filename = get_io_filename( work_path, exp_id, & - file_tag_tmp, date_time=date_time, & - dir_name=dir_name_tmp, ens_id=ens_id ) - - if (logit) write (logunit,'(400A)') 'Reading restart file ' // trim(filename) - - open(10, file=filename, form='unformatted', status='old', & - convert=trim(endian_string), action='read') - - read (10) (cat_progn(n)%tc1, n=1,N_catd) - read (10) (cat_progn(n)%tc2, n=1,N_catd) - read (10) (cat_progn(n)%tc4, n=1,N_catd) - - - read (10) (cat_progn(n)%qa1, n=1,N_catd) - read (10) (cat_progn(n)%qa2, n=1,N_catd) - read (10) (cat_progn(n)%qa4, n=1,N_catd) - - read (10) (cat_progn(n)%capac, n=1,N_catd) - - read (10) (cat_progn(n)%catdef, n=1,N_catd) - read (10) (cat_progn(n)%rzexc, n=1,N_catd) - read (10) (cat_progn(n)%srfexc, n=1,N_catd) - - do k=1,N_gt - read (10) (cat_progn(n)%ght(k), n=1,N_catd) - end do - - do k=1,N_snow - read (10) (cat_progn(n)%wesn(k), n=1,N_catd) - end do - do k=1,N_snow - read (10) (cat_progn(n)%htsn(k), n=1,N_catd) - end do - do k=1,N_snow - read (10) (cat_progn(n)%sndz(k), n=1,N_catd) - end do - - - case ('w','W') - - filename = get_io_filename( work_path, exp_id, & - file_tag_tmp, date_time=date_time, & - dir_name=dir_name_tmp, ens_id=ens_id ) - - if (logit) write (logunit,'(400A)') 'Writing restart (or incr) file ' // trim(filename) - - open(10, file=filename, form='unformatted', status='unknown', & - convert=trim(endian_string), action='write') - - write (10) (cat_progn(n)%tc1, n=1,N_catd) - write (10) (cat_progn(n)%tc2, n=1,N_catd) - write (10) (cat_progn(n)%tc4, n=1,N_catd) - - write (10) (cat_progn(n)%qa1, n=1,N_catd) - write (10) (cat_progn(n)%qa2, n=1,N_catd) - write (10) (cat_progn(n)%qa4, n=1,N_catd) - - - write (10) (cat_progn(n)%capac, n=1,N_catd) - - write (10) (cat_progn(n)%catdef, n=1,N_catd) - write (10) (cat_progn(n)%rzexc, n=1,N_catd) - write (10) (cat_progn(n)%srfexc, n=1,N_catd) - - do k=1,N_gt - write (10) (cat_progn(n)%ght(k), n=1,N_catd) - end do - - do k=1,N_snow - write (10) (cat_progn(n)%wesn(k), n=1,N_catd) - end do - do k=1,N_snow - write (10) (cat_progn(n)%htsn(k), n=1,N_catd) - end do - do k=1,N_snow - write (10) (cat_progn(n)%sndz(k), n=1,N_catd) - end do - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown action') - - end select - - close (10,status='keep') - - end subroutine io_rstrt - end module LDAS_ensdrv_init_routines ! *********** EOF ****************************************************** diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 index 323e1807..3574dab3 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 @@ -66,7 +66,7 @@ module LDAS_ensdrv_mpi integer, public :: MPI_cat_diagS_type, MPI_cat_diagF_type integer, public :: MPI_met_force_type, MPI_veg_param_type integer, public :: MPI_bal_diagn_type, MPI_alb_param_type - integer, public :: MPI_date_time_type, MPI_out_dtstep_type, MPI_out_choice_type + integer, public :: MPI_date_time_type integer, public :: MPI_mwRTM_param_type,MPI_obs_type, MPI_obs_param_type integer, public :: MPI_cat_progn_int_type, MPI_cat_bias_param_type integer, public :: MPI_obs_bias_type @@ -121,76 +121,6 @@ subroutine init_MPI_types() deallocate(idisp) deallocate(itype) - ! --------------------------------------------------------------- - ! - ! type output time steps - ! - ! type :: out_dtstep_type - ! integer :: rstrt - ! integer :: inst - ! integer :: xhourly - ! end type out_dtstep_type - - icount = 1 - - allocate(iblock(icount)) - allocate(idisp( icount)) - allocate(itype( icount)) - - itype(1) = MPI_INTEGER - - iblock(1) = 3 - - idisp(1) = 0 - - call MPI_TYPE_CREATE_STRUCT( icount, iblock, idisp, itype, & - MPI_out_dtstep_type, mpierr ) - - call MPI_TYPE_COMMIT(MPI_out_dtstep_type, mpierr) - - deallocate(iblock) - deallocate(idisp) - deallocate(itype) - - ! --------------------------------------------------------------- - ! - ! type for output choices *after* processing in read_driver_inputs() - ! - ! type :: out_choice_space_type - ! logical :: tile - ! logical :: grid - ! logical :: any - ! end type out_choice_space_type - ! - ! type :: out_choice_type - ! type(out_choice_space_type) :: inst - ! type(out_choice_space_type) :: xhourly - ! type(out_choice_space_type) :: daily - ! type(out_choice_space_type) :: pentad - ! type(out_choice_space_type) :: monthly - ! type(out_choice_space_type) :: any - ! end type out_choice_type - - icount = 1 - - allocate(iblock(icount)) - allocate(idisp( icount)) - allocate(itype( icount)) - - itype(1) = MPI_LOGICAL - - iblock(1) = 18 - - idisp(1) = 0 - - call MPI_TYPE_CREATE_STRUCT( icount, iblock, idisp, itype, & - MPI_out_choice_type, mpierr ) - - call MPI_TYPE_COMMIT(MPI_out_choice_type, mpierr) - - deallocate(iblock) - deallocate(idisp) - deallocate(itype) ! -------------------------------------------------------------------------------- ! From fca64a5bc9e2a64e9380b0ee0b796f72dee8bbb9 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Mon, 11 May 2020 15:29:39 -0400 Subject: [PATCH 21/42] Sync master back into BRIDGE_FROM_DEVELOP_TO_MASTER (#217) From d45ff75426db6945840981ca8935c89c557fa8d3 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Mon, 11 May 2020 15:31:04 -0400 Subject: [PATCH 22/42] Update Externals.cfg back to what it should be in develop --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 60601a4e..f9970364 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.3 +branch = master protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.3 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 4a393990504ec0b3d8e25f26142806d1feca4be4 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 20 May 2020 11:22:33 -0400 Subject: [PATCH 23/42] editing Externals.cfg in prep for merge into master --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index f9970364..e461c33c 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = master +tag = v1.1.3 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -branch = develop +tag = 1.8.4 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From bcf8cdc1da1f3a29269cbce264adcc3255e93e24 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 20 May 2020 11:34:35 -0400 Subject: [PATCH 24/42] Merging BRIDGE... into master (#225) --- Externals.cfg | 2 +- components.yaml | 32 + src/Applications/LDAS_App/GEOSldas_HIST.rc | 48 +- src/Applications/LDAS_App/GEOSldas_LDAS.rc | 7 +- src/Applications/LDAS_App/ldas_setup | 64 +- .../LDAS_App/mk_GEOSldasRestarts.F90 | 6 +- src/Applications/LDAS_App/process_hist.csh | 2 +- src/Applications/LDAS_App/process_rst.csh | 2 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 160 +- .../GEOS_LandAssimGridComp.F90 | 3431 +++++++++-------- .../GEOSlandassim_GridComp/mwRTM_routines.F90 | 9 +- .../GEOS_LandPertGridComp.F90 | 50 +- .../LDAS_PertRoutines.F90 | 377 +- .../GEOSlandpert_GridComp/land_pert.F90 | 4 +- .../GEOS_MetforceGridComp.F90 | 34 +- 15 files changed, 2065 insertions(+), 2163 deletions(-) create mode 100644 components.yaml diff --git a/Externals.cfg b/Externals.cfg index 60601a4e..e461c33c 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.3 +tag = 1.8.4 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/components.yaml b/components.yaml new file mode 100644 index 00000000..5616a26f --- /dev/null +++ b/components.yaml @@ -0,0 +1,32 @@ +env: + local: ./@env + remote: git@github.com:GEOS-ESM/ESMA_env.git + tag: v2.1.3+intel19.1.0 + +cmake: + local: ./@cmake + remote: git@github.com:GEOS-ESM/ESMA_cmake.git + tag: v3.0.1 + +ecbuild: + local: ./@cmake/@ecbuild + remote: git@github.com:GEOS-ESM/ecbuild.git + tag: geos/v1.0.1 + +GMAO_Shared: + local: ./src/Shared/@GMAO_Shared + remote: git@github.com:GEOS-ESM/GMAO_Shared.git + sparse: ./config/GMAO_Shared.sparse + branch: master + +MAPL: + local: ./src/Shared/@MAPL + remote: git@github.com:GEOS-ESM/MAPL.git + tag: v2.1.3 + +GEOSgcm_GridComp: + local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp + remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git + sparse: ./config/GEOSgcm_GridComp_ldas.sparse + branch: develop + diff --git a/src/Applications/LDAS_App/GEOSldas_HIST.rc b/src/Applications/LDAS_App/GEOSldas_HIST.rc index 42c71954..193b7554 100644 --- a/src/Applications/LDAS_App/GEOSldas_HIST.rc +++ b/src/Applications/LDAS_App/GEOSldas_HIST.rc @@ -36,18 +36,18 @@ COLLECTIONS: tavg24_1d_lfs_Nt.mode: 'time-averaged', tavg24_1d_lfs_Nt.frequency: 240000, tavg24_1d_lfs_Nt.ref_time: 000000, - tavg24_1d_lfs_Nt.fields:'Tair' , 'DATAATM' , - 'Qair' , 'DATAATM' , - 'LWdown' , 'DATAATM' , - 'SWdown' , 'DATAATM' , - 'Wind' , 'DATAATM' , - 'Psurf' , 'DATAATM' , - 'Rainf_C' , 'DATAATM' , - 'Rainf' , 'DATAATM' , - 'Snowf' , 'DATAATM' , - 'RainfSnowf' , 'DATAATM' , - 'SWnet' , 'DATAATM' , - 'RefH' , 'DATAATM' , + tavg24_1d_lfs_Nt.fields:'Tair' , 'METFORCE' , + 'Qair' , 'METFORCE' , + 'LWdown' , 'METFORCE' , + 'SWdown' , 'METFORCE' , + 'Wind' , 'METFORCE' , + 'Psurf' , 'METFORCE' , + 'Rainf_C' , 'METFORCE' , + 'Rainf' , 'METFORCE' , + 'Snowf' , 'METFORCE' , + 'RainfSnowf' , 'METFORCE' , + 'SWnet' , 'METFORCE' , + 'RefH' , 'METFORCE' , 'CATDEF' , 'GridComp' , 'RZEXC' , 'GridComp' , 'SRFEXC' , 'GridComp' , @@ -68,18 +68,18 @@ COLLECTIONS: tavg24_2d_lfs_Nx.regrid_name: 'GRIDNAME', tavg24_2d_lfs_Nx.grid_label: PC720x361-DC, tavg24_2d_lfs_Nx.deflate: 2, - tavg24_2d_lfs_Nx.fields:'Tair' , 'DATAATM' , - 'Qair' , 'DATAATM' , - 'LWdown' , 'DATAATM' , - 'SWdown' , 'DATAATM' , - 'Wind' , 'DATAATM' , - 'Psurf' , 'DATAATM' , - 'Rainf_C' , 'DATAATM' , - 'Rainf' , 'DATAATM' , - 'Snowf' , 'DATAATM' , - 'RainfSnowf' , 'DATAATM' , - 'SWnet' , 'DATAATM' , - 'RefH' , 'DATAATM' , + tavg24_2d_lfs_Nx.fields:'Tair' , 'METFORCE' , + 'Qair' , 'METFORCE' , + 'LWdown' , 'METFORCE' , + 'SWdown' , 'METFORCE' , + 'Wind' , 'METFORCE' , + 'Psurf' , 'METFORCE' , + 'Rainf_C' , 'METFORCE' , + 'Rainf' , 'METFORCE' , + 'Snowf' , 'METFORCE' , + 'RainfSnowf' , 'METFORCE' , + 'SWnet' , 'METFORCE' , + 'RefH' , 'METFORCE' , 'CATDEF' , 'GridComp' , 'RZEXC' , 'GridComp' , 'SRFEXC' , 'GridComp' , diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index 801cdde4..c4ebd5e5 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -94,7 +94,12 @@ FIRST_ENS_ID: 0 # NML_INPUT_PATH: '' -# ---- Microwave Radiative Transfer Model (mwRTM) parameter file name (nc4 format) used for Tb assimilation +# ---- Microwave Radiative Transfer Model (mwRTM) parameter file name (nc4 format) +# +# Must be provided for +# - output of Tb through HISTORY or +# - Tb assimilation. +# Otherwise, leave unspecified (i.e., use default empty string). # # This file can be converted from binary with the program mwrtm_bin2nc4.x. # If empty or commented out, GEOSldas will search the restart directory. diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 94e94cb7..68c7d0d1 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -82,6 +82,8 @@ class LDASsetup: assert os.path.isdir(self.exphome) # exphome should exist self.verbose = cmdLineArgs['verbose'] self.runmodel = cmdLineArgs['runmodel'] + if self.runmodel : + print('\n The option "--runmodel" is out of date, not necessary anymore. \n') self.daysperjob = cmdLineArgs['daysperjob'] self.monthsperjob = cmdLineArgs['monthsperjob'] self.rqdExeInp = OrderedDict() @@ -97,6 +99,7 @@ class LDASsetup: self.islocal = False self.catch = '' self.has_mwrtm = False + self.assim = False self.has_landassim_seed = False self.has_geos_pert = False self.has_ldassa_pert = False @@ -138,8 +141,9 @@ class LDASsetup: _mydir = self.exphome + '/' + self.rqdExeInp['EXP_ID'] assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None - self.ensdirs = ['ens%04d'%iens for iens in xrange(self.nens)] - self.ensids = ['%04d'%iens for iens in xrange(self.nens)] + _first_ens_id = int(self.rqdExeInp.get('FIRST_ENS_ID',0)) + self.ensdirs = ['ens%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] + self.ensids = ['%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] if (self.nens == 1) : self.ensdirs_avg = self.ensdirs self.ensids=[''] @@ -350,15 +354,13 @@ class LDASsetup: self.has_ldassa_pert = True # DEAL WITH mwRTM input from exec - _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 - if _assim == 0 : - _result = self.rqdExeInp.pop('MWRTM_FILE', None) - - + self.assim = True if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else False + # verify mwrtm file if 'MWRTM_FILE' in self.rqdExeInp : _tmpfile = self.rqdExeInp['MWRTM_FILE'].replace("'",'').replace('"','') if os.path.isfile(_tmpfile) : - assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'if MWRTM_FILE is specified,it should be global' + self.has_mwrtm = True + self.rqdExeInp['MWRTM_FILE'] = _tmpfile else : assert not _tmpfile.strip(), ' MWRTM_FILE: %s should point to mwrtm param file'% _tmpfile del self.rqdExeInp['MWRTM_FILE'] @@ -531,7 +533,7 @@ class LDASsetup: # ensxxxx directories nSegments = self.nSegments - for iseg in xrange(nSegments): + for iseg in range(nSegments): _start = self.begDates[iseg] _end = self.endDates[iseg] @@ -629,7 +631,7 @@ class LDASsetup: sp.call(cmd,shell=True) # check if it is local or global with open('f2g.txt') as f2gfile : - head=[next(f2gfile) for x in xrange(2)] + head=[next(f2gfile) for x in range(2)] if(head[0].strip() != head[1].strip()) : self.islocal= True @@ -708,11 +710,11 @@ class LDASsetup: rstpath0 = self.rqdExeInp['RESTART_PATH'] # just copy the landassim pert seed if it exists - for iens in xrange(self.nens) : + for iens in range(self.nens) : _ensdir = self.ensdirs[iens] _ensid = self.ensids[iens] landassim_seeds = rstpath + _ensdir + '/' + y4m2+'/' + rstid + '.landassim_obspertrseed_rst.'+y4m2d2_h2m2 - if os.path.isfile(landassim_seeds) and self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' : + if os.path.isfile(landassim_seeds) and self.assim : _seeds = self.rstdir + _ensdir + '/' + y4m2+'/' + exp_id + '.landassim_obspertrseed_rst.'+y4m2d2_h2m2 shutil.copy(landassim_seeds, _seeds) os.symlink(_seeds, myRstDir+ '/landassim_obspertrseed'+ _ensid +'_rst') @@ -739,7 +741,7 @@ class LDASsetup: #for ens in self.ensdirs : catchRstFile0 = '' vegdynRstFile0 = '' - for iens in xrange(self.nens) : + for iens in range(self.nens) : ens = self.ensdirs[iens] ensid = self.ensids[iens] myCatchRst = myRstDir+'/'+self.catch +ensid +'_internal_rst' @@ -833,16 +835,8 @@ class LDASsetup: catch_param_file = self.bcsdir+'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.ldas_catparam.'+y4m2d2_h2m2+'z.bin' assert os.path.isfile(catch_param_file), "need catch_param file %s" % catch_param_file - # mwRTM restart file - mwRTMRstFile = "" - _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 - if 'MWRTM_FILE' in self.rqdExeInp : + if self.has_mwrtm : mwRTMRstFile = self.rqdExeInp['MWRTM_FILE'] - elif _assim ==1 : - mwRTMRstFile= rcoutpath +'/' + y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' - - if os.path.isfile(mwRTMRstFile) : - self.has_mwrtm = True mwRTMLocal = self.bcsdir+'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' if self.islocal : print "Creating the local mwRTM restart file... \n" @@ -963,7 +957,7 @@ class LDASsetup: GRID='EASE ' + self.rqdExeInp['GRIDNAME'] + ' ' +tmprcfile if '-CF' in self.rqdExeInp['GRIDNAME'] : GRID ='CUBE ' + self.rqdExeInp['GRIDNAME'] + ' ' +tmprcfile - _assim = '1' if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else '0' + _assim = '1' if self.assim else '0' _perturb = '1' if self.nens > 1 else '0' cmd ='./process_hist.csh '+ str(self.rqdExeInp['LSM_CHOICE']) + ' ' + str(self.rqdExeInp['AEROSOL_DEPOSITION']) + \ ' ' + GRID + ' ' + str(self.rqdExeInp['RUN_IRRIG']) + ' ' + _assim + ' '+ _perturb @@ -1012,12 +1006,6 @@ class LDASsetup: #for key,val in optinxny.iteritems(): # ldasrcInp[key]= val - - if (self.runmodel) : - assert ldasrcInp['LAND_ASSIM'].upper() == 'NO', "--runmodel is used,should set LAND_ASSIM to NO" - else : - assert ldasrcInp['LAND_ASSIM'].upper() == 'YES', "--runmodel is not used,should set LAND_ASSIM to YES" - # create BC in rc file tmpl_ = '' if self.nens >1 : @@ -1049,18 +1037,17 @@ class LDASsetup: rstkey=[catch_,'VEGDYN','LANDPERT'] rstval=[self.catch,'vegdyn','landpert'] - _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 - if self.has_mwrtm and _assim ==1 : + if self.has_mwrtm : # and _assim ==1 : keyn='LANDASSIM_INTERNAL_RESTART_FILE' valn='../input/restart/mwrtm_param_rst' ldasrcInp[keyn]= valn - if self.has_landassim_seed and _assim ==1 : + if self.has_landassim_seed and self.assim : keyn='LANDASSIM_OBSPERTRSEED_RESTART_FILE' valn='../input/restart/landassim_obspertrseed%s_rst' ldasrcInp[keyn]= valn - if _assim == 1: + if self.assim: keyn='LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE' valn='landassim_obspertrseed%s_checkpoint' ldasrcInp[keyn]= valn @@ -1170,7 +1157,7 @@ class LDASsetup: expid = self.rqdExeInp['EXP_ID'] fout.write("\nsed -i 's/if($capdate<$enddate) sbatch /#if($capdate<$enddate) sbatch /g' lenkf.j\n\n") nSegments = self.nSegments - for iseg in xrange(nSegments): + for iseg in range(nSegments): if iseg ==0 : fout.write("jobid%d=$(echo $(sbatch lenkf.j) | cut -d' ' -f 4)\n"%(iseg)) fout.write("echo $jobid%d\n"%iseg ) @@ -1229,7 +1216,7 @@ class LDASsetup: if 'job_name' in self.optRmInp : my_job = self.optRmInp['job_name'] - my_constraint='hasw' + my_constraint='' if 'constraint' in self.optRmInp : my_constraint = self.optRmInp['constraint'] @@ -1272,7 +1259,8 @@ class LDASsetup: elif 'MY_JOB' in line : fout.write(line.replace('MY_JOB',my_job)) elif 'MY_CONS' in line : - fout.write(line.replace('MY_CONS',my_constraint)) + if my_constraint!='' : + fout.write(line.replace('MY_CONS',my_constraint)) elif 'MY_EXPID' in line : fout.write(line.replace('MY_EXPID',self.rqdExeInp['EXP_ID'])) elif 'MY_EXPDOMAIN' in line : @@ -1485,7 +1473,7 @@ def _printRmInputKeys(rqdRmInpKeys, optRmInpKeys): print '#' print '# NOTE:' print '# (1) Default job_name is "exp_id"' - print '# (2) Default constraint is "hasw"' + print '# (2) Default is no constraint' print '# (3) Do not specify qos (quality-of-service) by default. Specify "debug" for faster but limited service.' print '#' for key in optRmInpKeys: @@ -1549,7 +1537,7 @@ def parseCmdLine(): ) p_setup.add_argument( '--runmodel', - help='model run (no assimilation)', + help='obsolete, no effect any more', action='store_true', ) p_setup.add_argument( diff --git a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 index dd28242d..60de2cce 100644 --- a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 +++ b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 @@ -220,9 +220,9 @@ PROGRAM mk_GEOSldasRestarts call MPI_FINALIZE(mpierr) call exit(0) -else + else - ! The user does now have restarts, thus cold start (RESTART: 0) + ! The user does not have restarts, thus cold start (RESTART: 0) if(JOBFILE == 'N') then @@ -241,7 +241,7 @@ PROGRAM mk_GEOSldasRestarts write(10,'(a)')'#SBATCH --time=1:00:00' write(10,'(a)')'#SBATCH --ntasks=56' write(10,'(a)')'#SBATCH --job-name=mkLDAS' - write(10,'(a)')'#SBATCH --constraint=hasw' + write(10,'(a)')'###SBATCH --constraint=hasw' write(10,'(a)')'#SBATCH --output=mkLDAS.o' write(10,'(a)')'#SBATCH --error=mkLDAS.e' write(10,'(a)')' ' diff --git a/src/Applications/LDAS_App/process_hist.csh b/src/Applications/LDAS_App/process_hist.csh index dc730a6a..4adfb2c3 100755 --- a/src/Applications/LDAS_App/process_hist.csh +++ b/src/Applications/LDAS_App/process_hist.csh @@ -46,7 +46,7 @@ endif if($PERTURB == 1 ) then set GridComp = ENSAVG sed -i 's|VEGDYN|'VEGDYN0000'|g' $HISTRC - sed -i 's|DATAATM|'DATAATM0000'|g' $HISTRC +# sed -i 's|DATAATM|'DATAATM0000'|g' $HISTRC endif sed -i 's|GridComp|'$GridComp'|g' $HISTRC diff --git a/src/Applications/LDAS_App/process_rst.csh b/src/Applications/LDAS_App/process_rst.csh index 5e59c93e..568057e3 100755 --- a/src/Applications/LDAS_App/process_rst.csh +++ b/src/Applications/LDAS_App/process_rst.csh @@ -68,7 +68,7 @@ case [0] : #SBATCH --time=1:00:00 #SBATCH --ntasks=56 #SBATCH --job-name=mkLDAS -#SBATCH --constraint=hasw +###SBATCH --constraint=hasw #SBATCH --qos=debug #SBATCH --output=mkLDAS.o #SBATCH --error=mkLDAS.e diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index fd5b2e09..ff8dd319 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -8,10 +8,6 @@ module GEOS_LdasGridCompMod use ESMF use MAPL_Mod - !use MAPL_GridManagerMod, only: grid_manager - !use MAPL_RegridderManagerMod - !use MAPL_AbstractRegridderMod - !use MAPL_RegridderSpecMod use GEOS_MetforceGridCompMod, only: MetforceSetServices => SetServices use GEOS_LandGridCompMod, only: LandSetServices => SetServices @@ -44,21 +40,25 @@ module GEOS_LdasGridCompMod public SetServices - ! !DESCRIPTION: This gridded component (GC) combines the GridComps - ! LDDATAATM, LAND, LAKE, LANDICE, SALTWATER and LANA into a - ! new composite LDAS GricComp. + ! !DESCRIPTION: This gridded component (GC) combines the GridComps: + ! METFORCE, LAND, LANDPERT, ENSAVG, and LANDASSIM + ! into a new composite LDAS GricComp. + ! Include later: LAKE, LANDICE(?), SALTWATER(?) !EOP include 'mpif.h' ! All children - integer,allocatable :: DATAATM(:) integer,allocatable :: LAND(:) integer,allocatable :: LANDPERT(:) - integer :: ENSAVG, LANDASSIM + integer :: METFORCE, ENSAVG, LANDASSIM + + ! other global variables integer :: NUM_ENSEMBLE - logical :: assim + logical :: land_assim + logical :: mwRTM + contains !BOP @@ -86,14 +86,16 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: id_string,childname, fmt_str - character(len=ESMF_MAXSTR) :: LAND_ASSIM + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file integer :: ens_id_width ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal type(TILECOORD_WRAP) :: tcwrap type(ESMF_Config) :: CF - + integer :: LSM_CHOICE + integer :: FIRST_ENS_ID + ! Begin... ! Get my name and setup traceback handle @@ -137,38 +139,36 @@ subroutine SetServices(gc, rc) !create ensemble children call MAPL_GetObjectFromGC(gc, MAPL, rc=status) VERIFY_(status) - call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) + call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) + call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, LAND_ASSIM, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) + call MAPL_GetResource ( MAPL, LAND_ASSIM_STR, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) - LAND_ASSIM = ESMF_UtilStringUpperCase(LAND_ASSIM, rc=STATUS) + LAND_ASSIM_STR = ESMF_UtilStringUpperCase(LAND_ASSIM_STR, rc=STATUS) VERIFY_(STATUS) - assim = (LAND_ASSIM /= 'NO') + land_assim = (trim(LAND_ASSIM_STR) /= 'NO') - allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) - allocate(DATAATM(1)) - - ! one dataatm provides all the data - ens_id(1)=0 ! id start form 0 - if(NUM_ENSEMBLE ==1 ) then - id_string='' - else - fmt_str='' - write (fmt_str, "(A2,I1,A1,I1,A1)") "(I", ens_id_width,".",ens_id_width,")" - write(id_string, fmt_str) ens_id(1) + call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) + VERIFY_(STATUS) + mwRTM = ( len_trim(mwRTM_file) /= 0 ) + + call MAPL_GetResource ( MAPL, LSM_CHOICE, Label="LSM_CHOICE:", DEFAULT=1, RC=STATUS) + if (LSM_CHOICE /=1 ) then + _ASSERT( .not. (mwRTM .or. land_assim), "CatchCN is Not Ready for assimilation or mwRTM") endif - id_string=trim(id_string) - childname='DATAATM'//trim(id_string) - DATAATM(1) = MAPL_AddChild(gc, name=childname, ss=MetforceSetServices, rc=status) + + METFORCE = MAPL_AddChild(gc, name='METFORCE', ss=MetforceSetServices, rc=status) VERIFY_(status) + allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) + write (fmt_str, "(A2,I1,A1,I1,A1)") "(I", ens_id_width,".",ens_id_width,")" do i=1,NUM_ENSEMBLE - - ens_id(i)=i-1 ! id start form 0 - if(NUM_ENSEMBLE ==1 ) then + ens_id(i) = i-1 + FIRST_ENS_ID ! id start form FIRST_ENS_ID + if(NUM_ENSEMBLE == 1 ) then id_string='' else write(id_string, fmt_str) ens_id(i) @@ -176,11 +176,6 @@ subroutine SetServices(gc, rc) id_string=trim(id_string) - ! note: different dataatm provide different data - ! childname='DATAATM'//trim(id_string) - ! DATAATM(i) = MAPL_AddChild(gc, name=childname, ss=MetforceSetServices, rc=status) - ! VERIFY_(status) - childname='LANDPERT'//trim(id_string) LANDPERT(i) = MAPL_AddChild(gc, name=childname, ss=LandPertSetServices, rc=status) VERIFY_(status) @@ -188,26 +183,25 @@ subroutine SetServices(gc, rc) childname='LAND'//trim(id_string) LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) VERIFY_(status) - enddo + ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) VERIFY_(status) - if(assim) then + if(land_assim .or. mwRTM ) then LANDASSIM = MAPL_AddChild(gc, name='LANDASSIM', ss=LandAssimSetServices, rc=status) VERIFY_(status) endif ! Connections do i=1,NUM_ENSEMBLE - ! -DATAATM-feeds-LANDPERT's-imports- + ! -METFORCE-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & SHORT_NAME = ['Tair ', 'Qair ', 'Psurf ', 'Rainf_C', 'Rainf ', & 'Snowf ', 'LWdown ', 'SWdown ', 'SWnet ', 'PARdrct', & 'PARdffs', 'Wind ', 'RefH '], & - ! SRC_ID = DATAATM(i), & - SRC_ID = DATAATM(1), & + SRC_ID = METFORCE, & DST_ID = LANDPERT(i), & rc = status & ) @@ -229,15 +223,14 @@ subroutine SetServices(gc, rc) rc = status & ) VERIFY_(status) - ! -DATAATM-feeds-LAND's-imports- + ! -METFORCE-feeds-LAND's-imports- call MAPL_AddConnectivity( & gc, & SRC_NAME = ['Psurf', 'RefH ', & 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & - ! SRC_ID = DATAATM(i), & - SRC_ID = DATAATM(1), & + SRC_ID = METFORCE, & DST_NAME = ['PS ', 'DZ ', & 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & @@ -247,34 +240,34 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) ! -CATCH-feeds-LANDPERT's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['TC ','CATDEF ','RZEXC ','SRFEXC ','WESNN1 ','WESNN2 ','WESNN3 ', & - 'GHTCNT1','GHTCNT2','GHTCNT3','GHTCNT4','GHTCNT5','GHTCNT6', & - 'HTSNNN1','HTSNNN2','HTSNNN3','SNDZN1 ','SNDZN2 ','SNDZN3 '], & - SRC_ID = LAND(i), & - DST_NAME = ['TCPert ','CATDEFPert ','RZEXCPert ','SRFEXCPert ','WESNN1Pert ',& - 'WESNN2Pert ','WESNN3Pert ','GHTCNT1Pert','GHTCNT2Pert', & - 'GHTCNT3Pert','GHTCNT4Pert','GHTCNT5Pert','GHTCNT6Pert', & - 'HTSNNN1Pert','HTSNNN2Pert','HTSNNN3Pert','SNDZN1Pert ', & - 'SNDZN2Pert ','SNDZN3Pert '], & - DST_ID = LANDPERT(i), & - rc = status & + call MAPL_AddConnectivity( & + gc, & + SRC_NAME = ['TC ','CATDEF ','RZEXC ','SRFEXC ','WESNN1 ','WESNN2 ','WESNN3 ', & + 'GHTCNT1','GHTCNT2','GHTCNT3','GHTCNT4','GHTCNT5','GHTCNT6', & + 'HTSNNN1','HTSNNN2','HTSNNN3','SNDZN1 ','SNDZN2 ','SNDZN3 '], & + SRC_ID = LAND(i), & + DST_NAME = ['TCPert ','CATDEFPert ','RZEXCPert ','SRFEXCPert ','WESNN1Pert ', & + 'WESNN2Pert ','WESNN3Pert ','GHTCNT1Pert','GHTCNT2Pert', & + 'GHTCNT3Pert','GHTCNT4Pert','GHTCNT5Pert','GHTCNT6Pert', & + 'HTSNNN1Pert','HTSNNN2Pert','HTSNNN3Pert','SNDZN1Pert ', & + 'SNDZN2Pert ','SNDZN3Pert '], & + DST_ID = LANDPERT(i), & + rc = status & ) VERIFY_(status) enddo - if(assim) then - call MAPL_AddConnectivity( & - gc, & - SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & - 'BF1 ', 'BF2 ','BF3 ','CDCR1 ','CDCR2 ','ARS1 ', & - 'ARS2 ', 'ARS3 ','ARA1 ','ARA2 ','ARA3 ','ARA4 ', & - 'ARW1 ', 'ARW2 ','ARW3 ','ARW4 ','TSA1 ','TSA2 ','TSB1 ', & - 'TSB2 ', 'ATAU ','BTAU ','ITY ','Z2CH ' ], & - SRC_ID = LAND(1), & - DST_ID = LANDASSIM, & - rc = status & + if(land_assim .or. mwRTM) then + call MAPL_AddConnectivity( & + gc, & + SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & + 'BF1 ', 'BF2 ','BF3 ','CDCR1 ','CDCR2 ','ARS1 ', & + 'ARS2 ', 'ARS3 ','ARA1 ','ARA2 ','ARA3 ','ARA4 ', & + 'ARW1 ', 'ARW2 ','ARW3 ','ARW4 ','TSA1 ','TSA2 ','TSB1 ', & + 'TSB2 ', 'ATAU ','BTAU ','ITY ','Z2CH ' ], & + SRC_ID = LAND(1), & + DST_ID = LANDASSIM, & + rc = status & ) VERIFY_(status) endif @@ -418,7 +411,6 @@ subroutine Initialize(gc, import, export, clock, rc) call esmf2ldas(CurrentTime, start_time, rc=status) VERIFY_(status) - call MAPL_GetResource(MAPL,LDAS_logit,'LDAS_logit:',default = "NO",rc = status) VERIFY_(status) @@ -661,8 +653,8 @@ subroutine Initialize(gc, import, export, clock, rc) tcinternal%grid_f = tile_grid_f tcinternal%grid_l = tile_grid_l - call MAPL_GetObjectFromGC(gcs(DATAATM(1)), CHILD_MAPL, rc=status) - VERIFY_(status) ! CHILD = DATAATM + call MAPL_GetObjectFromGC(gcs(METFORCE), CHILD_MAPL, rc=status) + VERIFY_(status) ! CHILD = METFORCE call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) @@ -670,7 +662,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! CHILD = ens_avg call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) - call ESMF_UserCompSetInternalState(gcs(DATAATM(1)), 'TILE_COORD', tcwrap, status) + call ESMF_UserCompSetInternalState(gcs(METFORCE), 'TILE_COORD', tcwrap, status) VERIFY_(status) do i = 1,NUM_ENSEMBLE @@ -678,10 +670,6 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) - !call MAPL_GetObjectFromGC(gcs(DATAATM(i)), CHILD_MAPL, rc=status) - !VERIFY_(status) ! CHILD = DATAATM - !call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) - !VERIFY_(status) call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = LANDPERT call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) @@ -693,7 +681,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) enddo - if (assim) then + if (land_assim .or. mwRTM) then call MAPL_GetObjectFromGC(gcs(LANDASSIM), CHILD_MAPL, rc=status) VERIFY_(status) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) @@ -839,7 +827,7 @@ subroutine Run(gc, import, export, clock, rc) enddo - igc = DATAATM(1) + igc = METFORCE call MAPL_TimerOn(MAPL, gcnames(igc)) call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, userRC=status) VERIFY_(status) @@ -877,9 +865,17 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=2, userRC=status) VERIFY_(status) + + if( mwRTM ) then + ! calculate ensemble-average L-band Tb (add up and normalize after last member has been added) + call ESMF_GridCompRun(gcs(LANDASSIM), importState=gex(igc), exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) + VERIFY_(status) + endif endif ! Should this be moved to the beginning of the loop to avoid the pollution ? + ! THIS MUST BE MOVED AT LEAST TO BEFORE THE "ENSAVG/phase=3" CALL IF ENSEMBLE STATS OTHER THAN THE AVERAGE + ! ARE COMPUTED - reichle, 14 May 2020 ! ApplyPrognPert igc = LANDPERT(i) call MAPL_TimerOn(MAPL, gcnames(igc)) @@ -890,7 +886,7 @@ subroutine Run(gc, import, export, clock, rc) enddo !run land assim - if (assim) then + if (land_assim) then igc = LANDASSIM call MAPL_TimerOn(MAPL, gcnames(igc)) !import state is the export from ens_GridComp, assimilation run diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index b0e7636b..5aa17990 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -3,154 +3,173 @@ !============================================================================= module GEOS_LandAssimGridCompMod -!BOP -! !DESCRIPTION: -! -! {\tt Obs} is a gridded component to -! {\tt Obs} has no children. - -! -! !USES: - + !BOP + ! !DESCRIPTION: + ! + ! {\tt Obs} is a gridded component to + ! {\tt Obs} has no children. + + ! + ! !USES: + use ESMF use MAPL_Mod - use ESMF_CFIOMOD, only: ESMF_CFIOstrTemplate - !USE GEOS_MOD - - use LDAS_TileCoordType, only: tile_coord_type - use LDAS_TileCoordType, only: grid_def_type - use LDAS_TileCoordType, only: T_TILECOORD_STATE - use LDAS_TileCoordType, only: TILECOORD_WRAP - - use enkf_types, only: obs_type,obs_param_type - use nr_ran2_gasdev, ONLY: & - NRANDSEED, init_randseed - use land_pert_routines, only: get_init_pert_rseed - use LDAS_ensdrv_mpi, only: mpicomm,numprocs,myid - use LDAS_ensdrv_mpi, only: master_proc - use LDAS_ensdrv_mpi, only: MPI_obs_param_type + use ESMF_CFIOMOD, only: ESMF_CFIOstrTemplate - use LDAS_DateTimeMod,ONLY: date_time_type - use LDAS_ensdrv_Globals, only: logunit - - use LDAS_ConvertMod, ONLY: esmf2ldas - use LDAS_DriverTypes, ONLY: & - met_force_type - - use GEOS_LandPertGridCompMod, only: N_force_pert, N_progn_pert - use GEOS_LandPertGridCompMod, only: progn_pert_param - use GEOS_LandPertGridCompMod, only: force_pert_param -! use GEOS_LandPertGridCompMod, only: pert_rseed=>pert_iseed - - use lsm_routines, only: DZGT - use GEOS_EnsGridCompMod, only: cat_progn=>catch_progn - use GEOS_EnsGridCompMod, only: cat_param=>catch_param - use mwRTM_types, only: mwRTM_param_type - use catch_bias_types, only: obs_bias_type - use catch_bias_types, only: cat_bias_param_type - use catch_types, only: cat_progn_type - use catch_types, only: cat_param_type - use catch_types, only: assignment(=), operator (+), operator (/) - use clsm_bias_routines, only: initialize_obs_bias - use clsm_bias_routines, only: read_cat_bias_inputs - - use clsm_ensupd_upd_routines, only: read_ens_upd_inputs - use clsm_ensupd_upd_routines, only: finalize_obslog - use clsm_ensupd_glob_param, only: echo_clsm_ensupd_glob_param - use clsm_ensupd_enkf_update, only: get_enkf_increments - use clsm_ensupd_enkf_update, only: apply_enkf_increments - use clsm_ensupd_enkf_update, only: output_incr_etc - use clsm_ensupd_enkf_update, only: write_smapL4SMaup - use clsm_ensdrv_out_routines, only: init_log, GEOS_output_smapL4SMlmc - use, intrinsic :: ieee_arithmetic - -implicit none - -include 'mpif.h' + use LDAS_TileCoordType, only: tile_coord_type + use LDAS_TileCoordType, only: grid_def_type + use LDAS_TileCoordType, only: T_TILECOORD_STATE + use LDAS_TileCoordType, only: TILECOORD_WRAP + + use enkf_types, only: obs_type,obs_param_type + use nr_ran2_gasdev, only: NRANDSEED, init_randseed + use land_pert_routines, only: get_init_pert_rseed + use LDAS_ensdrv_mpi, only: mpicomm,numprocs,myid + use LDAS_ensdrv_mpi, only: master_proc + use LDAS_ensdrv_mpi, only: MPI_obs_param_type + + use LDAS_DateTimeMod, only: date_time_type + use LDAS_ensdrv_Globals, only: logunit, nodata_generic + + use LDAS_ConvertMod, only: esmf2ldas + use LDAS_DriverTypes, only: met_force_type + + use GEOS_LandPertGridCompMod, only: N_force_pert, N_progn_pert + use GEOS_LandPertGridCompMod, only: progn_pert_param + use GEOS_LandPertGridCompMod, only: force_pert_param + + use lsm_routines, only: DZGT + use GEOS_EnsGridCompMod, only: cat_progn=>catch_progn + use GEOS_EnsGridCompMod, only: cat_param=>catch_param + use mwRTM_types, only: mwRTM_param_type, mwRTM_param_nodata_check + use catch_bias_types, only: obs_bias_type + use catch_bias_types, only: cat_bias_param_type + use catch_types, only: cat_progn_type + use catch_types, only: cat_param_type + use catch_types, only: assignment(=), operator (+), operator (/) + use clsm_bias_routines, only: initialize_obs_bias + use clsm_bias_routines, only: read_cat_bias_inputs + + use clsm_ensupd_upd_routines, only: read_ens_upd_inputs + use clsm_ensupd_upd_routines, only: finalize_obslog + use clsm_ensupd_glob_param, only: echo_clsm_ensupd_glob_param + use clsm_ensupd_enkf_update, only: get_enkf_increments + use clsm_ensupd_enkf_update, only: apply_enkf_increments + use clsm_ensupd_enkf_update, only: output_incr_etc + use clsm_ensupd_enkf_update, only: write_smapL4SMaup + use clsm_ensdrv_out_routines, only: init_log, GEOS_output_smapL4SMlmc + use mwRTM_routines, only : mwRTM_get_Tb, catch2mwRTM_vars -private + use, intrinsic :: ieee_arithmetic -! !PUBLIC MEMBER FUNCTIONS: -public :: SetServices -! -!EOP -! -integer, parameter :: NUM_SUBTILES = 4 -integer :: NUM_ENSEMBLE -integer :: FIRST_ENS_ID - -type(met_force_type), allocatable :: mfPert_ensavg(:) - -type(obs_param_type),pointer :: obs_param(:)=>null() -logical :: need_mwRTM_param -integer :: update_type, dtstep_assim -logical :: centered_update -real :: xcompact, ycompact -real :: fcsterr_inflation_fac -integer :: N_obs_param -logical :: out_obslog -logical :: out_ObsFcstAna -logical :: out_smapL4SMaup -integer :: N_obsbias_max - -integer,dimension(:),pointer :: N_catl_vec,low_ind -integer :: N_catf -!reordered tile_coord_rf and mapping l2rf -integer,dimension(:),pointer :: l2rf, rf2l,rf2g, rf2f -type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() -integer, allocatable :: Pert_rseed(:,:) -real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) + implicit none -contains + include 'mpif.h' + + private + + ! !PUBLIC MEMBER FUNCTIONS: + + public :: SetServices + ! + !EOP + ! + integer, parameter :: NUM_SUBTILES = 4 + integer :: NUM_ENSEMBLE + integer :: FIRST_ENS_ID + integer :: collect_tb_counter + + type(met_force_type), allocatable :: mfPert_ensavg(:) + + type(obs_param_type), pointer :: obs_param(:)=>null() + + integer :: update_type, dtstep_assim + logical :: centered_update + real :: xcompact, ycompact + real :: fcsterr_inflation_fac + integer :: N_obs_param + logical :: out_obslog + logical :: out_ObsFcstAna + logical :: out_smapL4SMaup + integer :: N_obsbias_max + + integer, dimension(:), pointer :: N_catl_vec,low_ind + integer :: N_catf -!BOP -! !IROUTINE: SetServices -- Sets ESMF services for component -! !INTERFACE: + !reordered tile_coord_rf and mapping l2rf + integer, dimension(:), pointer :: l2rf, rf2l,rf2g, rf2f + type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() -subroutine SetServices ( GC, RC ) + integer, allocatable :: Pert_rseed( :,:) + real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) + type(mwRTM_param_type), dimension(:), allocatable :: mwRTM_param -! !ARGUMENTS: + logical :: mwRTM_all_nodata ! no data for mwRTM_param + logical :: land_assim + logical :: mwRTM +contains + + !BOP + ! !IROUTINE: SetServices -- Sets ESMF services for component + ! !INTERFACE: + + subroutine SetServices ( GC, RC ) + + ! !ARGUMENTS: + type(ESMF_GridComp),intent(INOUT) :: GC integer, optional, intent( OUT) :: RC - -! !DESCRIPTION: - -!EOP -! -! ErrLog Variables - - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: COMP_NAME - integer :: STATUS - -! Local Variables + + ! !DESCRIPTION: + + !EOP + ! + ! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + ! Local Variables type(MAPL_MetaComp), pointer :: MAPL=>null() - type(ESMF_Config) :: CF -! Begin... -! -------- - -! Get my name and set-up traceback handle -! ------------------------------------------------------------------------------ + type(ESMF_Config) :: CF + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file + ! Begin... + ! -------- + + ! Get my name and set-up traceback handle + ! ------------------------------------------------------------------------------ + Iam='SetServices' call ESMF_GridCompGet ( GC, NAME=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) Iam=trim(COMP_NAME)//trim(Iam) - + call MAPL_GetObjectFromGC(gc, MAPL, rc=status) - VERIFY_(status) + _VERIFY(status) + + call MAPL_GetResource ( MAPL, LAND_ASSIM_STR, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) + VERIFY_(STATUS) + LAND_ASSIM_STR = ESMF_UtilStringUpperCase(LAND_ASSIM_STR, rc=STATUS) + VERIFY_(STATUS) + land_assim = (trim(LAND_ASSIM_STR) /= 'NO') - ! Register services for this component + call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) + VERIFY_(STATUS) + mwRTM = ( len_trim(mwRTM_file) /= 0 ) + + ! Register services for this component call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_INITIALIZE, & Initialize, & rc=status & ) - VERIFY_(status) - + _VERIFY(status) + !phase 1: assimilation run call MAPL_GridCompSetEntryPoint( & gc, & @@ -158,8 +177,8 @@ subroutine SetServices ( GC, RC ) RUN, & rc=status & ) - VERIFY_(status) - + _VERIFY(status) + !phase 2: feed back to change catch_progn call MAPL_GridCompSetEntryPoint( & gc, & @@ -167,592 +186,599 @@ subroutine SetServices ( GC, RC ) UPDATE_ASSIM, & rc=status & ) - VERIFY_(status) - + _VERIFY(status) + + !phase 3: calculation of ensemble average of L-band Tb_h and Tb_v + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + CALC_LAND_TB, & + rc=status & + ) + _VERIFY(status) + call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_FINALIZE, & Finalize, & rc=status & ) - VERIFY_(status) - - - -! Set the state variable specs. -! ----------------------------- -!BOS -! -! IMPORT STATE: -! -! --------------------------------- - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'soil_porosity' ,& - UNITS = '1' ,& - SHORT_NAME = 'POROS' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'sfc_sat_hydraulic_conduct' ,& - UNITS = 'm s-1' ,& - SHORT_NAME = 'COND' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'saturated_matric_potential',& - UNITS = 'm' ,& - SHORT_NAME = 'PSIS' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'clapp_hornberger_b' ,& - UNITS = '1' ,& - SHORT_NAME = 'BEE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_at_wilting_point' ,& - UNITS = '1' ,& - SHORT_NAME = 'WPWET' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'vertical_transmissivity' ,& - UNITS = 'm-1' ,& - SHORT_NAME = 'GNU' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'max_rootzone_water_content',& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'VGWMAX' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'topo_baseflow_param_1' ,& - UNITS = 'kg m-4' ,& - SHORT_NAME = 'BF1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'topo_baseflow_param_2' ,& - UNITS = 'm' ,& - SHORT_NAME = 'BF2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'topo_baseflow_param_3' ,& - UNITS = 'log(m)' ,& - SHORT_NAME = 'BF3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'moisture_threshold' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CDCR1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'max_water_content' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CDCR2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_param_1' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARS1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_param_2' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARS2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_param_3' ,& - UNITS = 'm+4 kg-2' ,& - SHORT_NAME = 'ARS3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_1' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARA1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_2' ,& - UNITS = '1' ,& - SHORT_NAME = 'ARA2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_3' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARA3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_4' ,& - UNITS = '1' ,& - SHORT_NAME = 'ARA4' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_1' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARW1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_2' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARW2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_3' ,& - UNITS = 'm+4 kg-2' ,& - SHORT_NAME = 'ARW3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_4' ,& - UNITS = '1' ,& - SHORT_NAME = 'ARW4' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_1' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSA1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_2' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSA2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_3' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSB1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_4' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSB2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_5' ,& - UNITS = '1' ,& - SHORT_NAME = 'ATAU' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_6' ,& - UNITS = '1' ,& - SHORT_NAME = 'BTAU' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'ITY' ,& - LONG_NAME = 'vegetation_type' ,& - UNITS = '1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'Z2CH' ,& - LONG_NAME = 'vegetation_height' ,& - UNITS = 'm' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(status) + + + ! Set the state variable specs. + ! ----------------------------- + !BOS + ! + ! IMPORT STATE: + ! + ! --------------------------------- + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'soil_porosity' ,& + UNITS = '1' ,& + SHORT_NAME = 'POROS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'sfc_sat_hydraulic_conduct' ,& + UNITS = 'm s-1' ,& + SHORT_NAME = 'COND' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'saturated_matric_potential',& + UNITS = 'm' ,& + SHORT_NAME = 'PSIS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'clapp_hornberger_b' ,& + UNITS = '1' ,& + SHORT_NAME = 'BEE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_at_wilting_point' ,& + UNITS = '1' ,& + SHORT_NAME = 'WPWET' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'vertical_transmissivity' ,& + UNITS = 'm-1' ,& + SHORT_NAME = 'GNU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'max_rootzone_water_content',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'VGWMAX' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_1' ,& + UNITS = 'kg m-4' ,& + SHORT_NAME = 'BF1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_2' ,& + UNITS = 'm' ,& + SHORT_NAME = 'BF2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_3' ,& + UNITS = 'log(m)' ,& + SHORT_NAME = 'BF3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'moisture_threshold' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CDCR1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'max_water_content' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CDCR2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARS1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_param_2' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARS2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_param_3' ,& + UNITS = 'm+4 kg-2' ,& + SHORT_NAME = 'ARS3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARA1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_2' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARA2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_3' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARA3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARA4' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARW1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_2' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARW2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_3' ,& + UNITS = 'm+4 kg-2' ,& + SHORT_NAME = 'ARW3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARW4' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_1' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSA1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_2' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSA2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_3' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSB1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSB2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_5' ,& + UNITS = '1' ,& + SHORT_NAME = 'ATAU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_6' ,& + UNITS = '1' ,& + SHORT_NAME = 'BTAU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'ITY' ,& + LONG_NAME = 'vegetation_type' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'Z2CH' ,& + LONG_NAME = 'vegetation_height' ,& + UNITS = 'm' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + -! -! Export for incr -! + ! Exports for brightness temperature + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Hpol' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TB_LAND_1410MHZ_40DEG_HPOL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Vpol' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TB_LAND_1410MHZ_40DEG_VPOL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + ! Exports for Catchment prognostics increments + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_saturated_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFSAT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_transition_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFTRN_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_wilting_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFWLT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFSAT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_transition_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFTRN_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFWLT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_interception_reservoir_capac' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CAPAC_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_catchment_deficit' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CATDEF_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_root_zone_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RZEXC_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_surface_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'SRFEXC_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_2' ,& + UNITS = 'J_m-2' ,& + SHORT_NAME = 'GHTCNT2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_4' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT4_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_5' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT5_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_6' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT6_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_1' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_2' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_3' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_2' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_1' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_2' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_3' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_temperature_saturated_zone' ,& - UNITS = 'K' ,& - SHORT_NAME = 'TCFSAT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_temperature_transition_zone' ,& - UNITS = 'K' ,& - SHORT_NAME = 'TCFTRN_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_temperature_wilting_zone' ,& - UNITS = 'K' ,& - SHORT_NAME = 'TCFWLT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone' ,& - UNITS = 'kg kg-1' ,& - SHORT_NAME = 'QCFSAT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_specific_humidity_transition_zone' ,& - UNITS = 'kg kg-1' ,& - SHORT_NAME = 'QCFTRN_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone' ,& - UNITS = 'kg kg-1' ,& - SHORT_NAME = 'QCFWLT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_interception_reservoir_capac',& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CAPAC_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_catchment_deficit' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CATDEF_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_root_zone_excess' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'RZEXC_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_surface_excess' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'SRFEXC_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_1' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_2' ,& - UNITS = 'J_m-2' ,& - SHORT_NAME = 'GHTCNT2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_3' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_4' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT4_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_5' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT5_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_6' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT6_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_mass_layer_1' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'WESNN1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_mass_layer_2' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'WESNN2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_mass_layer_3' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'WESNN3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_heat_content_snow_layer_1' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'HTSNNN1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_heat_content_snow_layer_2' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'HTSNNN2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_heat_content_snow_layer_3' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'HTSNNN3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_depth_layer_1' ,& - UNITS = 'm' ,& - SHORT_NAME = 'SNDZN1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_depth_layer_2' ,& - UNITS = 'm' ,& - SHORT_NAME = 'SNDZN2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_depth_layer_3' ,& - UNITS = 'm' ,& - SHORT_NAME = 'SNDZN3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) + ! + ! INTERNAL STATE + ! -! -! INTERNAL STATE -! - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Vegetation class. Type is Unsigned32' ,& - UNITS = '1' ,& - SHORT_NAME = 'MWRTM_VEGCLS' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& + UNITS = '1' ,& + SHORT_NAME = 'MWRTM_VEGCLS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Soil class. Type is Unsigned32' ,& UNITS = '1' ,& SHORT_NAME = 'MWRTM_SOILCLS' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Sand fraction' ,& UNITS = '1' ,& SHORT_NAME = 'MWRTM_SAND' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Clay fraction' ,& UNITS = '1' ,& SHORT_NAME = 'MWRTM_CLAY' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -761,7 +787,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_POROS' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -770,7 +796,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_WANGWT' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -779,7 +805,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_WANGWP' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -788,7 +814,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHHMIN' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -797,25 +823,25 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHHMAX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Soil moisture value below which maximum microwave roughness parameter is used' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'MWRTM_RGHWMIN' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Soil moisture value above which minimum microwave roughness parameter is used' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'MWRTM_RGHWMAX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -824,7 +850,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHNRH' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -833,7 +859,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHNRV' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -842,7 +868,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHPOLMIX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -851,7 +877,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_OMEGA' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -860,7 +886,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_BH' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -869,7 +895,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_BV' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -878,59 +904,59 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_LEWT' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_TimerAdd(GC, name="Initialize" ,RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_TimerAdd(GC, name="RUN" ,RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GenericSetServices ( GC, RC=STATUS ) - VERIFY_(STATUS) - + _VERIFY(STATUS) + RETURN_(ESMF_SUCCESS) - -end subroutine SetServices - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!BOP -! !IROTUINE: Initialize -- initialize method for LandAssim GC - -! !INTERFACE: -subroutine Initialize(gc, import, export, clock, rc) - + + end subroutine SetServices + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !BOP + ! !IROTUINE: Initialize -- initialize method for LandAssim GC + + ! !INTERFACE: + subroutine Initialize(gc, import, export, clock, rc) + ! !ARGUMENTS: - + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component type(ESMF_State), intent(inout) :: import ! Import state type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code - + integer :: status - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: comp_name - - ! ESMF variables - type(ESMF_Time) :: CurrentTime - type(ESMF_Alarm) :: LandAssimAlarm - type(ESMF_TimeInterval) :: LandAssim_DT - integer :: LandAssimDTstep - type(ESMF_TimeInterval) :: ModelTimeStep + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: comp_name + + ! ESMF variables + type(ESMF_Time) :: CurrentTime + type(ESMF_Alarm) :: LandAssimAlarm + type(ESMF_TimeInterval) :: LandAssim_DT + integer :: LandAssimDTstep + type(ESMF_TimeInterval) :: ModelTimeStep ! locals type(MAPL_MetaComp), pointer :: MAPL=>null() - type(MAPL_LocStream) :: locstream + type(MAPL_LocStream) :: locstream - character(len=300) :: out_path,fname - character(len=ESMF_MAXSTR) :: exp_id, GridName - integer :: model_dtstep - type(date_time_type) :: start_time + character(len=300) :: out_path,fname + character(len=ESMF_MAXSTR) :: exp_id, GridName + integer :: model_dtstep + type(date_time_type) :: start_time - ! LDAS' tile_coord variable + ! LDAS' tile_coord variable type(T_TILECOORD_STATE), pointer :: tcinternal - type(TILECOORD_WRAP) :: tcwrap + type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), dimension(:), pointer :: tile_coord_f => null() type(tile_coord_type), dimension(:), pointer :: tile_coord_l => null() @@ -938,67 +964,80 @@ subroutine Initialize(gc, import, export, clock, rc) integer :: land_nt_local,i,mpierr, ens ! mapping f to re-orderd f so it is continous for mpi_gather ! rf -- ordered by processors. Within the processor, ordered by MAPL grid - integer,allocatable :: f2rf(:) ! mapping re-orderd rf to f for the LDASsa output - type(grid_def_type) :: tile_grid_g - type(grid_def_type) :: tile_grid_f - character(len=300) :: seed_fname - character(len=300) :: fname_tpl - character(len=14) :: datestamp - character(len=4) :: id_string - integer :: nymd, nhms -!! from LDASsa + integer, allocatable :: f2rf(:) ! mapping re-orderd rf to f for the LDASsa output + type(grid_def_type) :: tile_grid_g + type(grid_def_type) :: tile_grid_f + character(len=300) :: seed_fname + character(len=300) :: fname_tpl + character(len=14) :: datestamp + character(len=4) :: id_string + integer :: nymd, nhms + !! from LDASsa + ! Begin... - + ! Get component's name and setup traceback handle call ESMF_GridCompget(gc, name=comp_name, rc=status) - VERIFY_(status) + _VERIFY(status) Iam = trim(comp_name) // "::Initialize" ! Get MAPL obj call MAPL_GetObjectFromGC(gc, MAPL, rc=status) - VERIFY_(status) - + _VERIFY(status) + ! Turn timers on call MAPL_TimerOn(MAPL, "TOTAL") call MAPL_TimerOn(MAPL, "Initialize") - call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - VERIFY_(STATUS) + collect_tb_counter = 0 call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) - VERIFY_(STATUS) - + _VERIFY(STATUS) call init_log( myid, numprocs, master_proc ) - + + if ( .not. land_assim) then ! to arrive here, mwRTM must be .true. + ! only need to calculate Tb for HISTORY; no processing of assimilation obs necessary; + ! generic initialization is sufficient + call MAPL_GenericInitialize(gc, import, export, clock, rc=status) + _VERIFY(status) + + call MAPL_TimerOff(MAPL, "Initialize") + call MAPL_TimerOff(MAPL, "TOTAL") + RETURN_(ESMF_SUCCESS) + endif + + call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) + _VERIFY(STATUS) + ! Get current time call ESMF_ClockGet(clock, currTime=CurrentTime, rc=status) - VERIFY_(status) + _VERIFY(status) call esmf2ldas(CurrentTime, start_time, rc=status) - VERIFY_(status) - + _VERIFY(status) + call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) - VERIFY_(status) + _VERIFY(status) call ESMF_TimeIntervalGet(ModelTimeStep, s=model_dtstep,rc=status) - VERIFY_(status) - + _VERIFY(status) + ! Create alarm for Land assimilation ! -create-nonsticky-alarm- - ! -time-interval- + ! -time-interval- call MAPL_GetResource( & MAPL, & - LandAssimDtStep, & - 'LANDASSIM_DTSTEP:', & - default=10800, & + LandAssimDtStep, & + 'LANDASSIM_DTSTEP:', & + default=10800, & rc=status & ) - VERIFY_(status) - + _VERIFY(status) + call ESMF_TimeIntervalSet(LandAssim_DT, s=LandAssimDtStep, rc=status) - VERIFY_(status) - + _VERIFY(status) + LandAssimAlarm = ESMF_AlarmCreate( & clock, & name='LandAssim', & @@ -1008,52 +1047,52 @@ subroutine Initialize(gc, import, export, clock, rc) sticky=.false., & rc=status & ) - VERIFY_(status) + _VERIFY(status) call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) + _VERIFY(status) tcinternal =>tcwrap%ptr tile_coord_l =>tcinternal%tile_coord - ! Get number of land tiles + ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=land_nt_local,rc=status) - VERIFY_(status) - - allocate(Pert_rseed(NRANDSEED, NUM_ENSEMBLE), source = 0) + _VERIFY(status) + + allocate(Pert_rseed( NRANDSEED, NUM_ENSEMBLE), source = 0 ) allocate(Pert_rseed_r8(NRANDSEED, NUM_ENSEMBLE), source = 0.0d0) - + if (master_proc) then - + call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_RESTART_FILE:", DEFAULT="../intput/restart/landassim_obspertrseed%s_rst", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_DateStampGet( clock, datestamp, rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) read(datestamp(1:8),*) nymd read(datestamp(10:13),*) nhms nhms = nhms*100 do ens = 0, NUM_ENSEMBLE-1 - write(id_string,'(I4.4)') ens + FIRST_ENS_ID - seed_fname = "" - call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - call read_pert_rseed(seed_fname,Pert_rseed_r8(:,ens+1)) - - Pert_rseed(:,ens+1) = nint(Pert_rseed_r8(:,ens+1)) - if (all(Pert_rseed(:,ens+1) == 0)) then - call get_init_pert_rseed(ens, pert_rseed(1,ens+1)) - call init_randseed(pert_rseed(:,ens+1)) - endif + write(id_string,'(I4.4)') ens + FIRST_ENS_ID + seed_fname = "" + call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) + call read_pert_rseed(seed_fname,Pert_rseed_r8(:,ens+1)) + + Pert_rseed(:,ens+1) = nint(Pert_rseed_r8(:,ens+1)) + if (all(Pert_rseed(:,ens+1) == 0)) then + call get_init_pert_rseed(ens, pert_rseed(1,ens+1)) + call init_randseed(pert_rseed(:,ens+1)) + endif enddo endif call MPI_Bcast(pert_rseed, NRANDSEED*NUM_ENSEMBLE, MPI_INTEGER, 0, mpicomm, mpierr) - - + + allocate(N_catl_vec(numprocs)) allocate(low_ind(numprocs)) allocate(l2rf(land_nt_local)) - + call MPI_AllGATHER(land_nt_local,1,MPI_INTEGER,N_catl_vec,1,MPI_INTEGER,mpicomm,mpierr) - + low_ind(1) = 1 do i = 2, numprocs low_ind(i) = low_ind(i-1) + N_catl_vec(i-1) @@ -1063,63 +1102,63 @@ subroutine Initialize(gc, import, export, clock, rc) allocate(f2rf(N_catf)) call MPI_AllGATHERV(tcinternal%l2f, land_nt_local, MPI_INTEGER, & - rf2f, N_catl_vec, low_ind-1, MPI_INTEGER, & - mpicomm,mpierr) - + rf2f, N_catl_vec, low_ind-1, MPI_INTEGER, & + mpicomm,mpierr) + allocate(tile_coord_rf(N_catf)) tile_coord_rf(:) = tcwrap%ptr%tile_coord_f(rf2f(:)) allocate(rf2g(N_catf)) rf2g(:) = tile_coord_rf(:)%tile_id - + do i=1,N_catf - f2rf(rf2f(i))= i - tile_coord_rf(i)%f_num = i + f2rf(rf2f(i))= i + tile_coord_rf(i)%f_num = i enddo - + do i=1, land_nt_local l2rf(i) = low_ind(myid+1) + i - 1 end do - + tcwrap%ptr%tile_coord%f_num = l2rf - - ! invert mapping from local to full grid (get f2l from l2f) - + + ! invert mapping from local to full grid (get f2l from l2f) + allocate(rf2l(N_catf)) - + rf2l = -9999 - + do i=1,land_nt_local - rf2l( l2rf(i) ) = i + rf2l( l2rf(i) ) = i end do if (master_proc) then - call read_ens_upd_inputs( & - trim(out_path), & - trim(exp_id), & - start_time, & - model_dtstep, & - N_catf, tile_coord_rf, & - N_progn_pert, progn_pert_param, & - N_force_pert, force_pert_param, & - need_mwRTM_param, & - update_type, & - dtstep_assim, & - centered_update, & - xcompact, ycompact, & - fcsterr_inflation_fac, & - N_obs_param, & - obs_param, & - out_obslog, & - out_ObsFcstAna, & - out_smapL4SMaup, & - N_obsbias_max & - ) - call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) - VERIFY_(STATUS) - if (index(GridName,"-CF") /=0) out_smapL4SMaup = .false. ! no out_smap for now if it is cs frid + call read_ens_upd_inputs( & + trim(out_path), & + trim(exp_id), & + start_time, & + model_dtstep, & + N_catf, tile_coord_rf, & + N_progn_pert, progn_pert_param, & + N_force_pert, force_pert_param, & + mwRTM, & ! ensure mwRTM=.true. when microwave Tb obs are assimilated + update_type, & + dtstep_assim, & + centered_update, & + xcompact, ycompact, & + fcsterr_inflation_fac, & + N_obs_param, & + obs_param, & + out_obslog, & + out_ObsFcstAna, & + out_smapL4SMaup, & + N_obsbias_max & + ) + call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) + _VERIFY(STATUS) + if (index(GridName,"-CF") /=0) out_smapL4SMaup = .false. ! no out_smap for now if it is cs grid endif - - call MPI_BCAST(need_mwRTM_param, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) + + call MPI_BCAST(mwRTM, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(update_type, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(dtstep_assim, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(centered_update, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) @@ -1131,107 +1170,88 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_BCAST(out_ObsFcstAna, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr) - - if (.not. master_proc) allocate(obs_param(N_obs_param)) - + + if (.not. master_proc) allocate(obs_param(N_obs_param)) + call MPI_BCAST(obs_param, N_obs_param, MPI_OBS_PARAM_TYPE, 0,MPICOMM,mpierr) - + if (master_proc) call echo_clsm_ensupd_glob_param(logunit) - + call MAPL_GenericInitialize(gc, import, export, clock, rc=status) - VERIFY_(status) - + _VERIFY(status) + call MAPL_TimerOff(MAPL, "Initialize") call MAPL_TimerOff(MAPL, "TOTAL") - + RETURN_(ESMF_SUCCESS) - -end subroutine Initialize - -! !IROUTINE: RUN -! !INTERFACE: -subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) - -! !ARGUMENTS: - + + end subroutine Initialize + + ! !IROUTINE: RUN + ! !INTERFACE: + subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) + + ! !ARGUMENTS: + type(ESMF_GridComp),intent(inout) :: GC !Gridded component type(ESMF_State), intent(inout) :: IMPORT !Import state type(ESMF_State), intent(inout) :: EXPORT !Export state type(ESMF_Clock), intent(inout) :: CLOCK !The clock integer,optional, intent(out ) :: RC !Error code: + + !EOP + ! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + ! + ! time + ! + type(ESMF_Time) :: ModelTimeCur, ModelTimeNxt + type(ESMF_Alarm) :: LandAssimAlarm + type(ESMF_TimeInterval) :: ModelTimeStep + + + ! Locals + type(MAPL_MetaComp), pointer :: MAPL=>null() + type(TILECOORD_WRAP) :: tcwrap + type(tile_coord_type), pointer :: tile_coord_l(:)=>null() + type(T_TILECOORD_STATE), pointer :: tcinternal -!EOP -! ErrLog Variables - - character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME -! -! time -! - type(ESMF_Time) :: ModelTimeCur, ModelTimeNxt - type(ESMF_Alarm) :: LandAssimAlarm - type(ESMF_TimeInterval) :: ModelTimeStep - + type(ESMF_State) :: INTERNAL + type(date_time_type) :: start_time + type(date_time_type) :: date_time_new + character(len=14) :: datestamp -! Locals - type(MAPL_MetaComp), pointer :: MAPL=>null() - type(TILECOORD_WRAP) :: tcwrap - type(tile_coord_type), pointer :: tile_coord_l(:)=>null() - type(T_TILECOORD_STATE), pointer :: tcinternal - type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param + integer :: N_catl, N_catg,N_obsl_max, n_e, i - type(ESMF_State) :: INTERNAL - type(date_time_type) :: start_time - type(date_time_type) :: date_time_new - character(len=14) :: datestamp + character(len=300) :: out_path + character(len=ESMF_MAXSTR) :: exp_id + character(40) :: exp_domain + integer :: model_dtstep - integer :: N_catl, N_catg,N_obsl_max, n_e, i + type(met_force_type), dimension(:), allocatable :: met_force - character(len=300) :: out_path - character(len=ESMF_MAXSTR) :: exp_id - character(40) :: exp_domain - integer :: model_dtstep - type(met_force_type), dimension(:), allocatable :: met_force + integer :: N_adapt_R + type(MAPL_LocStream) :: locstream + + integer, dimension(:), allocatable :: obs_pert_adapt_param + real, dimension(:,:), allocatable :: Pert_adapt_R + real, dimension(:,:), allocatable :: Obs_pert + type(obs_bias_type), dimension(:,:,:), allocatable :: obs_bias + + type(cat_progn_type), dimension(:,:), allocatable :: cat_progn_incr + type(cat_progn_type), dimension(:), allocatable :: cat_progn_incr_ensavg + + type(obs_type), dimension(:), pointer :: Observations_l => null() - integer :: N_adapt_R - type(MAPL_LocStream) :: locstream - integer,dimension(:),allocatable :: obs_pert_adapt_param - real,dimension(:,:), allocatable :: Pert_adapt_R - real,dimension(:,:), allocatable :: Obs_pert - type(obs_bias_type), dimension(:,:,:), allocatable :: obs_bias - - type(cat_progn_type), dimension(:,:), allocatable :: cat_progn_incr - type(cat_progn_type), dimension(:), allocatable :: cat_progn_incr_ensavg - type(obs_type), dimension(:), pointer :: Observations_l => null() logical :: fresh_incr integer :: N_obsf,N_obsl integer :: secs_in_day -! ----------------------------------------------------- -! INTERNAL Pointers -! ----------------------------------------------------- - - real, dimension(:), pointer :: VEGCLS - real, dimension(:), pointer :: SOILCLS - real, dimension(:), pointer :: SAND - real, dimension(:), pointer :: CLAY - real, dimension(:), pointer :: mw_POROS - real, dimension(:), pointer :: WANGWT - real, dimension(:), pointer :: WANGWP - real, dimension(:), pointer :: RGHHMIN - real, dimension(:), pointer :: RGHHMAX - real, dimension(:), pointer :: RGHWMAX - real, dimension(:), pointer :: RGHWMIN - real, dimension(:), pointer :: RGHNRH - real, dimension(:), pointer :: RGHNRV - real, dimension(:), pointer :: RGHPOLMIX - real, dimension(:), pointer :: OMEGA - real, dimension(:), pointer :: BH - real, dimension(:), pointer :: BV - real, dimension(:), pointer :: LEWT - -!! import ensemble forcing + !! import ensemble forcing + real, pointer :: TA_enavg(:)=>null() real, pointer :: QA_enavg(:)=>null() real, pointer :: PS_enavg(:)=>null() @@ -1250,8 +1270,8 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer :: SWLAND(:)=>null() real, pointer :: LAI(:)=>null() -!! export incr progn - + !! export incr progn + real, dimension(:),pointer :: TC1_incr=>null() real, dimension(:),pointer :: TC2_incr=>null() real, dimension(:),pointer :: TC4_incr=>null() @@ -1279,152 +1299,102 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real, dimension(:),pointer :: SNDZN3_incr=>null() - logical :: spin + logical :: spin logical, save :: firsttime=.true. type(cat_bias_param_type) :: cat_bias_param integer :: N_catbias - character(len=300) :: seed_fname - character(len=300) :: fname_tpl - character(len=4) :: id_string - integer:: ens, nymd, nhms + character(len=300) :: seed_fname + character(len=300) :: fname_tpl + character(len=4) :: id_string + integer :: ens, nymd, nhms #ifdef DBG_LANDASSIM_INPUTS - ! vars for debugging purposes - type(ESMF_Grid) :: TILEGRID - integer, pointer :: mask(:) - integer :: nt,ens_id - integer, save :: unit_i=0 - integer :: unit - integer :: NT_GLOBAL,mpierr,i - real,allocatable :: metTair(:),metTair_l(:) - integer,allocatable :: ids(:) + ! vars for debugging purposes + type(ESMF_Grid) :: TILEGRID + integer, pointer :: mask(:) + integer :: nt, ens_counter + integer, save :: unit_i=0 + integer :: unit + integer :: NT_GLOBAL,mpierr,i + real, allocatable :: metTair(:),metTair_l(:) + integer, allocatable :: ids(:) #endif - + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" - + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) -! Start timers -! ------------ + _VERIFY(STATUS) + ! Start timers + ! ------------ call MAPL_TimerOn(MAPL,"TOTAL") call MAPL_TimerOn(MAPL,"RUN") call ESMF_ClockGetAlarm(clock, 'LandAssim', LandAssimAlarm, rc=status) - VERIFY_(status) - + _VERIFY(status) + call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - - ! Get component's internal variable + + ! Get component's internal variable call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) + _VERIFY(status) tcinternal => tcwrap%ptr tile_coord_l => tcwrap%ptr%tile_coord - + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) - VERIFY_(status) - + _VERIFY(status) + ! Get current time call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) - VERIFY_(status) + _VERIFY(status) call ESMF_ClockGet(clock, currTime=ModelTimeCur, rc=status) - VERIFY_(status) + _VERIFY(status) call esmf2ldas(ModelTimeCur+ModelTimeStep, date_time_new, rc=status) - VERIFY_(status) - + _VERIFY(status) + call esmf2ldas(ModelTimeCur, start_time, rc=status) - VERIFY_(status) - + _VERIFY(status) + ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=N_catl,rc=status) - VERIFY_(status) - -! Pointers to internals -!---------------------- - if (need_mwRTM_param) then - call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) - VERIFY_(STATUS) - - allocate(mwRTM_param(N_catl)) - mwRTM_param(:)%sand = SAND(:) - mwRTM_param(:)%vegcls = nint(VEGCLS(:)) - mwRTM_param(:)%soilcls = nint(SOILCLS(:)) - mwRTM_param(:)%clay = CLAY(:) - mwRTM_param(:)%poros = mw_POROS(:) - mwRTM_param(:)%wang_wt = WANGWT(:) - mwRTM_param(:)%wang_wp = WANGWP(:) - mwRTM_param(:)%rgh_hmin = RGHHMIN(:) - mwRTM_param(:)%rgh_hmax = RGHHMAX(:) - mwRTM_param(:)%rgh_wmin = RGHWMIN(:) - mwRTM_param(:)%rgh_wmax = RGHWMAX(:) - mwRTM_param(:)%rgh_Nrh = RGHNRH(:) - mwRTM_param(:)%rgh_Nrv = RGHNRV(:) - mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) - mwRTM_param(:)%omega = OMEGA(:) - mwRTM_param(:)%bh = BH(:) - mwRTM_param(:)%bv = bv(:) - mwRTM_param(:)%lewt = LEWT(:) + _VERIFY(status) + + ! Pointers to internals + !---------------------- + if (mwRTM) then + call get_mwrtm_param(INTERNAL, N_catl, rc=STATUS) + _VERIFY(STATUS) endif - + ! assert mwRTM parameters are not nodata for all tiles + if (mwRTM_all_nodata) then + _ASSERT(.false., "Tb innovations or assimilation requested but all mwRTM parameters are nodata") + endif + if (firsttime) then firsttime = .false. - if (need_mwRTM_param) & - call GEOS_output_smapL4SMlmc( GC, start_time, trim(out_path), trim(exp_id), & - N_catl, tile_coord_l, cat_param, mwRTM_param ) + if (mwRTM) & + call GEOS_output_smapL4SMlmc( GC, start_time, trim(out_path), trim(exp_id), & + N_catl, tile_coord_l, cat_param, mwRTM_param ) if (master_proc) then - ! for out put + ! for out put call read_cat_bias_inputs( trim(out_path), trim(exp_id), start_time, update_type, & - cat_bias_param, N_catbias) + cat_bias_param, N_catbias) endif endif - + ! The time is one model time step behind Current time, so record the checkpoint here if (MAPL_RecordAlarmIsRinging(MAPL)) then if (master_proc) then Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) fname_tpl = trim(fname_tpl) //".%y4%m2%d2_%h2%n2z.nc4" call MAPL_DateStampGet( clock, datestamp, rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) read(datestamp(1:8),*) nymd read(datestamp(10:13),*) nhms nhms = nhms*100 @@ -1432,110 +1402,110 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) write(id_string,'(I4.4)') ens + FIRST_ENS_ID seed_fname = "" call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - VERIFY_(STATUS) + _VERIFY(STATUS) call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) enddo - endif + endif endif - - + + if ( .not. ESMF_AlarmIsRinging(LandAssimAlarm)) then call MAPL_TimerOff ( MAPL, "RUN" ) call MAPL_TimerOff ( MAPL, "TOTAL" ) RETURN_(ESMF_SUCCESS) endif - + N_obsl_max = N_catl*N_obs_param - -!! get import from ens to get ensemble average forcing - - call MAPL_GetPointer(import, TA_enavg, 'TA', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, QA_enavg, 'QA', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, PS_enavg, 'PS', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, UU_enavg, 'UU', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, PCU_enavg, 'PCU', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, PLS_enavg, 'PLS', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, SNO_enavg, 'SNO', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, DRPAR_enavg, 'DRPAR', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, DFPAR_enavg, 'DFPAR', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, DRNIR_enavg, 'DRNIR', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, DFNIR_enavg, 'DFNIR', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, DRUVR_enavg, 'DRUVR', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, DFUVR_enavg, 'DFUVR', rc=status) - VERIFY_(status) + + !! get import from ens to get ensemble average forcing + + call MAPL_GetPointer(import, TA_enavg, 'TA', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, QA_enavg, 'QA', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, PS_enavg, 'PS', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, UU_enavg, 'UU', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, PCU_enavg, 'PCU', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, PLS_enavg, 'PLS', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, SNO_enavg, 'SNO', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, DRPAR_enavg, 'DRPAR', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, DFPAR_enavg, 'DFPAR', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, DRNIR_enavg, 'DRNIR', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, DFNIR_enavg, 'DFNIR', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, DRUVR_enavg, 'DRUVR', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, DFUVR_enavg, 'DFUVR', rc=status) + _VERIFY(status) call MAPL_GetPointer(import, LWDNSRF_enavg, 'LWDNSRF', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, DZ_enavg, 'DZ', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, SWLAND, 'SWLAND', rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, LAI, 'LAI', rc=status) - VERIFY_(status) + _VERIFY(status) + call MAPL_GetPointer(import, DZ_enavg, 'DZ', rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, SWLAND, 'SWLAND', rc=status) ! not _enavg + _VERIFY(status) + call MAPL_GetPointer(import, LAI, 'LAI', rc=status) + _VERIFY(status) ! ! export for incr ! - call MAPL_GetPointer(export, TC1_incr, 'TCFSAT_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, TC4_incr, 'TCFWLT_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, QC1_incr, 'QCFSAT_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, QC2_incr, 'QCFTRN_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, QC4_incr, 'QCFWLT_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, CAPAC_incr, 'CAPAC_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, CATDEF_incr, 'CATDEF_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, RZEXC_incr, 'RZEXC_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SRFEXC_incr, 'SRFEXC_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT1_incr, 'GHTCNT1_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT2_incr, 'GHTCNT2_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT3_incr, 'GHTCNT3_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT4_incr, 'GHTCNT4_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT5_incr, 'GHTCNT5_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT6_incr, 'GHTCNT6_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, WESNN1_incr, 'WESNN1_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, WESNN2_incr, 'WESNN2_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, WESNN3_incr, 'WESNN3_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, HTSNNN1_incr, 'HTSNNN1_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, HTSNNN2_incr, 'HTSNNN2_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, HTSNNN3_incr, 'HTSNNN3_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SNDZN1_incr, 'SNDZN1_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SNDZN2_incr, 'SNDZN2_INCR' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SNDZN3_incr, 'SNDZN3_INCR' ,rc=status) - VERIFY_(status) + call MAPL_GetPointer(export, TC1_incr, 'TCFSAT_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, TC4_incr, 'TCFWLT_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, QC1_incr, 'QCFSAT_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, QC2_incr, 'QCFTRN_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, QC4_incr, 'QCFWLT_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, CAPAC_incr, 'CAPAC_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, CATDEF_incr, 'CATDEF_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, RZEXC_incr, 'RZEXC_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SRFEXC_incr, 'SRFEXC_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT1_incr, 'GHTCNT1_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT2_incr, 'GHTCNT2_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT3_incr, 'GHTCNT3_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT4_incr, 'GHTCNT4_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT5_incr, 'GHTCNT5_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT6_incr, 'GHTCNT6_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, WESNN1_incr, 'WESNN1_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, WESNN2_incr, 'WESNN2_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, WESNN3_incr, 'WESNN3_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, HTSNNN1_incr, 'HTSNNN1_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, HTSNNN2_incr, 'HTSNNN2_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, HTSNNN3_incr, 'HTSNNN3_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SNDZN1_incr, 'SNDZN1_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SNDZN2_incr, 'SNDZN2_INCR' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SNDZN3_incr, 'SNDZN3_INCR' ,rc=status) + _VERIFY(status) allocate(met_force(N_catl)) met_force(:)%Tair = TA_enavg(:) @@ -1546,290 +1516,283 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) met_force(:)%Snowf = SNO_enavg(:) met_force(:)%LWdown = LWDNSRF_enavg(:) met_force(:)%SWdown = DRPAR_enavg(:)+DFPAR_enavg(:)+DRNIR_enavg(:) + & - DFNIR_enavg(:)+DRUVR_enavg(:)+DFUVR_enavg(:) + DFNIR_enavg(:)+DRUVR_enavg(:)+DFUVR_enavg(:) met_force(:)%SWnet = SWLAND(:) met_force(:)%PARdrct = DRPAR_enavg(:) met_force(:)%PARdffs = DFPAR_enavg(:) met_force(:)%wind = UU_enavg(:) met_force(:)%RefH = DZ_enavg(:) - -! Weiyuan note: dummy adapt for now + + ! Weiyuan note: dummy adapt for now N_adapt_R = 0 !allocate(obs_pert_adapt_param(N_obs_param)) !allocate(Pert_adapt_R(N_adapt_R,NUM_ENSEMBLE)) !allocate(Obs_pert(N_obsl_max,NUM_ENSEMBLE)) - + if (N_obsbias_max>0) then - allocate(obs_bias(N_catl,N_obs_param,N_obsbias_max)) - call initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, trim(out_path), & - trim(exp_id), start_time, N_catl, numprocs, N_catl_vec, low_ind, obs_bias) + allocate(obs_bias(N_catl,N_obs_param,N_obsbias_max)) + call initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, trim(out_path), & + trim(exp_id), start_time, N_catl, numprocs, N_catl_vec, low_ind, obs_bias) end if - + allocate(cat_progn_incr(N_catl,NUM_ENSEMBLE)) allocate(cat_progn_incr_ensavg(N_catl)) allocate(Observations_l(N_obsl_max)) - - !WY note: temportary - - + + !WY note: temporary #ifdef DBG_LANDASSIM_INPUTS - + if (firsttime) then - firsttime = .false. - call MAPL_LocStreamGet(LOCSTREAM, TILEGRID=TILEGRID, RC=STATUS) - VERIFY_(STATUS) - - call MAPL_TileMaskGet(tilegrid, mask, rc=status) - VERIFY_(STATUS) - - allocate(metTair(N_catf),metTair_l(N_catl)) - allocate(ids(N_catf)) - - metTair_l(:) = met_force(:)%Tair - ids(:) = tile_coord_rf(:)%tile_id - - call MPI_AllGATHERV(metTair_l, N_catl, MPI_REAL, & - metTair, N_catl_vec, low_ind-1, MPI_REAL, & - mpicomm,mpierr) - - - if(myid ==0) then + firsttime = .false. + call MAPL_LocStreamGet(LOCSTREAM, TILEGRID=TILEGRID, RC=STATUS) + _VERIFY(STATUS) + + call MAPL_TileMaskGet(tilegrid, mask, rc=status) + _VERIFY(STATUS) + + allocate(metTair(N_catf),metTair_l(N_catl)) + allocate(ids(N_catf)) + + metTair_l(:) = met_force(:)%Tair + ids(:) = tile_coord_rf(:)%tile_id + + call MPI_AllGATHERV(metTair_l, N_catl, MPI_REAL, & + metTair, N_catl_vec, low_ind-1, MPI_REAL, & + mpicomm,mpierr) + + + if(myid ==0) then open(unit=10,file='metTair.txt',action="write",status="replace") do i = 1, N_catf - write(10,*) ids(i), metTair(i) + write(10,*) ids(i), metTair(i) enddo close(10) - endif - - unit = GETFILE( "landassim_force_inputs.bin", form="unformatted", RC=STATUS ) - VERIFY_(STATUS) -! Inputs - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Tair, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Qair, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Psurf, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf_c, mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Snowf, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%LWdown, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWdown, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWnet, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdrct,mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdffs, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%wind, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%RefH, mask=mask, rc=status); VERIFY_(STATUS) - - unit = GETFILE( "landassim_catprogn_inputs.bin", form="unformatted", RC=STATUS ) - VERIFY_(STATUS) + endif - ens_id = 1 - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc1, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc2, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc4, mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa1, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa2, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa4, mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%capac, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%catdef, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%rzexc, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%srfexc, mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(3), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(4), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(5), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(6), mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(3), mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(3), mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(3), mask=mask, rc=status); VERIFY_(STATUS) - - - unit = GETFILE( "landassim_mwrtm_inputs.bin", form="unformatted", RC=STATUS ) - VERIFY_(STATUS) + unit = GETFILE( "landassim_force_inputs.bin", form="unformatted", RC=STATUS ) + _VERIFY(STATUS) + ! Inputs + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Tair, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Qair, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Psurf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf_c, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%vegcls), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%soilcls), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%sand, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%clay, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%poros, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wt, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wp, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmin, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmax, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmin, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmax, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrh, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrv, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_polmix,mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%omega, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bh, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bv, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%lewt, mask=mask, rc=status); VERIFY_(STATUS) - - !unit = GETFILE( "landassim_catparam_inputs.bin", form="unformatted", RC=STATUS ) - !VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Snowf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%LWdown, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWdown, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWnet, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdrct,mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdffs, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%wind, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%RefH, mask=mask, rc=status); _VERIFY(STATUS) - endif - - - -#endif - - call get_enkf_increments( & - date_time_new, & - NUM_ENSEMBLE, N_catl, N_catf, N_obsl_max, & - trim(out_path), trim(exp_id), exp_domain, & - met_force, lai, cat_param, mwRTM_param, & - tile_coord_l, tile_coord_rf, tcinternal%grid_f, & - tcinternal%grid_f, tcinternal%grid_l, tcinternal%grid_g, & - N_catl_vec, low_ind, l2rf, rf2l, & - N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & - update_type, & - dtstep_assim, centered_update, & - xcompact, ycompact, fcsterr_inflation_fac, & - N_obs_param, obs_param, N_obsbias_max, & - out_obslog, out_smapL4SMaup, & - cat_progn, & - Pert_rseed, obs_bias, & - cat_progn_incr, fresh_incr, & - N_obsf, N_obsl, Observations_l, & - ! below are dummy for now - N_adapt_R, obs_pert_adapt_param, Pert_adapt_R) - !Obs_pert ) - - ! forced to apply - spin = .false. - - if (.not. spin) then - if (fresh_incr) then + unit = GETFILE( "landassim_catprogn_inputs.bin", form="unformatted", RC=STATUS ) + _VERIFY(STATUS) + + ens_counter = 1 + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%tc1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%tc2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%tc4, mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%qa1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%qa2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%qa4, mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%capac, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%catdef, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%rzexc, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%srfexc, mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(3), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(4), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(5), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(6), mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%wesn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%wesn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%wesn(3), mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%htsn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%htsn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%htsn(3), mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%sndz(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%sndz(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%sndz(3), mask=mask, rc=status); _VERIFY(STATUS) + + + unit = GETFILE( "landassim_mwrtm_inputs.bin", form="unformatted", RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%vegcls), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%soilcls), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%sand, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%clay, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%poros, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wt, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wp, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmin, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmax, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmin, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmax, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrh, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrv, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_polmix,mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%omega, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bh, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bv, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%lewt, mask=mask, rc=status); _VERIFY(STATUS) + + !unit = GETFILE( "landassim_catparam_inputs.bin", form="unformatted", RC=STATUS ) + !_VERIFY(STATUS) + + endif + +#endif ! DBG_LANDASSIM_INPUTS + + call get_enkf_increments( & + date_time_new, & + NUM_ENSEMBLE, N_catl, N_catf, N_obsl_max, & + trim(out_path), trim(exp_id), exp_domain, & + met_force, lai, cat_param, mwRTM_param, & + tile_coord_l, tile_coord_rf, tcinternal%grid_f, & + tcinternal%grid_f, tcinternal%grid_l, tcinternal%grid_g, & + N_catl_vec, low_ind, l2rf, rf2l, & + N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & + update_type, & + dtstep_assim, centered_update, & + xcompact, ycompact, fcsterr_inflation_fac, & + N_obs_param, obs_param, N_obsbias_max, & + out_obslog, out_smapL4SMaup, & + cat_progn, & + Pert_rseed, obs_bias, & + cat_progn_incr, fresh_incr, & + N_obsf, N_obsl, Observations_l, & + ! below are dummy for now + N_adapt_R, obs_pert_adapt_param, Pert_adapt_R) + + ! forced to apply + spin = .false. + + if (.not. spin) then + if (fresh_incr) then ! apply EnKF increments ! (without call to subroutine recompute_diagnostics()) - call apply_enkf_increments( N_catl, NUM_ENSEMBLE, update_type, cat_param, & - cat_progn_incr, cat_progn ) - - end if ! fresh_incr - - ! if requested, write incr and/or ObsFcstAna files whenever it was - ! time for assimilation, even if there were no observations - ! - reichle, 29 Aug 2014 - - secs_in_day = & - date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec - - if (centered_update) secs_in_day = secs_in_day + dtstep_assim/2 + call apply_enkf_increments( N_catl, NUM_ENSEMBLE, update_type, cat_param, & + cat_progn_incr, cat_progn ) + + end if ! fresh_incr - ! WY note : Here N_catg is not the global land tile number - ! but a maximum global_id this simulation covers. - ! Need to find the number - N_catg = maxval(rf2g) - - if (mod(secs_in_day, dtstep_assim)==0) then - - call output_incr_etc( out_ObsFcstAna, & - date_time_new, trim(out_path), trim(exp_id), & - N_obsl, N_obs_param, NUM_ENSEMBLE, & - N_catl, tile_coord_l, & - N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, & - N_catl_vec, low_ind, rf2l, N_catg, rf2g, & - obs_param, & - met_force, lai, & - cat_param, cat_progn, cat_progn_incr, mwRTM_param, & - Observations_l, rf2f=rf2f ) - - - do i = 1, N_catl - cat_progn_incr_ensavg(i) = 0.0 - do n_e=1, NUM_ENSEMBLE - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & - + cat_progn_incr(i,n_e) - end do - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) - enddo - - if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 - if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 - if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 - if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 - if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 - if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 - - if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac - if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef - if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc - if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc - - if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) - if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) - if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) - if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) - if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) - if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) - - if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) - if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) - if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) - - if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) - if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) - if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) - - if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) - if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) - if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) - - - - ! write analysis fields into SMAP L4_SM aup file - ! whenever it was time for assimilation (regardless - ! of whether obs were actually assimilated and fresh - ! increments were computed) - - if (out_smapL4SMaup) & - call write_smapL4SMaup( 'analysis', date_time_new, trim(out_path), & - trim(exp_id), NUM_ENSEMBLE, N_catl, N_catf, N_obsl, tile_coord_rf, & - tcinternal%grid_g, N_catl_vec, low_ind, & - N_obs_param, obs_param, Observations_l, cat_param, cat_progn ) - - end if - - - fresh_incr = .false. - - endif !spin - - - -!-------------------- -! Pointers to inputs -!-------------------- + ! if requested, write incr and/or ObsFcstAna files whenever it was + ! time for assimilation, even if there were no observations + ! - reichle, 29 Aug 2014 + + secs_in_day = & + date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec + + if (centered_update) secs_in_day = secs_in_day + dtstep_assim/2 + + ! WY note : Here N_catg is not the global land tile number + ! but a maximum global_id this simulation covers. + ! Need to find the number + N_catg = maxval(rf2g) + + if (mod(secs_in_day, dtstep_assim)==0) then + + call output_incr_etc( out_ObsFcstAna, & + date_time_new, trim(out_path), trim(exp_id), & + N_obsl, N_obs_param, NUM_ENSEMBLE, & + N_catl, tile_coord_l, & + N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, & + N_catl_vec, low_ind, rf2l, N_catg, rf2g, & + obs_param, & + met_force, lai, & + cat_param, cat_progn, cat_progn_incr, mwRTM_param, & + Observations_l, rf2f=rf2f ) + + + do i = 1, N_catl + cat_progn_incr_ensavg(i) = 0.0 + do n_e=1, NUM_ENSEMBLE + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & + + cat_progn_incr(i,n_e) + end do + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) + enddo + + if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 + if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 + if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 + if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 + if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 + if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 + + if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac + if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef + if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc + if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc + + if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) + if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) + if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) + if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) + if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) + if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) + + if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) + if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) + if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) + + if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) + if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) + if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) + + if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) + if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) + if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) + + + ! write analysis fields into SMAP L4_SM aup file + ! whenever it was time for assimilation (regardless + ! of whether obs were actually assimilated and fresh + ! increments were computed) + + if (out_smapL4SMaup) & + call write_smapL4SMaup( 'analysis', date_time_new, trim(out_path), & + trim(exp_id), NUM_ENSEMBLE, N_catl, N_catf, N_obsl, tile_coord_rf, & + tcinternal%grid_g, N_catl_vec, low_ind, & + N_obs_param, obs_param, Observations_l, cat_param, cat_progn ) + + end if + + fresh_incr = .false. + + endif !spin + + + + !-------------------- + ! Pointers to inputs + !-------------------- deallocate(cat_progn_incr) deallocate(cat_progn_incr_ensavg) deallocate(Observations_l) - + call MAPL_TimerOff ( MAPL, "RUN" ) call MAPL_TimerOff ( MAPL, "TOTAL" ) - + RETURN_(ESMF_SUCCESS) - -end subroutine RUN - - ! !IROTUINE: collecting and averaging - -subroutine UPDATE_ASSIM(gc, import, export, clock, rc) - + + end subroutine RUN + + ! !IROTUINE: collecting and averaging + + subroutine UPDATE_ASSIM(gc, import, export, clock, rc) + ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: gc ! Gridded component @@ -1838,7 +1801,7 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code - + ! ErrLog variables integer :: status character(len=ESMF_MAXSTR) :: Iam='UPDATE_ASSIM' @@ -1846,280 +1809,556 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) ! ESMF variables type(ESMF_Alarm) :: LandAssimAlarm - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm ! MAPL variables type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj - + real, dimension(:,:),pointer :: TC real, dimension(:,:),pointer :: QC - real, dimension(:),pointer :: CAPAC - real, dimension(:),pointer :: CATDEF - real, dimension(:),pointer :: RZEXC - real, dimension(:),pointer :: SRFEXC - real, dimension(:),pointer :: GHTCNT1 - real, dimension(:),pointer :: GHTCNT2 - real, dimension(:),pointer :: GHTCNT3 - real, dimension(:),pointer :: GHTCNT4 - real, dimension(:),pointer :: GHTCNT5 - real, dimension(:),pointer :: GHTCNT6 - real, dimension(:),pointer :: WESNN1 - real, dimension(:),pointer :: WESNN2 - real, dimension(:),pointer :: WESNN3 - real, dimension(:),pointer :: HTSNNN1 - real, dimension(:),pointer :: HTSNNN2 - real, dimension(:),pointer :: HTSNNN3 - real, dimension(:),pointer :: SNDZN1 - real, dimension(:),pointer :: SNDZN2 - real, dimension(:),pointer :: SNDZN3 - - integer,save :: ens_id = 0 - - !BOP - + real, dimension(:), pointer :: CAPAC + real, dimension(:), pointer :: CATDEF + real, dimension(:), pointer :: RZEXC + real, dimension(:), pointer :: SRFEXC + real, dimension(:), pointer :: GHTCNT1 + real, dimension(:), pointer :: GHTCNT2 + real, dimension(:), pointer :: GHTCNT3 + real, dimension(:), pointer :: GHTCNT4 + real, dimension(:), pointer :: GHTCNT5 + real, dimension(:), pointer :: GHTCNT6 + real, dimension(:), pointer :: WESNN1 + real, dimension(:), pointer :: WESNN2 + real, dimension(:), pointer :: WESNN3 + real, dimension(:), pointer :: HTSNNN1 + real, dimension(:), pointer :: HTSNNN2 + real, dimension(:), pointer :: HTSNNN3 + real, dimension(:), pointer :: SNDZN1 + real, dimension(:), pointer :: SNDZN2 + real, dimension(:), pointer :: SNDZN3 + + integer, save :: ens_counter = 0 + + !BOP + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) - + _VERIFY(STATUS) + call ESMF_ClockGetAlarm(clock, 'LandAssim', LandAssimAlarm, rc=status) - VERIFY_(status) + _VERIFY(status) if ( .not. ESMF_AlarmIsRinging(LandAssimAlarm)) then RETURN_(ESMF_SUCCESS) endif - - call MAPL_GetPointer(export, TC, 'TC' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, QC, 'QC' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, CAPAC, 'CAPAC' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, CATDEF, 'CATDEF' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, RZEXC, 'RZEXC' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SRFEXC, 'SRFEXC' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT1, 'GHTCNT1' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT2, 'GHTCNT2' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT3, 'GHTCNT3' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT4, 'GHTCNT4' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT5, 'GHTCNT5' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, GHTCNT6, 'GHTCNT6' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, WESNN1, 'WESNN1' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, WESNN2, 'WESNN2' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, WESNN3, 'WESNN3' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, HTSNNN1, 'HTSNNN1' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, HTSNNN2, 'HTSNNN2' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, HTSNNN3, 'HTSNNN3' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SNDZN1, 'SNDZN1' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SNDZN2, 'SNDZN2' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(export, SNDZN3, 'SNDZN3' ,rc=status) - VERIFY_(status) + + call MAPL_GetPointer(export, TC, 'TC' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, QC, 'QC' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, CAPAC, 'CAPAC' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, CATDEF, 'CATDEF' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, RZEXC, 'RZEXC' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SRFEXC, 'SRFEXC' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT1, 'GHTCNT1' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT2, 'GHTCNT2' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT3, 'GHTCNT3' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT4, 'GHTCNT4' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT5, 'GHTCNT5' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, GHTCNT6, 'GHTCNT6' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, WESNN1, 'WESNN1' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, WESNN2, 'WESNN2' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, WESNN3, 'WESNN3' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, HTSNNN1, 'HTSNNN1' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, HTSNNN2, 'HTSNNN2' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, HTSNNN3, 'HTSNNN3' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SNDZN1, 'SNDZN1' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SNDZN2, 'SNDZN2' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, SNDZN3, 'SNDZN3' ,rc=status) + _VERIFY(status) ! This counter is relative to ens_id - ens_id = ens_id + 1 - !distrbute catch_progn - - TC(:,1) = cat_progn(:,ens_id)%tc1 - TC(:,2) = cat_progn(:,ens_id)%tc2 - TC(:,3) = cat_progn(:,ens_id)%tc4 - - QC(:,1) = cat_progn(:,ens_id)%qa1 - QC(:,2) = cat_progn(:,ens_id)%qa2 - QC(:,3) = cat_progn(:,ens_id)%qa4 - - CAPAC(:) = cat_progn(:,ens_id)%capac - CATDEF(:) = cat_progn(:,ens_id)%catdef - RZEXC(:) = cat_progn(:,ens_id)%rzexc - SRFEXC(:) = cat_progn(:,ens_id)%srfexc - GHTCNT1(:) = cat_progn(:,ens_id)%ght(1) - GHTCNT2(:) = cat_progn(:,ens_id)%ght(2) - GHTCNT3(:) = cat_progn(:,ens_id)%ght(3) - GHTCNT4(:) = cat_progn(:,ens_id)%ght(4) - GHTCNT5(:) = cat_progn(:,ens_id)%ght(5) - GHTCNT6(:) = cat_progn(:,ens_id)%ght(6) - - WESNN1(:) = cat_progn(:,ens_id)%wesn(1) - WESNN2(:) = cat_progn(:,ens_id)%wesn(2) - WESNN3(:) = cat_progn(:,ens_id)%wesn(3) - - HTSNNN1(:) = cat_progn(:,ens_id)%htsn(1) - HTSNNN2(:) = cat_progn(:,ens_id)%htsn(2) - HTSNNN3(:) = cat_progn(:,ens_id)%htsn(3) - - SNDZN1(:) = cat_progn(:,ens_id)%sndz(1) - SNDZN2(:) = cat_progn(:,ens_id)%sndz(2) - SNDZN3(:) = cat_progn(:,ens_id)%sndz(3) - - if(ens_id == NUM_ENSEMBLE ) ens_id = 0 + ens_counter = ens_counter + 1 + + !distribute catch_progn + TC(:,1) = cat_progn(:,ens_counter)%tc1 + TC(:,2) = cat_progn(:,ens_counter)%tc2 + TC(:,3) = cat_progn(:,ens_counter)%tc4 + + QC(:,1) = cat_progn(:,ens_counter)%qa1 + QC(:,2) = cat_progn(:,ens_counter)%qa2 + QC(:,3) = cat_progn(:,ens_counter)%qa4 + + CAPAC(:) = cat_progn(:,ens_counter)%capac + CATDEF(:) = cat_progn(:,ens_counter)%catdef + RZEXC(:) = cat_progn(:,ens_counter)%rzexc + SRFEXC(:) = cat_progn(:,ens_counter)%srfexc + + GHTCNT1(:) = cat_progn(:,ens_counter)%ght(1) + GHTCNT2(:) = cat_progn(:,ens_counter)%ght(2) + GHTCNT3(:) = cat_progn(:,ens_counter)%ght(3) + GHTCNT4(:) = cat_progn(:,ens_counter)%ght(4) + GHTCNT5(:) = cat_progn(:,ens_counter)%ght(5) + GHTCNT6(:) = cat_progn(:,ens_counter)%ght(6) + + WESNN1(:) = cat_progn(:,ens_counter)%wesn(1) + WESNN2(:) = cat_progn(:,ens_counter)%wesn(2) + WESNN3(:) = cat_progn(:,ens_counter)%wesn(3) + + HTSNNN1(:) = cat_progn(:,ens_counter)%htsn(1) + HTSNNN2(:) = cat_progn(:,ens_counter)%htsn(2) + HTSNNN3(:) = cat_progn(:,ens_counter)%htsn(3) + + SNDZN1(:) = cat_progn(:,ens_counter)%sndz(1) + SNDZN2(:) = cat_progn(:,ens_counter)%sndz(2) + SNDZN3(:) = cat_progn(:,ens_counter)%sndz(3) + + if(ens_counter == NUM_ENSEMBLE ) ens_counter = 0 + ! End RETURN_(ESMF_SUCCESS) + + end subroutine UPDATE_ASSIM + + + ! subroutine to calculate Tb for HISTORY output + + subroutine CALC_LAND_TB(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: import ! Import state + ! this import is from land grid component + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code -end subroutine UPDATE_ASSIM - -subroutine read_pert_rseed(seed_fname,pert_rseed_r8) - use netcdf - character(len=*),intent(in) :: seed_fname - real(kind=ESMF_KIND_R8),intent(inout) :: pert_rseed_r8(:) - - integer :: ncid, s_varid, en_dim, n_ens, id_varid, i, pos - logical :: file_exist - - inquire (file = trim(seed_fname), exist=file_exist) - if ( .not. file_exist) then - pert_rseed_r8 = 0 - return - endif - - call check( nf90_open(seed_fname, NF90_NOWRITE, ncid) ) - ! Get the varid of the data variable, based on its name. - call check( nf90_inq_varid(ncid, "pert_rseed", s_varid) ) - call check( nf90_get_var(ncid, s_varid, pert_rseed_r8) ) - - ! Close the file, freeing all resources. - call check( nf90_close(ncid) ) - - contains - subroutine check(status) - integer, intent ( in) :: status - - if(status /= nf90_noerr) then - print *, trim(nf90_strerror(status)) - stop 1 - end if - end subroutine check -end subroutine read_pert_rseed - -subroutine write_pert_rseed(chk_fname, pert_rseed_r8) - use netcdf - character(len=*),intent(in) :: chk_fname - real(kind=ESMF_KIND_R8),intent(in) :: pert_rseed_r8(:) - character(len=*), parameter :: SHORT_NAME = "SHORT_NAME" - character(len=*), parameter :: LONG_NAME = "LONG_NAME" - character(len=*), parameter :: UNITS = "UNITS" - character(len=*), parameter :: s_SHORT = "obspert_rseed" - character(len=*), parameter :: s_long = "Observation_Perturbations_rseed" - character(len=*), parameter :: units_ = "1" - integer :: nseeds - integer :: ncid, s_varid - integer :: seed_dimid - - nseeds = size(pert_rseed_r8) - - ! Create the file. - call check( nf90_create(trim(chk_fname), nf90_clobber + NF90_NETCDF4, ncid) ) -! Define the dimensions. - call check( nf90_def_dim(ncid, "NRANDSEED", nseeds, seed_dimid) ) - call check( nf90_def_var(ncid, 'pert_rseed', NF90_DOUBLE, [seed_dimid], s_varid) ) - - ! Assign attribute - call check( nf90_put_att(ncid, s_varid, UNITS, units_) ) - call check( nf90_put_att(ncid, s_varid, SHORT_NAME, s_short) ) - call check( nf90_put_att(ncid, s_varid, LONG_NAME, s_long) ) - - ! End define mode. - call check( nf90_enddef(ncid) ) - - ! write varaible - call check( nf90_put_var(ncid, s_varid, pert_rseed_r8) ) - ! Close the file. - call check( nf90_close(ncid) ) - - contains - subroutine check(status) - integer, intent ( in) :: status - - if(status /= nf90_noerr) then - print *, trim(nf90_strerror(status)) - stop 1 - end if - end subroutine check -end subroutine write_pert_rseed - -!BOP -! !IROTUINE: Finalize -- finalize method for LDAS GC -! !INTERFACE: -subroutine Finalize(gc, import, export, clock, rc) - ! !ARGUMENTS: + ! hard-coded SMAP Tb parameters + real, parameter :: freq = 1.41e9 ! microwave frequency [Hz] + real, parameter :: inc_angle = 40. ! incidence angle [deg] + logical, parameter :: incl_atm_terms = .false. ! no atmospheric correction, ie, get Tb at top-of-vegetation + integer :: status + character(len=ESMF_MAXSTR) :: Iam='CALC_LAND_TB' + character(len=ESMF_MAXSTR) :: comp_name + ! MAPL variables + type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj + type(ESMF_State) :: INTERNAL + + real, dimension(:), pointer :: LAI + real, dimension(:), pointer :: TP1 + real, dimension(:), pointer :: TPSURF + real, dimension(:), pointer :: WCSF + real, dimension(:), pointer :: SWE + + real, dimension(:), pointer :: VEGCLS + real, dimension(:), pointer :: SOILCLS + real, dimension(:), pointer :: SAND + real, dimension(:), pointer :: CLAY + real, dimension(:), pointer :: mw_POROS + real, dimension(:), pointer :: WANGWT + real, dimension(:), pointer :: WANGWP + real, dimension(:), pointer :: RGHHMIN + real, dimension(:), pointer :: RGHHMAX + real, dimension(:), pointer :: RGHWMAX + real, dimension(:), pointer :: RGHWMIN + real, dimension(:), pointer :: RGHNRH + real, dimension(:), pointer :: RGHNRV + real, dimension(:), pointer :: RGHPOLMIX + real, dimension(:), pointer :: OMEGA + real, dimension(:), pointer :: BH + real, dimension(:), pointer :: BV + real, dimension(:), pointer :: LEWT + + ! export + real, dimension(:), pointer :: TB_H_enavg + real, dimension(:), pointer :: TB_V_enavg + + ! local + real, allocatable, dimension(:) :: sfmc_mwRTM, tsoil_mwRTM + real, allocatable, dimension(:) :: dummy_real + real, allocatable, dimension(:) :: Tb_v_tmp, TB_h_tmp + + integer :: N_catl, n, mpierr + type(MAPL_LocStream) :: locstream + + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) + _VERIFY(STATUS) + Iam=trim(COMP_NAME)//"::RUN" + + call MAPL_GetPointer(export, TB_H_enavg, 'TB_LAND_1410MHZ_40DEG_HPOL' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(export, TB_V_enavg, 'TB_LAND_1410MHZ_40DEG_VPOL' ,rc=status) + _VERIFY(STATUS) + + !if HISTORY does not ask for these variables, no calculation necessary; return + if (.not. associated(TB_H_enavg) .or. .not. associated(TB_V_enavg)) then + _RETURN(_SUCCESS) + endif + + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) + _VERIFY(status) + call MAPL_Get(MAPL, LocStream=locstream,rc=status) + _VERIFY(status) + call MAPL_LocStreamGet(locstream, NT_LOCAL=N_catl,rc=status) + _VERIFY(status) + + ! Pointers to internals + !---------------------- + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) + _VERIFY(status) + + call get_mwrtm_param(INTERNAL, N_catl, rc=status) + _VERIFY(STATUS) + ! make sure that at least some mwRTM parameters are not nodata + if (mwRTM_all_nodata) then + _ASSERT(.false., "Tb output requested but all mwRTM parameters are nodata") + endif + + call MAPL_GetPointer(import, LAI, 'LAI' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, TP1, 'TP1' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, WCSF, 'WCSF' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, TPSURF, 'TPSURF' ,rc=status) + _VERIFY(status) + call MAPL_GetPointer(import, SWE, 'SNOWMASS' ,rc=status) + _VERIFY(status) + + ! convert Catchment model variables into inputs suitable for the mwRTM + ! NOTE: input TP1 must be in degree Celsius! + allocate(sfmc_mwRTM(N_catl), tsoil_mwRTM (N_catl)) + call catch2mwRTM_vars( & + N_catl, & + cat_param%vegcls, & ! not used anymore but keep for now + cat_param%poros, & + mwRTM_param%poros, & + WCSF, & + TPSURF, & + TP1-MAPL_TICE, & ! units deg C !!! + sfmc_mwRTM, & + tsoil_mwRTM ) + + ! calculate brightness temperatures + ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] + ! but without Pellarin atmospheric corrections) + + allocate(TB_h_tmp(N_catl), TB_v_tmp(N_catl)) + + if (.not. incl_atm_terms) then + allocate(dummy_real(N_catl)) ! allocate needed for GNU compiler + call mwRTM_get_Tb( & + N_catl, freq, inc_angle, mwRTM_param, & + dummy_real, & ! intent(in), "elev", not used as long as "incl_atm_terms=.false." + LAI, & + sfmc_mwRTM, & + tsoil_mwRTM, & + SWE, & + dummy_real, & ! intent(in), "Tair", not used as long as "incl_atm_terms=.false." + incl_atm_terms, & + Tb_h_tmp, Tb_v_tmp ) ! intent(out) 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' + deallocate(dummy_real) + else + _ASSERT(.false., "top-of-atmosphere Tb calculation not yet implemented (incl_atm_terms=.true.)") + end if + + if (collect_tb_counter == 0) then + TB_V_enavg = 0. + TB_H_enavg = 0. + endif + + ! This counter is relative to ens_id + collect_tb_counter = collect_tb_counter + 1 + + TB_V_enavg(:) = TB_V_enavg(:) + Tb_v_tmp(:) + TB_H_enavg(:) = TB_H_enavg(:) + Tb_h_tmp(:) + + if (collect_tb_counter == NUM_ENSEMBLE) then + collect_tb_counter = 0 + TB_V_enavg(:) = TB_V_enavg(:)/NUM_ENSEMBLE + TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE + endif + + deallocate(Tb_h_tmp, Tb_v_tmp, sfmc_mwRTM, tsoil_mwRTM) + + RETURN_(_SUCCESS) + end subroutine CALC_LAND_TB + + + subroutine read_pert_rseed(seed_fname,pert_rseed_r8) + use netcdf + character(len=*),intent(in) :: seed_fname + real(kind=ESMF_KIND_R8),intent(inout) :: pert_rseed_r8(:) + + integer :: ncid, s_varid, en_dim, n_ens, id_varid, i, pos + logical :: file_exist + + inquire (file = trim(seed_fname), exist=file_exist) + if ( .not. file_exist) then + pert_rseed_r8 = 0 + return + endif + + call check( nf90_open(seed_fname, NF90_NOWRITE, ncid) ) + ! Get the varid of the data variable, based on its name. + call check( nf90_inq_varid(ncid, "pert_rseed", s_varid) ) + call check( nf90_get_var(ncid, s_varid, pert_rseed_r8) ) + + ! Close the file, freeing all resources. + call check( nf90_close(ncid) ) + + contains + subroutine check(status) + integer, intent ( in) :: status + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status)) + stop 1 + end if + end subroutine check + end subroutine read_pert_rseed + + subroutine write_pert_rseed(chk_fname, pert_rseed_r8) + use netcdf + character(len=*),intent(in) :: chk_fname + real(kind=ESMF_KIND_R8),intent(in) :: pert_rseed_r8(:) + character(len=*), parameter :: SHORT_NAME = "SHORT_NAME" + character(len=*), parameter :: LONG_NAME = "LONG_NAME" + character(len=*), parameter :: UNITS = "UNITS" + character(len=*), parameter :: s_SHORT = "obspert_rseed" + character(len=*), parameter :: s_long = "Observation_Perturbations_rseed" + character(len=*), parameter :: units_ = "1" + + integer :: nseeds + integer :: ncid, s_varid + integer :: seed_dimid + + nseeds = size(pert_rseed_r8) + + ! Create the file. + call check( nf90_create(trim(chk_fname), nf90_clobber + NF90_NETCDF4, ncid) ) + ! Define the dimensions. + call check( nf90_def_dim(ncid, "NRANDSEED", nseeds, seed_dimid) ) + call check( nf90_def_var(ncid, 'pert_rseed', NF90_DOUBLE, [seed_dimid], s_varid) ) + + ! Assign attribute + call check( nf90_put_att(ncid, s_varid, UNITS, units_) ) + call check( nf90_put_att(ncid, s_varid, SHORT_NAME, s_short) ) + call check( nf90_put_att(ncid, s_varid, LONG_NAME, s_long) ) + + ! End define mode. + call check( nf90_enddef(ncid) ) + + ! write varaible + call check( nf90_put_var(ncid, s_varid, pert_rseed_r8) ) + ! Close the file. + call check( nf90_close(ncid) ) + + contains + subroutine check(status) + integer, intent ( in) :: status + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status)) + stop 1 + end if + end subroutine check + end subroutine write_pert_rseed + + + subroutine get_mwrtm_param(internal,N_catl, rc) + type(ESMF_State), intent(inout) :: INTERNAL + integer, intent(in) :: N_catl + integer, optional, intent(out) :: rc + + real, dimension(:), pointer :: VEGCLS + real, dimension(:), pointer :: SOILCLS + real, dimension(:), pointer :: SAND + real, dimension(:), pointer :: CLAY + real, dimension(:), pointer :: mw_POROS + real, dimension(:), pointer :: WANGWT + real, dimension(:), pointer :: WANGWP + real, dimension(:), pointer :: RGHHMIN + real, dimension(:), pointer :: RGHHMAX + real, dimension(:), pointer :: RGHWMAX + real, dimension(:), pointer :: RGHWMIN + real, dimension(:), pointer :: RGHNRH + real, dimension(:), pointer :: RGHNRV + real, dimension(:), pointer :: RGHPOLMIX + real, dimension(:), pointer :: OMEGA + real, dimension(:), pointer :: BH + real, dimension(:), pointer :: BV + real, dimension(:), pointer :: LEWT + + integer :: N_catl_tmp, n, mpierr, status + logical :: is_nodata, all_nodata_l + + if(allocated(mwRTM_param)) then + _RETURN(_SUCCESS) + endif + + call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) + _VERIFY(STATUS) + + N_catl_tmp = size(sand,1) + _ASSERT(N_catl_tmp == N_catl, "sanity check: N_catl should be consistent") + + allocate(mwRTM_param(N_catl)) + mwRTM_param(:)%sand = SAND(:) + mwRTM_param(:)%vegcls = nint(VEGCLS(:)) + mwRTM_param(:)%soilcls = nint(SOILCLS(:)) + mwRTM_param(:)%clay = CLAY(:) + mwRTM_param(:)%poros = mw_POROS(:) + mwRTM_param(:)%wang_wt = WANGWT(:) + mwRTM_param(:)%wang_wp = WANGWP(:) + mwRTM_param(:)%rgh_hmin = RGHHMIN(:) + mwRTM_param(:)%rgh_hmax = RGHHMAX(:) + mwRTM_param(:)%rgh_wmin = RGHWMIN(:) + mwRTM_param(:)%rgh_wmax = RGHWMAX(:) + mwRTM_param(:)%rgh_Nrh = RGHNRH(:) + mwRTM_param(:)%rgh_Nrv = RGHNRV(:) + mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) + mwRTM_param(:)%omega = OMEGA(:) + mwRTM_param(:)%bh = BH(:) + mwRTM_param(:)%bv = bv(:) + mwRTM_param(:)%lewt = LEWT(:) + + all_nodata_l = .true. + do n=1,N_catl + call mwRTM_param_nodata_check(mwRTM_param(n), is_nodata ) + if (.not. is_nodata) all_nodata_l = .false. + end do + + ! perform logical AND across elements + call MPI_AllReduce(all_nodata_l, mwRTM_all_nodata, 1, MPI_LOGICAL, & + MPI_LAND, mpicomm, mpierr) + _RETURN(_SUCCESS) + end subroutine get_mwrtm_param + + !BOP + ! !IROTUINE: Finalize -- finalize method for LDAS GC + ! !INTERFACE: + subroutine Finalize(gc, import, export, clock, rc) + + ! !ARGUMENTS: + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component type(ESMF_State), intent(inout) :: import ! Import state type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code - + !EOP - + ! ErrLog variables - integer :: status - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: comp_name + integer :: status + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: comp_name type(MAPL_MetaComp), pointer :: MAPL=>null() - character(len=300) :: seed_fname - character(len=300) :: fname_tpl - character(len=300) :: out_path - character(len=ESMF_MAXSTR) :: exp_id - character(len=4) :: id_string - character(len=14):: datestamp - integer :: ens, nymd, nhms + character(len=300) :: seed_fname + character(len=300) :: fname_tpl + character(len=300) :: out_path + character(len=ESMF_MAXSTR) :: exp_id + character(len=4) :: id_string + character(len=14) :: datestamp + integer :: ens, nymd, nhms + ! Get component's name and setup traceback handle call ESMF_GridCompget(gc, name=comp_name, rc=status) - VERIFY_(status) + _VERIFY(status) Iam = trim(comp_name) // "::Finalize" - + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - VERIFY_(STATUS) - - if (master_proc) then - call finalize_obslog() - Pert_rseed_r8 = Pert_rseed - call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) - VERIFY_(STATUS) - call MAPL_DateStampGet( clock, datestamp, rc=status) - VERIFY_(STATUS) - - read(datestamp(1:8),*) nymd - read(datestamp(10:13),*) nhms - nhms = nhms*100 - do ens = 0, NUM_ENSEMBLE-1 - write(id_string,'(I4.4)') ens + FIRST_ENS_ID - seed_fname = "" - call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - VERIFY_(STATUS) - call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) - enddo - endif - + _VERIFY(STATUS) + + if( land_assim) then + call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) + _VERIFY(STATUS) + + if (master_proc) then + if (out_obslog) call finalize_obslog() + Pert_rseed_r8 = Pert_rseed + call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", & + DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) + _VERIFY(STATUS) + call MAPL_DateStampGet( clock, datestamp, rc=status) + _VERIFY(STATUS) + + read(datestamp(1:8),*) nymd + read(datestamp(10:13),*) nhms + nhms = nhms*100 + do ens = 0, NUM_ENSEMBLE-1 + write(id_string,'(I4.4)') ens + FIRST_ENS_ID + seed_fname = "" + call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) + _VERIFY(STATUS) + call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) + enddo + endif + endif ! land_assim + ! Call Finalize for every child call MAPL_GenericFinalize(gc, import, export, clock, rc=status) - VERIFY_(status) - - ! End + _VERIFY(status) + RETURN_(ESMF_SUCCESS) - -end subroutine Finalize + + end subroutine Finalize end module GEOS_LandAssimGridCompMod diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 index 42387c89..c3a8feca 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 @@ -323,10 +323,13 @@ subroutine mwRTM_get_Tb( N_tile, freq, inc_angle, mwp, elev, & if (logit) write(logunit,*) 'entering mwRTM_get_Tb...' ! check first element of elevation against no-data-value + ! (elevation is needed only when incl_atm_terms=.true.) - if ( abs(elev(1)-nodata_generic)null() integer :: lat1, lat2, lon1, lon2 + integer :: FIRST_ENS_ID contains !BOP @@ -115,7 +116,7 @@ subroutine SetServices(gc, rc) call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & - Phase2_Initialize, & + Phase2_Initialize, & rc=status & ) VERIFY_(status) @@ -184,7 +185,8 @@ subroutine SetServices(gc, rc) call MAPL_GetResource(MAPL, GEOSldas_FIRST_ENS_ID, 'FIRST_ENS_ID:',DEFAULT=0, rc=status) VERIFY_(status) - ens_id = 0 + FIRST_ENS_ID = GEOSldas_FIRST_ENS_ID + ens_id = FIRST_ENS_ID if ( internal%NUM_ENSEMBLE > 1) then !landpertxxxx read(comp_name(9:12),*) ens_id @@ -1085,8 +1087,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) endif - - if (IAmRoot .and. internal%ens_id == 0) then + if (IAmRoot .and. internal%ens_id == FIRST_ENS_ID) then call echo_pert_param( internal%ForcePert%npert, internal%ForcePert%param, 1, 1 ) call echo_pert_param( internal%PrognPert%npert, internal%PrognPert%param, 1, 1 ) endif @@ -1107,7 +1108,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! Coldstart if (COLDSTART) then - if (IAmRoot .and. internal%ens_id == 0 ) print *, trim(Iam)//'::WARNING: Cold-starting LandPert GridComp' + if (IAmRoot .and. internal%ens_id == FIRST_ENS_ID ) print *, trim(Iam)//'::WARNING: Cold-starting LandPert GridComp' ! -pert_rseed- call get_init_pert_rseed(internal%ens_id, pert_rseed(1)) call init_randseed(pert_rseed) @@ -1141,25 +1142,25 @@ subroutine Initialize(gc, import, export, clock, rc) end if - if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. + if(internal%ens_id == FIRST_ENS_ID ) fpert_enavg(:,:,:)=0. do m = 1,internal%ForcePert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), fpert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%ForcePert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then fpert_enavg(:,:,m)=fpert_enavg(:,:,m)+fpert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then + if( internal%ens_id-FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then fpert_enavg(:,:,m) = -fpert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif enddo - if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. + if(internal%ens_id == FIRST_ENS_ID) ppert_enavg(:,:,:)=0. do m = 1,internal%PrognPert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), ppert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%PrognPert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then ppert_enavg(:,:,m)=ppert_enavg(:,:,m)+ppert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then ppert_enavg(:,:,m) = -ppert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1184,7 +1185,7 @@ subroutine Initialize(gc, import, export, clock, rc) call esmf2ldas(StopTime, stop_time, rc=status) VERIFY_(status) - if( internal%ens_id ==0 .and. IAmRoot) then + if( internal%ens_id == FIRST_ENS_ID .and. IAmRoot) then ! write out the input file call read_ens_prop_inputs(write_nml = .true. , work_path = trim(out_path), & exp_id = trim(exp_id), date_time = start_time) @@ -1233,7 +1234,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! Update the r4 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_KIND_R8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id + 1 - FIRST_ENS_ID ) = pert_rseed ! Clean up if (allocated(pert_rseed)) then ! integer version of MINTERNAL state @@ -1377,7 +1378,8 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) allocate(ppert_grid(n_lon,n_lat, internal%PrognPert%npert), source=MAPL_UNDEF, stat=status) VERIFY_(status) - ! Get pertubations on the underlying grid and convert grid data to tile data + ! Get pertubations on the underlying grid and convert grid data to tile data, adjust mean + ! ! -ForcePert- fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert)= fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert) + & @@ -1448,7 +1450,7 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! Clean up if (allocated(fpert_grid)) then @@ -1468,7 +1470,7 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) call MAPL_TimerOff(MAPL, "phase2_Initialize") call MAPL_TimerOff(MAPL, "TOTAL") - if(internal%ens_id == internal%NUM_ENSEMBLE -1) phase2_initialized = .true. + if(internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE -1) phase2_initialized = .true. ! End RETURN_(ESMF_SUCCESS) @@ -1644,7 +1646,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) call MAPL_DateStampGet(clock, datestamp, rc=status) VERIFY_(STATUS) - write(id_string,'(I4.4)') internal%ens_id + write(id_string,'(I4.4)') internal%ens_id if(internal%NUM_ENSEMBLE ==1 ) id_string='' chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint.'//datestamp @@ -1663,17 +1665,17 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) real(internal%ForcePert%dtstep), & pert_rseed, & internal%ForcePert%param, & - fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert), & + fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert), & .false. & ) - if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. + if(internal%ens_id == FIRST_ENS_ID ) fpert_enavg(:,:,:)=0. do m = 1,internal%ForcePert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), fpert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%ForcePert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then fpert_enavg(:,:,m)=fpert_enavg(:,:,m)+fpert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then fpert_enavg(:,:,m) = -fpert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1694,13 +1696,13 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) .false. & ) - if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. + if(internal%ens_id == FIRST_ENS_ID) ppert_enavg(:,:,:)=0. do m = 1,internal%PrognPert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), ppert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%PrognPert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then ppert_enavg(:,:,m)=ppert_enavg(:,:,m)+ppert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE -1) then + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE -1) then ppert_enavg(:,:,m) = -ppert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1710,7 +1712,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) endif ! Update the r4 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_KIND_R8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1 - FIRST_ENS_ID) = pert_rseed call MAPL_TimerOff(MAPL, "GenerateRaw") ! End @@ -2168,7 +2170,7 @@ subroutine ApplyForcePert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed if (internal%PERTURBATIONS /=0 ) then pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed endif ! Clean up @@ -2559,7 +2561,7 @@ subroutine ApplyPrognPert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! Clean up if (allocated(PROGNPERT)) then @@ -2631,7 +2633,7 @@ subroutine Update_pert_rseed(gc,import,export,clock,rc) VERIFY_(status) endif - pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1),kind=ESMF_KIND_R8) + pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID),kind=ESMF_KIND_R8) ! End RETURN_(ESMF_SUCCESS) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 index efb254d9..04ab04ea 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 @@ -117,24 +117,17 @@ module LDAS_PertRoutinesMod private public :: read_ens_prop_inputs - ! CHANGED: we do not need get_tile_pert any more - ! public :: get_tile_pert public :: interpolate_pert_to_timestep - ! public :: apply_progn_pert - ! public :: apply_force_pert public :: get_pert_grid public :: get_progn_pert_param public :: get_force_pert_param public :: echo_pert_param - ! CHANGED :: io_pert_rstrt() removed - use MAPL to read internal rst vars ! WY note :: io_pert_rstrt() was adapted. read from LDASsa and write to a nc4 file as MAPL internal public :: io_pert_rstrt - ! CHANGED: we do not need initialize_perturbations any more - ! public :: initialize_perturbations public :: check_pert_dtstep ! ADDED public :: apply_pert - ! the parameters below will be overriteted by RC file + ! the parameters below will be overwritten by RC file integer,public :: GEOSldas_NUM_ENSEMBLE = -1 integer,public :: GEOSldas_FIRST_ENS_ID = -1 integer,public :: GEOSldas_FORCE_PERT_DTSTEP = -1 @@ -408,53 +401,14 @@ subroutine read_ens_prop_inputs( & read (10, nml=ens_prop_inputs) close(10,status='keep') endif - if( GEOSldas_NUM_ENSEMBLE == -1 .or. GEOSldas_FIRST_ENS_ID==-1 & + if( GEOSldas_NUM_ENSEMBLE == -1 .or. GEOSldas_FIRST_ENS_ID == -1 & .or. GEOSldas_FORCE_PERT_DTSTEP == -1 .or. GEOSldas_PROGN_PERT_DTSTEP == -1 ) then stop " GEOSldas_NUM_ENSEMBLE etc. should be initialized" endif - N_ens = GEOSldas_NUM_ENSEMBLE - first_ens_id = GEOSldas_FIRST_ENS_ID - force_pert_dtstep =GEOSldas_FORCE_PERT_DTSTEP - progn_pert_dtstep =GEOSldas_PROGN_PERT_DTSTEP - - ! CHANGED: Getting rid of ability to read ensprop path and file from command line - ! ! Get name and path for special ens prop inputs file from - ! ! command line (if present) - - ! ens_prop_inputs_path = '' - ! ens_prop_inputs_file = '' - - ! call clsm_ensdrv_get_command_line( & - ! ens_prop_inputs_path=ens_prop_inputs_path, & - ! ens_prop_inputs_file=ens_prop_inputs_file ) - - ! if ( trim(ens_prop_inputs_path) /= '' .and. & - ! trim(ens_prop_inputs_file) /= '' ) then - - ! ! Read data from special ens prop inputs namelist file - - ! fname = trim(ens_prop_inputs_path) // '/' // trim(ens_prop_inputs_file) - - ! open (10, file=fname, delim='apostrophe', action='read', status='old') - - ! if (logit) write (logunit,*) - ! if (logit) write (logunit,'(400A)') 'reading *special* ens prop inputs from ' // trim(fname) - ! if (logit) write (logunit,*) - - ! read (10, nml=ens_prop_inputs) - - ! close(10,status='keep') - - ! end if - - ! over write ens prop from the test file - ! overwrite ens prop inputs with command line options, if any - - ! write (logunit,*) 'overwriting driver inputs from command line (if present)' - ! write (logunit,*) - - ! CHANGED: Not reading N_ens and first_ens_id from command line - ! call clsm_ensdrv_get_command_line( N_ens=N_ens, first_ens_id=first_ens_id ) + N_ens = GEOSldas_NUM_ENSEMBLE + first_ens_id = GEOSldas_FIRST_ENS_ID + force_pert_dtstep = GEOSldas_FORCE_PERT_DTSTEP + progn_pert_dtstep = GEOSldas_PROGN_PERT_DTSTEP ! echo variables of ens_prop_inputs @@ -1982,137 +1936,6 @@ end subroutine get_pert_select ! ********************************************************************* - ! subroutine get_tile_pert( & - ! N_pert, N_ens, pert_grid_f, pert_grid_l, & - ! dtstep, & - ! N_catl, tile_coord_l, & - ! pert_param, & - ! Pert_rseed, Pert_ntrmdt, & - ! Pert_tile, & - ! ens_id, & - ! initialize_rseed, & - ! initialize_ntrmdt, & - ! diagnose_pert_only ) - - ! ! get perturbations in tile space - - ! implicit none - - ! integer, intent(in) :: N_pert, N_ens - - ! type(grid_def_type), intent(in) :: pert_grid_f, pert_grid_l - - ! real, intent(in) :: dtstep - - ! integer, intent(in) :: N_catl - - ! type(tile_coord_type), dimension(:), pointer :: tile_coord_l - - ! type(pert_param_type), dimension(:), pointer :: pert_param - - ! integer, dimension(NRANDSEED,N_ens), intent(inout) :: Pert_rseed - - ! real, dimension(N_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens), & - ! intent(inout) :: Pert_ntrmdt - - ! real, dimension(N_pert, N_catl, N_ens), intent(out) :: Pert_tile - - ! integer, dimension(N_ens), intent(in), optional :: ens_id - - ! logical, intent(in), optional :: initialize_rseed - ! logical, intent(in), optional :: initialize_ntrmdt - - ! logical, intent(in), optional :: diagnose_pert_only - - ! ! local variables - - ! integer :: i, n_e - - ! real, dimension(N_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens) :: & - ! Pert_grid - - ! real, dimension(pert_grid_l%N_lon,pert_grid_l%N_lat) :: grid_data - ! real, dimension(N_catl) :: tile_data - - ! logical :: init_rseed, init_ntrmdt, diagn_only - - ! character(len=400) :: err_msg - ! character(len=*), parameter :: Iam = 'get_tile_pert' - - ! ! ------------------------------------------------------------ - - ! init_rseed = .false. - ! init_ntrmdt = .false. - - ! if (present(initialize_rseed)) init_rseed = initialize_rseed - ! if (present(initialize_ntrmdt)) init_ntrmdt = initialize_ntrmdt - - ! if (init_rseed) then - - ! write (logunit,*) 'initializing random seed from scratch' - - ! if (present(ens_id)) then - - ! call get_init_Pert_rseed( N_ens, ens_id, Pert_rseed(1,:) ) - - ! else - - ! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'ens_id not present') - - ! end if - - ! end if - - ! ! ----------------------------------------------------------------- - - ! diagn_only = .false. - - ! if (present(diagnose_pert_only)) diagn_only = diagnose_pert_only - - ! if ( diagn_only .and. (init_rseed .or. init_ntrmdt) ) then - - ! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'contradictory optional inputs') - - ! end if - - ! ! ----------------------------------------------------------------- - - ! call get_pert( & - ! N_pert, N_ens, & - ! pert_grid_f, pert_grid_l, & - ! dtstep, & - ! pert_param, & - ! Pert_rseed, & - ! Pert_ntrmdt, & - ! Pert_grid, & - ! initialize_rseed=init_rseed, & - ! initialize_ntrmdt=init_ntrmdt, & - ! diagnose_pert_only=diagn_only ) - - ! ! ----------------------------------------------------------------- - - ! ! map to tile space - - ! do i=1,N_pert - ! do n_e=1,N_ens - - ! grid_data = Pert_grid(i,:,:,n_e) - - ! ! this call to grid2tile() links the grid on which perturbations - ! ! are computed to the GEOS5 tile_grid - - ! call grid2tile( pert_grid_l, N_catl, tile_coord_l, grid_data, & - ! tile_data) - - ! Pert_tile(i,:,n_e) = tile_data - - ! end do - ! end do - - ! end subroutine get_tile_pert - - ! ********************************************************************* - subroutine interpolate_pert_to_timestep( & date_time, pert_time_old, pert_dtstep_real, & Pert_old, Pert_new, Pert_ntp ) @@ -2407,194 +2230,6 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & end subroutine io_pert_rstrt -! subroutine initialize_perturbations( & -! N_catl, N_ens, ens_id, start_time, & -! restart_path, restart_domain, restart_id, work_path, exp_id, & -! tile_coord_l, pert_grid_f, pert_grid_l, & -! N_force_pert, N_progn_pert, & -! force_pert_param, progn_pert_param, & -! Pert_rseed, Force_pert_ntrmdt_l, Progn_pert_ntrmdt_l, & -! Force_pert_tile_new, Force_pert_tile_old, & -! Progn_pert_tile_new, Progn_pert_tile_old ) - -! ! Initialize perturbations variables either from a restart file or -! ! by reinitializing the seed -! ! -! ! reichle, 21 Jun 2005 -! ! reichle, 16 Oct 2008 - eliminated logical variable "restart_pert" from input list -! ! -! ! ----------------------------------------------------------------- - -! implicit none - -! integer, intent(in) :: N_catl, N_ens - -! integer, intent(in), dimension(N_ens) :: ens_id - -! type(date_time_type), intent(in) :: start_time - -! character(200), intent(in) :: restart_path, work_path - -! character(40), intent(in) :: restart_domain, restart_id, exp_id - -! type(tile_coord_type), dimension(:), pointer :: tile_coord_l ! input - -! type(grid_def_type), intent(in) :: pert_grid_f, pert_grid_l - -! integer, intent(in) :: N_force_pert, N_progn_pert - -! type(pert_param_type), dimension(:), pointer :: force_pert_param ! input -! type(pert_param_type), dimension(:), pointer :: progn_pert_param ! input - -! integer, dimension(NRANDSEED,N_ens), intent(out) :: Pert_rseed - -! real, dimension(N_force_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens), & -! intent(out) :: Force_pert_ntrmdt_l - -! real, dimension(N_progn_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens), & -! intent(out) :: Progn_pert_ntrmdt_l - -! real, dimension(N_force_pert,N_catl,N_ens), intent(out) :: & -! Force_pert_tile_new, Force_pert_tile_old - -! real, dimension(N_progn_pert,N_catl,N_ens), intent(out) :: & -! Progn_pert_tile_new, Progn_pert_tile_old - -! character(len=*), parameter :: Iam = 'initialize_perturbations' -! character(len=400) :: err_msg - -! ! --------------------------------- - -! ! locals - -! character(200) :: restart_path_tmp - -! integer :: n_e, rc - -! logical :: initialize_rseed, initialize_ntrmdt, diagnose_pert_only, restart_pert - -! ! ----------------------------------------------------------------------- - -! write (logunit,*) - -! ! CHANGED: Replaced call to add_domain_to_path by its content -! ! restart_path_tmp = add_domain_to_path( restart_path, restart_domain ) -! restart_path_tmp = trim(restart_path) // '/' // trim(restart_domain) // '/' - -! initialize_rseed = .true. -! initialize_ntrmdt = .true. - -! diagnose_pert_only = .false. - -! restart_pert = .false. ! assume restart file is NOT available - -! ! try getting perturbations prognostics from restart file - -! do n_e=1,N_ens - -! call io_pert_rstrt( 'r', restart_path_tmp, restart_id, ens_id(n_e), & -! start_time, tile_coord_l, pert_grid_l, pert_grid_f, & -! N_force_pert, N_progn_pert, Pert_rseed(:,n_e), & -! Force_pert_ntrmdt_l(:,:,:,n_e), Progn_pert_ntrmdt_l(:,:,:,n_e), rc ) - -! if (n_e==1) then - -! ! set restart_pert to true if first pert restart file was successfully read - -! if (rc==0) restart_pert = .true. - -! else - -! ! stop if restart file was read for first but not for current ensemble member - -! if (rc/=0 .and. restart_pert) then -! err_msg = 'found pert restart file for some but not all ens members' -! call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) -! end if - -! end if - -! end do - -! ! broadcast Pert_rseed -! call MPI_Bcast(Pert_rseed,NRANDSEED*N_ens,MPI_INTEGER,0,mpicomm,mpierr) - -! ! restart_pert is now true if pert restart files were available for all ens members, -! ! false otherwise - -! if (restart_pert) then - -! initialize_rseed = .false. -! initialize_ntrmdt = .false. - -! diagnose_pert_only = .true. - -! end if - -! ! -------------------------------------------------------------------- -! ! -! ! get perturbations prognostics (unless read from restart file) and -! ! perturbations diagnostics - -! if (N_force_pert>0) then - -! call get_tile_pert( & -! N_force_pert, N_ens, pert_grid_f, pert_grid_l, & -! nodata_generic, & -! N_catl, tile_coord_l, & -! force_pert_param, & -! Pert_rseed, & -! Force_pert_ntrmdt_l, & -! Force_pert_tile_old, & -! ens_id=ens_id, & -! initialize_rseed=initialize_rseed, & -! initialize_ntrmdt=initialize_ntrmdt, & -! diagnose_pert_only=diagnose_pert_only ) - -! Force_pert_tile_new = Force_pert_tile_old - -! initialize_rseed = .false. - -! end if - -! if (N_progn_pert>0) then - -! call get_tile_pert( & -! N_progn_pert, N_ens, pert_grid_f, pert_grid_l, & -! nodata_generic, & -! N_catl, tile_coord_l, & -! progn_pert_param, & -! Pert_rseed, & -! Progn_pert_ntrmdt_l, & -! Progn_pert_tile_old, & -! ens_id=ens_id, & -! initialize_rseed=initialize_rseed, & -! initialize_ntrmdt=initialize_ntrmdt, & -! diagnose_pert_only=diagnose_pert_only ) - -! Progn_pert_tile_new = Progn_pert_tile_old - -! end if - -! ! -------------------------------------------------------------------- -! ! -! ! if no restart file was available or restart file was from a -! ! different experiment, write out initial restart file -! ! for current experiment - -! if ( (.not. restart_pert) .or. (trim(restart_path_tmp)/=trim(work_path)) ) then - -! do n_e=1,N_ens -! call io_pert_rstrt( 'w', work_path, exp_id, ens_id(n_e), & -! start_time, tile_coord_l, pert_grid_l, pert_grid_f, & -! N_force_pert, N_progn_pert, Pert_rseed(:,n_e), & -! Force_pert_ntrmdt_l(:,:,:,n_e), Progn_pert_ntrmdt_l(:,:,:,n_e) ) -! end do - -! end if - -! end subroutine initialize_perturbations - ! ****************************************************************** ! handle return code of nf90_* calls diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 index 2246f1c4..6082d52d 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 @@ -312,7 +312,9 @@ subroutine GEOSldas_get_pert( & end subroutine GEOSldas_get_pert - subroutine LDASsa_get_pert( & + ! ****************************************************************** + + subroutine LDASsa_get_pert( & N_pert, N_ens, & pert_grid_f, pert_grid_l, & dtstep, & diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index b1ed0f41..f91a66cf 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -62,13 +62,13 @@ module GEOS_MetforceGridCompMod end type T_MET_FORCING ! Internal state and its wrapper - type T_DATAATM_STATE + type T_METFORCE_STATE private type(T_MET_FORCING) :: mf - end type T_DATAATM_STATE - type DATAATM_WRAP - type(T_DATAATM_STATE), pointer :: ptr=>null() - end type DATAATM_WRAP + end type T_METFORCE_STATE + type METFORCE_WRAP + type(T_METFORCE_STATE), pointer :: ptr=>null() + end type METFORCE_WRAP !! Wrapper to the tile_coord variable !type T_TILECOORD_STATE @@ -104,8 +104,8 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: comp_name ! Local variables - type(T_DATAATM_STATE), pointer :: internal - type(DATAATM_WRAP) :: wrap + type(T_METFORCE_STATE), pointer :: internal + type(METFORCE_WRAP) :: wrap ! Begin... @@ -143,7 +143,7 @@ subroutine SetServices(gc, rc) allocate(internal, stat=status) VERIFY_(status) wrap%ptr => internal - call ESMF_UserCompSetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompSetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) ! Set the state variable specs @@ -572,8 +572,8 @@ subroutine Initialize(gc, import, export, clock, rc) type(T_MET_FORCING) :: mf ! Internal private state variables - type(T_DATAATM_STATE), pointer :: internal=>null() - type(DATAATM_WRAP) :: wrap + type(T_METFORCE_STATE), pointer :: internal=>null() + type(METFORCE_WRAP) :: wrap type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), pointer :: tile_coord(:)=>null() @@ -606,7 +606,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! Get component's internal private state - call ESMF_UserCompGetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr @@ -767,8 +767,8 @@ subroutine Run(gc, import, export, clock, rc) type(date_time_type) :: force_time_prv, force_time_nxt, model_time_nxt ! Private internal state variables - type(T_DATAATM_STATE), pointer :: internal=>null() - type(DATAATM_WRAP) :: wrap + type(T_METFORCE_STATE), pointer :: internal=>null() + type(METFORCE_WRAP) :: wrap type(TILECOORD_WRAP) :: tcwrap ! LDAS' tile_coord variable type(tile_coord_type), pointer :: tile_coord(:) @@ -851,7 +851,7 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) ! Get component's internal private state - call ESMF_UserCompGetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr @@ -1239,8 +1239,8 @@ subroutine Finalize(gc, import, export, clock, rc) ! Local variables type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj - type(T_DATAATM_STATE), pointer :: internal - type(DATAATM_WRAP) :: wrap + type(T_METFORCE_STATE), pointer :: internal + type(METFORCE_WRAP) :: wrap type(ESMF_Alarm) :: MetForcing !external :: GEOS_closefile ! Begin... @@ -1255,7 +1255,7 @@ subroutine Finalize(gc, import, export, clock, rc) VERIFY_(status) ! Get component's internal private state - call ESMF_UserCompGetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr From c1f746f299e016e8008d4f9c3baa62bd95141f53 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 20 May 2020 11:39:46 -0400 Subject: [PATCH 25/42] synching develop into BRIDGE --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index e461c33c..f9970364 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.3 +branch = master protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = 1.8.4 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 89b74368ae36771a15e910b3f54f75534fbd7a95 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 22 May 2020 08:09:42 -0400 Subject: [PATCH 26/42] point to latest release 1.8.5 of GCM GridComp (#227) --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index e461c33c..e9039ff2 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = 1.8.4 +tag = 1.8.5 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From f95f93d8978dbe2a7b86ae029c5b8e8c39467168 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 29 May 2020 14:00:26 -0400 Subject: [PATCH 27/42] Sync Bridge to master (#232) --- README.md | 15 +- src/Applications/LDAS_App/GEOSldas_HIST.rc | 17 +- src/Applications/LDAS_App/GEOSldas_LDAS.rc | 12 +- src/Applications/LDAS_App/ldas_setup | 76 ++- src/Applications/LDAS_App/lenkf.j.template | 2 +- src/Applications/LDAS_App/mwrtm_bin2nc4.F90 | 44 +- src/Applications/LDAS_App/process_hist.csh | 4 +- src/Applications/LDAS_App/tile_bin2nc4.F90 | 91 +-- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 41 +- .../GEOSens_GridComp/GEOS_EnsGridComp.F90 | 50 +- .../GEOS_LandAssimGridComp.F90 | 99 +++- .../clsm_adapt_routines.F90 | 108 +--- .../clsm_bias_routines.F90 | 92 +--- .../clsm_ensdrv_out_routines.F90 | 52 +- .../clsm_ensupd_enkf_update.F90 | 10 +- .../clsm_ensupd_upd_routines.F90 | 88 +-- .../GEOSlandassim_GridComp/mwRTM_routines.F90 | 14 +- .../GEOSlandassim_GridComp/mwRTM_types.F90 | 59 +- .../LDAS_PertRoutines.F90 | 11 - .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 4 +- .../Shared/LDAS_RepairForcing.F90 | 8 +- .../Shared/LDAS_ensdrv_Globals.F90 | 28 +- .../Shared/LDAS_ensdrv_init_routines.F90 | 520 +----------------- 23 files changed, 367 insertions(+), 1078 deletions(-) diff --git a/README.md b/README.md index 1ac6c945..c2015d92 100644 --- a/README.md +++ b/README.md @@ -63,16 +63,7 @@ See below for how to build the model in multiple steps. ## How to Set Up and Run GEOSldas -a) Obtain an interactive _compute_ node: - -``` -xalloc --nodes=1 -``` - -The GEOSldas setup script uses MPI and **must** be run on a compute node. (For NCCS SLES11, a login node also works.) - - -b) On the _compute_ node, set up the job as follows: +a) Set up the job as follows: ``` cd (build_path)/GEOSldas/install/bin @@ -113,9 +104,9 @@ ldas_setup sample -h ldas_setup setup -h ``` -Configure the experiment output by editing the ```HISTORY.rc``` file. +b) Configure the experiment output by editing the ```./run/HISTORY.rc``` file as needed. -c) Finally, run the job: +c) Run the job: ``` cd [exp_path]/[exp_name]/run/ sbatch lenkf.j diff --git a/src/Applications/LDAS_App/GEOSldas_HIST.rc b/src/Applications/LDAS_App/GEOSldas_HIST.rc index 193b7554..0d938044 100644 --- a/src/Applications/LDAS_App/GEOSldas_HIST.rc +++ b/src/Applications/LDAS_App/GEOSldas_HIST.rc @@ -16,6 +16,7 @@ COLLECTIONS: #EASE 'tavg24_1d_lnd_Nt' #CUBE 'tavg24_2d_lnd_Nx' #ASSIM 'SMAP_L4_SM_gph' +# 'inst1_1d_lnr_Nt' # 'catch_progn_incr' :: @@ -323,10 +324,22 @@ COLLECTIONS: 'TA' , 'ENSAVG' , 'temp_lowatmmodlay' , 'QA' , 'ENSAVG' , 'specific_humidity_lowatmmodlay' , 'UU' , 'ENSAVG' , 'windspeed_lowatmmodlay' , - 'GRN' , 'VEGDYN' , 'vegetation_greenness_fraction' , - 'LAI' , 'VEGDYN' , 'leaf_area_index' , + 'GRN' , 'VEGDYN' , 'vegetation_greenness_fraction' , + 'LAI' , 'VEGDYN' , 'leaf_area_index' , :: + inst1_1d_lnr_Nt.descr: 'Tile-space,1-Hourly,Instantaneous,Single-Level,Assimilation,Land Nature Run Diagnostics', + inst1_1d_lnr_Nt.template: '%y4%m2%d2_%h2%n2z.bin' , + inst1_1d_lnr_Nt.mode: 'instantaneous' , + inst1_1d_lnr_Nt.frequency: 010000 , + inst1_1d_lnr_Nt.ref_time: 000000, + inst1_1d_lnr_Nt.fields: 'TPSURF' , 'ENSAVG' , 'surface_temp' , + 'TSOIL1TILE' , 'ENSAVG' , 'soil_temp_layer1' , + 'TPSNOW' , 'ENSAVG' , 'snow_temp_layer1' , + 'TB_LAND_1410MHZ_40DEG_HPOL' , 'LANDASSIM' , 'tb_h' , + 'TB_LAND_1410MHZ_40DEG_VPOL' , 'LANDASSIM' , 'tb_v' , + :: + catch_progn_incr.descr: 'Tile-space,3-Hourly,Instantaneous,Single-Level,Assimilation,Ensemble-Average Land Prognostics Increments', catch_progn_incr.template: '%y4%m2%d2_%h2%n2z.bin', catch_progn_incr.mode: 'instantaneous', diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index c4ebd5e5..3b59a389 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -38,7 +38,7 @@ LSM_CHOICE: 1 # # Specify extremities of lat/lon rectangle: # Max lat/lon range: lon=-180:180, lat=-90:90. -# If only whitelist should be used, specify dummy valuessuch that: +# If only whitelist should be used, specify dummy values such that: # MINLON > MAXLON and MINLAT > MAXLAT. # # MINLON: -180. @@ -46,7 +46,7 @@ LSM_CHOICE: 1 # MINLAT: -90. # MAXLAT: 90. # -# Specify path and filenames for blacklist and whitelist files: +# Path and filenames for blacklist and whitelist files. # (May leave blank.) # # BLACK_FILE: '' @@ -63,8 +63,8 @@ MET_HINTERP: 1 # ---- Specify if running model only or data assimilation # -# NO : model only (DEFAULT; with --runmodel option) -# YES : assimilation (without --runmodel option) +# NO : model only, with or without perturbations (default) +# YES : assimilation (full land analysis or just processing of obs for "innovations" output) # LAND_ASSIM: NO @@ -164,10 +164,6 @@ SURFRC: LDAS.rc # DYCORE: none -# ---- Only one surface level -# -LM: 1 - # ---- For MAPL_RestartOptional # MAPL_ENABLE_BOOTSTRAP: YES diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 68c7d0d1..92efbe09 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -44,7 +44,7 @@ class LDASsetup: 'RESTART_DOMAIN','RESTART_ID','BCS_PATH','TILING_FILE','GRN_FILE','LAI_FILE','NIRDF_FILE', 'VISDF_FILE','CATCH_DEF_FILE','NDVI_FILE', 'NML_INPUT_PATH','HISTRC_FILE','RST_FROM_GLOBAL','JOB_SGMT','NUM_SGMT','POSTPROC_HIST', - 'MINLON','MAXLON','MINLAT','MAXLAT','BLACK_FILE','WHITE_FILE','MWRTM_FILE'] + 'MINLON','MAXLON','MINLAT','MAXLAT','BLACK_FILE','WHITE_FILE','MWRTM_FILE','GRIDNAME'] # ------ @@ -104,6 +104,7 @@ class LDASsetup: self.has_geos_pert = False self.has_ldassa_pert = False self.nSegments = 1 + self.perturb = 0 # ------ # Read exe input file which is required to set up the dir # ------ @@ -142,6 +143,9 @@ class LDASsetup: assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None _first_ens_id = int(self.rqdExeInp.get('FIRST_ENS_ID',0)) + self.perturb = int(self.rqdExeInp.get('PERTURBATIONS',0)) + if self.nens > 1: + self.perturb = 1 self.ensdirs = ['ens%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] self.ensids = ['%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] if (self.nens == 1) : @@ -275,8 +279,6 @@ class LDASsetup: if 'GRIDNAME' not in self.rqdExeInp : tmptile =self.rqdExeInp['TILING_FILE'] self.rqdExeInp['GRIDNAME'] = linecache.getline(tmptile, 3).strip() - if 'RESOLUTION' not in self.rqdExeInp : - self.rqdExeInp['RESOLUTION']= os.path.split(os.path.split(self.rqdExeInp['BCS_PATH'])[0])[1] if 'LSM_CHOICE' not in self.rqdExeInp: self.rqdExeInp['LSM_CHOICE'] = 1 @@ -772,7 +774,7 @@ class LDASsetup: catchRstFile = self.exphome+'/'+exp_id+'/mk_restarts/'+self.catch+'_internal_rst.'+YYYYMMDD # catchment restart file - print 'catchRstFile1: ' + catchRstFile + print 'catchRstFile: ' + catchRstFile if os.path.isfile(catchRstFile) : catchLocal = self.rstdir+ens +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 @@ -809,14 +811,14 @@ class LDASsetup: vegdynRstFile0 = vegdynRstFile else : vegdynRstFile = vegdynRstFile0 - _perturb = 1 if self.nens > 1 else 0 - if (self.has_geos_pert and _perturb == 1) : + + if (self.has_geos_pert and self.perturb == 1) : pertRstFile = rstpath+ens +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.landpert_internal_rst.'+y4m2d2_h2m2 pertLocal = self.rstdir+ens +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landpert_internal_rst.'+y4m2d2_h2m2 shutil.copy(pertRstFile,pertLocal) pertRstFile = pertLocal - if (self.has_ldassa_pert and _perturb == 1 ) : + if (self.has_ldassa_pert and self.perturb == 1 ) : pertRstFile = rstpath+ens +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+ens+'.pert_ldas_rst.'+y4m2d2_h2m2+'z.bin' pertLocal = self.rstdir+ens +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landpert_internal_rst.'+y4m2d2_h2m2 print "Convert LDASsa pert " + ensid + " rst to GEOSldas rst" @@ -828,7 +830,7 @@ class LDASsetup: os.symlink(catchRstFile, myCatchRst) os.symlink(vegdynRstFile, myVegRst) - if ( (self.has_geos_pert or self.has_ldassa_pert) and _perturb == 1 ): + if ( (self.has_geos_pert or self.has_ldassa_pert) and self.perturb == 1 ): os.symlink(pertRstFile, myPertRst) # catch_param restar file @@ -896,18 +898,17 @@ class LDASsetup: etcdir = self.blddirLn + '/etc' #defalt nml - default_nml = glob.glob(etcdir+'/LDASsa_DEFAULT*.nml') + default_nml = glob.glob(etcdir+'/LDASsa_DEFAULT_inputs_*.nml') for nmlfile in default_nml: shortfile=self.rundir+'/'+nmlfile.split('/')[-1] shutil.copy2(nmlfile, shortfile) # special nml special_nml=[] if 'NML_INPUT_PATH' in self.rqdExeInp : - special_nml = glob.glob(self.rqdExeInp['NML_INPUT_PATH']+'/*SPECIAL*nml') + special_nml = glob.glob(self.rqdExeInp['NML_INPUT_PATH']+'/LDASsa_SPECIAL_inputs_*.nml') for nmlfile in special_nml: - if (_nens > 1) : - shortfile=nmlfile.split('/')[-1] - shutil.copy2(nmlfile, self.rundir+'/'+shortfile) + shortfile=nmlfile.split('/')[-1] + shutil.copy2(nmlfile, self.rundir+'/'+shortfile) # get optimzed NX and IMS if os.path.isfile('optimized_distribution'): @@ -958,9 +959,8 @@ class LDASsetup: if '-CF' in self.rqdExeInp['GRIDNAME'] : GRID ='CUBE ' + self.rqdExeInp['GRIDNAME'] + ' ' +tmprcfile _assim = '1' if self.assim else '0' - _perturb = '1' if self.nens > 1 else '0' cmd ='./process_hist.csh '+ str(self.rqdExeInp['LSM_CHOICE']) + ' ' + str(self.rqdExeInp['AEROSOL_DEPOSITION']) + \ - ' ' + GRID + ' ' + str(self.rqdExeInp['RUN_IRRIG']) + ' ' + _assim + ' '+ _perturb + ' ' + GRID + ' ' + str(self.rqdExeInp['RUN_IRRIG']) + ' ' + _assim + ' '+ str(self.nens) print(cmd) os.system(cmd) #sp.call(cmd) @@ -1009,8 +1009,9 @@ class LDASsetup: # create BC in rc file tmpl_ = '' if self.nens >1 : - ldasrcInp['PERTURBATIONS'] ='1' tmpl_='%s' + if self.perturb == 1: + ldasrcInp['PERTURBATIONS'] ='1' bcval=['../input/green','../input/lai','../input/ndvi','../input/nirdf','../input/visdf'] bckey=['GREEN','LAI','NDVI','NIRDF','VISDF'] for key, val in zip(bckey,bcval): @@ -1032,8 +1033,7 @@ class LDASsetup: rstkey=[catch_,'VEGDYN'] rstval=[self.catch,'vegdyn'] - _perturb = 1 if self.nens > 1 else 0 - if((self.has_ldassa_pert or self.has_geos_pert) and _perturb == 1) : + if((self.has_ldassa_pert or self.has_geos_pert) and self.perturb == 1) : rstkey=[catch_,'VEGDYN','LANDPERT'] rstval=[self.catch,'vegdyn','landpert'] @@ -1042,38 +1042,36 @@ class LDASsetup: valn='../input/restart/mwrtm_param_rst' ldasrcInp[keyn]= valn + if self.nens > 1 : + keyn='ENS_ID_WIDTH' + valn='4' + ldasrcInp[keyn]= valn + if self.has_landassim_seed and self.assim : keyn='LANDASSIM_OBSPERTRSEED_RESTART_FILE' - valn='../input/restart/landassim_obspertrseed%s_rst' + valn='../input/restart/landassim_obspertrseed'+tmpl_+'_rst' ldasrcInp[keyn]= valn if self.assim: keyn='LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE' - valn='landassim_obspertrseed%s_checkpoint' - ldasrcInp[keyn]= valn - - ensid ="" - if self.nens > 1 : - ensid ="%s" - keyn='ENS_ID_WIDTH' - valn='4' + valn='landassim_obspertrseed'+tmpl_+'_checkpoint' ldasrcInp[keyn]= valn for key,val in zip(rstkey,rstval) : keyn = key+ '_INTERNAL_RESTART_FILE' - valn = '../input/restart/'+val+ensid+'_internal_rst' + valn = '../input/restart/'+val+tmpl_+'_internal_rst' ldasrcInp[keyn]= valn # checkpoint file and its type keyn = catch_ + '_INTERNAL_CHECKPOINT_FILE' - valn = self.catch+ensid+'_internal_checkpoint' + valn = self.catch+tmpl_+'_internal_checkpoint' ldasrcInp[keyn]= valn # for lat/lon and EASE tile space, specify LANDPERT checkpoint file here (via MAPL); # for cube-sphere tile space, Landpert GC will set up LANDPERT checkpoint file - if('-CF' not in self.rqdExeInp['GRIDNAME'] and _perturb == 1): + if('-CF' not in self.rqdExeInp['GRIDNAME'] and self.perturb == 1): keyn = 'LANDPERT_INTERNAL_CHECKPOINT_FILE' - valn = 'landpert'+ensid+'_internal_checkpoint' + valn = 'landpert'+tmpl_+'_internal_checkpoint' ldasrcInp[keyn]= valn @@ -1535,28 +1533,28 @@ def parseCmdLine(): 'batinpfile', help='input file with arguments for SLURM', ) - p_setup.add_argument( - '--runmodel', - help='obsolete, no effect any more', - action='store_true', - ) p_setup.add_argument( '--account', - help='replace the account in batinpfile)', + help='replace computing/sponsor account in batinp file', type=str, default='None' ) + p_setup.add_argument( + '--runmodel', + help='Obsolete.', + action='store_true', + ) spltgrp = p_setup.add_mutually_exclusive_group() spltgrp.add_argument( '--daysperjob', type=int, metavar='N', - help='This option is no longer available. Use NUM_SGMT and JOB_SGMT in exeinp file.', + help='Obsolete. Use NUM_SGMT and JOB_SGMT in exeinp file.', ) spltgrp.add_argument( '--monthsperjob', type=int, metavar='N', - help='This option is no longer available. Use NUM_SGMT and JOB_SGMT in exeinp file.', + help='Obsolete. Use NUM_SGMT and JOB_SGMT in exeinp file.', ) return p.parse_args() diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index 07748581..f18cf98b 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -502,7 +502,7 @@ EOF set dayl = `echo $time_steps[$LEN] | cut -c1-8` set day1 = `echo $time_steps[1] | cut -c1-8` @ NAVAIL = ($dayl - $day1) + 1 - else if( $LEN_ !=0 ) then + else if( $LEN_ != 0 ) then set dayl = `echo $time_steps_[$LEN] | cut -c1-8` set day1 = `echo $time_steps_[1] | cut -c1-8` @ NAVAIL = ($dayl - $day1) + 1 diff --git a/src/Applications/LDAS_App/mwrtm_bin2nc4.F90 b/src/Applications/LDAS_App/mwrtm_bin2nc4.F90 index 5acc4619..b3f39ac0 100644 --- a/src/Applications/LDAS_App/mwrtm_bin2nc4.F90 +++ b/src/Applications/LDAS_App/mwrtm_bin2nc4.F90 @@ -20,30 +20,30 @@ PROGRAM mwrtm_bin2nc4 character(len=:),allocatable :: shnms(:) type(mwRTM_param_type), allocatable :: mwp(:) integer :: unitnum - logical :: is_nodata + logical :: mwp_nodata nVars = 18 - shnms =[ & -'MWRTM_VEGCLS ',& -'MWRTM_SOILCLS ',& -'MWRTM_SAND ',& -'MWRTM_CLAY ',& -'MWRTM_POROS ',& -'MWRTM_WANGWT ',& -'MWRTM_WANGWP ',& -'MWRTM_RGHHMIN ',& -'MWRTM_RGHHMAX ',& -'MWRTM_RGHWMIN ',& -'MWRTM_RGHWMAX ',& -'MWRTM_RGHNRH ',& -'MWRTM_RGHNRV ',& -'MWRTM_RGHPOLMIX',& -'MWRTM_OMEGA ',& -'MWRTM_BH ',& -'MWRTM_BV ',& -'MWRTM_LEWT '] - + shnms = [ & + 'MWRTM_VEGCLS ',& + 'MWRTM_SOILCLS ',& + 'MWRTM_SAND ',& + 'MWRTM_CLAY ',& + 'MWRTM_POROS ',& + 'MWRTM_WANGWT ',& + 'MWRTM_WANGWP ',& + 'MWRTM_RGHHMIN ',& + 'MWRTM_RGHHMAX ',& + 'MWRTM_RGHWMIN ',& + 'MWRTM_RGHWMAX ',& + 'MWRTM_RGHNRH ',& + 'MWRTM_RGHNRV ',& + 'MWRTM_RGHPOLMIX',& + 'MWRTM_OMEGA ',& + 'MWRTM_BH ',& + 'MWRTM_BV ',& + 'MWRTM_LEWT '] + ! processing command line agruments I = iargc() @@ -123,7 +123,7 @@ PROGRAM mwrtm_bin2nc4 read (unitnum) VAR; mwp(1:NTILES)%lewt = VAR(1:NTILES) do i = 1, NTILES - call mwRTM_param_nodata_check( mwp(i), is_nodata ) + call mwRTM_param_nodata_check( mwp(i), mwp_nodata ) enddo VAR = real(mwp(1:NTILES)%vegcls) diff --git a/src/Applications/LDAS_App/process_hist.csh b/src/Applications/LDAS_App/process_hist.csh index 4adfb2c3..77ca5699 100755 --- a/src/Applications/LDAS_App/process_hist.csh +++ b/src/Applications/LDAS_App/process_hist.csh @@ -11,7 +11,7 @@ setenv GRIDNAME $4 setenv HISTRC $5 setenv RUN_IRRIG $6 setenv ASSIM $7 -setenv PERTURB $8 +setenv NENS $8 echo $GRIDNAME @@ -43,7 +43,7 @@ if($LSM_CHOICE == 2) then sed -i 's/>>>HIST_CATCHCN<< 1) then set GridComp = ENSAVG sed -i 's|VEGDYN|'VEGDYN0000'|g' $HISTRC # sed -i 's|DATAATM|'DATAATM0000'|g' $HISTRC diff --git a/src/Applications/LDAS_App/tile_bin2nc4.F90 b/src/Applications/LDAS_App/tile_bin2nc4.F90 index dcf0fb92..c29b56b9 100644 --- a/src/Applications/LDAS_App/tile_bin2nc4.F90 +++ b/src/Applications/LDAS_App/tile_bin2nc4.F90 @@ -187,20 +187,22 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) SELECT case (trim(SHORT_NAME)) - ! For SM_L4 + ! For SM_L4 + ! reichle, 20 May 2020: verified SHORT_NAME and corrected UNITS to match SMAP L4_SM Product Specs; LONG_NAME (mostly) from GEOS_CatchGridComp.F90 + case ('sm_surface'); LONG_NAME = 'water_surface_layer'; UNITS = 'm3 m-3' case ('sm_rootzone'); LONG_NAME = 'water_root_zone'; UNITS = 'm3 m-3' case ('sm_profile'); LONG_NAME = 'water_ave_prof'; UNITS = 'm3 m-3' case ('sm_surface_wetness'); LONG_NAME = 'surface_soil_wetness'; UNITS = '1' case ('sm_rootzone_wetness'); LONG_NAME = 'root_zone_soil_wetness'; UNITS = '1' case ('sm_profile_wetness'); LONG_NAME = 'ave_prof_soil_wetness'; UNITS = '1' - case ('surface_temp'); LONG_NAME = 'ave_catchment_temp_incl_snw'; UNITS = 'k' - case ('soil_temp_layer1'); LONG_NAME = 'soil_temperatures_layer_1'; UNITS = 'k' - case ('soil_temp_layer2'); LONG_NAME = 'soil_temperatures_layer_2'; UNITS = 'k' - case ('soil_temp_layer3'); LONG_NAME = 'soil_temperatures_layer_3'; UNITS = 'k' - case ('soil_temp_layer4'); LONG_NAME = 'soil_temperatures_layer_4'; UNITS = 'k' - case ('soil_temp_layer5'); LONG_NAME = 'soil_temperatures_layer_5'; UNITS = 'k' - case ('soil_temp_layer6'); LONG_NAME = 'soil_temperatures_layer_6'; UNITS = 'k' + case ('surface_temp'); LONG_NAME = 'ave_catchment_temp_incl_snw'; UNITS = 'K' + case ('soil_temp_layer1'); LONG_NAME = 'soil_temperatures_layer_1'; UNITS = 'K' + case ('soil_temp_layer2'); LONG_NAME = 'soil_temperatures_layer_2'; UNITS = 'K' + case ('soil_temp_layer3'); LONG_NAME = 'soil_temperatures_layer_3'; UNITS = 'K' + case ('soil_temp_layer4'); LONG_NAME = 'soil_temperatures_layer_4'; UNITS = 'K' + case ('soil_temp_layer5'); LONG_NAME = 'soil_temperatures_layer_5'; UNITS = 'K' + case ('soil_temp_layer6'); LONG_NAME = 'soil_temperatures_layer_6'; UNITS = 'K' case ('snow_mass'); LONG_NAME = 'snow_mass'; UNITS = 'kg m-2' case ('snow_depth'); LONG_NAME = 'snow_depth_in_snow_covered_area'; UNITS = 'm' case ('land_evapotranspiration_flux'); LONG_NAME = 'Evaporation_land'; UNITS = 'kg m-2 s-1' @@ -227,9 +229,18 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('specific_humidity_lowatmmodlay'); LONG_NAME = 'specific_humidity_at_RefH'; UNITS = 'kg kg-1' case ('windspeed_lowatmmodlay'); LONG_NAME = 'wind_speed_at_RefH'; UNITS = 'm s-1' case ('vegetation_greenness_fraction'); LONG_NAME = 'greeness_fraction'; UNITS = '1' - case ('leaf_area_index'); LONG_NAME = 'leaf_area_index'; UNITS = '1' - ! Done for SM_L4 + case ('leaf_area_index'); LONG_NAME = 'leaf_area_index'; UNITS = 'm2 m-2' + ! additional defintions for SMAP Nature Run - reichle, 20 May 2020 + + case ('snow_temp_layer1'); LONG_NAME = 'temperature_top_snow_layer'; UNITS = 'K' + case ('tb_h'); LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Hpol'; UNITS = 'K' + case ('tb_v'); LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Vpol'; UNITS = 'K' + case ('TB_LAND_1410MHZ_40DEG_HPOL'); LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Hpol'; UNITS = 'K' + case ('TB_LAND_1410MHZ_40DEG_VPOL'); LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Vpol'; UNITS = 'K' + + ! Done for SM_L4 + case ('Tair'); LONG_NAME = 'air_temperature_at_RefH'; UNITS = 'K' case ('TA'); LONG_NAME = 'air_temperature_at_RefH'; UNITS = 'K' case ('Qair'); LONG_NAME = 'specific_humidity_at_RefH'; UNITS = 'kg kg-1' @@ -345,35 +356,39 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('RMELTBC002'); LONG_NAME = 'flushed_out_black_carbon_mass_flux_from_the_bottom_layer_bin_2'; UNITS = 'kg m-2 s-1' case ('RMELTOC001'); LONG_NAME = 'flushed_out_organic_carbon_mass_flux_from_the_bottom_layer_bin_1'; UNITS = 'kg m-2 s-1' case ('RMELTOC002'); LONG_NAME = 'flushed_out_organic_carbon_mass_flux_from_the_bottom_layer_bin_2'; UNITS = 'kg m-2 s-1' + + ! land assimilation increments for Catchment prognostic variables in coupled land-atmosphere DAS (#sqz 2020-01) + + case ('TCFSAT_INCR'); LONG_NAME = 'increment_canopy_temperature_saturated_zone'; UNITS = 'K' + case ('TCFTRN_INCR'); LONG_NAME = 'increment_canopy_temperature_transition_zone'; UNITS = 'K' + case ('TCFWLT_INCR'); LONG_NAME = 'increment_canopy_temperature_wilting_zone'; UNITS = 'K' + case ('QCFSAT_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone'; UNITS = 'kg kg-1' + case ('QCFTRN_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_transition_zone'; UNITS = 'kg kg-1' + case ('QCFWLT_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone'; UNITS = 'kg kg-1' + case ('CAPAC_INCR'); LONG_NAME = 'increment_interception_reservoir_capac'; UNITS = 'kg m-2' + case ('CATDEF_INCR'); LONG_NAME = 'increment_catchment_deficit'; UNITS = 'kg m-2' + case ('RZEXC_INCR'); LONG_NAME = 'increment_root_zone_excess'; UNITS = 'kg m-2' + case ('SRFEXC_INCR'); LONG_NAME = 'increment_surface_excess'; UNITS = 'kg m-2' + case ('GHTCNT1_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_1'; UNITS = 'J m-2' + case ('GHTCNT2_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_2'; UNITS = 'J m-2' + case ('GHTCNT3_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_3'; UNITS = 'J m-2' + case ('GHTCNT4_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_4'; UNITS = 'J m-2' + case ('GHTCNT5_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_5'; UNITS = 'J m-2' + case ('GHTCNT6_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_6'; UNITS = 'J m-2' + case ('WESNN1_INCR'); LONG_NAME = 'increment_snow_mass_layer_1'; UNITS = 'kg m-2' + case ('WESNN2_INCR'); LONG_NAME = 'increment_snow_mass_layer_2'; UNITS = 'kg m-2' + case ('WESNN3_INCR'); LONG_NAME = 'increment_snow_mass_layer_3'; UNITS = 'kg m-2' + case ('HTSNNN1_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_1'; UNITS = 'J m-2' + case ('HTSNNN2_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_2'; UNITS = 'J m-2' + case ('HTSNNN3_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_3'; UNITS = 'J m-2' + case ('SNDZN1_INCR'); LONG_NAME = 'increment_snow_depth_layer_1'; UNITS = 'm' + case ('SNDZN2_INCR'); LONG_NAME = 'increment_snow_depth_layer_2'; UNITS = 'm' + case ('SNDZN3_INCR'); LONG_NAME = 'increment_snow_depth_layer_3'; UNITS = 'm' + ! + ! default LONG_NAME and UNITS for nc4 files created by tile_bin2nc4.F90 (used for any SHORT_NAME not listed above): + ! + case default; LONG_NAME = 'not defined in tile_bin2nc4.F90'; UNITS = 'not defined in tile_bin2nc4.F90'; -!#sqz 2020-01 - case ('TCFSAT_INCR'); LONG_NAME = 'increment_canopy_temperature_saturated_zone'; UNITS = 'K' - case ('TCFTRN_INCR'); LONG_NAME = 'increment_canopy_temperature_transition_zone'; UNITS = 'K' - case ('TCFWLT_INCR'); LONG_NAME = 'increment_canopy_temperature_wilting_zone'; UNITS = 'K' - case ('QCFSAT_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone'; UNITS = 'kg kg-1' - case ('QCFTRN_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_transition_zone'; UNITS = 'kg kg-1' - case ('QCFWLT_INCR'); LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone'; UNITS = 'kg kg-1' - case ('CAPAC_INCR'); LONG_NAME = 'increment_interception_reservoir_capac'; UNITS = 'kg m-2' - case ('CATDEF_INCR'); LONG_NAME = 'increment_catchment_deficit'; UNITS = 'kg m-2' - case ('RZEXC_INCR'); LONG_NAME = 'increment_root_zone_excess'; UNITS = 'kg m-2' - case ('SRFEXC_INCR'); LONG_NAME = 'increment_surface_excess'; UNITS = 'kg m-2' - case ('GHTCNT1_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_1'; UNITS = 'J m-2' - case ('GHTCNT2_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_2'; UNITS = 'J m-2' - case ('GHTCNT3_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_3'; UNITS = 'J m-2' - case ('GHTCNT4_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_4'; UNITS = 'J m-2' - case ('GHTCNT5_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_5'; UNITS = 'J m-2' - case ('GHTCNT6_INCR'); LONG_NAME = 'increment_soil_heat_content_layer_6'; UNITS = 'J m-2' - case ('WESNN1_INCR'); LONG_NAME = 'increment_snow_mass_layer_1'; UNITS = 'kg m-2' - case ('WESNN2_INCR'); LONG_NAME = 'increment_snow_mass_layer_2'; UNITS = 'kg m-2' - case ('WESNN3_INCR'); LONG_NAME = 'increment_snow_mass_layer_3'; UNITS = 'kg m-2' - case ('HTSNNN1_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_1'; UNITS = 'J m-2' - case ('HTSNNN2_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_2'; UNITS = 'J m-2' - case ('HTSNNN3_INCR'); LONG_NAME = 'increment_heat_content_snow_layer_3'; UNITS = 'J m-2' - case ('SNDZN1_INCR'); LONG_NAME = 'increment_snow_depth_layer_1'; UNITS = 'm' - case ('SNDZN2_INCR'); LONG_NAME = 'increment_snow_depth_layer_2'; UNITS = 'm' - case ('SNDZN3_INCR'); LONG_NAME = 'increment_snow_depth_layer_3'; UNITS = 'm' - - case default; LONG_NAME = 'Check_GridComp'; UNITS = 'No to fix getAttribute table in tile_bin2nc4.F90'; end select if (present(LNAME)) str_atr = trim (LONG_NAME) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index ff8dd319..ae65d1fa 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -239,7 +239,7 @@ subroutine SetServices(gc, rc) rc = status & ) VERIFY_(status) - ! -CATCH-feeds-LANDPERT's-imports- + ! -LAND-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & SRC_NAME = ['TC ','CATDEF ','RZEXC ','SRFEXC ','WESNN1 ','WESNN2 ','WESNN3 ', & @@ -258,6 +258,8 @@ subroutine SetServices(gc, rc) enddo if(land_assim .or. mwRTM) then + ! -LAND-feeds-LANDASSIM's-imports- + ! Catchment model parameters from first LAND ens member, assumes no parameter perturbations! call MAPL_AddConnectivity( & gc, & SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & @@ -265,7 +267,7 @@ subroutine SetServices(gc, rc) 'ARS2 ', 'ARS3 ','ARA1 ','ARA2 ','ARA3 ','ARA4 ', & 'ARW1 ', 'ARW2 ','ARW3 ','ARW4 ','TSA1 ','TSA2 ','TSB1 ', & 'TSB2 ', 'ATAU ','BTAU ','ITY ','Z2CH ' ], & - SRC_ID = LAND(1), & + SRC_ID = LAND(1), & ! Note (1) ! DST_ID = LANDASSIM, & rc = status & ) @@ -842,14 +844,15 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) - ! Use landpert's output as the input to calculate the force ensemble average - ! W.J note: So far it is only for catchment model. - ! To make catchmentCN work with assim, the export from landgrid and catchmentCN grid need to be modified. + ! Use landpert's output as the input to calculate the ensemble average forcing + ! W.J note: So far it is only for the Catchment model. + ! To make CatchmentCN work with assim, the export from landgrid and catchmentCN grid need to be modified. if ( LSM_CHOICE == 1 ) then call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=1, userRC=status) VERIFY_(status) endif + ! Run the land model igc = LAND(i) call MAPL_TimerOn(MAPL, gcnames(igc)) call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) @@ -858,7 +861,15 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) - ! Use land's output as the input to calculate the ensemble average + ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 + igc = LANDPERT(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=4, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) + + ! Use LAND's output as the input to calculate the ensemble average + igc = LAND(i) if (LSM_CHOICE == 1) then ! collect cat_param call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=3, userRC=status) @@ -867,34 +878,24 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) if( mwRTM ) then - ! calculate ensemble-average L-band Tb (add up and normalize after last member has been added) + ! Calculate ensemble-average L-band Tb using LAND's output (add up and normalize after last member has been added) call ESMF_GridCompRun(gcs(LANDASSIM), importState=gex(igc), exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) VERIFY_(status) endif endif - ! Should this be moved to the beginning of the loop to avoid the pollution ? - ! THIS MUST BE MOVED AT LEAST TO BEFORE THE "ENSAVG/phase=3" CALL IF ENSEMBLE STATS OTHER THAN THE AVERAGE - ! ARE COMPUTED - reichle, 14 May 2020 - ! ApplyPrognPert - igc = LANDPERT(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=4, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) - enddo - !run land assim + ! Run land analysis if (land_assim) then igc = LANDASSIM call MAPL_TimerOn(MAPL, gcnames(igc)) - !import state is the export from ens_GridComp, assimilation run + ! Get EnKF increments and apply to "cat_progn" (imported from ENSAVG via "use" statement!); otherwise import state is export from ENSAVG call ESMF_GridCompRun(gcs(igc), importState=gex(ENSAVG), exportState=gex(igc), clock=clock, phase=1, userRC=status) VERIFY_(status) do i = 1, NUM_ENSEMBLE - ! update catch_progn + ! Extract updated exports from "cat_progn" call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(LAND(i)), clock=clock, phase=2, userRC=status) VERIFY_(status) diff --git a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 index e43a9692..ffafa75a 100644 --- a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 @@ -8,9 +8,9 @@ module GEOS_EnsGridCompMod use ESMF use MAPL_Mod use lsm_routines, only: DZGT - use LDAS_ensdrv_Globals, only: nodata_generic - use catch_types, ONLY: cat_progn_type - use catch_types, only: cat_param_type + use catch_types, only: cat_progn_type + use catch_types, only: cat_param_type + use, intrinsic :: ieee_arithmetic implicit none @@ -20,17 +20,18 @@ module GEOS_EnsGridCompMod public :: SetServices public :: catch_progn public :: catch_param + ! !DESCRIPTION: This GridComp collect ensemble member and then averages the vaiables form catchment !EOP - integer :: NUM_ENSEMBLE - integer :: collect_land_counter - integer :: collect_force_counter - integer,parameter :: NUM_SUBTILES=4 - real, parameter :: daylen = 86400. + integer :: NUM_ENSEMBLE + integer :: collect_land_counter + integer :: collect_force_counter + integer, parameter :: NUM_SUBTILES=4 + real :: enavg_nodata_threshold type(cat_progn_type),dimension(:,:), allocatable :: catch_progn - type(cat_param_type),dimension(:), allocatable :: catch_param + type(cat_param_type),dimension(: ), allocatable :: catch_param contains @@ -71,7 +72,7 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) - ! phase one: collect ensembl forces + ! phase one: collect forcing ensemble call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -1720,6 +1721,10 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) VERIFY_(STATUS) + ! nodata handling for ensemble average + _ASSERT( (MAPL_UNDEF>.9999*1.e15), Iam // ': nodata handling for ensemble average requires MAPL_UNDEF to be a very large number') + enavg_nodata_threshold = MAPL_UNDEF/(NUM_ENSEMBLE+1) + collect_land_counter = 0 collect_force_counter = 0 @@ -3322,7 +3327,30 @@ subroutine Collect_land_ens(gc, import, export, clock, rc) if(associated(SPLAND_enavg)) SPLAND_enavg = SPLAND_enavg/NUM_ENSEMBLE if(associated(SPWATR_enavg)) SPWATR_enavg = SPWATR_enavg/NUM_ENSEMBLE if(associated(SPSNOW_enavg)) SPSNOW_enavg = SPSNOW_enavg/NUM_ENSEMBLE - endif + + ! Deal with no-data-values + ! + ! Surface temperature components may be nodata in some but not all ensemble members. + ! (Nodata values are assigned in GEOS_CatchGridComp.F90 when the associated + ! area fraction is zero.) + ! + ! For now, the ensemble average is set to nodata if any member has a nodata value. + ! + ! Alternatively, only ensemble members with good values could be averaged, or the + ! averaging could use the associated area fraction as averaging weights. + ! + ! The simple detection implemented here relies on MAPL_UNDEF being many orders of + ! magnitude larger than any valid values, which works fine for Earth surface + ! temperatures as long as MAPL_UNDEF is 1.e15. + ! + ! - reichle, 29 May 2020 + + if(associated(TPSNOW_enavg)) where (TPSNOW_enavg > enavg_nodata_threshold) TPSNOW_enavg = MAPL_UNDEF + if(associated(TPSAT_enavg )) where (TPSAT_enavg > enavg_nodata_threshold) TPSAT_enavg = MAPL_UNDEF + if(associated(TPWLT_enavg )) where (TPWLT_enavg > enavg_nodata_threshold) TPWLT_enavg = MAPL_UNDEF + if(associated(TPUNST_enavg)) where (TPUNST_enavg > enavg_nodata_threshold) TPUNST_enavg = MAPL_UNDEF + + end if ! collect_land_counter==NUM_ENSEMBLE ! Turn timers off call MAPL_TimerOff(MAPL, "Collect_land") diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 5aa17990..741fb64a 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -29,7 +29,7 @@ module GEOS_LandAssimGridCompMod use LDAS_ensdrv_mpi, only: MPI_obs_param_type use LDAS_DateTimeMod, only: date_time_type - use LDAS_ensdrv_Globals, only: logunit, nodata_generic + use LDAS_ensdrv_Globals, only: logunit, LDAS_is_nodata, nodata_generic use LDAS_ConvertMod, only: esmf2ldas use LDAS_DriverTypes, only: met_force_type @@ -58,7 +58,7 @@ module GEOS_LandAssimGridCompMod use clsm_ensupd_enkf_update, only: output_incr_etc use clsm_ensupd_enkf_update, only: write_smapL4SMaup use clsm_ensdrv_out_routines, only: init_log, GEOS_output_smapL4SMlmc - use mwRTM_routines, only : mwRTM_get_Tb, catch2mwRTM_vars + use mwRTM_routines, only: mwRTM_get_Tb, catch2mwRTM_vars use, intrinsic :: ieee_arithmetic @@ -105,12 +105,16 @@ module GEOS_LandAssimGridCompMod real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) type(mwRTM_param_type), dimension(:), allocatable :: mwRTM_param - logical :: mwRTM_all_nodata ! no data for mwRTM_param - logical :: land_assim - logical :: mwRTM + logical :: mwRTM_all_nodata + logical :: land_assim + logical :: mwRTM + + logical, allocatable :: tb_nodata(:) contains + ! ****************************************************************************** + !BOP ! !IROUTINE: SetServices -- Sets ESMF services for component ! !INTERFACE: @@ -919,6 +923,8 @@ subroutine SetServices ( GC, RC ) end subroutine SetServices + ! ****************************************************************************** + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !BOP ! !IROTUINE: Initialize -- initialize method for LandAssim GC @@ -995,7 +1001,14 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) _VERIFY(STATUS) call init_log( myid, numprocs, master_proc ) + ! Get number of land tiles + call MAPL_Get(MAPL, LocStream=locstream,rc=status) + _VERIFY(status) + call MAPL_LocStreamGet(locstream, NT_LOCAL=land_nt_local,rc=status) + _VERIFY(status) + allocate(tb_nodata(land_nt_local)) + if ( .not. land_assim) then ! to arrive here, mwRTM must be .true. ! only need to calculate Tb for HISTORY; no processing of assimilation obs necessary; ! generic initialization is sufficient @@ -1053,11 +1066,6 @@ subroutine Initialize(gc, import, export, clock, rc) _VERIFY(status) tcinternal =>tcwrap%ptr tile_coord_l =>tcinternal%tile_coord - ! Get number of land tiles - call MAPL_Get(MAPL, LocStream=locstream,rc=status) - _VERIFY(status) - call MAPL_LocStreamGet(locstream, NT_LOCAL=land_nt_local,rc=status) - _VERIFY(status) allocate(Pert_rseed( NRANDSEED, NUM_ENSEMBLE), source = 0 ) allocate(Pert_rseed_r8(NRANDSEED, NUM_ENSEMBLE), source = 0.0d0) @@ -1153,9 +1161,16 @@ subroutine Initialize(gc, import, export, clock, rc) out_smapL4SMaup, & N_obsbias_max & ) - call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) - _VERIFY(STATUS) - if (index(GridName,"-CF") /=0) out_smapL4SMaup = .false. ! no out_smap for now if it is cs grid + + if (out_smapL4SMaup) then + + call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) + _VERIFY(STATUS) + _ASSERT( (NUM_ENSEMBLE>1), "out_smapL4SMaup=.true. only works for NUM_ENSEMBLE>1") + _ASSERT( (index(GridName,"EASEv2-M09") /=0), "out_smapL4SMaup=.true. only works with EASEv2-M09 tile space") + + end if + endif call MPI_BCAST(mwRTM, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) @@ -1187,6 +1202,8 @@ subroutine Initialize(gc, import, export, clock, rc) end subroutine Initialize + ! ****************************************************************************** + ! !IROUTINE: RUN ! !INTERFACE: subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) @@ -1789,6 +1806,8 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) end subroutine RUN + ! ****************************************************************************** + ! !IROTUINE: collecting and averaging subroutine UPDATE_ASSIM(gc, import, export, clock, rc) @@ -1940,6 +1959,7 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) end subroutine UPDATE_ASSIM + ! ****************************************************************************** ! subroutine to calculate Tb for HISTORY output @@ -1994,10 +2014,11 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) real, dimension(:), pointer :: TB_V_enavg ! local - real, allocatable, dimension(:) :: sfmc_mwRTM, tsoil_mwRTM - real, allocatable, dimension(:) :: dummy_real - real, allocatable, dimension(:) :: Tb_v_tmp, TB_h_tmp - + real, allocatable, dimension(:) :: sfmc_mwRTM, tsoil_mwRTM + real, allocatable, dimension(:) :: dummy_real + real, allocatable, dimension(:) :: Tb_h_tmp, TB_v_tmp + + integer :: N_catl, n, mpierr type(MAPL_LocStream) :: locstream @@ -2055,9 +2076,9 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) mwRTM_param%poros, & WCSF, & TPSURF, & - TP1-MAPL_TICE, & ! units deg C !!! + TP1, & ! units deg C !!! sfmc_mwRTM, & - tsoil_mwRTM ) + tsoil_mwRTM ) ! units Kelvin !!! ! calculate brightness temperatures ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] @@ -2081,22 +2102,36 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) else _ASSERT(.false., "top-of-atmosphere Tb calculation not yet implemented (incl_atm_terms=.true.)") end if - + if (collect_tb_counter == 0) then - TB_V_enavg = 0. TB_H_enavg = 0. + TB_V_enavg = 0. + tb_nodata = .false. endif + ! ensemble average Tb must be nodata if Tb of any member is nodata + + tb_nodata = tb_nodata .or. LDAS_is_nodata(Tb_h_tmp) .or. LDAS_is_nodata(Tb_v_tmp) + ! This counter is relative to ens_id collect_tb_counter = collect_tb_counter + 1 - TB_V_enavg(:) = TB_V_enavg(:) + Tb_v_tmp(:) TB_H_enavg(:) = TB_H_enavg(:) + Tb_h_tmp(:) + TB_V_enavg(:) = TB_V_enavg(:) + Tb_v_tmp(:) if (collect_tb_counter == NUM_ENSEMBLE) then - collect_tb_counter = 0 - TB_V_enavg(:) = TB_V_enavg(:)/NUM_ENSEMBLE - TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE + + collect_tb_counter = 0 + + TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE + TB_V_enavg(:) = TB_V_enavg(:)/NUM_ENSEMBLE + + ! finalize no-data-value + where (tb_nodata) + TB_H_enavg = MAPL_UNDEF + TB_V_enavg = MAPL_UNDEF + end where + endif deallocate(Tb_h_tmp, Tb_v_tmp, sfmc_mwRTM, tsoil_mwRTM) @@ -2104,6 +2139,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) RETURN_(_SUCCESS) end subroutine CALC_LAND_TB + ! ****************************************************************************** subroutine read_pert_rseed(seed_fname,pert_rseed_r8) use netcdf @@ -2138,6 +2174,8 @@ subroutine check(status) end subroutine check end subroutine read_pert_rseed + ! ****************************************************************************** + subroutine write_pert_rseed(chk_fname, pert_rseed_r8) use netcdf character(len=*),intent(in) :: chk_fname @@ -2185,6 +2223,7 @@ subroutine check(status) end subroutine check end subroutine write_pert_rseed + ! ****************************************************************************** subroutine get_mwrtm_param(internal,N_catl, rc) type(ESMF_State), intent(inout) :: INTERNAL @@ -2211,7 +2250,7 @@ subroutine get_mwrtm_param(internal,N_catl, rc) real, dimension(:), pointer :: LEWT integer :: N_catl_tmp, n, mpierr, status - logical :: is_nodata, all_nodata_l + logical :: mwp_nodata, all_nodata_l if(allocated(mwRTM_param)) then _RETURN(_SUCCESS) @@ -2279,8 +2318,8 @@ subroutine get_mwrtm_param(internal,N_catl, rc) all_nodata_l = .true. do n=1,N_catl - call mwRTM_param_nodata_check(mwRTM_param(n), is_nodata ) - if (.not. is_nodata) all_nodata_l = .false. + call mwRTM_param_nodata_check(mwRTM_param(n), mwp_nodata ) + if (.not. mwp_nodata) all_nodata_l = .false. end do ! perform logical AND across elements @@ -2289,6 +2328,8 @@ subroutine get_mwrtm_param(internal,N_catl, rc) _RETURN(_SUCCESS) end subroutine get_mwrtm_param + ! ****************************************************************************** + !BOP ! !IROTUINE: Finalize -- finalize method for LDAS GC ! !INTERFACE: @@ -2362,3 +2403,5 @@ subroutine Finalize(gc, import, export, clock, rc) end subroutine Finalize end module GEOS_LandAssimGridCompMod + +! ====================== EOF ======================================================= diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 index f13b1563..345ed458 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_adapt_routines.F90 @@ -48,9 +48,6 @@ module clsm_adapt_routines use LDAS_ensdrv_functions, ONLY: & get_io_filename - use LDAS_ensdrv_init_routines, ONLY: & - clsm_ensdrv_get_command_line - use LDAS_TilecoordRoutines, ONLY: & grid2tile @@ -73,77 +70,6 @@ module clsm_adapt_routines ! *********************************************************************** - subroutine clsm_adapt_get_command_line( & - adapt_inputs_path, adapt_inputs_file & - ) - - ! get some inputs from command line - ! - ! if present, command line arguments overwrite inputs from - ! clsm_adapt_default_inputs namelist file - ! - ! command line should look something like - ! - ! a.out -adapt_inputs_file fname.nml - ! - ! NOTE: This subroutine does NOT stop for unknown arguments! - ! (If that is desired, all arguments used by - ! clsm_ensdrv_get_command_line() must be listed here - ! explicitly and be ignored.) - ! - ! reichle, 14 Dec 2006 - ! - ! ---------------------------------------------------------------- - - implicit none - - character(200), intent(inout), optional :: adapt_inputs_path - character(40), intent(inout), optional :: adapt_inputs_file - - ! ----------------------------------------------------------------- - - integer :: N_args, iargc, i - - character(40) :: arg - - !external getarg, iargc - - ! ----------------------------------------------------------------- - - N_args = iargc() - - i=0 - - do while ( i < N_args ) - - i = i+1 - - call getarg(i,arg) - - if ( trim(arg) == '-adapt_inputs_path' ) then - i = i+1 - if (present(adapt_inputs_path)) & - call getarg(i,adapt_inputs_path) - - elseif ( trim(arg) == '-adapt_inputs_file' ) then - i = i+1 - if (present(adapt_inputs_file)) & - call getarg(i,adapt_inputs_file) - - else - - i=i+1 - if (logit) write (logunit,*) & - 'clsm_adapt_get_command_line(): IGNORING argument = ', trim(arg) - - endif - - end do - - end subroutine clsm_adapt_get_command_line - - ! ---------------------------------------------------------------------- - subroutine read_adapt_inputs( work_path, exp_id, date_time, & adapt_type, adapt_misc_param, adapt_progn_pert, adapt_force_pert ) @@ -170,6 +96,8 @@ subroutine read_adapt_inputs( work_path, exp_id, date_time, & character(300) :: fname + logical :: file_exists + ! ----------------------------------------- namelist / adapt_inputs / & @@ -180,7 +108,6 @@ subroutine read_adapt_inputs( work_path, exp_id, date_time, & ! Set default file name for driver inputs namelist file adapt_inputs_path = './' ! set default - call clsm_ensdrv_get_command_line(run_path=adapt_inputs_path) adapt_inputs_file = 'LDASsa_DEFAULT_inputs_adapt.nml' ! Read data from default adapt_inputs namelist file @@ -190,7 +117,7 @@ subroutine read_adapt_inputs( work_path, exp_id, date_time, & open (10, file=fname, delim='apostrophe', action='read', status='old') if (logit) write (logunit,*) - if (logit) write (logunit,*) 'reading *default* adapt inputs from ', trim(fname) + if (logit) write (logunit,'(400A)') 'reading *default* adapt inputs from ', trim(fname) if (logit) write (logunit,*) read (10, nml=adapt_inputs) @@ -198,35 +125,30 @@ subroutine read_adapt_inputs( work_path, exp_id, date_time, & close(10,status='keep') - ! Get name and path for special adapt inputs file from - ! command line (if present) + ! Read from special adapt inputs file (if present) - adapt_inputs_path = '' - adapt_inputs_file = '' + adapt_inputs_file = 'LDASsa_SPECIAL_inputs_adapt.nml' - call clsm_adapt_get_command_line( & - adapt_inputs_path=adapt_inputs_path, & - adapt_inputs_file=adapt_inputs_file ) + ! Read data from special adapt_inputs namelist file - if ( trim(adapt_inputs_path) /= '' .and. & - trim(adapt_inputs_file) /= '' ) then - - ! Read data from special adapt_inputs namelist file - - fname = trim(adapt_inputs_path) // '/' // trim(adapt_inputs_file) - + fname = trim(adapt_inputs_path) // '/' // trim(adapt_inputs_file) + + inquire(file=fname, exist=file_exists) + + if (file_exists) then + open (10, file=fname, delim='apostrophe', action='read', status='old') if (logit) write (logunit,*) - if (logit) write (logunit,*) 'reading *special* adapt inputs from ', trim(fname) + if (logit) write (logunit,'(400A)') 'reading *special* adapt inputs from ', trim(fname) if (logit) write (logunit,*) read (10, nml=adapt_inputs) close(10,status='keep') - + end if - + ! echo variables of adapt_inputs if (logit) write (logunit,*) 'adapt inputs are:' diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 index c080889b..11c775d2 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 @@ -40,9 +40,6 @@ module clsm_bias_routines use LDAS_ensdrv_functions, ONLY: & get_io_filename - use LDAS_ensdrv_init_routines, ONLY: & - clsm_ensdrv_get_command_line - use clsm_ensupd_upd_routines, ONLY: & get_cat_progn_ens_avg @@ -78,78 +75,6 @@ module clsm_bias_routines ! ! ------------------------------------------------------------------- - subroutine clsm_cat_bias_get_command_line( & - cat_bias_inputs_path, cat_bias_inputs_file & - ) - - ! get some inputs from command line - ! - ! if present, command line arguments overwrite inputs from - ! catbias_inputs namelist files - ! - ! command line should look something like - ! - ! a.out -cat_bias_inputs_file fname.nml - ! - ! NOTE: This subroutine does NOT stop for unknown arguments! - ! (If that is desired, all arguments used by - ! clsm_ensdrv_get_command_line() must be listed here - ! explicitly and be ignored.) - ! - ! reichle, 18 Oct 2005 - ! - ! ---------------------------------------------------------------- - - implicit none - - character(*), intent(inout), optional :: cat_bias_inputs_path - character(*), intent(inout), optional :: cat_bias_inputs_file - - ! ----------------------------------------------------------------- - - integer :: N_args, iargc, i - - character(40) :: arg - - !external getarg, iargc - - ! ----------------------------------------------------------------- - - N_args = iargc() - - i=0 - - do while ( i < N_args ) - - i = i+1 - - call getarg(i,arg) - - if ( trim(arg) == '-cat_bias_inputs_path' ) then - i = i+1 - if (present(cat_bias_inputs_path)) & - call getarg(i,cat_bias_inputs_path) - - elseif ( trim(arg) == '-cat_bias_inputs_file' ) then - i = i+1 - if (present(cat_bias_inputs_file)) & - call getarg(i,cat_bias_inputs_file) - - else - - i=i+1 - if (logit) write (logunit,*) & - 'clsm_cat_bias_get_command_line(): IGNORING argument = ', & - trim(arg) - - endif - - end do - - end subroutine clsm_cat_bias_get_command_line - - ! ******************************************************************** - subroutine io_rstrt_cat_bias( action, work_path, exp_id, date_time, & model_dtstep, N_cat, N_catbias, cat_bias ) @@ -578,7 +503,6 @@ subroutine read_cat_bias_inputs( work_path, exp_id, date_time, & ! read default cat bias inputs file cat_bias_inputs_path = './' ! set default - !call clsm_ensdrv_get_command_line(run_path=cat_bias_inputs_path) cat_bias_inputs_file = 'LDASsa_DEFAULT_inputs_catbias.nml' fname = trim(cat_bias_inputs_path) // '/' // trim(cat_bias_inputs_file) @@ -594,21 +518,11 @@ subroutine read_cat_bias_inputs( work_path, exp_id, date_time, & close(10,status='keep') - ! Get name and path for special cat bias inputs file from - ! command line (if present) - - ! cat_bias_inputs_path = '' - ! cat_bias_inputs_file = '' - - ! call clsm_cat_bias_get_command_line( & - ! cat_bias_inputs_path=cat_bias_inputs_path, & - ! cat_bias_inputs_file=cat_bias_inputs_file ) + ! Read from special cat bias inputs file (if present) cat_bias_inputs_file = 'LDASsa_SPECIAL_inputs_catbias.nml' - ! if ( trim(cat_bias_inputs_path) /= '' .and. & - ! trim(cat_bias_inputs_file) /= '' ) then - - ! Read data from special cat bias inputs namelist file + + ! Read data from special cat bias inputs namelist file fname = trim(cat_bias_inputs_path)//'/'//trim(cat_bias_inputs_file) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 index f0fe7034..a719b7d7 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 @@ -32,10 +32,6 @@ module clsm_ensdrv_out_routines use LDAS_DateTimeMod, ONLY: & date_time_type - use LDAS_ensdrv_init_routines, ONLY: & - clsm_ensdrv_get_command_line, & - add_domain_to_path - use LDAS_ensdrv_functions, ONLY: & get_io_filename @@ -120,52 +116,8 @@ subroutine init_log( myid, numprocs, master_proc ) if (logunit/=output_unit) then - ! get command line arguments - ! - ! NOTE: If ldas_abort() is called from clsm_ensdrv_get_command_line() at this - ! time, the error message should appear in a file named "fort.[logunit]" - - call clsm_ensdrv_get_command_line( & - start_time=start_time, & - work_path=work_path, exp_domain=exp_domain, & - exp_id=exp_id ) - - ! augment work_path (must be same as in read_driver_inputs() ) - - io_path = add_domain_to_path( work_path, exp_domain ) - - write (myid_string,'(i4.4)') myid - - dir_name = 'rc_out' - file_tag = 'ldas_log' - file_ext = '.txt' - - if (.not. master_proc) then - - file_tag = trim(file_tag) // '_PE' // myid_string - - end if - - ! NOTE: If ldas_abort() is called from get_io_filename() at this time, - ! the error message should appear in a file named "fort.[logunit]" - - fname = get_io_filename( io_path, exp_id, file_tag, date_time=start_time, & - dir_name=dir_name, file_ext=file_ext ) - - open (logunit, file=trim(fname), form='formatted', action='write', & - status='new', iostat=istat) - - if (istat/=0) then - - ! this call to ldas_abort() should create a file named "fort.[logunit]" - - err_msg = 'ERROR opening log file (perhaps it already exists)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end if - - write (logunit,*) - write (logunit,'(400A)') 'logfile: ' // trim(fname) + err_msg = 'logunit/=output_unit (stdout) - this should never happen per module LDAS_ensdrv_Globals' + call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) else diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 4502a216..8fc2625f 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -1544,8 +1544,9 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & deallocate(Observations_tmp) -#endif ! LDAS_MPI - ! reorder tilenum, so it is consisten with the order in tile_coord.bin file +#endif ! LDAS_MPI + + ! reorder tilenum, so it is consistent with the order in tile_coord.bin file if(present(rf2f)) then allocate(rf_tilenums(N_obsf), tilenums(N_obsf)) rf_tilenums = Observations_f(:)%tilenum @@ -1553,6 +1554,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & Observations_f(:)%tilenum =tilenums deallocate(rf_tilenums, tilenums) endif + ! write to file fname = get_io_filename( './', exp_id, file_tag, date_time=date_time, & @@ -1604,8 +1606,8 @@ end subroutine output_ObsFcstAna ! ********************************************************************** - subroutine output_incr_etc( out_ObsFcstAna, & - date_time, work_path, exp_id, & + subroutine output_incr_etc( out_ObsFcstAna, & + date_time, work_path, exp_id, & N_obsl, N_obs_param, N_ens, & N_catl, tile_coord_l, & N_catf, tile_coord_f, tile_grid_f, tile_grid_g, & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 index 36d07f06..9e300e1e 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_upd_routines.F90 @@ -41,9 +41,6 @@ module clsm_ensupd_upd_routines get_io_filename, & is_in_rectangle - use LDAS_ensdrv_init_routines, ONLY: & - clsm_ensdrv_get_command_line - use LDAS_DateTimeMod, ONLY: & date_time_type @@ -190,9 +187,6 @@ subroutine read_ens_upd_inputs( & ! specified at the command line using -ens_upd_inputs_path ! and -ens_upd_inputs_file ! - ! 3.) overwrite options from command line (if present) - ! see subroutine clsm_ensupd_get_command_line() - ! ! reichle, 19 Jul 2005 ! reichle, 14 Apr 2006 - added "update_type" to namelist and outputs ! - removed reading from "stored"/"saved" nml file @@ -284,7 +278,6 @@ subroutine read_ens_upd_inputs( & ! Set default file name for EnKF inputs namelist file ens_upd_inputs_path = '.' ! set default - !call clsm_ensdrv_get_command_line(run_path=ens_upd_inputs_path) ens_upd_inputs_file = 'LDASsa_DEFAULT_inputs_ensupd.nml' ! Read data from default ens_upd_inputs namelist file @@ -308,14 +301,7 @@ subroutine read_ens_upd_inputs( & ens_upd_inputs_path = '.' ens_upd_inputs_file = 'LDASsa_SPECIAL_inputs_ensupd.nml' - ! call clsm_ensupd_get_command_line( & - ! ens_upd_inputs_path=ens_upd_inputs_path, & - ! ens_upd_inputs_file=ens_upd_inputs_file ) - - ! if ( trim(ens_upd_inputs_path) /= '' .and. & - ! trim(ens_upd_inputs_file) /= '' ) then - - ! Read data from special EnKF inputs namelist file + ! Read data from special EnKF inputs namelist file fname = trim(ens_upd_inputs_path)//'/'//trim(ens_upd_inputs_file) inquire(file=fname, exist=file_exists) @@ -689,78 +675,6 @@ subroutine read_ens_upd_inputs( & end subroutine read_ens_upd_inputs - ! *********************************************************************** - - subroutine clsm_ensupd_get_command_line( & - ens_upd_inputs_path, ens_upd_inputs_file & - ) - - ! get some inputs from command line - ! - ! if present, command line arguments overwrite inputs from - ! ens_upd_inputs namelist files - ! - ! command line should look something like - ! - ! a.out -upd_driver_inputs_file fname.nml - ! - ! NOTE: This subroutine does NOT stop for unknown arguments! - ! (If that is desired, all arguments used by - ! clsm_ensdrv_get_command_line() must be listed here - ! explicitly and be ignored.) - ! - ! reichle, 19 Jul 2005 - ! reichle, 2 Aug 2005 - consistency with clsm_ensdrv_get_command_line() - ! - ! ---------------------------------------------------------------- - - implicit none - - character(*), intent(inout), optional :: ens_upd_inputs_path - character(*), intent(inout), optional :: ens_upd_inputs_file - - ! ----------------------------------------------------------------- - - integer :: N_args, iargc, i - - character(40) :: arg - - !external getarg, iargc - - ! ----------------------------------------------------------------- - - N_args = iargc() - - i=0 - - do while ( i < N_args ) - - i = i+1 - - call getarg(i,arg) - - if ( trim(arg) == '-ens_upd_inputs_path' ) then - i = i+1 - if (present(ens_upd_inputs_path)) & - call getarg(i,ens_upd_inputs_path) - - elseif ( trim(arg) == '-ens_upd_inputs_file' ) then - i = i+1 - if (present(ens_upd_inputs_file)) & - call getarg(i,ens_upd_inputs_file) - - else - - i=i+1 - if (logit) write (logunit,*) & - 'clsm_ensupd_get_command_line(): IGNORING argument = ', trim(arg) - - endif - - end do - - end subroutine clsm_ensupd_get_command_line - ! ******************************************************************** subroutine init_obslog( work_path, exp_id, date_time ) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 index c3a8feca..b83115ad 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 @@ -28,7 +28,7 @@ module mwRTM_routines mwRTM_param_nodata_check, & assignment (=) - use LDAS_ensdrv_globals, ONLY: & + use LDAS_ensdrv_globals, ONLY: & logit, & logunit, & nodata_generic, & @@ -37,7 +37,7 @@ module mwRTM_routines use LDAS_ensdrv_functions, ONLY: & open_land_param_file - use LDAS_exceptionsMod, ONLY: & + use LDAS_exceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -103,7 +103,7 @@ subroutine mwRTM_get_param( N_catg, N_tile, d2g, tile_id, mwRTM_param_path, & character(100), dimension(N_search_dir_max) :: search_dir - logical :: all_nodata, is_nodata + logical :: all_nodata, mwp_nodata character(len=*), parameter :: Iam = 'mwRTM_get_param' character(len=400) :: err_msg @@ -156,9 +156,9 @@ subroutine mwRTM_get_param( N_catg, N_tile, d2g, tile_id, mwRTM_param_path, & do n=1,N_tile - call mwRTM_param_nodata_check( mwp(n), is_nodata ) + call mwRTM_param_nodata_check( mwp(n), mwp_nodata ) - if (.not. is_nodata) all_nodata = .false. + if (.not. mwp_nodata) all_nodata = .false. end do @@ -320,7 +320,7 @@ subroutine mwRTM_get_Tb( N_tile, freq, inc_angle, mwp, elev, & !--------------------------------------------------- - if (logit) write(logunit,*) 'entering mwRTM_get_Tb...' + !if (logit) write(logunit,*) 'entering mwRTM_get_Tb...' ! check first element of elevation against no-data-value ! (elevation is needed only when incl_atm_terms=.true.) @@ -495,7 +495,7 @@ subroutine mwRTM_get_Tb( N_tile, freq, inc_angle, mwp, elev, & end do - if (logit) write(logunit,*) 'exiting mwRTM_get_Tb.' + !if (logit) write(logunit,*) 'exiting mwRTM_get_Tb.' end subroutine mwRTM_get_Tb diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_types.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_types.F90 index b958419e..3b1861e3 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_types.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_types.F90 @@ -14,11 +14,12 @@ module mwRTM_types ! -------------------------------------------------------------------------- use LDAS_ensdrv_globals, ONLY: & - nodata_generic, & - nodata_tol_generic + nodata_generic, & + nodata_tol_generic, & + LDAS_is_nodata - use ldas_exceptionsMod, ONLY: & - ldas_abort, & + use ldas_exceptionsMod, ONLY: & + ldas_abort, & LDAS_GENERIC_ERROR implicit none @@ -276,13 +277,13 @@ end subroutine scalar2mwRTM_param ! ************************************************************ - subroutine mwRTM_param_nodata_check( mwp, is_nodata ) + subroutine mwRTM_param_nodata_check( mwp, mwp_nodata ) implicit none type(mwRTM_param_type), intent(inout) :: mwp - logical, intent( out) :: is_nodata + logical, intent( out) :: mwp_nodata ! local variables @@ -293,32 +294,32 @@ subroutine mwRTM_param_nodata_check( mwp, is_nodata ) realvegcls = real(mwp%vegcls) realsoilcls = real(mwp%soilcls) - if ( (abs(realvegcls -nodata_generic)MAPL_STFBOL use LDAS_ensdrv_Globals, only: master_logit implicit none @@ -447,7 +447,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & ! SWnet is no-data-value for most forcing data sets (except MERRA, G5DAS) - if(abs(met_force(i)%SWnet-nodata_generic)>nodata_tol_generic) then + if( .not. LDAS_is_nodata(met_force(i)%SWnet) ) then if (field(1:3)=='all' .or. field(1:7)=='SWnet ') then @@ -491,7 +491,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & ! PARdffs is no-data-value for most forcing data sets (except MERRA, G5DAS) - if(abs(met_force(i)%PARdffs-nodata_generic)>nodata_tol_generic) then + if( .not. LDAS_is_nodata(met_force(i)%PARdffs)) then if (field(1:3)=='all' .or. field(1:7)=='PARdffs') then @@ -544,7 +544,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & ! ! MUST "repair" PARdffs *before* PARdrct - if(abs(met_force(i)%PARdrct-nodata_generic)>nodata_tol_generic) then + if( .not. LDAS_is_nodata(met_force(i)%PARdrct) ) then if (field(1:3)=='all' .or. field(1:7)=='PARdrct') then diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 index d539e241..d87128ab 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 @@ -1,18 +1,19 @@ module LDAS_ensdrv_Globals - ! just change the name CLSM_xxxx to LDAS_xxxx ! global parameters for LDAS ens driver ! - ! must re-compile if any of these change - ! ! reichle, 25 Mar 2004 ! reichle, 6 May 2005 ! reichle, 29 Nov 2010 - deleted N_outselect (obsolete) ! - added sfc_turb_scheme (choose Louis or Helfand Monin-Obukhov) ! reichle, 5 Apr 2013 - removed N_out_fields as global parameter - + ! wjiang+reichle, + ! 21 May 2020 - added "LDAS_is_nodata" function, checks if "nodata_generic" or "MAPL_UNDEF" + use, intrinsic :: iso_fortran_env, only : output_unit + use MAPL_BaseMod, only : MAPL_UNDEF + implicit none private @@ -20,6 +21,7 @@ module LDAS_ensdrv_Globals public :: nodata_generic public :: nodata_tolfrac_generic public :: nodata_tol_generic + public :: LDAS_is_nodata public :: logunit public :: logit public :: master_logit @@ -35,8 +37,9 @@ module LDAS_ensdrv_Globals real, parameter :: nodata_generic = -9999. real, parameter :: nodata_tolfrac_generic = 1.e-4 - real :: nodata_tol_generic = abs(nodata_generic*nodata_tolfrac_generic) - + real :: nodata_tol_generic = abs(nodata_generic*nodata_tolfrac_generic) + real :: MAPL_UNDEF_tol_generic = abs(MAPL_UNDEF *nodata_tolfrac_generic) + ! ---------------------------------------------------------------- ! ! log file @@ -124,6 +127,19 @@ subroutine write_status(lenkf_status) end subroutine write_status + ! ******************************************************************** + + elemental function LDAS_is_nodata(data) result(no_data) + + real, intent(in) :: data + logical :: no_data + + no_data = & + ( abs(data-nodata_generic) < nodata_tol_generic ) .or. & + ( abs(data-MAPL_UNDEF) < MAPL_UNDEF_tol_generic) + + end function LDAS_is_nodata + ! ************************************************************* end module LDAS_ensdrv_Globals diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 index 91e0319c..c80a16d7 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 @@ -8,34 +8,28 @@ module LDAS_ensdrv_init_routines ! (originally in clsm_ensdrv_drv_routines.F90) ! ! reichle, 22 Aug 2014 + ! reichle, 22 May 2020 - cleanup use ESMF use GEOS_MOD - use LDAS_ensdrv_Globals, ONLY: & + use LDAS_ensdrv_Globals, ONLY: & log_master_only, & logunit, & logit, & nodata_generic - use MAPL_ConstantsMod, ONLY: & - Tzero => MAPL_TICE - use MAPL_BaseMod, ONLY: & NTYPS => MAPL_NumVegTypes - use LDAS_TileCoordType, ONLY: & + use LDAS_TileCoordType, ONLY: & tile_coord_type, & grid_def_type, & - operator (==), & + operator (==), & N_cont_max, & io_tile_coord_type, & io_grid_def_type - use LDAS_DateTimeMod, ONLY: & - date_time_type, & - get_dofyr_pentad - use LDAS_ensdrv_functions, ONLY: & get_io_filename, & is_in_list, & @@ -43,16 +37,12 @@ module LDAS_ensdrv_init_routines open_land_param_file, & word_count -! use clsm_ensdrv_drv_routines, ONLY: & -! check_cat_progn - - use LDAS_TileCoordRoutines, ONLY: & + use LDAS_TileCoordRoutines, ONLY: & is_cat_in_box, & - !reorder_tiles, & get_tile_grid, & read_til_file - use LDAS_ExceptionsMod, ONLY: & + use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -72,38 +62,16 @@ module LDAS_ensdrv_init_routines private - public :: add_domain_to_path public :: domain_setup public :: read_cat_param - public :: clsm_ensdrv_get_command_line public :: io_domain_files - !integer ,parameter :: N_gt=6, N_snow=3 - character(10), private :: tmpstring10 character(40), private :: tmpstring40 contains ! ******************************************************************** - - - character(200) function add_domain_to_path( pathname, exp_domain ) - - ! make sure "exp_domain" is always added to "pathname" in the same way - ! (so that comparison of strings does not depend on extra slashes) - ! - reichle, 2 Apr 2014 - - implicit none - - character(200) :: pathname - character(40) :: exp_domain - - add_domain_to_path = trim(pathname) // '/' // trim(exp_domain) // '/' - - end function add_domain_to_path - - ! **************************************************************** subroutine domain_setup( & N_cat_global, tile_coord_global, & @@ -239,7 +207,7 @@ subroutine domain_setup( & else - print*, "Creating domain..., reading white and black lists if there have ones..." + print*, "Creating domain..., reading white and black lists if present..." ! ------------------------------------------------------------ ! ! load blacklist: catchments listed in this file will be excluded @@ -1135,150 +1103,6 @@ subroutine read_cat_param( & end subroutine read_cat_param ! ************************************************************************* - - subroutine read_VEG_Height( & - N_catg, veg_path, V_HEIGHT ) - - ! addapted from read_cat_param - - implicit none - - integer, intent(in) :: N_catg - character(*), intent(in) :: veg_path - real, dimension(N_catg),intent(inout) :: V_HEIGHT - - character( 80) :: fname - character(999) :: tmpstr999 - - character(100), dimension(2) :: search_dir - - integer :: n, k, m, dummy_int, dummy_int2, istat, N_search_dir, N_col - - integer, dimension(N_catg) :: tmpint, tmpint2, tmptileid - - real, dimension(N_catg,7) :: tmpreal - - real :: dummy_real, dummy_real2, z_in_m, term1, term2 - - logical :: dummy_logical - - character(len=*), parameter :: Iam = 'read_Veg_Hight' - character(len=400) :: err_msg - - real, dimension(NTYPS) :: VGZ2 - - ! legacy vegetation height look-up table (for backward compatibility) - ! - DATA VGZ2 /35.0, 20.0, 17.0, 0.6, 0.5, 0.6/ ! Dorman and Sellers (1989) - - ! --------------------------------------------------------------------- - - if (logit) write (logunit,*) 'reading VEG_HEIGHT' - if (logit) write (logunit,*) - - ! ----------------------------- - - ! Vegetation class - - if (logit) write (logunit,*) 'Reading vegetation class and, if available, height' - - fname = '/mosaic_veg_typs_fracs' - - N_search_dir = 2 ! specify sub-dirs of veg_path to search for file "fname" - - search_dir(1) = 'clsm' - search_dir(2) = 'VEGETATION-GSWP2' - - ! find out how many columns are in the (formatted) file - - istat = open_land_param_file( & - 10, .true., dummy_logical, N_search_dir, fname, veg_path, search_dir) - - read(10,'(a)') tmpstr999 ! read first line - ! count words in first line (delimited by space) - N_col = word_count( tmpstr999 ) - - ! get line number or the real N_catg - n =1 - do while (.true.) - read(10,*,iostat= istat) tmpstr999 - if(IS_IOSTAT_END(istat)) exit - n=n+1 - enddo - - if(n /= N_catg) stop " Please don't add vegheight to REGIONAOL veg restart" - - close(10, status='keep') - - - ! read parameters - - istat = open_land_param_file( & - 10, .true., dummy_logical, N_search_dir, fname, veg_path, search_dir) - - tmptileid = 0 - - tmpreal = nodata_generic - - select case (N_col) - - case (6) - - ! legacy vegetation height from look-up table - - if (logit) write (logunit,*) 'Using vegetation height look-up table' - - do n=1,N_catg - - read (10,*) tmptileid(n), dummy_int, tmpint(n) - - end do - - if ( (any(tmpint<1)) .or. (any(tmpint>NTYPS)) ) then - - err_msg = 'veg type (class) exceeds allowed min/max' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end if - - do n=1,N_catg - - tmpreal(n,1) = VGZ2( tmpint(n) ) - - end do - - case (7) - - ! vegetation height from boundary condition file - - if (logit) write (logunit,*) 'reading vegetation height from file' - - do n=1,N_catg - - ! 7-th column contains veg height in m - - read (10,*) tmptileid(n), dummy_int, tmpint(n), & - dummy_int2, dummy_real, dummy_real2, tmpreal(n,1) - - end do - - case default - - err_msg = 'unknown number of columns in ' // trim(fname) - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end select - - close (10,status='keep') - - if (logit) write (logunit,*) 'done reading' - if (logit) write (logunit,*) - - V_HEIGHT = tmpreal(:,1) - - end subroutine read_VEG_Height - - ! ********************************************************************** subroutine read_black_or_whitelist(N_cat, fname, blacklist, N_black) @@ -1376,336 +1200,6 @@ subroutine read_black_or_whitelist(N_cat, fname, blacklist, N_black) end subroutine read_black_or_whitelist - ! **************************************************************** - - subroutine clsm_ensdrv_get_command_line( & - driver_inputs_path, & - driver_inputs_file, & - start_time, & - end_time, & - resolution, & - exp_domain, & - exp_id, & - work_path, & - run_path, & - restart_path, & - restart_domain, & - restart_id, & - tile_coord_path, & - tile_coord_file, & - catchment_def_path, & - catchment_def_file, & - met_tag, & - met_path, & - force_dtstep, & - restart, & - spin, & - ens_prop_inputs_path, & - ens_prop_inputs_file, & - N_ens, & - first_ens_id & - ) - - ! get inputs from command line - ! - ! if present, command line arguments overwrite inputs from - ! driver_inputs or ens_prop_inputs namelist files - ! - ! command line should look something like - ! - ! a.out -start_year 1979 -restart true -driver_inputs_file fname.nml - ! - ! NOTE: Arguments that are used for assimilation ("ensupd") must be - ! listed here explicitly (and will be ignored). Otherwise it - ! would not be possible to stop for unknown arguments. - ! - ! reichle, 29 Aug 02 - ! - ! modified for namelist input file path and name - ! - reichle, 6 May 03 - ! converted to optional arguments, added arguments for EnKF inputs - ! - reichle, 29 Mar 04 - ! - ! reichle, 2 Aug 2005 - consistency with clsm_ensdrv_get_command_line() - ! reichle, 6 Mar 2008 - added force_dtstep for DAS/MERRA integration - ! - ! ---------------------------------------------------------------- - - implicit none - - character(200), intent(inout), optional :: driver_inputs_path - character(200), intent(inout), optional :: work_path, run_path - character(200), intent(inout), optional :: restart_path - - character(40), intent(inout), optional :: driver_inputs_file - - type(date_time_type), intent(inout), optional :: start_time - type(date_time_type), intent(inout), optional :: end_time - - character(40), intent(inout), optional :: exp_domain, exp_id, resolution - character(40), intent(inout), optional :: restart_domain, restart_id - - character(200), intent(inout), optional :: tile_coord_path - character(200), intent(inout), optional :: catchment_def_path - character(80), intent(inout), optional :: tile_coord_file - character(40), intent(inout), optional :: catchment_def_file - - character(200), intent(inout), optional :: met_path - character(80), intent(inout), optional :: met_tag - - integer, intent(inout), optional :: force_dtstep - - logical, intent(inout), optional :: restart, spin - - character(200), intent(inout), optional :: ens_prop_inputs_path - character(40), intent(inout), optional :: ens_prop_inputs_file - - integer, intent(inout), optional :: N_ens, first_ens_id - - ! ----------------------------------------------------------------- - - integer :: N_args, iargc, i - - character(40) :: arg - - logical :: outlog - - character(len=*), parameter :: Iam = 'clsm_ensdrv_get_command_line' - character(len=400) :: err_msg - - !external getarg, iargc - - ! ----------------------------------------------------------------- - - ! make sure log file has already been opened - - inquire( logunit, opened=outlog ) - - ! do not write log output for non-master processes as requested - - if ((log_master_only) .and. (.not. master_proc)) outlog = .false. - - N_args = iargc() - - i=0 - - do while ( i < N_args ) - - i = i+1 - - call getarg(i,arg) - - if ( trim(arg) == '-driver_inputs_path' ) then - i = i+1 - if (present(driver_inputs_path)) call getarg(i,driver_inputs_path) - - elseif ( trim(arg) == '-driver_inputs_file' ) then - i = i+1 - if (present(driver_inputs_file)) call getarg(i,driver_inputs_file) - - elseif ( trim(arg) == '-start_year' ) then - i = i+1 - call getarg(i,arg) - if (present(start_time)) read (arg,*) start_time%year - - elseif ( trim(arg) == '-start_month' ) then - i = i+1 - call getarg(i,arg) - if (present(start_time)) read (arg,*) start_time%month - - elseif ( trim(arg) == '-start_day' ) then - i = i+1 - call getarg(i,arg) - if (present(start_time)) read (arg,*) start_time%day - - elseif ( trim(arg) == '-start_hour' ) then - i = i+1 - call getarg(i,arg) - if (present(start_time)) read (arg,*) start_time%hour - - elseif ( trim(arg) == '-start_min' ) then - i = i+1 - call getarg(i,arg) - if (present(start_time)) read (arg,*) start_time%min - - elseif ( trim(arg) == '-start_sec' ) then - i = i+1 - call getarg(i,arg) - if (present(start_time)) read (arg,*) start_time%sec - - elseif ( trim(arg) == '-end_year' ) then - i = i+1 - call getarg(i,arg) - if (present(end_time)) read (arg,*) end_time%year - - elseif ( trim(arg) == '-end_month' ) then - i = i+1 - call getarg(i,arg) - if (present(end_time)) read (arg,*) end_time%month - - elseif ( trim(arg) == '-end_day' ) then - i = i+1 - call getarg(i,arg) - if (present(end_time)) read (arg,*) end_time%day - - elseif ( trim(arg) == '-end_hour' ) then - i = i+1 - call getarg(i,arg) - if (present(end_time)) read (arg,*) end_time%hour - - elseif ( trim(arg) == '-end_min' ) then - i = i+1 - call getarg(i,arg) - if (present(end_time)) read (arg,*) end_time%min - - elseif ( trim(arg) == '-end_sec' ) then - i = i+1 - call getarg(i,arg) - if (present(end_time)) read (arg,*) end_time%sec - - elseif ( trim(arg) == '-resolution' ) then - i = i+1 - if (present(resolution)) call getarg(i,resolution) - - elseif ( trim(arg) == '-exp_domain' ) then - i = i+1 - if (present(exp_domain)) call getarg(i,exp_domain) - - elseif ( trim(arg) == '-exp_id' ) then - i = i+1 - if (present(exp_id)) call getarg(i,exp_id) - - elseif ( trim(arg) == '-work_path' ) then - i = i+1 - if (present(work_path)) call getarg(i,work_path) - - elseif ( trim(arg) == '-run_path' ) then - i = i+1 - if (present(run_path)) call getarg(i,run_path) - - elseif ( trim(arg) == '-restart_path' ) then - i = i+1 - if (present(restart_path)) call getarg(i,restart_path) - - elseif ( trim(arg) == '-restart_domain' ) then - i = i+1 - if (present(restart_domain)) call getarg(i,restart_domain) - - elseif ( trim(arg) == '-restart_id' ) then - i = i+1 - if (present(restart_id)) call getarg(i,restart_id) - - elseif ( trim(arg) == '-tile_coord_path' ) then - i = i+1 - if (present(tile_coord_path)) call getarg(i,tile_coord_path) - - elseif ( trim(arg) == '-tile_coord_file' ) then - i = i+1 - if (present(tile_coord_file)) call getarg(i,tile_coord_file) - - elseif ( trim(arg) == '-catchment_def_path' ) then - i = i+1 - if (present(catchment_def_path)) call getarg(i,catchment_def_path) - - elseif ( trim(arg) == '-catchment_def_file' ) then - i = i+1 - if (present(catchment_def_file)) call getarg(i,catchment_def_file) - - elseif ( trim(arg) == '-met_path' ) then - i = i+1 - if (present(met_path)) call getarg(i,met_path) - - elseif ( trim(arg) == '-met_tag' ) then - i = i+1 - if (present(met_tag)) call getarg(i,met_tag) - - elseif ( trim(arg) == '-force_dtstep' ) then - i = i+1 - call getarg(i,arg) - if (present(force_dtstep)) read (arg,*) force_dtstep - - elseif ( trim(arg) == '-restart' ) then - i = i+1 - call getarg(i,arg) - if (present(restart)) read (arg,*) restart - - elseif ( trim(arg) == '-spin' ) then - i = i+1 - call getarg(i,arg) - if (present(spin)) read (arg,*) spin - - elseif ( trim(arg) == '-ens_prop_inputs_path' ) then - i = i+1 - if (present(ens_prop_inputs_path)) & - call getarg(i,ens_prop_inputs_path) - - elseif ( trim(arg) == '-ens_prop_inputs_file' ) then - i = i+1 - if (present(ens_prop_inputs_file)) & - call getarg(i,ens_prop_inputs_file) - - elseif ( trim(arg) == '-N_ens' ) then - i = i+1 - call getarg(i,arg) - if (present(N_ens)) read (arg,*) N_ens - - elseif ( trim(arg) == '-first_ens_id' ) then - i = i+1 - call getarg(i,arg) - if (present(first_ens_id)) read (arg,*) first_ens_id - - - ! ignore arguments for assimilation, bias, adaptive estimation - - elseif ( trim(arg) == '-ens_upd_inputs_path' ) then - i = i+1 - if (outlog) & - write (logunit,*) 'clsm_ensdrv_get_command_line(): IGNORING argument = ', & - trim(arg) - - elseif ( trim(arg) == '-ens_upd_inputs_file' ) then - i = i+1 - if (outlog) & - write (logunit,*) 'clsm_ensdrv_get_command_line(): IGNORING argument = ', & - trim(arg) - - elseif ( trim(arg) == '-cat_bias_inputs_path' ) then - i = i+1 - if (outlog) & - write (logunit,*) 'clsm_ensdrv_get_command_line(): IGNORING argument = ', & - trim(arg) - - elseif ( trim(arg) == '-cat_bias_inputs_file' ) then - i = i+1 - if (outlog) & - write (logunit,*) 'clsm_ensdrv_get_command_line(): IGNORING argument = ', & - trim(arg) - - elseif ( trim(arg) == '-adapt_inputs_path' ) then - i = i+1 - if (outlog) & - write (logunit,*) 'clsm_ensdrv_get_command_line(): IGNORING argument = ', & - trim(arg) - - elseif ( trim(arg) == '-adapt_inputs_file' ) then - i = i+1 - if (outlog) & - write (logunit,*) 'clsm_ensdrv_get_command_line(): IGNORING argument = ', & - trim(arg) - - ! stop for any other arguments - - else - - err_msg = 'unknown argument = ' // trim(arg) - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - endif - - end do - - end subroutine clsm_ensdrv_get_command_line - ! *********************************************************************** end module LDAS_ensdrv_init_routines From e019b3d8d1ea4d80e1778ed5ccbd58535dde6b06 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 29 May 2020 14:05:07 -0400 Subject: [PATCH 28/42] synching develop's External into BRIDGE --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index e9039ff2..f9970364 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.3 +branch = master protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = 1.8.5 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 215c8eba980770ce898885e0a409ce2249a83eed Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 29 May 2020 18:13:40 -0400 Subject: [PATCH 29/42] hotfix - correcting GEOSgcm_GridComp tag (#235) --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index e9039ff2..3636b4a0 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = 1.8.5 +tag = v1.8.5 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 47eaadc81fb0da3b8ff3f3ec9b6d44dac00b77c5 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 11 Jun 2020 16:28:56 -0400 Subject: [PATCH 30/42] updating Externals.cfg in prep for merge to master --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index f9970364..05cfb3f8 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = master +tag = v1.1.3 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -branch = develop +tag = v1.8.6 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From e28db4ec0078457b71311daa08bdc7e618c78d1a Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 11 Jun 2020 16:33:05 -0400 Subject: [PATCH 31/42] Merging Bridge into master (#246) --- Externals.cfg | 2 +- doc/CHANGELOG.md | 93 ++++- src/Applications/LDAS_App/GEOSldas_HIST.rc | 43 +++ src/Applications/LDAS_App/GEOSldas_LDAS.rc | 13 +- src/Applications/LDAS_App/ldas_setup | 9 +- src/Applications/LDAS_App/lenkf.j.template | 25 +- src/Applications/LDAS_App/tile_bin2nc4.F90 | 17 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 2 +- .../GEOSens_GridComp/GEOS_EnsGridComp.F90 | 12 +- .../GEOS_LandAssimGridComp.F90 | 343 ++++++++++++------ .../clsm_ensdrv_drv_routines.F90 | 130 ++++++- .../clsm_ensupd_enkf_update.F90 | 4 +- .../GEOS_LandPertGridComp.F90 | 88 +++-- .../Shared/LDAS_TileCoordRoutines.F90 | 45 +++ 14 files changed, 657 insertions(+), 169 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 3636b4a0..05cfb3f8 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.5 +tag = v1.8.6 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index 116048bf..ae6bce64 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -33,15 +33,90 @@ This README file contains the history of stable GEOSldas versions ("tags") in Gi Overview of Git Releases: ============================ + + + + +------------------------------ +[v17.9.0-beta.7](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.7) - 2020-06-11 +------------------------------ + +- Zero-diff vs. v17.9.0-beta.6 for model-only simulations without perturbations. + +- Not zero-diff for simulations with perturbations (including data assimilation). + +- Infrastructure: + + - Added calculation of ensemble-mean Catchment model diagnostics to LANDASSIM GridComp for output of instantaneous forecast and analysis estimates via HISTORY (“lndfcstana” Collection). + + +- Bug fixes and other minor changes: + + - Fixed handling of LANDPERT restart files after cold-start in first job segment. + + - For lat/lon and EASE tile space only, fixed violation of zero-diff (binary identical) results when stopping/restarting at different intervals (removed extra zero-mean adjustment of LANDPERT after reading from restart file). Requires more work for cube-sphere tile space. + + - Fixed LANDPERT restart file name for cube-sphere. + + - Added log message for all ens members if LANDPERT is cold-started. + + - Removed deflation of LANDPERT checkpoint files. + + - Added “.nc4” file name extension for cube-sphere LANDPERT checkpoint file. + + - Added log message for OBSPERTRSEED “cold” start. + + - Fixed typo in default OBSPERTRSEED restart file name. + + - Fixed time stamp of output *ensprop*inputs.nml file. + + - Fixed FIRST_ENS_ID for post-processing. + + - Added “endhour” for control of loop through job segments in lenkf.j.template to facilitate job segments that are shorter than a full day. + + - Added sample entries in “LDAS.rc” for output of CHECKPOINT (restart) files before GEOSldas.x exits (RECORD_FREQUENCY, RECORD_REF_TIME, RECORD_REF_DATE). + + + +------------------------------ +[v17.9.0-beta.6](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.6) - 2020-05-29 +------------------------------ + +- Zero-diff vs. v17.9.0-beta.5 for model-only simulations without perturbations. + +- Not zero-diff for simulations with perturbations (including data assimilation). + +- Infrastructure: + + - Output of L-band Tb via HISTORY (nodata value = MAPL_UNDEF = 1.e15). + +- Bug fixes: + + - Changed timing of application of model prognostics perturbations such that perturbations at the current time step impact the land analysis and HISTORY output at that same time step. Before the fix, ApplyPrognPert was executed too late and the current time step's prognostics perturbations were missed by the land analysis and HISTORY, and only felt at the next time step. Consequently, simulations with perturbations are not zero-diff vs. v17.9.0-beta.5. + + - Fixed no-data-value handling in computation of the ensemble average for surface temperature components. + +- Cleanup and documentation: + + - Avoids redundant entries in LDAS.rc. + - Enabled setup for NUM_ENSEMBLE=1 with PERTURBATION=1. + - Improved help and log messages for setup and configuration. + - Option "--runmodel" of "ldas_setup" script is now obsolete. + - "DATAATM" renamed to "METFORCE" in HISTORY.rc. + - Removed default constraint to Haswell nodes. + + + +------------------------------ [v17.9.0-beta.5](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.5) - 2020-05-11 ------------------------------ - Pre-release meant for use under SLES12 at NCCS. Still works for SLES11. -- New/Updated Science Functionality: +- Science functionality: - Forecast error covariance inflation with scalar (globally constant) factor. -- New/Updated Infrastructure: +- Infrastructure: - Support for GEOS FP forcing with generic ("seamless") file names. - Resource parameter changes: @@ -49,7 +124,7 @@ Overview of Git Releases: - Renamed MONTHLY_OUTPUT to POSTPROC_HIST. - Updated utilities to MAPL v2.1.3, ESMA_env v2.1.3+intel19.1.0. -- Bug Fixes and Other Minor Changes: +- Bug fixes and other minor changes: - Added basic protections for concatenation of sub-daily into daily nc4 files and for generation of monthly-mean nc4 files. - Write ObsFcstAna and smapL4SMaup files into ./scratch, then move to ana/ens_avg/year/month dir in postprocessing. @@ -70,11 +145,11 @@ Overview of Git Releases: - Zero-diff vs. v17.9.0-beta.3 for Catchment only (except SMAP L1C Tb fore-minus-aft check). - Not zero-diff for CatchCN (via v1.8.3 of GEOS_GCMGridComp). -- New/Updated Science Functionality: +- Science functionality: - Resurrected SMAP L1C Tb fore-minus-aft check. -- New/Updated Infrastructure: +- Infrastructure: - Updated utilities to MAPL v2.1.1, ESMA_env v2.1.1., ESMA_cmake v3.0.1. - New GEOS_SurfaceGridComp.rc file (via v1.8.3 of GEOS_GCMGridComp). @@ -84,7 +159,7 @@ Overview of Git Releases: - Subdaily-to-daily concatenation processes before month is complete. - Temporary solution to create directories for ObsFcstAna files to enable extending an existing GEOSldas run without going through setup. -- Bug Fixes and Other Minor Changes: +- Bug fixes and other minor changes: - Updated README.md. - ~obspertrseed~ restart file name when restarting from existing run. @@ -101,7 +176,7 @@ Overview of Git Releases: ------------------------------ [v17.9.0-beta.2](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.2) - 2020-02-26 ------------------------------ -- New/Updated Science Functionality: +- Science functionality: - Assimilation when running on cube-sphere tiles. - Read forcing from cube-sphere grid when running on matching cube-sphere tiles. @@ -111,7 +186,7 @@ Overview of Git Releases: - Configuration option to add extra variables into catch restart files (as needed by GCM). - Allows processing of (assimilation) observations for innovations output *without* perturbations turned on. -- New/Updated Infrastructure: +- Infrastructure: - Support for SLES 12 in addition to SLES11 (ESMA_env v2.0.2). - Updated to MAPL v2.0. @@ -121,7 +196,7 @@ Overview of Git Releases: - Added LDAS_app/mk_GEOSldasRestarts.F90 (adapted from GCM GridComp's mk_LDASsaRestarts.F90 in preparation for re-tiling changes). - Fixed output log file name and location. -- Bug Fixes and Other Minor Changes: +- Bug fixes and other minor changes: - Bug fix in select-update_type 9 (abs(deltaT)>0.) - Bug fix for local mwRTM and time dimension restart. diff --git a/src/Applications/LDAS_App/GEOSldas_HIST.rc b/src/Applications/LDAS_App/GEOSldas_HIST.rc index 0d938044..8233cb8e 100644 --- a/src/Applications/LDAS_App/GEOSldas_HIST.rc +++ b/src/Applications/LDAS_App/GEOSldas_HIST.rc @@ -18,6 +18,8 @@ COLLECTIONS: #ASSIM 'SMAP_L4_SM_gph' # 'inst1_1d_lnr_Nt' # 'catch_progn_incr' +# 'inst3_1d_lndfcstana_Nt' +# 'inst3_2d_lndfcstana_Nx' :: #CUBE GRID_LABELS: PC720x361-DC @@ -372,3 +374,44 @@ COLLECTIONS: 'SNDZN3_INCR' , 'LANDASSIM' , :: + inst3_1d_lndfcstana_Nt.descr: 'Tile-space,3-Hourly,Instantaneous,Single-Level,Assimilation,Ensemble-Average Land Forecast and Analysis Diagnostics', + inst3_1d_lndfcstana_Nt.template: '%y4%m2%d2_%h2%n2z.bin', + inst3_1d_lndfcstana_Nt.mode: 'instantaneous', + inst3_1d_lndfcstana_Nt.frequency: 030000, + inst3_1d_lndfcstana_Nt.ref_time: 000000, + inst3_1d_lndfcstana_Nt.fields: 'WCSF' , 'ENSAVG' , 'SFMC_FCST' , + 'WCRZ' , 'ENSAVG' , 'RZMC_FCST' , + 'WCPR' , 'ENSAVG' , 'PRMC_FCST' , + 'TPSURF' , 'ENSAVG' , 'TSURF_FCST' , + 'TSOIL1TILE' , 'ENSAVG' , 'TSOIL1_FCST' , + 'WCSF_ANA' , 'LANDASSIM' , 'SFMC_ANA' , + 'WCRZ_ANA' , 'LANDASSIM' , 'RZMC_ANA' , + 'WCPR_ANA' , 'LANDASSIM' , 'PRMC_ANA' , + 'TPSURF_ANA' , 'LANDASSIM' , 'TSURF_ANA' , + 'TSOIL1_ANA' , 'LANDASSIM' , 'TSOIL1_ANA' , + :: + + inst3_2d_lndfcstana_Nx.descr: '2d,3-Hourly,Instantaneous,Single-Level,Assimilation,Ensemble-Average Land Forecast and Analysis Diagnostics', + inst3_2d_lndfcstana_Nx.template: '%y4%m2%d2_%h2%n2z.nc4', + inst3_2d_lndfcstana_Nx.archive: '%c/Y%y4', + inst3_2d_lndfcstana_Nx.mode: 'instantaneous', + inst3_2d_lndfcstana_Nx.frequency: 030000, + inst3_2d_lndfcstana_Nx.ref_time: 000000, + inst3_2d_lndfcstana_Nx.format: 'CFIO', + inst3_2d_lndfcstana_Nx.regrid_exch: '../input/tile.data', + inst3_2d_lndfcstana_Nx.regrid_name: 'GRIDNAME', + inst3_2d_lndfcstana_Nx.grid_label: PC720x361-DC, + inst3_2d_lndfcstana_Nx.deflate: 2, + inst3_2d_lndfcstana_Nx.fields: 'WCSF' , 'ENSAVG' , 'SFMC_FCST' , + 'WCRZ' , 'ENSAVG' , 'RZMC_FCST' , + 'WCPR' , 'ENSAVG' , 'PRMC_FCST' , + 'TPSURF' , 'ENSAVG' , 'TSURF_FCST' , + 'TSOIL1TILE' , 'ENSAVG' , 'TSOIL1_FCST' , + 'WCSF_ANA' , 'LANDASSIM' , 'SFMC_ANA' , + 'WCRZ_ANA' , 'LANDASSIM' , 'RZMC_ANA' , + 'WCPR_ANA' , 'LANDASSIM' , 'PRMC_ANA' , + 'TPSURF_ANA' , 'LANDASSIM' , 'TSURF_ANA' , + 'TSOIL1_ANA' , 'LANDASSIM' , 'TSOIL1_ANA' , + :: + +# ========================== EOF ============================================================== diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index 3b59a389..284e824e 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -109,7 +109,7 @@ FIRST_ENS_ID: 0 # ---- Job segments: Length # -# Specify period between output of restart files. (GEOSldas.x shuts down and restarts.) +# Specify period between GEOSldas.x shutdown and restart. # Default is the entire simulation period (END_DATE minus BEG_DATE). # Format: yyyymmdd hhmmss # @@ -125,6 +125,17 @@ FIRST_ENS_ID: 0 # NUM_SGMT: 1 +# ---- CHECKPOINT file output +# +# By default, CHECKPOINT (restart) files are are written at the end of each job segment. +# Restart files can also be written before exiting GEOSldas.x. +# The following resource parameters specify the frequency and reference time and date. +# +# RECORD_FREQUENCY: 0240000 # hhhmmss (can be greater than 1 day!) +# RECORD_REF_TIME: 000000 # hhmmss (reference time-of-day) +# RECORD_REF_DATE: 19790101 000000 # yyyymmdd hhmmss (date/time after which checkpoints are written) + + # ---- Output: Write log file (YES/NO)? # LDAS_logit: YES diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 92efbe09..a516ad70 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -105,6 +105,7 @@ class LDASsetup: self.has_ldassa_pert = False self.nSegments = 1 self.perturb = 0 + self.first_ens_id = 0 # ------ # Read exe input file which is required to set up the dir # ------ @@ -142,12 +143,12 @@ class LDASsetup: _mydir = self.exphome + '/' + self.rqdExeInp['EXP_ID'] assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None - _first_ens_id = int(self.rqdExeInp.get('FIRST_ENS_ID',0)) + self.first_ens_id = int(self.rqdExeInp.get('FIRST_ENS_ID',0)) self.perturb = int(self.rqdExeInp.get('PERTURBATIONS',0)) if self.nens > 1: self.perturb = 1 - self.ensdirs = ['ens%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] - self.ensids = ['%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] + self.ensdirs = ['ens%04d'%iens for iens in range(self.first_ens_id, self.nens + self.first_ens_id)] + self.ensids = ['%04d'%iens for iens in range(self.first_ens_id, self.nens + self.first_ens_id)] if (self.nens == 1) : self.ensdirs_avg = self.ensdirs self.ensids=[''] @@ -1273,6 +1274,8 @@ class LDASsetup: fout.write(line.replace('MY_MODEL',self.catch)) elif 'MY_POSTPROC_HIST' in line : fout.write(line.replace('MY_POSTPROC_HIST',str(self.rqdExeInp['POSTPROC_HIST']))) + elif 'MY_FIRST_ENS_ID' in line : + fout.write(line.replace('MY_FIRST_ENS_ID',str(self.first_ens_id))) else : fout.write(line.replace('MY_EXPDIR',self.exphome+'/$EXPID')) diff --git a/src/Applications/LDAS_App/lenkf.j.template b/src/Applications/LDAS_App/lenkf.j.template index f18cf98b..6206e87a 100644 --- a/src/Applications/LDAS_App/lenkf.j.template +++ b/src/Applications/LDAS_App/lenkf.j.template @@ -572,8 +572,9 @@ EOF # Move Intermediate Checkpoints to RESTARTS directory # --------------------------------------------------- - @ inens = 0 - while ($inens < $NENS) + @ inens = MY_FIRST_ENS_ID + @ enens = $inens + $NENS + while ($inens < $enens) if ($inens <10) then set ENSDIR = `echo ens000${inens}` else if($inens<100) then @@ -599,11 +600,19 @@ EOF set rstf = 'landpert' if (-f ${rstf}${ENSID}_internal_checkpoint ) then set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} + # copy generic restart file to final location/name but remove lat/lon variables + # (lat/lon variables are not correct when running in EASE-grid tile space) ncks -4 -O -C -x -v lat,lon ${rstf}${ENSID}_internal_checkpoint $tmp_file /bin/rm -f ${rstf}${ENSID}_internal_checkpoint set old_rst = `/usr/bin/readlink -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst` /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst /bin/ln -s $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst + set pert_rst = `grep -o "LANDPERT_INTERNAL_RESTART_FILE" LDAS.rc` + if ( $pert_rst == '' ) then + echo "LANDPERT_INTERNAL_RESTART_FILE: ../input/restart/landpert%s_internal_rst" >> LDAS.rc + /bin/mv ../run/LDAS.rc ../run/LDAS.rc.sgmt0 + /bin/cp LDAS.rc ../run/LDAS.rc + endif /usr/bin/gzip $old_rst & endif @@ -681,14 +690,18 @@ EOF ####################################################################### # Update Iteration Counter ####################################################################### - + set enddate = `echo $END_DATE | cut -c1-8` + set endhour = `echo $END_DATE | cut -c10-11` set capdate = `cat cap_restart | cut -c1-8` - + set caphour = `cat cap_restart | cut -c10-11` + if ( $capdate < $enddate ) then - @ counter = $counter + 1 + @ counter = $counter + 1 + else if ( $capdate == $enddate && $caphour < $endhour ) then + @ counter = $counter + 1 else - @ counter = ${NUM_SGMT} + 1 + @ counter = ${NUM_SGMT} + 1 endif ## End of the while ( $counter <= ${NUM_SGMT} ) loop ## diff --git a/src/Applications/LDAS_App/tile_bin2nc4.F90 b/src/Applications/LDAS_App/tile_bin2nc4.F90 index c29b56b9..5fa961df 100644 --- a/src/Applications/LDAS_App/tile_bin2nc4.F90 +++ b/src/Applications/LDAS_App/tile_bin2nc4.F90 @@ -384,9 +384,22 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('SNDZN1_INCR'); LONG_NAME = 'increment_snow_depth_layer_1'; UNITS = 'm' case ('SNDZN2_INCR'); LONG_NAME = 'increment_snow_depth_layer_2'; UNITS = 'm' case ('SNDZN3_INCR'); LONG_NAME = 'increment_snow_depth_layer_3'; UNITS = 'm' - ! + + ! land assimilation forecast and analysis for Catchment model diagnostics + + case ('SFMC_FCST'); LONG_NAME = 'soil_moisture_surface_forecast'; UNITS = 'm3 m-3' + case ('RZMC_FCST'); LONG_NAME = 'soil_moisture_rootzone_forecast'; UNITS = 'm3 m-3' + case ('PRMC_FCST'); LONG_NAME = 'soil_moisture_profile_forecast'; UNITS = 'm3 m-3' + case ('TSURF_FCST'); LONG_NAME = 'ave_catchment_temp_incl_snw_forecast'; UNITS = 'K' + case ('TSOIL1_FCST'); LONG_NAME = 'soil_temperatures_layer_1_forecast'; UNITS = 'K' + case ('SFMC_ANA'); LONG_NAME = 'soil_moisture_surface_analysis'; UNITS = 'm3 m-3' + case ('RZMC_ANA'); LONG_NAME = 'soil_moisture_rootzone_analysis'; UNITS = 'm3 m-3' + case ('PRMC_ANA'); LONG_NAME = 'soil_moisture_profile_analysis'; UNITS = 'm3 m-3' + case ('TSURF_ANA'); LONG_NAME = 'ave_catchment_temp_incl_snw_analysis'; UNITS = 'K' + case ('TSOIL1_ANA'); LONG_NAME = 'soil_temperatures_layer_1_analysis'; UNITS = 'K' + ! default LONG_NAME and UNITS for nc4 files created by tile_bin2nc4.F90 (used for any SHORT_NAME not listed above): - ! + case default; LONG_NAME = 'not defined in tile_bin2nc4.F90'; UNITS = 'not defined in tile_bin2nc4.F90'; end select diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index ae65d1fa..b404e68f 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -165,7 +165,7 @@ subroutine SetServices(gc, rc) VERIFY_(status) allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) - write (fmt_str, "(A2,I1,A1,I1,A1)") "(I", ens_id_width,".",ens_id_width,")" + write (fmt_str, "(A2,I1,A1,I1,A1)") "(I", ens_id_width,".",ens_id_width,")" ! BUG? only works for ens_id_width<10) (reichle, 11 Jun 2020) do i=1,NUM_ENSEMBLE ens_id(i) = i-1 + FIRST_ENS_ID ! id start form FIRST_ENS_ID if(NUM_ENSEMBLE == 1 ) then diff --git a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 index ffafa75a..46fd1115 100644 --- a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 @@ -3257,12 +3257,12 @@ subroutine Collect_land_ens(gc, import, export, clock, rc) if(associated(WCSF_enavg)) WCSF_enavg = WCSF_enavg/NUM_ENSEMBLE if(associated(WCRZ_enavg)) WCRZ_enavg = WCRZ_enavg/NUM_ENSEMBLE if(associated(WCPR_enavg)) WCPR_enavg = WCPR_enavg/NUM_ENSEMBLE - if(associated(TP1_enavg)) TP1_enavg = TP1_enavg/NUM_ENSEMBLE + MAPL_TICE - if(associated(TP2_enavg)) TP2_enavg = TP2_enavg/NUM_ENSEMBLE + MAPL_TICE - if(associated(TP3_enavg)) TP3_enavg = TP3_enavg/NUM_ENSEMBLE + MAPL_TICE - if(associated(TP4_enavg)) TP4_enavg = TP4_enavg/NUM_ENSEMBLE + MAPL_TICE - if(associated(TP5_enavg)) TP5_enavg = TP5_enavg/NUM_ENSEMBLE + MAPL_TICE - if(associated(TP6_enavg)) TP6_enavg = TP6_enavg/NUM_ENSEMBLE + MAPL_TICE + if(associated(TP1_enavg)) TP1_enavg = TP1_enavg/NUM_ENSEMBLE + MAPL_TICE ! convert to K + if(associated(TP2_enavg)) TP2_enavg = TP2_enavg/NUM_ENSEMBLE + MAPL_TICE ! convert to K + if(associated(TP3_enavg)) TP3_enavg = TP3_enavg/NUM_ENSEMBLE + MAPL_TICE ! convert to K + if(associated(TP4_enavg)) TP4_enavg = TP4_enavg/NUM_ENSEMBLE + MAPL_TICE ! convert to K + if(associated(TP5_enavg)) TP5_enavg = TP5_enavg/NUM_ENSEMBLE + MAPL_TICE ! convert to K + if(associated(TP6_enavg)) TP6_enavg = TP6_enavg/NUM_ENSEMBLE + MAPL_TICE ! convert to K if(associated(EMIS_enavg)) EMIS_enavg = EMIS_enavg/NUM_ENSEMBLE if(associated(ALBVR_enavg)) ALBVR_enavg = ALBVR_enavg/NUM_ENSEMBLE if(associated(ALBVF_enavg)) ALBVF_enavg = ALBVF_enavg/NUM_ENSEMBLE diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 741fb64a..15ac2fb2 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -14,8 +14,10 @@ module GEOS_LandAssimGridCompMod use ESMF use MAPL_Mod - use ESMF_CFIOMOD, only: ESMF_CFIOstrTemplate + use ESMF_CFIOMOD, only: ESMF_CFIOstrTemplate + use MAPL_ConstantsMod, only: MAPL_TICE + use LDAS_TileCoordType, only: tile_coord_type use LDAS_TileCoordType, only: grid_def_type use LDAS_TileCoordType, only: T_TILECOORD_STATE @@ -46,6 +48,7 @@ module GEOS_LandAssimGridCompMod use catch_bias_types, only: cat_bias_param_type use catch_types, only: cat_progn_type use catch_types, only: cat_param_type + use catch_types, only: cat_diagS_type use catch_types, only: assignment(=), operator (+), operator (/) use clsm_bias_routines, only: initialize_obs_bias use clsm_bias_routines, only: read_cat_bias_inputs @@ -58,6 +61,8 @@ module GEOS_LandAssimGridCompMod use clsm_ensupd_enkf_update, only: output_incr_etc use clsm_ensupd_enkf_update, only: write_smapL4SMaup use clsm_ensdrv_out_routines, only: init_log, GEOS_output_smapL4SMlmc + use clsm_ensdrv_drv_routines, only: recompute_diagS + use mwRTM_routines, only: mwRTM_get_Tb, catch2mwRTM_vars use, intrinsic :: ieee_arithmetic @@ -743,7 +748,61 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) _VERIFY(STATUS) + ! some analysis model diagnostics + + ! - sm_surface_analysis [m3 m-3] + ! - sm_rootzone_analysis [m3 m-3] + ! - sm_profile_analysis [m3 m-3] + ! - surface_temp_analysis [K] + ! - soil_temp_layer1_analysis [K] + ! could add other model diagnostics available in "cat_diagS_ensavg" (see below) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'soil_moisture_surface_analysis' ,& + UNITS = 'm3 m-3' ,& + SHORT_NAME = 'WCSF_ANA' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'soil_moisture_rootzone_analysis' ,& + UNITS = 'm3 m-3' ,& + SHORT_NAME = 'WCRZ_ANA' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'soil_moisture_profile_analysis' ,& + UNITS = 'm3 m-3' ,& + SHORT_NAME = 'WCPR_ANA' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'ave_catchment_temp_incl_snw_analysis' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TPSURF_ANA' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'soil_temperatures_layer_1_analysis' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TSOIL1_ANA' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + ! ! INTERNAL STATE ! @@ -976,7 +1035,7 @@ subroutine Initialize(gc, import, export, clock, rc) character(len=300) :: seed_fname character(len=300) :: fname_tpl character(len=14) :: datestamp - character(len=4) :: id_string + character(len=4) :: id_string ! BUG! should be "len=ens_id_width" (reichle, 11 Jun 2020) integer :: nymd, nhms !! from LDASsa @@ -1072,7 +1131,7 @@ subroutine Initialize(gc, import, export, clock, rc) if (master_proc) then - call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_RESTART_FILE:", DEFAULT="../intput/restart/landassim_obspertrseed%s_rst", RC=STATUS) + call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_RESTART_FILE:", DEFAULT="../input/restart/landassim_obspertrseed%s_rst", RC=STATUS) _VERIFY(STATUS) call MAPL_DateStampGet( clock, datestamp, rc=status) _VERIFY(STATUS) @@ -1080,10 +1139,10 @@ subroutine Initialize(gc, import, export, clock, rc) read(datestamp(10:13),*) nhms nhms = nhms*100 do ens = 0, NUM_ENSEMBLE-1 - write(id_string,'(I4.4)') ens + FIRST_ENS_ID + write(id_string,'(I4.4)') ens + FIRST_ENS_ID ! BUG! format string should depend on ens_id_width (reichle, 11 Jun 2020) seed_fname = "" call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - call read_pert_rseed(seed_fname,Pert_rseed_r8(:,ens+1)) + call read_pert_rseed(id_string,seed_fname,Pert_rseed_r8(:,ens+1)) Pert_rseed(:,ens+1) = nint(Pert_rseed_r8(:,ens+1)) if (all(Pert_rseed(:,ens+1) == 0)) then @@ -1241,7 +1300,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) type(date_time_type) :: date_time_new character(len=14) :: datestamp - integer :: N_catl, N_catg,N_obsl_max, n_e, i + integer :: N_catl, N_catg,N_obsl_max, n_e, ii character(len=300) :: out_path character(len=ESMF_MAXSTR) :: exp_id @@ -1253,15 +1312,19 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: N_adapt_R type(MAPL_LocStream) :: locstream - integer, dimension(:), allocatable :: obs_pert_adapt_param + integer, dimension(:), allocatable :: obs_pert_adapt_param real, dimension(:,:), allocatable :: Pert_adapt_R real, dimension(:,:), allocatable :: Obs_pert type(obs_bias_type), dimension(:,:,:), allocatable :: obs_bias type(cat_progn_type), dimension(:,:), allocatable :: cat_progn_incr type(cat_progn_type), dimension(:), allocatable :: cat_progn_incr_ensavg + type(cat_progn_type), dimension(:), allocatable :: cat_progn_tmp + + type(cat_diagS_type), dimension(:), allocatable :: cat_diagS + type(cat_diagS_type), dimension(:), allocatable :: cat_diagS_ensavg - type(obs_type), dimension(:), pointer :: Observations_l => null() + type(obs_type), dimension(:), pointer :: Observations_l => null() logical :: fresh_incr integer :: N_obsf,N_obsl @@ -1315,14 +1378,20 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real, dimension(:),pointer :: SNDZN2_incr=>null() real, dimension(:),pointer :: SNDZN3_incr=>null() + !! export for analysis model diagnostics - logical :: spin + real, dimension(:),pointer :: SFMC_ana=>null() ! surface soil moisture + real, dimension(:),pointer :: RZMC_ana=>null() ! rootzone soil moisture + real, dimension(:),pointer :: PRMC_ana=>null() ! profile soil moisture + real, dimension(:),pointer :: TPSURF_ana=>null() ! tpsurf + real, dimension(:),pointer :: TSOIL1_ana=>null() ! tsoil1 + logical, save :: firsttime=.true. type(cat_bias_param_type) :: cat_bias_param integer :: N_catbias character(len=300) :: seed_fname character(len=300) :: fname_tpl - character(len=4) :: id_string + character(len=4) :: id_string ! BUG! should be "len=ens_id_width" (reichle, 11 Jun 2020) integer :: ens, nymd, nhms #ifdef DBG_LANDASSIM_INPUTS @@ -1416,7 +1485,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) read(datestamp(10:13),*) nhms nhms = nhms*100 do ens = 0, NUM_ENSEMBLE-1 - write(id_string,'(I4.4)') ens + FIRST_ENS_ID + write(id_string,'(I4.4)') ens + FIRST_ENS_ID ! BUG! format string should be '(I[ens_id_width].[ens_id_width])' (reichle, 11 Jun 2020) seed_fname = "" call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) _VERIFY(STATUS) @@ -1470,9 +1539,9 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(status) call MAPL_GetPointer(import, LAI, 'LAI', rc=status) _VERIFY(status) -! -! export for incr -! + + ! exports for model prognostics increments + call MAPL_GetPointer(export, TC1_incr, 'TCFSAT_INCR' ,rc=status) _VERIFY(status) call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status) @@ -1524,6 +1593,19 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(export, SNDZN3_incr, 'SNDZN3_INCR' ,rc=status) _VERIFY(status) + ! exports for analysis model diagnostics + + call MAPL_GetPointer(export, TPSURF_ana, 'TPSURF_ANA' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, TSOIL1_ana, 'TSOIL1_ANA' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, SFMC_ana, 'WCSF_ANA' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, RZMC_ana, 'WCRZ_ANA' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, PRMC_ana, 'WCPR_ANA' ,rc=status) + VERIFY_(status) + allocate(met_force(N_catl)) met_force(:)%Tair = TA_enavg(:) met_force(:)%Qair = QA_enavg(:) @@ -1552,11 +1634,12 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) trim(exp_id), start_time, N_catl, numprocs, N_catl_vec, low_ind, obs_bias) end if - allocate(cat_progn_incr(N_catl,NUM_ENSEMBLE)) - allocate(cat_progn_incr_ensavg(N_catl)) - allocate(Observations_l(N_obsl_max)) - - !WY note: temporary + allocate(cat_progn_incr( N_catl, NUM_ENSEMBLE)) + allocate(cat_progn_incr_ensavg(N_catl )) + allocate(Observations_l( N_obsl_max )) + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + #ifdef DBG_LANDASSIM_INPUTS if (firsttime) then @@ -1604,6 +1687,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_VarWrite(unit, tilegrid, met_force(:)%wind, mask=mask, rc=status); _VERIFY(STATUS) call MAPL_VarWrite(unit, tilegrid, met_force(:)%RefH, mask=mask, rc=status); _VERIFY(STATUS) + unit = GETFILE( "landassim_catprogn_inputs.bin", form="unformatted", RC=STATUS ) _VERIFY(STATUS) @@ -1670,6 +1754,9 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) endif #endif ! DBG_LANDASSIM_INPUTS + + ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + call get_enkf_increments( & date_time_new, & @@ -1692,105 +1779,137 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! below are dummy for now N_adapt_R, obs_pert_adapt_param, Pert_adapt_R) - ! forced to apply - spin = .false. - if (.not. spin) then - if (fresh_incr) then - ! apply EnKF increments - ! (without call to subroutine recompute_diagnostics()) - call apply_enkf_increments( N_catl, NUM_ENSEMBLE, update_type, cat_param, & - cat_progn_incr, cat_progn ) - - end if ! fresh_incr + if (fresh_incr) then + ! apply EnKF increments (incl. call to catch_calc_soil_moist but not to recompute_diagS()) + call apply_enkf_increments( N_catl, NUM_ENSEMBLE, update_type, cat_param, & + cat_progn_incr, cat_progn ) + + end if ! fresh_incr + + ! if requested, write incr and/or ObsFcstAna files whenever it was + ! time for assimilation, even if there were no observations + ! - reichle, 29 Aug 2014 + + secs_in_day = & + date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec + + if (centered_update) secs_in_day = secs_in_day + dtstep_assim/2 + + ! WY note : Here N_catg is not the global land tile number + ! but a maximum global_id this simulation covers. + ! Need to find the number + N_catg = maxval(rf2g) + + if (mod(secs_in_day, dtstep_assim)==0) then - ! if requested, write incr and/or ObsFcstAna files whenever it was - ! time for assimilation, even if there were no observations - ! - reichle, 29 Aug 2014 + call output_incr_etc( out_ObsFcstAna, & + date_time_new, trim(out_path), trim(exp_id), & + N_obsl, N_obs_param, NUM_ENSEMBLE, & + N_catl, tile_coord_l, & + N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, & + N_catl_vec, low_ind, rf2l, N_catg, rf2g, & + obs_param, & + met_force, lai, & + cat_param, cat_progn, cat_progn_incr, mwRTM_param, & + Observations_l, rf2f=rf2f ) - secs_in_day = & - date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec + do ii = 1, N_catl + cat_progn_incr_ensavg(ii) = 0.0 + do n_e=1, NUM_ENSEMBLE + cat_progn_incr_ensavg(ii) = cat_progn_incr_ensavg(ii) & + + cat_progn_incr(ii,n_e) + end do + cat_progn_incr_ensavg(ii) = cat_progn_incr_ensavg(ii)/real(NUM_ENSEMBLE) + enddo - if (centered_update) secs_in_day = secs_in_day + dtstep_assim/2 + if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 + if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 + if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 + if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 + if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 + if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 - ! WY note : Here N_catg is not the global land tile number - ! but a maximum global_id this simulation covers. - ! Need to find the number - N_catg = maxval(rf2g) + if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac + if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef + if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc + if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc - if (mod(secs_in_day, dtstep_assim)==0) then - - call output_incr_etc( out_ObsFcstAna, & - date_time_new, trim(out_path), trim(exp_id), & - N_obsl, N_obs_param, NUM_ENSEMBLE, & - N_catl, tile_coord_l, & - N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, & - N_catl_vec, low_ind, rf2l, N_catg, rf2g, & - obs_param, & - met_force, lai, & - cat_param, cat_progn, cat_progn_incr, mwRTM_param, & - Observations_l, rf2f=rf2f ) - - - do i = 1, N_catl - cat_progn_incr_ensavg(i) = 0.0 - do n_e=1, NUM_ENSEMBLE - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & - + cat_progn_incr(i,n_e) - end do - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) - enddo - - if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 - if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 - if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 - if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 - if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 - if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 - - if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac - if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef - if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc - if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc + if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) + if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) + if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) + if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) + if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) + if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) + + if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) + if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) + if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) + + if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) + if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) + if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) + + if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) + if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) + if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) + + + ! recompute select model diagnostics after analysis + + allocate(cat_progn_tmp( N_catl)) + allocate(cat_diagS( N_catl)) + allocate(cat_diagS_ensavg(N_catl)) + + do ii=1,N_catl + cat_diagS_ensavg(ii) = 0.0 ! initialize ens average + end do + + do n_e=1,NUM_ENSEMBLE - if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) - if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) - if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) - if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) - if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) - if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) + ! make a copy of cat_progn to ensure 0-diff (recompute_diagS() potentially alters its input cat_progn) - if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) - if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) - if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) + do ii=1,N_catl + cat_progn_tmp(ii) = cat_progn(ii,n_e) + end do - if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) - if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) - if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) + call recompute_diagS( N_catl, cat_param, cat_progn_tmp, cat_diagS ) - if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) - if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) - if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) + do ii=1,N_catl + cat_diagS_ensavg(ii) = cat_diagS_ensavg(ii) + cat_diagS(ii) + end do + end do + + do ii=1,N_catl + cat_diagS_ensavg(ii) = cat_diagS_ensavg(ii)/real(NUM_ENSEMBLE) ! normalize + end do + + if(associated(SFMC_ana)) SFMC_ana(:) = cat_diagS_ensavg(:)%sfmc + if(associated(RZMC_ana)) RZMC_ana(:) = cat_diagS_ensavg(:)%rzmc + if(associated(PRMC_ana)) PRMC_ana(:) = cat_diagS_ensavg(:)%prmc + if(associated(TPSURF_ana)) TPSURF_ana(:) = cat_diagS_ensavg(:)%tsurf + if(associated(TSOIL1_ana)) TSOIL1_ana(:) = cat_diagS_ensavg(:)%tp(1) + MAPL_TICE ! convert to K + + deallocate(cat_progn_tmp) + deallocate(cat_diagS) + deallocate(cat_diagS_ensavg) - ! write analysis fields into SMAP L4_SM aup file - ! whenever it was time for assimilation (regardless - ! of whether obs were actually assimilated and fresh - ! increments were computed) - - if (out_smapL4SMaup) & - call write_smapL4SMaup( 'analysis', date_time_new, trim(out_path), & - trim(exp_id), NUM_ENSEMBLE, N_catl, N_catf, N_obsl, tile_coord_rf, & - tcinternal%grid_g, N_catl_vec, low_ind, & - N_obs_param, obs_param, Observations_l, cat_param, cat_progn ) - - end if - fresh_incr = .false. + ! write analysis fields into SMAP L4_SM aup file + ! whenever it was time for assimilation (regardless + ! of whether obs were actually assimilated and fresh + ! increments were computed) - endif !spin - + if (out_smapL4SMaup) & + call write_smapL4SMaup( 'analysis', date_time_new, trim(out_path), & + trim(exp_id), NUM_ENSEMBLE, N_catl, N_catf, N_obsl, tile_coord_rf, & + tcinternal%grid_g, N_catl_vec, low_ind, & + N_obs_param, obs_param, Observations_l, cat_param, cat_progn ) + + end if ! (mod(secs_in_day, dtstep_assim)==0) (time for assimilation) + fresh_incr = .false. !-------------------- ! Pointers to inputs @@ -2141,18 +2260,30 @@ end subroutine CALC_LAND_TB ! ****************************************************************************** - subroutine read_pert_rseed(seed_fname,pert_rseed_r8) + subroutine read_pert_rseed(id_string,seed_fname,pert_rseed_r8) use netcdf + character(len=*),intent(in) :: id_string character(len=*),intent(in) :: seed_fname real(kind=ESMF_KIND_R8),intent(inout) :: pert_rseed_r8(:) integer :: ncid, s_varid, en_dim, n_ens, id_varid, i, pos logical :: file_exist + + character(len=ESMF_MAXSTR) :: tmpstr inquire (file = trim(seed_fname), exist=file_exist) if ( .not. file_exist) then + tmpstr = 'Cold-starting OBSPERTRSEED for ens member ' // trim(id_string) // '.' + if (len_trim(seed_fname)>0) then + print *, trim(tmpstr), 'File not found: ', trim(seed_fname) + else + print *, trim(tmpstr), 'Restart file name is empty.' + end if pert_rseed_r8 = 0 return + else + tmpstr = 'Reading OBSPERTRSEED for ens member ' // trim(id_string) // ' from ' + print *, trim(tmpstr), trim(seed_fname) endif call check( nf90_open(seed_fname, NF90_NOWRITE, ncid) ) @@ -2354,7 +2485,7 @@ subroutine Finalize(gc, import, export, clock, rc) character(len=300) :: fname_tpl character(len=300) :: out_path character(len=ESMF_MAXSTR) :: exp_id - character(len=4) :: id_string + character(len=4) :: id_string ! BUG! should be "len=ens_id_width" (reichle, 11 Jun 2020) character(len=14) :: datestamp integer :: ens, nymd, nhms @@ -2385,7 +2516,7 @@ subroutine Finalize(gc, import, export, clock, rc) read(datestamp(10:13),*) nhms nhms = nhms*100 do ens = 0, NUM_ENSEMBLE-1 - write(id_string,'(I4.4)') ens + FIRST_ENS_ID + write(id_string,'(I4.4)') ens + FIRST_ENS_ID ! BUG! format string should depend on ens_id_width (reichle, 11 Jun 2020) seed_fname = "" call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) _VERIFY(STATUS) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 index 080246f2..6402ca72 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 @@ -11,6 +11,9 @@ module clsm_ensdrv_drv_routines ! - optimized restart-to-exp-domain mapping in initialize_model() ! reichle, 5 Apr 2013 - revised treatment of output collections + use MAPL_ConstantsMod, ONLY: & + Tzero => MAPL_TICE + use catch_constants, ONLY: & N_snow => CATCH_N_SNOW, & N_gt => CATCH_N_GT @@ -20,14 +23,32 @@ module clsm_ensdrv_drv_routines use catch_types, ONLY: & cat_param_type, & - cat_progn_type + cat_progn_type, & + cat_diagS_type, & + catprogn2wesn, & + catprogn2htsn, & + catprogn2sndz, & + catprogn2ghtcnt + use LDAS_ensdrv_mpi, ONLY: & mpicomm, & mpierr, & numprocs, & master_proc + use catchment_model, ONLY: & + catch_calc_tsurf + + use lsm_routines, ONLY: & + catch_calc_soil_moist, & + catch_calc_tp + + use StieglitzSnow, ONLY: & + StieglitzSnow_calc_asnow, & + StieglitzSnow_calc_tpsnow + + implicit none include 'mpif.h' @@ -35,6 +56,7 @@ module clsm_ensdrv_drv_routines private public :: check_cat_progn + public :: recompute_diagS public :: l2f_real public :: f2l_real public :: f2l_real8 @@ -122,8 +144,112 @@ subroutine check_cat_progn( N_cat, cat_param, cat_progn ) end subroutine check_cat_progn - ! ************************************************************* + ! ********************************************************************* + + subroutine recompute_diagS( N_catd, cat_param, cat_progn, cat_diagS ) + + ! replace cat_diagS with updated diagnostics + ! + ! typically called after prognostics perturbations, EnKF update, and/or cat + ! bias correction + ! + ! IMPORTANT: cat_progn is intent(inout) because srfexc, rzexc, and catdef + ! fields *might* be changed! Such changes can be prevented by first calling + ! subroutine check_cat_progn(). + ! + ! reichle, 20 Oct 2004 + ! reichle, 14 Feb 2013 - added recomputation of soil temperature + ! reichle, 30 Oct 2013 - moved from clsm_ensupd_upd_routines.F90 + ! - removed dependency on "update_type" + ! - added recompute of snow diagnostics + + integer, intent(in) :: N_catd + + ! note: cat_progn must be "inout" because call to calc_soil_moist + ! might reset inconsistent sets of srfexc, rzexc, catdef + + type(cat_param_type), dimension(N_catd), intent(in) :: cat_param + type(cat_progn_type), dimension(N_catd), intent(inout) :: cat_progn + type(cat_diagS_type), dimension(N_catd), intent(inout) :: cat_diagS + + ! local variables + integer :: ii + + real, dimension( N_catd) :: ar4, fices + + real, dimension(N_gt,N_catd) :: tp + + ! ------------------------------------------------------------------ + + ! update soil moisture diagnostics + + ! note that the call to calc_soil_moist resets srfexc, rzexc, and + ! catdef if they are not consistent! + + ! updated to new interface - reichle, 3 Apr 2012 + + call catch_calc_soil_moist( & + N_catd, & + cat_param%vegcls, cat_param%dzsf, cat_param%vgwmax, & + cat_param%cdcr1, cat_param%cdcr2, cat_param%psis, & + cat_param%bee, cat_param%poros, cat_param%wpwet, & + cat_param%ars1, cat_param%ars2, cat_param%ars3, & + cat_param%ara1, cat_param%ara2, cat_param%ara3, & + cat_param%ara4, cat_param%arw1, cat_param%arw2, & + cat_param%arw3, cat_param%arw4, & + cat_progn%srfexc, cat_progn%rzexc, cat_progn%catdef, & + cat_diagS%ar1, cat_diagS%ar2, ar4, & + cat_diagS%sfmc, cat_diagS%rzmc, cat_diagS%prmc) + + + ! update snow cover fraction and snow temperatures + + call StieglitzSnow_calc_asnow( & + N_snow, N_catd, catprogn2wesn(N_catd,cat_progn), cat_diagS%asnow ) + + do ii=1,N_snow + + call StieglitzSnow_calc_tpsnow( N_catd, & + cat_progn(1:N_catd)%htsn(ii), & + cat_progn(1:N_catd)%wesn(ii), & + cat_diagS(1:N_catd)%tpsn(ii), & + fices ) + + cat_diagS%tpsn(ii) = cat_diagS%tpsn(ii) + Tzero ! convert to Kelvin + + end do + + ! update surface temperature + + ! updated to new interface, + ! need ar1, ar2, ar4 from call to catch_calc_soil_moist() above + ! - reichle, 3 Apr 2012 + + call catch_calc_tsurf( N_catd, & + cat_progn%tc1, cat_progn%tc2, cat_progn%tc4, & + catprogn2wesn(N_catd,cat_progn), & + catprogn2htsn(N_catd,cat_progn), & + cat_diagS%ar1, cat_diagS%ar2, ar4, & + cat_diagS%tsurf ) + + ! update soil temperature + + ! NOTE: "tp" is returned in CELSIUS [for consistency w/ catchment.F90] + + call catch_calc_tp( N_catd, cat_param%poros, & + catprogn2ghtcnt(N_catd,cat_progn), tp ) + + do ii=1,N_gt + + cat_diagS(:)%tp(ii) = tp(ii,:) + + end do + + end subroutine recompute_diagS + + ! ******************************************************************** + subroutine l2f_real( N_l, N_f, N_l_vec, low_ind, data_l, data_f) ! wrapper for MPI_GATHERV applied to MPI_REAL vector diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 8fc2625f..7bb3ab1d 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -135,7 +135,7 @@ module clsm_ensupd_enkf_update public :: get_enkf_increments public :: apply_enkf_increments public :: output_incr_etc - public :: write_smapL4SMaup + public :: write_smapL4SMaup contains @@ -1978,7 +1978,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & ! - sm_profile_forecast ! - surface_temp_forecast ! - soil_temp_layer1_forecast - ! + ! option = 'analysis' : append select analysis fields into output file ! ! - sm_surface_analysis diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 index 7c298c07..bcaca064 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 @@ -7,6 +7,7 @@ module GEOS_LandPertGridCompMod ! !USES use ESMF + use ESMF_CFIOMod, only: ESMF_CFIOStrTemplate use MAPL_Mod use, intrinsic :: iso_c_binding, only: c_loc, c_f_pointer use LDAS_PertTypes, only: pert_param_type @@ -38,7 +39,7 @@ module GEOS_LandPertGridCompMod use LDAS_PertRoutinesMod, only: GEOSldas_PROGN_PERT_DTSTEP use LDAS_PertRoutinesMod, only: GEOSldas_NUM_ENSEMBLE use LDAS_PertRoutinesMod, only: GEOSldas_FIRST_ENS_ID - use LDAS_TileCoordRoutines, only: grid2tile, tile2grid, tile_mask_grid + use LDAS_TileCoordRoutines, only: grid2tile, tile2grid_simple, tile_mask_grid use LDAS_TileCoordRoutines, only: get_ij_ind_from_latlon use force_and_cat_progn_pert_types, only: N_FORCE_PERT_MAX use force_and_cat_progn_pert_types, only: N_PROGN_PERT_MAX @@ -70,6 +71,7 @@ module GEOS_LandPertGridCompMod integer,dimension(:,:),pointer,public :: pert_iseed=>null() integer :: lat1, lat2, lon1, lon2 integer :: FIRST_ENS_ID + logical :: COLDSTART contains !BOP @@ -819,7 +821,7 @@ end subroutine SetServices !BOP - ! !IROTUINE: Initialize -- initialize method for LDAS GC + ! !IROUTINE: Initialize -- initialize method for LDAS GC ! !INTERFACE: @@ -840,7 +842,7 @@ subroutine Initialize(gc, import, export, clock, rc) integer :: status character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name - character(len=ESMF_MAXSTR) :: rst_fname + character(len=ESMF_MAXSTR) :: rst_fname, rst_fname_tmp ! ESMF variables type(ESMF_VM) :: vm @@ -851,7 +853,7 @@ subroutine Initialize(gc, import, export, clock, rc) type(ESMF_State) :: MINTERNAL ! LDAS variables - type(date_time_type) :: start_time, stop_time + type(date_time_type) :: start_time, stop_time, current_time ! MAPL variables type(MAPL_MetaComp), pointer :: MAPL=>null() @@ -877,11 +879,12 @@ subroutine Initialize(gc, import, export, clock, rc) integer :: model_dtstep integer :: land_nt_local,m,n, i1, in, j1, jn logical :: IAmRoot - logical :: COLDSTART integer :: ipert,n_lon,n_lat, n_lon_g, n_lat_g integer, allocatable :: pert_rseed(:) real :: dlon, dlat,locallat,locallon type(ESMF_Grid) :: Grid + character(len=ESMF_MAXSTR) :: id_string + integer :: ens_id_width ! Begin... ! Get component's name and setup traceback handle @@ -961,6 +964,9 @@ subroutine Initialize(gc, import, export, clock, rc) n_lon = internal%pgrid_l%n_lon n_lat = internal%pgrid_l%n_lat + call MAPL_GetResource( MAPL, ens_id_width,"ENS_ID_WIDTH:", default=4, RC=STATUS) + VERIFY_(status) + ! Pointers to mapl internals if ( internal%isCubedSphere ) then n_lon_g = internal%pgrid_g%n_lon @@ -969,9 +975,17 @@ subroutine Initialize(gc, import, export, clock, rc) allocate(internal%ppert_ntrmdt(n_lon_g, n_lat_g, N_PROGN_PERT_MAX), source=0.0) allocate(internal%pert_rseed_r8(NRANDSEED), source=0.0d0) - call MAPL_GetResource(MAPL, rst_fname, trim(comp_name)//'_INTERNAL_RESTART_FILE:',DEFAULT='NONE', rc=status) + call MAPL_GetResource(MAPL, rst_fname_tmp, 'LANDPERT_INTERNAL_RESTART_FILE:',DEFAULT='NONE', rc=status) VERIFY_(status) + id_string="" + if (internal%NUM_ENSEMBLE > 1) then + n = len(trim(COMP_NAME)) + id_string = COMP_NAME(n-ens_id_width+1:n) + endif + + call ESMF_CFIOStrTemplate(rst_fname, trim(adjustl(rst_fname_tmp)),'GRADS', xid = trim(id_string), stat=status) + if (index(rst_fname, 'NONE') == 0) then if ( IAmRoot) then @@ -1108,7 +1122,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! Coldstart if (COLDSTART) then - if (IAmRoot .and. internal%ens_id == FIRST_ENS_ID ) print *, trim(Iam)//'::WARNING: Cold-starting LandPert GridComp' + if (IAmRoot) print *, trim(Iam)//'::WARNING: Cold-starting '// trim(COMP_NAME) // ' GridComp' ! -pert_rseed- call get_init_pert_rseed(internal%ens_id, pert_rseed(1)) call init_randseed(pert_rseed) @@ -1184,11 +1198,13 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call esmf2ldas(StopTime, stop_time, rc=status) VERIFY_(status) + call esmf2ldas(CurrentTime, current_time, rc=status) + VERIFY_(status) if( internal%ens_id == FIRST_ENS_ID .and. IAmRoot) then ! write out the input file call read_ens_prop_inputs(write_nml = .true. , work_path = trim(out_path), & - exp_id = trim(exp_id), date_time = start_time) + exp_id = trim(exp_id), date_time = current_time) endif @@ -1378,12 +1394,16 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) allocate(ppert_grid(n_lon,n_lat, internal%PrognPert%npert), source=MAPL_UNDEF, stat=status) VERIFY_(status) - ! Get pertubations on the underlying grid and convert grid data to tile data, adjust mean + ! Get pertubations on the underlying grid and convert grid data to tile data ! ! -ForcePert- - - fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert)= fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert) + & - fpert_enavg(:,:,:) + ! + ! adjust mean after cold start (if fpert_ntrmdt is from restart file, + ! mean was adjusted in ApplyForcePert before restart was written) + if (COLDSTART) & + fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert) = & + fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert) + & + fpert_enavg(:,:,:) call get_pert( & internal%ForcePert%npert, & @@ -1391,7 +1411,7 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) real(internal%ForcePert%dtstep), & internal%ForcePert%param, & pert_rseed, & - fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert), & + fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert), & fpert_grid, & initialize_rseed=.false., & initialize_ntrmdt=.false., & @@ -1416,15 +1436,21 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) internal%ForcePert%DataNxt = internal%ForcePert%DataPrv ! -PrognPert- - ppert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%PrognPert%npert)= ppert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%PrognPert%npert) + & - ppert_enavg(:,:,:) + ! + ! adjust mean after cold start (if ppert_ntrmdt is from restart file, + ! mean was adjusted in ApplyPrognPert before restart was written) + if (COLDSTART) & + ppert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%PrognPert%npert) = & + ppert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%PrognPert%npert) + & + ppert_enavg(:,:,:) + call get_pert( & internal%PrognPert%npert, & internal%pgrid_l, internal%pgrid_f, & real(internal%PrognPert%dtstep), & internal%PrognPert%param, & pert_rseed, & - ppert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%PrognPert%npert), & + ppert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%PrognPert%npert), & ppert_grid, & initialize_rseed=.false., & initialize_ntrmdt=.false., & @@ -1493,8 +1519,8 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: chk_fname - character(len=4) :: id_string - character(len=14) :: datestamp + character(len=4) :: id_string ! BUG! should be "len=ens_id_width" (reichle, 11 Jun 2020) + character(len=14) :: datestamp ! ESMF variables type(ESMF_Alarm) :: ForcePertAlarm, PrognPertAlarm @@ -1634,22 +1660,22 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) VERIFY_(STATUS) enddo if (IamRoot) then - ! 3) tile2grid + ! 3) tile2grid. simple reverser of grid2tile without weighted do m = 1, nfpert - call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_f_all(:,m), internal%fpert_ntrmdt(:,:,m)) + call tile2grid_simple( N_tile, tile_coord_f, internal%pgrid_g, tile_data_f_all(:,m), internal%fpert_ntrmdt(:,:,m)) enddo do m = 1, nppert - call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_p_all(:,m), internal%ppert_ntrmdt(:,:,m)) + call tile2grid_simple( N_tile, tile_coord_f, internal%pgrid_g, tile_data_p_all(:,m), internal%ppert_ntrmdt(:,:,m)) enddo ! 4) writing call MAPL_DateStampGet(clock, datestamp, rc=status) VERIFY_(STATUS) - write(id_string,'(I4.4)') internal%ens_id + write(id_string,'(I4.4)') internal%ens_id ! BUG! format string should depend on ens_id_width (reichle, 11 Jun 2020) if(internal%NUM_ENSEMBLE ==1 ) id_string='' - chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint.'//datestamp + chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint.'//datestamp//'.nc4' call write_pert_checkpoint(trim(chk_fname),internal%fpert_ntrmdt, internal%ppert_ntrmdt, internal%pert_rseed_r8) endif @@ -2666,7 +2692,7 @@ subroutine Finalize(gc, import, export, clock, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: chk_fname - character(len=4) :: id_string + character(len=4) :: id_string ! BUG! should be "len=ens_id_width" (reichle, 11 Jun 2020) ! MAPL variables type(MAPL_MetaComp), pointer :: MAPL=>null() @@ -2749,17 +2775,19 @@ subroutine Finalize(gc, import, export, clock, rc) call ArrayGather(tile_data_p(:,m), tile_data_p_all(:,m), tilegrid, mask=mask, rc=status) VERIFY_(STATUS) enddo + if (MAPL_am_I_Root()) then - ! 3) tile2grid + ! 3) tile2grid + ! this step is simply a reverse of grid2tile without any weighted do m = 1, nfpert - call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_f_all(:,m), internal%fpert_ntrmdt(:,:,m)) + call tile2grid_simple( N_tile, tile_coord_f, internal%pgrid_g, tile_data_f_all(:,m), internal%fpert_ntrmdt(:,:,m)) enddo do m = 1, nppert - call tile2grid( N_tile, tile_coord_f, internal%pgrid_g, tile_data_p_all(:,m), internal%ppert_ntrmdt(:,:,m)) + call tile2grid_simple( N_tile, tile_coord_f, internal%pgrid_g, tile_data_p_all(:,m), internal%ppert_ntrmdt(:,:,m)) enddo ! 4) writing - write(id_string,'(I4.4)') internal%ens_id + write(id_string,'(I4.4)') internal%ens_id ! BUG! format string should depend on ens_id_width (reichle, 11 Jun 2020) if(internal%NUM_ENSEMBLE ==1 ) id_string='' chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint' @@ -2901,8 +2929,8 @@ subroutine write_pert_checkpoint(chk_fname, fpert,ppert, pert_rseed_r8) call check( nf90_def_var(ncid, 'ppert_ntrmdt', NF90_REAL, dimids, p_varid) ) call check( nf90_def_var(ncid, 'pert_rseed', NF90_DOUBLE, seed_dimid, s_varid) ) - call check( nf90_def_var_deflate(ncid, f_varid, 1, 1, 2)) - call check( nf90_def_var_deflate(ncid, p_varid, 1, 1, 2)) + ! call check( nf90_def_var_deflate(ncid, f_varid, 1, 1, 2)) + ! call check( nf90_def_var_deflate(ncid, p_varid, 1, 1, 2)) ! Assign attribute call check( nf90_put_att(ncid, f_varid, UNITS, units_) ) call check( nf90_put_att(ncid, p_varid, UNITS, units_) ) diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 index b82a3ccd..a5f601a3 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 @@ -53,6 +53,7 @@ module LDAS_TileCoordRoutines public :: get_tile_num_from_latlon public :: get_ij_ind_from_latlon public :: tile2grid + public :: tile2grid_simple public :: tile_mask_grid public :: grid2tile, grid2tile_real8 public :: is_cat_in_box @@ -2602,6 +2603,50 @@ subroutine tile2grid( N_tile, tile_coord, tile_grid, tile_data, & end subroutine tile2grid + subroutine tile2grid_simple( N_tile, tile_coord, tile_grid, tile_data, grid_data) + ! no interpolation or weighted. simply assign the tile value to grid + implicit none + + integer, intent(in) :: N_tile + + type(tile_coord_type), dimension(:), pointer :: tile_coord ! input + + type(grid_def_type), intent(in) :: tile_grid + + real, dimension(N_tile), intent(in) :: tile_data + + real, dimension(tile_grid%N_lon,tile_grid%N_lat), intent(out) :: grid_data + + ! local variables + + integer :: n, i, j, off_i, off_j + real, parameter :: no_data= -9999. + character(len=*), parameter :: Iam = 'tile2grid_simple' + character(len=400) :: err_msg + + ! ------------------------------------ + + if (size(tile_coord)/=N_tile) then + err_msg = 'tile_coord and tile_data do not match.' + call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) + end if + ! + ! adjust for 0-based indexing (eg., EASE grids) + ! + off_i = tile_grid%i_offg + (tile_grid%ind_base - 1) + off_j = tile_grid%j_offg + (tile_grid%ind_base - 1) + + ! loop through tile space + + grid_data = no_data + do n=1,N_tile + i = tile_coord(n)%i_indg - off_i + j = tile_coord(n)%j_indg - off_j + grid_data(i,j) = tile_data(n) + end do + + end subroutine tile2grid_simple + ! ******************************************************************* subroutine tile_mask_grid( tile_grid, N_tile, i_indgs,j_indgs, grid_data) From 639052ff6d36996f7c10aef67e1498b5a5cff994 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Thu, 11 Jun 2020 16:35:31 -0400 Subject: [PATCH 32/42] Merging Bridge into master (#246) (#247) From aa32b041b9c910704c24267cf6c97526c25ef612 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 11 Jun 2020 16:36:27 -0400 Subject: [PATCH 33/42] replacing Externals.cfg to match that of develop --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 05cfb3f8..f9970364 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.3 +branch = master protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.6 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse From 99259df758260a5f2938f7e445a77da451c45d8b Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 26 Jun 2020 09:19:09 -0400 Subject: [PATCH 34/42] syncing Develop into BRIDGE (#262) --- .gitignore | 1 + Externals.cfg | 2 +- components.yaml | 8 +- doc/CHANGELOG.md | 11 +- parallel_build.csh | 16 +- src/Applications/LDAS_App/ldas_setup | 11 +- .../LDAS_App/mk_GEOSldasRestarts.F90 | 48 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 8 +- .../GEOS_LandAssimGridComp.F90 | 18 +- .../clsm_bias_routines.F90 | 18 +- .../clsm_ensdrv_drv_routines.F90 | 3 +- .../clsm_ensdrv_out_routines.F90 | 14 +- .../clsm_ensupd_enkf_update.F90 | 86 +- .../clsm_ensupd_read_obs.F90 | 28 +- .../LDAS_PertRoutines.F90 | 92 +- .../GEOSlandpert_GridComp/land_pert.F90 | 6 +- .../GEOS_MetforceGridComp.F90 | 14 +- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 46 +- .../Shared/LDAS_RepairForcing.F90 | 44 +- .../Shared/LDAS_TileCoordRoutines.F90 | 2 +- .../Shared/LDAS_ensdrv_Globals.F90 | 12 +- .../Shared/LDAS_ensdrv_init_routines.F90 | 4 - .../Shared/LDAS_ensdrv_mpi.F90 | 2 +- .../Shared/LDAS_ensdrv_vegalb_routines.F90 | 1233 ----------------- 24 files changed, 248 insertions(+), 1479 deletions(-) delete mode 100644 src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 diff --git a/.gitignore b/.gitignore index f227fb53..5304b0f9 100644 --- a/.gitignore +++ b/.gitignore @@ -5,4 +5,5 @@ /BUILD/ /build*/ /install*/ +/.mepo/ parallel_build.o* diff --git a/Externals.cfg b/Externals.cfg index f9970364..59defd71 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = master +branch = main protocol = git sparse = ../../../config/GMAO_Shared.sparse diff --git a/components.yaml b/components.yaml index 5616a26f..52f1b0c3 100644 --- a/components.yaml +++ b/components.yaml @@ -2,11 +2,13 @@ env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git tag: v2.1.3+intel19.1.0 + develop: main cmake: local: ./@cmake remote: git@github.com:GEOS-ESM/ESMA_cmake.git tag: v3.0.1 + develop: develop ecbuild: local: ./@cmake/@ecbuild @@ -17,16 +19,18 @@ GMAO_Shared: local: ./src/Shared/@GMAO_Shared remote: git@github.com:GEOS-ESM/GMAO_Shared.git sparse: ./config/GMAO_Shared.sparse - branch: master + branch: main + develop: main MAPL: local: ./src/Shared/@MAPL remote: git@github.com:GEOS-ESM/MAPL.git tag: v2.1.3 + develop: develop GEOSgcm_GridComp: local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git sparse: ./config/GEOSgcm_GridComp_ldas.sparse branch: develop - + develop: develop diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index ae6bce64..39fb551a 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -33,11 +33,6 @@ This README file contains the history of stable GEOSldas versions ("tags") in Gi Overview of Git Releases: ============================ - - - - ------------------------------- [v17.9.0-beta.7](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.7) - 2020-06-11 ------------------------------ @@ -54,7 +49,7 @@ Overview of Git Releases: - Fixed handling of LANDPERT restart files after cold-start in first job segment. - - For lat/lon and EASE tile space only, fixed violation of zero-diff (binary identical) results when stopping/restarting at different intervals (removed extra zero-mean adjustment of LANDPERT after reading from restart file). Requires more work for cube-sphere tile space. + - Fixed violation of zero-diff (binary identical) results when stopping/restarting at different intervals (removed extra zero-mean adjustment of LANDPERT after reading from restart file and fixed tile2grid operation for cube-sphere tile space). - Fixed LANDPERT restart file name for cube-sphere. @@ -64,11 +59,11 @@ Overview of Git Releases: - Added “.nc4” file name extension for cube-sphere LANDPERT checkpoint file. - - Added log message for OBSPERTRSEED “cold” start. + - Added log messages for initialization of OBSPERTRSEED. - Fixed typo in default OBSPERTRSEED restart file name. - - Fixed time stamp of output *ensprop*inputs.nml file. + - Fixed time stamp of output *ensprop_inputs.nml file. - Fixed FIRST_ENS_ID for post-processing. diff --git a/parallel_build.csh b/parallel_build.csh index e2164658..75111799 100755 --- a/parallel_build.csh +++ b/parallel_build.csh @@ -21,9 +21,11 @@ setenv ESMADIR $srcdir set origargv = "$argv" setenv external "" +setenv USEMEPO FALSE while ($#argv) - if ("$1" == "-develop") then - setenv external "-e Develop.cfg" + + if ("$1" == "-mepo") then + setenv USEMEPO TRUE endif shift @@ -36,8 +38,14 @@ if (! -d ${ESMADIR}/@env) then echo " Please run from a head node" exit 1 else - echo " Running checkout_externals" - checkout_externals $external + if ( "$USEMEPO" == "TRUE") then + echo "Running mepo initialization" + mepo init + mepo clone + else + echo " Running checkout_externals" + checkout_externals $external + endif endif endif diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index a516ad70..ad68cd26 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -678,10 +678,9 @@ class LDASsetup: # link BC print "linking bcs..." bcnames=['green','lai','ndvi','nirdf','visdf'] - for ensid in self.ensids : - for bcln,bc in zip(bcnames,bcs) : - myBC=self.inpdir+'/'+bcln+ensid+'.data' - os.symlink(bc,myBC) + for bcln,bc in zip(bcnames,bcs) : + myBC=self.inpdir+'/'+bcln+'.data' + os.symlink(bc,myBC) # create and link restart print "Creating and lining restart..." @@ -1016,8 +1015,8 @@ class LDASsetup: bcval=['../input/green','../input/lai','../input/ndvi','../input/nirdf','../input/visdf'] bckey=['GREEN','LAI','NDVI','NIRDF','VISDF'] for key, val in zip(bckey,bcval): - keyn= key+'_FILE' - valn= val+tmpl_+'.data' + keyn = key+'_FILE' + valn = val+'.data' ldasrcInp[keyn]= valn # create restart item in RC diff --git a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 index 60de2cce..4b575de2 100644 --- a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 +++ b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 @@ -28,7 +28,7 @@ PROGRAM mk_GEOSldasRestarts ! initialize to non-MPI values integer :: myid=0, numprocs=1, mpierr - logical :: master_proc=.true. + logical :: root_proc=.true. ! Carbon model specifics ! ---------------------- @@ -268,7 +268,7 @@ PROGRAM mk_GEOSldasRestarts endif endif - if (master_proc) then + if (root_proc) then ! read in ntiles ! ---------------------------- @@ -289,7 +289,7 @@ PROGRAM mk_GEOSldasRestarts call MPI_Barrier(MPI_COMM_WORLD, STATUS) stop endif - if (master_proc) then + if (root_proc) then if(trim(MODEL) == 'CATCH' ) call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catch_internal_rst' ) if(trim(MODEL) == 'CATCHCN') call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catchcn_internal_rst') endif @@ -371,7 +371,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL read (10) NTILES_RST - if(master_proc) then + if(root_proc) then print *,'NTILES in BCs : ',NTILES print *,'NTILES in restarts : ',NTILES_RST endif @@ -403,7 +403,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL allocate (latc (1:ntiles_rst)) allocate (tid_offl (ntiles_rst)) - if (master_proc) then + if (root_proc) then allocate (long (ntiles)) allocate (latg (ntiles)) allocate (ld_reorder(ntiles_rst)) @@ -455,7 +455,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL endif end do - if(master_proc) deallocate (long) + if(root_proc) deallocate (long) call MPI_BCAST(lonc,ntiles_rst,MPI_REAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(latc,ntiles_rst,MPI_REAL,0,MPI_COMM_WORLD,mpierr) @@ -468,7 +468,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL ! id_glb for hydrologic variable call GetIds(lonc,latc,lonn,latt,id_loc, tid_offl) - if(master_proc) allocate (id_glb (ntiles)) + if(root_proc) allocate (id_glb (ntiles)) call MPI_Barrier(MPI_COMM_WORLD, STATUS) ! call MPI_GATHERV( & @@ -492,7 +492,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL deallocate (id_loc) - if(master_proc) then + if(root_proc) then inquire(file = trim(rst_file), exist=fexist) if (.not. fexist) then @@ -557,7 +557,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_sf1) STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_sf2) - if (master_proc) then + if (root_proc) then allocate (ityp_tmp (ntiles_rst,nveg)) allocate (fveg_tmp (ntiles_rst,nveg)) @@ -603,7 +603,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & fveg_offl, ityp_offl) - if(master_proc) allocate (id_glb_cn (ntiles,nveg)) + if(root_proc) allocate (id_glb_cn (ntiles,nveg)) allocate (id_loc (ntiles)) call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -632,11 +632,11 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL endif end do - if(master_proc) id_glb_cn (:,nv) = id_loc + if(root_proc) id_glb_cn (:,nv) = id_loc end do - if(master_proc) then + if(root_proc) then allocate (var_off_col (1: NTILES_RST, 1 : nzone,1 : var_col)) allocate (var_off_pft (1: NTILES_RST, 1 : nzone,1 : nveg, 1 : var_pft)) @@ -1121,7 +1121,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) allocate (lonc (1:ntiles_smap)) allocate (latc (1:ntiles_smap)) - if (master_proc) then + if (root_proc) then allocate (long (ntiles)) allocate (latg (ntiles)) @@ -1190,7 +1190,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) ! latt,nt_local(myid+1),MPI_real , & ! 0,MPI_COMM_WORLD, mpierr ) - if(master_proc) deallocate (long, latg) + if(root_proc) deallocate (long, latg) call MPI_BCAST(lonc,ntiles_smap,MPI_REAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(latc,ntiles_smap,MPI_REAL,0,MPI_COMM_WORLD,mpierr) @@ -1204,7 +1204,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) ! Loop through NTILES (# of tiles in output array) find the nearest neighbor from Qing. - if(master_proc) allocate (id_glb (ntiles)) + if(root_proc) allocate (id_glb (ntiles)) call MPI_Barrier(MPI_COMM_WORLD, STATUS) ! call MPI_GATHERV( & @@ -1226,7 +1226,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) endif end do - if (master_proc) call put_land_vars (NTILES, ntiles_smap, id_glb, ld_reorder, model) + if (root_proc) call put_land_vars (NTILES, ntiles_smap, id_glb, ld_reorder, model) call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -1771,7 +1771,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) allocate (lonc (1:ntiles_cn)) allocate (latc (1:ntiles_cn)) - if (master_proc) then + if (root_proc) then ! -------------------------------------------- ! Read exact lonn, latt from output .til file @@ -1828,7 +1828,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) end do - if(master_proc) deallocate (long, latg) + if(root_proc) deallocate (long, latg) call MPI_BCAST(lonc,ntiles_cn,MPI_REAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(latc,ntiles_cn,MPI_REAL,0,MPI_COMM_WORLD,mpierr) @@ -1856,7 +1856,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_sf1) STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_sf2) - if (master_proc) then + if (root_proc) then allocate (TILE_ID (1:ntiles_cn)) @@ -1907,7 +1907,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) ! update id_glb in root - if(master_proc) then + if(root_proc) then allocate (id_glb (ntiles, nveg)) allocate (id_vec (ntiles)) endif @@ -1934,11 +1934,11 @@ SUBROUTINE regrid_carbon_vars (NTILES) endif end do - if(master_proc) id_glb (:,nv) = id_vec + if(root_proc) id_glb (:,nv) = id_vec end do - if(master_proc) then + if(root_proc) then allocate (var_off_col (1: NTILES_CN, 1 : nzone,1 : var_col)) allocate (var_off_pft (1: NTILES_CN, 1 : nzone,1 : nveg, 1 : var_pft)) @@ -2961,12 +2961,12 @@ subroutine init_MPI() call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, mpierr ) - if (myid .ne. 0) master_proc = .false. + if (myid .ne. 0) root_proc = .false. ! call init_MPI_types() write (*,*) "MPI process ", myid, " of ", numprocs, " is alive" - write (*,*) "MPI process ", myid, ": master_proc=", master_proc + write (*,*) "MPI process ", myid, ": root_proc=", root_proc end subroutine init_MPI diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index b404e68f..b4ffaa3a 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -25,9 +25,9 @@ module GEOS_LdasGridCompMod use LDAS_DateTimeMod,ONLY: date_time_type use LDAS_ensdrv_mpi, only: MPI_tile_coord_type, MPI_grid_def_type use LDAS_ensdrv_mpi, only: init_MPI_types,mpicomm,numprocs,myid - use LDAS_ensdrv_mpi, only: master_proc + use LDAS_ensdrv_mpi, only: root_proc use LDAS_ensdrv_init_routines, only: io_domain_files - use LDAS_ensdrv_Globals, only: logunit,logit,master_logit,echo_clsm_ensdrv_glob_param + use LDAS_ensdrv_Globals, only: logunit,logit,root_logit,echo_clsm_ensdrv_glob_param use lsm_routines, only: lsmroutines_echo_constants use StieglitzSnow, only: StieglitzSnow_echo_constants use SurfParams, only: SurfParams_init @@ -403,7 +403,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call MPI_COMM_RANK(mpicomm, myid,mpierr) call MPI_COMM_SIZE(mpicomm, numprocs, mpierr ) - master_proc = IAmRoot + root_proc = IAmRoot ! Turn timers on call MAPL_TimerOn(MAPL, "TOTAL") call MAPL_TimerOn(MAPL, "Initialize") @@ -417,7 +417,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) logit = (trim(LDAS_logit) /= 'NO') - master_logit = (IamRoot .and. logit) + root_logit = (IamRoot .and. logit) ! Init catchment constants, currently different in GCM and GEOSldas call MAPL_GetResource(MAPL, LAND_PARAMS,Label="LAND_PARAMS:",DEFAULT="Icarus",RC=STATUS) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 15ac2fb2..baec2c6e 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -27,7 +27,7 @@ module GEOS_LandAssimGridCompMod use nr_ran2_gasdev, only: NRANDSEED, init_randseed use land_pert_routines, only: get_init_pert_rseed use LDAS_ensdrv_mpi, only: mpicomm,numprocs,myid - use LDAS_ensdrv_mpi, only: master_proc + use LDAS_ensdrv_mpi, only: root_proc use LDAS_ensdrv_mpi, only: MPI_obs_param_type use LDAS_DateTimeMod, only: date_time_type @@ -1059,7 +1059,7 @@ subroutine Initialize(gc, import, export, clock, rc) _VERIFY(STATUS) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) _VERIFY(STATUS) - call init_log( myid, numprocs, master_proc ) + call init_log( myid, numprocs, root_proc ) ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) _VERIFY(status) @@ -1129,7 +1129,7 @@ subroutine Initialize(gc, import, export, clock, rc) allocate(Pert_rseed( NRANDSEED, NUM_ENSEMBLE), source = 0 ) allocate(Pert_rseed_r8(NRANDSEED, NUM_ENSEMBLE), source = 0.0d0) - if (master_proc) then + if (root_proc) then call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_RESTART_FILE:", DEFAULT="../input/restart/landassim_obspertrseed%s_rst", RC=STATUS) _VERIFY(STATUS) @@ -1198,7 +1198,7 @@ subroutine Initialize(gc, import, export, clock, rc) rf2l( l2rf(i) ) = i end do - if (master_proc) then + if (root_proc) then call read_ens_upd_inputs( & trim(out_path), & trim(exp_id), & @@ -1245,11 +1245,11 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr) - if (.not. master_proc) allocate(obs_param(N_obs_param)) + if (.not. root_proc) allocate(obs_param(N_obs_param)) call MPI_BCAST(obs_param, N_obs_param, MPI_OBS_PARAM_TYPE, 0,MPICOMM,mpierr) - if (master_proc) call echo_clsm_ensupd_glob_param(logunit) + if (root_proc) call echo_clsm_ensupd_glob_param(logunit) call MAPL_GenericInitialize(gc, import, export, clock, rc=status) _VERIFY(status) @@ -1465,7 +1465,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) if (mwRTM) & call GEOS_output_smapL4SMlmc( GC, start_time, trim(out_path), trim(exp_id), & N_catl, tile_coord_l, cat_param, mwRTM_param ) - if (master_proc) then + if (root_proc) then ! for out put call read_cat_bias_inputs( trim(out_path), trim(exp_id), start_time, update_type, & cat_bias_param, N_catbias) @@ -1474,7 +1474,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! The time is one model time step behind Current time, so record the checkpoint here if (MAPL_RecordAlarmIsRinging(MAPL)) then - if (master_proc) then + if (root_proc) then Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) _VERIFY(STATUS) @@ -2503,7 +2503,7 @@ subroutine Finalize(gc, import, export, clock, rc) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) _VERIFY(STATUS) - if (master_proc) then + if (root_proc) then if (out_obslog) call finalize_obslog() Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 index 11c775d2..58fd93da 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 @@ -11,12 +11,12 @@ module clsm_bias_routines N_snow => CATCH_N_SNOW, & N_gt => CATCH_N_GT - use LDAS_ensdrv_globals, ONLY: & + use LDAS_ensdrv_globals, ONLY: & nodata_generic, & logit, & logunit - use LDAS_DateTimeMod, ONLY: & + use LDAS_DateTimeMod, ONLY: & date_time_type use catch_types, ONLY: & @@ -32,9 +32,9 @@ module clsm_bias_routines obs_bias_type use LDAS_ensdrv_mpi, ONLY: & - master_proc, & + root_proc, & MPI_obs_bias_type, & - mpicomm, & + mpicomm, & MPIERR use LDAS_ensdrv_functions, ONLY: & @@ -43,7 +43,7 @@ module clsm_bias_routines use clsm_ensupd_upd_routines, ONLY: & get_cat_progn_ens_avg - use LDAS_exceptionsMod, ONLY: & + use LDAS_exceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -1069,7 +1069,7 @@ subroutine initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, work_path, & ! ------------------------------------------------------------------ - if (master_proc) then + if (root_proc) then allocate(obs_bias_f(N_catf,N_obs_param,N_obsbias_max)) @@ -1098,7 +1098,7 @@ subroutine initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, work_path, & #endif - if (master_proc) deallocate(obs_bias_f) + if (root_proc) deallocate(obs_bias_f) end subroutine initialize_obs_bias @@ -1313,7 +1313,7 @@ subroutine output_obs_bias(N_obs_param, N_obsbias_max, N_catl, N_catf, & integer :: i,j - if (master_proc) allocate(obs_bias_f(N_catf,N_obs_param, N_obsbias_max)) + if (root_proc) allocate(obs_bias_f(N_catf,N_obs_param, N_obsbias_max)) #ifdef LDAS_MPI @@ -1336,7 +1336,7 @@ subroutine output_obs_bias(N_obs_param, N_obsbias_max, N_catl, N_catf, & #endif - if (master_proc) then + if (root_proc) then call io_rstrt_obs_bias( & 'w', work_path, exp_id, date_time, N_catf, & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 index 6402ca72..b1ec9d14 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 @@ -34,8 +34,7 @@ module clsm_ensdrv_drv_routines use LDAS_ensdrv_mpi, ONLY: & mpicomm, & mpierr, & - numprocs, & - master_proc + numprocs use catchment_model, ONLY: & catch_calc_tsurf diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 index a719b7d7..aae2f856 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 @@ -9,7 +9,7 @@ module clsm_ensdrv_out_routines ! reichle, 22 Aug 2014 use LDAS_ensdrv_globals, ONLY: & - log_master_only, & + log_root_only, & logunit, & logit @@ -26,7 +26,7 @@ module clsm_ensdrv_out_routines mwRTM_param_type use LDAS_ensdrv_mpi, ONLY: & - master_proc, & + root_proc, & numprocs use LDAS_DateTimeMod, ONLY: & @@ -52,7 +52,7 @@ module clsm_ensdrv_out_routines ! ******************************************************************** - subroutine init_log( myid, numprocs, master_proc ) + subroutine init_log( myid, numprocs, root_proc ) ! open file for output log, write a few things @@ -63,7 +63,7 @@ subroutine init_log( myid, numprocs, master_proc ) implicit none integer, intent(in) :: myid, numprocs - logical, intent(in) :: master_proc + logical, intent(in) :: root_proc ! ------------------------------------------------------------------------ ! @@ -89,7 +89,7 @@ subroutine init_log( myid, numprocs, master_proc ) ! interpret parameters from clsm_ensdrv_glob_param - if (log_master_only .and. (.not. master_proc)) then + if (log_root_only .and. (.not. root_proc)) then logit = .false. @@ -101,7 +101,7 @@ subroutine init_log( myid, numprocs, master_proc ) ! stop if logunit is stdout and output is requested for *all* processors - if ( (.not. log_master_only) .and. (logunit==output_unit) ) then + if ( (.not. log_root_only) .and. (logunit==output_unit) ) then err_msg = 'logunit=output_unit (stdout) together with logging *all* procs is disabled' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) @@ -141,7 +141,7 @@ subroutine init_log( myid, numprocs, master_proc ) write (logunit,*) "process ", myid, " of ", numprocs, " is alive" write (logunit,*) - write (logunit,*) "process ", myid, ": master_proc=", master_proc + write (logunit,*) "process ", myid, ": root_proc=", root_proc write (logunit,*) end if ! if (logit) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 7bb3ab1d..e2edfbe8 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -114,7 +114,7 @@ module clsm_ensupd_enkf_update use LDAS_ensdrv_mpi, ONLY: & MPI_cat_param_type, & MPI_cat_progn_type, & - master_proc, & + root_proc, & numprocs, & myid, & mpierr, & @@ -400,9 +400,9 @@ subroutine get_enkf_increments( & ! ! Get additional grid/tile information that is needed to map obs ! from lat/lon to tiles. This needs to be done: - ! - by master process (because of call to read_obs() in collect_obs()) + ! - by root process (because of call to read_obs() in collect_obs()) ! - by all processes if FOV>~0 ("tile_num_in_circle" needed in get_obs_pred()) - if ( (master_proc) .or. & + if ( (root_proc) .or. & (any(obs_param(1:N_obs_param)%FOV>FOV_threshold)) ) then allocate(N_tile_in_cell_ij_f(tile_grid_f%N_lon,tile_grid_f%N_lat)) @@ -695,7 +695,7 @@ subroutine get_enkf_increments( & end do call MPI_Gather(nTiles_l,1,MPI_INTEGER, & nTilesl_vec,1,MPI_INTEGER,0,mpicomm,mpierr) - if (master_proc) nTiles_f = sum(nTilesl_vec) + if (root_proc) nTiles_f = sum(nTilesl_vec) call MPI_Bcast(nTiles_f,1,MPI_INTEGER,0,mpicomm,mpierr) if (logit) then write (tmpstr12,'(i12)') nTiles_f ! convert integer to string @@ -704,8 +704,8 @@ subroutine get_enkf_increments( & end if ! Step 2b: indTiles_l -> indTiles_f (on root) - if (master_proc) allocate(indTiles_f(nTiles_f), source=-99) - if (master_proc) then + if (root_proc) allocate(indTiles_f(nTiles_f), source=-99) + if (root_proc) then tmp_low_ind(1) = 1 do iproc=1,numprocs-1 tmp_low_ind(iproc+1) = tmp_low_ind(iproc) + nTilesl_vec(iproc) @@ -741,12 +741,12 @@ subroutine get_enkf_increments( & ! Step 2d: indTiles_ana -> indTilesAna_vec (on root) ! root needs indTiles_ana from each proc to distribute cat_param, cat_progn etc. - if (master_proc) then + if (root_proc) then do iproc=1,numprocs allocate(indTilesAna_vec(iproc)%ind(nTilesAna_vec(iproc))) end do end if - if (master_proc) then + if (root_proc) then indTilesAna_vec(1)%ind = indTiles_ana ! copy contribution from root do src=1,numprocs-1 recvct = nTilesAna_vec(src+1) @@ -764,8 +764,8 @@ subroutine get_enkf_increments( & ! Step 2: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 2 time taken (create indTiles_ana): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 2 time taken (create indTiles_ana): ', & ' max =', tmax, ', min =', tmin ! Step 3a: for each proc create nObs_ana, indObs_ana and Obs_ana @@ -794,18 +794,18 @@ subroutine get_enkf_increments( & ! Step 3b: nObs_ana -> nObsAna_vec (on root) call MPI_Gather(nObs_ana,1,MPI_INTEGER, & nObsAna_vec,1,MPI_INTEGER,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,I7,A,I7)') & + if (root_proc .and. logit) write (logunit,'(2A,I7,A,I7)') & 'AnaLoadBal: nObs_ana statistics: ', & 'max =', maxval(nObsAna_vec), ', min =', minval(nObsAna_vec) ! Step 3c: indObs_ana -> indObsAna_vec (on root) ! root needs indObs_ana from each proc (to distribute Obs_pred_l) - if (master_proc) then + if (root_proc) then do iproc=1,numprocs allocate(indObsAna_vec(iproc)%ind(nObsAna_vec(iproc))) end do end if - if (master_proc) then + if (root_proc) then indObsAna_vec(1)%ind = indObs_ana(1:nObs_ana) ! copy contribution from root do src=1,numprocs-1 recvct = nObsAna_vec(src+1) @@ -824,8 +824,8 @@ subroutine get_enkf_increments( & ! Step 3: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 3 time taken (create indObs_ana): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 3 time taken (create indObs_ana): ', & ' max =', tmax, ', min =', tmin !-AnaLodaBal-decomposition-ends-here @@ -841,13 +841,13 @@ subroutine get_enkf_increments( & tile_coord_ana = tile_coord_f(indTiles_ana) ! Step 4c: cat_param(N_catl) -> cat_param_f (on root) -> cat_param_ana - if (master_proc) allocate(cat_param_f(N_catf)) + if (root_proc) allocate(cat_param_f(N_catf)) call MPI_Gatherv( & cat_param, N_catl, MPI_cat_param_type, & cat_param_f, N_catl_vec, low_ind-1, MPI_cat_param_type, & 0, mpicomm, mpierr ) allocate(cat_param_ana(nTiles_ana)) - if (master_proc) then + if (root_proc) then cat_param_ana = cat_param_f(indTilesAna_vec(1)%ind) do dest=1,numprocs-1 sendtag = dest @@ -867,7 +867,7 @@ subroutine get_enkf_increments( & ! Step 4d: cat_progn -> cat_progn_f (on root) -> cat_progn_ana ! one ensemble at a time - if (master_proc) allocate(cat_progn_f(N_catf)) + if (root_proc) allocate(cat_progn_f(N_catf)) allocate(cat_progn_ana(nTiles_ana,N_ens)) allocate(tmp_cat_progn_ana(nTiles_ana)) ! CSD-BUGFIX @@ -877,7 +877,7 @@ subroutine get_enkf_increments( & cat_progn(:,iEns), N_catl, MPI_cat_progn_type, & cat_progn_f, N_catl_vec, low_ind-1, MPI_cat_progn_type, & 0, mpicomm, mpierr ) - if (master_proc) then + if (root_proc) then cat_progn_ana(:,iEns) = cat_progn_f(indTilesAna_vec(1)%ind) do dest=1, numprocs-1 sendtag = dest @@ -914,9 +914,9 @@ subroutine get_enkf_increments( & ! Step 4e: Obs_pred_l (obs%assim=.true.) -> Obs_pred_f_assim (on root) -> Obs_pred_ana ! one ensemble at a time - if (master_proc) allocate(Obs_pred_f_assim(N_obsf_assim)) + if (root_proc) allocate(Obs_pred_f_assim(N_obsf_assim)) allocate(Obs_pred_ana(nObs_ana,N_ens), source=0.) - if (master_proc) then + if (root_proc) then tmp_low_ind(1) = 1 do iproc=1,numprocs-1 tmp_low_ind(iproc+1) = tmp_low_ind(iproc) + N_obsl_assim_vec(iproc) @@ -929,7 +929,7 @@ subroutine get_enkf_increments( & Obs_pred_f_assim, N_obsl_assim_vec, tmp_low_ind-1, MPI_REAL, & 0, mpicomm, mpierr ) ! Obs_pred_f_assim (on root) -> Obs_pred_ana - if (master_proc) then + if (root_proc) then ! copy Obs_pred_ana for root Obs_pred_ana(:,iEns) = Obs_pred_f_assim(indObsAna_vec(1)%ind) ! communicate @@ -956,8 +956,8 @@ subroutine get_enkf_increments( & ! Step 4: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 4 time taken (distribute inputs): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 4 time taken (distribute inputs): ', & ' max =', tmax, ', min =', tmin !-AnaLoadBal-Input-Distribution-ends-here @@ -1046,8 +1046,8 @@ subroutine get_enkf_increments( & ! cat_enkf_incr timinig info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'Time taken by cat_enkf_increments: ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'Time taken by cat_enkf_increments: ', & ' max =', tmax, ', min =', tmin #else ! NOTE: make sure to pass into cat_enkf_increments() only the @@ -1073,13 +1073,13 @@ subroutine get_enkf_increments( & ! cat_progn_incr_ana -> cat_progn_incr_f -> cat_progn_incr ! WE PROBABLY SHOULD DO AWAY WITH recvBuf call cpu_time(t_start) - if (master_proc) then + if (root_proc) then allocate(cat_progn_incr_f(N_catf)) allocate(recvBuf(maxval(nTilesAna_vec))) ! temp storage of incoming data end if do iEns=1,N_ens ! cat_progn_incr_ana -> cat_progn_incr_f - if (master_proc) then + if (root_proc) then do iTile=1,N_catf ! cannot do cat_progn_incr_f = 0. cat_progn_incr_f(iTile) = 0. ! initialize end do @@ -1114,8 +1114,8 @@ subroutine get_enkf_increments( & ! Step 5: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 5 time taken (collect increments): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 5 time taken (collect increments): ', & ' max =', tmax, ', min =', tmin !-AnaLoadBal-Output-Collection-ends-here- #endif @@ -1448,7 +1448,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & #endif - if (master_proc) then + if (root_proc) then N_obsf = sum(N_obsl_vec) @@ -1481,7 +1481,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & ! ! write to file - if (master_proc) then + if (root_proc) then #ifdef LDAS_MPI @@ -1739,7 +1739,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & !! file_tag = 'ldas_incr' !! dir_name = 'ana' !! -!! if (master_proc) allocate(cat_progn_incr_f(N_catf)) +!! if (root_proc) allocate(cat_progn_incr_f(N_catf)) !! !!#ifdef LDAS_MPI !! @@ -1751,7 +1751,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & !!#else !! cat_progn_incr_f = cat_progn_incr_ensavg !!#endif -!! if (master_proc) then +!! if (root_proc) then !! !! !! select case (out_incr_format) @@ -1805,7 +1805,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & !! !! deallocate(cat_progn_incr_f) !! -!! end if ! masterproc +!! end if ! root_proc !! !! end if ! out_incr @@ -1853,7 +1853,7 @@ subroutine output_smapL4SMaup( date_time, work_path, exp_id, dtstep_assim, & integer, dimension(N_catl), intent(in) :: l2f ! N_tile_in_cell_ij and tile_num_in_cell_ij are on the "full" domain - ! and guaranteed to be allocated ONLY for the master_proc + ! and guaranteed to be allocated ONLY for the root_proc ! (but may be allocated on all processors depending on obs_param%FOV) integer, dimension(:,:), pointer :: N_tile_in_cell_ij_f ! input @@ -2098,7 +2098,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & ! ! assemble file name and open file - if (master_proc) then + if (root_proc) then fname = get_io_filename( './', exp_id, file_tag, & date_time=date_time, dir_name=dir_name, ens_id=-1, no_subdirs=.true.) @@ -2143,7 +2143,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & #endif - if (master_proc) then + if (root_proc) then N_obsf = sum(N_obsl_vec) @@ -2174,7 +2174,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & ! ----------------------------------------------------- - if (master_proc) then + if (root_proc) then ! determine mapping from Observations vector onto global 9 km EASE grid @@ -2804,7 +2804,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & deallocate(data_h_9km_tile) deallocate(data_v_9km_tile) - end if ! master_proc + end if ! root_proc end if ! (option=='orig_obs' .or. option=='obs_fcst') @@ -2889,7 +2889,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, & tile_mean_l(:,k), tile_data_f) - if (master_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) + if (root_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) end do @@ -2910,7 +2910,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, & tile_std_l(:,k), tile_data_f) - if (master_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) + if (root_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) end do @@ -2924,7 +2924,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & ! ! close output file - if (master_proc) close(unitnum,status='keep') + if (root_proc) close(unitnum,status='keep') end subroutine write_smapL4SMaup diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 index d25edb88..3e759c5c 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 @@ -21,11 +21,11 @@ module clsm_ensupd_read_obs use io_hdf5, ONLY: & hdf5read - use LDAS_ease_conv, ONLY: & + use LDAS_ease_conv, ONLY: & easeV2_convert, & easeV2_extent - use LDAS_ensdrv_globals, ONLY: & + use LDAS_ensdrv_globals, ONLY: & logit, & logunit, & nodata_tolfrac_generic @@ -33,7 +33,7 @@ module clsm_ensupd_read_obs use clsm_ensupd_glob_param, ONLY: & unitnum_obslog - use LDAS_DateTimeMod, ONLY: & + use LDAS_DateTimeMod, ONLY: & date_time_type, & augment_date_time, & get_dofyr_pentad, & @@ -46,7 +46,7 @@ module clsm_ensupd_read_obs obs_type, & obs_param_type - use LDAS_TilecoordType, ONLY: & + use LDAS_TilecoordType, ONLY: & tile_coord_type, & grid_def_type @@ -55,17 +55,17 @@ module clsm_ensupd_read_obs f2l_real8, & f2l_logical - use LDAS_TilecoordRoutines, ONLY: & + use LDAS_TilecoordRoutines, ONLY: & get_tile_num_from_latlon use LDAS_ensdrv_mpi, ONLY: & - master_proc, & + root_proc, & numprocs, & - mpicomm, & + mpicomm, & MPI_obs_type, & mpierr - use LDAS_exceptionsMod, ONLY: & + use LDAS_exceptionsMod, ONLY: & ldas_abort, & ldas_warn, & LDAS_GENERIC_ERROR, & @@ -6454,7 +6454,7 @@ subroutine turn_off_assim_SMAP_L1CTb(N_obs_param, obs_param, N_obsl, Observation #endif - if (master_proc) then + if (root_proc) then N_obsf = sum(N_obsl_vec) @@ -6499,7 +6499,7 @@ subroutine turn_off_assim_SMAP_L1CTb(N_obs_param, obs_param, N_obsl, Observation mask_v_A = .false. ! initialize mask_v_D = .false. ! initialize - if (master_proc) then + if (root_proc) then ! mask for H-pol ascending @@ -6591,7 +6591,7 @@ subroutine turn_off_assim_SMAP_L1CTb(N_obs_param, obs_param, N_obsl, Observation deallocate(Observations_f) - end if ! (master_proc) + end if ! (root_proc) ! MPI broadcast masks @@ -6904,7 +6904,7 @@ subroutine read_obs( & ! read observations and optionally scale observations to model clim ! - ! intended to be called by master_proc + ! intended to be called by root_proc ! 10 Jun 2011 - removed model-based QC for MPI re-structuring (now done ! in connection with get_obs_pred()) @@ -8115,7 +8115,7 @@ subroutine collect_obs( type(grid_def_type), intent(in) :: tile_grid_f ! N_tile_in_cell_ij and tile_num_in_cell_ij are on the "full" domain - ! and guaranteed to be allocated ONLY for the master_proc + ! and guaranteed to be allocated ONLY for the root_proc ! (but may be allocated on all processors depending on obs_param%FOV) integer, dimension(:,:), pointer :: N_tile_in_cell_ij_f ! input @@ -8187,7 +8187,7 @@ subroutine collect_obs( call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'something wrong') end if - if (master_proc) then + if (root_proc) then ! subroutine read_obs() reads all observations in obs files ! (typically global) and returns a vector in (full domain) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 index 02f3d548..0658ad67 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 @@ -18,9 +18,9 @@ module LDAS_PertRoutinesMod use ESMF use MAPL_Mod - use LDAS_ensdrv_Globals, ONLY: & + use LDAS_ensdrv_Globals, ONLY: & logunit, & - master_logit, & + root_logit, & nodata_generic, & nodata_tolfrac_generic, & nodata_tol_generic @@ -35,7 +35,7 @@ module LDAS_PertRoutinesMod grid_def_type, & io_grid_def_type - use LDAS_TileCoordRoutines, ONLY: & + use LDAS_TileCoordRoutines, ONLY: & LDAS_create_grid_g, & get_ij_ind_from_latlon @@ -294,7 +294,7 @@ subroutine read_ens_prop_inputs( & ! MPI variables type(ESMF_VM) :: vm integer :: mpicomm - logical :: master_proc,f_exist + logical :: root_proc,f_exist ! ----------------------------------------------------------------- @@ -333,7 +333,7 @@ subroutine read_ens_prop_inputs( & VERIFY_(status) call ESMF_VmGet(vm, mpicommunicator=mpicomm, rc=status) VERIFY_(status) - master_proc = MAPL_Am_I_Root(vm) + root_proc = MAPL_Am_I_Root(vm) ! --------------------------------------------------------------------- ! @@ -359,7 +359,7 @@ subroutine read_ens_prop_inputs( & if (present(kw_echo)) then if (kw_echo) then - if(master_logit) then + if(root_logit) then write (logunit,*) write (logunit,'(400A)') 'reading *default* ens prop inputs from ' // trim(fname) write (logunit,*) @@ -380,7 +380,7 @@ subroutine read_ens_prop_inputs( & if (present(kw_echo)) then if (kw_echo) then - if(master_logit) then + if(root_logit) then write (logunit,*) write (logunit,'(400A)') 'reading *SPECIAL* ens prop inputs from ' // trim(fname) write (logunit,*) @@ -401,7 +401,7 @@ subroutine read_ens_prop_inputs( & ! echo variables of ens_prop_inputs - if (present(kw_echo) .and. master_logit) then + if (present(kw_echo) .and. root_logit) then if (kw_echo) then write (logunit,*) 'ens_prop inputs are:' @@ -424,7 +424,7 @@ subroutine read_ens_prop_inputs( & do i=1,N_ens kw_ens_id(i) = first_ens_id + i - 1 end do - if(master_logit) then + if(root_logit) then write (logunit,*) write (logunit,*) 'ens_id = ', (kw_ens_id(i), i=1,N_ens) write (logunit,*) @@ -511,8 +511,8 @@ subroutine read_ens_prop_inputs( & fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & dir_name=dir_name, file_ext=file_ext ) - if(master_logit) write (logunit,'(400A)') 'writing ens prop inputs to ' // trim(fname) - if(master_logit) write (logunit,*) + if(root_logit) write (logunit,'(400A)') 'writing ens prop inputs to ' // trim(fname) + if(root_logit) write (logunit,*) open(10, file=fname, status='unknown', action='write', & delim='apostrophe') @@ -996,7 +996,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! MPI variables type(ESMF_VM) :: vm integer :: mpicomm, numprocs, myid, mpierr - logical :: master_proc + logical :: root_proc ! ----------------------------------------------------------------- @@ -1004,13 +1004,13 @@ subroutine get_force_pert_inputs( pert_grid_l, & VERIFY_(status) call ESMF_VMGet(VM, petCount=numprocs, localPet=myid, mpiCommunicator=mpicomm, rc=status) VERIFY_(status) - master_proc = MAPL_Am_I_Root(vm) + root_proc = MAPL_Am_I_Root(vm) ! --------- ! ! DESCR - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_descr_force_pert=tmp_force_pert_character) @@ -1029,7 +1029,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ! ZEROMEAN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_zeromean_force_pert=tmp_force_pert_logical) @@ -1045,7 +1045,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ! COARSEN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_coarsen_force_pert=tmp_force_pert_logical) @@ -1063,7 +1063,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! obtain (default) homogeneous std of forcing perturbations - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_force_pert=tmp_force_pert_real) @@ -1086,7 +1086,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! find out whether std_force_pert should be read from file - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_stdfromfile_force_pert=tmp_force_pert_logical) @@ -1104,7 +1104,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! find out name (incl full path) of file with std value - if (master_proc) & + if (root_proc) & call read_ens_prop_inputs( & kw_stdfilename_force_pert = stdfilename_force_pert & ) @@ -1177,7 +1177,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! PC: instead of reading one param (and broadcasting it) at a time, it ! will be better to read them all and broadcast at one go - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_normal_max_force_pert=tmp_force_pert_real) @@ -1192,7 +1192,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_xcorr_force_pert=tmp_force_pert_real) @@ -1206,7 +1206,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ycorr_force_pert=tmp_force_pert_real) @@ -1220,7 +1220,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_tcorr_force_pert=tmp_force_pert_real) @@ -1234,7 +1234,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_typ_force_pert=tmp_force_pert_real) @@ -1253,7 +1253,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! (see subroutine read_ens_prop_inputs) ! now fill in the rest of the information (diagonal=1 and symmetry) - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ccorr_force_pert=tmp_force_pert_ccorr) @@ -1387,7 +1387,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! MPI variables type(ESMF_VM) :: vm integer :: mpicomm, numprocs, myid, mpierr - logical :: master_proc + logical :: root_proc ! ----------------------------------------------------------------- @@ -1395,13 +1395,13 @@ subroutine get_progn_pert_inputs( pert_grid_l, & VERIFY_(status) call ESMF_VMGet(VM, petCount=numprocs, localPet=myid, mpiCommunicator=mpicomm, rc=status) VERIFY_(status) - master_proc = MAPL_Am_I_Root(vm) + root_proc = MAPL_Am_I_Root(vm) ! ------- ! ! DESCR - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_descr_progn_pert=tmp_progn_pert_character) @@ -1420,7 +1420,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ! ZEROMEAN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_zeromean_progn_pert=tmp_progn_pert_logical) @@ -1436,7 +1436,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ! COARSEN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_coarsen_progn_pert=tmp_progn_pert_logical) @@ -1454,7 +1454,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ! obtain (default) homogeneous std of forcing perturbations - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_progn_pert=tmp_progn_pert_real) @@ -1477,7 +1477,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! find out whether std_progn_pert should be read from file - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_stdfromfile_progn_pert=tmp_progn_pert_logical) @@ -1496,7 +1496,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! find out name (incl full path) of file with std value - if (master_proc) & + if (root_proc) & call read_ens_prop_inputs( & kw_stdfilename_progn_pert = stdfilename_progn_pert & ) @@ -1566,7 +1566,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! homogeneous (ie same for all catchments, unlike std_progn_pert) ! typ_progn_pert must also be homogeneous - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_normal_max_progn_pert=tmp_progn_pert_real) @@ -1581,7 +1581,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_xcorr_progn_pert=tmp_progn_pert_real) @@ -1595,7 +1595,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ycorr_progn_pert=tmp_progn_pert_real) @@ -1609,7 +1609,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_tcorr_progn_pert=tmp_progn_pert_real) @@ -1623,7 +1623,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_typ_progn_pert=tmp_progn_pert_real) @@ -1642,7 +1642,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! (see subroutine read_ens_prop_inputs) ! now fill in the rest of the information (diagonal=1 and symmetry) - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ccorr_progn_pert=tmp_progn_pert_ccorr) @@ -1985,7 +1985,7 @@ subroutine echo_pert_param( N_pert, pert_param, ind_i, ind_j ) ! ------------------------------------------------------------- - if (master_logit) then + if (root_logit) then write (logunit,*) 'echo_pert_param():' do m=1,N_pert @@ -2013,7 +2013,7 @@ subroutine echo_pert_param( N_pert, pert_param, ind_i, ind_j ) end do end do - endif ! master_logit + endif ! root_logit end subroutine echo_pert_param !************************************************************* @@ -2088,7 +2088,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & file_tag, date_time=date_time, & dir_name=dir_name, ens_id=ens_id, file_ext=file_ext ) -!!$ if (master_proc) then +!!$ if (root_proc) then inquire(file=filename,exist=file_exists) if(.not. file_exists) then write (6,'(400A)') & @@ -2106,7 +2106,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & !!$ call MPI_Bcast(istat, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, mpierr) !!$#endif -!!$ if (master_proc) then +!!$ if (root_proc) then write (6,'(400A)') & 'Reading pert restart file ' // trim(filename) @@ -2171,7 +2171,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & do k=1,N_force_pert -!!$ if (master_proc) then +!!$ if (root_proc) then read (10) ((Pert_ntrmdt_f(i,j), i=1,pert_grid_f%N_lon), & j=1,pert_grid_f%N_lat) @@ -2187,7 +2187,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & do k=1,N_progn_pert -!!$ if (master_proc) then +!!$ if (root_proc) then read (10) ((Pert_ntrmdt_f(i,j), i=1,pert_grid_f%N_lon), & j=1,pert_grid_f%N_lat) Progn_pert_ntrmdt_g(xstart:xend, ystart:yend,k) = Pert_ntrmdt_f(:,:) @@ -2214,7 +2214,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & end select -!! if (master_proc) close (10,status='keep') +!! if (root_proc) close (10,status='keep') close (10,status='keep') end subroutine io_pert_rstrt diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 index 6082d52d..9e911413 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 @@ -46,7 +46,7 @@ module land_pert_routines use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR - use LDAS_ensdrv_Globals, only: master_logit,logunit + use LDAS_ensdrv_Globals, only: root_logit,logunit implicit none @@ -1551,7 +1551,7 @@ subroutine assemble_forcepert_param( N_x, N_y, & ! echo part of forcepert_param (mean, std, and ccorr for i=1, j=1 only): - if(master_logit) then + if(root_logit) then do i=1,N_forcepert write (logunit,*) 'forcepert_param(',i,')%descr=', & @@ -1582,7 +1582,7 @@ subroutine assemble_forcepert_param( N_x, N_y, & forcepert_param(i)%ccorr(j,1,1) end do end do - endif ! master_logit + endif ! root_logit diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index f91a66cf..631a9767 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -10,7 +10,7 @@ module GEOS_MetforceGridCompMod use MAPL_Mod use LDAS_ensdrv_Globals, only: nodata_generic, nodata_tol_generic - use LDAS_ensdrv_Globals, only: logunit,master_logit,logit + use LDAS_ensdrv_Globals, only: logunit,logit !,root_logit use LDAS_DateTimeMod, only: date_time_type, date_time_print use LDAS_TileCoordType, only: tile_coord_type use LDAS_TileCoordType, only: T_TILECOORD_STATE @@ -936,7 +936,7 @@ subroutine Run(gc, import, export, clock, rc) call LDAS_move_new_force_to_old(internal%mf%DataNxt,internal%mf%DataPrv, & MERRA_file_specs,GEOS_Forcing,AEROSOL_DEPOSITION) - !if(master_logit) write(logunit,*) trim(Iam)//'::force_time_nxt: ', date_time_print(force_time_nxt) + !if(root_logit) write(logunit,*) trim(Iam)//'::force_time_nxt: ', date_time_print(force_time_nxt) ! -compute-average-zenith-angle-over-daylight-part-of-forcing-interval- call MAPL_SunGetInsolation( & @@ -968,7 +968,7 @@ subroutine Run(gc, import, export, clock, rc) end if - !if(master_logit) write(logunit,*) trim(Iam)//'::zenav max/min: ', maxval(internal%mf%zenav), minval(internal%mf%zenav) + !if(root_logit) write(logunit,*) trim(Iam)//'::zenav max/min: ', maxval(internal%mf%zenav), minval(internal%mf%zenav) !if(logit) write(logunit,*) trim(Iam)//'::zenav max/min: ', maxval(internal%mf%zenav), minval(internal%mf%zenav) ! Compute zenith angle at the next time step @@ -997,7 +997,7 @@ subroutine Run(gc, import, export, clock, rc) RETURN_(ESMF_FAILURE) end if - !if(master_logit) write(logunit,*) trim(Iam)//'::zth max/min: ', maxval(zth), minval(zth) + !if(root_logit) write(logunit,*) trim(Iam)//'::zth max/min: ', maxval(zth), minval(zth) ! -convert-mf%TimePrv-to-LDAS-datetime- call esmf2ldas(internal%mf%TimePrv, force_time_prv, rc=status) @@ -1006,9 +1006,9 @@ subroutine Run(gc, import, export, clock, rc) ! -convert-ModelTimeNxt-to-LDAS-datetime- call esmf2ldas(ModelTimeNxt, model_time_nxt, rc=status) - !if(master_logit) write(logunit,*) trim(Iam)//'::force_time_prv: ', date_time_print(force_time_prv) + !if(root_logit) write(logunit,*) trim(Iam)//'::force_time_prv: ', date_time_print(force_time_prv) - !if(master_logit) write(logunit,*) trim(Iam)//'::model_time_nxt: ', date_time_print(model_time_nxt) + !if(root_logit) write(logunit,*) trim(Iam)//'::model_time_nxt: ', date_time_print(model_time_nxt) ! Allocate memory for interpolated MetForcing data mf_nodata = nodata_generic @@ -1031,7 +1031,7 @@ subroutine Run(gc, import, export, clock, rc) rc=status & ) VERIFY_(status) - !if(master_logit) write(logunit,*) trim(Iam)//'::mf_ntp%tair max/min: ', maxval(mfDataNtp%Tair), minval(mfDataNtp%Tair) + !if(root_logit) write(logunit,*) trim(Iam)//'::mf_ntp%tair max/min: ', maxval(mfDataNtp%Tair), minval(mfDataNtp%Tair) ! Pointers to exports (allocate memory) call MAPL_GetPointer(export, Tair, 'Tair', alloc=.true., rc=status) diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index 0eddac4a..882b5ef2 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -14,7 +14,7 @@ module LDAS_ForceMod use LDAS_ensdrv_Globals, ONLY: & logunit, & logit, & - master_logit, & + root_logit, & nodata_generic, & nodata_tol_generic, & nodata_tolfrac_generic @@ -333,7 +333,7 @@ subroutine get_forcing( date_time, force_dtstep, met_path, met_tag, & else ! assume forcing from GEOS5 GCM ("DAS" or "MERRA") output - if(master_logit) write (logunit,*) 'get_forcing(): assuming GEOS-5 forcing data set' + if(root_logit) write (logunit,*) 'get_forcing(): assuming GEOS-5 forcing data set' GEOS_forcing = .true. @@ -781,7 +781,7 @@ subroutine get_Berg_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(berg_dir(berg_var)) // '/' // YYYY & // '/' // trim(berg_name(berg_var)) // '.' // YYYY // MM // '.nc' - if(master_logit) write(logunit,*) 'get netcdf compression params from ' // trim(fname) + if(root_logit) write(logunit,*) 'get netcdf compression params from ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -806,7 +806,7 @@ subroutine get_Berg_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(berg_dir(berg_var)) // '/' // YYYY & // '/' // trim(berg_name(berg_var)) // '.' // YYYY // MM // '.nc' - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -1031,7 +1031,7 @@ subroutine get_RedArk_ASCII(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // '/' // YYYY // '/' & // 'red_ark_forc' // '.' // YYYY // '.' // DDD // '.' // HH - if(master_logit) write(logunit,*) 'opening ' // trim(fname) + if(root_logit) write(logunit,*) 'opening ' // trim(fname) open(10, file=fname, form='formatted', action='read', status='old') @@ -1249,7 +1249,7 @@ subroutine get_RedArk_GOLD(date_time, met_path, N_catd, tile_coord, & // trim(RedArk_GOLD_name(this_var)) // '_RedArk_' // & YYYY // MM // DD // '_' // HHMM - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) open(10,file=fname,form='formatted',action='read') @@ -1450,7 +1450,7 @@ subroutine get_RedArk_Princeton(date_time, met_path, N_catd, tile_coord, & // trim(RedArk_Princeton_name(this_var)) // '_RedArk_' // & YYYY // MM // DD // '_' // HHMM - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) open(10,file=fname,form='formatted',action='read') @@ -1664,7 +1664,7 @@ subroutine get_Princeton_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // '/' // trim(Princeton_name(Princeton_var)) & // '_3hourly_' // YYYY // '-' // YYYY // '.nc' - if(master_logit) write(logunit,*) 'opening' // trim(fname) + if(root_logit) write(logunit,*) 'opening' // trim(fname) ierr = NF_OPEN(fname, NF_NOWRITE, ncid) @@ -1847,7 +1847,7 @@ subroutine get_conus_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // '/' // YYYY//'-'//MM//'.nc' - if(master_logit) write (logunit,*) 'opening' // trim(fname) + if(root_logit) write (logunit,*) 'opening' // trim(fname) ierr = NF_OPEN(fname, NF_NOWRITE, ncid) @@ -2061,7 +2061,7 @@ subroutine get_GLDAS_2x2_5_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(gldas_name(gldas_var)) // '/' // YYYY & // '/' // trim(gldas_name(gldas_var)) // '.' // YYYY // MM // '.nc' - if(master_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) + if(root_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -2087,7 +2087,7 @@ subroutine get_GLDAS_2x2_5_netcdf(date_time, met_path, N_catd, tile_coord, & // '/' // trim(gldas_name(gldas_var)) // '.' // YYYY // MM // & '.nc' - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -2355,7 +2355,7 @@ subroutine get_Viviana_OK_precip(unitnumber, date_time, met_path, met_tag, & ! !if (present(ens_id)) unitnumber = unitnumber + ens_id - if(master_logit) write (logunit,*) 'opening ', trim(fname) + if(root_logit) write (logunit,*) 'opening ', trim(fname) open(unitnumber, file=fname, form='formatted', action='read', status='old') @@ -3007,7 +3007,7 @@ subroutine get_GEOS(date_time, force_dtstep, & (j==1) .and. & (tmp_init) .and. & (trim(GEOSgcm_defs(GEOSgcm_var,2))=='tavg') .and. & - (master_logit) ) then + (root_logit) ) then if (.not. MERRA_file_specs) write (logunit,'(400A)') & 'NOTE: Initialization. Data from tavg file are not used ' // & @@ -3759,7 +3759,7 @@ subroutine parse_MERRA_met_tag( met_path_in, met_tag_in, date_time, & !!end if ! ! The above fix did not work in MPI because subroutine get_forcing() is - ! only called by the master process. All other processes are unaware of + ! only called by the root process. All other processes are unaware of ! any changes to "ignore_SWnet_for_snow" from its uninitialized value ! because an MPI broadcast was missing. ! As of April 2015, "ignore_SWnet_for_snow" is no longer meaningful. @@ -4568,7 +4568,7 @@ subroutine get_GEOS_forcing_filename(fname_full,file_exists, date_time, daily_fi ! if no file was found, report file names that were tried if (.not. file_exists) then - if(master_logit) then + if(root_logit) then print '(400A)', trim(Iam) // ': Could not find any of the following files:' print '(400A)', trim(fname_full_tmp1) print '(400A)', trim(fname_full_tmp2) @@ -4622,7 +4622,7 @@ subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, if( fid == -9999 ) then ! not open yet ierr=nf90_open(fname_full,NF90_NOWRITE, fid) - if(master_logit) then + if(root_logit) then write(logunit,'(400A)') "opening file: "//trim(fname_full) endif ASSERT_( ierr == nf90_noerr) @@ -4905,7 +4905,7 @@ subroutine get_GEOS_corr_prec_filename(fname_full,file_exists, date_time, met_pa ! if no file was found, report file names that were tried if( .not. file_exists ) then - if(master_logit) then + if(root_logit) then print '(400A)', trim(Iam) // ': Could not find any of the following files:' print '(400A)', trim(fname_full_tmp1) print '(400A)', trim(fname_full_tmp2) @@ -5108,7 +5108,7 @@ subroutine get_GSWP2_1x1_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(gswp2_name(gswp2_var)) // '/' & // '/' // trim(gswp2_name(gswp2_var)) // YYYY // MM // '.nc' - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -5123,7 +5123,7 @@ subroutine get_GSWP2_1x1_netcdf(date_time, met_path, N_catd, tile_coord, & if (gswp2_var == 1) then - if(master_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) + if(root_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) if (ierr/=0) then err_msg = 'error opening netcdf file' @@ -5345,7 +5345,7 @@ subroutine check_forcing_nodata_2( N_catd, tile_coord, nodata_forcing, force_vec else if (abs(force_vec(i_next)-nodata_forcing)>tol) then - if(master_logit) write (logunit,*) 'forcing has no-data-value in tile ID = ', & + if(root_logit) write (logunit,*) 'forcing has no-data-value in tile ID = ', & tile_coord(i)%tile_id force_vec(i)=force_vec(i_next) else @@ -5364,8 +5364,8 @@ subroutine check_forcing_nodata_2( N_catd, tile_coord, nodata_forcing, force_vec end do if (create_blacklist) then - if(master_logit) write (logunit,*) '---------------------------------------------------------------' - if(master_logit) write (logunit,*) ' found N_black = ',N_black, ' tiles that should be blacklisted' + if(root_logit) write (logunit,*) '---------------------------------------------------------------' + if(root_logit) write (logunit,*) ' found N_black = ',N_black, ' tiles that should be blacklisted' err_msg = 'blacklist now in file fort.9999' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if @@ -5413,7 +5413,7 @@ type(date_time_type) function shift_forcing_date( met_tag, date_time ) tmpstring300 = 'shift_forcing_date(): Are you sure? ' // & 'If so, edit source code and recompile.' - if(master_logit) write (logunit,*) tmpstring300 + if(root_logit) write (logunit,*) tmpstring300 write(0,*) tmpstring300 stop diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 index 822769ff..94240807 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 @@ -6,7 +6,7 @@ module RepairForcingMod use MAPL_SatVaporMod, only: MAPL_EQsat use LDAS_ensdrv_Globals, only: logunit, LDAS_is_nodata use MAPL_ConstantsMod, only: stefan_boltzmann=>MAPL_STFBOL - use LDAS_ensdrv_Globals, only: master_logit + use LDAS_ensdrv_Globals, only: root_logit implicit none private @@ -161,7 +161,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Rainf ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Rainf < 0. in tile ID ' // & tile_id_str // ': met_force(i)%Rainf = ' // tmpstr13a @@ -179,7 +179,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Rainf_C ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Rainf_C < 0. in tile ID ' //& tile_id_str // ': met_force(i)%Rainf_C = ' // tmpstr13a @@ -196,7 +196,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Rainf ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%Rainf_C ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Rainf < Rainf_C in tile ID ' // & tile_id_str // ': met_force(i)%Rainf = ' // tmpstr13a // & ', met_force(i)%Rainf_C = ' // tmpstr13b @@ -215,7 +215,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Snowf ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Snowf < 0. in tile ID ' //& tile_id_str // ': met_force(i)%Snowf = ' // tmpstr13a @@ -240,7 +240,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Tair ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: Tair < '//min_Tair_string//' in tile ID ' // & tile_id_str // ': met_force(i)%Tair = ' // tmpstr13a @@ -253,7 +253,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Tair ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: Tair > '//max_Tair_string//' in tile ID ' // & tile_id_str // ': met_force(i)%Tair = ' // tmpstr13a @@ -274,7 +274,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%PSurf ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: Psurf > '//max_PSurf_string//' in tile ID ' // & tile_id_str // ': met_force(i)%PSurf = ' // tmpstr13a @@ -295,7 +295,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Qair ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Qair < 0. in tile ID ' // & tile_id_str // ': met_force(i)%Qair = ' // tmpstr13a @@ -316,7 +316,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Qair ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%Qair/Qair_sat - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Qair > Qair_sat in tile ID ' // & tile_id_str // ': met_force(i)%Qair = ' // tmpstr13a // & ', met_force(i)%Qair/Qair_sat = ' // tmpstr13b @@ -343,7 +343,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Wind ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Wind < 0. in tile ID ' //& tile_id_str // ': met_force(i)%Wind = ' // tmpstr13a @@ -374,7 +374,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%LWdown ! convert real to string write (tmpstr13b,'(e13.5)') min_LWdown - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: LWdown < min_LWdown in tile ID ' // & tile_id_str // ': met_force(i)%LWdown = ' // tmpstr13a // & ', min_LWdown = ' // tmpstr13b @@ -390,7 +390,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%LWdown ! convert real to string write (tmpstr13b,'(e13.5)') max_LWdown - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: LWdown > max_LWdown in tile ID ' // & tile_id_str // ': met_force(i)%LWdown = ' // tmpstr13a // & ', max_LWdown = ' // tmpstr13b @@ -413,7 +413,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWdown ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWdown < 0. in tile ID ' //& tile_id_str // ': met_force(i)%SWdown = ' // tmpstr13a @@ -431,7 +431,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWdown ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWdown > ' // SWDN_MAX_string // & ' in tile ID ' // tile_id_str // ': met_force(i)%SWdown = ' // tmpstr13a @@ -455,7 +455,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWnet ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWnet < 0. in tile ID ' //& tile_id_str // ': met_force(i)%SWnet = ' // tmpstr13a @@ -473,7 +473,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWnet ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%SWdown ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWnet > SWdown in tile ID ' // & tile_id_str // ': met_force(i)%SWnet = ' // tmpstr13a // & ', met_force(i)%SWdown = ' // tmpstr13b @@ -499,7 +499,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%PARdffs ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdffs < 0. in tile ID ' //& tile_id_str // ': met_force(i)%PARdffs = ' // tmpstr13a @@ -524,7 +524,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') tmp_maxPar ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%PARdffs ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdffs > ' // tmpstr13a // & ' in tile ID ' // tile_id_str // ': met_force(i)%PARdffs = ' // & tmpstr13b @@ -552,7 +552,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%PARdrct ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdrct < 0. in tile ID ' //& tile_id_str // ': met_force(i)%PARdrct = ' // tmpstr13a @@ -571,7 +571,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') tmp_maxPar ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%PARdrct ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdrct > ' // tmpstr13a // & ' in tile ID ' // tile_id_str // ': met_force(i)%PARdrct = ' // & tmpstr13b @@ -599,7 +599,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr16,'(i16)') kk ! convert integer to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: turning OFF warnings after detecting ' // & trim(tmpstr16) // ' tiles with problematic forcing' diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 index a5f601a3..b18ec215 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 @@ -1547,7 +1547,7 @@ subroutine reorder_tiles( reorder, pfaf_system, N_tile, tile_coord, d2g, N_tiles ! If input argument "reorder" is ".false." and "pfaf_system=0", assume that tiles have ! already been reordered. Check for obvious violations and only return "N_tiles_cont". ! - ! Typically done only by the master process (because the re-ordering requires + ! Typically done only by the root process (because the re-ordering requires ! a second copy of the full domain tile coord structure). ! ! reichle, 26 June 2012 diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 index d87128ab..700abc92 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 @@ -24,8 +24,8 @@ module LDAS_ensdrv_Globals public :: LDAS_is_nodata public :: logunit public :: logit - public :: master_logit - public :: log_master_only + public :: root_logit + public :: log_root_only public :: echo_clsm_ensdrv_glob_param public :: write_status @@ -50,13 +50,13 @@ module LDAS_ensdrv_Globals ! until the job terminates. ! ! NOTE: "logunit=stdout" is disabled if log messages are requested from *all* processors - ! (that is, for "log_master_only=.false.") to avoid garbled output + ! (that is, for "log_root_only=.false.") to avoid garbled output integer, parameter :: logunit = output_unit ! defined in iso_fortran_env - logical, parameter :: log_master_only = .true. + logical, parameter :: log_root_only = .true. - logical :: logit,master_logit + logical :: logit,root_logit contains @@ -82,7 +82,7 @@ subroutine echo_clsm_ensdrv_glob_param() write (logunit,*) write (logunit,*) 'logunit = ', logunit write (logunit,*) - write (logunit,*) 'log_master_only = ', log_master_only + write (logunit,*) 'log_root_only = ', log_root_only write (logunit,*) write (logunit,*) 'logit = ', logit write (logunit,*) diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 index c80a16d7..3641e8b8 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 @@ -14,7 +14,6 @@ module LDAS_ensdrv_init_routines use GEOS_MOD use LDAS_ensdrv_Globals, ONLY: & - log_master_only, & logunit, & logit, & nodata_generic @@ -52,9 +51,6 @@ module LDAS_ensdrv_init_routines N_gt, & N_snow - use LDAS_ensdrv_mpi, ONLY: & - master_proc - use ESMF use MAPL_Mod diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 index 3574dab3..1029db8e 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 @@ -59,7 +59,7 @@ module LDAS_ensdrv_mpi integer, public :: myid=0, numprocs=1, mpicomm integer, public :: mpierr, mpistatus(MPI_STATUS_SIZE) - logical, public :: master_proc=.true. + logical, public :: root_proc=.true. integer, public :: MPI_tile_coord_type, MPI_grid_def_type integer, public :: MPI_cat_param_type, MPI_cat_progn_type diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 deleted file mode 100644 index 63c8356f..00000000 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 +++ /dev/null @@ -1,1233 +0,0 @@ - -module LDAS_ensdrv_vegalb_routines - - ! collection of LDASsa subroutines for vegetation and albedo parameters - ! - ! (originally in clsm_ensdrv_drv_routines.F90) - ! - ! reichle, 22 Aug 2014 - - use LDAS_ensdrv_Globals, ONLY: & - logunit, & - logit - - use LDAS_DriverTypes, ONLY: & - veg_param_type, & - alb_param_type - -! use clsm_ensdrv_mpi, ONLY: & -! MPI_INTEGER, & -! MPI_COMM_WORLD, & -! mpierr, & -! MPI_DATE_TIME_TYPE, & -! numprocs, & -! master_proc - - use LDAS_DateTimeMod, ONLY: & - date_time_type, & - datetime_lt_refdatetime, & - datetime_eq_refdatetime, & - datetime2_minus_datetime1, & - augment_date_time, & - get_dofyr_pentad - - use LDAS_ensdrv_functions, ONLY: & - open_land_param_file - - use clsm_ensdrv_drv_routines, ONLY: & - f2l_real - - use LDAS_ExceptionsMod, ONLY: & - ldas_abort, & - LDAS_GENERIC_ERROR - - implicit none - - private - - public :: get_veg_and_alb_times - public :: get_VEG - public :: get_ALB - -contains - - ! ******************************************************************** - - subroutine open_file_VEG( field_name, unitnum, file_format_VEG, veg_path, & - res_ftag ) - - implicit none - - integer, intent(in) :: unitnum, file_format_VEG - - character( 3), intent(in) :: field_name - character(200), intent(in) :: veg_path - character( 40), intent(in) :: res_ftag - - ! local variables - - integer, parameter :: N_search_dir_max = 5 - - integer :: N_search_dir, istat - - logical :: is_big_endian - - character(100), dimension(N_search_dir_max) :: search_dir - character( 80) :: fname - character( 20) :: ftag - - character(len=*), parameter :: Iam = 'open_file_VEG' - - ! ------------------------------------------------------------------------- - - select case (field_name) - - case ('GRN'); ftag = 'green' - case ('LAI'); ftag = 'lai' - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown field_name') - - end select - - ! ----------------------------------- - - select case (file_format_VEG) - - case (0) - - N_search_dir = 2 ! specify sub-dirs of veg_path to search for file "fname" - - search_dir(1) = 'clsm' - search_dir(2) = 'VEGETATION-GSWP2/LAI_GRN_CLIMATOLOGY' - - ! 'green.dat' - ! 'lai.dat' - - fname = '/' // trim(ftag) // '.dat' - - is_big_endian = .true. - - case (1) - - N_search_dir = 1 ! specify sub-dirs of veg_path to search for file "fname" - - search_dir(1) = './' - - ! 'green_clim_180x1080.data' - MERRA-2 on cube-sphere grid - ! 'green_clim_540x361_DC.data' - MERRA DC grid with MERRA-2 tiling - - ! 'lai_clim_180x1080.data' - MERRA-2 on cube-sphere grid - ! 'lai_clim_540x361_DC.data' - MERRA DC grid with MERRA-2 tiling - - fname = '/' // trim(ftag) // '_clim_' // trim(res_ftag) // '.data' - - is_big_endian = .false. - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown file_format_VEG') - - end select - - istat = open_land_param_file( & - unitnum, .false., is_big_endian, N_search_dir, fname, veg_path, search_dir) - - end subroutine open_file_VEG - - ! ******************************************************************** - - subroutine open_file_ALB( field_name, unitnum, file_format_ALB, alb_path, & - res_ftag ) - - implicit none - - integer, intent(in) :: unitnum, file_format_ALB - - character( 5), intent(in) :: field_name - character(200), intent(in) :: alb_path - character( 40), intent(in) :: res_ftag - - ! local variables - - integer, parameter :: N_search_dir_max = 5 - - integer :: N_search_dir, istat - - logical :: is_big_endian - - character(100), dimension(N_search_dir_max) :: search_dir - character( 80) :: fname - character( 20) :: ftag - - character(len=*), parameter :: Iam = 'open_file_ALB' - - ! ------------------------------------------------------------------------- - - select case (file_format_ALB) - - case (0) - - N_search_dir = 2 ! specify sub-dirs of alb_path to search for file "fname" - - search_dir(1) = 'clsm' - search_dir(2) = 'MODIS_alb' - - select case (field_name) - - case ('ALBnf'); fname = '/modis_scale_factor.albnf.clim' - case ('ALBvf'); fname = '/modis_scale_factor.albvf.clim' - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown field_name') - - end select - - is_big_endian = .true. - - case (1) - - N_search_dir = 1 ! specify sub-dirs of alb_path to search for file "fname" - - search_dir(1) = './' - - ! 'nirdf_180x1080.dat' - MERRA-2 on cube-sphere grid - ! 'nirdf_540x361_DC.dat' - MERRA DC grid with MERRA-2 tiling - - ! 'visdf_180x1080.dat' - MERRA-2 on cube-sphere grid - ! 'visdf_540x361_DC.dat' - MERRA DC grid with MERRA-2 tiling - - ! NOTE: files named "AlbMap.*.dat" contain albedos, not the albedo *scaling* - ! factors needed here - - select case (field_name) - - case ('ALBnf'); ftag = 'nirdf' - case ('ALBvf'); ftag = 'visdf' - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown field_name') - - end select - - fname = '/' // trim(ftag) // '_' // trim(res_ftag) // '.dat' - - is_big_endian = .false. - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown file_format_ALB') - - end select - - istat = open_land_param_file( & - unitnum, .false., is_big_endian, N_search_dir, fname, alb_path, search_dir) - - end subroutine open_file_ALB - - ! ******************************************************************** - - subroutine get_veg_and_alb_times( N_catg, N_catf, res_ftag, & - veg_path, alb_path, file_format_VEG, file_format_ALB, this_date_time, & - N_GRN, N_LAI, N_ALB, & - mid_GRN, mid_LAI, mid_ALB ) - - ! Read and MPI broadcast either - ! (i) number of data times (if "mid_*" arguments are NOT present) - ! (ii) timestamps for veg and albedo files (otherwise) - ! - ! reichle, 25 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: N_catg, N_catf - - character( 40), intent(in) :: res_ftag - - character(200), intent(in) :: veg_path, alb_path - - integer, intent(in) :: file_format_VEG - integer, intent(in) :: file_format_ALB - - type(date_time_type), intent(in) :: this_date_time - - integer, intent(inout) :: N_GRN - integer, intent(inout) :: N_LAI - integer, intent(inout) :: N_ALB - - type(date_time_type), dimension(N_GRN), intent(out), optional :: mid_GRN - type(date_time_type), dimension(N_GRN), intent(out), optional :: mid_LAI - type(date_time_type), dimension(N_GRN), intent(out), optional :: mid_ALB - - ! local variables - - integer :: unitnum - character(len=*), parameter :: Iam = 'get_veg_and_alb_times' - - ! ------------------------------------------------------------------------ - - ! ensure proper usage - - if ( (.not. present(mid_GRN)) .and. & - (.not. present(mid_LAI)) .and. & - (.not. present(mid_ALB)) ) then - - if (logit) write (logunit,*) 'reading number of data times for LAI, GRN, ALB' - - elseif (present(mid_GRN) .and. present(mid_LAI) .and. present(mid_ALB) ) then - - if (logit) write (logunit,*) 'reading midpoint times for LAI, GRN, ALB' - - else - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown usage') - - end if - - unitnum = 10 - - ! ---------------------------------- - - if (master_proc) then - - ! greenness (GRN) - - call open_file_VEG( 'GRN', unitnum, file_format_VEG, veg_path, res_ftag) - - if (present(mid_GRN)) then - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_GRN, & - this_date_time, mid_GRN ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_GRN ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading GRN info' - - ! ----------------------------------------- - ! - ! leaf area index (LAI) - - call open_file_VEG( 'LAI', unitnum, file_format_VEG, veg_path, res_ftag) - - if (present(mid_LAI)) then - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_LAI, & - this_date_time, mid_LAI ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_LAI ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading LAI info' - - ! ----------------------------------------- - - ! albedo scaling parameters (ALB) - - ! assume that N_times matches between ALBnf and ALBvf files - - call open_file_ALB( 'ALBnf', unitnum, file_format_ALB, alb_path, res_ftag ) - - if (present(mid_ALB)) then - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, N_ALB, & - this_date_time, mid_ALB ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, N_ALB ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading ALB info' - - end if ! master_proc - - ! ----------------------------------------------------------------------- - ! - ! MPI broadcast (simplified "if" construct, see "proper usage" block above) - -#ifdef LDAS_MPI - - if (.not. present(mid_GRN)) then - - call MPI_BCAST(N_GRN, 1, MPI_INTEGER, 0, MPI_COMM_WORLD,mpierr) - call MPI_BCAST(N_LAI, 1, MPI_INTEGER, 0, MPI_COMM_WORLD,mpierr) - call MPI_BCAST(N_ALB, 1, MPI_INTEGER, 0, MPI_COMM_WORLD,mpierr) - - else - - call MPI_BCAST(mid_GRN, N_GRN, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(mid_LAI, N_LAI, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(mid_ALB, N_ALB, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - - end if - -#endif - - end subroutine get_veg_and_alb_times - - ! ******************************************************************** - - subroutine get_VEG( field_name, N_catg, N_catf, N_catl, f2g, N_catl_vec, low_ind, & - res_ftag, veg_path, file_format_VEG, this_date_time, & - N_VEG, mid_VEG, veg_time_new, veg_time_old, veg_param_new, veg_param_old ) - - ! Read either greenness (GRN) *or* leaf area index (LAI) data and put - ! into veg_param - ! - ! field_name = 'GRN': read GRN - ! field_name = 'LAI': read LAI - ! - ! veg_time_new: first available data time *after* this_date_time - ! veg_time_old: latest available data time *before* this_date_time - ! - ! veg_param_new: data for veg_time_new - ! veg_param_old: data for veg_time_old (optional, use for initialization) - ! - ! data are read for the full domain and MPI-scattered to the local processor - ! - ! reichle, 26 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - character(3), intent(in) :: field_name - - integer, intent(in) :: N_catg, N_catf, N_catl - - integer, dimension(N_catf), intent(in) :: f2g - - integer, dimension(numprocs), intent(in) :: N_catl_vec, low_ind - - character( 40), intent(in) :: res_ftag - character(200), intent(in) :: veg_path - - integer, intent(in) :: file_format_VEG - - type(date_time_type), intent(in) :: this_date_time - - integer, intent(in) :: N_VEG - - type(date_time_type), dimension(N_VEG), intent(in) :: mid_VEG - - type(date_time_type), intent(out) :: veg_time_new - type(date_time_type), intent(out) :: veg_time_old - - type(veg_param_type), dimension(N_catl), intent(out) :: veg_param_new - type(veg_param_type), dimension(N_catl), intent(out), optional :: veg_param_old - - ! local variables - - integer :: unitnum, N_VEG_tmp - - type(date_time_type), dimension(N_VEG) :: mid_VEG_tmp - - real, dimension(N_catl) :: data_new - real, dimension(N_catl) :: data_old - - real, dimension(:), allocatable :: data_new_f - real, dimension(:), allocatable :: data_old_f - - ! ------------------------------------------------------------------------ - - if (master_proc) then - - ! prepare - - unitnum = 10 - - N_VEG_tmp = N_VEG - - mid_VEG_tmp = mid_VEG - - allocate(data_new_f(N_catf)) - - if (present(veg_param_old)) allocate(data_old_f(N_catf)) - - ! read full domain data - - call open_file_VEG( field_name, unitnum, file_format_VEG, veg_path, res_ftag) - - if (present(veg_param_old)) then - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, & - N_VEG_tmp, this_date_time, mid_VEG_tmp, & - f2g, veg_time_new, veg_time_old, data_new_f, data_old_f ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, & - N_VEG_tmp, this_date_time, mid_VEG_tmp, & - f2g, veg_time_new, veg_time_old, data_new_f ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading ' // field_name - - end if - - ! map from full to local domain - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_new_f, data_new) - - select case (field_name) - - case ('GRN'); veg_param_new%grn = data_new - case ('LAI'); veg_param_new%lai = data_new - - end select - - if (master_proc) deallocate(data_new_f) - - if (present(veg_param_old)) then - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_old_f, data_old) - - select case (field_name) - - case ('GRN'); veg_param_old%grn = data_old - case ('LAI'); veg_param_old%lai = data_old - - end select - - if (master_proc) deallocate(data_old_f) - - end if - -#ifdef LDAS_MPI - - call MPI_BCAST(veg_time_new, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(veg_time_old, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - -#endif - - end subroutine get_VEG - - ! ******************************************************************** - - subroutine get_ALB( N_catg, N_catf, N_catl, f2g, N_catl_vec, low_ind, & - res_ftag, alb_path, file_format_ALB, this_date_time, & - N_ALB, mid_ALB, alb_time_new, alb_time_old, alb_param_new, alb_param_old ) - - ! Read albedo scaling parameters - ! - ! alb_time_new: first available data time *after* this_date_time - ! alb_time_old: latest available data time *before* this_date_time - ! - ! alb_param_new: data for alb_time_new - ! alb_param_old: data for alb_time_old (optional, use for initialization) - ! - ! data are read for the full domain and MPI-scattered to the local processor - ! - ! reichle, 26 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: N_catg, N_catf, N_catl - - integer, dimension(N_catf), intent(in) :: f2g - - integer, dimension(numprocs), intent(in) :: N_catl_vec, low_ind - - character( 40), intent(in) :: res_ftag - character(200), intent(in) :: alb_path - - integer, intent(in) :: file_format_ALB - - type(date_time_type), intent(in) :: this_date_time - - integer, intent(in) :: N_ALB - - type(date_time_type), dimension(N_ALB), intent(in) :: mid_ALB - - type(date_time_type), intent(out) :: alb_time_new - type(date_time_type), intent(out) :: alb_time_old - - type(alb_param_type), dimension(N_catl), intent(out) :: alb_param_new - type(alb_param_type), dimension(N_catl), intent(out), optional :: alb_param_old - - ! local variables - - integer :: unitnum, N_ALB_tmp, ff - - integer, parameter :: N_fields = 2 - - character(5), dimension(N_fields) :: field_names - - type(date_time_type), dimension(N_ALB) :: mid_ALB_tmp - - real, dimension(N_catl) :: data_new - real, dimension(N_catl) :: data_old - - real, dimension(:), allocatable :: data_new_f - real, dimension(:), allocatable :: data_old_f - - ! ------------------------------------------------------------------------ - - ! prepare - - field_names = (/ 'ALBnf', 'ALBvf' /) - - if (master_proc) then - - unitnum = 10 - - N_ALB_tmp = N_ALB - - mid_ALB_tmp = mid_ALB - - allocate(data_new_f(N_catf)) - - if (present(alb_param_old)) allocate(data_old_f(N_catf)) - - end if - - ! read data - - do ff=1,N_fields - - if (master_proc) then - - ! read full domain data - - call open_file_ALB( field_names(ff), unitnum, file_format_ALB, alb_path, & - res_ftag) - - if (present(alb_param_old)) then - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, & - N_ALB_tmp, this_date_time, mid_ALB_tmp, & - f2g, alb_time_new, alb_time_old, data_new_f, data_old_f ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, & - N_ALB_tmp, this_date_time, mid_ALB_tmp, & - f2g, alb_time_new, alb_time_old, data_new_f ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading ' // field_names(ff) - - end if - - ! map from full to local domain - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_new_f, data_new) - - select case (field_names(ff)) - - case ('ALBnf'); alb_param_new%sc_albnf = data_new - case ('ALBvf'); alb_param_new%sc_albvf = data_new - - end select - - if (present(alb_param_old)) then - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_old_f, data_old) - - select case (field_names(ff)) - - case ('ALBnf'); alb_param_old%sc_albnf = data_old - case ('ALBvf'); alb_param_old%sc_albvf = data_old - - end select - - end if - - end do ! ff=1,N_fields - - if ( master_proc ) deallocate(data_new_f) - if ( master_proc .and. present(alb_param_old) ) deallocate(data_old_f) - -#ifdef LDAS_MPI - - call MPI_BCAST(alb_time_new, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(alb_time_old, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - -#endif - - end subroutine get_ALB - - ! ******************************************************************** - - subroutine read_veg_or_alb_clim( unitnum, file_format, N_catg, N_catf, N_times, & - this_date_time, mid_date_time, f2g, new_date_time, old_date_time, data_new, & - data_old ) - - ! Read climatological vegetation (LAI, greenness) or albedo scaling - ! parameters from file. - ! - ! Climatological science data are provided as n-day averages for the - ! global tile space. - ! - ! This subroutine accomodates the following file formats: - ! - ! file_format=0: legacy format (monthly data, flat binaries, no date/time info) - ! file_format=1: compatible with MAPL_readforcing() - ! - ! The subroutine can be called in the following ways: - ! usage=1: Obtain only N_times - ! usage=2: Obtain mid-point date/time of data averaging intervals for all N_times - ! usage=3: a) Read data for interval with mid-point after this_date_time - ! b) Read data for intervals w/ mid-points after and before - ! this_date_time (use for initialization) - ! - ! reichle, 25 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: unitnum - integer, intent(in) :: file_format - - integer, intent(in) :: N_catg, N_catf - - integer, intent(inout) :: N_times - - type(date_time_type), intent(in), optional :: this_date_time - - type(date_time_type), dimension(N_times), intent(inout), optional :: mid_date_time - - integer, dimension(N_catf), intent(in), optional :: f2g - - type(date_time_type), intent(out), optional :: new_date_time - - type(date_time_type), intent(out), optional :: old_date_time - - real, dimension(N_catf), intent(out), optional :: data_new - - real, dimension(N_catf), intent(out), optional :: data_old - - - ! local variables - - integer, parameter :: max_times = 75 ! 73 pentads plus 2 for wrap-around - - integer :: usage, ii, jj, istat, dim1, dim2 - integer :: ind_new, tmp_ind_new, tmp_ind_old - integer :: prev_year, curr_year, next_year - - real, dimension(14) :: tmprealvec14 - - real, dimension(N_catg) :: tmpvec - - type(date_time_type) :: end_date_time - - type(date_time_type), dimension(:), allocatable :: start_date_time - - character(len=*), parameter :: Iam = 'read_veg_or_alb_clim' - character(len=400) :: err_msg - - ! ------------------------------------------------ - ! - ! determine what is needed - - if ( & - (.not. present(this_date_time)) .and. & - (.not. present(mid_date_time )) .and. & - (.not. present(f2g )) .and. & - (.not. present(new_date_time )) .and. & - (.not. present(old_date_time )) .and. & - (.not. present(data_new )) .and. & - (.not. present(data_old )) ) then - - ! usage=1: Obtain only N_times - - usage = 1 - - elseif ( & - ( present(this_date_time)) .and. & - ( present(mid_date_time )) .and. & - (.not. present(f2g )) .and. & - (.not. present(new_date_time )) .and. & - (.not. present(old_date_time )) .and. & - (.not. present(data_new )) .and. & - (.not. present(data_old )) ) then - - ! usage=2: Obtain mid-point date/time of data averaging intervals - ! for all N_times - - usage = 2 - - allocate(start_date_time(N_times+1)) - - elseif ( & - ( present(this_date_time)) .and. & - ( present(mid_date_time )) .and. & - ( present(f2g )) .and. & - ( present(new_date_time )) .and. & - ( present(old_date_time )) .and. & - ( present(data_new )) ) then - - ! usage=3: - ! - ! a) Read data for interval with mid-point after this_date_time - ! (if "data_old" is NOT present) - ! b) Read data for intervals w/ mid-points after *and* before this_date_time - ! (if "data_old" *is* present --> use for initialization) - ! - ! in this usage, "mid_date_time" is intent(in) - - usage = 3 - - ! Determine ind_new such that: - ! - ! mid_date_time(ind_new-1) < this_date_time <= mid_date_time(ind_new) - ! - ! Note: 2 <= ind_new <= N_times (by construction) - ! - ! ind_old = ind_new-1 (by definition) - - ind_new = 2 - - do while (ind_new<=N_times) - - ! test whether this_date_time is before mid_date_time(ind_new) - - if (datetime_lt_refdatetime( this_date_time, mid_date_time(ind_new))) exit - - ind_new = ind_new+1 - - end do - - new_date_time = mid_date_time(ind_new) - - old_date_time = mid_date_time(ind_new-1) - - else - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown usage (B)') - - end if - - ! ---------------------------------------------------------------------- - ! - ! read data from file - - select case (file_format) - - case (0) - - ! file format: flat binaries, monthly data, no date/time info, - ! wrap-around NOT stored in file - ! (legacy file format, e.g. MERRA-Land, Fortuna) - - if (usage==1) then - - N_times = 14 ! incl 2 for wrap-around NOT stored in file - - elseif (usage==2) then - - ! get N_times+1 (!) start date/times for averaging intervals - - ! 1 = Dec 1, 0z (year 0) - - start_date_time(1)%year = 0 - start_date_time(1)%month = 12 - start_date_time(1)%day = 1 - start_date_time(1)%hour = 0 - start_date_time(1)%min = 0 - start_date_time(1)%sec = 0 - - ! 2 = Jan 1, 0z (year 1) - ! 3 = Feb 1, 0z (year 1) - ! ... - ! 13 = Dec 1, 0z (year 1) - - do ii=2,(N_times-1) - - start_date_time(ii)%year = 1 - start_date_time(ii)%month = ii-1 - start_date_time(ii)%day = 1 - start_date_time(ii)%hour = 0 - start_date_time(ii)%min = 0 - start_date_time(ii)%sec = 0 - - end do - - ! 14 = Jan 1, 0z (year 2) - - start_date_time(N_times )%year = 2 - start_date_time(N_times )%month = 1 - start_date_time(N_times )%day = 1 - start_date_time(N_times )%hour = 0 - start_date_time(N_times )%min = 0 - start_date_time(N_times )%sec = 0 - - ! 15 = Feb 1, 0z (year 2) - - start_date_time(N_times+1)%year = 2 - start_date_time(N_times+1)%month = 2 - start_date_time(N_times+1)%day = 1 - start_date_time(N_times+1)%hour = 0 - start_date_time(N_times+1)%min = 0 - start_date_time(N_times+1)%sec = 0 - - elseif (usage==3) then - - ! translate ind_new into tmp_ind_new (wrap-around months NOT stored in file) - - if (ind_new==2 .or. ind_new==14) then - - tmp_ind_new = 1 ! Jan - tmp_ind_old = 12 ! Dec - - else - - tmp_ind_new = ind_new - 1 - tmp_ind_old = ind_new - 2 - - end if - - ! disable "tmp_ind_old" if not needed - - if (.not. present(data_old)) tmp_ind_old = -9999 - - ! read through file and extract months of interest - - do ii=1,max(tmp_ind_old,tmp_ind_new) - - if (ii==tmp_ind_new) then - - read (unitnum) (tmpvec(jj), jj=1,N_catg) - - data_new(1:N_catf) = tmpvec(f2g(1:N_catf)) - - elseif (ii==tmp_ind_old) then - - ! per definition of tmp_ind_old above and loop boundaries, - ! "data_old" must be present in this case - - read (unitnum) (tmpvec(jj), jj=1,N_catg) - - data_old(1:N_catf) = tmpvec(f2g(1:N_catf)) - - else - - read (unitnum) ! SKIP science data record - - end if - - end do - - end if ! usage - - ! ------------------------------------------- - - case (1) - - ! file format: compatible with MAPL_readforcing() - ! flat binaries, n-day averages, date/time info - ! (e.g., MERRA-2) - - if (usage==1) then - - ! determine number of data records in file - - ii = 0 - - do while (ii=max_times) then - err_msg = 'number or data times in file exceeds max allowed' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - N_times = ii - - elseif (usage==2) then - - do ii=1,N_times - - ! read date/time record - - read (unitnum) (tmprealvec14(jj), jj=1,14) - - ! start date/time of averaging interval - - start_date_time(ii)%year = nint(tmprealvec14( 1)) - start_date_time(ii)%month = nint(tmprealvec14( 2)) - start_date_time(ii)%day = nint(tmprealvec14( 3)) - start_date_time(ii)%hour = nint(tmprealvec14( 4)) - start_date_time(ii)%min = nint(tmprealvec14( 5)) - start_date_time(ii)%sec = nint(tmprealvec14( 6)) - - ! sanity check - - if (ii>1) then - - ! start of current interval must match end of previous interval - - if (.not. datetime_eq_refdatetime( & - start_date_time(ii), end_date_time ) & - ) then - err_msg = 'intervals do not line up' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - ! end date/time of averaging interval - - end_date_time%year = nint(tmprealvec14( 7)) - end_date_time%month = nint(tmprealvec14( 8)) - end_date_time%day = nint(tmprealvec14( 9)) - end_date_time%hour = nint(tmprealvec14(10)) - end_date_time%min = nint(tmprealvec14(11)) - end_date_time%sec = nint(tmprealvec14(12)) - - ! spatial dimensions - - dim1 = nint(tmprealvec14(13)) - dim2 = nint(tmprealvec14(14)) - - ! sanity check - - ! dim1 must match N_catg, dim2 must be 1 - - if ((dim1/=N_catg) .or. (dim2/=1)) then - err_msg = 'dimensions do not match' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - - read (unitnum) ! SKIP science data record - - end do - - ! fill in last element of start_date_time - - start_date_time(N_times+1) = end_date_time - - ! additional sanity checks - - ! check wrap-around: last three start_date_time entries must match - ! first three, resp. (except for year) - - if ( (start_date_time(N_times-1)%month/=start_date_time(1)%month) .or. & - (start_date_time(N_times-1)%day /=start_date_time(1)%day ) .or. & - (start_date_time(N_times-1)%hour /=start_date_time(1)%hour ) .or. & - (start_date_time(N_times-1)%min /=start_date_time(1)%min ) .or. & - (start_date_time(N_times-1)%sec /=start_date_time(1)%sec ) ) then - err_msg = 'something wrong with wrap-around (A)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ( (start_date_time(N_times )%month/=start_date_time(2)%month) .or. & - (start_date_time(N_times )%day /=start_date_time(2)%day ) .or. & - (start_date_time(N_times )%hour /=start_date_time(2)%hour ) .or. & - (start_date_time(N_times )%min /=start_date_time(2)%min ) .or. & - (start_date_time(N_times )%sec /=start_date_time(2)%sec ) ) then - err_msg = 'something wrong with wrap-around (B)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ( (start_date_time(N_times+1)%month/=start_date_time(3)%month) .or. & - (start_date_time(N_times+1)%day /=start_date_time(3)%day ) .or. & - (start_date_time(N_times+1)%hour /=start_date_time(3)%hour ) .or. & - (start_date_time(N_times+1)%min /=start_date_time(3)%min ) .or. & - (start_date_time(N_times+1)%sec /=start_date_time(3)%sec ) ) then - err_msg = 'something wrong with wrap-around (C)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! check years - - prev_year = start_date_time( 1)%year - curr_year = start_date_time( 2)%year - next_year = start_date_time( N_times)%year - - if ((prev_year+1/=curr_year) .or. (curr_year+1/=next_year)) then - err_msg = 'error with years in file (A)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - do ii=3,N_times-1 - - if (start_date_time(ii)%year/=curr_year) then - err_msg = 'error with years in file (B)' - end if - - end do - - if (start_date_time(N_times+1)%year/=next_year) then - err_msg = 'error with years in file (C)' - end if - - - elseif (usage==3) then - - do ii=1,ind_new - - read (unitnum) ! SKIP date/time info record - - if (ii1 .and. ii=N_times) then - - start_date_time_tmp(ii)%year = current_year+1 - - end if - - ! recompute day-of-year - - call get_dofyr_pentad( start_date_time_tmp(ii) ) - - end do - - ! compute mid-point date/time - - do ii=1,N_times - - ! get length of interval (ii:ii+1) in seconds - - dt = datetime2_minus_datetime1( & - start_date_time_tmp(ii), start_date_time_tmp(ii+1) ) - - ! initialize and add dt/2 - - mid_date_time(ii) = start_date_time_tmp(ii) - - call augment_date_time( dt/2, mid_date_time(ii) ) - - end do - - end subroutine get_veg_or_alb_clim_mid_date_time - - ! ******************************************************************** - -end module clsm_ensdrv_vegalb_routines - -! *********** EOF ****************************************************** From eb5561110a106ee16d582b03f911d7ed7d7fde6a Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 26 Jun 2020 09:31:50 -0400 Subject: [PATCH 35/42] edited Externals.cfg and components.yaml for use with main --- Externals.cfg | 4 ++-- components.yaml | 13 +++++-------- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 59defd71..3b49a045 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = main +tag = v1.1.3 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -branch = develop +tag = v1.8.7 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/components.yaml b/components.yaml index 52f1b0c3..d67288d6 100644 --- a/components.yaml +++ b/components.yaml @@ -1,14 +1,12 @@ env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git - tag: v2.1.3+intel19.1.0 - develop: main + tag: v2.1.3+intel19.1.0 cmake: local: ./@cmake remote: git@github.com:GEOS-ESM/ESMA_cmake.git tag: v3.0.1 - develop: develop ecbuild: local: ./@cmake/@ecbuild @@ -19,18 +17,17 @@ GMAO_Shared: local: ./src/Shared/@GMAO_Shared remote: git@github.com:GEOS-ESM/GMAO_Shared.git sparse: ./config/GMAO_Shared.sparse - branch: main - develop: main + tag: v1.1.3 MAPL: local: ./src/Shared/@MAPL remote: git@github.com:GEOS-ESM/MAPL.git tag: v2.1.3 - develop: develop GEOSgcm_GridComp: local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git sparse: ./config/GEOSgcm_GridComp_ldas.sparse - branch: develop - develop: develop + tag: v1.8.7 + + From 7c2a1cf1f21f523495157700b927ba2afd9318d9 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 26 Jun 2020 09:45:32 -0400 Subject: [PATCH 36/42] Syncing Bridge into main (#263) --- .gitignore | 1 + Externals.cfg | 2 +- components.yaml | 7 +- doc/CHANGELOG.md | 11 +- parallel_build.csh | 16 +- src/Applications/LDAS_App/ldas_setup | 11 +- .../LDAS_App/mk_GEOSldasRestarts.F90 | 48 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 8 +- .../GEOS_LandAssimGridComp.F90 | 18 +- .../clsm_bias_routines.F90 | 18 +- .../clsm_ensdrv_drv_routines.F90 | 3 +- .../clsm_ensdrv_out_routines.F90 | 14 +- .../clsm_ensupd_enkf_update.F90 | 86 +- .../clsm_ensupd_read_obs.F90 | 28 +- .../LDAS_PertRoutines.F90 | 92 +- .../GEOSlandpert_GridComp/land_pert.F90 | 6 +- .../GEOS_MetforceGridComp.F90 | 14 +- .../GEOSmetforce_GridComp/LDAS_Forcing.F90 | 46 +- .../Shared/LDAS_RepairForcing.F90 | 44 +- .../Shared/LDAS_TileCoordRoutines.F90 | 2 +- .../Shared/LDAS_ensdrv_Globals.F90 | 12 +- .../Shared/LDAS_ensdrv_init_routines.F90 | 4 - .../Shared/LDAS_ensdrv_mpi.F90 | 2 +- .../Shared/LDAS_ensdrv_vegalb_routines.F90 | 1233 ----------------- 24 files changed, 246 insertions(+), 1480 deletions(-) delete mode 100644 src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 diff --git a/.gitignore b/.gitignore index f227fb53..5304b0f9 100644 --- a/.gitignore +++ b/.gitignore @@ -5,4 +5,5 @@ /BUILD/ /build*/ /install*/ +/.mepo/ parallel_build.o* diff --git a/Externals.cfg b/Externals.cfg index 05cfb3f8..3b49a045 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.6 +tag = v1.8.7 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/components.yaml b/components.yaml index 5616a26f..d67288d6 100644 --- a/components.yaml +++ b/components.yaml @@ -1,7 +1,7 @@ env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git - tag: v2.1.3+intel19.1.0 + tag: v2.1.3+intel19.1.0 cmake: local: ./@cmake @@ -17,7 +17,7 @@ GMAO_Shared: local: ./src/Shared/@GMAO_Shared remote: git@github.com:GEOS-ESM/GMAO_Shared.git sparse: ./config/GMAO_Shared.sparse - branch: master + tag: v1.1.3 MAPL: local: ./src/Shared/@MAPL @@ -28,5 +28,6 @@ GEOSgcm_GridComp: local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git sparse: ./config/GEOSgcm_GridComp_ldas.sparse - branch: develop + tag: v1.8.7 + diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index ae6bce64..39fb551a 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -33,11 +33,6 @@ This README file contains the history of stable GEOSldas versions ("tags") in Gi Overview of Git Releases: ============================ - - - - ------------------------------- [v17.9.0-beta.7](https://github.com/GEOS-ESM/GEOSldas/releases/tag/v17.9.0-beta.7) - 2020-06-11 ------------------------------ @@ -54,7 +49,7 @@ Overview of Git Releases: - Fixed handling of LANDPERT restart files after cold-start in first job segment. - - For lat/lon and EASE tile space only, fixed violation of zero-diff (binary identical) results when stopping/restarting at different intervals (removed extra zero-mean adjustment of LANDPERT after reading from restart file). Requires more work for cube-sphere tile space. + - Fixed violation of zero-diff (binary identical) results when stopping/restarting at different intervals (removed extra zero-mean adjustment of LANDPERT after reading from restart file and fixed tile2grid operation for cube-sphere tile space). - Fixed LANDPERT restart file name for cube-sphere. @@ -64,11 +59,11 @@ Overview of Git Releases: - Added “.nc4” file name extension for cube-sphere LANDPERT checkpoint file. - - Added log message for OBSPERTRSEED “cold” start. + - Added log messages for initialization of OBSPERTRSEED. - Fixed typo in default OBSPERTRSEED restart file name. - - Fixed time stamp of output *ensprop*inputs.nml file. + - Fixed time stamp of output *ensprop_inputs.nml file. - Fixed FIRST_ENS_ID for post-processing. diff --git a/parallel_build.csh b/parallel_build.csh index e2164658..75111799 100755 --- a/parallel_build.csh +++ b/parallel_build.csh @@ -21,9 +21,11 @@ setenv ESMADIR $srcdir set origargv = "$argv" setenv external "" +setenv USEMEPO FALSE while ($#argv) - if ("$1" == "-develop") then - setenv external "-e Develop.cfg" + + if ("$1" == "-mepo") then + setenv USEMEPO TRUE endif shift @@ -36,8 +38,14 @@ if (! -d ${ESMADIR}/@env) then echo " Please run from a head node" exit 1 else - echo " Running checkout_externals" - checkout_externals $external + if ( "$USEMEPO" == "TRUE") then + echo "Running mepo initialization" + mepo init + mepo clone + else + echo " Running checkout_externals" + checkout_externals $external + endif endif endif diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index a516ad70..ad68cd26 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -678,10 +678,9 @@ class LDASsetup: # link BC print "linking bcs..." bcnames=['green','lai','ndvi','nirdf','visdf'] - for ensid in self.ensids : - for bcln,bc in zip(bcnames,bcs) : - myBC=self.inpdir+'/'+bcln+ensid+'.data' - os.symlink(bc,myBC) + for bcln,bc in zip(bcnames,bcs) : + myBC=self.inpdir+'/'+bcln+'.data' + os.symlink(bc,myBC) # create and link restart print "Creating and lining restart..." @@ -1016,8 +1015,8 @@ class LDASsetup: bcval=['../input/green','../input/lai','../input/ndvi','../input/nirdf','../input/visdf'] bckey=['GREEN','LAI','NDVI','NIRDF','VISDF'] for key, val in zip(bckey,bcval): - keyn= key+'_FILE' - valn= val+tmpl_+'.data' + keyn = key+'_FILE' + valn = val+'.data' ldasrcInp[keyn]= valn # create restart item in RC diff --git a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 index 60de2cce..4b575de2 100644 --- a/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 +++ b/src/Applications/LDAS_App/mk_GEOSldasRestarts.F90 @@ -28,7 +28,7 @@ PROGRAM mk_GEOSldasRestarts ! initialize to non-MPI values integer :: myid=0, numprocs=1, mpierr - logical :: master_proc=.true. + logical :: root_proc=.true. ! Carbon model specifics ! ---------------------- @@ -268,7 +268,7 @@ PROGRAM mk_GEOSldasRestarts endif endif - if (master_proc) then + if (root_proc) then ! read in ntiles ! ---------------------------- @@ -289,7 +289,7 @@ PROGRAM mk_GEOSldasRestarts call MPI_Barrier(MPI_COMM_WORLD, STATUS) stop endif - if (master_proc) then + if (root_proc) then if(trim(MODEL) == 'CATCH' ) call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catch_internal_rst' ) if(trim(MODEL) == 'CATCHCN') call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData2/clsm/','OutData2/catchcn_internal_rst') endif @@ -371,7 +371,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL read (10) NTILES_RST - if(master_proc) then + if(root_proc) then print *,'NTILES in BCs : ',NTILES print *,'NTILES in restarts : ',NTILES_RST endif @@ -403,7 +403,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL allocate (latc (1:ntiles_rst)) allocate (tid_offl (ntiles_rst)) - if (master_proc) then + if (root_proc) then allocate (long (ntiles)) allocate (latg (ntiles)) allocate (ld_reorder(ntiles_rst)) @@ -455,7 +455,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL endif end do - if(master_proc) deallocate (long) + if(root_proc) deallocate (long) call MPI_BCAST(lonc,ntiles_rst,MPI_REAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(latc,ntiles_rst,MPI_REAL,0,MPI_COMM_WORLD,mpierr) @@ -468,7 +468,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL ! id_glb for hydrologic variable call GetIds(lonc,latc,lonn,latt,id_loc, tid_offl) - if(master_proc) allocate (id_glb (ntiles)) + if(root_proc) allocate (id_glb (ntiles)) call MPI_Barrier(MPI_COMM_WORLD, STATUS) ! call MPI_GATHERV( & @@ -492,7 +492,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL deallocate (id_loc) - if(master_proc) then + if(root_proc) then inquire(file = trim(rst_file), exist=fexist) if (.not. fexist) then @@ -557,7 +557,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_sf1) STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_sf2) - if (master_proc) then + if (root_proc) then allocate (ityp_tmp (ntiles_rst,nveg)) allocate (fveg_tmp (ntiles_rst,nveg)) @@ -603,7 +603,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & fveg_offl, ityp_offl) - if(master_proc) allocate (id_glb_cn (ntiles,nveg)) + if(root_proc) allocate (id_glb_cn (ntiles,nveg)) allocate (id_loc (ntiles)) call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -632,11 +632,11 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDD, EXPNAME, EXPDIR, MODEL endif end do - if(master_proc) id_glb_cn (:,nv) = id_loc + if(root_proc) id_glb_cn (:,nv) = id_loc end do - if(master_proc) then + if(root_proc) then allocate (var_off_col (1: NTILES_RST, 1 : nzone,1 : var_col)) allocate (var_off_pft (1: NTILES_RST, 1 : nzone,1 : nveg, 1 : var_pft)) @@ -1121,7 +1121,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) allocate (lonc (1:ntiles_smap)) allocate (latc (1:ntiles_smap)) - if (master_proc) then + if (root_proc) then allocate (long (ntiles)) allocate (latg (ntiles)) @@ -1190,7 +1190,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) ! latt,nt_local(myid+1),MPI_real , & ! 0,MPI_COMM_WORLD, mpierr ) - if(master_proc) deallocate (long, latg) + if(root_proc) deallocate (long, latg) call MPI_BCAST(lonc,ntiles_smap,MPI_REAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(latc,ntiles_smap,MPI_REAL,0,MPI_COMM_WORLD,mpierr) @@ -1204,7 +1204,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) ! Loop through NTILES (# of tiles in output array) find the nearest neighbor from Qing. - if(master_proc) allocate (id_glb (ntiles)) + if(root_proc) allocate (id_glb (ntiles)) call MPI_Barrier(MPI_COMM_WORLD, STATUS) ! call MPI_GATHERV( & @@ -1226,7 +1226,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) endif end do - if (master_proc) call put_land_vars (NTILES, ntiles_smap, id_glb, ld_reorder, model) + if (root_proc) call put_land_vars (NTILES, ntiles_smap, id_glb, ld_reorder, model) call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -1771,7 +1771,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) allocate (lonc (1:ntiles_cn)) allocate (latc (1:ntiles_cn)) - if (master_proc) then + if (root_proc) then ! -------------------------------------------- ! Read exact lonn, latt from output .til file @@ -1828,7 +1828,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) end do - if(master_proc) deallocate (long, latg) + if(root_proc) deallocate (long, latg) call MPI_BCAST(lonc,ntiles_cn,MPI_REAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(latc,ntiles_cn,MPI_REAL,0,MPI_COMM_WORLD,mpierr) @@ -1856,7 +1856,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),3/), (/nt_local(myid+1),1/),CLMC_sf1) STATUS = NF_GET_VARA_REAL(OUTID,VarID(OUTID,'FVG'), (/low_ind(myid+1),4/), (/nt_local(myid+1),1/),CLMC_sf2) - if (master_proc) then + if (root_proc) then allocate (TILE_ID (1:ntiles_cn)) @@ -1907,7 +1907,7 @@ SUBROUTINE regrid_carbon_vars (NTILES) ! update id_glb in root - if(master_proc) then + if(root_proc) then allocate (id_glb (ntiles, nveg)) allocate (id_vec (ntiles)) endif @@ -1934,11 +1934,11 @@ SUBROUTINE regrid_carbon_vars (NTILES) endif end do - if(master_proc) id_glb (:,nv) = id_vec + if(root_proc) id_glb (:,nv) = id_vec end do - if(master_proc) then + if(root_proc) then allocate (var_off_col (1: NTILES_CN, 1 : nzone,1 : var_col)) allocate (var_off_pft (1: NTILES_CN, 1 : nzone,1 : nveg, 1 : var_pft)) @@ -2961,12 +2961,12 @@ subroutine init_MPI() call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, mpierr ) - if (myid .ne. 0) master_proc = .false. + if (myid .ne. 0) root_proc = .false. ! call init_MPI_types() write (*,*) "MPI process ", myid, " of ", numprocs, " is alive" - write (*,*) "MPI process ", myid, ": master_proc=", master_proc + write (*,*) "MPI process ", myid, ": root_proc=", root_proc end subroutine init_MPI diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index b404e68f..b4ffaa3a 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -25,9 +25,9 @@ module GEOS_LdasGridCompMod use LDAS_DateTimeMod,ONLY: date_time_type use LDAS_ensdrv_mpi, only: MPI_tile_coord_type, MPI_grid_def_type use LDAS_ensdrv_mpi, only: init_MPI_types,mpicomm,numprocs,myid - use LDAS_ensdrv_mpi, only: master_proc + use LDAS_ensdrv_mpi, only: root_proc use LDAS_ensdrv_init_routines, only: io_domain_files - use LDAS_ensdrv_Globals, only: logunit,logit,master_logit,echo_clsm_ensdrv_glob_param + use LDAS_ensdrv_Globals, only: logunit,logit,root_logit,echo_clsm_ensdrv_glob_param use lsm_routines, only: lsmroutines_echo_constants use StieglitzSnow, only: StieglitzSnow_echo_constants use SurfParams, only: SurfParams_init @@ -403,7 +403,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call MPI_COMM_RANK(mpicomm, myid,mpierr) call MPI_COMM_SIZE(mpicomm, numprocs, mpierr ) - master_proc = IAmRoot + root_proc = IAmRoot ! Turn timers on call MAPL_TimerOn(MAPL, "TOTAL") call MAPL_TimerOn(MAPL, "Initialize") @@ -417,7 +417,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) logit = (trim(LDAS_logit) /= 'NO') - master_logit = (IamRoot .and. logit) + root_logit = (IamRoot .and. logit) ! Init catchment constants, currently different in GCM and GEOSldas call MAPL_GetResource(MAPL, LAND_PARAMS,Label="LAND_PARAMS:",DEFAULT="Icarus",RC=STATUS) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 15ac2fb2..baec2c6e 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -27,7 +27,7 @@ module GEOS_LandAssimGridCompMod use nr_ran2_gasdev, only: NRANDSEED, init_randseed use land_pert_routines, only: get_init_pert_rseed use LDAS_ensdrv_mpi, only: mpicomm,numprocs,myid - use LDAS_ensdrv_mpi, only: master_proc + use LDAS_ensdrv_mpi, only: root_proc use LDAS_ensdrv_mpi, only: MPI_obs_param_type use LDAS_DateTimeMod, only: date_time_type @@ -1059,7 +1059,7 @@ subroutine Initialize(gc, import, export, clock, rc) _VERIFY(STATUS) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) _VERIFY(STATUS) - call init_log( myid, numprocs, master_proc ) + call init_log( myid, numprocs, root_proc ) ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) _VERIFY(status) @@ -1129,7 +1129,7 @@ subroutine Initialize(gc, import, export, clock, rc) allocate(Pert_rseed( NRANDSEED, NUM_ENSEMBLE), source = 0 ) allocate(Pert_rseed_r8(NRANDSEED, NUM_ENSEMBLE), source = 0.0d0) - if (master_proc) then + if (root_proc) then call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_RESTART_FILE:", DEFAULT="../input/restart/landassim_obspertrseed%s_rst", RC=STATUS) _VERIFY(STATUS) @@ -1198,7 +1198,7 @@ subroutine Initialize(gc, import, export, clock, rc) rf2l( l2rf(i) ) = i end do - if (master_proc) then + if (root_proc) then call read_ens_upd_inputs( & trim(out_path), & trim(exp_id), & @@ -1245,11 +1245,11 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr) - if (.not. master_proc) allocate(obs_param(N_obs_param)) + if (.not. root_proc) allocate(obs_param(N_obs_param)) call MPI_BCAST(obs_param, N_obs_param, MPI_OBS_PARAM_TYPE, 0,MPICOMM,mpierr) - if (master_proc) call echo_clsm_ensupd_glob_param(logunit) + if (root_proc) call echo_clsm_ensupd_glob_param(logunit) call MAPL_GenericInitialize(gc, import, export, clock, rc=status) _VERIFY(status) @@ -1465,7 +1465,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) if (mwRTM) & call GEOS_output_smapL4SMlmc( GC, start_time, trim(out_path), trim(exp_id), & N_catl, tile_coord_l, cat_param, mwRTM_param ) - if (master_proc) then + if (root_proc) then ! for out put call read_cat_bias_inputs( trim(out_path), trim(exp_id), start_time, update_type, & cat_bias_param, N_catbias) @@ -1474,7 +1474,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! The time is one model time step behind Current time, so record the checkpoint here if (MAPL_RecordAlarmIsRinging(MAPL)) then - if (master_proc) then + if (root_proc) then Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) _VERIFY(STATUS) @@ -2503,7 +2503,7 @@ subroutine Finalize(gc, import, export, clock, rc) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) _VERIFY(STATUS) - if (master_proc) then + if (root_proc) then if (out_obslog) call finalize_obslog() Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 index 11c775d2..58fd93da 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_bias_routines.F90 @@ -11,12 +11,12 @@ module clsm_bias_routines N_snow => CATCH_N_SNOW, & N_gt => CATCH_N_GT - use LDAS_ensdrv_globals, ONLY: & + use LDAS_ensdrv_globals, ONLY: & nodata_generic, & logit, & logunit - use LDAS_DateTimeMod, ONLY: & + use LDAS_DateTimeMod, ONLY: & date_time_type use catch_types, ONLY: & @@ -32,9 +32,9 @@ module clsm_bias_routines obs_bias_type use LDAS_ensdrv_mpi, ONLY: & - master_proc, & + root_proc, & MPI_obs_bias_type, & - mpicomm, & + mpicomm, & MPIERR use LDAS_ensdrv_functions, ONLY: & @@ -43,7 +43,7 @@ module clsm_bias_routines use clsm_ensupd_upd_routines, ONLY: & get_cat_progn_ens_avg - use LDAS_exceptionsMod, ONLY: & + use LDAS_exceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR @@ -1069,7 +1069,7 @@ subroutine initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, work_path, & ! ------------------------------------------------------------------ - if (master_proc) then + if (root_proc) then allocate(obs_bias_f(N_catf,N_obs_param,N_obsbias_max)) @@ -1098,7 +1098,7 @@ subroutine initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, work_path, & #endif - if (master_proc) deallocate(obs_bias_f) + if (root_proc) deallocate(obs_bias_f) end subroutine initialize_obs_bias @@ -1313,7 +1313,7 @@ subroutine output_obs_bias(N_obs_param, N_obsbias_max, N_catl, N_catf, & integer :: i,j - if (master_proc) allocate(obs_bias_f(N_catf,N_obs_param, N_obsbias_max)) + if (root_proc) allocate(obs_bias_f(N_catf,N_obs_param, N_obsbias_max)) #ifdef LDAS_MPI @@ -1336,7 +1336,7 @@ subroutine output_obs_bias(N_obs_param, N_obsbias_max, N_catl, N_catf, & #endif - if (master_proc) then + if (root_proc) then call io_rstrt_obs_bias( & 'w', work_path, exp_id, date_time, N_catf, & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 index 6402ca72..b1ec9d14 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_drv_routines.F90 @@ -34,8 +34,7 @@ module clsm_ensdrv_drv_routines use LDAS_ensdrv_mpi, ONLY: & mpicomm, & mpierr, & - numprocs, & - master_proc + numprocs use catchment_model, ONLY: & catch_calc_tsurf diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 index a719b7d7..aae2f856 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensdrv_out_routines.F90 @@ -9,7 +9,7 @@ module clsm_ensdrv_out_routines ! reichle, 22 Aug 2014 use LDAS_ensdrv_globals, ONLY: & - log_master_only, & + log_root_only, & logunit, & logit @@ -26,7 +26,7 @@ module clsm_ensdrv_out_routines mwRTM_param_type use LDAS_ensdrv_mpi, ONLY: & - master_proc, & + root_proc, & numprocs use LDAS_DateTimeMod, ONLY: & @@ -52,7 +52,7 @@ module clsm_ensdrv_out_routines ! ******************************************************************** - subroutine init_log( myid, numprocs, master_proc ) + subroutine init_log( myid, numprocs, root_proc ) ! open file for output log, write a few things @@ -63,7 +63,7 @@ subroutine init_log( myid, numprocs, master_proc ) implicit none integer, intent(in) :: myid, numprocs - logical, intent(in) :: master_proc + logical, intent(in) :: root_proc ! ------------------------------------------------------------------------ ! @@ -89,7 +89,7 @@ subroutine init_log( myid, numprocs, master_proc ) ! interpret parameters from clsm_ensdrv_glob_param - if (log_master_only .and. (.not. master_proc)) then + if (log_root_only .and. (.not. root_proc)) then logit = .false. @@ -101,7 +101,7 @@ subroutine init_log( myid, numprocs, master_proc ) ! stop if logunit is stdout and output is requested for *all* processors - if ( (.not. log_master_only) .and. (logunit==output_unit) ) then + if ( (.not. log_root_only) .and. (logunit==output_unit) ) then err_msg = 'logunit=output_unit (stdout) together with logging *all* procs is disabled' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) @@ -141,7 +141,7 @@ subroutine init_log( myid, numprocs, master_proc ) write (logunit,*) "process ", myid, " of ", numprocs, " is alive" write (logunit,*) - write (logunit,*) "process ", myid, ": master_proc=", master_proc + write (logunit,*) "process ", myid, ": root_proc=", root_proc write (logunit,*) end if ! if (logit) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index 7bb3ab1d..e2edfbe8 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -114,7 +114,7 @@ module clsm_ensupd_enkf_update use LDAS_ensdrv_mpi, ONLY: & MPI_cat_param_type, & MPI_cat_progn_type, & - master_proc, & + root_proc, & numprocs, & myid, & mpierr, & @@ -400,9 +400,9 @@ subroutine get_enkf_increments( & ! ! Get additional grid/tile information that is needed to map obs ! from lat/lon to tiles. This needs to be done: - ! - by master process (because of call to read_obs() in collect_obs()) + ! - by root process (because of call to read_obs() in collect_obs()) ! - by all processes if FOV>~0 ("tile_num_in_circle" needed in get_obs_pred()) - if ( (master_proc) .or. & + if ( (root_proc) .or. & (any(obs_param(1:N_obs_param)%FOV>FOV_threshold)) ) then allocate(N_tile_in_cell_ij_f(tile_grid_f%N_lon,tile_grid_f%N_lat)) @@ -695,7 +695,7 @@ subroutine get_enkf_increments( & end do call MPI_Gather(nTiles_l,1,MPI_INTEGER, & nTilesl_vec,1,MPI_INTEGER,0,mpicomm,mpierr) - if (master_proc) nTiles_f = sum(nTilesl_vec) + if (root_proc) nTiles_f = sum(nTilesl_vec) call MPI_Bcast(nTiles_f,1,MPI_INTEGER,0,mpicomm,mpierr) if (logit) then write (tmpstr12,'(i12)') nTiles_f ! convert integer to string @@ -704,8 +704,8 @@ subroutine get_enkf_increments( & end if ! Step 2b: indTiles_l -> indTiles_f (on root) - if (master_proc) allocate(indTiles_f(nTiles_f), source=-99) - if (master_proc) then + if (root_proc) allocate(indTiles_f(nTiles_f), source=-99) + if (root_proc) then tmp_low_ind(1) = 1 do iproc=1,numprocs-1 tmp_low_ind(iproc+1) = tmp_low_ind(iproc) + nTilesl_vec(iproc) @@ -741,12 +741,12 @@ subroutine get_enkf_increments( & ! Step 2d: indTiles_ana -> indTilesAna_vec (on root) ! root needs indTiles_ana from each proc to distribute cat_param, cat_progn etc. - if (master_proc) then + if (root_proc) then do iproc=1,numprocs allocate(indTilesAna_vec(iproc)%ind(nTilesAna_vec(iproc))) end do end if - if (master_proc) then + if (root_proc) then indTilesAna_vec(1)%ind = indTiles_ana ! copy contribution from root do src=1,numprocs-1 recvct = nTilesAna_vec(src+1) @@ -764,8 +764,8 @@ subroutine get_enkf_increments( & ! Step 2: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 2 time taken (create indTiles_ana): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 2 time taken (create indTiles_ana): ', & ' max =', tmax, ', min =', tmin ! Step 3a: for each proc create nObs_ana, indObs_ana and Obs_ana @@ -794,18 +794,18 @@ subroutine get_enkf_increments( & ! Step 3b: nObs_ana -> nObsAna_vec (on root) call MPI_Gather(nObs_ana,1,MPI_INTEGER, & nObsAna_vec,1,MPI_INTEGER,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,I7,A,I7)') & + if (root_proc .and. logit) write (logunit,'(2A,I7,A,I7)') & 'AnaLoadBal: nObs_ana statistics: ', & 'max =', maxval(nObsAna_vec), ', min =', minval(nObsAna_vec) ! Step 3c: indObs_ana -> indObsAna_vec (on root) ! root needs indObs_ana from each proc (to distribute Obs_pred_l) - if (master_proc) then + if (root_proc) then do iproc=1,numprocs allocate(indObsAna_vec(iproc)%ind(nObsAna_vec(iproc))) end do end if - if (master_proc) then + if (root_proc) then indObsAna_vec(1)%ind = indObs_ana(1:nObs_ana) ! copy contribution from root do src=1,numprocs-1 recvct = nObsAna_vec(src+1) @@ -824,8 +824,8 @@ subroutine get_enkf_increments( & ! Step 3: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 3 time taken (create indObs_ana): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 3 time taken (create indObs_ana): ', & ' max =', tmax, ', min =', tmin !-AnaLodaBal-decomposition-ends-here @@ -841,13 +841,13 @@ subroutine get_enkf_increments( & tile_coord_ana = tile_coord_f(indTiles_ana) ! Step 4c: cat_param(N_catl) -> cat_param_f (on root) -> cat_param_ana - if (master_proc) allocate(cat_param_f(N_catf)) + if (root_proc) allocate(cat_param_f(N_catf)) call MPI_Gatherv( & cat_param, N_catl, MPI_cat_param_type, & cat_param_f, N_catl_vec, low_ind-1, MPI_cat_param_type, & 0, mpicomm, mpierr ) allocate(cat_param_ana(nTiles_ana)) - if (master_proc) then + if (root_proc) then cat_param_ana = cat_param_f(indTilesAna_vec(1)%ind) do dest=1,numprocs-1 sendtag = dest @@ -867,7 +867,7 @@ subroutine get_enkf_increments( & ! Step 4d: cat_progn -> cat_progn_f (on root) -> cat_progn_ana ! one ensemble at a time - if (master_proc) allocate(cat_progn_f(N_catf)) + if (root_proc) allocate(cat_progn_f(N_catf)) allocate(cat_progn_ana(nTiles_ana,N_ens)) allocate(tmp_cat_progn_ana(nTiles_ana)) ! CSD-BUGFIX @@ -877,7 +877,7 @@ subroutine get_enkf_increments( & cat_progn(:,iEns), N_catl, MPI_cat_progn_type, & cat_progn_f, N_catl_vec, low_ind-1, MPI_cat_progn_type, & 0, mpicomm, mpierr ) - if (master_proc) then + if (root_proc) then cat_progn_ana(:,iEns) = cat_progn_f(indTilesAna_vec(1)%ind) do dest=1, numprocs-1 sendtag = dest @@ -914,9 +914,9 @@ subroutine get_enkf_increments( & ! Step 4e: Obs_pred_l (obs%assim=.true.) -> Obs_pred_f_assim (on root) -> Obs_pred_ana ! one ensemble at a time - if (master_proc) allocate(Obs_pred_f_assim(N_obsf_assim)) + if (root_proc) allocate(Obs_pred_f_assim(N_obsf_assim)) allocate(Obs_pred_ana(nObs_ana,N_ens), source=0.) - if (master_proc) then + if (root_proc) then tmp_low_ind(1) = 1 do iproc=1,numprocs-1 tmp_low_ind(iproc+1) = tmp_low_ind(iproc) + N_obsl_assim_vec(iproc) @@ -929,7 +929,7 @@ subroutine get_enkf_increments( & Obs_pred_f_assim, N_obsl_assim_vec, tmp_low_ind-1, MPI_REAL, & 0, mpicomm, mpierr ) ! Obs_pred_f_assim (on root) -> Obs_pred_ana - if (master_proc) then + if (root_proc) then ! copy Obs_pred_ana for root Obs_pred_ana(:,iEns) = Obs_pred_f_assim(indObsAna_vec(1)%ind) ! communicate @@ -956,8 +956,8 @@ subroutine get_enkf_increments( & ! Step 4: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 4 time taken (distribute inputs): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 4 time taken (distribute inputs): ', & ' max =', tmax, ', min =', tmin !-AnaLoadBal-Input-Distribution-ends-here @@ -1046,8 +1046,8 @@ subroutine get_enkf_increments( & ! cat_enkf_incr timinig info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'Time taken by cat_enkf_increments: ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'Time taken by cat_enkf_increments: ', & ' max =', tmax, ', min =', tmin #else ! NOTE: make sure to pass into cat_enkf_increments() only the @@ -1073,13 +1073,13 @@ subroutine get_enkf_increments( & ! cat_progn_incr_ana -> cat_progn_incr_f -> cat_progn_incr ! WE PROBABLY SHOULD DO AWAY WITH recvBuf call cpu_time(t_start) - if (master_proc) then + if (root_proc) then allocate(cat_progn_incr_f(N_catf)) allocate(recvBuf(maxval(nTilesAna_vec))) ! temp storage of incoming data end if do iEns=1,N_ens ! cat_progn_incr_ana -> cat_progn_incr_f - if (master_proc) then + if (root_proc) then do iTile=1,N_catf ! cannot do cat_progn_incr_f = 0. cat_progn_incr_f(iTile) = 0. ! initialize end do @@ -1114,8 +1114,8 @@ subroutine get_enkf_increments( & ! Step 5: timing info call MPI_Reduce(t_end-t_start,tmax,1,MPI_REAL,MPI_MAX,0,mpicomm,mpierr) call MPI_Reduce(t_end-t_start,tmin,1,MPI_REAL,MPI_MIN,0,mpicomm,mpierr) - if (master_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & - 'AnaLoadBal: Step 5 time taken (collect increments): ', & + if (root_proc .and. logit) write (logunit,'(2A,ES10.3,A,ES10.3)') & + 'AnaLoadBal: Step 5 time taken (collect increments): ', & ' max =', tmax, ', min =', tmin !-AnaLoadBal-Output-Collection-ends-here- #endif @@ -1448,7 +1448,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & #endif - if (master_proc) then + if (root_proc) then N_obsf = sum(N_obsl_vec) @@ -1481,7 +1481,7 @@ subroutine output_ObsFcstAna(date_time, work_path, exp_id, & ! ! write to file - if (master_proc) then + if (root_proc) then #ifdef LDAS_MPI @@ -1739,7 +1739,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & !! file_tag = 'ldas_incr' !! dir_name = 'ana' !! -!! if (master_proc) allocate(cat_progn_incr_f(N_catf)) +!! if (root_proc) allocate(cat_progn_incr_f(N_catf)) !! !!#ifdef LDAS_MPI !! @@ -1751,7 +1751,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & !!#else !! cat_progn_incr_f = cat_progn_incr_ensavg !!#endif -!! if (master_proc) then +!! if (root_proc) then !! !! !! select case (out_incr_format) @@ -1805,7 +1805,7 @@ subroutine output_incr_etc( out_ObsFcstAna, & !! !! deallocate(cat_progn_incr_f) !! -!! end if ! masterproc +!! end if ! root_proc !! !! end if ! out_incr @@ -1853,7 +1853,7 @@ subroutine output_smapL4SMaup( date_time, work_path, exp_id, dtstep_assim, & integer, dimension(N_catl), intent(in) :: l2f ! N_tile_in_cell_ij and tile_num_in_cell_ij are on the "full" domain - ! and guaranteed to be allocated ONLY for the master_proc + ! and guaranteed to be allocated ONLY for the root_proc ! (but may be allocated on all processors depending on obs_param%FOV) integer, dimension(:,:), pointer :: N_tile_in_cell_ij_f ! input @@ -2098,7 +2098,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & ! ! assemble file name and open file - if (master_proc) then + if (root_proc) then fname = get_io_filename( './', exp_id, file_tag, & date_time=date_time, dir_name=dir_name, ens_id=-1, no_subdirs=.true.) @@ -2143,7 +2143,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & #endif - if (master_proc) then + if (root_proc) then N_obsf = sum(N_obsl_vec) @@ -2174,7 +2174,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & ! ----------------------------------------------------- - if (master_proc) then + if (root_proc) then ! determine mapping from Observations vector onto global 9 km EASE grid @@ -2804,7 +2804,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & deallocate(data_h_9km_tile) deallocate(data_v_9km_tile) - end if ! master_proc + end if ! root_proc end if ! (option=='orig_obs' .or. option=='obs_fcst') @@ -2889,7 +2889,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, & tile_mean_l(:,k), tile_data_f) - if (master_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) + if (root_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) end do @@ -2910,7 +2910,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & call l2f_real( N_catl, N_catf, N_catl_vec, low_ind, & tile_std_l(:,k), tile_data_f) - if (master_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) + if (root_proc) write(unitnum) (tile_data_f(n), n=1,N_catf) end do @@ -2924,7 +2924,7 @@ subroutine write_smapL4SMaup( option, date_time, work_path, exp_id, N_ens, & ! ! close output file - if (master_proc) close(unitnum,status='keep') + if (root_proc) close(unitnum,status='keep') end subroutine write_smapL4SMaup diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 index d25edb88..3e759c5c 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 @@ -21,11 +21,11 @@ module clsm_ensupd_read_obs use io_hdf5, ONLY: & hdf5read - use LDAS_ease_conv, ONLY: & + use LDAS_ease_conv, ONLY: & easeV2_convert, & easeV2_extent - use LDAS_ensdrv_globals, ONLY: & + use LDAS_ensdrv_globals, ONLY: & logit, & logunit, & nodata_tolfrac_generic @@ -33,7 +33,7 @@ module clsm_ensupd_read_obs use clsm_ensupd_glob_param, ONLY: & unitnum_obslog - use LDAS_DateTimeMod, ONLY: & + use LDAS_DateTimeMod, ONLY: & date_time_type, & augment_date_time, & get_dofyr_pentad, & @@ -46,7 +46,7 @@ module clsm_ensupd_read_obs obs_type, & obs_param_type - use LDAS_TilecoordType, ONLY: & + use LDAS_TilecoordType, ONLY: & tile_coord_type, & grid_def_type @@ -55,17 +55,17 @@ module clsm_ensupd_read_obs f2l_real8, & f2l_logical - use LDAS_TilecoordRoutines, ONLY: & + use LDAS_TilecoordRoutines, ONLY: & get_tile_num_from_latlon use LDAS_ensdrv_mpi, ONLY: & - master_proc, & + root_proc, & numprocs, & - mpicomm, & + mpicomm, & MPI_obs_type, & mpierr - use LDAS_exceptionsMod, ONLY: & + use LDAS_exceptionsMod, ONLY: & ldas_abort, & ldas_warn, & LDAS_GENERIC_ERROR, & @@ -6454,7 +6454,7 @@ subroutine turn_off_assim_SMAP_L1CTb(N_obs_param, obs_param, N_obsl, Observation #endif - if (master_proc) then + if (root_proc) then N_obsf = sum(N_obsl_vec) @@ -6499,7 +6499,7 @@ subroutine turn_off_assim_SMAP_L1CTb(N_obs_param, obs_param, N_obsl, Observation mask_v_A = .false. ! initialize mask_v_D = .false. ! initialize - if (master_proc) then + if (root_proc) then ! mask for H-pol ascending @@ -6591,7 +6591,7 @@ subroutine turn_off_assim_SMAP_L1CTb(N_obs_param, obs_param, N_obsl, Observation deallocate(Observations_f) - end if ! (master_proc) + end if ! (root_proc) ! MPI broadcast masks @@ -6904,7 +6904,7 @@ subroutine read_obs( & ! read observations and optionally scale observations to model clim ! - ! intended to be called by master_proc + ! intended to be called by root_proc ! 10 Jun 2011 - removed model-based QC for MPI re-structuring (now done ! in connection with get_obs_pred()) @@ -8115,7 +8115,7 @@ subroutine collect_obs( type(grid_def_type), intent(in) :: tile_grid_f ! N_tile_in_cell_ij and tile_num_in_cell_ij are on the "full" domain - ! and guaranteed to be allocated ONLY for the master_proc + ! and guaranteed to be allocated ONLY for the root_proc ! (but may be allocated on all processors depending on obs_param%FOV) integer, dimension(:,:), pointer :: N_tile_in_cell_ij_f ! input @@ -8187,7 +8187,7 @@ subroutine collect_obs( call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'something wrong') end if - if (master_proc) then + if (root_proc) then ! subroutine read_obs() reads all observations in obs files ! (typically global) and returns a vector in (full domain) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 index 02f3d548..0658ad67 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 @@ -18,9 +18,9 @@ module LDAS_PertRoutinesMod use ESMF use MAPL_Mod - use LDAS_ensdrv_Globals, ONLY: & + use LDAS_ensdrv_Globals, ONLY: & logunit, & - master_logit, & + root_logit, & nodata_generic, & nodata_tolfrac_generic, & nodata_tol_generic @@ -35,7 +35,7 @@ module LDAS_PertRoutinesMod grid_def_type, & io_grid_def_type - use LDAS_TileCoordRoutines, ONLY: & + use LDAS_TileCoordRoutines, ONLY: & LDAS_create_grid_g, & get_ij_ind_from_latlon @@ -294,7 +294,7 @@ subroutine read_ens_prop_inputs( & ! MPI variables type(ESMF_VM) :: vm integer :: mpicomm - logical :: master_proc,f_exist + logical :: root_proc,f_exist ! ----------------------------------------------------------------- @@ -333,7 +333,7 @@ subroutine read_ens_prop_inputs( & VERIFY_(status) call ESMF_VmGet(vm, mpicommunicator=mpicomm, rc=status) VERIFY_(status) - master_proc = MAPL_Am_I_Root(vm) + root_proc = MAPL_Am_I_Root(vm) ! --------------------------------------------------------------------- ! @@ -359,7 +359,7 @@ subroutine read_ens_prop_inputs( & if (present(kw_echo)) then if (kw_echo) then - if(master_logit) then + if(root_logit) then write (logunit,*) write (logunit,'(400A)') 'reading *default* ens prop inputs from ' // trim(fname) write (logunit,*) @@ -380,7 +380,7 @@ subroutine read_ens_prop_inputs( & if (present(kw_echo)) then if (kw_echo) then - if(master_logit) then + if(root_logit) then write (logunit,*) write (logunit,'(400A)') 'reading *SPECIAL* ens prop inputs from ' // trim(fname) write (logunit,*) @@ -401,7 +401,7 @@ subroutine read_ens_prop_inputs( & ! echo variables of ens_prop_inputs - if (present(kw_echo) .and. master_logit) then + if (present(kw_echo) .and. root_logit) then if (kw_echo) then write (logunit,*) 'ens_prop inputs are:' @@ -424,7 +424,7 @@ subroutine read_ens_prop_inputs( & do i=1,N_ens kw_ens_id(i) = first_ens_id + i - 1 end do - if(master_logit) then + if(root_logit) then write (logunit,*) write (logunit,*) 'ens_id = ', (kw_ens_id(i), i=1,N_ens) write (logunit,*) @@ -511,8 +511,8 @@ subroutine read_ens_prop_inputs( & fname = get_io_filename( work_path, exp_id, file_tag, date_time=date_time, & dir_name=dir_name, file_ext=file_ext ) - if(master_logit) write (logunit,'(400A)') 'writing ens prop inputs to ' // trim(fname) - if(master_logit) write (logunit,*) + if(root_logit) write (logunit,'(400A)') 'writing ens prop inputs to ' // trim(fname) + if(root_logit) write (logunit,*) open(10, file=fname, status='unknown', action='write', & delim='apostrophe') @@ -996,7 +996,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! MPI variables type(ESMF_VM) :: vm integer :: mpicomm, numprocs, myid, mpierr - logical :: master_proc + logical :: root_proc ! ----------------------------------------------------------------- @@ -1004,13 +1004,13 @@ subroutine get_force_pert_inputs( pert_grid_l, & VERIFY_(status) call ESMF_VMGet(VM, petCount=numprocs, localPet=myid, mpiCommunicator=mpicomm, rc=status) VERIFY_(status) - master_proc = MAPL_Am_I_Root(vm) + root_proc = MAPL_Am_I_Root(vm) ! --------- ! ! DESCR - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_descr_force_pert=tmp_force_pert_character) @@ -1029,7 +1029,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ! ZEROMEAN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_zeromean_force_pert=tmp_force_pert_logical) @@ -1045,7 +1045,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ! COARSEN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_coarsen_force_pert=tmp_force_pert_logical) @@ -1063,7 +1063,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! obtain (default) homogeneous std of forcing perturbations - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_force_pert=tmp_force_pert_real) @@ -1086,7 +1086,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! find out whether std_force_pert should be read from file - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_stdfromfile_force_pert=tmp_force_pert_logical) @@ -1104,7 +1104,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! find out name (incl full path) of file with std value - if (master_proc) & + if (root_proc) & call read_ens_prop_inputs( & kw_stdfilename_force_pert = stdfilename_force_pert & ) @@ -1177,7 +1177,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! PC: instead of reading one param (and broadcasting it) at a time, it ! will be better to read them all and broadcast at one go - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_normal_max_force_pert=tmp_force_pert_real) @@ -1192,7 +1192,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_xcorr_force_pert=tmp_force_pert_real) @@ -1206,7 +1206,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ycorr_force_pert=tmp_force_pert_real) @@ -1220,7 +1220,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_tcorr_force_pert=tmp_force_pert_real) @@ -1234,7 +1234,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_typ_force_pert=tmp_force_pert_real) @@ -1253,7 +1253,7 @@ subroutine get_force_pert_inputs( pert_grid_l, & ! (see subroutine read_ens_prop_inputs) ! now fill in the rest of the information (diagonal=1 and symmetry) - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ccorr_force_pert=tmp_force_pert_ccorr) @@ -1387,7 +1387,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! MPI variables type(ESMF_VM) :: vm integer :: mpicomm, numprocs, myid, mpierr - logical :: master_proc + logical :: root_proc ! ----------------------------------------------------------------- @@ -1395,13 +1395,13 @@ subroutine get_progn_pert_inputs( pert_grid_l, & VERIFY_(status) call ESMF_VMGet(VM, petCount=numprocs, localPet=myid, mpiCommunicator=mpicomm, rc=status) VERIFY_(status) - master_proc = MAPL_Am_I_Root(vm) + root_proc = MAPL_Am_I_Root(vm) ! ------- ! ! DESCR - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_descr_progn_pert=tmp_progn_pert_character) @@ -1420,7 +1420,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ! ZEROMEAN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_zeromean_progn_pert=tmp_progn_pert_logical) @@ -1436,7 +1436,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ! COARSEN - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_coarsen_progn_pert=tmp_progn_pert_logical) @@ -1454,7 +1454,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ! obtain (default) homogeneous std of forcing perturbations - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_progn_pert=tmp_progn_pert_real) @@ -1477,7 +1477,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! find out whether std_progn_pert should be read from file - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_stdfromfile_progn_pert=tmp_progn_pert_logical) @@ -1496,7 +1496,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! find out name (incl full path) of file with std value - if (master_proc) & + if (root_proc) & call read_ens_prop_inputs( & kw_stdfilename_progn_pert = stdfilename_progn_pert & ) @@ -1566,7 +1566,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! homogeneous (ie same for all catchments, unlike std_progn_pert) ! typ_progn_pert must also be homogeneous - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_std_normal_max_progn_pert=tmp_progn_pert_real) @@ -1581,7 +1581,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_xcorr_progn_pert=tmp_progn_pert_real) @@ -1595,7 +1595,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ycorr_progn_pert=tmp_progn_pert_real) @@ -1609,7 +1609,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_tcorr_progn_pert=tmp_progn_pert_real) @@ -1623,7 +1623,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! ---------- - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_typ_progn_pert=tmp_progn_pert_real) @@ -1642,7 +1642,7 @@ subroutine get_progn_pert_inputs( pert_grid_l, & ! (see subroutine read_ens_prop_inputs) ! now fill in the rest of the information (diagonal=1 and symmetry) - if (master_proc) then + if (root_proc) then call read_ens_prop_inputs(kw_echo=.false., & kw_ccorr_progn_pert=tmp_progn_pert_ccorr) @@ -1985,7 +1985,7 @@ subroutine echo_pert_param( N_pert, pert_param, ind_i, ind_j ) ! ------------------------------------------------------------- - if (master_logit) then + if (root_logit) then write (logunit,*) 'echo_pert_param():' do m=1,N_pert @@ -2013,7 +2013,7 @@ subroutine echo_pert_param( N_pert, pert_param, ind_i, ind_j ) end do end do - endif ! master_logit + endif ! root_logit end subroutine echo_pert_param !************************************************************* @@ -2088,7 +2088,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & file_tag, date_time=date_time, & dir_name=dir_name, ens_id=ens_id, file_ext=file_ext ) -!!$ if (master_proc) then +!!$ if (root_proc) then inquire(file=filename,exist=file_exists) if(.not. file_exists) then write (6,'(400A)') & @@ -2106,7 +2106,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & !!$ call MPI_Bcast(istat, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, mpierr) !!$#endif -!!$ if (master_proc) then +!!$ if (root_proc) then write (6,'(400A)') & 'Reading pert restart file ' // trim(filename) @@ -2171,7 +2171,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & do k=1,N_force_pert -!!$ if (master_proc) then +!!$ if (root_proc) then read (10) ((Pert_ntrmdt_f(i,j), i=1,pert_grid_f%N_lon), & j=1,pert_grid_f%N_lat) @@ -2187,7 +2187,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & do k=1,N_progn_pert -!!$ if (master_proc) then +!!$ if (root_proc) then read (10) ((Pert_ntrmdt_f(i,j), i=1,pert_grid_f%N_lon), & j=1,pert_grid_f%N_lat) Progn_pert_ntrmdt_g(xstart:xend, ystart:yend,k) = Pert_ntrmdt_f(:,:) @@ -2214,7 +2214,7 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & end select -!! if (master_proc) close (10,status='keep') +!! if (root_proc) close (10,status='keep') close (10,status='keep') end subroutine io_pert_rstrt diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 index 6082d52d..9e911413 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 @@ -46,7 +46,7 @@ module land_pert_routines use LDAS_ExceptionsMod, ONLY: & ldas_abort, & LDAS_GENERIC_ERROR - use LDAS_ensdrv_Globals, only: master_logit,logunit + use LDAS_ensdrv_Globals, only: root_logit,logunit implicit none @@ -1551,7 +1551,7 @@ subroutine assemble_forcepert_param( N_x, N_y, & ! echo part of forcepert_param (mean, std, and ccorr for i=1, j=1 only): - if(master_logit) then + if(root_logit) then do i=1,N_forcepert write (logunit,*) 'forcepert_param(',i,')%descr=', & @@ -1582,7 +1582,7 @@ subroutine assemble_forcepert_param( N_x, N_y, & forcepert_param(i)%ccorr(j,1,1) end do end do - endif ! master_logit + endif ! root_logit diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index f91a66cf..631a9767 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -10,7 +10,7 @@ module GEOS_MetforceGridCompMod use MAPL_Mod use LDAS_ensdrv_Globals, only: nodata_generic, nodata_tol_generic - use LDAS_ensdrv_Globals, only: logunit,master_logit,logit + use LDAS_ensdrv_Globals, only: logunit,logit !,root_logit use LDAS_DateTimeMod, only: date_time_type, date_time_print use LDAS_TileCoordType, only: tile_coord_type use LDAS_TileCoordType, only: T_TILECOORD_STATE @@ -936,7 +936,7 @@ subroutine Run(gc, import, export, clock, rc) call LDAS_move_new_force_to_old(internal%mf%DataNxt,internal%mf%DataPrv, & MERRA_file_specs,GEOS_Forcing,AEROSOL_DEPOSITION) - !if(master_logit) write(logunit,*) trim(Iam)//'::force_time_nxt: ', date_time_print(force_time_nxt) + !if(root_logit) write(logunit,*) trim(Iam)//'::force_time_nxt: ', date_time_print(force_time_nxt) ! -compute-average-zenith-angle-over-daylight-part-of-forcing-interval- call MAPL_SunGetInsolation( & @@ -968,7 +968,7 @@ subroutine Run(gc, import, export, clock, rc) end if - !if(master_logit) write(logunit,*) trim(Iam)//'::zenav max/min: ', maxval(internal%mf%zenav), minval(internal%mf%zenav) + !if(root_logit) write(logunit,*) trim(Iam)//'::zenav max/min: ', maxval(internal%mf%zenav), minval(internal%mf%zenav) !if(logit) write(logunit,*) trim(Iam)//'::zenav max/min: ', maxval(internal%mf%zenav), minval(internal%mf%zenav) ! Compute zenith angle at the next time step @@ -997,7 +997,7 @@ subroutine Run(gc, import, export, clock, rc) RETURN_(ESMF_FAILURE) end if - !if(master_logit) write(logunit,*) trim(Iam)//'::zth max/min: ', maxval(zth), minval(zth) + !if(root_logit) write(logunit,*) trim(Iam)//'::zth max/min: ', maxval(zth), minval(zth) ! -convert-mf%TimePrv-to-LDAS-datetime- call esmf2ldas(internal%mf%TimePrv, force_time_prv, rc=status) @@ -1006,9 +1006,9 @@ subroutine Run(gc, import, export, clock, rc) ! -convert-ModelTimeNxt-to-LDAS-datetime- call esmf2ldas(ModelTimeNxt, model_time_nxt, rc=status) - !if(master_logit) write(logunit,*) trim(Iam)//'::force_time_prv: ', date_time_print(force_time_prv) + !if(root_logit) write(logunit,*) trim(Iam)//'::force_time_prv: ', date_time_print(force_time_prv) - !if(master_logit) write(logunit,*) trim(Iam)//'::model_time_nxt: ', date_time_print(model_time_nxt) + !if(root_logit) write(logunit,*) trim(Iam)//'::model_time_nxt: ', date_time_print(model_time_nxt) ! Allocate memory for interpolated MetForcing data mf_nodata = nodata_generic @@ -1031,7 +1031,7 @@ subroutine Run(gc, import, export, clock, rc) rc=status & ) VERIFY_(status) - !if(master_logit) write(logunit,*) trim(Iam)//'::mf_ntp%tair max/min: ', maxval(mfDataNtp%Tair), minval(mfDataNtp%Tair) + !if(root_logit) write(logunit,*) trim(Iam)//'::mf_ntp%tair max/min: ', maxval(mfDataNtp%Tair), minval(mfDataNtp%Tair) ! Pointers to exports (allocate memory) call MAPL_GetPointer(export, Tair, 'Tair', alloc=.true., rc=status) diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 index 0eddac4a..882b5ef2 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/LDAS_Forcing.F90 @@ -14,7 +14,7 @@ module LDAS_ForceMod use LDAS_ensdrv_Globals, ONLY: & logunit, & logit, & - master_logit, & + root_logit, & nodata_generic, & nodata_tol_generic, & nodata_tolfrac_generic @@ -333,7 +333,7 @@ subroutine get_forcing( date_time, force_dtstep, met_path, met_tag, & else ! assume forcing from GEOS5 GCM ("DAS" or "MERRA") output - if(master_logit) write (logunit,*) 'get_forcing(): assuming GEOS-5 forcing data set' + if(root_logit) write (logunit,*) 'get_forcing(): assuming GEOS-5 forcing data set' GEOS_forcing = .true. @@ -781,7 +781,7 @@ subroutine get_Berg_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(berg_dir(berg_var)) // '/' // YYYY & // '/' // trim(berg_name(berg_var)) // '.' // YYYY // MM // '.nc' - if(master_logit) write(logunit,*) 'get netcdf compression params from ' // trim(fname) + if(root_logit) write(logunit,*) 'get netcdf compression params from ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -806,7 +806,7 @@ subroutine get_Berg_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(berg_dir(berg_var)) // '/' // YYYY & // '/' // trim(berg_name(berg_var)) // '.' // YYYY // MM // '.nc' - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -1031,7 +1031,7 @@ subroutine get_RedArk_ASCII(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // '/' // YYYY // '/' & // 'red_ark_forc' // '.' // YYYY // '.' // DDD // '.' // HH - if(master_logit) write(logunit,*) 'opening ' // trim(fname) + if(root_logit) write(logunit,*) 'opening ' // trim(fname) open(10, file=fname, form='formatted', action='read', status='old') @@ -1249,7 +1249,7 @@ subroutine get_RedArk_GOLD(date_time, met_path, N_catd, tile_coord, & // trim(RedArk_GOLD_name(this_var)) // '_RedArk_' // & YYYY // MM // DD // '_' // HHMM - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) open(10,file=fname,form='formatted',action='read') @@ -1450,7 +1450,7 @@ subroutine get_RedArk_Princeton(date_time, met_path, N_catd, tile_coord, & // trim(RedArk_Princeton_name(this_var)) // '_RedArk_' // & YYYY // MM // DD // '_' // HHMM - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) open(10,file=fname,form='formatted',action='read') @@ -1664,7 +1664,7 @@ subroutine get_Princeton_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // '/' // trim(Princeton_name(Princeton_var)) & // '_3hourly_' // YYYY // '-' // YYYY // '.nc' - if(master_logit) write(logunit,*) 'opening' // trim(fname) + if(root_logit) write(logunit,*) 'opening' // trim(fname) ierr = NF_OPEN(fname, NF_NOWRITE, ncid) @@ -1847,7 +1847,7 @@ subroutine get_conus_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // '/' // YYYY//'-'//MM//'.nc' - if(master_logit) write (logunit,*) 'opening' // trim(fname) + if(root_logit) write (logunit,*) 'opening' // trim(fname) ierr = NF_OPEN(fname, NF_NOWRITE, ncid) @@ -2061,7 +2061,7 @@ subroutine get_GLDAS_2x2_5_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(gldas_name(gldas_var)) // '/' // YYYY & // '/' // trim(gldas_name(gldas_var)) // '.' // YYYY // MM // '.nc' - if(master_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) + if(root_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -2087,7 +2087,7 @@ subroutine get_GLDAS_2x2_5_netcdf(date_time, met_path, N_catd, tile_coord, & // '/' // trim(gldas_name(gldas_var)) // '.' // YYYY // MM // & '.nc' - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -2355,7 +2355,7 @@ subroutine get_Viviana_OK_precip(unitnumber, date_time, met_path, met_tag, & ! !if (present(ens_id)) unitnumber = unitnumber + ens_id - if(master_logit) write (logunit,*) 'opening ', trim(fname) + if(root_logit) write (logunit,*) 'opening ', trim(fname) open(unitnumber, file=fname, form='formatted', action='read', status='old') @@ -3007,7 +3007,7 @@ subroutine get_GEOS(date_time, force_dtstep, & (j==1) .and. & (tmp_init) .and. & (trim(GEOSgcm_defs(GEOSgcm_var,2))=='tavg') .and. & - (master_logit) ) then + (root_logit) ) then if (.not. MERRA_file_specs) write (logunit,'(400A)') & 'NOTE: Initialization. Data from tavg file are not used ' // & @@ -3759,7 +3759,7 @@ subroutine parse_MERRA_met_tag( met_path_in, met_tag_in, date_time, & !!end if ! ! The above fix did not work in MPI because subroutine get_forcing() is - ! only called by the master process. All other processes are unaware of + ! only called by the root process. All other processes are unaware of ! any changes to "ignore_SWnet_for_snow" from its uninitialized value ! because an MPI broadcast was missing. ! As of April 2015, "ignore_SWnet_for_snow" is no longer meaningful. @@ -4568,7 +4568,7 @@ subroutine get_GEOS_forcing_filename(fname_full,file_exists, date_time, daily_fi ! if no file was found, report file names that were tried if (.not. file_exists) then - if(master_logit) then + if(root_logit) then print '(400A)', trim(Iam) // ': Could not find any of the following files:' print '(400A)', trim(fname_full_tmp1) print '(400A)', trim(fname_full_tmp2) @@ -4622,7 +4622,7 @@ subroutine GEOS_openfile(FileOpenedHash, fname_full, fid, tile_coord, m_hinterp, if( fid == -9999 ) then ! not open yet ierr=nf90_open(fname_full,NF90_NOWRITE, fid) - if(master_logit) then + if(root_logit) then write(logunit,'(400A)') "opening file: "//trim(fname_full) endif ASSERT_( ierr == nf90_noerr) @@ -4905,7 +4905,7 @@ subroutine get_GEOS_corr_prec_filename(fname_full,file_exists, date_time, met_pa ! if no file was found, report file names that were tried if( .not. file_exists ) then - if(master_logit) then + if(root_logit) then print '(400A)', trim(Iam) // ': Could not find any of the following files:' print '(400A)', trim(fname_full_tmp1) print '(400A)', trim(fname_full_tmp2) @@ -5108,7 +5108,7 @@ subroutine get_GSWP2_1x1_netcdf(date_time, met_path, N_catd, tile_coord, & fname = trim(met_path) // trim(gswp2_name(gswp2_var)) // '/' & // '/' // trim(gswp2_name(gswp2_var)) // YYYY // MM // '.nc' - if(master_logit) write (logunit,*) 'opening ' // trim(fname) + if(root_logit) write (logunit,*) 'opening ' // trim(fname) ierr = NF_OPEN(fname,NF_NOWRITE,ncid) @@ -5123,7 +5123,7 @@ subroutine get_GSWP2_1x1_netcdf(date_time, met_path, N_catd, tile_coord, & if (gswp2_var == 1) then - if(master_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) + if(root_logit) write (logunit,*) 'get netcdf compression params from ' // trim(fname) if (ierr/=0) then err_msg = 'error opening netcdf file' @@ -5345,7 +5345,7 @@ subroutine check_forcing_nodata_2( N_catd, tile_coord, nodata_forcing, force_vec else if (abs(force_vec(i_next)-nodata_forcing)>tol) then - if(master_logit) write (logunit,*) 'forcing has no-data-value in tile ID = ', & + if(root_logit) write (logunit,*) 'forcing has no-data-value in tile ID = ', & tile_coord(i)%tile_id force_vec(i)=force_vec(i_next) else @@ -5364,8 +5364,8 @@ subroutine check_forcing_nodata_2( N_catd, tile_coord, nodata_forcing, force_vec end do if (create_blacklist) then - if(master_logit) write (logunit,*) '---------------------------------------------------------------' - if(master_logit) write (logunit,*) ' found N_black = ',N_black, ' tiles that should be blacklisted' + if(root_logit) write (logunit,*) '---------------------------------------------------------------' + if(root_logit) write (logunit,*) ' found N_black = ',N_black, ' tiles that should be blacklisted' err_msg = 'blacklist now in file fort.9999' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if @@ -5413,7 +5413,7 @@ type(date_time_type) function shift_forcing_date( met_tag, date_time ) tmpstring300 = 'shift_forcing_date(): Are you sure? ' // & 'If so, edit source code and recompile.' - if(master_logit) write (logunit,*) tmpstring300 + if(root_logit) write (logunit,*) tmpstring300 write(0,*) tmpstring300 stop diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 index 822769ff..94240807 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_RepairForcing.F90 @@ -6,7 +6,7 @@ module RepairForcingMod use MAPL_SatVaporMod, only: MAPL_EQsat use LDAS_ensdrv_Globals, only: logunit, LDAS_is_nodata use MAPL_ConstantsMod, only: stefan_boltzmann=>MAPL_STFBOL - use LDAS_ensdrv_Globals, only: master_logit + use LDAS_ensdrv_Globals, only: root_logit implicit none private @@ -161,7 +161,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Rainf ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Rainf < 0. in tile ID ' // & tile_id_str // ': met_force(i)%Rainf = ' // tmpstr13a @@ -179,7 +179,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Rainf_C ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Rainf_C < 0. in tile ID ' //& tile_id_str // ': met_force(i)%Rainf_C = ' // tmpstr13a @@ -196,7 +196,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Rainf ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%Rainf_C ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Rainf < Rainf_C in tile ID ' // & tile_id_str // ': met_force(i)%Rainf = ' // tmpstr13a // & ', met_force(i)%Rainf_C = ' // tmpstr13b @@ -215,7 +215,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Snowf ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Snowf < 0. in tile ID ' //& tile_id_str // ': met_force(i)%Snowf = ' // tmpstr13a @@ -240,7 +240,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Tair ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: Tair < '//min_Tair_string//' in tile ID ' // & tile_id_str // ': met_force(i)%Tair = ' // tmpstr13a @@ -253,7 +253,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Tair ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: Tair > '//max_Tair_string//' in tile ID ' // & tile_id_str // ': met_force(i)%Tair = ' // tmpstr13a @@ -274,7 +274,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%PSurf ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: Psurf > '//max_PSurf_string//' in tile ID ' // & tile_id_str // ': met_force(i)%PSurf = ' // tmpstr13a @@ -295,7 +295,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Qair ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Qair < 0. in tile ID ' // & tile_id_str // ': met_force(i)%Qair = ' // tmpstr13a @@ -316,7 +316,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Qair ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%Qair/Qair_sat - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Qair > Qair_sat in tile ID ' // & tile_id_str // ': met_force(i)%Qair = ' // tmpstr13a // & ', met_force(i)%Qair/Qair_sat = ' // tmpstr13b @@ -343,7 +343,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%Wind ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: Wind < 0. in tile ID ' //& tile_id_str // ': met_force(i)%Wind = ' // tmpstr13a @@ -374,7 +374,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%LWdown ! convert real to string write (tmpstr13b,'(e13.5)') min_LWdown - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: LWdown < min_LWdown in tile ID ' // & tile_id_str // ': met_force(i)%LWdown = ' // tmpstr13a // & ', min_LWdown = ' // tmpstr13b @@ -390,7 +390,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%LWdown ! convert real to string write (tmpstr13b,'(e13.5)') max_LWdown - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: LWdown > max_LWdown in tile ID ' // & tile_id_str // ': met_force(i)%LWdown = ' // tmpstr13a // & ', max_LWdown = ' // tmpstr13b @@ -413,7 +413,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWdown ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWdown < 0. in tile ID ' //& tile_id_str // ': met_force(i)%SWdown = ' // tmpstr13a @@ -431,7 +431,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWdown ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWdown > ' // SWDN_MAX_string // & ' in tile ID ' // tile_id_str // ': met_force(i)%SWdown = ' // tmpstr13a @@ -455,7 +455,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWnet ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWnet < 0. in tile ID ' //& tile_id_str // ': met_force(i)%SWnet = ' // tmpstr13a @@ -473,7 +473,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%SWnet ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%SWdown ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: SWnet > SWdown in tile ID ' // & tile_id_str // ': met_force(i)%SWnet = ' // tmpstr13a // & ', met_force(i)%SWdown = ' // tmpstr13b @@ -499,7 +499,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%PARdffs ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdffs < 0. in tile ID ' //& tile_id_str // ': met_force(i)%PARdffs = ' // tmpstr13a @@ -524,7 +524,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') tmp_maxPar ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%PARdffs ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdffs > ' // tmpstr13a // & ' in tile ID ' // tile_id_str // ': met_force(i)%PARdffs = ' // & tmpstr13b @@ -552,7 +552,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') met_force(i)%PARdrct ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdrct < 0. in tile ID ' //& tile_id_str // ': met_force(i)%PARdrct = ' // tmpstr13a @@ -571,7 +571,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr13a,'(e13.5)') tmp_maxPar ! convert real to string write (tmpstr13b,'(e13.5)') met_force(i)%PARdrct ! convert real to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') 'repair_forcing: PARdrct > ' // tmpstr13a // & ' in tile ID ' // tile_id_str // ': met_force(i)%PARdrct = ' // & tmpstr13b @@ -599,7 +599,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & write (tmpstr16,'(i16)') kk ! convert integer to string - if (master_logit) & + if (root_logit) & write (logunit,'(200A)') & 'repair_forcing: turning OFF warnings after detecting ' // & trim(tmpstr16) // ' tiles with problematic forcing' diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 index a5f601a3..b18ec215 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_TileCoordRoutines.F90 @@ -1547,7 +1547,7 @@ subroutine reorder_tiles( reorder, pfaf_system, N_tile, tile_coord, d2g, N_tiles ! If input argument "reorder" is ".false." and "pfaf_system=0", assume that tiles have ! already been reordered. Check for obvious violations and only return "N_tiles_cont". ! - ! Typically done only by the master process (because the re-ordering requires + ! Typically done only by the root process (because the re-ordering requires ! a second copy of the full domain tile coord structure). ! ! reichle, 26 June 2012 diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 index d87128ab..700abc92 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_Globals.F90 @@ -24,8 +24,8 @@ module LDAS_ensdrv_Globals public :: LDAS_is_nodata public :: logunit public :: logit - public :: master_logit - public :: log_master_only + public :: root_logit + public :: log_root_only public :: echo_clsm_ensdrv_glob_param public :: write_status @@ -50,13 +50,13 @@ module LDAS_ensdrv_Globals ! until the job terminates. ! ! NOTE: "logunit=stdout" is disabled if log messages are requested from *all* processors - ! (that is, for "log_master_only=.false.") to avoid garbled output + ! (that is, for "log_root_only=.false.") to avoid garbled output integer, parameter :: logunit = output_unit ! defined in iso_fortran_env - logical, parameter :: log_master_only = .true. + logical, parameter :: log_root_only = .true. - logical :: logit,master_logit + logical :: logit,root_logit contains @@ -82,7 +82,7 @@ subroutine echo_clsm_ensdrv_glob_param() write (logunit,*) write (logunit,*) 'logunit = ', logunit write (logunit,*) - write (logunit,*) 'log_master_only = ', log_master_only + write (logunit,*) 'log_root_only = ', log_root_only write (logunit,*) write (logunit,*) 'logit = ', logit write (logunit,*) diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 index c80a16d7..3641e8b8 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_init_routines.F90 @@ -14,7 +14,6 @@ module LDAS_ensdrv_init_routines use GEOS_MOD use LDAS_ensdrv_Globals, ONLY: & - log_master_only, & logunit, & logit, & nodata_generic @@ -52,9 +51,6 @@ module LDAS_ensdrv_init_routines N_gt, & N_snow - use LDAS_ensdrv_mpi, ONLY: & - master_proc - use ESMF use MAPL_Mod diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 index 3574dab3..1029db8e 100644 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 +++ b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_mpi.F90 @@ -59,7 +59,7 @@ module LDAS_ensdrv_mpi integer, public :: myid=0, numprocs=1, mpicomm integer, public :: mpierr, mpistatus(MPI_STATUS_SIZE) - logical, public :: master_proc=.true. + logical, public :: root_proc=.true. integer, public :: MPI_tile_coord_type, MPI_grid_def_type integer, public :: MPI_cat_param_type, MPI_cat_progn_type diff --git a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 b/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 deleted file mode 100644 index 63c8356f..00000000 --- a/src/Components/GEOSldas_GridComp/Shared/LDAS_ensdrv_vegalb_routines.F90 +++ /dev/null @@ -1,1233 +0,0 @@ - -module LDAS_ensdrv_vegalb_routines - - ! collection of LDASsa subroutines for vegetation and albedo parameters - ! - ! (originally in clsm_ensdrv_drv_routines.F90) - ! - ! reichle, 22 Aug 2014 - - use LDAS_ensdrv_Globals, ONLY: & - logunit, & - logit - - use LDAS_DriverTypes, ONLY: & - veg_param_type, & - alb_param_type - -! use clsm_ensdrv_mpi, ONLY: & -! MPI_INTEGER, & -! MPI_COMM_WORLD, & -! mpierr, & -! MPI_DATE_TIME_TYPE, & -! numprocs, & -! master_proc - - use LDAS_DateTimeMod, ONLY: & - date_time_type, & - datetime_lt_refdatetime, & - datetime_eq_refdatetime, & - datetime2_minus_datetime1, & - augment_date_time, & - get_dofyr_pentad - - use LDAS_ensdrv_functions, ONLY: & - open_land_param_file - - use clsm_ensdrv_drv_routines, ONLY: & - f2l_real - - use LDAS_ExceptionsMod, ONLY: & - ldas_abort, & - LDAS_GENERIC_ERROR - - implicit none - - private - - public :: get_veg_and_alb_times - public :: get_VEG - public :: get_ALB - -contains - - ! ******************************************************************** - - subroutine open_file_VEG( field_name, unitnum, file_format_VEG, veg_path, & - res_ftag ) - - implicit none - - integer, intent(in) :: unitnum, file_format_VEG - - character( 3), intent(in) :: field_name - character(200), intent(in) :: veg_path - character( 40), intent(in) :: res_ftag - - ! local variables - - integer, parameter :: N_search_dir_max = 5 - - integer :: N_search_dir, istat - - logical :: is_big_endian - - character(100), dimension(N_search_dir_max) :: search_dir - character( 80) :: fname - character( 20) :: ftag - - character(len=*), parameter :: Iam = 'open_file_VEG' - - ! ------------------------------------------------------------------------- - - select case (field_name) - - case ('GRN'); ftag = 'green' - case ('LAI'); ftag = 'lai' - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown field_name') - - end select - - ! ----------------------------------- - - select case (file_format_VEG) - - case (0) - - N_search_dir = 2 ! specify sub-dirs of veg_path to search for file "fname" - - search_dir(1) = 'clsm' - search_dir(2) = 'VEGETATION-GSWP2/LAI_GRN_CLIMATOLOGY' - - ! 'green.dat' - ! 'lai.dat' - - fname = '/' // trim(ftag) // '.dat' - - is_big_endian = .true. - - case (1) - - N_search_dir = 1 ! specify sub-dirs of veg_path to search for file "fname" - - search_dir(1) = './' - - ! 'green_clim_180x1080.data' - MERRA-2 on cube-sphere grid - ! 'green_clim_540x361_DC.data' - MERRA DC grid with MERRA-2 tiling - - ! 'lai_clim_180x1080.data' - MERRA-2 on cube-sphere grid - ! 'lai_clim_540x361_DC.data' - MERRA DC grid with MERRA-2 tiling - - fname = '/' // trim(ftag) // '_clim_' // trim(res_ftag) // '.data' - - is_big_endian = .false. - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown file_format_VEG') - - end select - - istat = open_land_param_file( & - unitnum, .false., is_big_endian, N_search_dir, fname, veg_path, search_dir) - - end subroutine open_file_VEG - - ! ******************************************************************** - - subroutine open_file_ALB( field_name, unitnum, file_format_ALB, alb_path, & - res_ftag ) - - implicit none - - integer, intent(in) :: unitnum, file_format_ALB - - character( 5), intent(in) :: field_name - character(200), intent(in) :: alb_path - character( 40), intent(in) :: res_ftag - - ! local variables - - integer, parameter :: N_search_dir_max = 5 - - integer :: N_search_dir, istat - - logical :: is_big_endian - - character(100), dimension(N_search_dir_max) :: search_dir - character( 80) :: fname - character( 20) :: ftag - - character(len=*), parameter :: Iam = 'open_file_ALB' - - ! ------------------------------------------------------------------------- - - select case (file_format_ALB) - - case (0) - - N_search_dir = 2 ! specify sub-dirs of alb_path to search for file "fname" - - search_dir(1) = 'clsm' - search_dir(2) = 'MODIS_alb' - - select case (field_name) - - case ('ALBnf'); fname = '/modis_scale_factor.albnf.clim' - case ('ALBvf'); fname = '/modis_scale_factor.albvf.clim' - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown field_name') - - end select - - is_big_endian = .true. - - case (1) - - N_search_dir = 1 ! specify sub-dirs of alb_path to search for file "fname" - - search_dir(1) = './' - - ! 'nirdf_180x1080.dat' - MERRA-2 on cube-sphere grid - ! 'nirdf_540x361_DC.dat' - MERRA DC grid with MERRA-2 tiling - - ! 'visdf_180x1080.dat' - MERRA-2 on cube-sphere grid - ! 'visdf_540x361_DC.dat' - MERRA DC grid with MERRA-2 tiling - - ! NOTE: files named "AlbMap.*.dat" contain albedos, not the albedo *scaling* - ! factors needed here - - select case (field_name) - - case ('ALBnf'); ftag = 'nirdf' - case ('ALBvf'); ftag = 'visdf' - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown field_name') - - end select - - fname = '/' // trim(ftag) // '_' // trim(res_ftag) // '.dat' - - is_big_endian = .false. - - case default - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown file_format_ALB') - - end select - - istat = open_land_param_file( & - unitnum, .false., is_big_endian, N_search_dir, fname, alb_path, search_dir) - - end subroutine open_file_ALB - - ! ******************************************************************** - - subroutine get_veg_and_alb_times( N_catg, N_catf, res_ftag, & - veg_path, alb_path, file_format_VEG, file_format_ALB, this_date_time, & - N_GRN, N_LAI, N_ALB, & - mid_GRN, mid_LAI, mid_ALB ) - - ! Read and MPI broadcast either - ! (i) number of data times (if "mid_*" arguments are NOT present) - ! (ii) timestamps for veg and albedo files (otherwise) - ! - ! reichle, 25 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: N_catg, N_catf - - character( 40), intent(in) :: res_ftag - - character(200), intent(in) :: veg_path, alb_path - - integer, intent(in) :: file_format_VEG - integer, intent(in) :: file_format_ALB - - type(date_time_type), intent(in) :: this_date_time - - integer, intent(inout) :: N_GRN - integer, intent(inout) :: N_LAI - integer, intent(inout) :: N_ALB - - type(date_time_type), dimension(N_GRN), intent(out), optional :: mid_GRN - type(date_time_type), dimension(N_GRN), intent(out), optional :: mid_LAI - type(date_time_type), dimension(N_GRN), intent(out), optional :: mid_ALB - - ! local variables - - integer :: unitnum - character(len=*), parameter :: Iam = 'get_veg_and_alb_times' - - ! ------------------------------------------------------------------------ - - ! ensure proper usage - - if ( (.not. present(mid_GRN)) .and. & - (.not. present(mid_LAI)) .and. & - (.not. present(mid_ALB)) ) then - - if (logit) write (logunit,*) 'reading number of data times for LAI, GRN, ALB' - - elseif (present(mid_GRN) .and. present(mid_LAI) .and. present(mid_ALB) ) then - - if (logit) write (logunit,*) 'reading midpoint times for LAI, GRN, ALB' - - else - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown usage') - - end if - - unitnum = 10 - - ! ---------------------------------- - - if (master_proc) then - - ! greenness (GRN) - - call open_file_VEG( 'GRN', unitnum, file_format_VEG, veg_path, res_ftag) - - if (present(mid_GRN)) then - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_GRN, & - this_date_time, mid_GRN ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_GRN ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading GRN info' - - ! ----------------------------------------- - ! - ! leaf area index (LAI) - - call open_file_VEG( 'LAI', unitnum, file_format_VEG, veg_path, res_ftag) - - if (present(mid_LAI)) then - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_LAI, & - this_date_time, mid_LAI ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, N_LAI ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading LAI info' - - ! ----------------------------------------- - - ! albedo scaling parameters (ALB) - - ! assume that N_times matches between ALBnf and ALBvf files - - call open_file_ALB( 'ALBnf', unitnum, file_format_ALB, alb_path, res_ftag ) - - if (present(mid_ALB)) then - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, N_ALB, & - this_date_time, mid_ALB ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, N_ALB ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading ALB info' - - end if ! master_proc - - ! ----------------------------------------------------------------------- - ! - ! MPI broadcast (simplified "if" construct, see "proper usage" block above) - -#ifdef LDAS_MPI - - if (.not. present(mid_GRN)) then - - call MPI_BCAST(N_GRN, 1, MPI_INTEGER, 0, MPI_COMM_WORLD,mpierr) - call MPI_BCAST(N_LAI, 1, MPI_INTEGER, 0, MPI_COMM_WORLD,mpierr) - call MPI_BCAST(N_ALB, 1, MPI_INTEGER, 0, MPI_COMM_WORLD,mpierr) - - else - - call MPI_BCAST(mid_GRN, N_GRN, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(mid_LAI, N_LAI, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(mid_ALB, N_ALB, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - - end if - -#endif - - end subroutine get_veg_and_alb_times - - ! ******************************************************************** - - subroutine get_VEG( field_name, N_catg, N_catf, N_catl, f2g, N_catl_vec, low_ind, & - res_ftag, veg_path, file_format_VEG, this_date_time, & - N_VEG, mid_VEG, veg_time_new, veg_time_old, veg_param_new, veg_param_old ) - - ! Read either greenness (GRN) *or* leaf area index (LAI) data and put - ! into veg_param - ! - ! field_name = 'GRN': read GRN - ! field_name = 'LAI': read LAI - ! - ! veg_time_new: first available data time *after* this_date_time - ! veg_time_old: latest available data time *before* this_date_time - ! - ! veg_param_new: data for veg_time_new - ! veg_param_old: data for veg_time_old (optional, use for initialization) - ! - ! data are read for the full domain and MPI-scattered to the local processor - ! - ! reichle, 26 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - character(3), intent(in) :: field_name - - integer, intent(in) :: N_catg, N_catf, N_catl - - integer, dimension(N_catf), intent(in) :: f2g - - integer, dimension(numprocs), intent(in) :: N_catl_vec, low_ind - - character( 40), intent(in) :: res_ftag - character(200), intent(in) :: veg_path - - integer, intent(in) :: file_format_VEG - - type(date_time_type), intent(in) :: this_date_time - - integer, intent(in) :: N_VEG - - type(date_time_type), dimension(N_VEG), intent(in) :: mid_VEG - - type(date_time_type), intent(out) :: veg_time_new - type(date_time_type), intent(out) :: veg_time_old - - type(veg_param_type), dimension(N_catl), intent(out) :: veg_param_new - type(veg_param_type), dimension(N_catl), intent(out), optional :: veg_param_old - - ! local variables - - integer :: unitnum, N_VEG_tmp - - type(date_time_type), dimension(N_VEG) :: mid_VEG_tmp - - real, dimension(N_catl) :: data_new - real, dimension(N_catl) :: data_old - - real, dimension(:), allocatable :: data_new_f - real, dimension(:), allocatable :: data_old_f - - ! ------------------------------------------------------------------------ - - if (master_proc) then - - ! prepare - - unitnum = 10 - - N_VEG_tmp = N_VEG - - mid_VEG_tmp = mid_VEG - - allocate(data_new_f(N_catf)) - - if (present(veg_param_old)) allocate(data_old_f(N_catf)) - - ! read full domain data - - call open_file_VEG( field_name, unitnum, file_format_VEG, veg_path, res_ftag) - - if (present(veg_param_old)) then - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, & - N_VEG_tmp, this_date_time, mid_VEG_tmp, & - f2g, veg_time_new, veg_time_old, data_new_f, data_old_f ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_VEG, N_catg, N_catf, & - N_VEG_tmp, this_date_time, mid_VEG_tmp, & - f2g, veg_time_new, veg_time_old, data_new_f ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading ' // field_name - - end if - - ! map from full to local domain - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_new_f, data_new) - - select case (field_name) - - case ('GRN'); veg_param_new%grn = data_new - case ('LAI'); veg_param_new%lai = data_new - - end select - - if (master_proc) deallocate(data_new_f) - - if (present(veg_param_old)) then - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_old_f, data_old) - - select case (field_name) - - case ('GRN'); veg_param_old%grn = data_old - case ('LAI'); veg_param_old%lai = data_old - - end select - - if (master_proc) deallocate(data_old_f) - - end if - -#ifdef LDAS_MPI - - call MPI_BCAST(veg_time_new, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(veg_time_old, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - -#endif - - end subroutine get_VEG - - ! ******************************************************************** - - subroutine get_ALB( N_catg, N_catf, N_catl, f2g, N_catl_vec, low_ind, & - res_ftag, alb_path, file_format_ALB, this_date_time, & - N_ALB, mid_ALB, alb_time_new, alb_time_old, alb_param_new, alb_param_old ) - - ! Read albedo scaling parameters - ! - ! alb_time_new: first available data time *after* this_date_time - ! alb_time_old: latest available data time *before* this_date_time - ! - ! alb_param_new: data for alb_time_new - ! alb_param_old: data for alb_time_old (optional, use for initialization) - ! - ! data are read for the full domain and MPI-scattered to the local processor - ! - ! reichle, 26 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: N_catg, N_catf, N_catl - - integer, dimension(N_catf), intent(in) :: f2g - - integer, dimension(numprocs), intent(in) :: N_catl_vec, low_ind - - character( 40), intent(in) :: res_ftag - character(200), intent(in) :: alb_path - - integer, intent(in) :: file_format_ALB - - type(date_time_type), intent(in) :: this_date_time - - integer, intent(in) :: N_ALB - - type(date_time_type), dimension(N_ALB), intent(in) :: mid_ALB - - type(date_time_type), intent(out) :: alb_time_new - type(date_time_type), intent(out) :: alb_time_old - - type(alb_param_type), dimension(N_catl), intent(out) :: alb_param_new - type(alb_param_type), dimension(N_catl), intent(out), optional :: alb_param_old - - ! local variables - - integer :: unitnum, N_ALB_tmp, ff - - integer, parameter :: N_fields = 2 - - character(5), dimension(N_fields) :: field_names - - type(date_time_type), dimension(N_ALB) :: mid_ALB_tmp - - real, dimension(N_catl) :: data_new - real, dimension(N_catl) :: data_old - - real, dimension(:), allocatable :: data_new_f - real, dimension(:), allocatable :: data_old_f - - ! ------------------------------------------------------------------------ - - ! prepare - - field_names = (/ 'ALBnf', 'ALBvf' /) - - if (master_proc) then - - unitnum = 10 - - N_ALB_tmp = N_ALB - - mid_ALB_tmp = mid_ALB - - allocate(data_new_f(N_catf)) - - if (present(alb_param_old)) allocate(data_old_f(N_catf)) - - end if - - ! read data - - do ff=1,N_fields - - if (master_proc) then - - ! read full domain data - - call open_file_ALB( field_names(ff), unitnum, file_format_ALB, alb_path, & - res_ftag) - - if (present(alb_param_old)) then - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, & - N_ALB_tmp, this_date_time, mid_ALB_tmp, & - f2g, alb_time_new, alb_time_old, data_new_f, data_old_f ) - - else - - call read_veg_or_alb_clim( unitnum, file_format_ALB, N_catg, N_catf, & - N_ALB_tmp, this_date_time, mid_ALB_tmp, & - f2g, alb_time_new, alb_time_old, data_new_f ) - - end if - - close (unitnum,status='keep') - - if (logit) write (logunit,*) 'done reading ' // field_names(ff) - - end if - - ! map from full to local domain - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_new_f, data_new) - - select case (field_names(ff)) - - case ('ALBnf'); alb_param_new%sc_albnf = data_new - case ('ALBvf'); alb_param_new%sc_albvf = data_new - - end select - - if (present(alb_param_old)) then - - call f2l_real( N_catf, N_catl, N_catl_vec, low_ind, data_old_f, data_old) - - select case (field_names(ff)) - - case ('ALBnf'); alb_param_old%sc_albnf = data_old - case ('ALBvf'); alb_param_old%sc_albvf = data_old - - end select - - end if - - end do ! ff=1,N_fields - - if ( master_proc ) deallocate(data_new_f) - if ( master_proc .and. present(alb_param_old) ) deallocate(data_old_f) - -#ifdef LDAS_MPI - - call MPI_BCAST(alb_time_new, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - call MPI_BCAST(alb_time_old, 1, MPI_date_time_type, 0, MPI_COMM_WORLD, mpierr) - -#endif - - end subroutine get_ALB - - ! ******************************************************************** - - subroutine read_veg_or_alb_clim( unitnum, file_format, N_catg, N_catf, N_times, & - this_date_time, mid_date_time, f2g, new_date_time, old_date_time, data_new, & - data_old ) - - ! Read climatological vegetation (LAI, greenness) or albedo scaling - ! parameters from file. - ! - ! Climatological science data are provided as n-day averages for the - ! global tile space. - ! - ! This subroutine accomodates the following file formats: - ! - ! file_format=0: legacy format (monthly data, flat binaries, no date/time info) - ! file_format=1: compatible with MAPL_readforcing() - ! - ! The subroutine can be called in the following ways: - ! usage=1: Obtain only N_times - ! usage=2: Obtain mid-point date/time of data averaging intervals for all N_times - ! usage=3: a) Read data for interval with mid-point after this_date_time - ! b) Read data for intervals w/ mid-points after and before - ! this_date_time (use for initialization) - ! - ! reichle, 25 Jul 2013 - ! - ! ------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: unitnum - integer, intent(in) :: file_format - - integer, intent(in) :: N_catg, N_catf - - integer, intent(inout) :: N_times - - type(date_time_type), intent(in), optional :: this_date_time - - type(date_time_type), dimension(N_times), intent(inout), optional :: mid_date_time - - integer, dimension(N_catf), intent(in), optional :: f2g - - type(date_time_type), intent(out), optional :: new_date_time - - type(date_time_type), intent(out), optional :: old_date_time - - real, dimension(N_catf), intent(out), optional :: data_new - - real, dimension(N_catf), intent(out), optional :: data_old - - - ! local variables - - integer, parameter :: max_times = 75 ! 73 pentads plus 2 for wrap-around - - integer :: usage, ii, jj, istat, dim1, dim2 - integer :: ind_new, tmp_ind_new, tmp_ind_old - integer :: prev_year, curr_year, next_year - - real, dimension(14) :: tmprealvec14 - - real, dimension(N_catg) :: tmpvec - - type(date_time_type) :: end_date_time - - type(date_time_type), dimension(:), allocatable :: start_date_time - - character(len=*), parameter :: Iam = 'read_veg_or_alb_clim' - character(len=400) :: err_msg - - ! ------------------------------------------------ - ! - ! determine what is needed - - if ( & - (.not. present(this_date_time)) .and. & - (.not. present(mid_date_time )) .and. & - (.not. present(f2g )) .and. & - (.not. present(new_date_time )) .and. & - (.not. present(old_date_time )) .and. & - (.not. present(data_new )) .and. & - (.not. present(data_old )) ) then - - ! usage=1: Obtain only N_times - - usage = 1 - - elseif ( & - ( present(this_date_time)) .and. & - ( present(mid_date_time )) .and. & - (.not. present(f2g )) .and. & - (.not. present(new_date_time )) .and. & - (.not. present(old_date_time )) .and. & - (.not. present(data_new )) .and. & - (.not. present(data_old )) ) then - - ! usage=2: Obtain mid-point date/time of data averaging intervals - ! for all N_times - - usage = 2 - - allocate(start_date_time(N_times+1)) - - elseif ( & - ( present(this_date_time)) .and. & - ( present(mid_date_time )) .and. & - ( present(f2g )) .and. & - ( present(new_date_time )) .and. & - ( present(old_date_time )) .and. & - ( present(data_new )) ) then - - ! usage=3: - ! - ! a) Read data for interval with mid-point after this_date_time - ! (if "data_old" is NOT present) - ! b) Read data for intervals w/ mid-points after *and* before this_date_time - ! (if "data_old" *is* present --> use for initialization) - ! - ! in this usage, "mid_date_time" is intent(in) - - usage = 3 - - ! Determine ind_new such that: - ! - ! mid_date_time(ind_new-1) < this_date_time <= mid_date_time(ind_new) - ! - ! Note: 2 <= ind_new <= N_times (by construction) - ! - ! ind_old = ind_new-1 (by definition) - - ind_new = 2 - - do while (ind_new<=N_times) - - ! test whether this_date_time is before mid_date_time(ind_new) - - if (datetime_lt_refdatetime( this_date_time, mid_date_time(ind_new))) exit - - ind_new = ind_new+1 - - end do - - new_date_time = mid_date_time(ind_new) - - old_date_time = mid_date_time(ind_new-1) - - else - - call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown usage (B)') - - end if - - ! ---------------------------------------------------------------------- - ! - ! read data from file - - select case (file_format) - - case (0) - - ! file format: flat binaries, monthly data, no date/time info, - ! wrap-around NOT stored in file - ! (legacy file format, e.g. MERRA-Land, Fortuna) - - if (usage==1) then - - N_times = 14 ! incl 2 for wrap-around NOT stored in file - - elseif (usage==2) then - - ! get N_times+1 (!) start date/times for averaging intervals - - ! 1 = Dec 1, 0z (year 0) - - start_date_time(1)%year = 0 - start_date_time(1)%month = 12 - start_date_time(1)%day = 1 - start_date_time(1)%hour = 0 - start_date_time(1)%min = 0 - start_date_time(1)%sec = 0 - - ! 2 = Jan 1, 0z (year 1) - ! 3 = Feb 1, 0z (year 1) - ! ... - ! 13 = Dec 1, 0z (year 1) - - do ii=2,(N_times-1) - - start_date_time(ii)%year = 1 - start_date_time(ii)%month = ii-1 - start_date_time(ii)%day = 1 - start_date_time(ii)%hour = 0 - start_date_time(ii)%min = 0 - start_date_time(ii)%sec = 0 - - end do - - ! 14 = Jan 1, 0z (year 2) - - start_date_time(N_times )%year = 2 - start_date_time(N_times )%month = 1 - start_date_time(N_times )%day = 1 - start_date_time(N_times )%hour = 0 - start_date_time(N_times )%min = 0 - start_date_time(N_times )%sec = 0 - - ! 15 = Feb 1, 0z (year 2) - - start_date_time(N_times+1)%year = 2 - start_date_time(N_times+1)%month = 2 - start_date_time(N_times+1)%day = 1 - start_date_time(N_times+1)%hour = 0 - start_date_time(N_times+1)%min = 0 - start_date_time(N_times+1)%sec = 0 - - elseif (usage==3) then - - ! translate ind_new into tmp_ind_new (wrap-around months NOT stored in file) - - if (ind_new==2 .or. ind_new==14) then - - tmp_ind_new = 1 ! Jan - tmp_ind_old = 12 ! Dec - - else - - tmp_ind_new = ind_new - 1 - tmp_ind_old = ind_new - 2 - - end if - - ! disable "tmp_ind_old" if not needed - - if (.not. present(data_old)) tmp_ind_old = -9999 - - ! read through file and extract months of interest - - do ii=1,max(tmp_ind_old,tmp_ind_new) - - if (ii==tmp_ind_new) then - - read (unitnum) (tmpvec(jj), jj=1,N_catg) - - data_new(1:N_catf) = tmpvec(f2g(1:N_catf)) - - elseif (ii==tmp_ind_old) then - - ! per definition of tmp_ind_old above and loop boundaries, - ! "data_old" must be present in this case - - read (unitnum) (tmpvec(jj), jj=1,N_catg) - - data_old(1:N_catf) = tmpvec(f2g(1:N_catf)) - - else - - read (unitnum) ! SKIP science data record - - end if - - end do - - end if ! usage - - ! ------------------------------------------- - - case (1) - - ! file format: compatible with MAPL_readforcing() - ! flat binaries, n-day averages, date/time info - ! (e.g., MERRA-2) - - if (usage==1) then - - ! determine number of data records in file - - ii = 0 - - do while (ii=max_times) then - err_msg = 'number or data times in file exceeds max allowed' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - N_times = ii - - elseif (usage==2) then - - do ii=1,N_times - - ! read date/time record - - read (unitnum) (tmprealvec14(jj), jj=1,14) - - ! start date/time of averaging interval - - start_date_time(ii)%year = nint(tmprealvec14( 1)) - start_date_time(ii)%month = nint(tmprealvec14( 2)) - start_date_time(ii)%day = nint(tmprealvec14( 3)) - start_date_time(ii)%hour = nint(tmprealvec14( 4)) - start_date_time(ii)%min = nint(tmprealvec14( 5)) - start_date_time(ii)%sec = nint(tmprealvec14( 6)) - - ! sanity check - - if (ii>1) then - - ! start of current interval must match end of previous interval - - if (.not. datetime_eq_refdatetime( & - start_date_time(ii), end_date_time ) & - ) then - err_msg = 'intervals do not line up' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - end if - - ! end date/time of averaging interval - - end_date_time%year = nint(tmprealvec14( 7)) - end_date_time%month = nint(tmprealvec14( 8)) - end_date_time%day = nint(tmprealvec14( 9)) - end_date_time%hour = nint(tmprealvec14(10)) - end_date_time%min = nint(tmprealvec14(11)) - end_date_time%sec = nint(tmprealvec14(12)) - - ! spatial dimensions - - dim1 = nint(tmprealvec14(13)) - dim2 = nint(tmprealvec14(14)) - - ! sanity check - - ! dim1 must match N_catg, dim2 must be 1 - - if ((dim1/=N_catg) .or. (dim2/=1)) then - err_msg = 'dimensions do not match' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - - read (unitnum) ! SKIP science data record - - end do - - ! fill in last element of start_date_time - - start_date_time(N_times+1) = end_date_time - - ! additional sanity checks - - ! check wrap-around: last three start_date_time entries must match - ! first three, resp. (except for year) - - if ( (start_date_time(N_times-1)%month/=start_date_time(1)%month) .or. & - (start_date_time(N_times-1)%day /=start_date_time(1)%day ) .or. & - (start_date_time(N_times-1)%hour /=start_date_time(1)%hour ) .or. & - (start_date_time(N_times-1)%min /=start_date_time(1)%min ) .or. & - (start_date_time(N_times-1)%sec /=start_date_time(1)%sec ) ) then - err_msg = 'something wrong with wrap-around (A)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ( (start_date_time(N_times )%month/=start_date_time(2)%month) .or. & - (start_date_time(N_times )%day /=start_date_time(2)%day ) .or. & - (start_date_time(N_times )%hour /=start_date_time(2)%hour ) .or. & - (start_date_time(N_times )%min /=start_date_time(2)%min ) .or. & - (start_date_time(N_times )%sec /=start_date_time(2)%sec ) ) then - err_msg = 'something wrong with wrap-around (B)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - if ( (start_date_time(N_times+1)%month/=start_date_time(3)%month) .or. & - (start_date_time(N_times+1)%day /=start_date_time(3)%day ) .or. & - (start_date_time(N_times+1)%hour /=start_date_time(3)%hour ) .or. & - (start_date_time(N_times+1)%min /=start_date_time(3)%min ) .or. & - (start_date_time(N_times+1)%sec /=start_date_time(3)%sec ) ) then - err_msg = 'something wrong with wrap-around (C)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! check years - - prev_year = start_date_time( 1)%year - curr_year = start_date_time( 2)%year - next_year = start_date_time( N_times)%year - - if ((prev_year+1/=curr_year) .or. (curr_year+1/=next_year)) then - err_msg = 'error with years in file (A)' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - do ii=3,N_times-1 - - if (start_date_time(ii)%year/=curr_year) then - err_msg = 'error with years in file (B)' - end if - - end do - - if (start_date_time(N_times+1)%year/=next_year) then - err_msg = 'error with years in file (C)' - end if - - - elseif (usage==3) then - - do ii=1,ind_new - - read (unitnum) ! SKIP date/time info record - - if (ii1 .and. ii=N_times) then - - start_date_time_tmp(ii)%year = current_year+1 - - end if - - ! recompute day-of-year - - call get_dofyr_pentad( start_date_time_tmp(ii) ) - - end do - - ! compute mid-point date/time - - do ii=1,N_times - - ! get length of interval (ii:ii+1) in seconds - - dt = datetime2_minus_datetime1( & - start_date_time_tmp(ii), start_date_time_tmp(ii+1) ) - - ! initialize and add dt/2 - - mid_date_time(ii) = start_date_time_tmp(ii) - - call augment_date_time( dt/2, mid_date_time(ii) ) - - end do - - end subroutine get_veg_or_alb_clim_mid_date_time - - ! ******************************************************************** - -end module clsm_ensdrv_vegalb_routines - -! *********** EOF ****************************************************** From 84978940704891238ec2e0e6b296c38ea87f6878 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 26 Jun 2020 09:54:57 -0400 Subject: [PATCH 37/42] Syncing Bridge into main (#264) From e0ca124b36edef2bc61f69f4bd4080760da3f03f Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 26 Jun 2020 09:55:55 -0400 Subject: [PATCH 38/42] editing Externals.cfg and components.yaml for use with develop --- Externals.cfg | 4 ++-- components.yaml | 13 ++++++++----- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 3b49a045..59defd71 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.3 +branch = main protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.7 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/components.yaml b/components.yaml index d67288d6..52f1b0c3 100644 --- a/components.yaml +++ b/components.yaml @@ -1,12 +1,14 @@ env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git - tag: v2.1.3+intel19.1.0 + tag: v2.1.3+intel19.1.0 + develop: main cmake: local: ./@cmake remote: git@github.com:GEOS-ESM/ESMA_cmake.git tag: v3.0.1 + develop: develop ecbuild: local: ./@cmake/@ecbuild @@ -17,17 +19,18 @@ GMAO_Shared: local: ./src/Shared/@GMAO_Shared remote: git@github.com:GEOS-ESM/GMAO_Shared.git sparse: ./config/GMAO_Shared.sparse - tag: v1.1.3 + branch: main + develop: main MAPL: local: ./src/Shared/@MAPL remote: git@github.com:GEOS-ESM/MAPL.git tag: v2.1.3 + develop: develop GEOSgcm_GridComp: local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git sparse: ./config/GEOSgcm_GridComp_ldas.sparse - tag: v1.8.7 - - + branch: develop + develop: develop From 2f18c53019faaf8f5c277fd6841b5acc0461e031 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Fri, 26 Jun 2020 15:02:40 -0400 Subject: [PATCH 39/42] hotfix to change GCM GridComp tag used by GEOSldas (#266) --- Externals.cfg | 2 +- components.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 3b49a045..0e287953 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.8.7 +tag = v1.9.0 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/components.yaml b/components.yaml index d67288d6..3a5879b7 100644 --- a/components.yaml +++ b/components.yaml @@ -28,6 +28,6 @@ GEOSgcm_GridComp: local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git sparse: ./config/GEOSgcm_GridComp_ldas.sparse - tag: v1.8.7 + tag: v1.9.0 From 26c533991ca6607b1aa328ec02f018344c13341d Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 26 Aug 2020 11:35:33 -0400 Subject: [PATCH 40/42] Updating Externals.cfg and components.yml with latest GMAO_Shared and GEOSgcm_GridComp releases --- Externals.cfg | 4 ++-- components.yaml | 13 +++++-------- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 59defd71..f02e2948 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -branch = main +tag = v1.1.8 protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -branch = develop +tag = v1.10.2 protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/components.yaml b/components.yaml index 52f1b0c3..3e5f83fd 100644 --- a/components.yaml +++ b/components.yaml @@ -1,14 +1,12 @@ env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git - tag: v2.1.3+intel19.1.0 - develop: main + tag: v2.1.3+intel19.1.0 cmake: local: ./@cmake remote: git@github.com:GEOS-ESM/ESMA_cmake.git tag: v3.0.1 - develop: develop ecbuild: local: ./@cmake/@ecbuild @@ -19,18 +17,17 @@ GMAO_Shared: local: ./src/Shared/@GMAO_Shared remote: git@github.com:GEOS-ESM/GMAO_Shared.git sparse: ./config/GMAO_Shared.sparse - branch: main - develop: main + tag: v1.1.8 MAPL: local: ./src/Shared/@MAPL remote: git@github.com:GEOS-ESM/MAPL.git tag: v2.1.3 - develop: develop GEOSgcm_GridComp: local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git sparse: ./config/GEOSgcm_GridComp_ldas.sparse - branch: develop - develop: develop + tag: v1.10.2 + + From f506ebca2209f949107a6f4c03747d44279a3e98 Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Wed, 26 Aug 2020 18:42:32 -0400 Subject: [PATCH 41/42] Merge Bridge into main (#298) (#300) From bb6e9e67b700e93cddd63233b4b3a39f2d65ec5a Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 26 Aug 2020 18:44:22 -0400 Subject: [PATCH 42/42] updating BRIDGE with Externals.cfg and components.yaml from develop --- Externals.cfg | 4 ++-- components.yaml | 13 ++++++++----- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index f02e2948..59defd71 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -17,7 +17,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GMAO_Shared.git local_path = ./src/Shared/@GMAO_Shared -tag = v1.1.8 +branch = main protocol = git sparse = ../../../config/GMAO_Shared.sparse @@ -32,7 +32,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/GEOSgcm_GridComp.git local_path = ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp -tag = v1.10.2 +branch = develop protocol = git sparse = ../../../../config/GEOSgcm_GridComp_ldas.sparse diff --git a/components.yaml b/components.yaml index 3e5f83fd..52f1b0c3 100644 --- a/components.yaml +++ b/components.yaml @@ -1,12 +1,14 @@ env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git - tag: v2.1.3+intel19.1.0 + tag: v2.1.3+intel19.1.0 + develop: main cmake: local: ./@cmake remote: git@github.com:GEOS-ESM/ESMA_cmake.git tag: v3.0.1 + develop: develop ecbuild: local: ./@cmake/@ecbuild @@ -17,17 +19,18 @@ GMAO_Shared: local: ./src/Shared/@GMAO_Shared remote: git@github.com:GEOS-ESM/GMAO_Shared.git sparse: ./config/GMAO_Shared.sparse - tag: v1.1.8 + branch: main + develop: main MAPL: local: ./src/Shared/@MAPL remote: git@github.com:GEOS-ESM/MAPL.git tag: v2.1.3 + develop: develop GEOSgcm_GridComp: local: ./src/Components/GEOSldas_GridComp/@GEOSgcm_GridComp remote: git@github.com:GEOS-ESM/GEOSgcm_GridComp.git sparse: ./config/GEOSgcm_GridComp_ldas.sparse - tag: v1.10.2 - - + branch: develop + develop: develop