From 258792e9c2ecf34d5e7dd58b556b34330edd0884 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 28 Mar 2024 17:27:56 -0600 Subject: [PATCH 01/19] If avgflag /= 'I', time_bounds is present and time = mid of time_bounds ...and other mods that I'm preserving from closed PR #2019, such as - changes to long_names and - treating avgflag as a tape (not field) trait for 'I' and 'L' tapes --- src/main/histFileMod.F90 | 65 +++++++++++++++++++++++++++++++--------- 1 file changed, 51 insertions(+), 14 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 863bf6e987..eb3d42348f 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -1170,6 +1170,7 @@ subroutine htape_addfld (t, f, avgflag) integer :: beg1d,end1d ! beginning and ending indices for this field (assume already set) integer :: num1d_out ! history output 1d size type(bounds_type) :: bounds + character(len=avgflag_strlen) :: avgflag_temp ! local copy of hist_avgflag_pertape(t) character(len=*),parameter :: subname = 'htape_addfld' !----------------------------------------------------------------------- @@ -1300,6 +1301,19 @@ subroutine htape_addfld (t, f, avgflag) tape(t)%hlist(n)%avgflag = avgflag end if + ! Override this tape's avgflag if nhtfrq == 1 + if (tape(t)%nhtfrq == 1) then ! output is instantaneous + hist_avgflag_pertape(t) = 'I' + end if + ! Override this field's avgflag if the namelist or the previous line + ! has set this tape to + ! - instantaneous (I) or + ! - 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 + end if + end subroutine htape_addfld !----------------------------------------------------------------------- @@ -3093,6 +3107,7 @@ subroutine htape_timeconst(t, mode) integer :: mcdate ! current date integer :: yr,mon,day,nbsec ! year,month,day,seconds components of a date integer :: hours,minutes,secs ! hours,minutes,seconds of hh:mm:ss + character(len= 12) :: step_or_bounds ! string used in long_name of several time variables character(len= 10) :: basedate ! base date (yyyymmdd) character(len= 8) :: basesec ! base seconds character(len= 8) :: cdate ! system date @@ -3352,8 +3367,18 @@ subroutine htape_timeconst(t, mode) dim1id(1) = time_dimid str = 'days since ' // basedate // " " // basesec - call ncd_defvar(nfid(t), 'time', tape(t)%ncprec, 1, dim1id, varid, & - long_name='time',units=str) + 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, & + long_name=long_name, units=str) + call ncd_putatt(nfid(t), 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, & + long_name=long_name, units=str) + end if cal = get_calendar() if ( trim(cal) == NO_LEAP_C )then caldesc = "noleap" @@ -3361,11 +3386,11 @@ subroutine htape_timeconst(t, mode) caldesc = "gregorian" end if call ncd_putatt(nfid(t), varid, 'calendar', caldesc) - call ncd_putatt(nfid(t), varid, 'bounds', 'time_bounds') 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, & - long_name = 'current date (YYYYMMDD)') + long_name = long_name) ! ! add global attribute time_period_freq ! @@ -3392,18 +3417,23 @@ subroutine htape_timeconst(t, mode) call ncd_putatt(nfid(t), 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, & - long_name = 'current seconds of current date', units='s') + 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, & - long_name = 'current day (from base day)') + 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, & - long_name = 'current seconds of current day') + long_name = long_name) call ncd_defvar(nfid(t) , 'nstep' , ncd_int, 1, dim1id , varid, & long_name = 'time step') dim2id(1) = hist_interval_dimid; dim2id(2) = time_dimid - call ncd_defvar(nfid(t), 'time_bounds', ncd_double, 2, dim2id, varid, & - long_name = 'history time interval endpoints') + if (tape(t)%hlist(1)%avgflag /= 'I') then ! NOT instantaneous fields tape + call ncd_defvar(nfid(t), '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) @@ -3431,13 +3461,16 @@ subroutine htape_timeconst(t, mode) call ncd_io('mscur' , mscur , 'write', nfid(t), nt=tape(t)%ntimes) call ncd_io('nstep' , nstep , 'write', nfid(t), nt=tape(t)%ntimes) - time = mdcur + mscur/secspday + 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) + else + time = timedata(2) + end if call ncd_io('time' , time , 'write', nfid(t), nt=tape(t)%ntimes) - timedata(1) = tape(t)%begtime - timedata(2) = time - call ncd_io('time_bounds', timedata, 'write', nfid(t), nt=tape(t)%ntimes) - call getdatetime (cdate, ctime) call ncd_io('date_written', cdate, 'write', nfid(t), nt=tape(t)%ntimes) @@ -5254,6 +5287,10 @@ 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 set_hist_filename = "./"//trim(caseid)//"."//trim(compname)//trim(inst_suffix)//& ".h"//hist_index//"."//trim(cdate)//".nc" From 9c7df7fcd29e76da4ec1c8f0f9566b938e173575 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 1 Apr 2024 16:36:39 -0600 Subject: [PATCH 02/19] 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 03/19] 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 04/19] 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 05/19] 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 06/19] 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 07/19] 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 08/19] 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 09/19] 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 10/19] 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 11/19] 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 12/19] 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 13/19] 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 14/19] 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 15/19] 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 16/19] 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 17/19] 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 18/19] 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 19/19] 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))