From 9c7df7fcd29e76da4ec1c8f0f9566b938e173575 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 1 Apr 2024 16:36:39 -0600 Subject: [PATCH 01/59] Begin to add a file number dimension to permit 2+ files per hist. tape --- src/main/histFileMod.F90 | 459 ++++++++++++++++++++------------------- 1 file changed, 234 insertions(+), 225 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index eb3d42348f..b6dc98b0fb 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -49,6 +49,7 @@ module histFileMod integer , public, 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 :: maxsplitfiles = 2 ! max number of files per tape (instantaneous_file_index = 1, accumulated_file_index = 2) ! 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 @@ -314,7 +315,7 @@ end subroutine copy_entry_interface ! 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. ! - logical :: history_tape_in_use(max_tapes) ! whether each history tape is in use in this run + logical :: history_tape_in_use(max_tapes, maxsplitfiles) ! whether each history tape is 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 @@ -330,13 +331,13 @@ end subroutine copy_entry_interface ! ! Other variables ! - character(len=max_length_filename) :: locfnh(max_tapes) ! local history file names + character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names character(len=max_length_filename) :: locfnhr(max_tapes) ! 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 :: nfid(max_tapes, maxsplitfiles) ! file ids type(file_desc_t), target :: ncid_hist(max_tapes) ! file ids for history restart files integer :: time_dimid ! time dimension id integer :: hist_interval_dimid ! time bounds dimension id @@ -902,8 +903,8 @@ subroutine htapes_fieldlist() end do end do - history_tape_in_use(:) = .false. - tape(:)%nflds = 0 + history_tape_in_use(:,:) = .false. + tape(:)%nflds(:) = 0 do t = 1,max_tapes ! Loop through the allhistfldlist set of field names and determine if any of those @@ -972,8 +973,9 @@ subroutine htapes_fieldlist() end do do t = 1, ntapes - if (tape(t)%nflds > 0) then - history_tape_in_use(t) = .true. + ! 7) TODO slevis: Change nflds to nflds(f) throughout NEXT + if (tape(t)%nflds(f) > 0) then + history_tape_in_use(t,f) = .true. end if end do @@ -1009,7 +1011,7 @@ 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 + if (.not. history_tape_in_use(t,f)) then write(iulog,*) 'History tape ',t,' does not have any fields,' write(iulog,*) 'so it will not be written!' end if @@ -2332,7 +2334,7 @@ subroutine hfields_zero (t) end subroutine hfields_zero !----------------------------------------------------------------------- - subroutine htape_create (t, histrest) + subroutine htape_create (t, f, histrest) ! ! !DESCRIPTION: ! Define netcdf metadata of history file t. @@ -2348,11 +2350,11 @@ subroutine htape_create (t, histrest) use fileutils , only : get_filename ! ! !ARGUMENTS: - integer, intent(in) :: t ! tape index + integer, intent(in) :: t, f ! tape index, file index logical, intent(in), optional :: histrest ! if creating the history restart file ! ! !LOCAL VARIABLES: - integer :: f ! field index + ! 5) TODO slevis: Rm old f in this subr. as unused and introduce f as file index DONE integer :: p,c,l,n ! indices integer :: ier ! error code integer :: num2d ! size of second dimension (e.g. number of vertical levels) @@ -2394,7 +2396,7 @@ subroutine htape_create (t, histrest) if (lhistrest) then lnfid => ncid_hist(t) else - lnfid => nfid(t) + lnfid => nfid(t,f) endif ! Create new netCDF file. It will be in define mode @@ -2402,10 +2404,10 @@ 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!" ) @@ -2541,7 +2543,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 @@ -2785,20 +2787,21 @@ 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,& + ! 6) TODO slevis: Changed nfid(t) to (t,f) throughout DONE + 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 @@ -2848,14 +2851,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 @@ -2876,20 +2879,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 @@ -2934,14 +2937,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 @@ -2962,16 +2965,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 @@ -3013,14 +3016,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 @@ -3143,143 +3146,143 @@ subroutine htape_timeconst(t, mode) 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='m', 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', 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='m', 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) @@ -3295,7 +3298,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 @@ -3305,45 +3308,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 @@ -3370,13 +3373,13 @@ subroutine htape_timeconst(t, mode) if (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape 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') + call ncd_putatt(nfid(t,f), varid, 'bounds', 'time_bounds') else ! instantaneous fields tape 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() @@ -3385,11 +3388,11 @@ 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) ! ! add global attribute time_period_freq @@ -3414,37 +3417,37 @@ 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') 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) 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_defvar(nfid(t) , 'nstep' , ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'nstep' , ncd_int, 1, dim1id , varid, & long_name = 'time step') dim2id(1) = hist_interval_dimid; dim2id(2) = time_dimid if (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape - call ncd_defvar(nfid(t), 'time_bounds', ncd_double, 2, dim2id, varid, & + call ncd_defvar(nfid(t,f), 'time_bounds', ncd_double, 2, dim2id, varid, & long_name = 'history time interval endpoints') 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 @@ -3455,26 +3458,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) + call ncd_io('mcsec' , mcsec , 'write', nfid(t,f), nt=tape(t)%ntimes) + call ncd_io('mdcur' , mdcur , 'write', nfid(t,f), nt=tape(t)%ntimes) + call ncd_io('mscur' , mscur , 'write', nfid(t,f), nt=tape(t)%ntimes) + call ncd_io('nstep' , nstep , 'write', nfid(t,f), nt=tape(t)%ntimes) timedata(1) = tape(t)%begtime ! beginning time timedata(2) = mdcur + mscur/secspday ! end time if (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape time = (timedata(1) + timedata(2)) * 0.5_r8 - call ncd_io('time_bounds', timedata, 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('time_bounds', timedata, 'write', nfid(t,f), nt=tape(t)%ntimes) else 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) 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) - 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) endif @@ -3487,76 +3490,76 @@ subroutine htape_timeconst(t, mode) 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='pftmask' , xtype=ncd_int, & dim1name='lon', dim2name='lat', & - long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), & + long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t,f), & imissing_value=ispval, ifill_value=ispval) else call ncd_defvar(varname='pftmask' , xtype=ncd_int, & dim1name=grlnd, & - long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), & + long_name='pft real/fake mask (0.=fake and 1.=real)', 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 @@ -3566,17 +3569,17 @@ subroutine htape_timeconst(t, mode) ! 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='pftmask' , data=ldomain%pftm, 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='pftmask' , data=ldomain%pftm, 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 @@ -3690,13 +3693,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, & @@ -3704,13 +3707,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, & @@ -3719,7 +3722,7 @@ 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 @@ -3743,10 +3746,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 @@ -3797,7 +3800,7 @@ subroutine hfields_1dinfo(t, mode) call get_proc_bounds(bounds) - ncid => nfid(t) + ncid => nfid(t,f) if (mode == 'define') then @@ -4173,7 +4176,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! and write data to history files if end of history interval. do t = 1, ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4211,14 +4214,15 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & 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) + ! 2) TODO slevis: Changed locfnh(t) to locfnh(t,f) throughout DONE + 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)), & + write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t,f)), & ' at nstep = ',get_nstep() write(iulog,*)'calling htape_create for file t = ',t endif - call htape_create (t) + call htape_create (t, f) ! Define time-constant field variables call htape_timeconst(t, mode='define') @@ -4228,14 +4232,14 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call htape_timeconst3D(t, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & cellsand_col, cellclay_col, mode='define') - TimeConst3DVars_Filename = trim(locfnh(t)) + TimeConst3DVars_Filename = trim(locfnh(t,f)) end if ! Define model field variables call hfields_write(t, mode='define') ! Exit define model - call ncd_enddef(nfid(t)) + call ncd_enddef(nfid(t,f)) call t_stopf('hist_htapes_wrapup_define') endif @@ -4254,7 +4258,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & if (masterproc) then write(iulog,*) write(iulog,*) trim(subname),' : Writing current time sample to local history file ', & - trim(locfnh(t)),' at nstep = ',get_nstep(), & + trim(locfnh(t,f)),' at nstep = ',get_nstep(), & ' for history time interval beginning at ', tape(t)%begtime, & ' and ending at ',time write(iulog,*) @@ -4286,7 +4290,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! must reopen the files do t = 1, ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4295,14 +4299,14 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & if (masterproc) then write(iulog,*) write(iulog,*) trim(subname),' : Closing local history file ',& - trim(locfnh(t)),' at nstep = ', get_nstep() + trim(locfnh(t,f)),' at nstep = ', get_nstep() write(iulog,*) endif - 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) + call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) end if else if (masterproc) then @@ -4315,7 +4319,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Reset number of time samples to zero if file is full do t = 1, ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4400,7 +4404,7 @@ 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(:,:) ! whether a given history tape is 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 @@ -4456,14 +4460,14 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_log, & long_name="Whether this history tape is in use", & - dim1name="ntapes") + dim1name="ntapes", dim2name="maxsplitfiles") 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", dim3name="maxsplitfiles" ) ier = PIO_inq_varid(ncid, 'locfnh', vardesc) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) @@ -4483,7 +4487,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! only read/write accumulators and counters if needed do t = 1,ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4492,7 +4496,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) locfnhr(t) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & // ".rh" // hnum //"."// trim(rdate) //".nc" - call htape_create( t, histrest=.true. ) + call htape_create( t, f, histrest=.true. ) ! Add read/write accumultators and counters if needed if (.not. tape(t)%is_endhist) then @@ -4660,9 +4664,10 @@ 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) + ! 3) TODO slevis: Changed history_tape_in_use(t) to (t,f) throughout DONE + call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) + if (history_tape_in_use(t,f)) then + my_locfnh = locfnh(t,f) my_locfnhr = locfnhr(t) else my_locfnh = 'non_existent_file' @@ -4704,7 +4709,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) allocate(itemp(max_nflds)) do t = 1,ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4782,21 +4787,22 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if if (ntapes > 0) then - allocate(history_tape_in_use_onfile(ntapes)) + ! 4) TODO slevis: Changed history_tape_in_use_onfile(t) to (t,f) throughout DONE + allocate(history_tape_in_use_onfile(ntapes,maxsplitfiles)) call ncd_io('history_tape_in_use', history_tape_in_use_onfile, 'read', ncid, & readvar=readvar) if (.not. readvar) then ! BACKWARDS_COMPATIBILITY(wjs, 2018-10-06) Old restart files do not have ! 'history_tape_in_use'. However, before now, this has implicitly been ! true for all tapes <= ntapes. - history_tape_in_use_onfile(:) = .true. + 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 + if (history_tape_in_use_onfile(t,f) .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 ', t - write(iulog,*) 'On restart file: ', history_tape_in_use_onfile(t) - write(iulog,*) 'In current run : ', history_tape_in_use(t) + write(iulog,*) 'disagrees with current run: For tape and file ', t, f + write(iulog,*) 'On restart file: ', history_tape_in_use_onfile(t,f) + 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.)' @@ -4806,11 +4812,11 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if end do - call ncd_io('locfnh', locfnh(1:ntapes), 'read', ncid ) + call ncd_io('locfnh', locfnh(1:ntapes,f), '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)) + call strip_null(locfnh(t,f)) end do end if end if @@ -4821,7 +4827,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if ( is_restart() )then do t = 1,ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4986,7 +4992,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! 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) + call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) end if end do ! end of tapes loop @@ -5029,7 +5035,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if (flag == 'write') then do t = 1,ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -5084,7 +5090,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Read history restart information if history files are not full do t = 1,ntapes - if (.not. history_tape_in_use(t)) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -5251,7 +5257,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. @@ -5266,11 +5272,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 -> ...) @@ -5287,12 +5295,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 - ! TODO slevis: After hist_index add "i" or "a" - ! For guidance on how to split the files, search for - ! maxsplitfiles in https://github.com/ESCOMP/CAM/pull/903/files - ! See CAM#1003 for a bug-fix in monthly avged output + write(file_index,'(i1.1)') f_index ! instantaneous or accumulated_file_index + ! 1) TODO slevis: After hist_index added file_index = "i" or "a" DONE + ! See maxsplitfiles in https://github.com/ESCOMP/CAM/pull/903/files + ! See CAM#1003 for a bug-fix in monthly avged output + ! AT THE END search all the vars that I modified to make sure I did not miss any of them 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 From 42d944dd51e74afd43b62eae9563d08465255b9e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 12 Apr 2024 18:29:45 -0600 Subject: [PATCH 02/59] WIP (cont'd): Adding file number dimension to permit 2+ files per tape --- src/main/histFileMod.F90 | 843 ++++++++++++++++++++------------------- 1 file changed, 440 insertions(+), 403 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index b6dc98b0fb..5cdea5d12f 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -259,7 +259,8 @@ end subroutine copy_entry_interface ! overridden by namelist params like hist_fincl1. type, extends(entry_base) :: allhistfldlist_entry logical :: actflag(max_tapes) ! which history tapes to write to. - character(len=avgflag_strlen) :: avgflag(max_tapes) ! type of time averaging + ! 10) TODO Add second dimension to avgflag as necessary + character(len=avgflag_strlen) :: avgflag(max_tapes, maxsplitfiles) ! type of time averaging contains procedure :: copy => copy_allhistfldlist_entry end type allhistfldlist_entry @@ -280,7 +281,7 @@ 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 :: nflds(maxsplitfiles) ! number of active fields on file integer :: ntimes ! current number of time samples on tape integer :: mfilt ! maximum number of time samples per tape integer :: nhtfrq ! number of time samples per tape @@ -332,6 +333,7 @@ end subroutine copy_entry_interface ! Other variables ! character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names + ! TODO History restart files seem to mirror history files => need the second dimension I think character(len=max_length_filename) :: locfnhr(max_tapes) ! local history restart file names logical :: htapes_defined = .false. ! flag indicates history output fields have been defined ! @@ -538,7 +540,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 @@ -595,49 +597,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 +647,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 @@ -744,7 +746,8 @@ subroutine allhistfldlist_make_active (name, tape_index, avgflag) character(len=*), intent(in), optional :: avgflag ! time averaging flag ! ! !LOCAL VARIABLES: - integer :: f ! field index + ! 7a) TODO IN PROG Replace old f with fld; search "do f" "(f" 'f)" ... + integer :: fld ! field index logical :: found ! flag indicates field found in allhistfldlist character(len=*),parameter :: subname = 'allhistfldlist_make_active' !----------------------------------------------------------------------- @@ -768,11 +771,11 @@ 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 + allhistfldlist(fld)%actflag(tape_index) = .true. if (present(avgflag)) then - if (avgflag/= ' ') allhistfldlist(f)%avgflag(tape_index) = avgflag + if (avgflag /= ' ') allhistfldlist(fld)%avgflag(tape_index) = avgflag end if found = .true. exit @@ -796,7 +799,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 +810,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 +831,7 @@ subroutine htapes_fieldlist() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: - integer :: t, f ! tape, field indices + integer :: t, fld ! tape, 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 @@ -873,9 +876,9 @@ 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)) + 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 @@ -885,21 +888,21 @@ subroutine htapes_fieldlist() '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 @@ -914,69 +917,76 @@ 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) + ! 8) TODO Add do f = 1, maxsplitfiles where needed; search "do t =" "do t=" + do f = 1, maxsplitfiles + do fld = 1, nallhistflds + allhistfldname = allhistfldlist(fld)%field%name + call list_index (fincl(1,t), allhistfldname, ff) - if (ff > 0) then + 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)) + call htape_addfld (t, f, fld, avgflag) - else if (.not. hist_empty_htapes) then + else if (.not. hist_empty_htapes) then - ! find index of field in exclude list + ! find index of field in exclude list - call list_index (fexcl(1,t), allhistfldname, ff) + call list_index (fexcl(1,t), allhistfldname, ff) - ! 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 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(f)%actflag(t)) then - call htape_addfld (t, f, ' ') - end if + if (ff == 0 .and. allhistfldlist(fld)%actflag(t)) then + call htape_addfld (t, f, fld, ' ') + end if - end if - end do + end if + end do - ! Specification of tape contents now complete. - ! Sort each list of active entries - call sort_hist_list(t, tape(t)%nflds, tape(t)%hlist) + ! Specification of tape contents now complete. + ! Sort each list of active entries + call sort_hist_list(t, tape(t)%nflds(f), tape(t)%hlist) - if (masterproc) then - if (tape(t)%nflds > 0) then - write(iulog,*) trim(subname),' : Included fields tape ',t,'=',tape(t)%nflds + 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)%field%name, & + tape(t)%hlist(fld)%field%num2d, ' ', tape(t)%hlist(fld)%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 ! 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, maxsplitfiles + if (tape(t)%nflds(f) > 0) then + ntapes = t + exit + end if + end do end do + ! 9) TODO Change nflds to nflds(f) throughout do t = 1, ntapes - ! 7) TODO slevis: Change nflds to nflds(f) throughout NEXT - if (tape(t)%nflds(f) > 0) then - history_tape_in_use(t,f) = .true. - end if + do f = 1, maxsplitfiles + 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 @@ -1148,14 +1158,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: @@ -1180,16 +1191,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)%field = allhistfldlist(fld)%field ! Determine bounds @@ -1273,10 +1284,10 @@ subroutine htape_addfld (t, f, avgflag) tape(t)%hlist(n)%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 if ( is_mapping_upto_subgrid( type1d, type1d_out ) ) then @@ -1298,7 +1309,7 @@ subroutine htape_addfld (t, f, avgflag) end if if (avgflag == ' ') then - tape(t)%hlist(n)%avgflag = allhistfldlist(f)%avgflag(t) + tape(t)%hlist(n)%avgflag = allhistfldlist(fld)%avgflag(t) else tape(t)%hlist(n)%avgflag = avgflag end if @@ -1330,7 +1341,8 @@ 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' @@ -1338,17 +1350,19 @@ subroutine hist_update_hbuf(bounds) !----------------------------------------------------------------------- do t = 1,ntapes -!$OMP PARALLEL DO PRIVATE (f, num2d, numdims) - do f = 1,tape(t)%nflds +!$OMP PARALLEL DO PRIVATE (f, fld, num2d, numdims) + do f = 1, maxsplitfiles + do fld = 1,tape(t)%nflds(f) - numdims = tape(t)%hlist(f)%field%numdims + numdims = tape(t)%hlist(fld)%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 + if ( numdims == 1) then + call hist_update_hbuf_field_1d (t, fld, bounds) + else + num2d = tape(t)%hlist(fld)%field%num2d + call hist_update_hbuf_field_2d (t, fld, bounds, num2d) + end if + end do end do !$OMP END PARALLEL DO end do @@ -1356,7 +1370,7 @@ subroutine hist_update_hbuf(bounds) end subroutine hist_update_hbuf !----------------------------------------------------------------------- - subroutine hist_update_hbuf_field_1d (t, f, bounds) + subroutine hist_update_hbuf_field_1d (t, fld, bounds) ! ! !DESCRIPTION: ! Accumulate (or take min, max, etc. as appropriate) input field @@ -1373,7 +1387,7 @@ 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) :: fld ! field index type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: @@ -1413,19 +1427,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)%avgflag + nacs => tape(t)%hlist(fld)%nacs + hbuf => tape(t)%hlist(fld)%hbuf + beg1d = tape(t)%hlist(fld)%field%beg1d + end1d = tape(t)%hlist(fld)%field%end1d + beg1d_out = tape(t)%hlist(fld)%field%beg1d_out + end1d_out = tape(t)%hlist(fld)%field%end1d_out + type1d = tape(t)%hlist(fld)%field%type1d + type1d_out = tape(t)%hlist(fld)%field%type1d_out + p2c_scale_type = tape(t)%hlist(fld)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(fld)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(fld)%field%l2g_scale_type + hpindex = tape(t)%hlist(fld)%field%hpindex field => clmptr_rs(hpindex)%ptr call get_curr_date (year, month, day, secs) @@ -1719,7 +1733,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, fld, bounds, num2d) ! ! !DESCRIPTION: ! Accumulate (or take min, max, etc. as appropriate) input field @@ -1737,7 +1751,7 @@ 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) :: fld ! field index type(bounds_type), intent(in) :: bounds integer, intent(in) :: num2d ! size of second dimension ! @@ -1780,20 +1794,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)%avgflag + nacs => tape(t)%hlist(fld)%nacs + hbuf => tape(t)%hlist(fld)%hbuf + beg1d = tape(t)%hlist(fld)%field%beg1d + end1d = tape(t)%hlist(fld)%field%end1d + beg1d_out = tape(t)%hlist(fld)%field%beg1d_out + end1d_out = tape(t)%hlist(fld)%field%end1d_out + type1d = tape(t)%hlist(fld)%field%type1d + type1d_out = tape(t)%hlist(fld)%field%type1d_out + p2c_scale_type = tape(t)%hlist(fld)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(fld)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(fld)%field%l2g_scale_type + no_snow_behavior = tape(t)%hlist(fld)%field%no_snow_behavior + hpindex = tape(t)%hlist(fld)%field%hpindex call get_curr_date (year, month, day, secs) @@ -2254,7 +2268,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. @@ -2263,9 +2277,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 @@ -2279,18 +2294,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)%avgflag(f) ! TODO Is this how I'm changing avgflag? + if ( is_mapping_upto_subgrid(tape(t)%hlist(fld)%field%type1d, tape(t)%hlist(fld)%field%type1d_out) )then + beg1d = tape(t)%hlist(fld)%field%beg1d_out + end1d = tape(t)%hlist(fld)%field%end1d_out else - beg1d = tape(t)%hlist(f)%field%beg1d - end1d = tape(t)%hlist(f)%field%end1d + beg1d = tape(t)%hlist(fld)%field%beg1d + end1d = tape(t)%hlist(fld)%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)%field%num2d + nacs => tape(t)%hlist(fld)%nacs + hbuf => tape(t)%hlist(fld)%hbuf if (avgflag == 'A' .or. avgflag(1:1) == 'L') then aflag = .true. @@ -2312,7 +2327,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. @@ -2320,15 +2335,16 @@ 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)%hbuf(:,:) = 0._r8 + tape(t)%hlist(fld)%nacs(:,:) = 0 end do end subroutine hfields_zero @@ -2350,11 +2366,14 @@ subroutine htape_create (t, f, histrest) use fileutils , only : get_filename ! ! !ARGUMENTS: - integer, intent(in) :: t, f ! tape index, file index + integer, intent(in) :: t ! tape index + ! TODO If finding that file dimension is necessary elsewhere for histrest, + ! then f is required. Otherwise, remove it from the second call. + integer, intent(in), optional :: f ! file index for use if not histrest logical, intent(in), optional :: histrest ! if creating the history restart file ! ! !LOCAL VARIABLES: - ! 5) TODO slevis: Rm old f in this subr. as unused and introduce f as file index DONE + ! 5) TODO DONE Rm old f in this subr. as unused and introduce f as file index integer :: p,c,l,n ! indices integer :: ier ! error code integer :: num2d ! size of second dimension (e.g. number of vertical levels) @@ -2666,7 +2685,8 @@ subroutine htape_add_cft_metadata(lnfid) end subroutine htape_add_cft_metadata !----------------------------------------------------------------------- - subroutine htape_timeconst3D(t, & + ! 7b) TODO Add argument f in the call + subroutine htape_timeconst3D(t, f, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & cellsand_col, cellclay_col, mode) ! @@ -2685,6 +2705,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: ) @@ -2787,7 +2808,9 @@ subroutine htape_timeconst3D(t, & end if if (tape(t)%dov2xy) then if (ldomain%isgrid2d) then - ! 6) TODO slevis: Changed nfid(t) to (t,f) throughout DONE + ! 6) TODO DONE Changed nfid(t) to (t,f) throughout + ! TODO Use ncid => nfid(t,f) here and elsewhere if possible, as done in + ! subroutine hfields_1dinfo 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, & @@ -3035,7 +3058,8 @@ subroutine htape_timeconst3D(t, & end subroutine htape_timeconst3D !----------------------------------------------------------------------- - subroutine htape_timeconst(t, mode) + ! 7c) TODO Add argument f in the call + subroutine htape_timeconst(t, f, mode) ! ! !DESCRIPTION: ! Write time constant values to primary history tape. @@ -3097,6 +3121,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' ! @@ -3586,7 +3611,8 @@ subroutine htape_timeconst(t, mode) end subroutine htape_timeconst !----------------------------------------------------------------------- - subroutine hfields_write(t, mode) + ! 7d) TODO Add argument f in the call + subroutine hfields_write(t, f, mode) ! ! !DESCRIPTION: ! Write history tape. Issue the call to write the variable. @@ -3596,10 +3622,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 @@ -3640,25 +3667,25 @@ subroutine hfields_write(t, mode) ! Define time-dependent variables create variables and attributes for field list - do f = 1,tape(t)%nflds + 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 + varname = tape(t)%hlist(fld)%field%name + long_name = tape(t)%hlist(fld)%field%long_name + units = tape(t)%hlist(fld)%field%units + avgflag = tape(t)%hlist(fld)%avgflag + type1d = tape(t)%hlist(fld)%field%type1d + type1d_out = tape(t)%hlist(fld)%field%type1d_out + beg1d = tape(t)%hlist(fld)%field%beg1d + end1d = tape(t)%hlist(fld)%field%end1d + beg1d_out = tape(t)%hlist(fld)%field%beg1d_out + end1d_out = tape(t)%hlist(fld)%field%end1d_out + num1d_out = tape(t)%hlist(fld)%field%num1d_out + type2d = tape(t)%hlist(fld)%field%type2d + numdims = tape(t)%hlist(fld)%field%numdims + num2d = tape(t)%hlist(fld)%field%num2d + l2g_scale_type = tape(t)%hlist(fld)%field%l2g_scale_type nt = tape(t)%ntimes if (mode == 'define') then @@ -3766,7 +3793,7 @@ subroutine hfields_write(t, mode) end subroutine hfields_write !----------------------------------------------------------------------- - subroutine hfields_1dinfo(t, mode) + subroutine hfields_1dinfo(t, f, mode) ! ! !DESCRIPTION: ! Write/define 1d info for history tape. @@ -3777,10 +3804,11 @@ 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 + ! 7e) TODO DONE Rm old f in this subr. as unused and introduce f as file index integer :: k ! 1d index integer :: g,c,l,p ! indices integer :: ier ! errir status @@ -4131,7 +4159,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) @@ -4175,110 +4204,111 @@ 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 + do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then - cycle - end if - - ! Skip nstep=0 if monthly average + if (.not. history_tape_in_use(t,f)) then + cycle + end if - if (nstep==0 .and. tape(t)%nhtfrq==0) then - cycle - end if + ! Skip nstep=0 if monthly average - ! 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 + if (nstep==0 .and. tape(t)%nhtfrq==0) then + cycle + end if - ! If end of history interval + ! 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 - if (tape(t)%is_endhist) then + ! If end of history interval - ! Normalize history buffer if time averaged + if (tape(t)%is_endhist) then - call hfields_normalize(t) + ! Normalize history buffer if time averaged - ! Increment current time sample counter. + call hfields_normalize(t, f) - tape(t)%ntimes = tape(t)%ntimes + 1 + ! Increment current time sample counter. - ! Create history file if appropriate and build time comment + tape(t)%ntimes = tape(t)%ntimes + 1 - ! If first time sample, generate unique history file name, open file, - ! define dims, vars, etc. + ! Create history file if appropriate and build time comment + ! If first time sample, generate unique history file name, open file, + ! define dims, vars, etc. - if (tape(t)%ntimes == 1) then - call t_startf('hist_htapes_wrapup_define') - ! 2) TODO slevis: Changed locfnh(t) to locfnh(t,f) throughout DONE - 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 file t = ',t - endif - call htape_create (t, f) - ! Define time-constant field variables - call htape_timeconst(t, mode='define') + if (tape(t)%ntimes == 1) then + call t_startf('hist_htapes_wrapup_define') + ! 2) TODO DONE Changed locfnh(t) to locfnh(t,f) throughout + 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 file t = ',t + 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,f)) - end if + ! Define time-constant field variables + call htape_timeconst(t, 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, & + 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,f)) - call t_stopf('hist_htapes_wrapup_define') - endif + ! Define model field variables + call hfields_write(t, 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, mode='write') - 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 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 - ! 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, mode='write') + call t_stopf('hist_htapes_wrapup_write') - end if + ! Zero necessary history buffers + call hfields_zero(t) + end if + end do ! end loop over history files end do ! end loop over history tapes ! Determine if file needs to be closed @@ -4408,7 +4438,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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 @@ -4487,77 +4518,79 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! only read/write accumulators and counters if needed do t = 1,ntapes - if (.not. history_tape_in_use(t,f)) 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, f, 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 + do f = 1, maxsplitfiles + 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 + locfnhr(t) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & + // ".rh" // hnum //"."// trim(rdate) //".nc" + + call htape_create( t, f, histrest=.true. ) + + ! Add read/write accumultators and counters if needed + if (.not. tape(t)%is_endhist) then + do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld)%field%name + long_name = tape(t)%hlist(fld)%field%long_name + units = tape(t)%hlist(fld)%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)%field%type1d_out + type2d = tape(t)%hlist(fld)%field%type2d + num2d = tape(t)%hlist(fld)%field%num2d + nacs => tape(t)%hlist(fld)%nacs + hbuf => tape(t)%hlist(fld)%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), 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)) + 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 - 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 + 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)) + 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 + end do ! end loop over history files TODO Name new loops instead of commenting ! ! Add namelist information to each restart history tape @@ -4664,17 +4697,19 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add history filenames to master restart file do t = 1,ntapes - ! 3) TODO slevis: Changed history_tape_in_use(t) to (t,f) throughout DONE - call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) - if (history_tape_in_use(t,f)) then - my_locfnh = locfnh(t,f) - 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) + ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout + do f = 1, maxsplitfiles + call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) + if (history_tape_in_use(t,f)) then + my_locfnh = locfnh(t,f) + 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 ! end loop over history files TODO Name new loops instead of commenting end do fincl(:,1) = hist_fincl1(:) @@ -4709,65 +4744,67 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) allocate(itemp(max_nflds)) do t = 1,ntapes - if (.not. history_tape_in_use(t,f)) then - cycle - end if + do f = 1, maxsplitfiles + 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), 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), 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), 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), 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 f = 1, tape(t)%nflds(f) + itemp(fld) = tape(t)%hlist(fld)%field%num2d + end do + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), 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 + itemp(:) = 0 + do f = 1, tape(t)%nflds(f) + itemp(fld) = tape(t)%hlist(fld)%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(f) + tname(fld) = tape(t)%hlist(fld)%field%name + tunits(fld) = tape(t)%hlist(fld)%field%units + tlongname(fld) = tape(t)%hlist(fld)%field%long_name + tmpstr(fld,1) = tape(t)%hlist(fld)%field%type1d + tmpstr(fld,2) = tape(t)%hlist(fld)%field%type1d_out + tmpstr(fld,3) = tape(t)%hlist(fld)%field%type2d + tavgflag(fld) = tape(t)%hlist(fld)%avgflag + p2c_scale_type(fld) = tape(t)%hlist(fld)%field%p2c_scale_type + c2l_scale_type(fld) = tape(t)%hlist(fld)%field%c2l_scale_type + l2g_scale_type(fld) = tape(t)%hlist(fld)%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) 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 + end do deallocate(itemp) ! @@ -4787,8 +4824,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if if (ntapes > 0) then - ! 4) TODO slevis: Changed history_tape_in_use_onfile(t) to (t,f) throughout DONE - allocate(history_tape_in_use_onfile(ntapes,maxsplitfiles)) + ! 4) TODO DONE Changed history_tape_in_use_onfile(t) to (t,f) throughout + allocate(history_tape_in_use_onfile(ntapes, maxsplitfiles)) call ncd_io('history_tape_in_use', history_tape_in_use_onfile, 'read', ncid, & readvar=readvar) if (.not. readvar) then @@ -5296,7 +5333,7 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, hist_m endif write(hist_index,'(i1.1)') hist_file - 1 write(file_index,'(i1.1)') f_index ! instantaneous or accumulated_file_index - ! 1) TODO slevis: After hist_index added file_index = "i" or "a" DONE + ! 1) TODO DONE After hist_index added file_index = "i" or "a" ! See maxsplitfiles in https://github.com/ESCOMP/CAM/pull/903/files ! See CAM#1003 for a bug-fix in monthly avged output ! AT THE END search all the vars that I modified to make sure I did not miss any of them From a37d9da749df11015e357ceeca36f770761e0663 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 16 Apr 2024 18:26:32 -0600 Subject: [PATCH 03/59] WIP (cont'd): Advancing through TODOs to permit 2+ files per tape --- src/main/histFileMod.F90 | 679 ++++++++++++++++++++------------------- 1 file changed, 349 insertions(+), 330 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 5cdea5d12f..f2fa4a6748 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -403,6 +403,7 @@ subroutine hist_printflds() ! the CTSM's web-based documentation. ! First sort the list to be in alphabetical order + ! TODO Is t = 1 argument needed? call sort_hist_list(1, nallhistflds, allhistfldlist) if (masterproc .and. hist_fields_list_file) then @@ -746,7 +747,7 @@ subroutine allhistfldlist_make_active (name, tape_index, avgflag) character(len=*), intent(in), optional :: avgflag ! time averaging flag ! ! !LOCAL VARIABLES: - ! 7a) TODO IN PROG Replace old f with fld; search "do f" "(f" 'f)" ... + ! 7a) TODO DONE Replace old f with fld; search "do f" "(f" 'f)" ... integer :: fld ! field index logical :: found ! flag indicates field found in allhistfldlist character(len=*),parameter :: subname = 'allhistfldlist_make_active' @@ -917,8 +918,8 @@ 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]). - ! 8) TODO Add do f = 1, maxsplitfiles where needed; search "do t =" "do t=" - do f = 1, maxsplitfiles + ! 8) TODO DONE do f = 1, maxsplitfiles where needed; search "do t" + file_loop: do f = 1, maxsplitfiles do fld = 1, nallhistflds allhistfldname = allhistfldlist(fld)%field%name call list_index (fincl(1,t), allhistfldname, ff) @@ -953,6 +954,7 @@ subroutine htapes_fieldlist() ! Specification of tape contents now complete. ! Sort each list of active entries + ! TODO Is t argument needed? call sort_hist_list(t, tape(t)%nflds(f), tape(t)%hlist) if (masterproc) then @@ -965,7 +967,7 @@ subroutine htapes_fieldlist() end do call shr_sys_flush(iulog) end if - end do + end do file_loop end do ! Determine index of max active history tape, and whether each tape is in use @@ -980,7 +982,7 @@ subroutine htapes_fieldlist() end do end do - ! 9) TODO Change nflds to nflds(f) throughout + ! 9) TODO DONE Change nflds to nflds(f) throughout do t = 1, ntapes do f = 1, maxsplitfiles if (tape(t)%nflds(f) > 0) then @@ -1088,7 +1090,7 @@ subroutine sort_hist_list(t, n_fields, hist_list) 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' @@ -1102,8 +1104,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 @@ -1351,7 +1353,7 @@ subroutine hist_update_hbuf(bounds) do t = 1,ntapes !$OMP PARALLEL DO PRIVATE (f, fld, num2d, numdims) - do f = 1, maxsplitfiles + file_loop: do f = 1, maxsplitfiles do fld = 1,tape(t)%nflds(f) numdims = tape(t)%hlist(fld)%field%numdims @@ -1363,7 +1365,7 @@ subroutine hist_update_hbuf(bounds) call hist_update_hbuf_field_2d (t, fld, bounds, num2d) end if end do - end do + end do file_loop !$OMP END PARALLEL DO end do @@ -2367,9 +2369,9 @@ subroutine htape_create (t, f, histrest) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index - ! TODO If finding that file dimension is necessary elsewhere for histrest, - ! then f is required. Otherwise, remove it from the second call. - integer, intent(in), optional :: f ! file index for use if not histrest + ! TODO If file dimension not necessary for histrest, make f optional + ! and remove from the second call to this subroutine + integer, intent(in) :: f ! file index logical, intent(in), optional :: histrest ! if creating the history restart file ! ! !LOCAL VARIABLES: @@ -2685,7 +2687,7 @@ subroutine htape_add_cft_metadata(lnfid) end subroutine htape_add_cft_metadata !----------------------------------------------------------------------- - ! 7b) TODO Add argument f in the call + ! 7b) TODO DONE Add argument f in the call subroutine htape_timeconst3D(t, f, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & cellsand_col, cellclay_col, mode) @@ -3058,7 +3060,7 @@ subroutine htape_timeconst3D(t, f, & end subroutine htape_timeconst3D !----------------------------------------------------------------------- - ! 7c) TODO Add argument f in the call + ! 7c) TODO DONE Add argument f in the call subroutine htape_timeconst(t, f, mode) ! ! !DESCRIPTION: @@ -3611,7 +3613,7 @@ subroutine htape_timeconst(t, f, mode) end subroutine htape_timeconst !----------------------------------------------------------------------- - ! 7d) TODO Add argument f in the call + ! 7d) TODO DONE Add argument f in the call subroutine hfields_write(t, f, mode) ! ! !DESCRIPTION: @@ -3667,7 +3669,7 @@ subroutine hfields_write(t, f, mode) ! Define time-dependent variables create variables and attributes for field list - do fld = 1,tape(t)%nflds(f) + fld_loop: do fld = 1, tape(t)%nflds(f) ! Set history field variables @@ -3756,7 +3758,7 @@ subroutine hfields_write(t, f, mode) ! Determine output buffer - histo => tape(t)%hlist(f)%hbuf + histo => tape(t)%hlist(fld)%hbuf ! Allocate dynamic memory @@ -3788,7 +3790,7 @@ subroutine hfields_write(t, f, mode) end if - end do + end do fld_loop end subroutine hfields_write @@ -4204,7 +4206,7 @@ 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 - do f = 1, maxsplitfiles + file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle @@ -4250,23 +4252,23 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & if (masterproc) then write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t,f)), & ' at nstep = ',get_nstep() - write(iulog,*)'calling htape_create for file t = ',t + write(iulog,*)'calling htape_create for tape t and file f = ', t, f endif call htape_create (t, f) ! Define time-constant field variables - call htape_timeconst(t, mode='define') + call htape_timeconst(t, f, mode='define') ! Define 3D time-constant field variables on first history tapes if ( do_3Dtconst .and. t == 1) then - call htape_timeconst3D(t, & + 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 ! Define model field variables - call hfields_write(t, mode='define') + call hfields_write(t, f, mode='define') ! Exit define model call ncd_enddef(nfid(t,f)) @@ -4275,11 +4277,11 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call t_startf('hist_htapes_wrapup_tconst') ! Write time constant history variables - call htape_timeconst(t, mode='write') + call htape_timeconst(t, f, mode='write') ! 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, & + call htape_timeconst3D(t, f, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & cellsand_col, cellclay_col, mode='write') do_3Dtconst = .false. @@ -4301,14 +4303,14 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Write history time samples call t_startf('hist_htapes_wrapup_write') - call hfields_write(t, mode='write') + call hfields_write(t, f, mode='write') call t_stopf('hist_htapes_wrapup_write') ! Zero necessary history buffers call hfields_zero(t) end if - end do ! end loop over history files + end do file_loop end do ! end loop over history tapes ! Determine if file needs to be closed @@ -4320,42 +4322,46 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! must reopen the files do t = 1, ntapes - if (.not. history_tape_in_use(t,f)) then - cycle - end if + file_loop: do f = 1, maxsplitfiles + 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,f)),' at nstep = ', get_nstep() - write(iulog,*) - endif + 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,f)),' at nstep = ', get_nstep() + write(iulog,*) + end if - call ncd_pio_closefile(nfid(t,f)) + 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,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 + if (.not.if_stop .and. (tape(t)%ntimes/=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 file_loop end do ! Reset number of time samples to zero if file is full do t = 1, ntapes - if (.not. history_tape_in_use(t,f)) then - cycle - end if + do f = 1, maxsplitfiles + 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) .and. tape(t)%ntimes==tape(t)%mfilt) then + tape(t)%ntimes = 0 + end if + end do end do end subroutine hist_htapes_wrapup @@ -4518,7 +4524,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! only read/write accumulators and counters if needed do t = 1,ntapes - do f = 1, maxsplitfiles + file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4532,7 +4538,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add read/write accumultators and counters if needed if (.not. tape(t)%is_endhist) then - do fld = 1, tape(t)%nflds(f) + fld_loop: do fld = 1, tape(t)%nflds(f) name = tape(t)%hlist(fld)%field%name long_name = tape(t)%hlist(fld)%field%long_name units = tape(t)%hlist(fld)%field%units @@ -4588,9 +4594,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) long_name=trim(long_name_acc), units=trim(units_acc)) end if endif - end do + end do fld_loop endif - end do ! end loop over history files TODO Name new loops instead of commenting + end do file_loop ! ! Add namelist information to each restart history tape @@ -4698,7 +4704,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add history filenames to master restart file do t = 1,ntapes ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout - do f = 1, maxsplitfiles + file_loop: do f = 1, maxsplitfiles call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) if (history_tape_in_use(t,f)) then my_locfnh = locfnh(t,f) @@ -4709,7 +4715,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=t) call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=t) - end do ! end loop over history files TODO Name new loops instead of commenting + end do file_loop end do fincl(:,1) = hist_fincl1(:) @@ -4744,7 +4750,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) allocate(itemp(max_nflds)) do t = 1,ntapes - do f = 1, maxsplitfiles + file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4758,28 +4764,28 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t), flag='write') itemp(:) = 0 - do f = 1, tape(t)%nflds(f) + do fld = 1, tape(t)%nflds(f) itemp(fld) = tape(t)%hlist(fld)%field%num2d end do call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='write') itemp(:) = 0 - do f = 1, tape(t)%nflds(f) + do fld = 1, tape(t)%nflds(f) itemp(fld) = tape(t)%hlist(fld)%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('nflds', tape(t)%nflds(f), '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(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)%field%name tunits(fld) = tape(t)%hlist(fld)%field%units tlongname(fld) = tape(t)%hlist(fld)%field%long_name @@ -4803,7 +4809,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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) - end do + end do file_loop end do deallocate(itemp) @@ -4835,25 +4841,30 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) history_tape_in_use_onfile(:,:) = .true. end if do t = 1, ntapes - if (history_tape_in_use_onfile(t,f) .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(t,f) - 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 + file_loop: do f = 1, maxsplitfiles + if (history_tape_in_use_onfile(t,f) .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(t,f) + 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_loop end do - - call ncd_io('locfnh', locfnh(1:ntapes,f), 'read', ncid ) + ! TODO Is this correct or should next few lines (and call ncd_io + ! above) be in a do f loop? + call ncd_io('locfnh', locfnh(1:ntapes,1:maxsplitfiles), '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,f)) + do f = 1, maxsplitfiles + call strip_null(locrest(t)) + call strip_null(locfnh(t,f)) + end do end do end if end if @@ -4864,174 +4875,176 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if ( is_restart() )then do t = 1,ntapes - if (.not. history_tape_in_use(t,f)) then - cycle - end if + file_loop: do f = 1, maxsplitfiles + 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), locfnhr(t), 0 ) + call ncd_pio_openfile (ncid_hist(t), trim(locfnhr(t)), ncd_nowrite) - if ( t == 1 )then + if ( t == 1 )then - call ncd_inqdlen(ncid_hist(1),dimid,max_nflds,name='max_nflds') + call ncd_inqdlen(ncid_hist(1),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), '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(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, '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 fld = 1, tape(t)%nflds(f) + tape(t)%hlist(fld)%field%num2d = itemp(fld) + end do - 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 + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='read') + do fld = 1, tape(t)%nflds(f) + tape(t)%hlist(fld)%field%hpindex = itemp(fld) + end do - 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 - - tape(t)%hlist(f)%field%num1d = num1d - tape(t)%hlist(f)%field%beg1d = beg1d - tape(t)%hlist(f)%field%end1d = end1d - - end do ! end of flds loop - - ! If history file is not full, open it + fld_loop: do fld = 1, tape(t)%nflds(f) + start(2) = fld + call ncd_io( name_desc, tape(t)%hlist(fld)%field%name, & + 'read', ncid_hist(t), start ) + call ncd_io( longname_desc, tape(t)%hlist(fld)%field%long_name, & + 'read', ncid_hist(t), start ) + call ncd_io( units_desc, tape(t)%hlist(fld)%field%units, & + 'read', ncid_hist(t), start ) + call ncd_io( type1d_desc, tape(t)%hlist(fld)%field%type1d, & + 'read', ncid_hist(t), start ) + call ncd_io( type1d_out_desc, tape(t)%hlist(fld)%field%type1d_out, & + 'read', ncid_hist(t), start ) + call ncd_io( type2d_desc, tape(t)%hlist(fld)%field%type2d, & + 'read', ncid_hist(t), start ) + call ncd_io( avgflag_desc, tape(t)%hlist(fld)%avgflag, & + 'read', ncid_hist(t), start ) + call ncd_io( p2c_scale_type_desc, tape(t)%hlist(fld)%field%p2c_scale_type, & + 'read', ncid_hist(t), start ) + call ncd_io( c2l_scale_type_desc, tape(t)%hlist(fld)%field%c2l_scale_type, & + 'read', ncid_hist(t), start ) + call ncd_io( l2g_scale_type_desc, tape(t)%hlist(fld)%field%l2g_scale_type, & + 'read', ncid_hist(t), start ) + call strip_null(tape(t)%hlist(fld)%field%name) + call strip_null(tape(t)%hlist(fld)%field%long_name) + call strip_null(tape(t)%hlist(fld)%field%units) + call strip_null(tape(t)%hlist(fld)%field%type1d) + call strip_null(tape(t)%hlist(fld)%field%type1d_out) + call strip_null(tape(t)%hlist(fld)%field%type2d) + call strip_null(tape(t)%hlist(fld)%field%p2c_scale_type) + call strip_null(tape(t)%hlist(fld)%field%c2l_scale_type) + call strip_null(tape(t)%hlist(fld)%field%l2g_scale_type) + call strip_null(tape(t)%hlist(fld)%avgflag) + + type1d_out = trim(tape(t)%hlist(fld)%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 - if (tape(t)%ntimes /= 0) then - call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) - end if + tape(t)%hlist(fld)%field%num1d_out = num1d_out + tape(t)%hlist(fld)%field%beg1d_out = beg1d_out + tape(t)%hlist(fld)%field%end1d_out = end1d_out + + num2d = tape(t)%hlist(fld)%field%num2d + allocate (tape(t)%hlist(fld)%hbuf(beg1d_out:end1d_out,num2d), & + tape(t)%hlist(fld)%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(fld)%hbuf(:,:) = 0._r8 + tape(t)%hlist(fld)%nacs(:,:) = 0 + + type1d = tape(t)%hlist(fld)%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(fld)%field%num1d = num1d + tape(t)%hlist(fld)%field%beg1d = beg1d + tape(t)%hlist(fld)%field%end1d = end1d + end do fld_loop + + ! If history file is not full, open it + + if (tape(t)%ntimes /= 0) then + call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) + end if + + end do file_loop end do ! end of tapes loop hist_fincl1(:) = fincl(:,1) @@ -5072,54 +5085,56 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if (flag == 'write') then do t = 1,ntapes - if (.not. history_tape_in_use(t,f)) then - cycle - end if + file_loop: do f = 1, maxsplitfiles + if (.not. history_tape_in_use(t,f)) 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 + if (.not. tape(t)%is_endhist) then - hbuf1d(beg1d_out:end1d_out) = hbuf(beg1d_out:end1d_out,1) - nacs1d(beg1d_out:end1d_out) = nacs(beg1d_out:end1d_out,1) + fld_loop: do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(fld)%field%type1d_out + type2d = tape(t)%hlist(fld)%field%type2d + num2d = tape(t)%hlist(fld)%field%num2d + beg1d_out = tape(t)%hlist(fld)%field%beg1d_out + end1d_out = tape(t)%hlist(fld)%field%end1d_out + nacs => tape(t)%hlist(fld)%nacs + hbuf => tape(t)%hlist(fld)%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 - 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) + hbuf1d(beg1d_out:end1d_out) = hbuf(beg1d_out:end1d_out,1) + nacs1d(beg1d_out:end1d_out) = nacs(beg1d_out:end1d_out,1) - 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 + 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) - end do + 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 + + end do fld_loop - 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)) + end do file_loop end do ! end of ntapes loop else if (flag == 'read') then @@ -5127,53 +5142,55 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Read history restart information if history files are not full do t = 1,ntapes - if (.not. history_tape_in_use(t,f)) then - cycle - end if + file_loop: do f = 1, maxsplitfiles + if (.not. history_tape_in_use(t,f)) 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 + if (.not. tape(t)%is_endhist) then - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & - dim1name=type1d_out, data=hbuf1d) - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & - dim1name=type1d_out, data=nacs1d) + fld_loop: do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(fld)%field%type1d_out + type2d = tape(t)%hlist(fld)%field%type2d + num2d = tape(t)%hlist(fld)%field%num2d + beg1d_out = tape(t)%hlist(fld)%field%beg1d_out + end1d_out = tape(t)%hlist(fld)%field%end1d_out + nacs => tape(t)%hlist(fld)%nacs + hbuf => tape(t)%hlist(fld)%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 - hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) - nacs(beg1d_out:end1d_out,1) = nacs1d(beg1d_out:end1d_out) + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf1d) + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs1d) - deallocate(hbuf1d) - deallocate(nacs1d) - else - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & - dim1name=type1d_out, data=hbuf) - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & - dim1name=type1d_out, data=nacs) - end if - end do + hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) + nacs(beg1d_out:end1d_out,1) = nacs1d(beg1d_out:end1d_out) - end if + deallocate(hbuf1d) + deallocate(nacs1d) + else + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf) + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs) + end if + end do fld_loop - call ncd_pio_closefile(ncid_hist(t)) + end if + call ncd_pio_closefile(ncid_hist(t)) + + end do file_loop end do end if @@ -5189,13 +5206,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, maxsplitfiles + max_nFields = max(max_nFields, tape(t)%nflds(f)) + end do end do return end function max_nFields @@ -5275,18 +5294,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 From 15535a06622efb46ebd0b07a4cbf7a82da58167f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 6 May 2024 15:27:33 -0600 Subject: [PATCH 04/59] Minor comment update to keep track of progress --- src/main/histFileMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index f2fa4a6748..9beccecd0e 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -259,7 +259,7 @@ end subroutine copy_entry_interface ! overridden by namelist params like hist_fincl1. type, extends(entry_base) :: allhistfldlist_entry logical :: actflag(max_tapes) ! which history tapes to write to. - ! 10) TODO Add second dimension to avgflag as necessary + ! 10) TODO NEXT Add second dimension to avgflag as necessary character(len=avgflag_strlen) :: avgflag(max_tapes, maxsplitfiles) ! type of time averaging contains procedure :: copy => copy_allhistfldlist_entry @@ -333,7 +333,7 @@ end subroutine copy_entry_interface ! Other variables ! character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names - ! TODO History restart files seem to mirror history files => need the second dimension I think + ! 11) TODO History restart files seem to mirror history files => need the second dimension I think character(len=max_length_filename) :: locfnhr(max_tapes) ! local history restart file names logical :: htapes_defined = .false. ! flag indicates history output fields have been defined ! From 7803fd425636dce875ec099d2806fb0b550e8b4b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 17 Dec 2024 17:01:59 -0700 Subject: [PATCH 05/59] Minor update to histFileMod, mainly in TODO comments --- src/main/histFileMod.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 4d8be1bc6b..316f825aaf 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -80,6 +80,10 @@ module histFileMod hist_dov2xy(max_tapes) = (/.true.,(.true.,ni=2,max_tapes)/) ! namelist: true=> do grid averaging integer, public :: & hist_nhtfrq(max_tapes) = (/0, (-24, ni=2,max_tapes)/) ! namelist: history write freq(0=monthly) + ! TODO slevis: My intuition currently says that namelist hist_* variables and the User should + ! remain agnostic as to whether tapes correspond to instantaneous or non files. + ! The split will happen under the covers at runtime, and the hist_* vars should NOT + ! have a 2nd (i.e. file) dimension. character(len=avgflag_strlen), public :: & hist_avgflag_pertape(max_tapes) = (/(' ',ni=1,max_tapes)/) ! namelist: per tape averaging flag character(len=max_namlen), public :: & @@ -260,9 +264,11 @@ end subroutine copy_entry_interface ! These values are specified in hist_addfld* calls but then can be ! overridden by namelist params like hist_fincl1. type, extends(entry_base) :: allhistfldlist_entry + ! 10) TODO DONE Add 2nd dim to avgflag and actflag + ! UNDONE because both are also dimensioned by fld which (at least + ! for now) is unique per tape; therefore, do not specify file number logical :: actflag(max_tapes) ! which history tapes to write to. - ! 10) TODO NEXT Add second dimension to avgflag as necessary - character(len=avgflag_strlen) :: avgflag(max_tapes, maxsplitfiles) ! type of time averaging + character(len=avgflag_strlen) :: avgflag(max_tapes) ! type of time averaging contains procedure :: copy => copy_allhistfldlist_entry end type allhistfldlist_entry @@ -335,7 +341,7 @@ end subroutine copy_entry_interface ! Other variables ! character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names - ! 11) TODO History restart files seem to mirror history files => need the second dimension I think + ! 11) TODO NEXT History restart files seem to mirror history files => need the second dimension I think character(len=max_length_filename) :: locfnhr(max_tapes) ! local history restart file names logical :: htapes_defined = .false. ! flag indicates history output fields have been defined ! @@ -2299,7 +2305,7 @@ subroutine hfields_normalize (t, f) ! Normalize by number of accumulations for time averaged case do fld = 1,tape(t)%nflds(f) - avgflag = tape(t)%hlist(fld)%avgflag(f) ! TODO Is this how I'm changing avgflag? + avgflag = tape(t)%hlist(fld)%avgflag if ( is_mapping_upto_subgrid(tape(t)%hlist(fld)%field%type1d, tape(t)%hlist(fld)%field%type1d_out) )then beg1d = tape(t)%hlist(fld)%field%beg1d_out end1d = tape(t)%hlist(fld)%field%end1d_out From 2304d59c3c1dbf7ea0381930c7efb65eb93aafba Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 18 Dec 2024 14:39:53 -0700 Subject: [PATCH 06/59] WIP (cont'd): Allow 2+ restart files per tape to mirror the hist files --- src/main/histFileMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 316f825aaf..39deea734b 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -341,8 +341,8 @@ end subroutine copy_entry_interface ! Other variables ! character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names - ! 11) TODO NEXT History restart files seem to mirror history files => need the second dimension I think - character(len=max_length_filename) :: locfnhr(max_tapes) ! local history restart file names + ! 11) TODO DONE History restart files seem to mirror history files => need the second dimension I think + character(len=max_length_filename) :: locfnhr(max_tapes, maxsplitfiles) ! local history restart file names logical :: htapes_defined = .false. ! flag indicates history output fields have been defined ! ! NetCDF Id's @@ -2444,10 +2444,10 @@ subroutine htape_create (t, f, histrest) 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', & @@ -4530,7 +4530,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Create the restart history filename and open it write(hnum,'(i1.1)') t-1 - locfnhr(t) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & + locfnhr(t,f) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & // ".rh" // hnum //"."// trim(rdate) //".nc" call htape_create( t, f, histrest=.true. ) @@ -4707,7 +4707,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) if (history_tape_in_use(t,f)) then my_locfnh = locfnh(t,f) - my_locfnhr = locfnhr(t) + my_locfnhr = locfnhr(t,f) else my_locfnh = 'non_existent_file' my_locfnhr = 'non_existent_file' @@ -4879,8 +4879,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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), locfnhr(t,f), 0 ) + call ncd_pio_openfile (ncid_hist(t), trim(locfnhr(t,f)), ncd_nowrite) if ( t == 1 )then From 93007dd0ff3bfba9d567d1894662117786be1ec0 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 18 Dec 2024 15:52:04 -0700 Subject: [PATCH 07/59] WIP (cont'd): Part (b) of the last commit --- src/main/histFileMod.F90 | 387 ++++++++++++++++++++------------------- 1 file changed, 196 insertions(+), 191 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 39deea734b..f7c7784616 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -341,14 +341,15 @@ end subroutine copy_entry_interface ! Other variables ! character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names - ! 11) TODO DONE History restart files seem to mirror history files => need the second dimension I think + ! 11a) TODO DONE History restart files seem to mirror history files => need the second dimension I think character(len=max_length_filename) :: locfnhr(max_tapes, maxsplitfiles) ! 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, maxsplitfiles) ! file ids - type(file_desc_t), target :: ncid_hist(max_tapes) ! file ids for history restart files + ! 11b) TODO DONE History restart files seem to mirror history files => need the second dimension I think + type(file_desc_t), target :: ncid_hist(max_tapes, maxsplitfiles) ! file ids for history restart files integer :: time_dimid ! time dimension id integer :: hist_interval_dimid ! time bounds dimension id integer :: strlen_dimid ! string dimension id @@ -2378,8 +2379,6 @@ subroutine htape_create (t, f, histrest) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index - ! TODO If file dimension not necessary for histrest, make f optional - ! and remove from the second call to this subroutine integer, intent(in) :: f ! file index logical, intent(in), optional :: histrest ! if creating the history restart file ! @@ -2424,7 +2423,7 @@ subroutine htape_create (t, f, histrest) ncprec = tape(t)%ncprec if (lhistrest) then - lnfid => ncid_hist(t) + lnfid => ncid_hist(t,f) else lnfid => nfid(t,f) endif @@ -4406,7 +4405,8 @@ 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 + ! 11c) TODO History restart files seem to mirror history files => need the second dimension I think + character(len=max_chars) :: locrest(max_tapes, maxsplitfiles) ! local history restart file names character(len=max_length_filename) :: my_locfnh ! temporary version of locfnh character(len=max_length_filename) :: my_locfnhr ! temporary version of locfnhr @@ -4522,7 +4522,7 @@ 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 + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle @@ -4536,7 +4536,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call htape_create( t, f, histrest=.true. ) ! Add read/write accumultators and counters if needed - if (.not. tape(t)%is_endhist) then + not_endhist: if (.not. tape(t)%is_endhist) then fld_loop: do fld = 1, tape(t)%nflds(f) name = tape(t)%hlist(fld)%field%name long_name = tape(t)%hlist(fld)%field%long_name @@ -4562,134 +4562,134 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if (dim2name == 'undefined') then if (num2d == 1) then - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + 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), varname=trim(name_acc), xtype=ncd_int, & + 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), varname=trim(name), xtype=ncd_double, & + 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), varname=trim(name_acc), xtype=ncd_int, & + 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 if (num2d == 1) then - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + 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), varname=trim(name_acc), xtype=ncd_int, & + 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), varname=trim(name), xtype=ncd_double, & + 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), varname=trim(name_acc), xtype=ncd_int, & + 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_loop - endif - end do file_loop + 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)) - ! - ! 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 + end do file_loop + end do tape_loop RETURN @@ -4701,7 +4701,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) !================================================ ! Add history filenames to master restart file - do t = 1,ntapes + tape_loop: do t = 1, ntapes ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout file_loop: do f = 1, maxsplitfiles call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) @@ -4715,8 +4715,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=t) call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=t) end do file_loop - end do + end do tape_loop + ! 12a) TODO LHS fincl & fexcl may need the file dimension here fincl(:,1) = hist_fincl1(:) fincl(:,2) = hist_fincl2(:) fincl(:,3) = hist_fincl3(:) @@ -4748,38 +4749,40 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! allocate(itemp(max_nflds)) - do t = 1,ntapes + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles 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') + ! 12c) TODO fincl & fexcl may need the file dimension here (and elsewhere?) + ! Look into is_endhist, as well + 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 fld = 1, tape(t)%nflds(f) itemp(fld) = tape(t)%hlist(fld)%field%num2d end do - call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='write') + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t,f), flag='write') itemp(:) = 0 do fld = 1, tape(t)%nflds(f) itemp(fld) = tape(t)%hlist(fld)%field%hpindex end do - call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='write') - - call ncd_io('nflds', tape(t)%nflds(f), '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) ) + 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, '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)), & @@ -4796,20 +4799,20 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) c2l_scale_type(fld) = tape(t)%hlist(fld)%field%c2l_scale_type l2g_scale_type(fld) = tape(t)%hlist(fld)%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)) + 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_loop - end do + end do tape_loop deallocate(itemp) ! @@ -4873,58 +4876,59 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) start(1)=1 if ( is_restart() )then - do t = 1,ntapes + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if call getfil( locrest(t), locfnhr(t,f), 0 ) - call ncd_pio_openfile (ncid_hist(t), trim(locfnhr(t,f)), ncd_nowrite) + call ncd_pio_openfile (ncid_hist(t,f), trim(locfnhr(t,f)), ncd_nowrite) if ( t == 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 - 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_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), flag='read') + ! 12d) TODO fincl & fexcl may need the file dimension here (and elsewhere?) + 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), 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) ) + 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') + call ncd_io('ntimes', tape(t)%ntimes, '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)%field%num2d = itemp(fld) end do - call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='read') + 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)%field%hpindex = itemp(fld) end do @@ -4932,25 +4936,25 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) fld_loop: do fld = 1, tape(t)%nflds(f) start(2) = fld call ncd_io( name_desc, tape(t)%hlist(fld)%field%name, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( longname_desc, tape(t)%hlist(fld)%field%long_name, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( units_desc, tape(t)%hlist(fld)%field%units, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( type1d_desc, tape(t)%hlist(fld)%field%type1d, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( type1d_out_desc, tape(t)%hlist(fld)%field%type1d_out, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( type2d_desc, tape(t)%hlist(fld)%field%type2d, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( avgflag_desc, tape(t)%hlist(fld)%avgflag, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( p2c_scale_type_desc, tape(t)%hlist(fld)%field%p2c_scale_type, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( c2l_scale_type_desc, tape(t)%hlist(fld)%field%c2l_scale_type, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call ncd_io( l2g_scale_type_desc, tape(t)%hlist(fld)%field%l2g_scale_type, & - 'read', ncid_hist(t), start ) + 'read', ncid_hist(t,f), start ) call strip_null(tape(t)%hlist(fld)%field%name) call strip_null(tape(t)%hlist(fld)%field%long_name) call strip_null(tape(t)%hlist(fld)%field%units) @@ -5044,8 +5048,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if end do file_loop - end do ! end of tapes loop + end do tape_loop + ! 12b) TODO LHS fincl & fexcl may need the file dimension here hist_fincl1(:) = fincl(:,1) hist_fincl2(:) = fincl(:,2) hist_fincl3(:) = fincl(:,3) @@ -5081,9 +5086,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! A new history file is used on a branch run. !====================================================================== - if (flag == 'write') then + read_write: if (flag == 'write') then - do t = 1,ntapes + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle @@ -5113,17 +5118,17 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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), flag='write', varname=trim(name), & + 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), flag='write', varname=trim(name_acc), & + 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), flag='write', varname=trim(name), & + 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), flag='write', varname=trim(name_acc), & + call ncd_io(ncid=ncid_hist(t,f), flag='write', varname=trim(name_acc), & dim1name=type1d_out, data=nacs) end if @@ -5131,16 +5136,16 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if ! end of is_endhist block - call ncd_pio_closefile(ncid_hist(t)) + call ncd_pio_closefile(ncid_hist(t,f)) end do file_loop - end do ! end of ntapes loop + end do tape_loop else if (flag == 'read') then ! Read history restart information if history files are not full - do t = 1,ntapes + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle @@ -5167,9 +5172,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name), & dim1name=type1d_out, data=hbuf1d) - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name_acc), & dim1name=type1d_out, data=nacs1d) hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) @@ -5178,21 +5183,21 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) deallocate(hbuf1d) deallocate(nacs1d) else - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name), & dim1name=type1d_out, data=hbuf) - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name_acc), & dim1name=type1d_out, data=nacs) end if end do fld_loop end if - call ncd_pio_closefile(ncid_hist(t)) + call ncd_pio_closefile(ncid_hist(t,f)) end do file_loop - end do + end do tape_loop - end if + end if read_write end subroutine hist_restart_ncd From 16217fe4facf21e85cafddd0a1edc5610ea3bb38 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 18 Dec 2024 16:07:16 -0700 Subject: [PATCH 08/59] WIP (cont'd): Part (c) of the last commit --- src/main/histFileMod.F90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index f7c7784616..aa883af3f8 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4405,7 +4405,7 @@ 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 - ! 11c) TODO History restart files seem to mirror history files => need the second dimension I think + ! 11c) TODO DONE History restart files seem to mirror history files => need the second dimension I think character(len=max_chars) :: locrest(max_tapes, maxsplitfiles) ! local history restart file names character(len=max_length_filename) :: my_locfnh ! temporary version of locfnh character(len=max_length_filename) :: my_locfnhr ! temporary version of locfnhr @@ -4479,7 +4479,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 @@ -4823,7 +4823,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) !================================================ call ncd_inqdlen(ncid,dimid,ntapes_onfile, name='ntapes') - if (is_restart()) then + is_restart: 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. '// & @@ -4831,7 +4831,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) additional_msg=errMsg(sourcefile, __LINE__)) end if - if (ntapes > 0) then + ntapes_gt_0: if (ntapes > 0) then ! 4) TODO DONE Changed history_tape_in_use_onfile(t) to (t,f) throughout allocate(history_tape_in_use_onfile(ntapes, maxsplitfiles)) call ncd_io('history_tape_in_use', history_tape_in_use_onfile, 'read', ncid, & @@ -4861,28 +4861,28 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! TODO Is this correct or should next few lines (and call ncd_io ! above) be in a do f loop? call ncd_io('locfnh', locfnh(1:ntapes,1:maxsplitfiles), 'read', ncid ) - call ncd_io('locfnhr', locrest(1:ntapes), 'read', ncid ) - do t = 1,ntapes - do f = 1, maxsplitfiles - call strip_null(locrest(t)) + call ncd_io('locfnhr', locrest(1:ntapes,1:maxsplitfiles), 'read', ncid ) + tape_loop: do t = 1, ntapes + file_loop: do f = 1, maxsplitfiles + call strip_null(locrest(t,f)) call strip_null(locfnh(t,f)) - end do - end do - end if - end if + end do file_loop + end do tape_loop + end if ntapes_gt_0 + end if is_restart ! Determine necessary indices - the following is needed if model decomposition is different on restart start(1)=1 - if ( is_restart() )then + is_restart: if ( is_restart() ) then tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if - call getfil( locrest(t), locfnhr(t,f), 0 ) + 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 @@ -5073,11 +5073,11 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) hist_fexcl9(:) = fexcl(:,9) hist_fexcl10(:) = fexcl(:,10) - end if + end if is_restart if ( allocated(itemp) ) deallocate(itemp) - end if + end if define_read_write !====================================================================== ! Read/write history file restart data. From 5810d1da470d19fc5947ee91973eecdad05dca6f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 18 Dec 2024 16:41:21 -0700 Subject: [PATCH 09/59] Clean-up some new and existing do-loops --- src/main/histFileMod.F90 | 44 +++++++++++++++++++++------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index aa883af3f8..a84afb48da 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -321,8 +321,8 @@ 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, maxsplitfiles) ! whether each history tape is in use in this run ! @@ -885,7 +885,7 @@ subroutine htapes_fieldlist() ! First ensure contents of fincl and fexcl are valid names - do t = 1,max_tapes + tape_loop: do t = 1, max_tapes fld = 1 do while (fld < max_flds .and. fincl(fld,t) /= ' ') name = getname (fincl(fld,t)) @@ -914,11 +914,11 @@ subroutine htapes_fieldlist() end if fld = fld + 1 end do - end do + end do tape_loop history_tape_in_use(:,:) = .false. tape(:)%nflds(:) = 0 - do t = 1,max_tapes + tape_loop: 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 @@ -977,7 +977,7 @@ subroutine htapes_fieldlist() call shr_sys_flush(iulog) end if end do file_loop - end do + end do tape_loop ! Determine index of max active history tape, and whether each tape is in use @@ -1018,7 +1018,7 @@ subroutine htapes_fieldlist() if (masterproc) then write(iulog,*) 'There will be a total of ',ntapes,' history tapes' - do t=1,ntapes + tape_loop: do t = 1, ntapes write(iulog,*) if (hist_nhtfrq(t) == 0) then write(iulog,*)'History tape ',t,' write frequency is MONTHLY' @@ -1032,12 +1032,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,f)) then - write(iulog,*) 'History tape ',t,' does not have any fields,' - write(iulog,*) 'so it will not be written!' - end if + file_loop: do f = 1, maxsplitfiles + 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_loop write(iulog,*) - end do + end do tape_loop call shr_sys_flush(iulog) end if @@ -2821,7 +2823,7 @@ subroutine htape_timeconst3D(t, f, & if (tape(t)%dov2xy) then if (ldomain%isgrid2d) then ! 6) TODO DONE Changed nfid(t) to (t,f) throughout - ! TODO Use ncid => nfid(t,f) here and elsewhere if possible, as done in + ! TODO LATER Use ncid => nfid(t,f) here and elsewhere if possible, as done in ! subroutine hfields_1dinfo call ncd_defvar(ncid=nfid(t,f), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec,& dim1name='lon', dim2name='lat', dim3name='levgrnd', & @@ -4203,7 +4205,7 @@ 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 + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then @@ -4309,7 +4311,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & end if end do file_loop - end do ! end loop over history tapes + end do tape_loop ! Determine if file needs to be closed @@ -4319,7 +4321,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Auxilary files may have been closed and saved off without being full, ! must reopen the files - do t = 1, ntapes + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle @@ -4346,7 +4348,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & endif endif end do file_loop - end do + end do tape_loop ! Reset number of time samples to zero if file is full @@ -4717,7 +4719,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end do file_loop end do tape_loop - ! 12a) TODO LHS fincl & fexcl may need the file dimension here + ! 12a) TODO NEXT: LHS fincl & fexcl may need the file dimension here fincl(:,1) = hist_fincl1(:) fincl(:,2) = hist_fincl2(:) fincl(:,3) = hist_fincl3(:) @@ -4842,7 +4844,7 @@ 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 + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles if (history_tape_in_use_onfile(t,f) .neqv. history_tape_in_use(t,f)) then write(iulog,*) subname//' ERROR: history_tape_in_use on restart file' @@ -4857,7 +4859,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) additional_msg=errMsg(sourcefile, __LINE__)) end if end do file_loop - end do + end do tape_loop ! TODO Is this correct or should next few lines (and call ncd_io ! above) be in a do f loop? call ncd_io('locfnh', locfnh(1:ntapes,1:maxsplitfiles), 'read', ncid ) @@ -5359,7 +5361,7 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, hist_m ! 1) TODO DONE After hist_index added file_index = "i" or "a" ! See maxsplitfiles in https://github.com/ESCOMP/CAM/pull/903/files ! See CAM#1003 for a bug-fix in monthly avged output - ! AT THE END search all the vars that I modified to make sure I did not miss any of them + ! TODO FINAL search all the vars that I modified to make sure I did not miss any of them set_hist_filename = "./"//trim(caseid)//"."//trim(compname)//trim(inst_suffix)//& ".h"//hist_index//file_index//"."//trim(cdate)//".nc" From fbabe7c419a8317bdec79ea99f7ffd44a4bcef16 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 18 Dec 2024 17:09:43 -0700 Subject: [PATCH 10/59] Small correction and TODO updates --- src/main/histFileMod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index a84afb48da..c07f266a5d 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -894,7 +894,7 @@ subroutine htapes_fieldlist() 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 @@ -4218,6 +4218,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & cycle end if + ! 13) TODO NEXT is_endhist may need file dimension ! Determine if end of history interval tape(t)%is_endhist = .false. if (tape(t)%nhtfrq==0) then !monthly average @@ -4719,7 +4720,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end do file_loop end do tape_loop - ! 12a) TODO NEXT: LHS fincl & fexcl may need the file dimension here + ! 12a) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension fincl(:,1) = hist_fincl1(:) fincl(:,2) = hist_fincl2(:) fincl(:,3) = hist_fincl3(:) @@ -4757,8 +4758,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) cycle end if - ! 12c) TODO fincl & fexcl may need the file dimension here (and elsewhere?) - ! Look into is_endhist, as well + ! 12c) TODO DONE (NOT DONE) fincl & fexcl may need the file dimension 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,f), flag='write') @@ -4905,7 +4905,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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) - ! 12d) TODO fincl & fexcl may need the file dimension here (and elsewhere?) + ! 12d) TODO DONE (NOT DONE) fincl & fexcl may need the file dimension 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') @@ -5052,7 +5052,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end do file_loop end do tape_loop - ! 12b) TODO LHS fincl & fexcl may need the file dimension here + ! 12b) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension hist_fincl1(:) = fincl(:,1) hist_fincl2(:) = fincl(:,2) hist_fincl3(:) = fincl(:,3) From e574acb82278455c2e10459acfad39a51185b672 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 19 Dec 2024 16:02:53 -0700 Subject: [PATCH 11/59] Small correction and some clean-up --- src/main/histFileMod.F90 | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index c07f266a5d..d754237487 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -412,7 +412,6 @@ subroutine hist_printflds() ! the CTSM's web-based documentation. ! First sort the list to be in alphabetical order - ! TODO Is t = 1 argument needed? call sort_hist_list(1, nallhistflds, allhistfldlist) if (masterproc .and. hist_fields_list_file) then @@ -963,7 +962,6 @@ subroutine htapes_fieldlist() ! Specification of tape contents now complete. ! Sort each list of active entries - ! TODO Is t argument needed? call sort_hist_list(t, tape(t)%nflds(f), tape(t)%hlist) if (masterproc) then @@ -1362,10 +1360,10 @@ subroutine hist_update_hbuf(bounds) 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, fld, num2d, numdims) + tape_loop: do t = 1, ntapes file_loop: do f = 1, maxsplitfiles - do fld = 1,tape(t)%nflds(f) +!$OMP PARALLEL DO PRIVATE (fld, num2d, numdims) + do fld = 1, tape(t)%nflds(f) numdims = tape(t)%hlist(fld)%field%numdims @@ -1376,9 +1374,9 @@ subroutine hist_update_hbuf(bounds) call hist_update_hbuf_field_2d (t, fld, bounds, num2d) end if end do - end do file_loop !$OMP END PARALLEL DO - end do + end do file_loop + end do tape_loop end subroutine hist_update_hbuf @@ -2307,18 +2305,18 @@ subroutine hfields_normalize (t, f) ! Normalize by number of accumulations for time averaged case - do fld = 1,tape(t)%nflds(f) - avgflag = tape(t)%hlist(fld)%avgflag + do fld = 1, tape(t)%nflds(f) + avgflag = tape(t)%hlist(fld)%avgflag if ( is_mapping_upto_subgrid(tape(t)%hlist(fld)%field%type1d, tape(t)%hlist(fld)%field%type1d_out) )then - beg1d = tape(t)%hlist(fld)%field%beg1d_out - end1d = tape(t)%hlist(fld)%field%end1d_out + beg1d = tape(t)%hlist(fld)%field%beg1d_out + end1d = tape(t)%hlist(fld)%field%end1d_out else - beg1d = tape(t)%hlist(fld)%field%beg1d - end1d = tape(t)%hlist(fld)%field%end1d + beg1d = tape(t)%hlist(fld)%field%beg1d + end1d = tape(t)%hlist(fld)%field%end1d end if - num2d = tape(t)%hlist(fld)%field%num2d - nacs => tape(t)%hlist(fld)%nacs - hbuf => tape(t)%hlist(fld)%hbuf + num2d = tape(t)%hlist(fld)%field%num2d + nacs => tape(t)%hlist(fld)%nacs + hbuf => tape(t)%hlist(fld)%hbuf if (avgflag == 'A' .or. avgflag(1:1) == 'L') then aflag = .true. @@ -4495,6 +4493,7 @@ 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, 'maxsplitfiles', maxsplitfiles, dimid) call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_log, & @@ -4513,7 +4512,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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", dim3name="maxsplitfiles" ) ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) From 30d790411d227caaa20d9e5947efa4cff0c1f5ab Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 27 Dec 2024 13:29:07 -0700 Subject: [PATCH 12/59] Corrections to resolve various errors in the SHAREDLIB_BUILD phase This commit does not resolve all the errors --- src/main/histFileMod.F90 | 138 +++++++++++++++++++-------------------- 1 file changed, 69 insertions(+), 69 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index d754237487..0d8fb62926 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -594,7 +594,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 @@ -840,7 +840,7 @@ subroutine htapes_fieldlist() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: - integer :: t, fld ! tape, field indices + 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 @@ -884,7 +884,7 @@ subroutine htapes_fieldlist() ! First ensure contents of fincl and fexcl are valid names - tape_loop: do t = 1, max_tapes + tape_loop1: do t = 1, max_tapes fld = 1 do while (fld < max_flds .and. fincl(fld,t) /= ' ') name = getname (fincl(fld,t)) @@ -913,11 +913,11 @@ subroutine htapes_fieldlist() end if fld = fld + 1 end do - end do tape_loop + history_tape_in_use(t,:) = .false. + tape(t)%nflds(:) = 0 + end do tape_loop1 - history_tape_in_use(:,:) = .false. - tape(:)%nflds(:) = 0 - tape_loop: 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 @@ -927,7 +927,7 @@ subroutine htapes_fieldlist() ! or if it is on by default and was not excluded via namelist (FEXCL[1-max_tapes]). ! 8) TODO DONE do f = 1, maxsplitfiles where needed; search "do t" - file_loop: do f = 1, maxsplitfiles + file_loop1: do f = 1, maxsplitfiles do fld = 1, nallhistflds allhistfldname = allhistfldlist(fld)%field%name call list_index (fincl(1,t), allhistfldname, ff) @@ -974,8 +974,8 @@ subroutine htapes_fieldlist() end do call shr_sys_flush(iulog) end if - end do file_loop - end do tape_loop + end do file_loop1 + end do tape_loop2 ! Determine index of max active history tape, and whether each tape is in use @@ -1016,7 +1016,7 @@ subroutine htapes_fieldlist() if (masterproc) then write(iulog,*) 'There will be a total of ',ntapes,' history tapes' - tape_loop: 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' @@ -1030,14 +1030,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) - file_loop: do f = 1, maxsplitfiles + file_loop2: do f = 1, maxsplitfiles 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_loop + end do file_loop2 write(iulog,*) - end do tape_loop + end do tape_loop3 call shr_sys_flush(iulog) end if @@ -3659,9 +3659,9 @@ subroutine hfields_write(t, f, 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 @@ -4203,8 +4203,8 @@ 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. - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop1: do t = 1, ntapes + file_loop1: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle @@ -4306,11 +4306,11 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call t_stopf('hist_htapes_wrapup_write') ! Zero necessary history buffers - call hfields_zero(t) + call hfields_zero(t, f) end if - end do file_loop - end do tape_loop + end do file_loop1 + end do tape_loop1 ! Determine if file needs to be closed @@ -4320,8 +4320,8 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Auxilary files may have been closed and saved off without being full, ! must reopen the files - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop2: do t = 1, ntapes + file_loop2: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4346,8 +4346,8 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & end if endif endif - end do file_loop - end do tape_loop + end do file_loop2 + end do tape_loop2 ! Reset number of time samples to zero if file is full @@ -4524,8 +4524,8 @@ 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 - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop1: do t = 1, ntapes + file_loop1: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4539,7 +4539,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add read/write accumultators and counters if needed not_endhist: if (.not. tape(t)%is_endhist) then - fld_loop: do fld = 1, tape(t)%nflds(f) + fld_loop1: do fld = 1, tape(t)%nflds(f) name = tape(t)%hlist(fld)%field%name long_name = tape(t)%hlist(fld)%field%long_name units = tape(t)%hlist(fld)%field%units @@ -4595,7 +4595,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) long_name=trim(long_name_acc), units=trim(units_acc)) end if endif - end do fld_loop + end do fld_loop1 end if not_endhist ! @@ -4690,8 +4690,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_enddef(ncid_hist(t,f)) - end do file_loop - end do tape_loop + end do file_loop1 + end do tape_loop1 RETURN @@ -4703,9 +4703,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) !================================================ ! Add history filenames to master restart file - tape_loop: do t = 1, ntapes + tape_loop2: do t = 1, ntapes ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout - file_loop: do f = 1, maxsplitfiles + file_loop2: do f = 1, maxsplitfiles call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) if (history_tape_in_use(t,f)) then my_locfnh = locfnh(t,f) @@ -4716,8 +4716,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=t) call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=t) - end do file_loop - end do tape_loop + end do file_loop2 + end do tape_loop2 ! 12a) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension fincl(:,1) = hist_fincl1(:) @@ -4751,8 +4751,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! allocate(itemp(max_nflds)) - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop3: do t = 1, ntapes + file_loop3: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4812,8 +4812,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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_loop - end do tape_loop + end do file_loop3 + end do tape_loop3 deallocate(itemp) ! @@ -4824,7 +4824,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) !================================================ call ncd_inqdlen(ncid,dimid,ntapes_onfile, name='ntapes') - is_restart: 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. '// & @@ -4843,8 +4843,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! true for all tapes <= ntapes. history_tape_in_use_onfile(:,:) = .true. end if - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop4: do t = 1, ntapes + file_loop4: do f = 1, maxsplitfiles if (history_tape_in_use_onfile(t,f) .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 @@ -4857,28 +4857,28 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 'You can NOT change history options on restart.', & additional_msg=errMsg(sourcefile, __LINE__)) end if - end do file_loop - end do tape_loop + end do file_loop4 + end do tape_loop4 ! TODO Is this correct or should next few lines (and call ncd_io ! above) be in a do f loop? call ncd_io('locfnh', locfnh(1:ntapes,1:maxsplitfiles), 'read', ncid ) call ncd_io('locfnhr', locrest(1:ntapes,1:maxsplitfiles), 'read', ncid ) - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop5: do t = 1, ntapes + file_loop5: do f = 1, maxsplitfiles call strip_null(locrest(t,f)) call strip_null(locfnh(t,f)) - end do file_loop - end do tape_loop + end do file_loop5 + end do tape_loop5 end if ntapes_gt_0 - end if is_restart + end if if_restart1 ! Determine necessary indices - the following is needed if model decomposition is different on restart start(1)=1 - is_restart: if ( is_restart() ) then - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + if_restart2: if ( is_restart() ) then + tape_loop6: do t = 1, ntapes + file_loop6: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4934,7 +4934,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape(t)%hlist(fld)%field%hpindex = itemp(fld) end do - fld_loop: do fld = 1, tape(t)%nflds(f) + fld_loop2: do fld = 1, tape(t)%nflds(f) start(2) = fld call ncd_io( name_desc, tape(t)%hlist(fld)%field%name, & 'read', ncid_hist(t,f), start ) @@ -5040,7 +5040,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape(t)%hlist(fld)%field%beg1d = beg1d tape(t)%hlist(fld)%field%end1d = end1d - end do fld_loop + end do fld_loop2 ! If history file is not full, open it @@ -5048,8 +5048,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) end if - end do file_loop - end do tape_loop + end do file_loop6 + end do tape_loop6 ! 12b) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension hist_fincl1(:) = fincl(:,1) @@ -5074,7 +5074,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) hist_fexcl9(:) = fexcl(:,9) hist_fexcl10(:) = fexcl(:,10) - end if is_restart + end if if_restart2 if ( allocated(itemp) ) deallocate(itemp) @@ -5089,15 +5089,15 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) read_write: if (flag == 'write') then - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop7: do t = 1, ntapes + file_loop7: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if if (.not. tape(t)%is_endhist) then - fld_loop: do fld = 1, tape(t)%nflds(f) + fld_loop3: do fld = 1, tape(t)%nflds(f) name = tape(t)%hlist(fld)%field%name name_acc = trim(name) // "_acc" type1d_out = tape(t)%hlist(fld)%field%type1d_out @@ -5133,28 +5133,28 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) dim1name=type1d_out, data=nacs) end if - end do fld_loop + end do fld_loop3 end if ! end of is_endhist block call ncd_pio_closefile(ncid_hist(t,f)) - end do file_loop - end do tape_loop + end do file_loop7 + end do tape_loop7 else if (flag == 'read') then ! Read history restart information if history files are not full - tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + tape_loop8: do t = 1, ntapes + file_loop8: do f = 1, maxsplitfiles if (.not. history_tape_in_use(t,f)) then cycle end if if (.not. tape(t)%is_endhist) then - fld_loop: do fld = 1, tape(t)%nflds(f) + fld_loop4: do fld = 1, tape(t)%nflds(f) name = tape(t)%hlist(fld)%field%name name_acc = trim(name) // "_acc" type1d_out = tape(t)%hlist(fld)%field%type1d_out @@ -5189,14 +5189,14 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name_acc), & dim1name=type1d_out, data=nacs) end if - end do fld_loop + end do fld_loop4 end if call ncd_pio_closefile(ncid_hist(t,f)) - end do file_loop - end do tape_loop + end do file_loop8 + end do tape_loop8 end if read_write From 63a4db6d632021d7a103d41306942c6040dcc7e2 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 27 Dec 2024 16:44:55 -0700 Subject: [PATCH 13/59] Change history_tape_in_use* from logical to integer for ncd_io to work --- src/main/histFileMod.F90 | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 0d8fb62926..8fd1fb4e8a 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -321,10 +321,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,j) is false, + ! Whether each history tape is in use in this run. If history_tape_in_use(i,j) is 0 (i.e. false), ! then data in [tape(i), file(j)] is undefined and should not be referenced. ! - logical :: history_tape_in_use(max_tapes, maxsplitfiles) ! whether each history tape is in use in this run + integer :: history_tape_in_use(max_tapes, maxsplitfiles) ! history tape is/isn't in use in this run (1 or 0) ! ! 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 @@ -913,7 +913,7 @@ subroutine htapes_fieldlist() end if fld = fld + 1 end do - history_tape_in_use(t,:) = .false. + history_tape_in_use(t,:) = 0 ! equivalent to .false. tape(t)%nflds(:) = 0 end do tape_loop1 @@ -993,7 +993,7 @@ subroutine htapes_fieldlist() do t = 1, ntapes do f = 1, maxsplitfiles if (tape(t)%nflds(f) > 0) then - history_tape_in_use(t,f) = .true. + history_tape_in_use(t,f) = 1 ! equivalent to .true. end if end do end do @@ -1031,7 +1031,7 @@ subroutine htapes_fieldlist() 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) file_loop2: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then write(iulog,*) 'History tape ', t,' and file ', f, ' has no fields,' write(iulog,*) 'so it will not be written!' end if @@ -4206,7 +4206,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape_loop1: do t = 1, ntapes file_loop1: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4322,7 +4322,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape_loop2: do t = 1, ntapes file_loop2: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4353,7 +4353,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & do t = 1, ntapes do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4440,7 +4440,7 @@ 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 + integer, allocatable :: history_tape_in_use_onfile(:,:) ! history tape is/isn't (1 or 0) 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 @@ -4496,8 +4496,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_defdim( ncid, 'maxsplitfiles', maxsplitfiles, 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", & + call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_int, & + long_name="Whether this history tape is/isn't (1 or 0) in use", & dim1name="ntapes", dim2name="maxsplitfiles") ier = PIO_inq_varid(ncid, 'history_tape_in_use', vardesc) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) @@ -4526,7 +4526,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop1: do t = 1, ntapes file_loop1: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4707,7 +4707,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout file_loop2: do f = 1, maxsplitfiles call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) - if (history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then my_locfnh = locfnh(t,f) my_locfnhr = locfnhr(t,f) else @@ -4753,7 +4753,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop3: do t = 1, ntapes file_loop3: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4841,17 +4841,17 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! BACKWARDS_COMPATIBILITY(wjs, 2018-10-06) Old restart files do not have ! 'history_tape_in_use'. However, before now, this has implicitly been ! true for all tapes <= ntapes. - history_tape_in_use_onfile(:,:) = .true. + history_tape_in_use_onfile(:,:) = 1 ! equivalent to .true. end if tape_loop4: do t = 1, ntapes file_loop4: do f = 1, maxsplitfiles - if (history_tape_in_use_onfile(t,f) .neqv. history_tape_in_use(t,f)) then + if (history_tape_in_use_onfile(t,f) /= 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(t,f) 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,*) 'but non-empty in the other. (history_tape_in_use 0 or .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.', & @@ -4879,7 +4879,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if_restart2: if ( is_restart() ) then tape_loop6: do t = 1, ntapes file_loop6: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if @@ -5091,7 +5091,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop7: do t = 1, ntapes file_loop7: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if @@ -5148,7 +5148,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop8: do t = 1, ntapes file_loop8: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if From 6f56d01245da917e3ec7624dbba2112066321d55 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 3 Jan 2025 11:47:29 -0700 Subject: [PATCH 14/59] Add the 'file' dimension to ntimes; test passes but output is not good --- src/main/histFileMod.F90 | 58 +++++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 8fd1fb4e8a..53921cbd91 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -290,7 +290,7 @@ end subroutine copy_entry_interface ! the code but contains 'h0' in its output filenames (see set_hist_filename method). type history_tape integer :: nflds(maxsplitfiles) ! number of active fields on file - integer :: ntimes ! current number of time samples on tape + integer :: ntimes(maxsplitfiles) ! current number of time samples on tape integer :: mfilt ! maximum number of time samples per tape integer :: nhtfrq ! number of time samples per tape integer :: ncprec ! netcdf output precision @@ -715,7 +715,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) @@ -3179,7 +3179,7 @@ subroutine htape_timeconst(t, f, 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', & @@ -3394,7 +3394,7 @@ subroutine htape_timeconst(t, f, 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 @@ -3495,26 +3495,26 @@ subroutine htape_timeconst(t, f, mode) mcdate = yr*10000 + mon*100 + day nstep = get_nstep() - call ncd_io('mcdate', mcdate, 'write', nfid(t,f), nt=tape(t)%ntimes) - call ncd_io('mcsec' , mcsec , 'write', nfid(t,f), nt=tape(t)%ntimes) - call ncd_io('mdcur' , mdcur , 'write', nfid(t,f), nt=tape(t)%ntimes) - call ncd_io('mscur' , mscur , 'write', nfid(t,f), nt=tape(t)%ntimes) - call ncd_io('nstep' , nstep , 'write', nfid(t,f), 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 (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape time = (timedata(1) + timedata(2)) * 0.5_r8 - call ncd_io('time_bounds', timedata, 'write', nfid(t,f), nt=tape(t)%ntimes) + call ncd_io('time_bounds', timedata, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) else time = timedata(2) end if - call ncd_io('time' , time , 'write', nfid(t,f), 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,f), 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,f), nt=tape(t)%ntimes) + call ncd_io('time_written', ctime, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) endif @@ -3522,7 +3522,7 @@ subroutine htape_timeconst(t, f, 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', & @@ -3591,7 +3591,7 @@ subroutine htape_timeconst(t, f, mode) 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 @@ -3686,7 +3686,7 @@ subroutine hfields_write(t, f, mode) numdims = tape(t)%hlist(fld)%field%numdims num2d = tape(t)%hlist(fld)%field%num2d l2g_scale_type = tape(t)%hlist(fld)%field%l2g_scale_type - nt = tape(t)%ntimes + nt = tape(t)%ntimes(f) if (mode == 'define') then @@ -4235,7 +4235,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Increment current time sample counter. - tape(t)%ntimes = tape(t)%ntimes + 1 + tape(t)%ntimes(f) = tape(t)%ntimes(f) + 1 ! Create history file if appropriate and build time comment @@ -4243,7 +4243,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! define dims, vars, etc. - if (tape(t)%ntimes == 1) then + if (tape(t)%ntimes(f) == 1) then call t_startf('hist_htapes_wrapup_define') ! 2) TODO DONE Changed locfnh(t) to locfnh(t,f) throughout locfnh(t,f) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & @@ -4279,7 +4279,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call htape_timeconst(t, f, mode='write') ! Write 3D time constant history variables to first history tapes - if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then + 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') @@ -4314,7 +4314,9 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! 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, maxsplitfiles + call hist_do_disp (ntapes, tape(:)%ntimes(f), tape(:)%mfilt, if_stop, if_disphist, rstwr, nlend) + end do file_loop1b ! Close open history file ! Auxilary files may have been closed and saved off without being full, @@ -4327,7 +4329,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & end if if (if_disphist(t)) then - if (tape(t)%ntimes /= 0) then + if (tape(t)%ntimes(f) /= 0) then if (masterproc) then write(iulog,*) write(iulog,*) trim(subname),' : Closing local history file ',& @@ -4337,7 +4339,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call ncd_pio_closefile(nfid(t,f)) - if (.not.if_stop .and. (tape(t)%ntimes/=tape(t)%mfilt)) then + 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 @@ -4357,8 +4359,8 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & cycle end if - if (if_disphist(t) .and. tape(t)%ntimes==tape(t)%mfilt) then - tape(t)%ntimes = 0 + if (if_disphist(t) .and. tape(t)%ntimes(f)==tape(t)%mfilt) then + tape(t)%ntimes(f) = 0 end if end do end do @@ -4464,7 +4466,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(f) = 0 end do return end if @@ -4779,7 +4781,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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, '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) ) @@ -4916,7 +4918,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ' you can NOT change history options on restart!' //& errMsg(sourcefile, __LINE__)) end if - call ncd_io('ntimes', tape(t)%ntimes, 'read', ncid_hist(t,f) ) + 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) ) @@ -5044,7 +5046,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! If history file is not full, open it - if (tape(t)%ntimes /= 0) then + if (tape(t)%ntimes(f) /= 0) then call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) end if From ebf652e0d0ceb6e3ff906e3ec85402edfe9424d1 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 3 Jan 2025 14:01:01 -0700 Subject: [PATCH 15/59] Change hist file labels from h01, h02 to h0i, h0a --- src/main/histFileMod.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 53921cbd91..01c0aaffd9 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -49,7 +49,9 @@ module histFileMod integer , public, 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 :: maxsplitfiles = 2 ! max number of files per tape (instantaneous_file_index = 1, accumulated_file_index = 2) + integer , private, parameter :: maxsplitfiles = 2 ! max number of files per tape + integer , private, parameter :: instantaneous_file_index = 1 + integer , private, parameter :: accumulated_file_index = 2 ! 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 @@ -5358,7 +5360,11 @@ 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 - write(file_index,'(i1.1)') f_index ! instantaneous or accumulated_file_index + 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 ! 1) TODO DONE After hist_index added file_index = "i" or "a" ! See maxsplitfiles in https://github.com/ESCOMP/CAM/pull/903/files ! See CAM#1003 for a bug-fix in monthly avged output From d9fdab0d879c25c7fc0b35339fa4fd160004769f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 3 Jan 2025 14:06:57 -0700 Subject: [PATCH 16/59] Change "if instantaneous" statemt with more appropriate conditional Matches commit eeedbc6ae95373cbd1f27359f54de7693409326d in #2838 --- src/main/histFileMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 01c0aaffd9..58fa969e60 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -3409,7 +3409,7 @@ subroutine htape_timeconst(t, f, mode) dim1id(1) = time_dimid str = 'days since ' // basedate // " " // basesec - if (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape + if (hist_avgflag_pertape(t) /= 'I') then ! NOT instantaneous fields tape step_or_bounds = 'time_bounds' long_name = 'time at exact middle of ' // step_or_bounds call ncd_defvar(nfid(t,f), 'time', tape(t)%ncprec, 1, dim1id, varid, & @@ -3472,7 +3472,7 @@ subroutine htape_timeconst(t, f, mode) long_name = 'time step') dim2id(1) = hist_interval_dimid; dim2id(2) = time_dimid - if (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape + if (hist_avgflag_pertape(t) /= 'I') then ! NOT instantaneous fields tape call ncd_defvar(nfid(t,f), 'time_bounds', ncd_double, 2, dim2id, varid, & long_name = 'history time interval endpoints') end if @@ -3505,7 +3505,7 @@ subroutine htape_timeconst(t, f, mode) timedata(1) = tape(t)%begtime ! beginning time timedata(2) = mdcur + mscur/secspday ! end time - if (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape + if (hist_avgflag_pertape(t) /= 'I') then ! NOT instantaneous fields tape time = (timedata(1) + timedata(2)) * 0.5_r8 call ncd_io('time_bounds', timedata, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) else From 16d1e296150ef8171f51a49161c7aaf5556e065a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 3 Jan 2025 17:29:47 -0700 Subject: [PATCH 17/59] Add "file" dimension to actflag to separate the 'I' fields --- src/main/histFileMod.F90 | 39 +++++++++++++++++++++++---------------- 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 58fa969e60..33387b34a8 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -50,8 +50,8 @@ module histFileMod 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 :: maxsplitfiles = 2 ! max number of files per tape - integer , private, parameter :: instantaneous_file_index = 1 - integer , private, parameter :: accumulated_file_index = 2 + integer , private, parameter :: accumulated_file_index = 1 + integer , private, parameter :: instantaneous_file_index = 2 ! 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 @@ -266,10 +266,8 @@ end subroutine copy_entry_interface ! These values are specified in hist_addfld* calls but then can be ! overridden by namelist params like hist_fincl1. type, extends(entry_base) :: allhistfldlist_entry - ! 10) TODO DONE Add 2nd dim to avgflag and actflag - ! UNDONE because both are also dimensioned by fld which (at least - ! for now) is unique per tape; therefore, do not specify file number - logical :: actflag(max_tapes) ! which history tapes to write to. + ! 10) TODO DONE Add 2nd dim to actflag, which should make fld unique by file + logical :: actflag(max_tapes,maxsplitfiles) ! which history tapes to write to character(len=avgflag_strlen) :: avgflag(max_tapes) ! type of time averaging contains procedure :: copy => copy_allhistfldlist_entry @@ -385,7 +383,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 @@ -426,7 +424,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 @@ -480,9 +479,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 @@ -494,14 +493,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 @@ -659,7 +658,7 @@ subroutine allhistfldlist_addfld (fname, numdims, type1d, type1d_out, & ! FLAG SET TO FALSE allhistfldlist(fld)%avgflag(:) = avgflag - allhistfldlist(fld)%actflag(:) = .false. + allhistfldlist(fld)%actflag(:,:) = .false. end subroutine allhistfldlist_addfld @@ -784,10 +783,14 @@ subroutine allhistfldlist_make_active (name, tape_index, avgflag) found = .false. do fld = 1, nallhistflds if (trim(name) == trim(allhistfldlist(fld)%field%name)) then - allhistfldlist(fld)%actflag(tape_index) = .true. if (present(avgflag)) then 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 end if @@ -940,7 +943,11 @@ subroutine htapes_fieldlist() ! will be called for field avgflag = getflag (fincl(ff,t)) - call htape_addfld (t, f, fld, avgflag) + 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) + end if else if (.not. hist_empty_htapes) then @@ -955,7 +962,7 @@ subroutine htapes_fieldlist() ! called below only if field is not in exclude list OR in ! include list - if (ff == 0 .and. allhistfldlist(fld)%actflag(t)) then + if (ff == 0 .and. allhistfldlist(fld)%actflag(t,f)) then call htape_addfld (t, f, fld, ' ') end if From f1b0685558f829d0852f7f6001245a344e9d46b6 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 3 Jan 2025 18:24:37 -0700 Subject: [PATCH 18/59] Correct time-related fields that appear on instantaneous file --- src/main/histFileMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 33387b34a8..c53c4b2d80 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -3416,13 +3416,13 @@ subroutine htape_timeconst(t, f, 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,f), 'time', tape(t)%ncprec, 1, dim1id, varid, & long_name=long_name, units=str) call ncd_putatt(nfid(t,f), varid, 'bounds', 'time_bounds') - else ! instantaneous fields tape + else ! instantaneous file step_or_bounds = 'time step' long_name = 'time at end of ' // step_or_bounds call ncd_defvar(nfid(t,f), 'time', tape(t)%ncprec, 1, dim1id, varid, & @@ -3479,7 +3479,7 @@ subroutine htape_timeconst(t, f, mode) long_name = 'time step') dim2id(1) = hist_interval_dimid; dim2id(2) = time_dimid - if (hist_avgflag_pertape(t) /= 'I') then ! NOT instantaneous fields tape + if (f == accumulated_file_index) then call ncd_defvar(nfid(t,f), 'time_bounds', ncd_double, 2, dim2id, varid, & long_name = 'history time interval endpoints') end if @@ -3512,10 +3512,10 @@ subroutine htape_timeconst(t, f, mode) 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,f), nt=tape(t)%ntimes(f)) - else + else ! instantaneous file time = timedata(2) end if call ncd_io('time' , time , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) From a037b2aa1d75a11e99b56e52de48e7d6778b8f20 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 10 Feb 2025 17:45:47 -0700 Subject: [PATCH 19/59] Fix conflict that slipped through --- src/main/histFileMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 4cfa72ba2c..589362786a 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4236,7 +4236,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Normalize history buffer if time averaged - call hfields_normalize(t,f) + call hfields_normalize(t, f) ! Increment current time sample counter. @@ -4258,7 +4258,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ' at nstep = ',get_nstep() write(iulog,*)'calling htape_create for tape t and file f = ', t, f endif - call htape_create (t,f) + call htape_create (t, f) ! Define time-constant field variables call htape_timeconst(t, f, mode='define') @@ -4289,6 +4289,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & cellsand_col, cellclay_col, mode='write') do_3Dtconst = .false. + end if if (masterproc) then write(iulog,*) From be8682e5a546eb86a7aac9917919f909d574725e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 6 May 2025 16:56:02 -0600 Subject: [PATCH 20/59] Corrections with imperfect results explained 2025/5/6 in #2445 --- src/main/histFileMod.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 589362786a..d8e11283f9 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -995,6 +995,7 @@ subroutine htapes_fieldlist() exit end if end do + if (ntapes > 0) exit end do ! 9) TODO DONE Change nflds to nflds(f) throughout @@ -3436,7 +3437,7 @@ subroutine htape_timeconst(t, f, mode) long_name = 'current date (YYYYMMDD) at end of ' // step_or_bounds 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 ! @@ -3466,15 +3467,15 @@ subroutine htape_timeconst(t, f, mode) long_name = 'current seconds of current date at end of ' // step_or_bounds 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,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,f) , 'mscur' , 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) call ncd_defvar(nfid(t,f) , 'nstep' , ncd_int, 1, dim1id , varid, & long_name = 'time step') @@ -3483,7 +3484,7 @@ subroutine htape_timeconst(t, f, mode) 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 @@ -4217,7 +4218,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape_loop1: do t = 1, ntapes file_loop1: do f = 1, maxsplitfiles - if (.not. history_tape_in_use(t,f)) then + if (history_tape_in_use(t,f) == 0) then cycle end if From 2daf3e4d1e06e4b5164c58af760f6c27071a92d8 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 7 May 2025 18:03:42 -0600 Subject: [PATCH 21/59] Corrections fixing issue (2) posted on 2025/5/6 in #2445 --- src/main/histFileMod.F90 | 324 ++++++++++++++++++++------------------- 1 file changed, 164 insertions(+), 160 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index d8e11283f9..3129924320 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -296,7 +296,8 @@ end subroutine copy_entry_interface 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. + ! 13) DONE slevis: change hlist to (max_flds,maxsplitfiles) + type (history_entry) :: hlist(max_flds, maxsplitfiles) ! array of active history tape entries. ! The ordering matches the allhistfldlist's. end type history_tape @@ -970,15 +971,15 @@ subroutine htapes_fieldlist() ! Specification of tape contents now complete. ! Sort each list of active entries - call sort_hist_list(t, tape(t)%nflds(f), tape(t)%hlist) + call sort_hist_list(t, tape(t)%nflds(f), tape(t)%hlist(:,f)) 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)%field%name, & - tape(t)%hlist(fld)%field%num2d, ' ', tape(t)%hlist(fld)%avgflag + 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 @@ -1220,7 +1221,8 @@ subroutine htape_addfld (t, f, fld, avgflag) ! Copy field information - tape(t)%hlist(n)%field = allhistfldlist(fld)%field + tape(t)%hlist(n,f)%field = allhistfldlist(fld)%field + write(iulog,*) 'field, t, f, n, fld', tape(t)%hlist(n,f)%field, t, f, n ! Determine bounds @@ -1235,16 +1237,16 @@ subroutine htape_addfld (t, f, fld, 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 @@ -1252,17 +1254,17 @@ subroutine htape_addfld (t, f, fld, 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__)) @@ -1272,7 +1274,7 @@ subroutine htape_addfld (t, f, fld, 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 @@ -1299,9 +1301,9 @@ subroutine htape_addfld (t, f, fld, 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(fld)%field%beg1d @@ -1309,16 +1311,16 @@ subroutine htape_addfld (t, f, fld, avgflag) ! 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 @@ -1329,9 +1331,9 @@ subroutine htape_addfld (t, f, fld, avgflag) end if if (avgflag == ' ') then - tape(t)%hlist(n)%avgflag = allhistfldlist(fld)%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 @@ -1344,7 +1346,7 @@ subroutine htape_addfld (t, f, fld, 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 @@ -1374,13 +1376,13 @@ subroutine hist_update_hbuf(bounds) !$OMP PARALLEL DO PRIVATE (fld, num2d, numdims) do fld = 1, tape(t)%nflds(f) - numdims = tape(t)%hlist(fld)%field%numdims + numdims = tape(t)%hlist(fld,f)%field%numdims if ( numdims == 1) then - call hist_update_hbuf_field_1d (t, fld, bounds) + call hist_update_hbuf_field_1d (t, f, fld, bounds) else - num2d = tape(t)%hlist(fld)%field%num2d - call hist_update_hbuf_field_2d (t, fld, bounds, num2d) + 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 @@ -1390,7 +1392,7 @@ subroutine hist_update_hbuf(bounds) end subroutine hist_update_hbuf !----------------------------------------------------------------------- - subroutine hist_update_hbuf_field_1d (t, fld, bounds) + subroutine hist_update_hbuf_field_1d (t, f, fld, bounds) ! ! !DESCRIPTION: ! Accumulate (or take min, max, etc. as appropriate) input field @@ -1407,6 +1409,7 @@ subroutine hist_update_hbuf_field_1d (t, fld, bounds) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index integer, intent(in) :: fld ! field index type(bounds_type), intent(in) :: bounds ! @@ -1447,19 +1450,19 @@ subroutine hist_update_hbuf_field_1d (t, fld, bounds) SHR_ASSERT_FL(bounds%level == bounds_level_proc, sourcefile, __LINE__) - avgflag = tape(t)%hlist(fld)%avgflag - nacs => tape(t)%hlist(fld)%nacs - hbuf => tape(t)%hlist(fld)%hbuf - beg1d = tape(t)%hlist(fld)%field%beg1d - end1d = tape(t)%hlist(fld)%field%end1d - beg1d_out = tape(t)%hlist(fld)%field%beg1d_out - end1d_out = tape(t)%hlist(fld)%field%end1d_out - type1d = tape(t)%hlist(fld)%field%type1d - type1d_out = tape(t)%hlist(fld)%field%type1d_out - p2c_scale_type = tape(t)%hlist(fld)%field%p2c_scale_type - c2l_scale_type = tape(t)%hlist(fld)%field%c2l_scale_type - l2g_scale_type = tape(t)%hlist(fld)%field%l2g_scale_type - hpindex = tape(t)%hlist(fld)%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) @@ -1753,7 +1756,7 @@ subroutine hist_update_hbuf_field_1d (t, fld, bounds) end subroutine hist_update_hbuf_field_1d !----------------------------------------------------------------------- - subroutine hist_update_hbuf_field_2d (t, fld, bounds, num2d) + subroutine hist_update_hbuf_field_2d (t, f, fld, bounds, num2d) ! ! !DESCRIPTION: ! Accumulate (or take min, max, etc. as appropriate) input field @@ -1771,6 +1774,7 @@ subroutine hist_update_hbuf_field_2d (t, fld, bounds, num2d) ! ! !ARGUMENTS: integer, intent(in) :: t ! tape 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 @@ -1814,20 +1818,20 @@ subroutine hist_update_hbuf_field_2d (t, fld, bounds, num2d) SHR_ASSERT_FL(bounds%level == bounds_level_proc, sourcefile, __LINE__) - avgflag = tape(t)%hlist(fld)%avgflag - nacs => tape(t)%hlist(fld)%nacs - hbuf => tape(t)%hlist(fld)%hbuf - beg1d = tape(t)%hlist(fld)%field%beg1d - end1d = tape(t)%hlist(fld)%field%end1d - beg1d_out = tape(t)%hlist(fld)%field%beg1d_out - end1d_out = tape(t)%hlist(fld)%field%end1d_out - type1d = tape(t)%hlist(fld)%field%type1d - type1d_out = tape(t)%hlist(fld)%field%type1d_out - p2c_scale_type = tape(t)%hlist(fld)%field%p2c_scale_type - c2l_scale_type = tape(t)%hlist(fld)%field%c2l_scale_type - l2g_scale_type = tape(t)%hlist(fld)%field%l2g_scale_type - no_snow_behavior = tape(t)%hlist(fld)%field%no_snow_behavior - hpindex = tape(t)%hlist(fld)%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) @@ -2315,17 +2319,17 @@ subroutine hfields_normalize (t, f) ! Normalize by number of accumulations for time averaged case do fld = 1, tape(t)%nflds(f) - avgflag = tape(t)%hlist(fld)%avgflag - if ( is_mapping_upto_subgrid(tape(t)%hlist(fld)%field%type1d, tape(t)%hlist(fld)%field%type1d_out) )then - beg1d = tape(t)%hlist(fld)%field%beg1d_out - end1d = tape(t)%hlist(fld)%field%end1d_out + 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(fld)%field%beg1d - end1d = tape(t)%hlist(fld)%field%end1d + beg1d = tape(t)%hlist(fld,f)%field%beg1d + end1d = tape(t)%hlist(fld,f)%field%end1d end if - num2d = tape(t)%hlist(fld)%field%num2d - nacs => tape(t)%hlist(fld)%nacs - hbuf => tape(t)%hlist(fld)%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. @@ -2363,8 +2367,8 @@ subroutine hfields_zero (t, f) !----------------------------------------------------------------------- do fld = 1,tape(t)%nflds(f) - tape(t)%hlist(fld)%hbuf(:,:) = 0._r8 - tape(t)%hlist(fld)%nacs(:,:) = 0 + tape(t)%hlist(fld,f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(fld,f)%nacs(:,:) = 0 end do end subroutine hfields_zero @@ -3683,21 +3687,21 @@ subroutine hfields_write(t, f, mode) ! Set history field variables - varname = tape(t)%hlist(fld)%field%name - long_name = tape(t)%hlist(fld)%field%long_name - units = tape(t)%hlist(fld)%field%units - avgflag = tape(t)%hlist(fld)%avgflag - type1d = tape(t)%hlist(fld)%field%type1d - type1d_out = tape(t)%hlist(fld)%field%type1d_out - beg1d = tape(t)%hlist(fld)%field%beg1d - end1d = tape(t)%hlist(fld)%field%end1d - beg1d_out = tape(t)%hlist(fld)%field%beg1d_out - end1d_out = tape(t)%hlist(fld)%field%end1d_out - num1d_out = tape(t)%hlist(fld)%field%num1d_out - type2d = tape(t)%hlist(fld)%field%type2d - numdims = tape(t)%hlist(fld)%field%numdims - num2d = tape(t)%hlist(fld)%field%num2d - l2g_scale_type = tape(t)%hlist(fld)%field%l2g_scale_type + 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 @@ -3768,7 +3772,7 @@ subroutine hfields_write(t, f, mode) ! Determine output buffer - histo => tape(t)%hlist(fld)%hbuf + histo => tape(t)%hlist(fld,f)%hbuf ! Allocate dynamic memory @@ -4222,7 +4226,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & cycle end if - ! 13) TODO NEXT is_endhist may need file dimension + ! 14) TODO NEXT is_endhist may need file dimension ! Determine if end of history interval tape(t)%is_endhist = .false. if (tape(t)%nhtfrq==0) then !monthly average @@ -4548,17 +4552,17 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! 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)%field%name - long_name = tape(t)%hlist(fld)%field%long_name - units = tape(t)%hlist(fld)%field%units + 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)%field%type1d_out - type2d = tape(t)%hlist(fld)%field%type2d - num2d = tape(t)%hlist(fld)%field%num2d - nacs => tape(t)%hlist(fld)%nacs - hbuf => tape(t)%hlist(fld)%hbuf + 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 @@ -4776,13 +4780,13 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) itemp(:) = 0 do fld = 1, tape(t)%nflds(f) - itemp(fld) = tape(t)%hlist(fld)%field%num2d + 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 fld = 1, tape(t)%nflds(f) - itemp(fld) = tape(t)%hlist(fld)%field%hpindex + 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') @@ -4797,16 +4801,16 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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)%field%name - tunits(fld) = tape(t)%hlist(fld)%field%units - tlongname(fld) = tape(t)%hlist(fld)%field%long_name - tmpstr(fld,1) = tape(t)%hlist(fld)%field%type1d - tmpstr(fld,2) = tape(t)%hlist(fld)%field%type1d_out - tmpstr(fld,3) = tape(t)%hlist(fld)%field%type2d - tavgflag(fld) = tape(t)%hlist(fld)%avgflag - p2c_scale_type(fld) = tape(t)%hlist(fld)%field%p2c_scale_type - c2l_scale_type(fld) = tape(t)%hlist(fld)%field%c2l_scale_type - l2g_scale_type(fld) = tape(t)%hlist(fld)%field%l2g_scale_type + 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)) @@ -4934,48 +4938,48 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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)%field%num2d = itemp(fld) + 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)%field%hpindex = itemp(fld) + 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)%field%name, & + 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)%field%long_name, & + 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)%field%units, & + 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)%field%type1d, & + 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)%field%type1d_out, & + 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)%field%type2d, & + 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)%avgflag, & + 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)%field%p2c_scale_type, & + 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)%field%c2l_scale_type, & + 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)%field%l2g_scale_type, & + 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)%field%name) - call strip_null(tape(t)%hlist(fld)%field%long_name) - call strip_null(tape(t)%hlist(fld)%field%units) - call strip_null(tape(t)%hlist(fld)%field%type1d) - call strip_null(tape(t)%hlist(fld)%field%type1d_out) - call strip_null(tape(t)%hlist(fld)%field%type2d) - call strip_null(tape(t)%hlist(fld)%field%p2c_scale_type) - call strip_null(tape(t)%hlist(fld)%field%c2l_scale_type) - call strip_null(tape(t)%hlist(fld)%field%l2g_scale_type) - call strip_null(tape(t)%hlist(fld)%avgflag) - - type1d_out = trim(tape(t)%hlist(fld)%field%type1d_out) + 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 @@ -5002,22 +5006,22 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - tape(t)%hlist(fld)%field%num1d_out = num1d_out - tape(t)%hlist(fld)%field%beg1d_out = beg1d_out - tape(t)%hlist(fld)%field%end1d_out = end1d_out + 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 - num2d = tape(t)%hlist(fld)%field%num2d - allocate (tape(t)%hlist(fld)%hbuf(beg1d_out:end1d_out,num2d), & - tape(t)%hlist(fld)%nacs(beg1d_out:end1d_out,num2d), & + 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=',t,f call endrun(msg=errMsg(sourcefile, __LINE__)) endif - tape(t)%hlist(fld)%hbuf(:,:) = 0._r8 - tape(t)%hlist(fld)%nacs(:,:) = 0 + tape(t)%hlist(fld,f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(fld,f)%nacs(:,:) = 0 - type1d = tape(t)%hlist(fld)%field%type1d + type1d = tape(t)%hlist(fld,f)%field%type1d select case (type1d) case (grlnd) num1d = numg @@ -5044,9 +5048,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - tape(t)%hlist(fld)%field%num1d = num1d - tape(t)%hlist(fld)%field%beg1d = beg1d - tape(t)%hlist(fld)%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 fld_loop2 @@ -5106,15 +5110,15 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if (.not. tape(t)%is_endhist) then fld_loop3: do fld = 1, tape(t)%nflds(f) - name = tape(t)%hlist(fld)%field%name + name = tape(t)%hlist(fld,f)%field%name name_acc = trim(name) // "_acc" - type1d_out = tape(t)%hlist(fld)%field%type1d_out - type2d = tape(t)%hlist(fld)%field%type2d - num2d = tape(t)%hlist(fld)%field%num2d - beg1d_out = tape(t)%hlist(fld)%field%beg1d_out - end1d_out = tape(t)%hlist(fld)%field%end1d_out - nacs => tape(t)%hlist(fld)%nacs - hbuf => tape(t)%hlist(fld)%hbuf + 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 if (num2d == 1) then allocate(hbuf1d(beg1d_out:end1d_out), & @@ -5163,15 +5167,15 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if (.not. tape(t)%is_endhist) then fld_loop4: do fld = 1, tape(t)%nflds(f) - name = tape(t)%hlist(fld)%field%name + name = tape(t)%hlist(fld,f)%field%name name_acc = trim(name) // "_acc" - type1d_out = tape(t)%hlist(fld)%field%type1d_out - type2d = tape(t)%hlist(fld)%field%type2d - num2d = tape(t)%hlist(fld)%field%num2d - beg1d_out = tape(t)%hlist(fld)%field%beg1d_out - end1d_out = tape(t)%hlist(fld)%field%end1d_out - nacs => tape(t)%hlist(fld)%nacs - hbuf => tape(t)%hlist(fld)%hbuf + 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 if (num2d == 1) then allocate(hbuf1d(beg1d_out:end1d_out), & From ee104f02edcfc88e347bfa53b46b2ca887da63af Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 9 May 2025 18:40:51 -0600 Subject: [PATCH 22/59] Add file dimension to if_disphist to resolve issue (1) posted 2025/5/6 --- src/main/histFileMod.F90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 3129924320..241cfc853b 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -148,7 +148,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, maxsplitfiles) ! 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 @@ -1222,7 +1222,6 @@ subroutine htape_addfld (t, f, fld, avgflag) ! Copy field information tape(t)%hlist(n,f)%field = allhistfldlist(fld)%field - write(iulog,*) 'field, t, f, n, fld', tape(t)%hlist(n,f)%field, t, f, n ! Determine bounds @@ -4252,7 +4251,6 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! If first time sample, generate unique history file name, open file, ! define dims, vars, etc. - if (tape(t)%ntimes(f) == 1) then call t_startf('hist_htapes_wrapup_define') ! 2) TODO DONE Changed locfnh(t) to locfnh(t,f) throughout @@ -4325,7 +4323,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Determine if file needs to be closed file_loop1b: do f = 1, maxsplitfiles - call hist_do_disp (ntapes, tape(:)%ntimes(f), tape(:)%mfilt, if_stop, if_disphist, rstwr, nlend) + 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 @@ -4338,7 +4336,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & cycle end if - if (if_disphist(t)) then + if (if_disphist(t,f)) then if (tape(t)%ntimes(f) /= 0) then if (masterproc) then write(iulog,*) @@ -4369,7 +4367,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & cycle end if - if (if_disphist(t) .and. tape(t)%ntimes(f)==tape(t)%mfilt) then + if (if_disphist(t,f) .and. tape(t)%ntimes(f)==tape(t)%mfilt) then tape(t)%ntimes(f) = 0 end if end do @@ -4476,7 +4474,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if (flag == 'read') then if (nsrest == nsrBranch) then do t = 1,ntapes - tape(t)%ntimes(f) = 0 + tape(t)%ntimes(:) = 0 end do return end if From 8683db1cdcaa4e9c31d0d4a4b21360808093df5b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 14 May 2025 17:57:35 -0600 Subject: [PATCH 23/59] Update needed for rh files to mirror h files with an "a" or "i" index --- src/main/histFileMod.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 241cfc853b..fd74abec7c 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4430,6 +4430,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 @@ -4542,8 +4543,13 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! 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 + end if locfnhr(t,f) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & - // ".rh" // hnum //"."// trim(rdate) //".nc" + // ".rh" // hnum // file_index //"."// trim(rdate) //".nc" call htape_create( t, f, histrest=.true. ) From 9a67b745efe6804872fcb6d50df38fd390fc505e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 15 May 2025 13:42:46 -0600 Subject: [PATCH 24/59] Resolve "invalid time averaging flag" error from corrupted call argumt --- src/main/histFileMod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index fd74abec7c..24b70501d2 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -845,6 +845,7 @@ subroutine htapes_fieldlist() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: + 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) @@ -971,7 +972,9 @@ subroutine htapes_fieldlist() ! Specification of tape contents now complete. ! Sort each list of active entries - call sort_hist_list(t, tape(t)%nflds(f), tape(t)%hlist(:,f)) + associate(tmp_hlist => tape(t)%hlist(:,f)) + call sort_hist_list(t, tape(t)%nflds(f), tmp_hlist(:)) + end associate if (masterproc) then if (tape(t)%nflds(f) > 0) then From 530d4478fe7f0b69d4dbcbe14fc77c9bf2a3258e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 15 May 2025 18:31:49 -0600 Subject: [PATCH 25/59] WIP resolving restart tests (and some clean-up) --- src/main/histFileMod.F90 | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 24b70501d2..5a9d03bf9b 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -412,7 +412,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 @@ -973,7 +973,7 @@ subroutine htapes_fieldlist() ! Specification of tape contents now complete. ! Sort each list of active entries associate(tmp_hlist => tape(t)%hlist(:,f)) - call sort_hist_list(t, tape(t)%nflds(f), tmp_hlist(:)) + call sort_hist_list(tape(t)%nflds(f), tmp_hlist(:)) end associate if (masterproc) then @@ -1100,14 +1100,13 @@ 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(:) @@ -4421,8 +4420,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) character(len=max_chars) :: fname ! full name of history file ! 11c) TODO DONE History restart files seem to mirror history files => need the second dimension I think character(len=max_chars) :: locrest(max_tapes, maxsplitfiles) ! local history restart file names - character(len=max_length_filename) :: my_locfnh ! temporary version of locfnh - character(len=max_length_filename) :: my_locfnhr ! temporary version of locfnhr character(len=max_namlen),allocatable :: tname(:) character(len=max_chars), allocatable :: tunits(:),tlongname(:) @@ -4723,19 +4720,16 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add history filenames to master restart file tape_loop2: do t = 1, ntapes + call ncd_io('history_tape_in_use', history_tape_in_use(t,:), 'write', ncid, nt=t) ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout file_loop2: do f = 1, maxsplitfiles - call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=t) if (history_tape_in_use(t,f) == 0) then - my_locfnh = locfnh(t,f) - my_locfnhr = locfnhr(t,f) - else - my_locfnh = 'non_existent_file' - my_locfnhr = 'non_existent_file' + locfnh(t,f) = 'non_existent_file' + locfnhr(t,f) = '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 file_loop2 + call ncd_io('locfnh', locfnh(t,:), 'write', ncid, nt=t) + call ncd_io('locfnhr', locfnhr(t,:), 'write', ncid, nt=t) end do tape_loop2 ! 12a) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension @@ -4905,7 +4899,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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,f),dimid,max_nflds,name='max_nflds') From 0bf015369cc3d9da76ebfe0443c007480cc9e396 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 16 May 2025 16:40:19 -0600 Subject: [PATCH 26/59] Reorder dims on two character vars to read them successfully --- src/main/histFileMod.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 5a9d03bf9b..2c0d1ba6e0 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4420,6 +4420,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) character(len=max_chars) :: fname ! full name of history file ! 11c) TODO DONE History restart files seem to mirror history files => need the second dimension I think character(len=max_chars) :: locrest(max_tapes, maxsplitfiles) ! local history restart file names + character(len=max_chars) :: locrest_onfile(maxsplitfiles, max_tapes) ! local history restart file names, dims flipped + character(len=max_chars) :: locfnh_onfile(maxsplitfiles, max_tapes) ! local history file names, dims flipped character(len=max_namlen),allocatable :: tname(:) character(len=max_chars), allocatable :: tunits(:),tlongname(:) @@ -4872,14 +4874,16 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if end do file_loop4 end do tape_loop4 - ! TODO Is this correct or should next few lines (and call ncd_io - ! above) be in a do f loop? - call ncd_io('locfnh', locfnh(1:ntapes,1:maxsplitfiles), 'read', ncid ) - call ncd_io('locfnhr', locrest(1:ntapes,1:maxsplitfiles), 'read', ncid ) + 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, maxsplitfiles - call strip_null(locrest(t,f)) - call strip_null(locfnh(t,f)) + 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 From 12472f714ef1b6c61ed2dd3ec60761f4522a3a5f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 20 May 2025 14:13:29 -0600 Subject: [PATCH 27/59] PASS ERS_D_Ld5_Mmpi-serial.1x1_mexicocityMEX.I1PtClm60SpRs.derecho_gnu.. --- src/main/histFileMod.F90 | 77 ++++++++++++++++++++++++++++------------ 1 file changed, 55 insertions(+), 22 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 2c0d1ba6e0..c06c42bf27 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4422,6 +4422,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) character(len=max_chars) :: locrest(max_tapes, maxsplitfiles) ! local history restart file names character(len=max_chars) :: locrest_onfile(maxsplitfiles, max_tapes) ! local history restart file names, dims flipped character(len=max_chars) :: locfnh_onfile(maxsplitfiles, max_tapes) ! local history file names, dims flipped + character(len=max_length_filename) :: my_locfnh ! temporary version of locfnh + character(len=max_length_filename) :: my_locfnhr ! temporary version of locfnhr character(len=max_namlen),allocatable :: tname(:) character(len=max_chars), allocatable :: tunits(:),tlongname(:) @@ -4509,25 +4511,47 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_defdim( ncid, 'maxsplitfiles', maxsplitfiles, dimid) call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) - call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_int, & - long_name="Whether this history tape is/isn't (1 or 0) in use", & - dim1name="ntapes", dim2name="maxsplitfiles") - 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", dim3name="maxsplitfiles" ) - 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", dim3name="maxsplitfiles" ) - ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) - ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) + if (ntapes == 1) then + call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_int, & + long_name="Whether this history tape is/isn't (1 or 0) in use", & + dim1name="maxsplitfiles") + 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="maxsplitfiles" ) + 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="maxsplitfiles" ) + ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) + ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) + else + call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_int, & + long_name="Whether this history tape is/isn't (1 or 0) in use", & + dim1name="ntapes", dim2name="maxsplitfiles") + 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", dim3name="maxsplitfiles" ) + 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", dim3name="maxsplitfiles" ) + ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) + ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) + end if ! max_nflds is the maximum number of fields on any tape ! max_flds is the maximum number possible number of fields @@ -4722,16 +4746,25 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add history filenames to master restart file tape_loop2: do t = 1, ntapes - call ncd_io('history_tape_in_use', history_tape_in_use(t,:), 'write', ncid, nt=t) ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout file_loop2: do f = 1, maxsplitfiles if (history_tape_in_use(t,f) == 0) 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) + if (ntapes == 1) then + call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=f) + call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=f) + call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=f) + end if end do file_loop2 - call ncd_io('locfnh', locfnh(t,:), 'write', ncid, nt=t) - call ncd_io('locfnhr', locfnhr(t,:), 'write', ncid, nt=t) + if (ntapes > 1) then + call ncd_io('locfnh', locfnh(t,:), 'write', ncid, nt=t) + call ncd_io('locfnhr', locfnhr(t,:), 'write', ncid, nt=t) + call ncd_io('history_tape_in_use', history_tape_in_use(t,:), 'write', ncid, nt=t) + end if end do tape_loop2 ! 12a) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension From f2bc68767ea764ed2088e210b20237aff9a17571 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 20 May 2025 17:28:50 -0600 Subject: [PATCH 28/59] PASS ERS_Ld396.f10_f10_mg37.I1850Clm60Bgc.derecho_intel.clm-monthly_matr --- src/main/histFileMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index c06c42bf27..cceee0ddc6 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4882,7 +4882,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ntapes_gt_0: if (ntapes > 0) then ! 4) TODO DONE Changed history_tape_in_use_onfile(t) to (t,f) throughout - allocate(history_tape_in_use_onfile(ntapes, maxsplitfiles)) + allocate(history_tape_in_use_onfile(maxsplitfiles, ntapes)) call ncd_io('history_tape_in_use', history_tape_in_use_onfile, 'read', ncid, & readvar=readvar) if (.not. readvar) then @@ -4893,10 +4893,10 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if tape_loop4: do t = 1, ntapes file_loop4: do f = 1, maxsplitfiles - if (history_tape_in_use_onfile(t,f) /= history_tape_in_use(t,f)) then + if (history_tape_in_use_onfile(f,t) /= 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(t,f) + write(iulog,*) 'On restart file: ', history_tape_in_use_onfile(f,t) 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 0 or .false.' From ab5050b418132de3d64eb8677431cdba2a14dc2c Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 21 May 2025 22:21:44 -0600 Subject: [PATCH 29/59] Resolve all aux_clm tests on derecho but one (RXCROPMATURITYSKIPGEN) --- cime_config/config_archive.xml | 18 ++++---- src/main/histFileMod.F90 | 77 ++++++++++++---------------------- 2 files changed, 36 insertions(+), 59 deletions(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index c219a1d1ef..91a8e5f5d8 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$ @@ -15,11 +16,11 @@ rpointer.lnd rpointer.lnd_9999 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.h0a.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_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 @@ -27,7 +28,8 @@ r - rh\d? + rh\da + rh\di h\d*.*\.nc$ e locfnh @@ -39,9 +41,9 @@ 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.rh4a.1976-01-01-00000.nc + casename.ctsm.h0a.1976-01-01-00000.nc + casename.ctsm.h0a.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 diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index cceee0ddc6..3ffdb09389 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4411,6 +4411,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 @@ -4509,49 +4510,28 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! call ncd_defdim( ncid, 'ntapes' , ntapes , dimid) call ncd_defdim( ncid, 'maxsplitfiles', maxsplitfiles, dimid) + call ncd_defdim( ncid, 'ntapes_by_maxsplitfiles', ntapes * maxsplitfiles, dimid) call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) - if (ntapes == 1) then - call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_int, & - long_name="Whether this history tape is/isn't (1 or 0) in use", & - dim1name="maxsplitfiles") - 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="maxsplitfiles" ) - 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="maxsplitfiles" ) - ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) - ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) - else - call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_int, & - long_name="Whether this history tape is/isn't (1 or 0) in use", & - dim1name="ntapes", dim2name="maxsplitfiles") - 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", dim3name="maxsplitfiles" ) - 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", dim3name="maxsplitfiles" ) - ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) - ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) - end if + call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_int, & + long_name="Whether this history tape is/isn't (1 or 0) in use", & + dim1name="ntapes_by_maxsplitfiles") + 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_by_maxsplitfiles" ) + 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_by_maxsplitfiles" ) + ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) + ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) ! max_nflds is the maximum number of fields on any tape ! max_flds is the maximum number possible number of fields @@ -4745,26 +4725,21 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) !================================================ ! Add history filenames to master restart file + counter = 0 tape_loop2: do t = 1, ntapes ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout file_loop2: do f = 1, maxsplitfiles + counter = counter + 1 if (history_tape_in_use(t,f) == 0) 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) - if (ntapes == 1) then - call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=f) - call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=f) - call ncd_io('history_tape_in_use', history_tape_in_use(t,f), 'write', ncid, nt=f) - end if + 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 - if (ntapes > 1) then - call ncd_io('locfnh', locfnh(t,:), 'write', ncid, nt=t) - call ncd_io('locfnhr', locfnhr(t,:), 'write', ncid, nt=t) - call ncd_io('history_tape_in_use', history_tape_in_use(t,:), 'write', ncid, nt=t) - end if end do tape_loop2 ! 12a) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension From 2334bf97b1c9b38d09b6f72b0ecb4ddc8ffcba3d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 22 May 2025 09:34:48 -0600 Subject: [PATCH 30/59] PASS RXCROPMATURITYSKIPGEN_Ld1097.f10_f10_mg37.IHistClm60BgcCrop.derecho --- python/ctsm/crop_calendars/check_rxboth_run.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/crop_calendars/check_rxboth_run.py b/python/ctsm/crop_calendars/check_rxboth_run.py index 2bb0872d45..52255ffa0d 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.h1a.*.nc")) # These should be constant in a Prescribed Calendars (rxboth) run, as long as the inputs were # static. From 31887739b9d6c3aa2b4de0927427e02cfb0b52f4 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 22 May 2025 10:31:39 -0600 Subject: [PATCH 31/59] Various minor clean-up items --- src/main/histFileMod.F90 | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 3ffdb09389..ca23601691 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -46,12 +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 :: maxsplitfiles = 2 ! max number of files per tape - integer , private, parameter :: accumulated_file_index = 1 - integer , private, parameter :: instantaneous_file_index = 2 + 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 @@ -297,8 +297,7 @@ end subroutine copy_entry_interface logical :: is_endhist ! true => current time step is end of history interval real(r8) :: begtime ! time at beginning of history averaging interval ! 13) DONE slevis: change hlist to (max_flds,maxsplitfiles) - type (history_entry) :: hlist(max_flds, maxsplitfiles) ! array of active history tape entries. - ! The ordering matches the allhistfldlist's. + type (history_entry) :: hlist(max_flds, maxsplitfiles) ! array of active history tape 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) @@ -934,11 +933,11 @@ subroutine htapes_fieldlist() ! 8) TODO DONE do f = 1, maxsplitfiles where needed; search "do t" file_loop1: do f = 1, maxsplitfiles - do fld = 1, nallhistflds + 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 @@ -967,8 +966,8 @@ subroutine htapes_fieldlist() call htape_addfld (t, f, fld, ' ') end if - end if - end do + end if ff_gt_0 + end do fld_loop ! Specification of tape contents now complete. ! Sort each list of active entries From 339eae2f4e56240d3d9de73208f15c03917918a3 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 30 May 2025 11:36:14 -0600 Subject: [PATCH 32/59] Cleaning up comments --- src/main/histFileMod.F90 | 27 +-------------------------- 1 file changed, 1 insertion(+), 26 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index ca23601691..4007571cd7 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -265,7 +265,6 @@ 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 - ! 10) TODO DONE Add 2nd dim to actflag, which should make fld unique by file logical :: actflag(max_tapes,maxsplitfiles) ! which history tapes to write to character(len=avgflag_strlen) :: avgflag(max_tapes) ! type of time averaging contains @@ -340,14 +339,12 @@ end subroutine copy_entry_interface ! Other variables ! character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names - ! 11a) TODO DONE History restart files seem to mirror history files => need the second dimension I think character(len=max_length_filename) :: locfnhr(max_tapes, maxsplitfiles) ! 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, maxsplitfiles) ! file ids - ! 11b) TODO DONE History restart files seem to mirror history files => need the second dimension I think type(file_desc_t), target :: ncid_hist(max_tapes, maxsplitfiles) ! file ids for history restart files integer :: time_dimid ! time dimension id integer :: nbnd_dimid ! time bounds dimension id @@ -755,7 +752,6 @@ subroutine allhistfldlist_make_active (name, tape_index, avgflag) character(len=*), intent(in), optional :: avgflag ! time averaging flag ! ! !LOCAL VARIABLES: - ! 7a) TODO DONE Replace old f with fld; search "do f" "(f" 'f)" ... integer :: fld ! field index logical :: found ! flag indicates field found in allhistfldlist character(len=*),parameter :: subname = 'allhistfldlist_make_active' @@ -931,7 +927,6 @@ 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]). - ! 8) TODO DONE do f = 1, maxsplitfiles where needed; search "do t" file_loop1: do f = 1, maxsplitfiles fld_loop: do fld = 1, nallhistflds allhistfldname = allhistfldlist(fld)%field%name @@ -1001,7 +996,6 @@ subroutine htapes_fieldlist() if (ntapes > 0) exit end do - ! 9) TODO DONE Change nflds to nflds(f) throughout do t = 1, ntapes do f = 1, maxsplitfiles if (tape(t)%nflds(f) > 0) then @@ -2396,7 +2390,6 @@ subroutine htape_create (t, f, histrest) logical, intent(in), optional :: histrest ! if creating the history restart file ! ! !LOCAL VARIABLES: - ! 5) TODO DONE Rm old f in this subr. as unused and introduce f as file index integer :: p,c,l,n ! indices integer :: ier ! error code integer :: num2d ! size of second dimension (e.g. number of vertical levels) @@ -2707,7 +2700,6 @@ subroutine htape_add_cft_metadata(lnfid) end subroutine htape_add_cft_metadata !----------------------------------------------------------------------- - ! 7b) TODO DONE Add argument f in the call subroutine htape_timeconst3D(t, f, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, & cellsand_col, cellclay_col, mode) @@ -2830,9 +2822,8 @@ subroutine htape_timeconst3D(t, f, & end if if (tape(t)%dov2xy) then if (ldomain%isgrid2d) then - ! 6) TODO DONE Changed nfid(t) to (t,f) throughout ! TODO LATER Use ncid => nfid(t,f) here and elsewhere if possible, as done in - ! subroutine hfields_1dinfo + ! subroutine hfields_1dinfo; repeat in mosart 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, & @@ -3080,7 +3071,6 @@ subroutine htape_timeconst3D(t, f, & end subroutine htape_timeconst3D !----------------------------------------------------------------------- - ! 7c) TODO DONE Add argument f in the call subroutine htape_timeconst(t, f, mode) ! ! !DESCRIPTION: @@ -3627,7 +3617,6 @@ subroutine htape_timeconst(t, f, mode) end subroutine htape_timeconst !----------------------------------------------------------------------- - ! 7d) TODO DONE Add argument f in the call subroutine hfields_write(t, f, mode) ! ! !DESCRIPTION: @@ -3824,7 +3813,6 @@ subroutine hfields_1dinfo(t, f, mode) character(len=*), intent(in) :: mode ! 'define' or 'write' ! ! !LOCAL VARIABLES: - ! 7e) TODO DONE Rm old f in this subr. as unused and introduce f as file index integer :: k ! 1d index integer :: g,c,l,p ! indices integer :: ier ! errir status @@ -4226,7 +4214,6 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & cycle end if - ! 14) TODO NEXT is_endhist may need file dimension ! Determine if end of history interval tape(t)%is_endhist = .false. if (tape(t)%nhtfrq==0) then !monthly average @@ -4254,7 +4241,6 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & if (tape(t)%ntimes(f) == 1) then call t_startf('hist_htapes_wrapup_define') - ! 2) TODO DONE Changed locfnh(t) to locfnh(t,f) throughout 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 @@ -4418,7 +4404,6 @@ 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 - ! 11c) TODO DONE History restart files seem to mirror history files => need the second dimension I think character(len=max_chars) :: locrest(max_tapes, maxsplitfiles) ! local history restart file names character(len=max_chars) :: locrest_onfile(maxsplitfiles, max_tapes) ! local history restart file names, dims flipped character(len=max_chars) :: locfnh_onfile(maxsplitfiles, max_tapes) ! local history file names, dims flipped @@ -4726,7 +4711,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add history filenames to master restart file counter = 0 tape_loop2: do t = 1, ntapes - ! 3) TODO DONE Changed history_tape_in_use(t) to (t,f) throughout file_loop2: do f = 1, maxsplitfiles counter = counter + 1 if (history_tape_in_use(t,f) == 0) then @@ -4741,7 +4725,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end do file_loop2 end do tape_loop2 - ! 12a) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension fincl(:,1) = hist_fincl1(:) fincl(:,2) = hist_fincl2(:) fincl(:,3) = hist_fincl3(:) @@ -4779,7 +4762,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) cycle end if - ! 12c) TODO DONE (NOT DONE) fincl & fexcl may need the file dimension 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,f), flag='write') @@ -4855,7 +4837,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if ntapes_gt_0: if (ntapes > 0) then - ! 4) TODO DONE Changed history_tape_in_use_onfile(t) to (t,f) throughout allocate(history_tape_in_use_onfile(maxsplitfiles, ntapes)) call ncd_io('history_tape_in_use', history_tape_in_use_onfile, 'read', ncid, & readvar=readvar) @@ -4928,7 +4909,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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) - ! 12d) TODO DONE (NOT DONE) fincl & fexcl may need the file dimension 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') @@ -5075,7 +5055,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end do file_loop6 end do tape_loop6 - ! 12b) TODO DONE (NOT DONE) LHS fincl & fexcl may need the file dimension hist_fincl1(:) = fincl(:,1) hist_fincl2(:) = fincl(:,2) hist_fincl3(:) = fincl(:,3) @@ -5385,10 +5364,6 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, hist_m else if (f_index == accumulated_file_index) then file_index = 'a' ! accumulated file_index end if - ! 1) TODO DONE After hist_index added file_index = "i" or "a" - ! See maxsplitfiles in https://github.com/ESCOMP/CAM/pull/903/files - ! See CAM#1003 for a bug-fix in monthly avged output - ! TODO FINAL search all the vars that I modified to make sure I did not miss any of them set_hist_filename = "./"//trim(caseid)//"."//trim(compname)//trim(inst_suffix)//& ".h"//hist_index//file_index//"."//trim(cdate)//".nc" From 5ab5280474070ce93175d2ccd92e6d47b17f5608 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 26 Jun 2025 15:49:42 -0600 Subject: [PATCH 33/59] Revisions to config_archive.xml as recommended in code review --- cime_config/config_archive.xml | 29 +++++------------------------ 1 file changed, 5 insertions(+), 24 deletions(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index 91a8e5f5d8..3a8272919e 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -14,38 +14,19 @@ rpointer.lnd - rpointer.lnd_9999 + rpointer.lnd_9999.1976-01-01-00000 casename.clm2.r.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.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\da - rh\di - 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.rh4a.1976-01-01-00000.nc - casename.ctsm.h0a.1976-01-01-00000.nc - casename.ctsm.h0a.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 From efadbb8d2cf0f81d9560d80e5621e37456c7ba5a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 26 Jun 2025 15:51:16 -0600 Subject: [PATCH 34/59] Revisions to histFileMod.F90 as recommended in code review --- src/main/histFileMod.F90 | 93 +++++++++++++++++++++------------------- 1 file changed, 48 insertions(+), 45 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 4007571cd7..7773c2b241 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -49,7 +49,7 @@ module histFileMod 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 :: maxsplitfiles = 2 ! max number of files per tape + 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 @@ -82,10 +82,6 @@ module histFileMod hist_dov2xy(max_tapes) = (/.true.,(.true.,ni=2,max_tapes)/) ! namelist: true=> do grid averaging integer, public :: & hist_nhtfrq(max_tapes) = (/0, (-24, ni=2,max_tapes)/) ! namelist: history write freq(0=monthly) - ! TODO slevis: My intuition currently says that namelist hist_* variables and the User should - ! remain agnostic as to whether tapes correspond to instantaneous or non files. - ! The split will happen under the covers at runtime, and the hist_* vars should NOT - ! have a 2nd (i.e. file) dimension. character(len=avgflag_strlen), public :: & hist_avgflag_pertape(max_tapes) = (/(' ',ni=1,max_tapes)/) ! namelist: per tape averaging flag character(len=max_namlen), public :: & @@ -148,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, maxsplitfiles) ! 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 @@ -265,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,maxsplitfiles) ! 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 @@ -287,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(maxsplitfiles) ! number of active fields on file - integer :: ntimes(maxsplitfiles) ! 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, same value on all max_split_files 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 - ! 13) DONE slevis: change hlist to (max_flds,maxsplitfiles) - type (history_entry) :: hlist(max_flds, maxsplitfiles) ! array of active history tape entries listed in the same order as in allhistfldlist, but hlist contains the active subset of all the fields + 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) @@ -322,7 +317,7 @@ end subroutine copy_entry_interface ! Whether each history tape is in use in this run. If history_tape_in_use(i,j) is 0 (i.e. false), ! then data in [tape(i), file(j)] is undefined and should not be referenced. ! - integer :: history_tape_in_use(max_tapes, maxsplitfiles) ! history tape is/isn't in use in this run (1 or 0) + integer :: history_tape_in_use(max_tapes, max_split_files) ! history tape is/isn't in use in this run (1 or 0) ! ! 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 @@ -338,14 +333,14 @@ end subroutine copy_entry_interface ! ! Other variables ! - character(len=max_length_filename) :: locfnh(max_tapes, maxsplitfiles) ! local history file names - character(len=max_length_filename) :: locfnhr(max_tapes, maxsplitfiles) ! 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, maxsplitfiles) ! file ids - type(file_desc_t), target :: ncid_hist(max_tapes, maxsplitfiles) ! 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 @@ -927,7 +922,7 @@ 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]). - file_loop1: do f = 1, maxsplitfiles + 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) @@ -938,10 +933,17 @@ subroutine htapes_fieldlist() ! will be called for field avgflag = getflag (fincl(ff,t)) + ! 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 + write(iulog,*) trim(subname),' ERROR: f =', f, ' but model expected f = ', instantaneous_file_index, ' or ', accumulated_file_index + call endrun(msg=errMsg(sourcefile, __LINE__)) end if else if (.not. hist_empty_htapes) then @@ -987,7 +989,7 @@ subroutine htapes_fieldlist() ntapes = 0 do t = max_tapes,1,-1 - do f = 1, maxsplitfiles + do f = 1, max_split_files if (tape(t)%nflds(f) > 0) then ntapes = t exit @@ -997,7 +999,7 @@ subroutine htapes_fieldlist() end do do t = 1, ntapes - do f = 1, maxsplitfiles + do f = 1, max_split_files if (tape(t)%nflds(f) > 0) then history_tape_in_use(t,f) = 1 ! equivalent to .true. end if @@ -1036,7 +1038,7 @@ 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) - file_loop2: do f = 1, maxsplitfiles + file_loop2: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then write(iulog,*) 'History tape ', t,' and file ', f, ' has no fields,' write(iulog,*) 'so it will not be written!' @@ -1366,7 +1368,7 @@ subroutine hist_update_hbuf(bounds) !----------------------------------------------------------------------- tape_loop: do t = 1, ntapes - file_loop: do f = 1, maxsplitfiles + file_loop: do f = 1, max_split_files !$OMP PARALLEL DO PRIVATE (fld, num2d, numdims) do fld = 1, tape(t)%nflds(f) @@ -2822,8 +2824,6 @@ subroutine htape_timeconst3D(t, f, & end if if (tape(t)%dov2xy) then if (ldomain%isgrid2d) then - ! TODO LATER Use ncid => nfid(t,f) here and elsewhere if possible, as done in - ! subroutine hfields_1dinfo; repeat in mosart 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, & @@ -4208,7 +4208,7 @@ 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. tape_loop1: do t = 1, ntapes - file_loop1: do f = 1, maxsplitfiles + file_loop1: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle @@ -4309,7 +4309,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Determine if file needs to be closed - file_loop1b: do f = 1, maxsplitfiles + 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 @@ -4318,7 +4318,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! must reopen the files tape_loop2: do t = 1, ntapes - file_loop2: do f = 1, maxsplitfiles + file_loop2: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4349,7 +4349,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Reset number of time samples to zero if file is full do t = 1, ntapes - do f = 1, maxsplitfiles + do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4404,9 +4404,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, maxsplitfiles) ! local history restart file names - character(len=max_chars) :: locrest_onfile(maxsplitfiles, max_tapes) ! local history restart file names, dims flipped - character(len=max_chars) :: locfnh_onfile(maxsplitfiles, max_tapes) ! local history file names, dims flipped + 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) ! local history restart file names, dims flipped + character(len=max_chars) :: locfnh_onfile(max_split_files, max_tapes) ! local history file names, dims flipped character(len=max_length_filename) :: my_locfnh ! temporary version of locfnh character(len=max_length_filename) :: my_locfnhr ! temporary version of locfnhr @@ -4493,27 +4493,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, 'maxsplitfiles', maxsplitfiles, dimid) - call ncd_defdim( ncid, 'ntapes_by_maxsplitfiles', ntapes * maxsplitfiles, dimid) + call ncd_defdim( ncid, 'max_split_files', max_split_files, dimid) + call ncd_defdim( ncid, 'ntapes_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_int, & long_name="Whether this history tape is/isn't (1 or 0) in use", & - dim1name="ntapes_by_maxsplitfiles") + dim1name="ntapes_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_by_maxsplitfiles" ) + dim1name='max_chars', dim2name="ntapes_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_by_maxsplitfiles" ) + dim1name='max_chars', dim2name="ntapes_by_max_split_files" ) ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) @@ -4526,7 +4526,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! only read/write accumulators and counters if needed tape_loop1: do t = 1, ntapes - file_loop1: do f = 1, maxsplitfiles + file_loop1: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4537,6 +4537,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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 =', f, ' but model expected f = ', instantaneous_file_index, ' or ', accumulated_file_index + call endrun(msg=errMsg(sourcefile, __LINE__)) end if locfnhr(t,f) = "./" // trim(caseid) //"."// trim(compname) // trim(inst_suffix) & // ".rh" // hnum // file_index //"."// trim(rdate) //".nc" @@ -4711,7 +4714,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Add history filenames to master restart file counter = 0 tape_loop2: do t = 1, ntapes - file_loop2: do f = 1, maxsplitfiles + file_loop2: do f = 1, max_split_files counter = counter + 1 if (history_tape_in_use(t,f) == 0) then locfnh(t,f) = 'non_existent_file' @@ -4757,7 +4760,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) allocate(itemp(max_nflds)) tape_loop3: do t = 1, ntapes - file_loop3: do f = 1, maxsplitfiles + file_loop3: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle end if @@ -4837,7 +4840,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if ntapes_gt_0: if (ntapes > 0) then - allocate(history_tape_in_use_onfile(maxsplitfiles, ntapes)) + 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 @@ -4847,7 +4850,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) history_tape_in_use_onfile(:,:) = 1 ! equivalent to .true. end if tape_loop4: do t = 1, ntapes - file_loop4: do f = 1, maxsplitfiles + file_loop4: do f = 1, max_split_files if (history_tape_in_use_onfile(f,t) /= 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 @@ -4865,7 +4868,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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, maxsplitfiles + 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 @@ -4883,7 +4886,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if_restart2: if ( is_restart() ) then tape_loop6: do t = 1, ntapes - file_loop6: do f = 1, maxsplitfiles + file_loop6: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle end if @@ -5093,7 +5096,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) read_write: if (flag == 'write') then tape_loop7: do t = 1, ntapes - file_loop7: do f = 1, maxsplitfiles + file_loop7: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle end if @@ -5150,7 +5153,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! Read history restart information if history files are not full tape_loop8: do t = 1, ntapes - file_loop8: do f = 1, maxsplitfiles + file_loop8: do f = 1, max_split_files if (history_tape_in_use(t,f) == 0) then cycle end if @@ -5220,7 +5223,7 @@ integer function max_nFields() max_nFields = 0 do t = 1,ntapes - do f = 1, maxsplitfiles + do f = 1, max_split_files max_nFields = max(max_nFields, tape(t)%nflds(f)) end do end do From 712dc0da65473d41e2272f4f45436b91b36a40cb Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 26 Jun 2025 17:08:09 -0600 Subject: [PATCH 35/59] Revert new "else error check" that I now realize will not work --- src/main/histFileMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 7773c2b241..ccbd12e4e1 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -937,13 +937,13 @@ subroutine htapes_fieldlist() ! 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. + ! An "else" that error checks for f out of bounds will + ! not work because it is possible to get + ! f == a_valid_value .and. avgflag unspecified 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 - write(iulog,*) trim(subname),' ERROR: f =', f, ' but model expected f = ', instantaneous_file_index, ' or ', accumulated_file_index - call endrun(msg=errMsg(sourcefile, __LINE__)) end if else if (.not. hist_empty_htapes) then From 7a881beeb0a4ae5dbb207a76bdfbde73fa65ec3d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 26 Jun 2025 18:08:22 -0600 Subject: [PATCH 36/59] Revert history_tape_in_use to logical as per code review --- src/main/histFileMod.F90 | 46 +++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index ccbd12e4e1..b63c04b9dc 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -314,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,j) is 0 (i.e. false), + ! 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. ! - integer :: history_tape_in_use(max_tapes, max_split_files) ! history tape is/isn't in use in this run (1 or 0) + 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 @@ -909,7 +909,7 @@ subroutine htapes_fieldlist() end if fld = fld + 1 end do - history_tape_in_use(t,:) = 0 ! equivalent to .false. + history_tape_in_use(t,:) = .false. tape(t)%nflds(:) = 0 end do tape_loop1 @@ -1001,7 +1001,7 @@ subroutine htapes_fieldlist() do t = 1, ntapes do f = 1, max_split_files if (tape(t)%nflds(f) > 0) then - history_tape_in_use(t,f) = 1 ! equivalent to .true. + history_tape_in_use(t,f) = .true. end if end do end do @@ -1039,7 +1039,7 @@ subroutine htapes_fieldlist() 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) file_loop2: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + 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 @@ -4210,7 +4210,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape_loop1: do t = 1, ntapes file_loop1: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4319,7 +4319,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape_loop2: do t = 1, ntapes file_loop2: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4350,7 +4350,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & do t = 1, ntapes do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4440,7 +4440,7 @@ 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 - integer, allocatable :: history_tape_in_use_onfile(:,:) ! history tape is/isn't (1 or 0) 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 @@ -4497,8 +4497,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_defdim( ncid, 'ntapes_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_int, & - long_name="Whether this history tape is/isn't (1 or 0) in use", & + call ncd_defvar(ncid=ncid, varname='history_tape_in_use', xtype=ncd_log, & + long_name="Whether this history tape is/isn't in use", & dim1name="ntapes_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) @@ -4527,7 +4527,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop1: do t = 1, ntapes file_loop1: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4716,7 +4716,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop2: do t = 1, ntapes file_loop2: do f = 1, max_split_files counter = counter + 1 - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then locfnh(t,f) = 'non_existent_file' locfnhr(t,f) = 'non_existent_file' end if @@ -4761,7 +4761,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop3: do t = 1, ntapes file_loop3: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -4840,24 +4840,26 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if ntapes_gt_0: if (ntapes > 0) then - allocate(history_tape_in_use_onfile(max_split_files, ntapes)) + 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 ! BACKWARDS_COMPATIBILITY(wjs, 2018-10-06) Old restart files do not have ! 'history_tape_in_use'. However, before now, this has implicitly been ! true for all tapes <= ntapes. - history_tape_in_use_onfile(:,:) = 1 ! equivalent to .true. + history_tape_in_use_onfile(:) = .true. end if + counter = 0 tape_loop4: do t = 1, ntapes file_loop4: do f = 1, max_split_files - if (history_tape_in_use_onfile(f,t) /= history_tape_in_use(t,f)) then + 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(f,t) + 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 0 or .false.' + 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.', & @@ -4887,7 +4889,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if_restart2: if ( is_restart() ) then tape_loop6: do t = 1, ntapes file_loop6: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -5097,7 +5099,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop7: do t = 1, ntapes file_loop7: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if @@ -5154,7 +5156,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) tape_loop8: do t = 1, ntapes file_loop8: do f = 1, max_split_files - if (history_tape_in_use(t,f) == 0) then + if (.not. history_tape_in_use(t,f)) then cycle end if From cd38e319196be4cb80cf3956511b5b979f5403e5 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 27 Jun 2025 16:15:24 -0600 Subject: [PATCH 37/59] Increase wallclock on SMS_D_Ld733... test for successful completion Complete name of the test: SMS_D_Ld733.f10_f10_mg37.IHistClm60BgcCrop.derecho_intel.clm-cropMonthOutput--clm-RxCropCalsAdaptGGCMI --- cime_config/testdefs/testlist_clm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 1a00fb683e..b11c017ae3 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -4316,7 +4316,7 @@ - + From e96bd65173ca667279769966419f2709fd3c865f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 27 Jun 2025 16:19:36 -0600 Subject: [PATCH 38/59] Update history file extensions in generate_gdds_functions.py --- python/ctsm/crop_calendars/generate_gdds_functions.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index f80f1e55f7..50f2609b68 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, "*h1a.*.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, "*h1a.*.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 '*h1a.*.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"*h2a.{this_year-1}-01*.nc", f"*h2a.{this_year-1}-01*.nc.base"] for pat in patterns: pattern = os.path.join(indir, pat) h2_files = glob.glob(pattern) From fcbac1448d4a834643a98c45cd1ec02270683703 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 27 Jun 2025 16:21:08 -0600 Subject: [PATCH 39/59] Update history file extensions in neon_gcs_upload --- tools/site_and_regional/neon_gcs_upload | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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)) From cf4121535585940fde08385c705e2f4cd2ee6703 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 27 Jun 2025 16:22:20 -0600 Subject: [PATCH 40/59] Update history file extensions in tools/contrib files --- tools/contrib/SpinupStability_BGC_v10.ncl | 4 ++-- tools/contrib/SpinupStability_BGC_v11_SE.ncl | 4 ++-- tools/contrib/SpinupStability_SP_v9.ncl | 4 ++-- tools/contrib/run_clm_historical | 10 +++++----- 4 files changed, 11 insertions(+), 11 deletions(-) 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 From 56e7d9c386e8fa9d3a55386a72bd287fb2c38b5a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 30 Jun 2025 15:37:15 -0600 Subject: [PATCH 41/59] Minor comment update --- src/main/histFileMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index b63c04b9dc..64814d076b 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4405,8 +4405,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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, max_split_files) ! local history restart file names - character(len=max_chars) :: locrest_onfile(max_split_files, max_tapes) ! local history restart file names, dims flipped - character(len=max_chars) :: locfnh_onfile(max_split_files, max_tapes) ! local history file names, dims flipped + 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 From 74a22fb1a7bed87dbdd60816fdc11382a108fc06 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 30 Jun 2025 16:27:31 -0600 Subject: [PATCH 42/59] Improved error message to include file number --- src/main/histFileMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 64814d076b..caee5dc2c8 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -5012,7 +5012,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) 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=',t,f + 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 From c2123d4487267b9d604c86d03b16e2dc3c29b0f5 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 1 Jul 2025 13:59:44 -0600 Subject: [PATCH 43/59] Remove RXCROP*INST tests as planned in this PR --- cime_config/SystemTests/rxcropmaturityinst.py | 6 ----- .../SystemTests/rxcropmaturityskipgeninst.py | 6 ----- cime_config/config_tests.xml | 20 ----------------- cime_config/testdefs/testlist_clm.xml | 22 ------------------- 4 files changed, 54 deletions(-) delete mode 100644 cime_config/SystemTests/rxcropmaturityinst.py delete mode 100644 cime_config/SystemTests/rxcropmaturityskipgeninst.py 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_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 - - 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..a28c1be4a7 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.3.062 slevis 07/03/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 From 862412381d173e6f673a1cadc129511f14873540 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:36:06 -0600 Subject: [PATCH 45/59] Updated ChangeLog --- doc/ChangeLog | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 90cb3a6a95..fe4899c55b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -19,7 +19,7 @@ Purpose and description of changes ... rhX becomes rhXa and rhXi - The clm could and still can handle not generating history (and corresponding history restart) files when empty. The rtm and mosart could not handle not generating empty files. Instead of refactoring rtm and mosart (out of scope), I introduced one active instantaneous field in mosart and one in rtm. + 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 (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 -------------------------------------------------------------- @@ -56,10 +56,6 @@ Changes to documentation: - clm documentation - Adam Phillips' cmip documentation -Substantial timing or memory changes: -[e.g., check PFS test in the test suite and look at timings, if you -expect possible significant timing changes] - Testing summary: ---------------- From 19762165fb3c6e4050cbbe2fe52b833f1ca3bc79 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:37:26 -0600 Subject: [PATCH 46/59] Change wallclock from 00:59:00 to 01:00:00 --- cime_config/testdefs/testlist_clm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 8b87bf1fcf..1a3b2ae3f3 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -4366,7 +4366,7 @@ - + From a7fd23ca20e17a6abfc4b05d86a42bbe4adc9dd7 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:41:37 -0600 Subject: [PATCH 47/59] Bug fix where h1i file was getting inappropriately named h1a --- src/main/histFileMod.F90 | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 79bf5fc99e..226ea6a346 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -933,17 +933,30 @@ subroutine htapes_fieldlist() ! will be called for field avgflag = getflag (fincl(ff,t)) + + ! Set time averaging flag based on allhistfldlist setting or + ! override the default averaging flag with namelist setting + + 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 + + if (avgflag == ' ') then + avgflag = allhistfldlist(fld)%avgflag(t) + end if + ! 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. - ! An "else" that error checks for f out of bounds will - ! not work because it is possible to get - ! f == a_valid_value .and. avgflag unspecified 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 else if (.not. hist_empty_htapes) then From a8af67bb8d0a3b2472b3a651e24b926c12d6019d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:42:59 -0600 Subject: [PATCH 48/59] Correction for RXCROP* tests --- python/ctsm/crop_calendars/check_rxboth_run.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/crop_calendars/check_rxboth_run.py b/python/ctsm/crop_calendars/check_rxboth_run.py index 52255ffa0d..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.h1a.*.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. From 1b490f3f83a86b18d2807b44c23eaf76c7219f6e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:46:30 -0600 Subject: [PATCH 49/59] Better error messaging based on code review --- src/main/histFileMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 226ea6a346..224e2790a4 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4551,8 +4551,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) else if (f == accumulated_file_index) then file_index = 'a' ! accumulated file_index else - write(iulog,*) trim(subname),' ERROR: f =', f, ' but model expected f = ', instantaneous_file_index, ' or ', accumulated_file_index - call endrun(msg=errMsg(sourcefile, __LINE__)) + 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" From dacee353985cab86561afe60d072dabb8fe72bde Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:48:12 -0600 Subject: [PATCH 50/59] Change dim. ntapes_by_max_split_files to ntapes_multiply_by_max_split_files --- src/main/histFileMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 224e2790a4..de45d41640 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -4507,26 +4507,26 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! call ncd_defdim( ncid, 'ntapes' , ntapes , dimid) call ncd_defdim( ncid, 'max_split_files', max_split_files, dimid) - call ncd_defdim( ncid, 'ntapes_by_max_split_files', ntapes * 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/isn't in use", & - dim1name="ntapes_by_max_split_files") + 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_by_max_split_files" ) + 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_by_max_split_files" ) + 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) From 70a9d86f25c931e55242701087d3b3c8aa524fb0 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:49:54 -0600 Subject: [PATCH 51/59] Clarify a comment --- src/main/histFileMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index de45d41640..74d4185a56 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -284,7 +284,7 @@ end subroutine copy_entry_interface ! the code but contains 'h0' in its output filenames (see set_hist_filename method). type history_tape integer :: nflds(max_split_files) ! number of active fields on file - integer :: ntimes(max_split_files) ! current number of time samples on tape, same value on all max_split_files + 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 From a67416fef8d4507a5ecdd106f5dde2f5dc6ccd9b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 18:36:37 -0600 Subject: [PATCH 52/59] Update rtm1_0_86 to 87 and mosart1.1.08 to 09 --- .gitmodules | 4 ++-- components/mosart | 2 +- components/rtm | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) 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/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 From 3b70fff70c344f334b7906723b97a571dc4cc4a5 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 19:05:34 -0600 Subject: [PATCH 53/59] Correction for RXCROP* tests, part 2 --- python/ctsm/crop_calendars/generate_gdds_functions.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index 50f2609b68..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, "*h1a.*.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, "*h1a.*.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 '*h1a.*.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"*h2a.{this_year-1}-01*.nc", f"*h2a.{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) From 31fe1bdbf0b965ef941a48f117b8fa8b3e48a1c5 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Jul 2025 13:24:24 -0600 Subject: [PATCH 54/59] Add to ExpectedTestFails five ctsm_sci tests needing new finidat to PASS --- cime_config/testdefs/ExpectedTestFails.xml | 36 ++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 9d41952366..bb691b62b4 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -29,6 +29,42 @@ + + + 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 From aa67359b16b1451278546e1520824e9ab443eae9 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Jul 2025 13:26:19 -0600 Subject: [PATCH 55/59] Double wallclock on ctsm_sci test that consistently exceeded wallclock --- cime_config/testdefs/testlist_clm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 1a3b2ae3f3..351b737c92 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -4366,7 +4366,7 @@ - + From fc825e54f4876988a2099760afc181cdf41909b3 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Jul 2025 13:27:27 -0600 Subject: [PATCH 56/59] Revert h2i extensions to h2a for RXCROP tests to PASS --- python/ctsm/crop_calendars/generate_gdds_functions.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index 0489f320b7..694689380a 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -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"*h2i.{this_year-1}-01*.nc", f"*h2i.{this_year-1}-01*.nc.base"] + patterns = [f"*h2a.{this_year-1}-01*.nc", f"*h2a.{this_year-1}-01*.nc.base"] for pat in patterns: pattern = os.path.join(indir, pat) h2_files = glob.glob(pattern) From e0e509dd2a9723149067503650b6c5f403f24592 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Jul 2025 13:28:35 -0600 Subject: [PATCH 57/59] Set hist_avgflag_pertape(3) = 'I' for LREPR tests to PASS --- cime_config/testdefs/testmods_dirs/clm/crop/user_nl_clm | 1 + 1 file changed, 1 insertion(+) 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. From d7a1a0b528b70d48b7e46daa37fafaa6f298e16a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 9 Jul 2025 08:55:35 -0600 Subject: [PATCH 58/59] Revert h2a extensions to h2i for RXCROP tests to PASS --- python/ctsm/crop_calendars/generate_gdds_functions.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index 694689380a..0489f320b7 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -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"*h2a.{this_year-1}-01*.nc", f"*h2a.{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) From adac90d1ea23bc8019d2eaae90f006d903d6adc0 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 9 Jul 2025 09:57:58 -0600 Subject: [PATCH 59/59] Update ChangeLog/ChangeSum --- doc/ChangeLog | 25 +++++++++++++++---------- doc/ChangeSum | 2 +- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index fe4899c55b..ca13522df8 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,12 +1,14 @@ =============================================================== Tag name: ctsm5.3.062 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) -Date: Thu 03 Jul 2025 12:23:00 PM MDT +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 + 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 @@ -19,7 +21,7 @@ Purpose and description of changes ... 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 (out of scope), I have introduced one active instantaneous field in mosart and one in rtm to bypass the "empty file" error. + 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 -------------------------------------------------------------- @@ -92,25 +94,28 @@ Testing summary: derecho ----- OK izumi ------- OK - crop_calendars tests: (tested while in ctsm5.3.058, before updating to ctsm5.3.061) + 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, before updating to ctsm5.3.061) + ssp tests: (tested while in ctsm5.3.058 and again in ctsm5.3.061) derecho ----- OK - hillslope tests: (tested while in ctsm5.3.058, before updating to ctsm5.3.061) + hillslope tests: (tested while in ctsm5.3.058 and again in ctsm5.3.061) derecho ----- OK - fire tests: (tested while in ctsm5.3.058, before updating to ctsm5.3.061) + 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 - - 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. +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 ------------- diff --git a/doc/ChangeSum b/doc/ChangeSum index a28c1be4a7..844b216d99 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,6 +1,6 @@ Tag Who Date Summary ============================================================================================================================ - ctsm5.3.062 slevis 07/03/2025 Put inst. and non-inst. fields on separate hist files + 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