diff --git a/.gitmodules b/.gitmodules index 0d39ebff4e..b6615c41fc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -44,7 +44,7 @@ fxDONOTUSEurl = https://github.com/ESCOMP/CISM-wrapper [submodule "rtm"] path = components/rtm url = https://github.com/ESCOMP/RTM -fxtag = rtm1_0_86 +fxtag = rtm1_0_87 fxrequired = ToplevelRequired # Standard Fork to compare to with "git fleximod test" to ensure personal forks aren't committed fxDONOTUSEurl = https://github.com/ESCOMP/RTM @@ -52,7 +52,7 @@ fxDONOTUSEurl = https://github.com/ESCOMP/RTM [submodule "mosart"] path = components/mosart url = https://github.com/ESCOMP/MOSART -fxtag = mosart1.1.08 +fxtag = mosart1.1.09 fxrequired = ToplevelRequired # Standard Fork to compare to with "git fleximod test" to ensure personal forks aren't committed fxDONOTUSEurl = https://github.com/ESCOMP/MOSART diff --git a/cime_config/SystemTests/rxcropmaturityinst.py b/cime_config/SystemTests/rxcropmaturityinst.py deleted file mode 100644 index bf8bf7750b..0000000000 --- a/cime_config/SystemTests/rxcropmaturityinst.py +++ /dev/null @@ -1,6 +0,0 @@ -from rxcropmaturity import RXCROPMATURITYSHARED - - -class RXCROPMATURITYINST(RXCROPMATURITYSHARED): - def run_phase(self): - self._run_phase(h1_inst=True) diff --git a/cime_config/SystemTests/rxcropmaturityskipgeninst.py b/cime_config/SystemTests/rxcropmaturityskipgeninst.py deleted file mode 100644 index 4cab9bd7c0..0000000000 --- a/cime_config/SystemTests/rxcropmaturityskipgeninst.py +++ /dev/null @@ -1,6 +0,0 @@ -from rxcropmaturity import RXCROPMATURITYSHARED - - -class RXCROPMATURITYSKIPGENINST(RXCROPMATURITYSHARED): - def run_phase(self): - self._run_phase(skip_gen=True, h1_inst=True) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index c219a1d1ef..3a8272919e 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -1,7 +1,8 @@ r - rh\d? + rh\da + rh\di h\d*.*\.nc$ lilac_hi.*\.nc$ lilac_atm_driver_h\d*.*\.nc$ @@ -13,37 +14,19 @@ rpointer.lnd - rpointer.lnd_9999 + rpointer.lnd_9999.1976-01-01-00000 casename.clm2.r.1976-01-01-00000.nc - casename.clm2.rh4.1976-01-01-00000.nc - casename.clm2.h0.1976-01-01-00000.nc + casename.clm2.rh4a.1976-01-01-00000.nc + casename.clm2.rh4i.1976-01-01-00000.nc + casename.clm2.h0a.1976-01-01-00000.nc + casename.clm2.h0i.1976-01-01-00000.nc casename.clm2.lilac_hi.1976-01-01-00000.nc casename.clm2.lilac_atm_driver_h0.0001-01.nc - casename.clm2.h0.1976-01-01-00000.nc.base + casename.clm2.h0a.1976-01-01-00000.nc.base + casename.clm2.h0i.1976-01-01-00000.nc.base casename.clm2_0002.e.postassim.1976-01-01-00000.nc casename.clm2_0002.e.preassim.1976-01-01-00000.nc - anothercasename.clm2.i.1976-01-01-00000.nc - - - - r - rh\d? - h\d*.*\.nc$ - e - locfnh - - rpointer.lnd$NINST_STRING - ./$CASE.ctsm$NINST_STRING.r.$DATENAME.nc - - - rpointer.lnd - rpointer.lnd_9999 - casename.ctsm.r.1976-01-01-00000.nc - casename.ctsm.rh4.1976-01-01-00000.nc - casename.ctsm.h0.1976-01-01-00000.nc - casename.ctsm.h0.1976-01-01-00000.nc.base - casename.ctsm_0002.e.postassim.1976-01-01-00000.nc - casename.ctsm_0002.e.preassim.1976-01-01-00000.nc + anothercasename.clm2.r.1976-01-01-00000.nc diff --git a/cime_config/config_tests.xml b/cime_config/config_tests.xml index ee80087a08..12859b9131 100644 --- a/cime_config/config_tests.xml +++ b/cime_config/config_tests.xml @@ -145,16 +145,6 @@ This defines various CTSM-specific system tests $STOP_N - - As RXCROPMATURITY but ensure instantaneous h1. Can be removed once instantaneous and other variables are on separate files. - 1 - FALSE - FALSE - never - $STOP_OPTION - $STOP_N - - As RXCROPMATURITY but don't actually generate GDDs. Allows short testing with existing GDD inputs. 1 @@ -165,16 +155,6 @@ This defines various CTSM-specific system tests $STOP_N - - As RXCROPMATURITYSKIPGEN but ensure instantaneous h1. Can be removed once instantaneous and other variables are on separate files. - 1 - FALSE - FALSE - never - $STOP_OPTION - $STOP_N - - + + + FAIL + #3311 + Requires finidat with c13/c14 to PASS + + + + + FAIL + #3311 + Requires finidat with c13/c14 to PASS + + + + + FAIL + #3311 + Requires finidat with c13/c14 to PASS + + + + + FAIL + #3311 + Requires finidat with c13/c14 to PASS + + + + + FAIL + #3311 + Requires finidat with c13/c14 to PASS + + + FAIL diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 943cd37e65..351b737c92 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -4240,17 +4240,6 @@ - - - - - - - - - - - @@ -4263,17 +4252,6 @@ - - - - - - - - - - - @@ -4388,7 +4366,7 @@ - + diff --git a/cime_config/testdefs/testmods_dirs/clm/crop/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/crop/user_nl_clm index 8ad588381e..56d4696774 100644 --- a/cime_config/testdefs/testmods_dirs/clm/crop/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/crop/user_nl_clm @@ -17,4 +17,5 @@ hist_fincl3 = 'SDATES', 'SDATES_PERHARV', 'SYEARS_PERHARV', 'HDATES', 'GRAINC_TO hist_nhtfrq = -24,-8,-24 hist_mfilt = 1,1,1 hist_type1d_pertape(3) = 'PFTS' +hist_avgflag_pertape(3) = 'I' hist_dov2xy = .true.,.false.,.false. diff --git a/components/mosart b/components/mosart index 00a87c9084..c776a802f6 160000 --- a/components/mosart +++ b/components/mosart @@ -1 +1 @@ -Subproject commit 00a87c9084af1af0d2b14d14e3d432f6808681f9 +Subproject commit c776a802f6f3e5ed853d4adfc7a8db6b8fed28ab diff --git a/components/rtm b/components/rtm index 26e96f500b..dd45b884bc 160000 --- a/components/rtm +++ b/components/rtm @@ -1 +1 @@ -Subproject commit 26e96f500b9500b32a870db20eed6b1bd37587ea +Subproject commit dd45b884bc26bf2ec578f2157a808b138f318fb3 diff --git a/doc/ChangeLog b/doc/ChangeLog index 569347dfce..ca13522df8 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,135 @@ =============================================================== +Tag name: ctsm5.3.062 +Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) +Date: Wed 09 Jul 2025 09:03:55 AM MDT +One-line Summary: Put instantaneous and non-inst. fields on separate hist files + +Purpose and description of changes +---------------------------------- + Following ctsm5.3.018 "Change history time to be the middle of the time bounds" + the current change intends to prevent confusion associated with the time corresponding to instantaneous history fields by putting them on separate files than non-instantaneous fields. The result is + + 1) two history files per clm, mosart, and rtm history tape: + tape h0 becomes h0a and h0i + tape h1 becomes h1a and h1i + ... + tape hX becomes hXa and hXi + + 2) two history restart files per history restart tape: + rh0 becomes rh0a and rh0i + rh1 becomes rh1a and rh1i + ... + rhX becomes rhXa and rhXi + + The clm handles empty history (and corresponding history restart) files by not generating them, while rtm and mosart give an error. Instead of refactoring rtm and mosart to behave like the clm (considered out of scope), I have introduced one active instantaneous field in mosart and one in rtm to bypass the "empty file" error. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm6_0 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed +---------- +List of CTSM issues fixed (include CTSM Issue # and description) [one per line]: + Resolves #1059 Don't allow inst. fields and averaged fields to be on the same history file + Resolves ESCOMP/RTM#32 + Resolves ESCOMP/MOSART#52 + +Notes of particular relevance for users +--------------------------------------- +Caveats for users (e.g., need to interpolate initial conditions): + History tapes have new extensions, e.g. h0 becomes h0a and h0i + History restart tapes have new extensions, e.g. rh0 becomes rh0a and rh0i + +Changes to documentation: + Not, yet: + - clm documentation + - Adam Phillips' cmip documentation + + +Testing summary: +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + derecho - PASS + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + derecho - PASS + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + derecho ----- OK + izumi ------- OK + + fates tests: (-c fates-sci.1.84.0_api.40.0.0-ctsm5.3.061 -g fates-sci.1.84.0_api.40.0.0-ctsm5.3.062) + derecho ----- OK + izumi ------- OK + + any other testing (give details below): + + ctsm_sci (-c ctsm_sci-ctsm5.3.059 -g ctsm_sci-ctsm5.3.062) + derecho ---- FAIL and I will open an issue and mark EXPECTED FAILURE as the problem originates in ctsm5.3.060 + + mosart tests: (-c mosart1.1.08-ctsm5.3.061 -g mosart1.1.09-ctsm5.3.062) + derecho ----- OK + izumi ------- OK + + rtm tests: (-c rtm1_0_86-ctsm5.3.061 -g rtm1_0_87-ctsm5.3.062) + derecho ----- OK + izumi ------- OK + + crop_calendars tests: (tested while in ctsm5.3.058 and again in ctsm5.3.061) + derecho ----- OK + izumi ------- OK + + ssp tests: (tested while in ctsm5.3.058 and again in ctsm5.3.061) + derecho ----- OK + + hillslope tests: (tested while in ctsm5.3.058 and again in ctsm5.3.061) + derecho ----- OK + + fire tests: (tested while in ctsm5.3.058 and again in ctsm5.3.061) + derecho ----- OK + +Answer changes +-------------- + +Changes answers relative to baseline: No, but read caveat: + h0 files become h0a (containing non-instantaneous fields) and h0i (containing instantaneous fields): + - I spot-checked clm, mosart, and rtm files and confirmed no bitwise change in answers. + - I ran Sam Rabin's comparison tool written specifically to compare hX files against hXa + hXi files: + ~samrabin/pr_2445_baseline_compare/pr_2445_baseline_compare.py -1 /glade/campaign/cgd/tss/ctsm_baselines/ctsm5.3.061 tests_0701-173109de + and it returned a single DIFF that appears to be a false positive. + +Other details +------------- +List any git submodules updated (cime, rtm, mosart, cism, fates, etc.): + mosart1.1.08 --> mosart1.1.09 + rtm1_0_86 --> rtm1_0_87 + +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/2445 + https://github.com/ESCOMP/MOSART/pull/117 + https://github.com/ESCOMP/RTM/pull/61 + +=============================================================== +=============================================================== Tag name: ctsm5.3.061 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) Date: Thu 26 Jun 2025 11:28:43 AM MDT diff --git a/doc/ChangeSum b/doc/ChangeSum index e10850838e..844b216d99 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.3.062 slevis 07/09/2025 Put inst. and non-inst. fields on separate hist files ctsm5.3.061 slevis 06/26/2025 Merge b4b-dev to master ctsm5.3.060 slevis 06/24/2025 Preliminary update of ctsm54 defaults (answer changing) ctsm5.3.059 erik 06/23/2025 Bring in various cleanup efforts found in previous testing after the chill changes came in diff --git a/python/ctsm/crop_calendars/check_rxboth_run.py b/python/ctsm/crop_calendars/check_rxboth_run.py index 2bb0872d45..568cb63822 100644 --- a/python/ctsm/crop_calendars/check_rxboth_run.py +++ b/python/ctsm/crop_calendars/check_rxboth_run.py @@ -78,7 +78,7 @@ def main(argv): any_bad = False - annual_outfiles = glob.glob(os.path.join(args.directory, "*.clm2.h1.*.nc")) + annual_outfiles = glob.glob(os.path.join(args.directory, "*.clm2.h1i.*.nc")) # These should be constant in a Prescribed Calendars (rxboth) run, as long as the inputs were # static. diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index f80f1e55f7..0489f320b7 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -280,13 +280,13 @@ def import_and_process_1yr( chunks = None # Get h1 file (list) - h1_pattern = os.path.join(indir, "*h1.*.nc") + h1_pattern = os.path.join(indir, "*h1i.*.nc") h1_filelist = glob.glob(h1_pattern) if not h1_filelist: - h1_pattern = os.path.join(indir, "*h1.*.nc.base") + h1_pattern = os.path.join(indir, "*h1i.*.nc.base") h1_filelist = glob.glob(h1_pattern) if not h1_filelist: - error(logger, "No files found matching pattern '*h1.*.nc(.base)'") + error(logger, "No files found matching pattern '*h1i.*.nc(.base)'") # Get list of crops to include if skip_crops is not None: @@ -566,7 +566,7 @@ def import_and_process_1yr( log(logger, " Importing accumulated GDDs...") clm_gdd_var = "GDDACCUM" my_vars = [clm_gdd_var, "GDDHARV"] - patterns = [f"*h2.{this_year-1}-01*.nc", f"*h2.{this_year-1}-01*.nc.base"] + patterns = [f"*h2i.{this_year-1}-01*.nc", f"*h2i.{this_year-1}-01*.nc.base"] for pat in patterns: pattern = os.path.join(indir, pat) h2_files = glob.glob(pattern) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 23096722db..74d4185a56 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -46,9 +46,12 @@ module histFileMod integer , public, parameter :: max_tapes = 10 ! max number of history tapes integer , public, parameter :: max_flds = 2500 ! max number of history fields integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name - integer , public, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types + integer , private, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types integer , private, parameter :: avgflag_strlen = 10 ! maximum number of characters for avgflag integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names + integer , private, parameter :: max_split_files = 2 ! max number of files per tape + integer , private, parameter :: accumulated_file_index = 1 ! non-instantaneous file identifier + integer , private, parameter :: instantaneous_file_index = 2 ! instantaneous file identifier ! Possible ways to treat multi-layer snow fields at times when no snow is present in a ! given layer. Note that the public parameters are the only ones that can be used by @@ -141,7 +144,7 @@ module histFileMod fexcl(max_flds,max_tapes) ! copy of hist_fexcl* fields in 2-D format. Note Fortran ! used to have a bug in 2-D namelists, thus this workaround. - logical, private :: if_disphist(max_tapes) ! restart, true => save history file + logical, private :: if_disphist(max_tapes, max_split_files) ! restart, true => save history file ! ! !PUBLIC MEMBER FUNCTIONS: (in rough call order) public :: hist_addfld1d ! Add a 1d single-level field to the list of all history fields @@ -258,7 +261,7 @@ end subroutine copy_entry_interface ! practice are all disabled. Fields for those tapes have to be specified ! explicitly and manually via hist_fincl2 et al. type, extends(entry_base) :: allhistfldlist_entry - logical :: actflag(max_tapes) ! which history tapes to write to. + logical :: actflag(max_tapes,max_split_files) ! which history tapes to write to character(len=avgflag_strlen) :: avgflag(max_tapes) ! type of time averaging contains procedure :: copy => copy_allhistfldlist_entry @@ -280,16 +283,15 @@ end subroutine copy_entry_interface ! tapes is assembled in the 'allhistfldlist' variable. Note that the first history tape is index 1 in ! the code but contains 'h0' in its output filenames (see set_hist_filename method). type history_tape - integer :: nflds ! number of active fields on tape - integer :: ntimes ! current number of time samples on tape + integer :: nflds(max_split_files) ! number of active fields on file + integer :: ntimes(max_split_files) ! current number of time samples on tape; although ntimes is an array, all its values are the same integer :: mfilt ! maximum number of time samples per tape integer :: nhtfrq ! number of time samples per tape integer :: ncprec ! netcdf output precision logical :: dov2xy ! true => do xy average for all fields logical :: is_endhist ! true => current time step is end of history interval real(r8) :: begtime ! time at beginning of history averaging interval - type (history_entry) :: hlist(max_flds) ! array of active history tape entries. - ! The ordering matches the allhistfldlist's. + type (history_entry) :: hlist(max_flds, max_split_files) ! array of active history tape and file entries listed in the same order as in allhistfldlist, but hlist contains the active subset of all the fields end type history_tape type clmpoint_rs ! Pointer to real scalar data (1D) @@ -312,10 +314,10 @@ end subroutine copy_entry_interface ! type (allhistfldlist_entry) :: allhistfldlist(max_flds) ! list of all history fields ! - ! Whether each history tape is in use in this run. If history_tape_in_use(i) is false, - ! then data in tape(i) is undefined and should not be referenced. + ! Whether each history tape is in use in this run. If history_tape_in_use(i,j) is false, + ! then data in [tape(i), file(j)] is undefined and should not be referenced. ! - logical :: history_tape_in_use(max_tapes) ! whether each history tape is in use in this run + logical :: history_tape_in_use(max_tapes, max_split_files) ! history tape is/isn't in use in this run ! ! The actual (accumulated) history data for all active fields in each in-use tape. See ! 'history_tape_in_use' for in-use tapes, and 'allhistfldlist' for active fields. See also @@ -331,14 +333,14 @@ end subroutine copy_entry_interface ! ! Other variables ! - character(len=max_length_filename) :: locfnh(max_tapes) ! local history file names - character(len=max_length_filename) :: locfnhr(max_tapes) ! local history restart file names + character(len=max_length_filename) :: locfnh(max_tapes, max_split_files) ! local history file names + character(len=max_length_filename) :: locfnhr(max_tapes, max_split_files) ! local history restart file names logical :: htapes_defined = .false. ! flag indicates history output fields have been defined ! ! NetCDF Id's ! - type(file_desc_t), target :: nfid(max_tapes) ! file ids - type(file_desc_t), target :: ncid_hist(max_tapes) ! file ids for history restart files + type(file_desc_t), target :: nfid(max_tapes, max_split_files) ! file ids + type(file_desc_t), target :: ncid_hist(max_tapes, max_split_files) ! file ids for history restart files integer :: time_dimid ! time dimension id integer :: nbnd_dimid ! time bounds dimension id integer :: strlen_dimid ! string dimension id @@ -372,7 +374,7 @@ subroutine hist_printflds() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: - integer, parameter :: ncol = 5 ! number of table columns + integer, parameter :: ncol = 6 ! number of table columns integer nf, i, j ! do-loop counters integer hist_fields_file ! file unit number integer width_col(ncol) ! widths of table columns @@ -401,7 +403,7 @@ subroutine hist_printflds() ! the CTSM's web-based documentation. ! First sort the list to be in alphabetical order - call sort_hist_list(1, nallhistflds, allhistfldlist) + call sort_hist_list(nallhistflds, allhistfldlist) if (masterproc .and. hist_fields_list_file) then ! Hardwired table column widths to fit the table on a computer @@ -413,7 +415,8 @@ subroutine hist_printflds() width_col(2) = hist_dim_name_length ! level dimension column width_col(3) = 94 ! long description column width_col(4) = 65 ! units column - width_col(5) = 7 ! active (T or F) column + width_col(5) = 10 ! active (T or F) column + width_col(6) = 12 ! active (T or F) column width_col_sum = sum(width_col) + ncol - 1 ! sum of widths & blank spaces ! Convert integer widths to strings for use in format statements @@ -467,9 +470,9 @@ subroutine hist_printflds() fmt_txt = '('//str_w_col_sum//'a)' write(hist_fields_file,fmt_txt) ('-', i=1, width_col_sum) ! Concatenate strings needed in format statement - fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',x,a'//str_width_col(5)//')' + fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',x,a'//str_width_col(5)//',x,a'//str_width_col(6)//')' write(hist_fields_file,fmt_txt) 'Variable Name', & - 'Level Dim.', 'Long Description', 'Units', 'Active?' + 'Level Dim.', 'Long Description', 'Units', "Active 'I'", "Act. not 'I'" ! End header, same as header ! Concatenate strings needed in format statement @@ -481,14 +484,14 @@ subroutine hist_printflds() ! Main table ! Concatenate strings needed in format statement - fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//')' + fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//',l'//str_width_col(6)//')' do nf = 1,nallhistflds write(hist_fields_file,fmt_txt) & allhistfldlist(nf)%field%name, & allhistfldlist(nf)%field%type2d, & allhistfldlist(nf)%field%long_name, & allhistfldlist(nf)%field%units, & - allhistfldlist(nf)%actflag(1) + allhistfldlist(nf)%actflag(1,:) end do ! Table footer, same as header @@ -538,7 +541,7 @@ subroutine allhistfldlist_addfld (fname, numdims, type1d, type1d_out, & ! ! !LOCAL VARIABLES: integer :: n ! loop index - integer :: f ! allhistfldlist index + integer :: fld ! allhistfldlist index integer :: numa ! total number of atm cells across all processors integer :: numg ! total number of gridcells across all processors integer :: numl ! total number of landunits across all processors @@ -583,7 +586,7 @@ subroutine allhistfldlist_addfld (fname, numdims, type1d, type1d_out, & ! Increase number of fields on list of all history fields nallhistflds = nallhistflds + 1 - f = nallhistflds + fld = nallhistflds ! Check number of fields in list against maximum number @@ -595,49 +598,49 @@ subroutine allhistfldlist_addfld (fname, numdims, type1d, type1d_out, & ! Add field to list of all history fields - allhistfldlist(f)%field%name = fname - allhistfldlist(f)%field%long_name = long_name - allhistfldlist(f)%field%units = units - allhistfldlist(f)%field%type1d = type1d - allhistfldlist(f)%field%type1d_out = type1d_out - allhistfldlist(f)%field%type2d = type2d - allhistfldlist(f)%field%numdims = numdims - allhistfldlist(f)%field%num2d = num2d - allhistfldlist(f)%field%hpindex = hpindex - allhistfldlist(f)%field%p2c_scale_type = p2c_scale_type - allhistfldlist(f)%field%c2l_scale_type = c2l_scale_type - allhistfldlist(f)%field%l2g_scale_type = l2g_scale_type + allhistfldlist(fld)%field%name = fname + allhistfldlist(fld)%field%long_name = long_name + allhistfldlist(fld)%field%units = units + allhistfldlist(fld)%field%type1d = type1d + allhistfldlist(fld)%field%type1d_out = type1d_out + allhistfldlist(fld)%field%type2d = type2d + allhistfldlist(fld)%field%numdims = numdims + allhistfldlist(fld)%field%num2d = num2d + allhistfldlist(fld)%field%hpindex = hpindex + allhistfldlist(fld)%field%p2c_scale_type = p2c_scale_type + allhistfldlist(fld)%field%c2l_scale_type = c2l_scale_type + allhistfldlist(fld)%field%l2g_scale_type = l2g_scale_type select case (type1d) case (grlnd) - allhistfldlist(f)%field%beg1d = bounds%begg - allhistfldlist(f)%field%end1d = bounds%endg - allhistfldlist(f)%field%num1d = numg + allhistfldlist(fld)%field%beg1d = bounds%begg + allhistfldlist(fld)%field%end1d = bounds%endg + allhistfldlist(fld)%field%num1d = numg case (nameg) - allhistfldlist(f)%field%beg1d = bounds%begg - allhistfldlist(f)%field%end1d = bounds%endg - allhistfldlist(f)%field%num1d = numg + allhistfldlist(fld)%field%beg1d = bounds%begg + allhistfldlist(fld)%field%end1d = bounds%endg + allhistfldlist(fld)%field%num1d = numg case (namel) - allhistfldlist(f)%field%beg1d = bounds%begl - allhistfldlist(f)%field%end1d = bounds%endl - allhistfldlist(f)%field%num1d = numl + allhistfldlist(fld)%field%beg1d = bounds%begl + allhistfldlist(fld)%field%end1d = bounds%endl + allhistfldlist(fld)%field%num1d = numl case (namec) - allhistfldlist(f)%field%beg1d = bounds%begc - allhistfldlist(f)%field%end1d = bounds%endc - allhistfldlist(f)%field%num1d = numc + allhistfldlist(fld)%field%beg1d = bounds%begc + allhistfldlist(fld)%field%end1d = bounds%endc + allhistfldlist(fld)%field%num1d = numc case (namep) - allhistfldlist(f)%field%beg1d = bounds%begp - allhistfldlist(f)%field%end1d = bounds%endp - allhistfldlist(f)%field%num1d = nump + allhistfldlist(fld)%field%beg1d = bounds%begp + allhistfldlist(fld)%field%end1d = bounds%endp + allhistfldlist(fld)%field%num1d = nump case default write(iulog,*) trim(subname),' ERROR: unknown 1d output type= ',type1d call endrun(msg=errMsg(sourcefile, __LINE__)) end select if (present(no_snow_behavior)) then - allhistfldlist(f)%field%no_snow_behavior = no_snow_behavior + allhistfldlist(fld)%field%no_snow_behavior = no_snow_behavior else - allhistfldlist(f)%field%no_snow_behavior = no_snow_unset + allhistfldlist(fld)%field%no_snow_behavior = no_snow_unset end if ! The following two fields are used only in list of all history fields, @@ -645,8 +648,8 @@ subroutine allhistfldlist_addfld (fname, numdims, type1d, type1d_out, & ! ALL FIELDS IN THE FORMER ARE INITIALIZED WITH THE ACTIVE ! FLAG SET TO FALSE - allhistfldlist(f)%avgflag(:) = avgflag - allhistfldlist(f)%actflag(:) = .false. + allhistfldlist(fld)%avgflag(:) = avgflag + allhistfldlist(fld)%actflag(:,:) = .false. end subroutine allhistfldlist_addfld @@ -704,7 +707,7 @@ subroutine hist_htapes_build () ! Note - with netcdf, only 1 (ncd_double) and 2 (ncd_float) are allowed do t=1,ntapes - tape(t)%ntimes = 0 + tape(t)%ntimes(:) = 0 tape(t)%dov2xy = hist_dov2xy(t) tape(t)%nhtfrq = hist_nhtfrq(t) tape(t)%mfilt = hist_mfilt(t) @@ -744,7 +747,7 @@ subroutine allhistfldlist_make_active (name, tape_index, avgflag) character(len=*), intent(in), optional :: avgflag ! time averaging flag ! ! !LOCAL VARIABLES: - integer :: f ! field index + integer :: fld ! field index logical :: found ! flag indicates field found in allhistfldlist character(len=*),parameter :: subname = 'allhistfldlist_make_active' !----------------------------------------------------------------------- @@ -768,11 +771,15 @@ subroutine allhistfldlist_make_active (name, tape_index, avgflag) ! Also reset averaging flag if told to use other than default. found = .false. - do f = 1,nallhistflds - if (trim(name) == trim(allhistfldlist(f)%field%name)) then - allhistfldlist(f)%actflag(tape_index) = .true. + do fld = 1, nallhistflds + if (trim(name) == trim(allhistfldlist(fld)%field%name)) then if (present(avgflag)) then - if (avgflag/= ' ') allhistfldlist(f)%avgflag(tape_index) = avgflag + if (avgflag /= ' ') allhistfldlist(fld)%avgflag(tape_index) = avgflag + end if + if (allhistfldlist(fld)%avgflag(tape_index) == 'I') then + allhistfldlist(fld)%actflag(tape_index,instantaneous_file_index) = .true. + else + allhistfldlist(fld)%actflag(tape_index,accumulated_file_index) = .true. end if found = .true. exit @@ -796,7 +803,7 @@ subroutine allhistfldlist_change_timeavg (t) integer, intent(in) :: t ! history tape index ! ! !LOCAL VARIABLES: - integer :: f ! field index + integer :: fld ! field index character(len=avgflag_strlen) :: avgflag ! local equiv of hist_avgflag_pertape(t) character(len=*),parameter :: subname = 'allhistfldlist_change_timeavg' !----------------------------------------------------------------------- @@ -807,8 +814,8 @@ subroutine allhistfldlist_change_timeavg (t) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - do f = 1,nallhistflds - allhistfldlist(f)%avgflag(t) = avgflag + do fld = 1, nallhistflds + allhistfldlist(fld)%avgflag(t) = avgflag end do end subroutine allhistfldlist_change_timeavg @@ -828,7 +835,8 @@ subroutine htapes_fieldlist() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: - integer :: t, f ! tape, field indices + class(entry_base), pointer :: tmp_hlist(:) ! temporary subset of hlist to pass as call argument + integer :: t, f, fld ! tape, file, field indices integer :: ff ! index into include, exclude and fprec list character(len=max_namlen) :: name ! field name portion of fincl (i.e. no avgflag separator) character(len=max_namlen) :: allhistfldname ! name from allhistfldlist field @@ -872,40 +880,40 @@ subroutine htapes_fieldlist() ! First ensure contents of fincl and fexcl are valid names - do t = 1,max_tapes - f = 1 - do while (f < max_flds .and. fincl(f,t) /= ' ') - name = getname (fincl(f,t)) + tape_loop1: do t = 1, max_tapes + fld = 1 + do while (fld < max_flds .and. fincl(fld,t) /= ' ') + name = getname (fincl(fld,t)) do ff = 1,nallhistflds allhistfldname = allhistfldlist(ff)%field%name if (name == allhistfldname) exit end do if (name /= allhistfldname) then - write(iulog,*) trim(subname),' ERROR: ', trim(name), ' in fincl(', f, ') ',& + write(iulog,*) trim(subname),' ERROR: ', trim(name), ' in fincl(', fld, ') ',& 'for history tape ',t,' not found' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - f = f + 1 + fld = fld + 1 end do - f = 1 - do while (f < max_flds .and. fexcl(f,t) /= ' ') + fld = 1 + do while (fld < max_flds .and. fexcl(fld,t) /= ' ') do ff = 1,nallhistflds allhistfldname = allhistfldlist(ff)%field%name - if (fexcl(f,t) == allhistfldname) exit + if (fexcl(fld,t) == allhistfldname) exit end do - if (fexcl(f,t) /= allhistfldname) then - write(iulog,*) trim(subname),' ERROR: ', fexcl(f,t), ' in fexcl(', f, ') ', & + if (fexcl(fld,t) /= allhistfldname) then + write(iulog,*) trim(subname),' ERROR: ', fexcl(fld,t), ' in fexcl(', fld, ') ', & 'for history tape ',t,' not found' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - f = f + 1 + fld = fld + 1 end do - end do + history_tape_in_use(t,:) = .false. + tape(t)%nflds(:) = 0 + end do tape_loop1 - history_tape_in_use(:) = .false. - tape(:)%nflds = 0 - do t = 1,max_tapes + tape_loop2: do t = 1, max_tapes ! Loop through the allhistfldlist set of field names and determine if any of those ! are in the FINCL or FEXCL arrays @@ -914,68 +922,101 @@ subroutine htapes_fieldlist() ! Add the field to the tape if specified via namelist (FINCL[1-max_tapes]), ! or if it is on by default and was not excluded via namelist (FEXCL[1-max_tapes]). - do f = 1,nallhistflds - allhistfldname = allhistfldlist(f)%field%name - call list_index (fincl(1,t), allhistfldname, ff) + file_loop1: do f = 1, max_split_files + fld_loop: do fld = 1, nallhistflds + allhistfldname = allhistfldlist(fld)%field%name + call list_index (fincl(1,t), allhistfldname, ff) - if (ff > 0) then + ff_gt_0: if (ff > 0) then - ! if field is in include list, ff > 0 and htape_addfld - ! will be called for field + ! if field is in include list, ff > 0 and htape_addfld + ! will be called for field - avgflag = getflag (fincl(ff,t)) - call htape_addfld (t, f, avgflag) + avgflag = getflag (fincl(ff,t)) - else if (.not. hist_empty_htapes) then + ! Set time averaging flag based on allhistfldlist setting or + ! override the default averaging flag with namelist setting - ! find index of field in exclude list + if (.not. avgflag_valid(avgflag, blank_valid=.true.)) then + write(iulog,*) trim(subname),' ERROR: unknown avgflag=', avgflag + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - call list_index (fexcl(1,t), allhistfldname, ff) + if (avgflag == ' ') then + avgflag = allhistfldlist(fld)%avgflag(t) + end if - ! if field is in exclude list, ff > 0 and htape_addfld - ! will not be called for field - ! if field is not in exclude list, ff =0 and htape_addfld - ! will be called for field (note that htape_addfld will be - ! called below only if field is not in exclude list OR in - ! include list + ! This if-statement is in a loop of f (instantaneous_ or + ! accumulated_file_index) so it matters whether f is one + ! or the other when going through here. Otherwise all fields + ! would end up on all files, which is not the intent. + if (f == instantaneous_file_index .and. avgflag == 'I') then + call htape_addfld (t, f, fld, avgflag) + else if (f == accumulated_file_index .and. avgflag /= 'I') then + call htape_addfld (t, f, fld, avgflag) + else if (f /= instantaneous_file_index .and. f /= accumulated_file_index) then + write(iulog,*) trim(subname),' ERROR: invalid f =', f, ' should be one of these values:', accumulated_file_index, instantaneous_file_index + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - if (ff == 0 .and. allhistfldlist(f)%actflag(t)) then - call htape_addfld (t, f, ' ') - end if + else if (.not. hist_empty_htapes) then - end if - end do + ! find index of field in exclude list - ! Specification of tape contents now complete. - ! Sort each list of active entries - call sort_hist_list(t, tape(t)%nflds, tape(t)%hlist) + call list_index (fexcl(1,t), allhistfldname, ff) - if (masterproc) then - if (tape(t)%nflds > 0) then - write(iulog,*) trim(subname),' : Included fields tape ',t,'=',tape(t)%nflds + ! if field is in exclude list, ff > 0 and htape_addfld + ! will not be called for field + ! if field is not in exclude list, ff =0 and htape_addfld + ! will be called for field (note that htape_addfld will be + ! called below only if field is not in exclude list OR in + ! include list + + if (ff == 0 .and. allhistfldlist(fld)%actflag(t,f)) then + call htape_addfld (t, f, fld, ' ') + end if + + end if ff_gt_0 + end do fld_loop + + ! Specification of tape contents now complete. + ! Sort each list of active entries + associate(tmp_hlist => tape(t)%hlist(:,f)) + call sort_hist_list(tape(t)%nflds(f), tmp_hlist(:)) + end associate + + if (masterproc) then + if (tape(t)%nflds(f) > 0) then + write(iulog,*) trim(subname),' : Included fields tape ', t, '=',tape(t)%nflds(f) + end if + do fld = 1, tape(t)%nflds(f) + write(iulog,*) fld, ' ', tape(t)%hlist(fld,f)%field%name, & + tape(t)%hlist(fld,f)%field%num2d, ' ', tape(t)%hlist(fld,f)%avgflag + end do + call shr_sys_flush(iulog) end if - do f = 1,tape(t)%nflds - write(iulog,*) f,' ',tape(t)%hlist(f)%field%name, & - tape(t)%hlist(f)%field%num2d,' ',tape(t)%hlist(f)%avgflag - end do - call shr_sys_flush(iulog) - end if - end do + end do file_loop1 + end do tape_loop2 ! Determine index of max active history tape, and whether each tape is in use ntapes = 0 do t = max_tapes,1,-1 - if (tape(t)%nflds > 0) then - ntapes = t - exit - end if + do f = 1, max_split_files + if (tape(t)%nflds(f) > 0) then + ntapes = t + exit + end if + end do + if (ntapes > 0) exit end do do t = 1, ntapes - if (tape(t)%nflds > 0) then - history_tape_in_use(t) = .true. - end if + do f = 1, max_split_files + if (tape(t)%nflds(f) > 0) then + history_tape_in_use(t,f) = .true. + end if + end do end do ! Change 1d output per tape output flag if requested - only for history @@ -996,7 +1037,7 @@ subroutine htapes_fieldlist() if (masterproc) then write(iulog,*) 'There will be a total of ',ntapes,' history tapes' - do t=1,ntapes + tape_loop3: do t = 1, ntapes write(iulog,*) if (hist_nhtfrq(t) == 0) then write(iulog,*)'History tape ',t,' write frequency is MONTHLY' @@ -1010,12 +1051,14 @@ subroutine htapes_fieldlist() end if write(iulog,*)'Number of time samples on history tape ',t,' is ',hist_mfilt(t) write(iulog,*)'Output precision on history tape ',t,'=',hist_ndens(t) - if (.not. history_tape_in_use(t)) then - write(iulog,*) 'History tape ',t,' does not have any fields,' - write(iulog,*) 'so it will not be written!' - end if + file_loop2: do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + write(iulog,*) 'History tape ', t,' and file ', f, ' has no fields,' + write(iulog,*) 'so it will not be written!' + end if + end do file_loop2 write(iulog,*) - end do + end do tape_loop3 call shr_sys_flush(iulog) end if @@ -1065,19 +1108,18 @@ subroutine copy_history_entry(this, other) end subroutine copy_history_entry !----------------------------------------------------------------------- - subroutine sort_hist_list(t, n_fields, hist_list) + subroutine sort_hist_list(n_fields, hist_list) ! !DESCRIPTION: ! Sort list of history variable names hist_list in alphabetical ! order. ! !ARGUMENTS: - integer, intent(in) :: t ! tape index integer, intent(in) :: n_fields ! number of fields class(entry_base), intent(inout) :: hist_list(:) ! !LOCAL VARIABLES: - integer :: f, ff ! field indices + integer :: fld, ff ! field indices class(entry_base), allocatable :: tmp character(len=*), parameter :: subname = 'sort_hist_list' @@ -1091,8 +1133,8 @@ subroutine sort_hist_list(t, n_fields, hist_list) allocate(tmp, source = hist_list(1)) - do f = n_fields-1, 1, -1 - do ff = 1, f + do fld = n_fields-1, 1, -1 + do ff = 1, fld ! First sort by the name of the level dimension; then, within the list of ! fields with the same level dimension, sort by field name. Sorting first by ! the level dimension gives a significant performance improvement especially @@ -1147,14 +1189,15 @@ logical function is_mapping_upto_subgrid( type1d, type1d_out ) result ( mapping) end function is_mapping_upto_subgrid !----------------------------------------------------------------------- - subroutine htape_addfld (t, f, avgflag) + subroutine htape_addfld (t, f, fld, avgflag) ! ! !DESCRIPTION: ! Add a field to a history tape, copying metadata from the list of all history fields ! ! !ARGUMENTS: integer, intent(in) :: t ! history tape index - integer, intent(in) :: f ! field index from list of all history fields + integer, intent(in) :: f ! history file index + integer, intent(in) :: fld ! field index from list of all history fields character(len=*), intent(in) :: avgflag ! time averaging flag ! ! !LOCAL VARIABLES: @@ -1179,16 +1222,16 @@ subroutine htape_addfld (t, f, avgflag) if (htapes_defined) then write(iulog,*) trim(subname),' ERROR: attempt to add field ', & - allhistfldlist(f)%field%name, ' after history files are set' + allhistfldlist(fld)%field%name, ' after history files are set' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - tape(t)%nflds = tape(t)%nflds + 1 - n = tape(t)%nflds + tape(t)%nflds(f) = tape(t)%nflds(f) + 1 + n = tape(t)%nflds(f) ! Copy field information - tape(t)%hlist(n)%field = allhistfldlist(f)%field + tape(t)%hlist(n,f)%field = allhistfldlist(fld)%field ! Determine bounds @@ -1203,16 +1246,16 @@ subroutine htape_addfld (t, f, avgflag) ! ***NOTE- the following logic is what permits non lat/lon grids to ! be written to clm history file - type1d = tape(t)%hlist(n)%field%type1d + type1d = tape(t)%hlist(n,f)%field%type1d if (type1d == nameg .or. & type1d == namel .or. & type1d == namec .or. & type1d == namep) then - tape(t)%hlist(n)%field%type1d_out = grlnd + tape(t)%hlist(n,f)%field%type1d_out = grlnd end if if (type1d == grlnd) then - tape(t)%hlist(n)%field%type1d_out = grlnd + tape(t)%hlist(n,f)%field%type1d_out = grlnd end if else if (hist_type1d_pertape(t) /= ' ') then @@ -1220,17 +1263,17 @@ subroutine htape_addfld (t, f, avgflag) ! Set output 1d type based on namelist setting of hist_type1d_pertape ! Only applies to tapes when xy output is not required - type1d = tape(t)%hlist(n)%field%type1d + type1d = tape(t)%hlist(n,f)%field%type1d select case (trim(hist_type1d_pertape(t))) case('GRID') - tape(t)%hlist(n)%field%type1d_out = nameg + tape(t)%hlist(n,f)%field%type1d_out = nameg case('LAND') - tape(t)%hlist(n)%field%type1d_out = namel + tape(t)%hlist(n,f)%field%type1d_out = namel case('COLS') - tape(t)%hlist(n)%field%type1d_out = namec + tape(t)%hlist(n,f)%field%type1d_out = namec case ('PFTS') - tape(t)%hlist(n)%field%type1d_out = namep + tape(t)%hlist(n,f)%field%type1d_out = namep case default write(iulog,*) trim(subname),' ERROR: unknown input hist_type1d_pertape= ', hist_type1d_pertape(t) call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1240,7 +1283,7 @@ subroutine htape_addfld (t, f, avgflag) ! Determine output 1d dimensions - type1d_out = tape(t)%hlist(n)%field%type1d_out + type1d_out = tape(t)%hlist(n,f)%field%type1d_out if (type1d_out == grlnd) then beg1d_out = bounds%begg end1d_out = bounds%endg @@ -1267,26 +1310,26 @@ subroutine htape_addfld (t, f, avgflag) end if ! Output bounds for the field - tape(t)%hlist(n)%field%beg1d_out = beg1d_out - tape(t)%hlist(n)%field%end1d_out = end1d_out - tape(t)%hlist(n)%field%num1d_out = num1d_out + tape(t)%hlist(n,f)%field%beg1d_out = beg1d_out + tape(t)%hlist(n,f)%field%end1d_out = end1d_out + tape(t)%hlist(n,f)%field%num1d_out = num1d_out ! Fields native bounds - beg1d = allhistfldlist(f)%field%beg1d - end1d = allhistfldlist(f)%field%end1d + beg1d = allhistfldlist(fld)%field%beg1d + end1d = allhistfldlist(fld)%field%end1d - ! Alloccate and initialize history buffer and related info + ! Allocate and initialize history buffer and related info - num2d = tape(t)%hlist(n)%field%num2d + num2d = tape(t)%hlist(n,f)%field%num2d if ( is_mapping_upto_subgrid( type1d, type1d_out ) ) then - allocate (tape(t)%hlist(n)%hbuf(beg1d_out:end1d_out,num2d)) - allocate (tape(t)%hlist(n)%nacs(beg1d_out:end1d_out,num2d)) + allocate (tape(t)%hlist(n,f)%hbuf(beg1d_out:end1d_out,num2d)) + allocate (tape(t)%hlist(n,f)%nacs(beg1d_out:end1d_out,num2d)) else - allocate (tape(t)%hlist(n)%hbuf(beg1d:end1d,num2d)) - allocate (tape(t)%hlist(n)%nacs(beg1d:end1d,num2d)) + allocate (tape(t)%hlist(n,f)%hbuf(beg1d:end1d,num2d)) + allocate (tape(t)%hlist(n,f)%nacs(beg1d:end1d,num2d)) end if - tape(t)%hlist(n)%hbuf(:,:) = 0._r8 - tape(t)%hlist(n)%nacs(:,:) = 0 + tape(t)%hlist(n,f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(n,f)%nacs(:,:) = 0 ! Set time averaging flag based on allhistfldlist setting or ! override the default averaging flag with namelist setting @@ -1297,9 +1340,9 @@ subroutine htape_addfld (t, f, avgflag) end if if (avgflag == ' ') then - tape(t)%hlist(n)%avgflag = allhistfldlist(f)%avgflag(t) + tape(t)%hlist(n,f)%avgflag = allhistfldlist(fld)%avgflag(t) else - tape(t)%hlist(n)%avgflag = avgflag + tape(t)%hlist(n,f)%avgflag = avgflag end if ! Override this tape's avgflag if nhtfrq == 1 @@ -1312,7 +1355,7 @@ subroutine htape_addfld (t, f, avgflag) ! - local time (L) avgflag_temp = hist_avgflag_pertape(t) if (avgflag_temp == 'I' .or. avgflag_temp(1:1) == 'L') then - tape(t)%hlist(n)%avgflag = avgflag_temp + tape(t)%hlist(n,f)%avgflag = avgflag_temp end if end subroutine htape_addfld @@ -1329,33 +1372,36 @@ subroutine hist_update_hbuf(bounds) ! ! !LOCAL VARIABLES: integer :: t ! tape index - integer :: f ! field index + integer :: f ! file index + integer :: fld ! field index integer :: num2d ! size of second dimension (e.g. number of vertical levels) integer :: numdims ! number of dimensions character(len=*),parameter :: subname = 'hist_update_hbuf' character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)","mxsowings","mxharvests"] !----------------------------------------------------------------------- - do t = 1,ntapes -!$OMP PARALLEL DO PRIVATE (f, num2d, numdims) - do f = 1,tape(t)%nflds + tape_loop: do t = 1, ntapes + file_loop: do f = 1, max_split_files +!$OMP PARALLEL DO PRIVATE (fld, num2d, numdims) + do fld = 1, tape(t)%nflds(f) - numdims = tape(t)%hlist(f)%field%numdims + numdims = tape(t)%hlist(fld,f)%field%numdims - if ( numdims == 1) then - call hist_update_hbuf_field_1d (t, f, bounds) - else - num2d = tape(t)%hlist(f)%field%num2d - call hist_update_hbuf_field_2d (t, f, bounds, num2d) - end if - end do + if ( numdims == 1) then + call hist_update_hbuf_field_1d (t, f, fld, bounds) + else + num2d = tape(t)%hlist(fld,f)%field%num2d + call hist_update_hbuf_field_2d (t, f, fld, bounds, num2d) + end if + end do !$OMP END PARALLEL DO - end do + end do file_loop + end do tape_loop end subroutine hist_update_hbuf !----------------------------------------------------------------------- - subroutine hist_update_hbuf_field_1d (t, f, bounds) + subroutine hist_update_hbuf_field_1d (t, f, fld, bounds) ! ! !DESCRIPTION: ! Accumulate (or take min, max, etc. as appropriate) input field @@ -1372,7 +1418,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index - integer, intent(in) :: f ! field index + integer, intent(in) :: f ! file index + integer, intent(in) :: fld ! field index type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: @@ -1412,19 +1459,19 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) SHR_ASSERT_FL(bounds%level == bounds_level_proc, sourcefile, __LINE__) - avgflag = tape(t)%hlist(f)%avgflag - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - beg1d = tape(t)%hlist(f)%field%beg1d - end1d = tape(t)%hlist(f)%field%end1d - beg1d_out = tape(t)%hlist(f)%field%beg1d_out - end1d_out = tape(t)%hlist(f)%field%end1d_out - type1d = tape(t)%hlist(f)%field%type1d - type1d_out = tape(t)%hlist(f)%field%type1d_out - p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type - c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type - l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type - hpindex = tape(t)%hlist(f)%field%hpindex + avgflag = tape(t)%hlist(fld,f)%avgflag + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + beg1d = tape(t)%hlist(fld,f)%field%beg1d + end1d = tape(t)%hlist(fld,f)%field%end1d + beg1d_out = tape(t)%hlist(fld,f)%field%beg1d_out + end1d_out = tape(t)%hlist(fld,f)%field%end1d_out + type1d = tape(t)%hlist(fld,f)%field%type1d + type1d_out = tape(t)%hlist(fld,f)%field%type1d_out + p2c_scale_type = tape(t)%hlist(fld,f)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(fld,f)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(fld,f)%field%l2g_scale_type + hpindex = tape(t)%hlist(fld,f)%field%hpindex field => clmptr_rs(hpindex)%ptr call get_curr_date (year, month, day, secs) @@ -1718,7 +1765,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end subroutine hist_update_hbuf_field_1d !----------------------------------------------------------------------- - subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) + subroutine hist_update_hbuf_field_2d (t, f, fld, bounds, num2d) ! ! !DESCRIPTION: ! Accumulate (or take min, max, etc. as appropriate) input field @@ -1736,7 +1783,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index - integer, intent(in) :: f ! field index + integer, intent(in) :: f ! file index + integer, intent(in) :: fld ! field index type(bounds_type), intent(in) :: bounds integer, intent(in) :: num2d ! size of second dimension ! @@ -1779,20 +1827,20 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) SHR_ASSERT_FL(bounds%level == bounds_level_proc, sourcefile, __LINE__) - avgflag = tape(t)%hlist(f)%avgflag - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - beg1d = tape(t)%hlist(f)%field%beg1d - end1d = tape(t)%hlist(f)%field%end1d - beg1d_out = tape(t)%hlist(f)%field%beg1d_out - end1d_out = tape(t)%hlist(f)%field%end1d_out - type1d = tape(t)%hlist(f)%field%type1d - type1d_out = tape(t)%hlist(f)%field%type1d_out - p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type - c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type - l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type - no_snow_behavior = tape(t)%hlist(f)%field%no_snow_behavior - hpindex = tape(t)%hlist(f)%field%hpindex + avgflag = tape(t)%hlist(fld,f)%avgflag + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + beg1d = tape(t)%hlist(fld,f)%field%beg1d + end1d = tape(t)%hlist(fld,f)%field%end1d + beg1d_out = tape(t)%hlist(fld,f)%field%beg1d_out + end1d_out = tape(t)%hlist(fld,f)%field%end1d_out + type1d = tape(t)%hlist(fld,f)%field%type1d + type1d_out = tape(t)%hlist(fld,f)%field%type1d_out + p2c_scale_type = tape(t)%hlist(fld,f)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(fld,f)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(fld,f)%field%l2g_scale_type + no_snow_behavior = tape(t)%hlist(fld,f)%field%no_snow_behavior + hpindex = tape(t)%hlist(fld,f)%field%hpindex call get_curr_date (year, month, day, secs) @@ -2253,7 +2301,7 @@ end subroutine hist_set_snow_field_2d !----------------------------------------------------------------------- - subroutine hfields_normalize (t) + subroutine hfields_normalize (t, f) ! ! !DESCRIPTION: ! Normalize fields on a history file by the number of accumulations. @@ -2262,9 +2310,10 @@ subroutine hfields_normalize (t) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index ! ! !LOCAL VARIABLES: - integer :: f ! field index + integer :: fld ! field index integer :: k ! 1d index integer :: j ! 2d index logical :: aflag ! averaging flag @@ -2278,18 +2327,18 @@ subroutine hfields_normalize (t) ! Normalize by number of accumulations for time averaged case - do f = 1,tape(t)%nflds - avgflag = tape(t)%hlist(f)%avgflag - if ( is_mapping_upto_subgrid(tape(t)%hlist(f)%field%type1d, tape(t)%hlist(f)%field%type1d_out) )then - beg1d = tape(t)%hlist(f)%field%beg1d_out - end1d = tape(t)%hlist(f)%field%end1d_out + do fld = 1, tape(t)%nflds(f) + avgflag = tape(t)%hlist(fld,f)%avgflag + if ( is_mapping_upto_subgrid(tape(t)%hlist(fld,f)%field%type1d, tape(t)%hlist(fld,f)%field%type1d_out) )then + beg1d = tape(t)%hlist(fld,f)%field%beg1d_out + end1d = tape(t)%hlist(fld,f)%field%end1d_out else - beg1d = tape(t)%hlist(f)%field%beg1d - end1d = tape(t)%hlist(f)%field%end1d + beg1d = tape(t)%hlist(fld,f)%field%beg1d + end1d = tape(t)%hlist(fld,f)%field%end1d end if - num2d = tape(t)%hlist(f)%field%num2d - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf + num2d = tape(t)%hlist(fld,f)%field%num2d + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf if (avgflag == 'A' .or. avgflag(1:1) == 'L') then aflag = .true. @@ -2311,7 +2360,7 @@ subroutine hfields_normalize (t) end subroutine hfields_normalize !----------------------------------------------------------------------- - subroutine hfields_zero (t) + subroutine hfields_zero (t, f) ! ! !DESCRIPTION: ! Zero out accumulation and history buffers for a given history tape. @@ -2319,21 +2368,22 @@ subroutine hfields_zero (t) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index ! ! !LOCAL VARIABLES: - integer :: f ! field index + integer :: fld ! field index character(len=*),parameter :: subname = 'hfields_zero' !----------------------------------------------------------------------- - do f = 1,tape(t)%nflds - tape(t)%hlist(f)%hbuf(:,:) = 0._r8 - tape(t)%hlist(f)%nacs(:,:) = 0 + do fld = 1,tape(t)%nflds(f) + tape(t)%hlist(fld,f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(fld,f)%nacs(:,:) = 0 end do end subroutine hfields_zero !----------------------------------------------------------------------- - subroutine htape_create (t, histrest) + subroutine htape_create (t, f, histrest) ! ! !DESCRIPTION: ! Define netcdf metadata of history file t. @@ -2351,10 +2401,10 @@ subroutine htape_create (t, histrest) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index logical, intent(in), optional :: histrest ! if creating the history restart file ! ! !LOCAL VARIABLES: - integer :: f ! field index integer :: p,c,l,n ! indices integer :: ier ! error code integer :: num2d ! size of second dimension (e.g. number of vertical levels) @@ -2394,9 +2444,9 @@ subroutine htape_create (t, histrest) ncprec = tape(t)%ncprec if (lhistrest) then - lnfid => ncid_hist(t) + lnfid => ncid_hist(t,f) else - lnfid => nfid(t) + lnfid => nfid(t,f) endif ! Create new netCDF file. It will be in define mode @@ -2404,20 +2454,20 @@ subroutine htape_create (t, histrest) if ( .not. lhistrest )then if (masterproc) then write(iulog,*) trim(subname),' : Opening netcdf htape ', & - trim(locfnh(t)) + trim(locfnh(t,f)) call shr_sys_flush(iulog) end if - call ncd_pio_createfile(lnfid, trim(locfnh(t))) + call ncd_pio_createfile(lnfid, trim(locfnh(t,f))) call ncd_putatt(lnfid, ncd_global, 'title', 'CLM History file information' ) call ncd_putatt(lnfid, ncd_global, 'comment', & "NOTE: None of the variables are weighted by land fraction!" ) else if (masterproc) then write(iulog,*) trim(subname),' : Opening netcdf rhtape ', & - trim(locfnhr(t)) + trim(locfnhr(t,f)) call shr_sys_flush(iulog) end if - call ncd_pio_createfile(lnfid, trim(locfnhr(t))) + call ncd_pio_createfile(lnfid, trim(locfnhr(t,f))) call ncd_putatt(lnfid, ncd_global, 'title', & 'CLM Restart History information, required to continue a simulation' ) call ncd_putatt(lnfid, ncd_global, 'comment', & @@ -2542,7 +2592,7 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'time', ncd_unlimited, time_dimid) if (masterproc)then write(iulog,*) trim(subname), & - ' : Successfully defined netcdf history file ',t + ' : Successfully defined netcdf history file ', t, f call shr_sys_flush(iulog) end if else @@ -2665,7 +2715,7 @@ subroutine htape_add_cft_metadata(lnfid) end subroutine htape_add_cft_metadata !----------------------------------------------------------------------- - subroutine htape_timeconst3D(t, & + subroutine htape_timeconst3D(t, f, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & cellsand_col, cellclay_col, mode) ! @@ -2684,6 +2734,7 @@ subroutine htape_timeconst3D(t, & ! ! !ARGUMENTS: integer , intent(in) :: t ! tape index + integer , intent(in) :: f ! file index type(bounds_type) , intent(in) :: bounds real(r8) , intent(in) :: watsat_col( bounds%begc:,1: ) real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) @@ -2786,20 +2837,20 @@ subroutine htape_timeconst3D(t, & end if if (tape(t)%dov2xy) then if (ldomain%isgrid2d) then - call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec,& + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec,& dim1name='lon', dim2name='lat', dim3name='levgrnd', & long_name=long_name, units=units, missing_value=spval, fill_value=spval, & varid=varid) else - call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & dim1name=grlnd, dim2name='levgrnd', & long_name=long_name, units=units, missing_value=spval, fill_value=spval, & varid=varid) end if - call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_type(ifld)) + call add_landunit_mask_metadata(nfid(t,f), varid, l2g_scale_type(ifld)) else - call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & dim1name=namec, dim2name='levgrnd', & long_name=long_name, units=units, missing_value=spval, fill_value=spval) end if @@ -2849,14 +2900,14 @@ subroutine htape_timeconst3D(t, & if (ldomain%isgrid2d) then call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & - data=histo, ncid=nfid(t), flag='write') + data=histo, ncid=nfid(t,f), flag='write') else call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & - data=histo, ncid=nfid(t), flag='write') + data=histo, ncid=nfid(t,f), flag='write') end if else call ncd_io(varname=trim(varnames(ifld)), dim1name=namec, & - data=histi, ncid=nfid(t), flag='write') + data=histi, ncid=nfid(t,f), flag='write') end if end do @@ -2877,20 +2928,20 @@ subroutine htape_timeconst3D(t, & end if if (tape(t)%dov2xy) then if (ldomain%isgrid2d) then - call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec,& + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec,& dim1name='lon', dim2name='lat', dim3name='levlak', & long_name=long_name, units=units, missing_value=spval, fill_value=spval, & varid=varid) else - call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & dim1name=grlnd, dim2name='levlak', & long_name=long_name, units=units, missing_value=spval, fill_value=spval, & varid=varid) end if - call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_typel(ifld)) + call add_landunit_mask_metadata(nfid(t,f), varid, l2g_scale_typel(ifld)) else - call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & dim1name=namec, dim2name='levlak', & long_name=long_name, units=units, missing_value=spval, fill_value=spval) end if @@ -2935,14 +2986,14 @@ subroutine htape_timeconst3D(t, & c2l_scale_type='unity', l2g_scale_type=l2g_scale_typel(ifld)) if (ldomain%isgrid2d) then call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, & - data=histol, ncid=nfid(t), flag='write') + data=histol, ncid=nfid(t,f), flag='write') else call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, & - data=histol, ncid=nfid(t), flag='write') + data=histol, ncid=nfid(t,f), flag='write') end if else call ncd_io(varname=trim(varnamesl(ifld)), dim1name=namec, & - data=histil, ncid=nfid(t), flag='write') + data=histil, ncid=nfid(t,f), flag='write') end if end do @@ -2963,16 +3014,16 @@ subroutine htape_timeconst3D(t, & end if if (tape(t)%dov2xy) then if (ldomain%isgrid2d) then - call ncd_defvar(ncid=nfid(t), varname=trim(varnamest(ifld)), xtype=tape(t)%ncprec,& + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnamest(ifld)), xtype=tape(t)%ncprec,& dim1name='lon', dim2name='lat', dim3name='levsoi', & long_name=long_name, units=units, missing_value=spval, fill_value=spval) else - call ncd_defvar(ncid=nfid(t), varname=trim(varnamest(ifld)), xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnamest(ifld)), xtype=tape(t)%ncprec, & dim1name=grlnd, dim2name='levsoi', & long_name=long_name, units=units, missing_value=spval, fill_value=spval) end if else - call ncd_defvar(ncid=nfid(t), varname=trim(varnamest(ifld)), xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=trim(varnamest(ifld)), xtype=tape(t)%ncprec, & dim1name=namec, dim2name='levsoi', & long_name=long_name, units=units, missing_value=spval, fill_value=spval) end if @@ -3014,14 +3065,14 @@ subroutine htape_timeconst3D(t, & c2l_scale_type='unity', l2g_scale_type='veg') if (ldomain%isgrid2d) then call ncd_io(varname=trim(varnamest(ifld)), dim1name=grlnd, & - data=histot, ncid=nfid(t), flag='write') + data=histot, ncid=nfid(t,f), flag='write') else call ncd_io(varname=trim(varnamest(ifld)), dim1name=grlnd, & - data=histot, ncid=nfid(t), flag='write') + data=histot, ncid=nfid(t,f), flag='write') end if else call ncd_io(varname=trim(varnamest(ifld)), dim1name=namec, & - data=histit, ncid=nfid(t), flag='write') + data=histit, ncid=nfid(t,f), flag='write') end if end do @@ -3033,7 +3084,7 @@ subroutine htape_timeconst3D(t, & end subroutine htape_timeconst3D !----------------------------------------------------------------------- - subroutine htape_timeconst(t, mode) + subroutine htape_timeconst(t, f, mode) ! ! !DESCRIPTION: ! Write time constant values to primary history tape. @@ -3095,6 +3146,7 @@ subroutine htape_timeconst(t, mode) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index integer :: dtime ! timestep size character(len=*), intent(in) :: mode ! 'define' or 'write' ! @@ -3140,147 +3192,147 @@ subroutine htape_timeconst(t, mode) call get_proc_bounds(bounds) - if (tape(t)%ntimes == 1) then + if (tape(t)%ntimes(f) == 1) then if (mode == 'define') then call ncd_defvar(varname='levgrnd', xtype=tape(t)%ncprec, & dim1name='levgrnd', & - long_name='coordinate ground levels', units='m', ncid=nfid(t)) + long_name='coordinate ground levels', units='m', ncid=nfid(t,f)) call ncd_defvar(varname='levsoi', xtype=tape(t)%ncprec, & dim1name='levsoi', & - long_name='coordinate soil levels (equivalent to top nlevsoi levels of levgrnd)', units='m', ncid=nfid(t)) + long_name='coordinate soil levels (equivalent to top nlevsoi levels of levgrnd)', units='m', ncid=nfid(t,f)) call ncd_defvar(varname='levlak', xtype=tape(t)%ncprec, & dim1name='levlak', & - long_name='coordinate lake levels', units='m', ncid=nfid(t)) + long_name='coordinate lake levels', units='m', ncid=nfid(t,f)) call ncd_defvar(varname='levdcmp', xtype=tape(t)%ncprec, dim1name='levdcmp', & - long_name='coordinate levels for soil decomposition variables', units='m', ncid=nfid(t)) + long_name='coordinate levels for soil decomposition variables', units='m', ncid=nfid(t,f)) if (use_hillslope .and. .not.tape(t)%dov2xy)then call ncd_defvar(varname='hillslope_distance', xtype=ncd_double, & dim1name=namec, long_name='hillslope column distance', & - units='m', ncid=nfid(t)) + units='m', ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_width', xtype=ncd_double, & dim1name=namec, long_name='hillslope column width', & - units='m', ncid=nfid(t)) + units='m', ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_area', xtype=ncd_double, & dim1name=namec, long_name='hillslope column area', & - units='m2', ncid=nfid(t)) + units='m', ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_elev', xtype=ncd_double, & dim1name=namec, long_name='hillslope column elevation', & - units='m', ncid=nfid(t)) + units='m', ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_slope', xtype=ncd_double, & dim1name=namec, long_name='hillslope column slope', & - units='m/m', ncid=nfid(t)) + units='m', ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_aspect', xtype=ncd_double, & dim1name=namec, long_name='hillslope column aspect', & - units='radians', ncid=nfid(t)) + units='m', ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_index', xtype=ncd_int, & dim1name=namec, long_name='hillslope index', & - ncid=nfid(t)) + ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_cold', xtype=ncd_int, & dim1name=namec, long_name='hillslope downhill column index', & - ncid=nfid(t)) + ncid=nfid(t,f)) call ncd_defvar(varname='hillslope_colu', xtype=ncd_int, & dim1name=namec, long_name='hillslope uphill column index', & - ncid=nfid(t)) + ncid=nfid(t,f)) end if if(use_fates)then call ncd_defvar(varname='fates_levscls', xtype=tape(t)%ncprec, dim1name='fates_levscls', & - long_name='FATES diameter size class lower bound', units='cm', ncid=nfid(t)) + long_name='FATES diameter size class lower bound', units='cm', ncid=nfid(t,f)) call ncd_defvar(varname='fates_scmap_levscag', xtype=ncd_int, dim1name='fates_levscag', & - long_name='FATES size-class map into size x patch age', units='-', ncid=nfid(t)) + long_name='FATES size-class map into size x patch age', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_agmap_levscag', xtype=ncd_int, dim1name='fates_levscag', & - long_name='FATES age-class map into size x patch age', units='-', ncid=nfid(t)) + long_name='FATES age-class map into size x patch age', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_pftmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', & - long_name='FATES pft index of the combined pft-size class dimension', units='-', ncid=nfid(t)) + long_name='FATES pft index of the combined pft-size class dimension', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_scmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', & - long_name='FATES size index of the combined pft-size class dimension', units='-', ncid=nfid(t)) + long_name='FATES size index of the combined pft-size class dimension', units='-', ncid=nfid(t,f)) ! Units are dash here with units of yr added to the long name so ! that postprocessors (like ferret) won't get confused with what ! the time coordinate is. EBK Nov/3/2021 (see #1540) call ncd_defvar(varname='fates_levcacls', xtype=tape(t)%ncprec, dim1name='fates_levcacls', & - long_name='FATES cohort age class lower bound (yr)', units='-', ncid=nfid(t)) + long_name='FATES cohort age class lower bound (yr)', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_pftmap_levcapf',xtype=ncd_int, dim1name='fates_levcapf', & - long_name='FATES pft index of the combined pft-cohort age class dimension', units='-', ncid=nfid(t)) + long_name='FATES pft index of the combined pft-cohort age class dimension', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_camap_levcapf',xtype=ncd_int, dim1name='fates_levcapf', & - long_name='FATES cohort age index of the combined pft-cohort age dimension', units='-', ncid=nfid(t)) + long_name='FATES cohort age index of the combined pft-cohort age dimension', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levage',xtype=tape(t)%ncprec, dim1name='fates_levage', & - long_name='FATES patch age (yr)', ncid=nfid(t)) + long_name='FATES patch age (yr)', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levheight',xtype=tape(t)%ncprec, dim1name='fates_levheight', & - long_name='FATES height (m)', ncid=nfid(t)) + long_name='FATES height (m)', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levpft',xtype=ncd_int, dim1name='fates_levpft', & - long_name='FATES pft number', ncid=nfid(t)) + long_name='FATES pft number', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levfuel',xtype=ncd_int, dim1name='fates_levfuel', & - long_name='FATES fuel index', ncid=nfid(t)) + long_name='FATES fuel index', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levcwdsc',xtype=ncd_int, dim1name='fates_levcwdsc', & - long_name='FATES cwd size class', ncid=nfid(t)) + long_name='FATES cwd size class', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levcan',xtype=ncd_int, dim1name='fates_levcan', & - long_name='FATES canopy level', ncid=nfid(t)) + long_name='FATES canopy level', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levleaf',xtype=ncd_int, dim1name='fates_levleaf', & - long_name='FATES leaf+stem level', units='VAI', ncid=nfid(t)) + long_name='FATES leaf+stem level', units='VAI', ncid=nfid(t,f)) call ncd_defvar(varname='fates_canmap_levcnlf',xtype=ncd_int, dim1name='fates_levcnlf', & - long_name='FATES canopy level of combined canopy-leaf dimension', ncid=nfid(t)) + long_name='FATES canopy level of combined canopy-leaf dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_lfmap_levcnlf',xtype=ncd_int, dim1name='fates_levcnlf', & - long_name='FATES leaf level of combined canopy-leaf dimension', ncid=nfid(t)) + long_name='FATES leaf level of combined canopy-leaf dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_canmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', & - long_name='FATES canopy level of combined canopy x leaf x pft dimension', ncid=nfid(t)) + long_name='FATES canopy level of combined canopy x leaf x pft dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_lfmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', & - long_name='FATES leaf level of combined canopy x leaf x pft dimension', ncid=nfid(t)) + long_name='FATES leaf level of combined canopy x leaf x pft dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_pftmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', & - long_name='FATES PFT level of combined canopy x leaf x pft dimension', ncid=nfid(t)) + long_name='FATES PFT level of combined canopy x leaf x pft dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_scmap_levscagpft', xtype=ncd_int, dim1name='fates_levscagpf', & - long_name='FATES size-class map into size x patch age x pft', units='-', ncid=nfid(t)) + long_name='FATES size-class map into size x patch age x pft', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_agmap_levscagpft', xtype=ncd_int, dim1name='fates_levscagpf', & - long_name='FATES age-class map into size x patch age x pft', units='-', ncid=nfid(t)) + long_name='FATES age-class map into size x patch age x pft', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_pftmap_levscagpft', xtype=ncd_int, dim1name='fates_levscagpf', & - long_name='FATES pft map into size x patch age x pft', units='-', ncid=nfid(t)) + long_name='FATES pft map into size x patch age x pft', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_pftmap_levagepft', xtype=ncd_int, dim1name='fates_levagepft', & - long_name='FATES pft map into patch age x pft', units='-', ncid=nfid(t)) + long_name='FATES pft map into patch age x pft', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_agmap_levagepft', xtype=ncd_int, dim1name='fates_levagepft', & - long_name='FATES age-class map into patch age x pft', units='-', ncid=nfid(t)) + long_name='FATES age-class map into patch age x pft', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_agmap_levagefuel', xtype=ncd_int, dim1name='fates_levagefuel', & - long_name='FATES age-class map into patch age x fuel size', units='-', ncid=nfid(t)) + long_name='FATES age-class map into patch age x fuel size', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_fscmap_levagefuel', xtype=ncd_int, dim1name='fates_levagefuel', & - long_name='FATES fuel size-class map into patch age x fuel size', units='-', ncid=nfid(t)) + long_name='FATES fuel size-class map into patch age x fuel size', units='-', ncid=nfid(t,f)) call ncd_defvar(varname='fates_cdmap_levcdsc',xtype=ncd_int, dim1name='fates_levcdsc', & - long_name='FATES damage index of the combined damage-size dimension', ncid=nfid(t)) + long_name='FATES damage index of the combined damage-size dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_scmap_levcdsc',xtype=ncd_int, dim1name='fates_levcdsc', & - long_name='FATES size index of the combined damage-size dimension', ncid=nfid(t)) + long_name='FATES size index of the combined damage-size dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_cdmap_levcdpf',xtype=ncd_int, dim1name='fates_levcdpf', & - long_name='FATES damage index of the combined damage-size-PFT dimension', ncid=nfid(t)) + long_name='FATES damage index of the combined damage-size-PFT dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_scmap_levcdpf',xtype=ncd_int, dim1name='fates_levcdpf', & - long_name='FATES size index of the combined damage-size-PFT dimension', ncid=nfid(t)) + long_name='FATES size index of the combined damage-size-PFT dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_pftmap_levcdpf',xtype=ncd_int, dim1name='fates_levcdpf', & - long_name='FATES pft index of the combined damage-size-PFT dimension', ncid=nfid(t)) + long_name='FATES pft index of the combined damage-size-PFT dimension', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levcdam', xtype=tape(t)%ncprec, dim1name='fates_levcdam', & - long_name='FATES damage class lower bound', units='unitless', ncid=nfid(t)) + long_name='FATES damage class lower bound', units='unitless', ncid=nfid(t,f)) call ncd_defvar(varname='fates_levlanduse',xtype=ncd_int, dim1name='fates_levlanduse', & - long_name='FATES land use label', ncid=nfid(t)) + long_name='FATES land use label', ncid=nfid(t,f)) end if elseif (mode == 'write') then if ( masterproc ) write(iulog, *) ' zsoi:',zsoi - call ncd_io(varname='levgrnd', data=zsoi, ncid=nfid(t), flag='write') - call ncd_io(varname='levsoi', data=zsoi(1:nlevsoi), ncid=nfid(t), flag='write') - call ncd_io(varname='levlak' , data=zlak, ncid=nfid(t), flag='write') + call ncd_io(varname='levgrnd', data=zsoi, ncid=nfid(t,f), flag='write') + call ncd_io(varname='levsoi', data=zsoi(1:nlevsoi), ncid=nfid(t,f), flag='write') + call ncd_io(varname='levlak' , data=zlak, ncid=nfid(t,f), flag='write') if ( decomp_method /= no_soil_decomp )then - call ncd_io(varname='levdcmp', data=zsoi, ncid=nfid(t), flag='write') + call ncd_io(varname='levdcmp', data=zsoi, ncid=nfid(t,f), flag='write') else zsoi_1d(1) = 1._r8 - call ncd_io(varname='levdcmp', data=zsoi_1d, ncid=nfid(t), flag='write') + call ncd_io(varname='levdcmp', data=zsoi_1d, ncid=nfid(t,f), flag='write') end if if (use_hillslope .and. .not.tape(t)%dov2xy) then - call ncd_io(varname='hillslope_distance' , data=col%hill_distance, dim1name=namec, ncid=nfid(t), flag='write') - call ncd_io(varname='hillslope_width' , data=col%hill_width, dim1name=namec, ncid=nfid(t), flag='write') - call ncd_io(varname='hillslope_area' , data=col%hill_area, dim1name=namec, ncid=nfid(t), flag='write') - call ncd_io(varname='hillslope_elev' , data=col%hill_elev, dim1name=namec, ncid=nfid(t), flag='write') - call ncd_io(varname='hillslope_slope' , data=col%hill_slope, dim1name=namec, ncid=nfid(t), flag='write') - call ncd_io(varname='hillslope_aspect' , data=col%hill_aspect, dim1name=namec, ncid=nfid(t), flag='write') - call ncd_io(varname='hillslope_index' , data=col%hillslope_ndx, dim1name=namec, ncid=nfid(t), flag='write') + call ncd_io(varname='hillslope_distance' , data=col%hill_distance, dim1name=namec, ncid=nfid(t,f), flag='write') + call ncd_io(varname='hillslope_width' , data=col%hill_width, dim1name=namec, ncid=nfid(t,f), flag='write') + call ncd_io(varname='hillslope_area' , data=col%hill_area, dim1name=namec, ncid=nfid(t,f), flag='write') + call ncd_io(varname='hillslope_elev' , data=col%hill_elev, dim1name=namec, ncid=nfid(t,f), flag='write') + call ncd_io(varname='hillslope_slope' , data=col%hill_slope, dim1name=namec, ncid=nfid(t,f), flag='write') + call ncd_io(varname='hillslope_aspect' , data=col%hill_aspect, dim1name=namec, ncid=nfid(t,f), flag='write') + call ncd_io(varname='hillslope_index' , data=col%hillslope_ndx, dim1name=namec, ncid=nfid(t,f), flag='write') ! write global indices rather than local indices allocate(icarr(bounds%begc:bounds%endc),stat=ier) @@ -3296,7 +3348,7 @@ subroutine htape_timeconst(t, mode) endif enddo - call ncd_io(varname='hillslope_cold' , data=icarr, dim1name=namec, ncid=nfid(t), flag='write') + call ncd_io(varname='hillslope_cold' , data=icarr, dim1name=namec, ncid=nfid(t,f), flag='write') do c = bounds%begc,bounds%endc if (col%colu(c) /= ispval) then @@ -3306,45 +3358,45 @@ subroutine htape_timeconst(t, mode) endif enddo - call ncd_io(varname='hillslope_colu' , data=icarr, dim1name=namec, ncid=nfid(t), flag='write') + call ncd_io(varname='hillslope_colu' , data=icarr, dim1name=namec, ncid=nfid(t,f), flag='write') deallocate(icarr) endif if(use_fates)then - call ncd_io(varname='fates_scmap_levscag',data=fates_hdim_scmap_levscag, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_agmap_levscag',data=fates_hdim_agmap_levscag, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levscls',data=fates_hdim_levsclass, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levcacls',data=fates_hdim_levcoage, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_pftmap_levscpf',data=fates_hdim_pfmap_levscpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_scmap_levscpf',data=fates_hdim_scmap_levscpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_pftmap_levcapf',data=fates_hdim_pfmap_levcapf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_camap_levcapf',data=fates_hdim_camap_levcapf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levage',data=fates_hdim_levage, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levheight',data=fates_hdim_levheight, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levpft',data=fates_hdim_levpft, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levfuel',data=fates_hdim_levfuel, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levcdam',data=fates_hdim_levdamage, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levcwdsc',data=fates_hdim_levcwdsc, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levcan',data=fates_hdim_levcan, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levleaf',data=fates_hdim_levleaf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_canmap_levcnlf',data=fates_hdim_canmap_levcnlf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_lfmap_levcnlf',data=fates_hdim_lfmap_levcnlf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_canmap_levcnlfpf',data=fates_hdim_canmap_levcnlfpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_lfmap_levcnlfpf',data=fates_hdim_lfmap_levcnlfpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_pftmap_levcnlfpf',data=fates_hdim_pftmap_levcnlfpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_scmap_levscagpft',data=fates_hdim_scmap_levscagpft, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_agmap_levscagpft',data=fates_hdim_agmap_levscagpft, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_pftmap_levscagpft',data=fates_hdim_pftmap_levscagpft, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_pftmap_levagepft',data=fates_hdim_pftmap_levagepft, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_agmap_levagepft',data=fates_hdim_agmap_levagepft, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_agmap_levagefuel',data=fates_hdim_agmap_levagefuel, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_fscmap_levagefuel',data=fates_hdim_fscmap_levagefuel, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_scmap_levcdsc',data=fates_hdim_scmap_levcdsc, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_cdmap_levcdsc',data=fates_hdim_cdmap_levcdsc, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_scmap_levcdpf',data=fates_hdim_scmap_levcdpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_cdmap_levcdpf',data=fates_hdim_cdmap_levcdpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_pftmap_levcdpf',data=fates_hdim_pftmap_levcdpf, ncid=nfid(t), flag='write') - call ncd_io(varname='fates_levlanduse',data=fates_hdim_levlanduse, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_scmap_levscag',data=fates_hdim_scmap_levscag, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_agmap_levscag',data=fates_hdim_agmap_levscag, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levscls',data=fates_hdim_levsclass, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levcacls',data=fates_hdim_levcoage, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_pftmap_levscpf',data=fates_hdim_pfmap_levscpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_scmap_levscpf',data=fates_hdim_scmap_levscpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_pftmap_levcapf',data=fates_hdim_pfmap_levcapf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_camap_levcapf',data=fates_hdim_camap_levcapf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levage',data=fates_hdim_levage, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levheight',data=fates_hdim_levheight, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levpft',data=fates_hdim_levpft, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levfuel',data=fates_hdim_levfuel, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levcdam',data=fates_hdim_levdamage, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levcwdsc',data=fates_hdim_levcwdsc, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levcan',data=fates_hdim_levcan, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levleaf',data=fates_hdim_levleaf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_canmap_levcnlf',data=fates_hdim_canmap_levcnlf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_lfmap_levcnlf',data=fates_hdim_lfmap_levcnlf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_canmap_levcnlfpf',data=fates_hdim_canmap_levcnlfpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_lfmap_levcnlfpf',data=fates_hdim_lfmap_levcnlfpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_pftmap_levcnlfpf',data=fates_hdim_pftmap_levcnlfpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_scmap_levscagpft',data=fates_hdim_scmap_levscagpft, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_agmap_levscagpft',data=fates_hdim_agmap_levscagpft, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_pftmap_levscagpft',data=fates_hdim_pftmap_levscagpft, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_pftmap_levagepft',data=fates_hdim_pftmap_levagepft, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_agmap_levagepft',data=fates_hdim_agmap_levagepft, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_agmap_levagefuel',data=fates_hdim_agmap_levagefuel, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_fscmap_levagefuel',data=fates_hdim_fscmap_levagefuel, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_scmap_levcdsc',data=fates_hdim_scmap_levcdsc, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_cdmap_levcdsc',data=fates_hdim_cdmap_levcdsc, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_scmap_levcdpf',data=fates_hdim_scmap_levcdpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_cdmap_levcdpf',data=fates_hdim_cdmap_levcdpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_pftmap_levcdpf',data=fates_hdim_pftmap_levcdpf, ncid=nfid(t,f), flag='write') + call ncd_io(varname='fates_levlanduse',data=fates_hdim_levlanduse, ncid=nfid(t,f), flag='write') end if endif @@ -3355,7 +3407,7 @@ subroutine htape_timeconst(t, mode) !------------------------------------------------------------------------------- ! For define mode -- only do this for first time-sample - if (mode == 'define' .and. tape(t)%ntimes == 1) then + if (mode == 'define' .and. tape(t)%ntimes(f) == 1) then call get_ref_date(yr, mon, day, nbsec) nstep = get_nstep() hours = nbsec / 3600 @@ -3368,16 +3420,16 @@ subroutine htape_timeconst(t, mode) dim1id(1) = time_dimid str = 'days since ' // basedate // " " // basesec - if (hist_avgflag_pertape(t) /= 'I') then ! NOT instantaneous fields tape + if (f == accumulated_file_index) then step_or_bounds = 'time_bounds' long_name = 'time at exact middle of ' // step_or_bounds - call ncd_defvar(nfid(t), 'time', tape(t)%ncprec, 1, dim1id, varid, & + call ncd_defvar(nfid(t,f), 'time', tape(t)%ncprec, 1, dim1id, varid, & long_name=long_name, units=str) - call ncd_putatt(nfid(t), varid, 'bounds', 'time_bounds') - else ! instantaneous fields tape + call ncd_putatt(nfid(t,f), varid, 'bounds', 'time_bounds') + else ! instantaneous file step_or_bounds = 'time step' long_name = 'time at end of ' // step_or_bounds - call ncd_defvar(nfid(t), 'time', tape(t)%ncprec, 1, dim1id, varid, & + call ncd_defvar(nfid(t,f), 'time', tape(t)%ncprec, 1, dim1id, varid, & long_name=long_name, units=str) end if cal = get_calendar() @@ -3386,13 +3438,13 @@ subroutine htape_timeconst(t, mode) else if ( trim(cal) == GREGORIAN_C )then caldesc = "gregorian" end if - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) dim1id(1) = time_dimid long_name = 'current date (YYYYMMDD) at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mcdate', ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mcdate', ncd_int, 1, dim1id , varid, & long_name = long_name) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) ! ! add global attribute time_period_freq ! @@ -3416,42 +3468,42 @@ subroutine htape_timeconst(t, mode) end if 999 format(a,i0) - call ncd_putatt(nfid(t), ncd_global, 'time_period_freq', & + call ncd_putatt(nfid(t,f), ncd_global, 'time_period_freq', & trim(time_period_freq)) long_name = 'current seconds of current date at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mcsec' , ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mcsec' , ncd_int, 1, dim1id , varid, & long_name = long_name, units='s') - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) long_name = 'current day (from base day) at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mdcur' , ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mdcur' , ncd_int, 1, dim1id , varid, & long_name = long_name) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) long_name = 'current seconds of current day at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mscur' , ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mscur' , ncd_int, 1, dim1id , varid, & long_name = long_name) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) - call ncd_defvar(nfid(t) , 'nstep' , ncd_int, 1, dim1id , varid, & + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) + call ncd_defvar(nfid(t,f) , 'nstep' , ncd_int, 1, dim1id , varid, & long_name = 'time step') dim2id(1) = nbnd_dimid; dim2id(2) = time_dimid - if (hist_avgflag_pertape(t) /= 'I') then ! NOT instantaneous fields tape - call ncd_defvar(nfid(t), 'time_bounds', ncd_double, 2, dim2id, varid, & + if (f == accumulated_file_index) then + call ncd_defvar(nfid(t,f), 'time_bounds', ncd_double, 2, dim2id, varid, & long_name = 'time interval endpoints', & units = str) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) end if dim2id(1) = strlen_dimid; dim2id(2) = time_dimid - call ncd_defvar(nfid(t), 'date_written', ncd_char, 2, dim2id, varid) - call ncd_defvar(nfid(t), 'time_written', ncd_char, 2, dim2id, varid) + call ncd_defvar(nfid(t,f), 'date_written', ncd_char, 2, dim2id, varid) + call ncd_defvar(nfid(t,f), 'time_written', ncd_char, 2, dim2id, varid) if ( len_trim(TimeConst3DVars_Filename) > 0 )then - call ncd_putatt(nfid(t), ncd_global, 'Time_constant_3Dvars_filename', & + call ncd_putatt(nfid(t,f), ncd_global, 'Time_constant_3Dvars_filename', & trim(TimeConst3DVars_Filename)) end if if ( len_trim(TimeConst3DVars) > 0 )then - call ncd_putatt(nfid(t), ncd_global, 'Time_constant_3Dvars', & + call ncd_putatt(nfid(t,f), ncd_global, 'Time_constant_3Dvars', & trim(TimeConst3DVars)) end if @@ -3462,26 +3514,26 @@ subroutine htape_timeconst(t, mode) mcdate = yr*10000 + mon*100 + day nstep = get_nstep() - call ncd_io('mcdate', mcdate, 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('mcsec' , mcsec , 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('mdcur' , mdcur , 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('mscur' , mscur , 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('nstep' , nstep , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mcdate', mcdate, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('mcsec' , mcsec , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('mdcur' , mdcur , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('mscur' , mscur , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('nstep' , nstep , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) timedata(1) = tape(t)%begtime ! beginning time timedata(2) = mdcur + mscur/secspday ! end time - if (hist_avgflag_pertape(t) /= 'I') then ! NOT instantaneous fields tape + if (f == accumulated_file_index) then time = (timedata(1) + timedata(2)) * 0.5_r8 - call ncd_io('time_bounds', timedata, 'write', nfid(t), nt=tape(t)%ntimes) - else + call ncd_io('time_bounds', timedata, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + else ! instantaneous file time = timedata(2) end if - call ncd_io('time' , time , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('time' , time , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) call getdatetime (cdate, ctime) - call ncd_io('date_written', cdate, 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('date_written', cdate, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) - call ncd_io('time_written', ctime, 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('time_written', ctime, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) endif @@ -3489,96 +3541,96 @@ subroutine htape_timeconst(t, mode) !*** Grid definition variables *** !------------------------------------------------------------------------------- ! For define mode -- only do this for first time-sample - if (mode == 'define' .and. tape(t)%ntimes == 1) then + if (mode == 'define' .and. tape(t)%ntimes(f) == 1) then if (ldomain%isgrid2d) then call ncd_defvar(varname='lon', xtype=tape(t)%ncprec, dim1name='lon', & long_name='coordinate longitude', units='degrees_east', & - ncid=nfid(t), missing_value=spval, fill_value=spval) + ncid=nfid(t,f), missing_value=spval, fill_value=spval) else call ncd_defvar(varname='lon', xtype=tape(t)%ncprec, & dim1name=grlnd, & - long_name='coordinate longitude', units='degrees_east', ncid=nfid(t), & + long_name='coordinate longitude', units='degrees_east', ncid=nfid(t,f), & missing_value=spval, fill_value=spval) end if if (ldomain%isgrid2d) then call ncd_defvar(varname='lat', xtype=tape(t)%ncprec, dim1name='lat', & long_name='coordinate latitude', units='degrees_north', & - ncid=nfid(t), missing_value=spval, fill_value=spval) + ncid=nfid(t,f), missing_value=spval, fill_value=spval) else call ncd_defvar(varname='lat', xtype=tape(t)%ncprec, & dim1name=grlnd, & - long_name='coordinate latitude', units='degrees_north', ncid=nfid(t), & + long_name='coordinate latitude', units='degrees_north', ncid=nfid(t,f), & missing_value=spval, fill_value=spval) end if if (ldomain%isgrid2d) then call ncd_defvar(varname='area', xtype=tape(t)%ncprec, & dim1name='lon', dim2name='lat',& - long_name='grid cell areas', units='km^2', ncid=nfid(t), & + long_name='grid cell areas', units='km^2', ncid=nfid(t,f), & missing_value=spval, fill_value=spval) else call ncd_defvar(varname='area', xtype=tape(t)%ncprec, & dim1name=grlnd, & - long_name='grid cell areas', units='km^2', ncid=nfid(t), & + long_name='grid cell areas', units='km^2', ncid=nfid(t,f), & missing_value=spval, fill_value=spval) end if if (ldomain%isgrid2d) then call ncd_defvar(varname='landfrac', xtype=tape(t)%ncprec, & dim1name='lon', dim2name='lat', & - long_name='land fraction', ncid=nfid(t), & + long_name='land fraction', ncid=nfid(t,f), & missing_value=spval, fill_value=spval) else call ncd_defvar(varname='landfrac', xtype=tape(t)%ncprec, & dim1name=grlnd, & - long_name='land fraction', ncid=nfid(t), & + long_name='land fraction', ncid=nfid(t,f), & missing_value=spval, fill_value=spval) end if if (ldomain%isgrid2d) then call ncd_defvar(varname='landmask', xtype=ncd_int, & dim1name='lon', dim2name='lat', & - long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t), & + long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t,f), & imissing_value=ispval, ifill_value=ispval) else call ncd_defvar(varname='landmask', xtype=ncd_int, & dim1name=grlnd, & - long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t), & + long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t,f), & imissing_value=ispval, ifill_value=ispval) end if if (ldomain%isgrid2d) then call ncd_defvar(varname='nbedrock' , xtype=ncd_int, & dim1name='lon', dim2name='lat', & - long_name='index of shallowest bedrock layer', ncid=nfid(t), & + long_name='index of shallowest bedrock layer', ncid=nfid(t,f), & imissing_value=ispval, ifill_value=ispval) else call ncd_defvar(varname='nbedrock' , xtype=ncd_int, & dim1name=grlnd, & - long_name='index of shallowest bedrock layer', ncid=nfid(t), & + long_name='index of shallowest bedrock layer', ncid=nfid(t,f), & imissing_value=ispval, ifill_value=ispval) end if else if (mode == 'write') then - ! Most of this is constant and only needs to be done on tape(t)%ntimes=1 + ! Most of this is constant and only needs to be done on tape(t)%ntimes(f)=1 ! But, some may change for dynamic PATCH mode for example if (ldomain%isgrid2d) then - call ncd_io(varname='lon', data=lon1d, ncid=nfid(t), flag='write') - call ncd_io(varname='lat', data=lat1d, ncid=nfid(t), flag='write') + call ncd_io(varname='lon', data=lon1d, ncid=nfid(t,f), flag='write') + call ncd_io(varname='lat', data=lat1d, ncid=nfid(t,f), flag='write') else - call ncd_io(varname='lon', data=ldomain%lonc, dim1name=grlnd, ncid=nfid(t), flag='write') - call ncd_io(varname='lat', data=ldomain%latc, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='lon', data=ldomain%lonc, dim1name=grlnd, ncid=nfid(t,f), flag='write') + call ncd_io(varname='lat', data=ldomain%latc, dim1name=grlnd, ncid=nfid(t,f), flag='write') end if - call ncd_io(varname='area' , data=ldomain%area, dim1name=grlnd, ncid=nfid(t), flag='write') - call ncd_io(varname='landfrac', data=ldomain%frac, dim1name=grlnd, ncid=nfid(t), flag='write') - call ncd_io(varname='landmask', data=ldomain%mask, dim1name=grlnd, ncid=nfid(t), flag='write') - call ncd_io(varname='nbedrock' , data=grc%nbedrock, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='area' , data=ldomain%area, dim1name=grlnd, ncid=nfid(t,f), flag='write') + call ncd_io(varname='landfrac', data=ldomain%frac, dim1name=grlnd, ncid=nfid(t,f), flag='write') + call ncd_io(varname='landmask', data=ldomain%mask, dim1name=grlnd, ncid=nfid(t,f), flag='write') + call ncd_io(varname='nbedrock' , data=grc%nbedrock, dim1name=grlnd, ncid=nfid(t,f), flag='write') end if ! (define/write mode end subroutine htape_timeconst !----------------------------------------------------------------------- - subroutine hfields_write(t, mode) + subroutine hfields_write(t, f, mode) ! ! !DESCRIPTION: ! Write history tape. Issue the call to write the variable. @@ -3588,10 +3640,11 @@ subroutine hfields_write(t, mode) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index character(len=*), intent(in) :: mode ! 'define' or 'write' ! ! !LOCAL VARIABLES: - integer :: f ! field index + integer :: fld ! field index integer :: k ! 1d index integer :: c,l,p ! indices integer :: beg1d ! on-node 1d field pointer start index @@ -3624,34 +3677,34 @@ subroutine hfields_write(t, mode) if (.not. tape(t)%dov2xy) then if (mode == 'define') then - call hfields_1dinfo(t, mode='define') + call hfields_1dinfo(t, f, mode='define') else if (mode == 'write') then - call hfields_1dinfo(t, mode='write') + call hfields_1dinfo(t, f, mode='write') end if end if ! Define time-dependent variables create variables and attributes for field list - do f = 1,tape(t)%nflds + fld_loop: do fld = 1, tape(t)%nflds(f) ! Set history field variables - varname = tape(t)%hlist(f)%field%name - long_name = tape(t)%hlist(f)%field%long_name - units = tape(t)%hlist(f)%field%units - avgflag = tape(t)%hlist(f)%avgflag - type1d = tape(t)%hlist(f)%field%type1d - type1d_out = tape(t)%hlist(f)%field%type1d_out - beg1d = tape(t)%hlist(f)%field%beg1d - end1d = tape(t)%hlist(f)%field%end1d - beg1d_out = tape(t)%hlist(f)%field%beg1d_out - end1d_out = tape(t)%hlist(f)%field%end1d_out - num1d_out = tape(t)%hlist(f)%field%num1d_out - type2d = tape(t)%hlist(f)%field%type2d - numdims = tape(t)%hlist(f)%field%numdims - num2d = tape(t)%hlist(f)%field%num2d - l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type - nt = tape(t)%ntimes + varname = tape(t)%hlist(fld,f)%field%name + long_name = tape(t)%hlist(fld,f)%field%long_name + units = tape(t)%hlist(fld,f)%field%units + avgflag = tape(t)%hlist(fld,f)%avgflag + type1d = tape(t)%hlist(fld,f)%field%type1d + type1d_out = tape(t)%hlist(fld,f)%field%type1d_out + beg1d = tape(t)%hlist(fld,f)%field%beg1d + end1d = tape(t)%hlist(fld,f)%field%end1d + beg1d_out = tape(t)%hlist(fld,f)%field%beg1d_out + end1d_out = tape(t)%hlist(fld,f)%field%end1d_out + num1d_out = tape(t)%hlist(fld,f)%field%num1d_out + type2d = tape(t)%hlist(fld,f)%field%type2d + numdims = tape(t)%hlist(fld,f)%field%numdims + num2d = tape(t)%hlist(fld,f)%field%num2d + l2g_scale_type = tape(t)%hlist(fld,f)%field%l2g_scale_type + nt = tape(t)%ntimes(f) if (mode == 'define') then @@ -3685,13 +3738,13 @@ subroutine hfields_write(t, mode) if (dim2name == 'undefined') then if (numdims == 1) then - call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name='time', & long_name=long_name, units=units, cell_method=avgstr, & missing_value=spval, fill_value=spval, & varid=varid) else - call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name=type2d, dim3name='time', & long_name=long_name, units=units, cell_method=avgstr, & missing_value=spval, fill_value=spval, & @@ -3699,13 +3752,13 @@ subroutine hfields_write(t, mode) end if else if (numdims == 1) then - call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name=dim2name, dim3name='time', & long_name=long_name, units=units, cell_method=avgstr, & missing_value=spval, fill_value=spval, & varid=varid) else - call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + call ncd_defvar(ncid=nfid(t,f), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name=dim2name, dim3name=type2d, dim4name='time', & long_name=long_name, units=units, cell_method=avgstr, & missing_value=spval, fill_value=spval, & @@ -3714,14 +3767,14 @@ subroutine hfields_write(t, mode) endif if (type1d_out == nameg .or. type1d_out == grlnd) then - call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_type) + call add_landunit_mask_metadata(nfid(t,f), varid, l2g_scale_type) end if else if (mode == 'write') then ! Determine output buffer - histo => tape(t)%hlist(f)%hbuf + histo => tape(t)%hlist(fld,f)%hbuf ! Allocate dynamic memory @@ -3738,10 +3791,10 @@ subroutine hfields_write(t, mode) if (numdims == 1) then call ncd_io(flag='write', varname=varname, & - dim1name=type1d_out, data=hist1do, ncid=nfid(t), nt=nt) + dim1name=type1d_out, data=hist1do, ncid=nfid(t,f), nt=nt) else call ncd_io(flag='write', varname=varname, & - dim1name=type1d_out, data=histo, ncid=nfid(t), nt=nt) + dim1name=type1d_out, data=histo, ncid=nfid(t,f), nt=nt) end if @@ -3753,12 +3806,12 @@ subroutine hfields_write(t, mode) end if - end do + end do fld_loop end subroutine hfields_write !----------------------------------------------------------------------- - subroutine hfields_1dinfo(t, mode) + subroutine hfields_1dinfo(t, f, mode) ! ! !DESCRIPTION: ! Write/define 1d info for history tape. @@ -3769,10 +3822,10 @@ subroutine hfields_1dinfo(t, mode) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index character(len=*), intent(in) :: mode ! 'define' or 'write' ! ! !LOCAL VARIABLES: - integer :: f ! field index integer :: k ! 1d index integer :: g,c,l,p ! indices integer :: ier ! errir status @@ -3792,7 +3845,7 @@ subroutine hfields_1dinfo(t, mode) call get_proc_bounds(bounds) - ncid => nfid(t) + ncid => nfid(t,f) if (mode == 'define') then @@ -4123,7 +4176,8 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! ! !LOCAL VARIABLES: integer :: t ! tape index - integer :: f ! field index + integer :: f ! file index + integer :: fld ! field index integer :: ier ! error code integer :: nstep ! current step integer :: day ! current day (1 -> 31) @@ -4166,151 +4220,157 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Loop over active history tapes, create new history files if necessary ! and write data to history files if end of history interval. - do t = 1, ntapes - - if (.not. history_tape_in_use(t)) then - cycle - end if - - ! Determine if end of history interval - tape(t)%is_endhist = .false. - if (tape(t)%nhtfrq==0) then !monthly average - if (mon /= monm1) tape(t)%is_endhist = .true. - else - if (mod(nstep,tape(t)%nhtfrq) == 0) tape(t)%is_endhist = .true. - end if + tape_loop1: do t = 1, ntapes + file_loop1: do f = 1, max_split_files - ! If end of history interval + if (.not. history_tape_in_use(t,f)) then + cycle + end if - if (tape(t)%is_endhist) then + ! Determine if end of history interval + tape(t)%is_endhist = .false. + if (tape(t)%nhtfrq==0) then !monthly average + if (mon /= monm1) tape(t)%is_endhist = .true. + else + if (mod(nstep,tape(t)%nhtfrq) == 0) tape(t)%is_endhist = .true. + end if - ! Normalize history buffer if time averaged + ! If end of history interval - call hfields_normalize(t) + if (tape(t)%is_endhist) then - ! Increment current time sample counter. + ! Normalize history buffer if time averaged - tape(t)%ntimes = tape(t)%ntimes + 1 + call hfields_normalize(t, f) - ! Create history file if appropriate and build time comment + ! Increment current time sample counter. - ! If first time sample, generate unique history file name, open file, - ! define dims, vars, etc. + tape(t)%ntimes(f) = tape(t)%ntimes(f) + 1 + ! Create history file if appropriate and build time comment - if (tape(t)%ntimes == 1) then - call t_startf('hist_htapes_wrapup_define') - locfnh(t) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & - hist_mfilt=tape(t)%mfilt, hist_file=t) - if (masterproc) then - write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t)), & - ' at nstep = ',get_nstep() - write(iulog,*)'calling htape_create for file t = ',t - endif - call htape_create (t) + ! If first time sample, generate unique history file name, open file, + ! define dims, vars, etc. - ! Define time-constant field variables - call htape_timeconst(t, mode='define') + if (tape(t)%ntimes(f) == 1) then + call t_startf('hist_htapes_wrapup_define') + locfnh(t,f) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & + hist_mfilt=tape(t)%mfilt, hist_file=t, f_index=f) + if (masterproc) then + write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t,f)), & + ' at nstep = ',get_nstep() + write(iulog,*)'calling htape_create for tape t and file f = ', t, f + endif + call htape_create (t, f) - ! Define 3D time-constant field variables on first history tapes - if ( do_3Dtconst .and. t == 1) then - call htape_timeconst3D(t, & - bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & - cellsand_col, cellclay_col, mode='define') - TimeConst3DVars_Filename = trim(locfnh(t)) - end if + ! Define time-constant field variables + call htape_timeconst(t, f, mode='define') - ! Define model field variables - call hfields_write(t, mode='define') + ! Define 3D time-constant field variables on first history tapes + if ( do_3Dtconst .and. t == 1) then + call htape_timeconst3D(t, f, & + bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & + cellsand_col, cellclay_col, mode='define') + TimeConst3DVars_Filename = trim(locfnh(t,f)) + end if - ! Exit define model - call ncd_enddef(nfid(t)) - call t_stopf('hist_htapes_wrapup_define') - endif + ! Define model field variables + call hfields_write(t, f, mode='define') - call t_startf('hist_htapes_wrapup_tconst') - ! Write time constant history variables - call htape_timeconst(t, mode='write') + ! Exit define model + call ncd_enddef(nfid(t,f)) + call t_stopf('hist_htapes_wrapup_define') + endif - ! Write 3D time constant history variables to first history tapes - if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then - call htape_timeconst3D(t, & - bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & - cellsand_col, cellclay_col, mode='write') - do_3Dtconst = .false. - end if + call t_startf('hist_htapes_wrapup_tconst') + ! Write time constant history variables + call htape_timeconst(t, f, mode='write') - if (masterproc) then - write(iulog,*) - write(iulog,*) trim(subname),' : Writing current time sample to local history file ', & - trim(locfnh(t)),' at nstep = ',get_nstep(), & - ' for history time interval beginning at ', tape(t)%begtime, & - ' and ending at ',time - write(iulog,*) - call shr_sys_flush(iulog) - endif + ! Write 3D time constant history variables to first history tapes + if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes(f) == 1 )then + call htape_timeconst3D(t, f, & + bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & + cellsand_col, cellclay_col, mode='write') + do_3Dtconst = .false. + end if - ! Update beginning time of next interval - tape(t)%begtime = time - call t_stopf('hist_htapes_wrapup_tconst') + if (masterproc) then + write(iulog,*) + write(iulog,*) trim(subname),' : Writing current time sample to local history file ', & + trim(locfnh(t,f)),' at nstep = ',get_nstep(), & + ' for history time interval beginning at ', tape(t)%begtime, & + ' and ending at ',time + write(iulog,*) + call shr_sys_flush(iulog) + endif - ! Write history time samples - call t_startf('hist_htapes_wrapup_write') - call hfields_write(t, mode='write') - call t_stopf('hist_htapes_wrapup_write') + ! Update beginning time of next interval + tape(t)%begtime = time + call t_stopf('hist_htapes_wrapup_tconst') - ! Zero necessary history buffers - call hfields_zero(t) + ! Write history time samples + call t_startf('hist_htapes_wrapup_write') + call hfields_write(t, f, mode='write') + call t_stopf('hist_htapes_wrapup_write') - end if + ! Zero necessary history buffers + call hfields_zero(t, f) - end do ! end loop over history tapes + end if + end do file_loop1 + end do tape_loop1 ! Determine if file needs to be closed - call hist_do_disp (ntapes, tape(:)%ntimes, tape(:)%mfilt, if_stop, if_disphist, rstwr, nlend) + file_loop1b: do f = 1, max_split_files + call hist_do_disp (ntapes, tape(:)%ntimes(f), tape(:)%mfilt, if_stop, if_disphist(:,f), rstwr, nlend) + end do file_loop1b ! Close open history file ! Auxilary files may have been closed and saved off without being full, ! must reopen the files - do t = 1, ntapes - if (.not. history_tape_in_use(t)) then - cycle - end if + tape_loop2: do t = 1, ntapes + file_loop2: do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + cycle + end if - if (if_disphist(t)) then - if (tape(t)%ntimes /= 0) then - if (masterproc) then - write(iulog,*) - write(iulog,*) trim(subname),' : Closing local history file ',& - trim(locfnh(t)),' at nstep = ', get_nstep() - write(iulog,*) - endif + if (if_disphist(t,f)) then + if (tape(t)%ntimes(f) /= 0) then + if (masterproc) then + write(iulog,*) + write(iulog,*) trim(subname),' : Closing local history file ',& + trim(locfnh(t,f)),' at nstep = ', get_nstep() + write(iulog,*) + end if - call ncd_pio_closefile(nfid(t)) + call ncd_pio_closefile(nfid(t,f)) - if (.not.if_stop .and. (tape(t)%ntimes/=tape(t)%mfilt)) then - call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) - end if - else - if (masterproc) then - write(iulog,*) trim(subname),' : history tape ',t,': no open file to close' - end if + if (.not.if_stop .and. (tape(t)%ntimes(f)/=tape(t)%mfilt)) then + call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) + end if + else + if (masterproc) then + write(iulog,*) trim(subname),' : history tape ',t,': no open file to close' + end if + endif endif - endif - end do + end do file_loop2 + end do tape_loop2 ! Reset number of time samples to zero if file is full do t = 1, ntapes - if (.not. history_tape_in_use(t)) then - cycle - end if + do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + cycle + end if - if (if_disphist(t) .and. tape(t)%ntimes==tape(t)%mfilt) then - tape(t)%ntimes = 0 - end if + if (if_disphist(t,f) .and. tape(t)%ntimes(f)==tape(t)%mfilt) then + tape(t)%ntimes(f) = 0 + end if + end do end do end subroutine hist_htapes_wrapup @@ -4349,6 +4409,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) integer :: numl ! total number of landunits across all processors integer :: numc ! total number of columns across all processors integer :: nump ! total number of pfts across all processors + integer :: counter ! loop counter character(len=max_namlen) :: name ! variable name character(len=max_namlen) :: name_acc ! accumulator variable name character(len=max_namlen) :: long_name ! long name of variable @@ -4356,7 +4417,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) character(len=max_chars) :: units ! units of variable character(len=max_chars) :: units_acc ! accumulator units character(len=max_chars) :: fname ! full name of history file - character(len=max_chars) :: locrest(max_tapes) ! local history restart file names + character(len=max_chars) :: locrest(max_tapes, max_split_files) ! local history restart file names + character(len=max_chars) :: locrest_onfile(max_split_files, max_tapes) ! history restart file names on file, dims flipped + character(len=max_chars) :: locfnh_onfile(max_split_files, max_tapes) ! history file names on file, dims flipped character(len=max_length_filename) :: my_locfnh ! temporary version of locfnh character(len=max_length_filename) :: my_locfnhr ! temporary version of locfnhr @@ -4369,6 +4432,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) character(len=avgflag_strlen), allocatable :: tavgflag(:) integer :: start(2) + character(len=1) :: file_index ! instantaneous or accumulated_file_index character(len=1) :: hnum ! history file index character(len=hist_dim_name_length) :: type1d ! clm pointer 1d type character(len=hist_dim_name_length) :: type1d_out ! history buffer 1d type @@ -4389,11 +4453,12 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) integer :: dimid ! dimension ID integer :: k ! 1d index integer :: ntapes_onfile ! number of history tapes on the restart file - logical, allocatable :: history_tape_in_use_onfile(:) ! whether a given history tape is in use, according to the restart file + logical, allocatable :: history_tape_in_use_onfile(:) ! history tape is/isn't in use according to the restart file integer :: nflds_onfile ! number of history fields on the restart file logical :: readvar ! whether a variable was read successfully integer :: t ! tape index - integer :: f ! field index + integer :: f ! file index + integer :: fld ! field index integer :: varid ! variable id integer, allocatable :: itemp(:) ! temporary real(r8), pointer :: hbuf(:,:) ! history buffer @@ -4412,7 +4477,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if (flag == 'read') then if (nsrest == nsrBranch) then do t = 1,ntapes - tape(t)%ntimes = 0 + tape(t)%ntimes(:) = 0 end do return end if @@ -4428,7 +4493,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! First when writing out and in define mode, create files and define all variables ! !================================================ - if (flag == 'define') then + define_read_write: if (flag == 'define') then !================================================ if (.not. present(rdate)) then @@ -4441,25 +4506,27 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! and then add the history and history restart filenames ! call ncd_defdim( ncid, 'ntapes' , ntapes , dimid) + call ncd_defdim( ncid, 'max_split_files', max_split_files, dimid) + call ncd_defdim( ncid, 'ntapes_multiply_by_max_split_files', ntapes * max_split_files, dimid) call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_log, & - long_name="Whether this history tape is in use", & - dim1name="ntapes") + long_name="Whether this history tape is/isn't in use", & + dim1name="ntapes_multiply_by_max_split_files") ier = PIO_inq_varid(ncid, 'history_tape_in_use', vardesc) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) call ncd_defvar(ncid=ncid, varname='locfnh', xtype=ncd_char, & long_name="History filename", & comment="This variable NOT needed for startup or branch simulations", & - dim1name='max_chars', dim2name="ntapes" ) + dim1name='max_chars', dim2name="ntapes_multiply_by_max_split_files" ) ier = PIO_inq_varid(ncid, 'locfnh', vardesc) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) call ncd_defvar(ncid=ncid, varname='locfnhr', xtype=ncd_char, & long_name="Restart history filename", & comment="This variable NOT needed for startup or branch simulations", & - dim1name='max_chars', dim2name="ntapes" ) + dim1name='max_chars', dim2name="ntapes_multiply_by_max_split_files" ) ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) @@ -4471,172 +4538,183 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Loop over tapes - write out namelist information to each restart-history tape ! only read/write accumulators and counters if needed - do t = 1,ntapes - if (.not. history_tape_in_use(t)) then - cycle - end if - - ! Create the restart history filename and open it - write(hnum,'(i1.1)') t-1 - locfnhr(t) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & - // ".rh" // hnum //"."// trim(rdate) //".nc" - - call htape_create( t, histrest=.true. ) - - ! Add read/write accumultators and counters if needed - if (.not. tape(t)%is_endhist) then - do f = 1,tape(t)%nflds - name = tape(t)%hlist(f)%field%name - long_name = tape(t)%hlist(f)%field%long_name - units = tape(t)%hlist(f)%field%units - name_acc = trim(name) // "_acc" - units_acc = "unitless positive integer" - long_name_acc = trim(long_name) // " accumulator number of samples" - type1d_out = tape(t)%hlist(f)%field%type1d_out - type2d = tape(t)%hlist(f)%field%type2d - num2d = tape(t)%hlist(f)%field%num2d - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - - if (type1d_out == grlnd) then - if (ldomain%isgrid2d) then - dim1name = 'lon' ; dim2name = 'lat' - else - dim1name = trim(grlnd); dim2name = 'undefined' - end if - else - dim1name = type1d_out ; dim2name = 'undefined' - endif + tape_loop1: do t = 1, ntapes + file_loop1: do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + cycle + end if - if (dim2name == 'undefined') then - if (num2d == 1) then - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & - dim1name=dim1name, & - long_name=trim(long_name), units=trim(units)) - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & - dim1name=dim1name, & - long_name=trim(long_name_acc), units=trim(units_acc)) + ! Create the restart history filename and open it + write(hnum,'(i1.1)') t-1 + if (f == instantaneous_file_index) then + file_index = 'i' ! instantaneous file_index + else if (f == accumulated_file_index) then + file_index = 'a' ! accumulated file_index + else + write(iulog,*) trim(subname),' ERROR: f index =', f, ' but model expected f = ', instantaneous_file_index, ' (instantaneous file index) or ', accumulated_file_index, ' (accumulated file index)' + write(iulog,*) errMsg(sourcefile, __LINE__) + call endrun(msg="ERROR: file index not in range") + end if + locfnhr(t,f) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & + // ".rh" // hnum // file_index //"."// trim(rdate) //".nc" + + call htape_create( t, f, histrest=.true. ) + + ! Add read/write accumultators and counters if needed + not_endhist: if (.not. tape(t)%is_endhist) then + fld_loop1: do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld,f)%field%name + long_name = tape(t)%hlist(fld,f)%field%long_name + units = tape(t)%hlist(fld,f)%field%units + name_acc = trim(name) // "_acc" + units_acc = "unitless positive integer" + long_name_acc = trim(long_name) // " accumulator number of samples" + type1d_out = tape(t)%hlist(fld,f)%field%type1d_out + type2d = tape(t)%hlist(fld,f)%field%type2d + num2d = tape(t)%hlist(fld,f)%field%num2d + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + + if (type1d_out == grlnd) then + if (ldomain%isgrid2d) then + dim1name = 'lon' ; dim2name = 'lat' + else + dim1name = trim(grlnd); dim2name = 'undefined' + end if else - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & - dim1name=dim1name, dim2name=type2d, & - long_name=trim(long_name), units=trim(units)) - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & - dim1name=dim1name, dim2name=type2d, & - long_name=trim(long_name_acc), units=trim(units_acc)) - end if - else - if (num2d == 1) then - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & - dim1name=dim1name, dim2name=dim2name, & - long_name=trim(long_name), units=trim(units)) - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & - dim1name=dim1name, dim2name=dim2name, & - long_name=trim(long_name_acc), units=trim(units_acc)) + dim1name = type1d_out ; dim2name = 'undefined' + endif + + if (dim2name == 'undefined') then + if (num2d == 1) then + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, & + long_name=trim(long_name_acc), units=trim(units_acc)) + else + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=type2d, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=type2d, & + long_name=trim(long_name_acc), units=trim(units_acc)) + end if else - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & - dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & - long_name=trim(long_name), units=trim(units)) - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & - dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & - long_name=trim(long_name_acc), units=trim(units_acc)) - end if - endif - end do - endif - - ! - ! Add namelist information to each restart history tape - ! - call ncd_defdim( ncid_hist(t), 'fname_lenp2' , max_namlen+2, dimid) - call ncd_defdim( ncid_hist(t), 'fname_len' , max_namlen , dimid) - call ncd_defdim( ncid_hist(t), 'avgflag_len' , avgflag_strlen, dimid) - call ncd_defdim( ncid_hist(t), 'scalar' , 1 , dimid) - call ncd_defdim( ncid_hist(t), 'max_chars' , max_chars , dimid) - call ncd_defdim( ncid_hist(t), 'max_nflds' , max_nflds , dimid) - call ncd_defdim( ncid_hist(t), 'max_flds' , max_flds , dimid) - - call ncd_defvar(ncid=ncid_hist(t), varname='nhtfrq', xtype=ncd_int, & - long_name="Frequency of history writes", & - comment="Namelist item", & - units="absolute value of negative is in hours, 0=monthly, positive is time-steps", & - dim1name='scalar') - call ncd_defvar(ncid=ncid_hist(t), varname='mfilt', xtype=ncd_int, & - long_name="Number of history time samples on a file", units="unitless", & - comment="Namelist item", & - dim1name='scalar') - call ncd_defvar(ncid=ncid_hist(t), varname='ncprec', xtype=ncd_int, & - long_name="Flag for data precision", flag_values=(/1,2/), & - comment="Namelist item", & - nvalid_range=(/1,2/), & - flag_meanings=(/"single-precision", "double-precision"/), & - dim1name='scalar') - call ncd_defvar(ncid=ncid_hist(t), varname='dov2xy', xtype=ncd_log, & - long_name="Output on 2D grid format (TRUE) or vector format (FALSE)", & - comment="Namelist item", & - dim1name='scalar') - call ncd_defvar(ncid=ncid_hist(t), varname='fincl', xtype=ncd_char, & - comment="Namelist item", & - long_name="Fieldnames to include", & - dim1name='fname_lenp2', dim2name='max_flds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='fexcl', xtype=ncd_char, & - comment="Namelist item", & - long_name="Fieldnames to exclude", & - dim1name='fname_lenp2', dim2name='max_flds' ) - - call ncd_defvar(ncid=ncid_hist(t), varname='nflds', xtype=ncd_int, & - long_name="Number of fields on file", units="unitless", & - dim1name='scalar') - call ncd_defvar(ncid=ncid_hist(t), varname='ntimes', xtype=ncd_int, & - long_name="Number of time steps on file", units="time-step", & - dim1name='scalar') - call ncd_defvar(ncid=ncid_hist(t), varname='is_endhist', xtype=ncd_log, & - long_name="End of history file", dim1name='scalar') - call ncd_defvar(ncid=ncid_hist(t), varname='begtime', xtype=ncd_double, & - long_name="Beginning time", units="time units", & - dim1name='scalar') - - call ncd_defvar(ncid=ncid_hist(t), varname='num2d', xtype=ncd_int, & - long_name="Size of second dimension", units="unitless", & - dim1name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='hpindex', xtype=ncd_int, & - long_name="History pointer index", units="unitless", & - dim1name='max_nflds' ) - - call ncd_defvar(ncid=ncid_hist(t), varname='avgflag', xtype=ncd_char, & - long_name="Averaging flag", & - units="A=Average, X=Maximum, M=Minimum, I=Instantaneous, SUM=Sum", & - dim1name='avgflag_len', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='name', xtype=ncd_char, & - long_name="Fieldnames", & - dim1name='fname_len', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='long_name', xtype=ncd_char, & - long_name="Long descriptive names for fields", & - dim1name='max_chars', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='units', xtype=ncd_char, & - long_name="Units for each history field output", & - dim1name='max_chars', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='type1d', xtype=ncd_char, & - long_name="1st dimension type", & - dim1name='string_length', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='type1d_out', xtype=ncd_char, & - long_name="1st output dimension type", & - dim1name='string_length', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='type2d', xtype=ncd_char, & - long_name="2nd dimension type", & - dim1name='string_length', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='p2c_scale_type', xtype=ncd_char, & - long_name="PFT to column scale type", & - dim1name='scale_type_string_length', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='c2l_scale_type', xtype=ncd_char, & - long_name="column to landunit scale type", & - dim1name='scale_type_string_length', dim2name='max_nflds' ) - call ncd_defvar(ncid=ncid_hist(t), varname='l2g_scale_type', xtype=ncd_char, & - long_name="landunit to gridpoint scale type", & - dim1name='scale_type_string_length', dim2name='max_nflds' ) - - call ncd_enddef(ncid_hist(t)) - - end do ! end of ntapes loop + if (num2d == 1) then + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=dim2name, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=dim2name, & + long_name=trim(long_name_acc), units=trim(units_acc)) + else + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & + long_name=trim(long_name_acc), units=trim(units_acc)) + end if + endif + end do fld_loop1 + end if not_endhist + + ! + ! Add namelist information to each restart history tape + ! + call ncd_defdim( ncid_hist(t,f), 'fname_lenp2' , max_namlen+2, dimid) + call ncd_defdim( ncid_hist(t,f), 'fname_len' , max_namlen , dimid) + call ncd_defdim( ncid_hist(t,f), 'avgflag_len' , avgflag_strlen, dimid) + call ncd_defdim( ncid_hist(t,f), 'scalar' , 1 , dimid) + call ncd_defdim( ncid_hist(t,f), 'max_chars' , max_chars , dimid) + call ncd_defdim( ncid_hist(t,f), 'max_nflds' , max_nflds , dimid) + call ncd_defdim( ncid_hist(t,f), 'max_flds' , max_flds , dimid) + + call ncd_defvar(ncid=ncid_hist(t,f), varname='nhtfrq', xtype=ncd_int, & + long_name="Frequency of history writes", & + comment="Namelist item", & + units="absolute value of negative is in hours, 0=monthly, positive is time-steps", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t,f), varname='mfilt', xtype=ncd_int, & + long_name="Number of history time samples on a file", units="unitless", & + comment="Namelist item", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t,f), varname='ncprec', xtype=ncd_int, & + long_name="Flag for data precision", flag_values=(/1,2/), & + comment="Namelist item", & + nvalid_range=(/1,2/), & + flag_meanings=(/"single-precision", "double-precision"/), & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t,f), varname='dov2xy', xtype=ncd_log, & + long_name="Output on 2D grid format (TRUE) or vector format (FALSE)", & + comment="Namelist item", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t,f), varname='fincl', xtype=ncd_char, & + comment="Namelist item", & + long_name="Fieldnames to include", & + dim1name='fname_lenp2', dim2name='max_flds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='fexcl', xtype=ncd_char, & + comment="Namelist item", & + long_name="Fieldnames to exclude", & + dim1name='fname_lenp2', dim2name='max_flds' ) + + call ncd_defvar(ncid=ncid_hist(t,f), varname='nflds', xtype=ncd_int, & + long_name="Number of fields on file", units="unitless", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t,f), varname='ntimes', xtype=ncd_int, & + long_name="Number of time steps on file", units="time-step", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t,f), varname='is_endhist', xtype=ncd_log, & + long_name="End of history file", dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t,f), varname='begtime', xtype=ncd_double, & + long_name="Beginning time", units="time units", & + dim1name='scalar') + + call ncd_defvar(ncid=ncid_hist(t,f), varname='num2d', xtype=ncd_int, & + long_name="Size of second dimension", units="unitless", & + dim1name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='hpindex', xtype=ncd_int, & + long_name="History pointer index", units="unitless", & + dim1name='max_nflds' ) + + call ncd_defvar(ncid=ncid_hist(t,f), varname='avgflag', xtype=ncd_char, & + long_name="Averaging flag", & + units="A=Average, X=Maximum, M=Minimum, I=Instantaneous, SUM=Sum", & + dim1name='avgflag_len', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='name', xtype=ncd_char, & + long_name="Fieldnames", & + dim1name='fname_len', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='long_name', xtype=ncd_char, & + long_name="Long descriptive names for fields", & + dim1name='max_chars', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='units', xtype=ncd_char, & + long_name="Units for each history field output", & + dim1name='max_chars', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='type1d', xtype=ncd_char, & + long_name="1st dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='type1d_out', xtype=ncd_char, & + long_name="1st output dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='type2d', xtype=ncd_char, & + long_name="2nd dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='p2c_scale_type', xtype=ncd_char, & + long_name="PFT to column scale type", & + dim1name='scale_type_string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='c2l_scale_type', xtype=ncd_char, & + long_name="column to landunit scale type", & + dim1name='scale_type_string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t,f), varname='l2g_scale_type', xtype=ncd_char, & + long_name="landunit to gridpoint scale type", & + dim1name='scale_type_string_length', dim2name='max_nflds' ) + + call ncd_enddef(ncid_hist(t,f)) + + end do file_loop1 + end do tape_loop1 RETURN @@ -4648,18 +4726,21 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) !================================================ ! Add history filenames to master restart file - do t = 1,ntapes - call ncd_io('history_tape_in_use', history_tape_in_use(t), 'write', ncid, nt=t) - if (history_tape_in_use(t)) then - my_locfnh = locfnh(t) - my_locfnhr = locfnhr(t) - else - my_locfnh = 'non_existent_file' - my_locfnhr = 'non_existent_file' - end if - call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=t) - call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=t) - end do + counter = 0 + tape_loop2: do t = 1, ntapes + file_loop2: do f = 1, max_split_files + counter = counter + 1 + if (.not. history_tape_in_use(t,f)) then + locfnh(t,f) = 'non_existent_file' + locfnhr(t,f) = 'non_existent_file' + end if + my_locfnh = locfnh(t,f) + my_locfnhr = locfnhr(t,f) + call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=counter) + call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=counter) + call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=counter) + end do file_loop2 + end do tape_loop2 fincl(:,1) = hist_fincl1(:) fincl(:,2) = hist_fincl2(:) @@ -4692,66 +4773,68 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! allocate(itemp(max_nflds)) - do t = 1,ntapes - if (.not. history_tape_in_use(t)) then - cycle - end if + tape_loop3: do t = 1, ntapes + file_loop3: do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + cycle + end if - call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t), flag='write') + call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t,f), flag='write') - call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t), flag='write') + call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t,f), flag='write') - call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t), flag='write') + call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t,f), flag='write') - call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t), flag='write') + call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t,f), flag='write') - itemp(:) = 0 - do f=1,tape(t)%nflds - itemp(f) = tape(t)%hlist(f)%field%num2d - end do - call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='write') + itemp(:) = 0 + do fld = 1, tape(t)%nflds(f) + itemp(fld) = tape(t)%hlist(fld,f)%field%num2d + end do + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t,f), flag='write') - itemp(:) = 0 - do f=1,tape(t)%nflds - itemp(f) = tape(t)%hlist(f)%field%hpindex - end do - call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='write') - - call ncd_io('nflds', tape(t)%nflds, 'write', ncid_hist(t) ) - call ncd_io('ntimes', tape(t)%ntimes, 'write', ncid_hist(t) ) - call ncd_io('nhtfrq', tape(t)%nhtfrq, 'write', ncid_hist(t) ) - call ncd_io('mfilt', tape(t)%mfilt, 'write', ncid_hist(t) ) - call ncd_io('ncprec', tape(t)%ncprec, 'write', ncid_hist(t) ) - call ncd_io('begtime', tape(t)%begtime, 'write', ncid_hist(t) ) - allocate(tmpstr(tape(t)%nflds,3 ),tname(tape(t)%nflds), & - tavgflag(tape(t)%nflds),tunits(tape(t)%nflds),tlongname(tape(t)%nflds), & - p2c_scale_type(tape(t)%nflds), c2l_scale_type(tape(t)%nflds), & - l2g_scale_type(tape(t)%nflds)) - do f=1,tape(t)%nflds - tname(f) = tape(t)%hlist(f)%field%name - tunits(f) = tape(t)%hlist(f)%field%units - tlongname(f) = tape(t)%hlist(f)%field%long_name - tmpstr(f,1) = tape(t)%hlist(f)%field%type1d - tmpstr(f,2) = tape(t)%hlist(f)%field%type1d_out - tmpstr(f,3) = tape(t)%hlist(f)%field%type2d - tavgflag(f) = tape(t)%hlist(f)%avgflag - p2c_scale_type(f) = tape(t)%hlist(f)%field%p2c_scale_type - c2l_scale_type(f) = tape(t)%hlist(f)%field%c2l_scale_type - l2g_scale_type(f) = tape(t)%hlist(f)%field%l2g_scale_type - end do - call ncd_io( 'name', tname, 'write',ncid_hist(t)) - call ncd_io('long_name', tlongname, 'write', ncid_hist(t)) - call ncd_io('units', tunits, 'write',ncid_hist(t)) - call ncd_io('type1d', tmpstr(:,1), 'write', ncid_hist(t)) - call ncd_io('type1d_out', tmpstr(:,2), 'write', ncid_hist(t)) - call ncd_io('type2d', tmpstr(:,3), 'write', ncid_hist(t)) - call ncd_io('avgflag',tavgflag , 'write', ncid_hist(t)) - call ncd_io('p2c_scale_type', p2c_scale_type, 'write', ncid_hist(t)) - call ncd_io('c2l_scale_type', c2l_scale_type, 'write', ncid_hist(t)) - call ncd_io('l2g_scale_type', l2g_scale_type, 'write', ncid_hist(t)) - deallocate(tname,tlongname,tunits,tmpstr,tavgflag) - deallocate(p2c_scale_type, c2l_scale_type, l2g_scale_type) - enddo + itemp(:) = 0 + do fld = 1, tape(t)%nflds(f) + itemp(fld) = tape(t)%hlist(fld,f)%field%hpindex + end do + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t,f), flag='write') + + call ncd_io('nflds', tape(t)%nflds(f), 'write', ncid_hist(t,f) ) + call ncd_io('ntimes', tape(t)%ntimes(f), 'write', ncid_hist(t,f) ) + call ncd_io('nhtfrq', tape(t)%nhtfrq, 'write', ncid_hist(t,f) ) + call ncd_io('mfilt', tape(t)%mfilt, 'write', ncid_hist(t,f) ) + call ncd_io('ncprec', tape(t)%ncprec, 'write', ncid_hist(t,f) ) + call ncd_io('begtime', tape(t)%begtime, 'write', ncid_hist(t,f) ) + allocate(tmpstr(tape(t)%nflds(f), 3), tname(tape(t)%nflds(f)), & + tavgflag(tape(t)%nflds(f)), tunits(tape(t)%nflds(f)), tlongname(tape(t)%nflds(f)), & + p2c_scale_type(tape(t)%nflds(f)), c2l_scale_type(tape(t)%nflds(f)), & + l2g_scale_type(tape(t)%nflds(f))) + do fld = 1, tape(t)%nflds(f) + tname(fld) = tape(t)%hlist(fld,f)%field%name + tunits(fld) = tape(t)%hlist(fld,f)%field%units + tlongname(fld) = tape(t)%hlist(fld,f)%field%long_name + tmpstr(fld,1) = tape(t)%hlist(fld,f)%field%type1d + tmpstr(fld,2) = tape(t)%hlist(fld,f)%field%type1d_out + tmpstr(fld,3) = tape(t)%hlist(fld,f)%field%type2d + tavgflag(fld) = tape(t)%hlist(fld,f)%avgflag + p2c_scale_type(fld) = tape(t)%hlist(fld,f)%field%p2c_scale_type + c2l_scale_type(fld) = tape(t)%hlist(fld,f)%field%c2l_scale_type + l2g_scale_type(fld) = tape(t)%hlist(fld,f)%field%l2g_scale_type + end do + call ncd_io( 'name', tname, 'write',ncid_hist(t,f)) + call ncd_io('long_name', tlongname, 'write', ncid_hist(t,f)) + call ncd_io('units', tunits, 'write',ncid_hist(t,f)) + call ncd_io('type1d', tmpstr(:,1), 'write', ncid_hist(t,f)) + call ncd_io('type1d_out', tmpstr(:,2), 'write', ncid_hist(t,f)) + call ncd_io('type2d', tmpstr(:,3), 'write', ncid_hist(t,f)) + call ncd_io('avgflag',tavgflag , 'write', ncid_hist(t,f)) + call ncd_io('p2c_scale_type', p2c_scale_type, 'write', ncid_hist(t,f)) + call ncd_io('c2l_scale_type', c2l_scale_type, 'write', ncid_hist(t,f)) + call ncd_io('l2g_scale_type', l2g_scale_type, 'write', ncid_hist(t,f)) + deallocate(tname,tlongname,tunits,tmpstr,tavgflag) + deallocate(p2c_scale_type, c2l_scale_type, l2g_scale_type) + end do file_loop3 + end do tape_loop3 deallocate(itemp) ! @@ -4762,7 +4845,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) !================================================ call ncd_inqdlen(ncid,dimid,ntapes_onfile, name='ntapes') - if (is_restart()) then + if_restart1: if (is_restart()) then if (ntapes_onfile /= ntapes) then write(iulog,*) 'ntapes = ', ntapes, ' ntapes_onfile = ', ntapes_onfile call endrun(msg=' ERROR: number of ntapes differs from restart file. '// & @@ -4770,8 +4853,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) additional_msg=errMsg(sourcefile, __LINE__)) end if - if (ntapes > 0) then - allocate(history_tape_in_use_onfile(ntapes)) + ntapes_gt_0: if (ntapes > 0) then + allocate(history_tape_in_use_onfile(max_split_files*ntapes)) call ncd_io('history_tape_in_use', history_tape_in_use_onfile, 'read', ncid, & readvar=readvar) if (.not. readvar) then @@ -4780,205 +4863,216 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! true for all tapes <= ntapes. history_tape_in_use_onfile(:) = .true. end if - do t = 1, ntapes - if (history_tape_in_use_onfile(t) .neqv. history_tape_in_use(t)) then - write(iulog,*) subname//' ERROR: history_tape_in_use on restart file' - write(iulog,*) 'disagrees with current run: For tape ', t - write(iulog,*) 'On restart file: ', history_tape_in_use_onfile(t) - write(iulog,*) 'In current run : ', history_tape_in_use(t) - write(iulog,*) 'This suggests that this tape was empty in one case,' - write(iulog,*) 'but non-empty in the other. (history_tape_in_use .false.' - write(iulog,*) 'means that history tape is empty.)' - call endrun(msg=' ERROR: history_tape_in_use differs from restart file. '// & - 'You can NOT change history options on restart.', & - additional_msg=errMsg(sourcefile, __LINE__)) - end if - end do - - call ncd_io('locfnh', locfnh(1:ntapes), 'read', ncid ) - call ncd_io('locfnhr', locrest(1:ntapes), 'read', ncid ) - do t = 1,ntapes - call strip_null(locrest(t)) - call strip_null(locfnh(t)) - end do - end if - end if + counter = 0 + tape_loop4: do t = 1, ntapes + file_loop4: do f = 1, max_split_files + counter = counter + 1 + if (history_tape_in_use_onfile(counter) .neqv. history_tape_in_use(t,f)) then + write(iulog,*) subname//' ERROR: history_tape_in_use on restart file' + write(iulog,*) 'disagrees with current run: For tape and file ', t, f + write(iulog,*) 'On restart file: ', history_tape_in_use_onfile(counter) + write(iulog,*) 'In current run : ', history_tape_in_use(t,f) + write(iulog,*) 'This suggests that this tape was empty in one case,' + write(iulog,*) 'but non-empty in the other. (history_tape_in_use .false.' + write(iulog,*) 'means that history tape is empty.)' + call endrun(msg=' ERROR: history_tape_in_use differs from restart file. '// & + 'You can NOT change history options on restart.', & + additional_msg=errMsg(sourcefile, __LINE__)) + end if + end do file_loop4 + end do tape_loop4 + call ncd_io('locfnh', locfnh_onfile, 'read', ncid ) + call ncd_io('locfnhr', locrest_onfile, 'read', ncid ) + tape_loop5: do t = 1, ntapes + file_loop5: do f = 1, max_split_files + call strip_null(locrest_onfile(f,t)) + call strip_null(locfnh_onfile(f,t)) + ! These character variables get read with their dimensions backwards + ! so flip them before using them + locrest(t,f) = locrest_onfile(f,t) + locfnh(t,f) = locfnh_onfile(f,t) + end do file_loop5 + end do tape_loop5 + end if ntapes_gt_0 + end if if_restart1 ! Determine necessary indices - the following is needed if model decomposition is different on restart start(1)=1 - if ( is_restart() )then - do t = 1,ntapes - if (.not. history_tape_in_use(t)) then - cycle - end if + if_restart2: if ( is_restart() ) then + tape_loop6: do t = 1, ntapes + file_loop6: do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + cycle + end if - call getfil( locrest(t), locfnhr(t), 0 ) - call ncd_pio_openfile (ncid_hist(t), trim(locfnhr(t)), ncd_nowrite) + call getfil( locrest(t,f), locfnhr(t,f), 0 ) + call ncd_pio_openfile (ncid_hist(t,f), trim(locfnhr(t,f)), ncd_nowrite) - if ( t == 1 )then + if ( t == 1 .and. f == 1 )then - call ncd_inqdlen(ncid_hist(1),dimid,max_nflds,name='max_nflds') + call ncd_inqdlen(ncid_hist(1,f),dimid,max_nflds,name='max_nflds') - allocate(itemp(max_nflds)) - end if + allocate(itemp(max_nflds)) + end if - call ncd_inqvid(ncid_hist(t), 'name', varid, name_desc) - call ncd_inqvid(ncid_hist(t), 'long_name', varid, longname_desc) - call ncd_inqvid(ncid_hist(t), 'units', varid, units_desc) - call ncd_inqvid(ncid_hist(t), 'type1d', varid, type1d_desc) - call ncd_inqvid(ncid_hist(t), 'type1d_out', varid, type1d_out_desc) - call ncd_inqvid(ncid_hist(t), 'type2d', varid, type2d_desc) - call ncd_inqvid(ncid_hist(t), 'avgflag', varid, avgflag_desc) - call ncd_inqvid(ncid_hist(t), 'p2c_scale_type', varid, p2c_scale_type_desc) - call ncd_inqvid(ncid_hist(t), 'c2l_scale_type', varid, c2l_scale_type_desc) - call ncd_inqvid(ncid_hist(t), 'l2g_scale_type', varid, l2g_scale_type_desc) - - call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t), flag='read') - - call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t), flag='read') - - call ncd_io('nflds', nflds_onfile, 'read', ncid_hist(t) ) - if ( nflds_onfile /= tape(t)%nflds )then - write(iulog,*) 'nflds = ', tape(t)%nflds, ' nflds_onfile = ', nflds_onfile - call endrun(msg=' ERROR: number of fields different than on restart file!,'// & - ' you can NOT change history options on restart!' //& + call ncd_inqvid(ncid_hist(t,f), 'name', varid, name_desc) + call ncd_inqvid(ncid_hist(t,f), 'long_name', varid, longname_desc) + call ncd_inqvid(ncid_hist(t,f), 'units', varid, units_desc) + call ncd_inqvid(ncid_hist(t,f), 'type1d', varid, type1d_desc) + call ncd_inqvid(ncid_hist(t,f), 'type1d_out', varid, type1d_out_desc) + call ncd_inqvid(ncid_hist(t,f), 'type2d', varid, type2d_desc) + call ncd_inqvid(ncid_hist(t,f), 'avgflag', varid, avgflag_desc) + call ncd_inqvid(ncid_hist(t,f), 'p2c_scale_type', varid, p2c_scale_type_desc) + call ncd_inqvid(ncid_hist(t,f), 'c2l_scale_type', varid, c2l_scale_type_desc) + call ncd_inqvid(ncid_hist(t,f), 'l2g_scale_type', varid, l2g_scale_type_desc) + + call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t,f), flag='read') + + call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t,f), flag='read') + + call ncd_io('nflds', nflds_onfile, 'read', ncid_hist(t,f) ) + if ( nflds_onfile /= tape(t)%nflds(f) ) then + write(iulog,*) 'nflds = ', tape(t)%nflds(f), ' nflds_onfile = ', nflds_onfile + call endrun(msg=' ERROR: number of fields different than on restart file!,'// & + ' you can NOT change history options on restart!' //& errMsg(sourcefile, __LINE__)) - end if - call ncd_io('ntimes', tape(t)%ntimes, 'read', ncid_hist(t) ) - call ncd_io('nhtfrq', tape(t)%nhtfrq, 'read', ncid_hist(t) ) - call ncd_io('mfilt', tape(t)%mfilt, 'read', ncid_hist(t) ) - call ncd_io('ncprec', tape(t)%ncprec, 'read', ncid_hist(t) ) - call ncd_io('begtime', tape(t)%begtime, 'read', ncid_hist(t) ) - - call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t), flag='read') - call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t), flag='read') - call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='read') - do f=1,tape(t)%nflds - tape(t)%hlist(f)%field%num2d = itemp(f) - end do + end if + call ncd_io('ntimes', tape(t)%ntimes(f), 'read', ncid_hist(t,f) ) + call ncd_io('nhtfrq', tape(t)%nhtfrq, 'read', ncid_hist(t,f) ) + call ncd_io('mfilt', tape(t)%mfilt, 'read', ncid_hist(t,f) ) + call ncd_io('ncprec', tape(t)%ncprec, 'read', ncid_hist(t,f) ) + call ncd_io('begtime', tape(t)%begtime, 'read', ncid_hist(t,f) ) + + call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t,f), flag='read') + call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t,f), flag='read') + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t,f), flag='read') + do fld = 1, tape(t)%nflds(f) + tape(t)%hlist(fld,f)%field%num2d = itemp(fld) + end do + + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t,f), flag='read') + do fld = 1, tape(t)%nflds(f) + tape(t)%hlist(fld,f)%field%hpindex = itemp(fld) + end do + + fld_loop2: do fld = 1, tape(t)%nflds(f) + start(2) = fld + call ncd_io( name_desc, tape(t)%hlist(fld,f)%field%name, & + 'read', ncid_hist(t,f), start ) + call ncd_io( longname_desc, tape(t)%hlist(fld,f)%field%long_name, & + 'read', ncid_hist(t,f), start ) + call ncd_io( units_desc, tape(t)%hlist(fld,f)%field%units, & + 'read', ncid_hist(t,f), start ) + call ncd_io( type1d_desc, tape(t)%hlist(fld,f)%field%type1d, & + 'read', ncid_hist(t,f), start ) + call ncd_io( type1d_out_desc, tape(t)%hlist(fld,f)%field%type1d_out, & + 'read', ncid_hist(t,f), start ) + call ncd_io( type2d_desc, tape(t)%hlist(fld,f)%field%type2d, & + 'read', ncid_hist(t,f), start ) + call ncd_io( avgflag_desc, tape(t)%hlist(fld,f)%avgflag, & + 'read', ncid_hist(t,f), start ) + call ncd_io( p2c_scale_type_desc, tape(t)%hlist(fld,f)%field%p2c_scale_type, & + 'read', ncid_hist(t,f), start ) + call ncd_io( c2l_scale_type_desc, tape(t)%hlist(fld,f)%field%c2l_scale_type, & + 'read', ncid_hist(t,f), start ) + call ncd_io( l2g_scale_type_desc, tape(t)%hlist(fld,f)%field%l2g_scale_type, & + 'read', ncid_hist(t,f), start ) + call strip_null(tape(t)%hlist(fld,f)%field%name) + call strip_null(tape(t)%hlist(fld,f)%field%long_name) + call strip_null(tape(t)%hlist(fld,f)%field%units) + call strip_null(tape(t)%hlist(fld,f)%field%type1d) + call strip_null(tape(t)%hlist(fld,f)%field%type1d_out) + call strip_null(tape(t)%hlist(fld,f)%field%type2d) + call strip_null(tape(t)%hlist(fld,f)%field%p2c_scale_type) + call strip_null(tape(t)%hlist(fld,f)%field%c2l_scale_type) + call strip_null(tape(t)%hlist(fld,f)%field%l2g_scale_type) + call strip_null(tape(t)%hlist(fld,f)%avgflag) + + type1d_out = trim(tape(t)%hlist(fld,f)%field%type1d_out) + select case (trim(type1d_out)) + case (grlnd) + num1d_out = numg + beg1d_out = bounds%begg + end1d_out = bounds%endg + case (nameg) + num1d_out = numg + beg1d_out = bounds%begg + end1d_out = bounds%endg + case (namel) + num1d_out = numl + beg1d_out = bounds%begl + end1d_out = bounds%endl + case (namec) + num1d_out = numc + beg1d_out = bounds%begc + end1d_out = bounds%endc + case (namep) + num1d_out = nump + beg1d_out = bounds%begp + end1d_out = bounds%endp + case default + write(iulog,*) trim(subname),' ERROR: read unknown 1d output type=',trim(type1d_out) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select - call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='read') - do f=1,tape(t)%nflds - tape(t)%hlist(f)%field%hpindex = itemp(f) - end do + tape(t)%hlist(fld,f)%field%num1d_out = num1d_out + tape(t)%hlist(fld,f)%field%beg1d_out = beg1d_out + tape(t)%hlist(fld,f)%field%end1d_out = end1d_out - do f=1,tape(t)%nflds - start(2) = f - call ncd_io( name_desc, tape(t)%hlist(f)%field%name, & - 'read', ncid_hist(t), start ) - call ncd_io( longname_desc, tape(t)%hlist(f)%field%long_name, & - 'read', ncid_hist(t), start ) - call ncd_io( units_desc, tape(t)%hlist(f)%field%units, & - 'read', ncid_hist(t), start ) - call ncd_io( type1d_desc, tape(t)%hlist(f)%field%type1d, & - 'read', ncid_hist(t), start ) - call ncd_io( type1d_out_desc, tape(t)%hlist(f)%field%type1d_out, & - 'read', ncid_hist(t), start ) - call ncd_io( type2d_desc, tape(t)%hlist(f)%field%type2d, & - 'read', ncid_hist(t), start ) - call ncd_io( avgflag_desc, tape(t)%hlist(f)%avgflag, & - 'read', ncid_hist(t), start ) - call ncd_io( p2c_scale_type_desc, tape(t)%hlist(f)%field%p2c_scale_type, & - 'read', ncid_hist(t), start ) - call ncd_io( c2l_scale_type_desc, tape(t)%hlist(f)%field%c2l_scale_type, & - 'read', ncid_hist(t), start ) - call ncd_io( l2g_scale_type_desc, tape(t)%hlist(f)%field%l2g_scale_type, & - 'read', ncid_hist(t), start ) - call strip_null(tape(t)%hlist(f)%field%name) - call strip_null(tape(t)%hlist(f)%field%long_name) - call strip_null(tape(t)%hlist(f)%field%units) - call strip_null(tape(t)%hlist(f)%field%type1d) - call strip_null(tape(t)%hlist(f)%field%type1d_out) - call strip_null(tape(t)%hlist(f)%field%type2d) - call strip_null(tape(t)%hlist(f)%field%p2c_scale_type) - call strip_null(tape(t)%hlist(f)%field%c2l_scale_type) - call strip_null(tape(t)%hlist(f)%field%l2g_scale_type) - call strip_null(tape(t)%hlist(f)%avgflag) - - type1d_out = trim(tape(t)%hlist(f)%field%type1d_out) - select case (trim(type1d_out)) - case (grlnd) - num1d_out = numg - beg1d_out = bounds%begg - end1d_out = bounds%endg - case (nameg) - num1d_out = numg - beg1d_out = bounds%begg - end1d_out = bounds%endg - case (namel) - num1d_out = numl - beg1d_out = bounds%begl - end1d_out = bounds%endl - case (namec) - num1d_out = numc - beg1d_out = bounds%begc - end1d_out = bounds%endc - case (namep) - num1d_out = nump - beg1d_out = bounds%begp - end1d_out = bounds%endp - case default - write(iulog,*) trim(subname),' ERROR: read unknown 1d output type=',trim(type1d_out) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - tape(t)%hlist(f)%field%num1d_out = num1d_out - tape(t)%hlist(f)%field%beg1d_out = beg1d_out - tape(t)%hlist(f)%field%end1d_out = end1d_out - - num2d = tape(t)%hlist(f)%field%num2d - allocate (tape(t)%hlist(f)%hbuf(beg1d_out:end1d_out,num2d), & - tape(t)%hlist(f)%nacs(beg1d_out:end1d_out,num2d), & - stat=status) - if (status /= 0) then - write(iulog,*) trim(subname),' ERROR: allocation error for hbuf,nacs at t,f=',t,f - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - tape(t)%hlist(f)%hbuf(:,:) = 0._r8 - tape(t)%hlist(f)%nacs(:,:) = 0 - - type1d = tape(t)%hlist(f)%field%type1d - select case (type1d) - case (grlnd) - num1d = numg - beg1d = bounds%begg - end1d = bounds%endg - case (nameg) - num1d = numg - beg1d = bounds%begg - end1d = bounds%endg - case (namel) - num1d = numl - beg1d = bounds%begl - end1d = bounds%endl - case (namec) - num1d = numc - beg1d = bounds%begc - end1d = bounds%endc - case (namep) - num1d = nump - beg1d = bounds%begp - end1d = bounds%endp - case default - write(iulog,*) trim(subname),' ERROR: read unknown 1d type=',type1d - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select + num2d = tape(t)%hlist(fld,f)%field%num2d + allocate (tape(t)%hlist(fld,f)%hbuf(beg1d_out:end1d_out,num2d), & + tape(t)%hlist(fld,f)%nacs(beg1d_out:end1d_out,num2d), & + stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for hbuf,nacs at t,f,fld=',t,f,fld + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + tape(t)%hlist(fld,f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(fld,f)%nacs(:,:) = 0 + + type1d = tape(t)%hlist(fld,f)%field%type1d + select case (type1d) + case (grlnd) + num1d = numg + beg1d = bounds%begg + end1d = bounds%endg + case (nameg) + num1d = numg + beg1d = bounds%begg + end1d = bounds%endg + case (namel) + num1d = numl + beg1d = bounds%begl + end1d = bounds%endl + case (namec) + num1d = numc + beg1d = bounds%begc + end1d = bounds%endc + case (namep) + num1d = nump + beg1d = bounds%begp + end1d = bounds%endp + case default + write(iulog,*) trim(subname),' ERROR: read unknown 1d type=',type1d + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select - tape(t)%hlist(f)%field%num1d = num1d - tape(t)%hlist(f)%field%beg1d = beg1d - tape(t)%hlist(f)%field%end1d = end1d + tape(t)%hlist(fld,f)%field%num1d = num1d + tape(t)%hlist(fld,f)%field%beg1d = beg1d + tape(t)%hlist(fld,f)%field%end1d = end1d - end do ! end of flds loop + end do fld_loop2 - ! If history file is not full, open it + ! If history file is not full, open it - if (tape(t)%ntimes /= 0) then - call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) - end if + if (tape(t)%ntimes(f) /= 0) then + call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) + end if - end do ! end of tapes loop + end do file_loop6 + end do tape_loop6 hist_fincl1(:) = fincl(:,1) hist_fincl2(:) = fincl(:,2) @@ -5002,11 +5096,11 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) hist_fexcl9(:) = fexcl(:,9) hist_fexcl10(:) = fexcl(:,10) - end if + end if if_restart2 if ( allocated(itemp) ) deallocate(itemp) - end if + end if define_read_write !====================================================================== ! Read/write history file restart data. @@ -5015,114 +5109,118 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! A new history file is used on a branch run. !====================================================================== - if (flag == 'write') then - - do t = 1,ntapes - if (.not. history_tape_in_use(t)) then - cycle - end if + read_write: if (flag == 'write') then - if (.not. tape(t)%is_endhist) then - - do f = 1,tape(t)%nflds - name = tape(t)%hlist(f)%field%name - name_acc = trim(name) // "_acc" - type1d_out = tape(t)%hlist(f)%field%type1d_out - type2d = tape(t)%hlist(f)%field%type2d - num2d = tape(t)%hlist(f)%field%num2d - beg1d_out = tape(t)%hlist(f)%field%beg1d_out - end1d_out = tape(t)%hlist(f)%field%end1d_out - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - - if (num2d == 1) then - allocate(hbuf1d(beg1d_out:end1d_out), & - nacs1d(beg1d_out:end1d_out), stat=status) - if (status /= 0) then - write(iulog,*) trim(subname),' ERROR: allocation' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + tape_loop7: do t = 1, ntapes + file_loop7: do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + cycle + end if - hbuf1d(beg1d_out:end1d_out) = hbuf(beg1d_out:end1d_out,1) - nacs1d(beg1d_out:end1d_out) = nacs(beg1d_out:end1d_out,1) + if (.not. tape(t)%is_endhist) then - call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name), & - dim1name=type1d_out, data=hbuf1d) - call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name_acc), & - dim1name=type1d_out, data=nacs1d) + fld_loop3: do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld,f)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(fld,f)%field%type1d_out + type2d = tape(t)%hlist(fld,f)%field%type2d + num2d = tape(t)%hlist(fld,f)%field%num2d + beg1d_out = tape(t)%hlist(fld,f)%field%beg1d_out + end1d_out = tape(t)%hlist(fld,f)%field%end1d_out + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf - deallocate(hbuf1d) - deallocate(nacs1d) - else - call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name), & - dim1name=type1d_out, data=hbuf) - call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name_acc), & - dim1name=type1d_out, data=nacs) - end if + if (num2d == 1) then + allocate(hbuf1d(beg1d_out:end1d_out), & + nacs1d(beg1d_out:end1d_out), stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + hbuf1d(beg1d_out:end1d_out) = hbuf(beg1d_out:end1d_out,1) + nacs1d(beg1d_out:end1d_out) = nacs(beg1d_out:end1d_out,1) + + call ncd_io(ncid=ncid_hist(t,f), flag='write', varname=trim(name), & + dim1name=type1d_out, data=hbuf1d) + call ncd_io(ncid=ncid_hist(t,f), flag='write', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs1d) + + deallocate(hbuf1d) + deallocate(nacs1d) + else + call ncd_io(ncid=ncid_hist(t,f), flag='write', varname=trim(name), & + dim1name=type1d_out, data=hbuf) + call ncd_io(ncid=ncid_hist(t,f), flag='write', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs) + end if - end do + end do fld_loop3 - end if ! end of is_endhist block + end if ! end of is_endhist block - call ncd_pio_closefile(ncid_hist(t)) + call ncd_pio_closefile(ncid_hist(t,f)) - end do ! end of ntapes loop + end do file_loop7 + end do tape_loop7 else if (flag == 'read') then ! Read history restart information if history files are not full - do t = 1,ntapes - if (.not. history_tape_in_use(t)) then - cycle - end if - - if (.not. tape(t)%is_endhist) then - - do f = 1,tape(t)%nflds - name = tape(t)%hlist(f)%field%name - name_acc = trim(name) // "_acc" - type1d_out = tape(t)%hlist(f)%field%type1d_out - type2d = tape(t)%hlist(f)%field%type2d - num2d = tape(t)%hlist(f)%field%num2d - beg1d_out = tape(t)%hlist(f)%field%beg1d_out - end1d_out = tape(t)%hlist(f)%field%end1d_out - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - - if (num2d == 1) then - allocate(hbuf1d(beg1d_out:end1d_out), & - nacs1d(beg1d_out:end1d_out), stat=status) - if (status /= 0) then - write(iulog,*) trim(subname),' ERROR: allocation' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + tape_loop8: do t = 1, ntapes + file_loop8: do f = 1, max_split_files + if (.not. history_tape_in_use(t,f)) then + cycle + end if - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & - dim1name=type1d_out, data=hbuf1d, posNOTonfile=.true.) - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & - dim1name=type1d_out, data=nacs1d, posNOTonfile=.true.) + if (.not. tape(t)%is_endhist) then - hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) - nacs(beg1d_out:end1d_out,1) = nacs1d(beg1d_out:end1d_out) + fld_loop4: do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld,f)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(fld,f)%field%type1d_out + type2d = tape(t)%hlist(fld,f)%field%type2d + num2d = tape(t)%hlist(fld,f)%field%num2d + beg1d_out = tape(t)%hlist(fld,f)%field%beg1d_out + end1d_out = tape(t)%hlist(fld,f)%field%end1d_out + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf - deallocate(hbuf1d) - deallocate(nacs1d) - else - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & - dim1name=type1d_out, data=hbuf, posNOTonfile=.true.) - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & - dim1name=type1d_out, data=nacs, posNOTonfile=.true.) - end if - end do + if (num2d == 1) then + allocate(hbuf1d(beg1d_out:end1d_out), & + nacs1d(beg1d_out:end1d_out), stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf1d, posNOTonfile=.true.) + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs1d, posNOTonfile=.true.) + + hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) + nacs(beg1d_out:end1d_out,1) = nacs1d(beg1d_out:end1d_out) + + deallocate(hbuf1d) + deallocate(nacs1d) + else + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf, posNOTonfile=.true.) + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs, posNOTonfile=.true.) + end if + end do fld_loop4 - end if + end if - call ncd_pio_closefile(ncid_hist(t)) + call ncd_pio_closefile(ncid_hist(t,f)) - end do + end do file_loop8 + end do tape_loop8 - end if + end if read_write end subroutine hist_restart_ncd @@ -5135,13 +5233,15 @@ integer function max_nFields() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: - integer :: t ! index + integer :: t, f ! indices character(len=*),parameter :: subname = 'max_nFields' !----------------------------------------------------------------------- max_nFields = 0 do t = 1,ntapes - max_nFields = max(max_nFields, tape(t)%nflds) + do f = 1, max_split_files + max_nFields = max(max_nFields, tape(t)%nflds(f)) + end do end do return end function max_nFields @@ -5221,18 +5321,18 @@ subroutine list_index (list, name, index) ! !LOCAL VARIABLES: !EOP character(len=max_namlen) :: listname ! input name with ":" stripped off. - integer f ! field index + integer fld ! field index character(len=*),parameter :: subname = 'list_index' !----------------------------------------------------------------------- ! Only list items index = 0 - do f=1,max_flds - listname = getname (list(f)) + do fld = 1, max_flds + listname = getname (list(fld)) if (listname == ' ') exit if (listname == name) then - index = f + index = fld exit end if end do @@ -5240,7 +5340,7 @@ subroutine list_index (list, name, index) end subroutine list_index !----------------------------------------------------------------------- - character(len=max_length_filename) function set_hist_filename (hist_freq, hist_mfilt, hist_file) + character(len=max_length_filename) function set_hist_filename (hist_freq, hist_mfilt, hist_file, f_index) ! ! !DESCRIPTION: ! Determine history dataset filenames. @@ -5255,11 +5355,13 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, hist_m integer, intent(in) :: hist_freq !history file frequency integer, intent(in) :: hist_mfilt !history file number of time-samples integer, intent(in) :: hist_file !history file index + integer, intent(in) :: f_index ! instantaneous or accumulated_file_index ! ! !LOCAL VARIABLES: !EOP character(len=max_chars) :: cdate !date char string character(len= 1) :: hist_index !p,1 or 2 (currently) + character(len = 1) :: file_index ! instantaneous or accumulated_file_index integer :: day !day (1 -> 31) integer :: mon !month (1 -> 12) integer :: yr !year (0 -> ...) @@ -5276,8 +5378,13 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, hist_m write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec endif write(hist_index,'(i1.1)') hist_file - 1 + if (f_index == instantaneous_file_index) then + file_index = 'i' ! instantaneous file_index + else if (f_index == accumulated_file_index) then + file_index = 'a' ! accumulated file_index + end if set_hist_filename = "./"//trim(caseid)//"."//trim(compname)//trim(inst_suffix)//& - ".h"//hist_index//"."//trim(cdate)//".nc" + ".h"//hist_index//file_index//"."//trim(cdate)//".nc" ! check to see if the concatenated filename exceeded the ! length. Simplest way to do this is ensure that the file diff --git a/tools/contrib/SpinupStability_BGC_v10.ncl b/tools/contrib/SpinupStability_BGC_v10.ncl index 5ed7516455..f0ebcbd7be 100644 --- a/tools/contrib/SpinupStability_BGC_v10.ncl +++ b/tools/contrib/SpinupStability_BGC_v10.ncl @@ -85,9 +85,9 @@ begin end if if (annual_hist) then - fls = systemfunc("ls " + data_dir + caseid+".clm2.h0.*-*-*-*"+".nc") + fls = systemfunc("ls " + data_dir + caseid+".clm2.h0a.*-*-*-*"+".nc") else - fls = systemfunc("ls " + data_dir + caseid+".clm2.h0.*-*"+".nc") + fls = systemfunc("ls " + data_dir + caseid+".clm2.h0a.*-*"+".nc") end if flsdims = dimsizes(fls) diff --git a/tools/contrib/SpinupStability_BGC_v11_SE.ncl b/tools/contrib/SpinupStability_BGC_v11_SE.ncl index db00c0b484..5666016a87 100644 --- a/tools/contrib/SpinupStability_BGC_v11_SE.ncl +++ b/tools/contrib/SpinupStability_BGC_v11_SE.ncl @@ -81,9 +81,9 @@ begin totecosysc_thresh = 1.0 ; disequilibrium threshold for individual gridcells (gC/m2/yr) if (annual_hist) then - fls = systemfunc("ls " + data_dir + caseid+".clm2.h0.*-*-*-*"+".nc") + fls = systemfunc("ls " + data_dir + caseid+".clm2.h0a.*-*-*-*"+".nc") else - fls = systemfunc("ls " + data_dir + caseid+".clm2.h0.*-*"+".nc") + fls = systemfunc("ls " + data_dir + caseid+".clm2.h0a.*-*"+".nc") end if flsdims = dimsizes(fls) diff --git a/tools/contrib/SpinupStability_SP_v9.ncl b/tools/contrib/SpinupStability_SP_v9.ncl index 58a769a910..b0bc7ff839 100644 --- a/tools/contrib/SpinupStability_SP_v9.ncl +++ b/tools/contrib/SpinupStability_SP_v9.ncl @@ -54,9 +54,9 @@ begin tws_thresh = 0.001 ; disequilibrium threshold for individual gridcells (m) if (annual_hist .eq. "True") then - fls = systemfunc("ls " + data_dir + caseid+".clm2.h0.*-*-*-*"+".nc") + fls = systemfunc("ls " + data_dir + caseid+".clm2.h0a.*-*-*-*"+".nc") else - fls = systemfunc("ls " + data_dir + caseid+".clm2.h0.*-*"+".nc") + fls = systemfunc("ls " + data_dir + caseid+".clm2.h0a.*-*"+".nc") end if flsdims = dimsizes(fls) diff --git a/tools/contrib/run_clm_historical b/tools/contrib/run_clm_historical index 8dc9269d3b..775d1aab1d 100755 --- a/tools/contrib/run_clm_historical +++ b/tools/contrib/run_clm_historical @@ -125,7 +125,7 @@ while ($DONE_RUNA == 0) set DONE_RUNA = 1 echo '1850-1870 run is complete' while ($DONE_ARCHIVE == 0) - set nh0 = `ls -l $WDIR/*clm?.h0.* | egrep -c '^-'` + set nh0 = `ls -l $WDIR/*clm?.h0a.* | egrep -c '^-'` echo $nh0 if ($nh0 == 1) then set DONE_ARCHIVE = 1 @@ -177,7 +177,7 @@ while ($DONE_RUNA == 0) set DONE_RUNA = 1 echo '1850-1900 run is complete' while ($DONE_ARCHIVE == 0) - set nh0 = `ls -l $WDIR/*clm?.h0.* | egrep -c '^-'` + set nh0 = `ls -l $WDIR/*clm?.h0a.* | egrep -c '^-'` echo $nh0 if ($nh0 == 1) then set DONE_ARCHIVE = 1 @@ -242,7 +242,7 @@ while ($DONE_RUNA == 0) set DONE_RUNA = 1 echo '1901-1989 run is complete' while ($DONE_ARCHIVE == 0) - set nh0 = `ls -l $WDIR/*clm?.h0.* | egrep -c '^-'` + set nh0 = `ls -l $WDIR/*clm?.h0a.* | egrep -c '^-'` echo $nh0 if ($nh0 == 1) then set DONE_ARCHIVE = 1 @@ -295,7 +295,7 @@ while ($DONE_RUNA == 0) set DONE_RUNA = 1 echo '1989-2004 run is complete' while ($DONE_ARCHIVE == 0) - set nh0 = `ls -l $WDIR/*clm?.h0.* | egrep -c '^-'` + set nh0 = `ls -l $WDIR/*clm?.h0a.* | egrep -c '^-'` echo $nh0 if ($nh0 == 1) then set DONE_ARCHIVE = 1 @@ -349,7 +349,7 @@ while ($DONE_RUNA == 0) set DONE_RUNA = 1 echo '2005-2014 run is complete' while ($DONE_ARCHIVE == 0) - set nh0 = `ls -l $WDIR/*clm?.h0.* | egrep -c '^-'` + set nh0 = `ls -l $WDIR/*clm?.h0a.* | egrep -c '^-'` echo $nh0 if ($nh0 == 1) then set DONE_ARCHIVE = 1 diff --git a/tools/site_and_regional/neon_gcs_upload b/tools/site_and_regional/neon_gcs_upload index 1c931e3b8d..5c673a1963 100755 --- a/tools/site_and_regional/neon_gcs_upload +++ b/tools/site_and_regional/neon_gcs_upload @@ -154,7 +154,7 @@ def main(description): continue with Case(case_path) as case: archive_dir = os.path.join(case.get_value("DOUT_S_ROOT"),"lnd","hist") - for histfile in glob.iglob(archive_dir + "/*.h1.*"): + for histfile in glob.iglob(archive_dir + "/*.h1a.*"): newfile = os.path.basename(histfile) upload_blob("neon-ncar-artifacts", histfile, os.path.join("NEON","archive",site,"lnd","hist",newfile))