From 7e12d51524b4a810e77ff1e8f470fd951cc9ad93 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 1 Jul 2025 11:45:46 -0600 Subject: [PATCH 01/11] Update file extensions in config_archive.xml --- cime_config/config_archive.xml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index a5e169c..a890245 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -2,7 +2,8 @@ r - rh\d* + rh\da + rh\di h\d*.*\.nc$ locfnh @@ -11,11 +12,14 @@ rpointer.rof - rpointer.rof_9999 + rpointer.rof_9999.1976-01-01-00000 casename.rtm.r.1976-01-01-00000.nc - casename.rtm.rh4.1976-01-01-00000.nc - casename.rtm.h0.1976-01-01-00000.nc - casename.rtm.h0.1976-01-01-00000.nc.base + casename.rtm.rh4a.1976-01-01-00000.nc + casename.rtm.rh4i.1976-01-01-00000.nc + casename.rtm.h0a.1976-01-01-00000.nc + casename.rtm.h0i.1976-01-01-00000.nc + casename.rtm.h0a.1976-01-01-00000.nc.base + casename.rtm.h0i.1976-01-01-00000.nc.base From 8bdc3a94a47982c5998bf0bb6a51f1d88f6eaeef Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 1 Jul 2025 11:47:59 -0600 Subject: [PATCH 02/11] Put inst. and non-inst. fields on separate hist files --- src/riverroute/RtmHistFile.F90 | 1250 +++++++++++++++++--------------- 1 file changed, 661 insertions(+), 589 deletions(-) diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index 84622dd..731dc68 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -6,7 +6,7 @@ module RtmHistFile ! Module containing methods to for RTM history file handling. ! ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_kind_mod , only : r8 => shr_kind_r8, CS => shr_kind_cs use shr_sys_mod , only : shr_sys_flush, shr_sys_abort use shr_log_mod , only : errMsg => shr_log_errMsg use RunoffMod , only : runoff @@ -32,7 +32,10 @@ module RtmHistFile ! integer , public, parameter :: max_tapes = 3 ! max number of history tapes integer , public, parameter :: max_flds = 1500 ! max number of history fields - integer , public, parameter :: max_namlen = 32 ! maximum number of characters for field name + integer , public, parameter :: max_namlen = CS ! maximum number of characters for field name + integer , private, parameter :: max_split_files = 2 ! max number of files per tape + integer , private, parameter :: accumulated_file_index = 1 ! non-instantaneous file identifier + integer , private, parameter :: instantaneous_file_index = 2 ! instantaneous file identifier ! ! Counters ! @@ -120,7 +123,7 @@ module RtmHistFile type master_entry type (field_info) :: field ! field information - logical :: actflag(max_tapes) ! active/inactive flag + logical :: actflag(max_tapes, max_split_files) ! active/inactive flag character(len=1) :: avgflag(max_tapes) ! time averaging flag ("X","A","M" or "I",) end type master_entry @@ -132,14 +135,14 @@ module RtmHistFile end type history_entry type history_tape - integer :: nflds ! number of active fields on tape - integer :: ntimes ! current number of time samples on tape + integer :: nflds(max_split_files) ! number of active fields on file + integer :: ntimes(max_split_files) ! current number of time samples on tape, same value on all max_split_files integer :: mfilt ! maximum number of time samples per tape integer :: nhtfrq ! number of time samples per tape integer :: ncprec ! netcdf output precision logical :: is_endhist ! true => current time step is end of history interval real(r8) :: begtime ! time at beginning of history averaging interval - type (history_entry) :: hlist(max_flds) ! array of active history tape entries + type (history_entry) :: hlist(max_flds, max_split_files) ! array of active history tape entries end type history_tape type rtmpoint ! Pointer to real scalar data (1D) @@ -168,14 +171,14 @@ module RtmHistFile ! ! Other variables ! - character(len=max_length_filename) :: locfnh(max_tapes) ! local history file names - character(len=max_chars) :: locfnhr(max_tapes) ! local history restart file names + character(len=max_length_filename) :: locfnh(max_tapes, max_split_files) ! local history file names + character(len=max_chars) :: locfnhr(max_tapes, max_split_files) ! local history restart file names logical :: htapes_defined = .false. ! flag indicates history contents have been defined ! ! NetCDF Id's ! - type(file_desc_t), target :: nfid(max_tapes) ! file ids - type(file_desc_t), target :: ncid_hist(max_tapes) ! file ids for history restart files + type(file_desc_t), target :: nfid(max_tapes, max_split_files) ! file ids + type(file_desc_t), target :: ncid_hist(max_tapes, max_split_files) ! file ids for history restart files integer :: time_dimid ! time dimension id integer :: nbnd_dimid ! time bounds dimension id integer :: strlen_dimid ! string dimension id @@ -197,12 +200,14 @@ subroutine RtmHistFileFinalize() ! !LOCAL VARIABLES: - integer :: t,f ! indices + integer :: t,f,fld ! indices do t = 1,ntapes - do f = 1,tape(t)%nflds - deallocate (tape(t)%hlist(f)%hbuf) - deallocate (tape(t)%hlist(f)%nacs) + do f = 1, max_split_files + do fld = 1, tape(t)%nflds(f) + deallocate (tape(t)%hlist(fld,f)%hbuf) + deallocate (tape(t)%hlist(fld,f)%nacs) + end do end do end do @@ -300,7 +305,7 @@ subroutine RtmHistHtapesBuild () ! 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)%nhtfrq = rtmhist_nhtfrq(t) tape(t)%mfilt = rtmhist_mfilt(t) if (rtmhist_ndens(t) == 1) then @@ -339,7 +344,7 @@ subroutine htapes_fieldlist() implicit none ! ! !LOCAL VARIABLES: - integer :: t, f ! 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) :: mastername ! name from masterlist field @@ -351,39 +356,37 @@ 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)) !namelist + tape_loop1: do t = 1, max_tapes + fld = 1 + do while (fld < max_flds .and. fincl(fld,t) /= ' ') + name = getname (fincl(fld,t)) !namelist do ff = 1,nfmaster mastername = masterlist(ff)%field%name if (name == mastername) exit end do if (name /= mastername) 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 shr_sys_abort() 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,nfmaster mastername = masterlist(ff)%field%name - if (fexcl(f,t) == mastername) exit + if (fexcl(fld,t) == mastername) exit end do - if (fexcl(f,t) /= mastername) then - write(iulog,*) trim(subname),' ERROR: ', fexcl(f,t), ' in fexcl(', f, ') ', & + if (fexcl(fld,t) /= mastername) then + write(iulog,*) trim(subname),' ERROR: ', fexcl(fld,t), ' in fexcl(', fld, ') ', & 'for history tape ',t,' not found' call shr_sys_abort() end if - f = f + 1 + fld = fld + 1 end do - end do - - tape(:)%nflds = 0 - do t = 1,max_tapes + tape(t)%nflds(:) = 0 + end do tape_loop1 ! Loop through the masterlist set of field names and determine if any of those ! are in the FINCL or FEXCL arrays @@ -392,78 +395,86 @@ 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,nfmaster - mastername = masterlist(f)%field%name - call list_index (fincl(1,t), mastername, ff) - if (ff > 0) then - ! if field is in include list, ff > 0 and htape_addfld - ! will not be called for field - avgflag = getflag (fincl(ff,t)) - call htape_addfld (t, f, avgflag) - else - ! find index of field in exclude list - call list_index (fexcl(1,t), mastername, 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 (ff == 0 .and. masterlist(f)%actflag(t)) then - call htape_addfld (t, f, ' ') + tape_loop2: do t = 1, max_tapes + file_loop1: do f = 1, max_split_files + fld_loop1: do fld = 1, nfmaster + mastername = masterlist(fld)%field%name + call list_index (fincl(1,t), mastername, ff) + if (ff > 0) then + ! if field is in include list, ff > 0 and htape_addfld + ! will not be called for field + avgflag = getflag (fincl(ff,t)) + call htape_addfld (t, f, fld, avgflag) + else + ! find index of field in exclude list + call list_index (fexcl(1,t), mastername, 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 (ff == 0 .and. masterlist(fld)%actflag(t,f)) then + call htape_addfld (t, f, fld, ' ') + end if end if - end if - end do + end do fld_loop1 ! Specification of tape contents now complete. ! Sort each list of active entries - do f = tape(t)%nflds-1,1,-1 - do ff = 1,f - if (tape(t)%hlist(ff)%field%name > tape(t)%hlist(ff+1)%field%name) then - tmp = tape(t)%hlist(ff) - tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) - tape(t)%hlist(ff+1) = tmp - else if (tape(t)%hlist(ff)%field%name == tape(t)%hlist(ff+1)%field%name) then - write(iulog,*) trim(subname),' ERROR: Duplicate field ', & - tape(t)%hlist(ff)%field%name, & - 't,ff,name=',t,ff,tape(t)%hlist(ff+1)%field%name - call shr_sys_abort() - end if - end do - end do + fld_loop2: do fld = tape(t)%nflds(f)-1,1,-1 + do ff = 1,fld + if (tape(t)%hlist(ff,f)%field%name > tape(t)%hlist(ff+1,f)%field%name) then + tmp = tape(t)%hlist(ff,f) + tape(t)%hlist(ff,f) = tape(t)%hlist(ff+1,f) + tape(t)%hlist(ff+1,f) = tmp + else if (tape(t)%hlist(ff,f)%field%name == tape(t)%hlist(ff+1,f)%field%name) then + write(iulog,*) trim(subname),' ERROR: Duplicate field ', & + tape(t)%hlist(ff,f)%field%name, & + 't,ff,name=',t,ff,tape(t)%hlist(ff+1,f)%field%name + call shr_sys_abort() + end if + end do + end do fld_loop2 - 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 + fld_loop3: do fld = 1, tape(t)%nflds(f) + write(iulog,*) fld,' ',tape(t)%hlist(fld,f)%field%name,' ',tape(t)%hlist(fld,f)%avgflag + end do fld_loop3 + 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)%avgflag - end do - call shr_sys_flush(iulog) - end if - end do + end do file_loop1 + end do tape_loop2 ! Determine total number of active history tapes ntapes = 0 - do t = max_tapes,1,-1 - if (tape(t)%nflds > 0) then - ntapes = t - exit - end if - end do + tape_loop3: do t = max_tapes,1,-1 + file_loop2: do f = 1, max_split_files + if (tape(t)%nflds(f) > 0) then + ntapes = t + exit + end if + end do file_loop2 + if (ntapes > 0) exit + end do tape_loop3 ! Ensure there are no "holes" in tape specification, i.e. empty tapes. ! Enabling holes should not be difficult if necessary. - do t = 1,ntapes - if (tape(t)%nflds == 0) then - write(iulog,*) trim(subname),' ERROR: Tape ',t,' is empty' - call shr_sys_abort() - end if - end do + tape_loop4: do t = 1, ntapes + file_loop3: do f = 1, max_split_files + if (tape(t)%nflds(f) == 0) then + write(iulog,*) trim(subname),' ERROR: Tape ',t, f, ' is empty' + call shr_sys_abort() + end if + end do file_loop3 + end do tape_loop4 ! Check that the number of history files declared does not exceed ! the maximum allowed. @@ -497,7 +508,7 @@ end subroutine htapes_fieldlist !----------------------------------------------------------------------- - subroutine htape_addfld (t, f, avgflag) + subroutine htape_addfld (t, f, fld, avgflag) ! !DESCRIPTION: ! Add a field to the active list for a history tape. Copy the data from @@ -505,8 +516,8 @@ subroutine htape_addfld (t, f, avgflag) ! !ARGUMENTS: implicit none - integer, intent(in) :: t ! history tape index - integer, intent(in) :: f ! field index from master field list + integer, intent(in) :: t, f ! history tape, file index + integer, intent(in) :: fld ! field index from master field list character(len=1), intent(in) :: avgflag ! time averaging flag ! !LOCAL VARIABLES: @@ -530,23 +541,23 @@ subroutine htape_addfld (t, f, avgflag) endrof = runoff%endr numrtm = runoff%numr - tape(t)%nflds = tape(t)%nflds + 1 - n = tape(t)%nflds - tape(t)%hlist(n)%field = masterlist(f)%field + tape(t)%nflds(f) = tape(t)%nflds(f) + 1 + n = tape(t)%nflds(f) + tape(t)%hlist(n,f)%field = masterlist(fld)%field - allocate (tape(t)%hlist(n)%hbuf(begrof:endrof)) - allocate (tape(t)%hlist(n)%nacs(begrof:endrof)) + allocate (tape(t)%hlist(n,f)%hbuf(begrof:endrof)) + allocate (tape(t)%hlist(n,f)%nacs(begrof:endrof)) - tape(t)%hlist(n)%hbuf(:) = 0._r8 - tape(t)%hlist(n)%nacs(:) = 0 + tape(t)%hlist(n,f)%hbuf(:) = 0._r8 + tape(t)%hlist(n,f)%nacs(:) = 0 ! Set time averaging flag based on masterlist setting or ! override the default averaging flag with namelist setting select case (avgflag) case (' ') - tape(t)%hlist(n)%avgflag = masterlist(f)%avgflag(t) + tape(t)%hlist(n,f)%avgflag = masterlist(fld)%avgflag(t) case ('A','I','X','M') - tape(t)%hlist(n)%avgflag = avgflag + tape(t)%hlist(n,f)%avgflag = avgflag case default write(iulog,*) trim(subname),' ERROR: unknown avgflag=', avgflag call shr_sys_abort() @@ -560,7 +571,7 @@ subroutine htape_addfld (t, f, avgflag) ! - instantaneous avgflag_temp = rtmhist_avgflag_pertape(t) if (avgflag_temp == 'I') then - tape(t)%hlist(n)%avgflag = avgflag_temp + tape(t)%hlist(n,f)%avgflag = avgflag_temp end if end subroutine htape_addfld @@ -577,8 +588,8 @@ subroutine RtmHistUpdateHbuf() implicit none ! !LOCAL VARIABLES: - integer :: t ! tape index - integer :: f ! field index + integer :: t, f ! tape, file index + integer :: fld ! field index integer :: k ! index integer :: hpindex ! history pointer index integer :: begrof,endrof ! beginning and ending indices @@ -593,66 +604,68 @@ subroutine RtmHistUpdateHbuf() begrof = runoff%begr endrof = runoff%endr - do t = 1,ntapes - do f = 1,tape(t)%nflds - avgflag = tape(t)%hlist(f)%avgflag - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - hpindex = tape(t)%hlist(f)%field%hpindex - field => rtmptr(hpindex)%ptr - - select case (avgflag) - case ('I') ! Instantaneous - do k = begrof,endrof - if (field(k) /= spval) then - hbuf(k) = field(k) - else - hbuf(k) = spval - end if - nacs(k) = 1 - end do - case ('A') ! Time average - do k = begrof,endrof - if (field(k) /= spval) then - if (nacs(k) == 0) hbuf(k) = 0._r8 - hbuf(k) = hbuf(k) + field(k) - nacs(k) = nacs(k) + 1 - else - if (nacs(k) == 0) hbuf(k) = spval - end if - end do - case ('X') ! Maximum over time - do k = begrof,endrof - if (field(k) /= spval) then - if (nacs(k) == 0) hbuf(k) = -1.e50_r8 - hbuf(k) = max( hbuf(k), field(k) ) - else - if (nacs(k) == 0) hbuf(k) = spval - end if - nacs(k) = 1 - end do - case ('M') ! Minimum over time - do k = begrof,endrof - if (field(k) /= spval) then - if (nacs(k) == 0) hbuf(k) = +1.e50_r8 - hbuf(k) = min( hbuf(k), field(k) ) - else - if (nacs(k) == 0) hbuf(k) = spval - end if - nacs(k) = 1 - end do - case default - write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag - call shr_sys_abort() - end select - end do - end do + tape_loop: do t = 1, ntapes + file_loop: do f = 1, max_split_files + fld_loop: do fld = 1, tape(t)%nflds(f) + avgflag = tape(t)%hlist(fld,f)%avgflag + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + hpindex = tape(t)%hlist(fld,f)%field%hpindex + field => rtmptr(hpindex)%ptr + + select case (avgflag) + case ('I') ! Instantaneous + do k = begrof,endrof + if (field(k) /= spval) then + hbuf(k) = field(k) + else + hbuf(k) = spval + end if + nacs(k) = 1 + end do + case ('A') ! Time average + do k = begrof,endrof + if (field(k) /= spval) then + if (nacs(k) == 0) hbuf(k) = 0._r8 + hbuf(k) = hbuf(k) + field(k) + nacs(k) = nacs(k) + 1 + else + if (nacs(k) == 0) hbuf(k) = spval + end if + end do + case ('X') ! Maximum over time + do k = begrof,endrof + if (field(k) /= spval) then + if (nacs(k) == 0) hbuf(k) = -1.e50_r8 + hbuf(k) = max( hbuf(k), field(k) ) + else + if (nacs(k) == 0) hbuf(k) = spval + end if + nacs(k) = 1 + end do + case ('M') ! Minimum over time + do k = begrof,endrof + if (field(k) /= spval) then + if (nacs(k) == 0) hbuf(k) = +1.e50_r8 + hbuf(k) = min( hbuf(k), field(k) ) + else + if (nacs(k) == 0) hbuf(k) = spval + end if + nacs(k) = 1 + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call shr_sys_abort() + end select + end do fld_loop + end do file_loop + end do tape_loop end subroutine RtmHistUpdateHbuf !----------------------------------------------------------------------- - subroutine htape_create (t, histrest) + subroutine htape_create (t, f, histrest) ! !DESCRIPTION: ! Define contents of history file t. Issue the required netcdf @@ -664,10 +677,10 @@ subroutine htape_create (t, histrest) ! !ARGUMENTS: implicit none integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index logical, intent(in), optional :: histrest ! if creating the history restart file ! !LOCAL VARIABLES: - integer :: f ! field index integer :: p,c,l,n ! indices integer :: ier ! error code integer :: dimid ! dimension id temporary @@ -701,29 +714,29 @@ subroutine htape_create (t, histrest) ! Define output write precsion for tape ncprec = tape(t)%ncprec if (lhistrest) then - lnfid => ncid_hist(t) + lnfid => ncid_hist(t,f) else - lnfid => nfid(t) + lnfid => nfid(t,f) endif ! Create new netCDF file. It will be in define mode 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', 'RTM History file information' ) call ncd_putatt(lnfid, ncd_global, 'comment', & "NOTE: None of the variables are weighted by land fraction!" ) else if (masterproc) then write(iulog,*) trim(subname),' : Opening netcdf rhtape ', & - trim(locfnhr(t)) + trim(locfnhr(t,f)) call shr_sys_flush(iulog) end if - call ncd_pio_createfile(lnfid, trim(locfnhr(t))) + call ncd_pio_createfile(lnfid, trim(locfnhr(t,f))) call ncd_putatt(lnfid, ncd_global, 'title', & 'RTM Restart History information, required to continue a simulation' ) call ncd_putatt(lnfid, ncd_global, 'comment', & @@ -794,13 +807,13 @@ 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 tape, file ', t, f call shr_sys_flush(iulog) end if else if (masterproc)then write(iulog,*) trim(subname), & - ' : Successfully defined netcdf restart history file ',t + ' : Successfully defined netcdf restart history tape, file ', t, f call shr_sys_flush(iulog) end if end if @@ -809,7 +822,7 @@ end subroutine htape_create !----------------------------------------------------------------------- - subroutine htape_timeconst(t, mode) + subroutine htape_timeconst(t, f, mode) ! !DESCRIPTION: ! Write time constant values to primary history tape. @@ -819,6 +832,7 @@ subroutine htape_timeconst(t, mode) ! !ARGUMENTS: implicit none integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! file index character(len=*), intent(in) :: mode ! 'define' or 'write' ! !LOCAL VARIABLES: @@ -854,7 +868,7 @@ subroutine htape_timeconst(t, mode) !-------------------------------------------------------- ! For define mode -- only do this for first time-sample - if (mode == 'define' .and. tape(t)%ntimes == 1) then + if (mode == 'define' .and. tape(t)%ntimes(f) == 1) then call get_ref_date(yr, mon, day, nbsec) nstep = get_nstep() @@ -871,13 +885,13 @@ subroutine htape_timeconst(t, mode) if (rtmhist_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), '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() @@ -886,49 +900,49 @@ subroutine htape_timeconst(t, mode) else if ( trim(cal) == GREGORIAN_C )then caldesc = "gregorian" end if - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) dim1id(1) = time_dimid long_name = 'current date (YYYYMMDD) at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mcdate', ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mcdate', ncd_int, 1, dim1id , varid, & long_name = long_name) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) long_name = 'current seconds of current date at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mcsec' , ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mcsec' , ncd_int, 1, dim1id , varid, & long_name = long_name, units='s') - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) long_name = 'current day (from base day) at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mdcur' , ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mdcur' , ncd_int, 1, dim1id , varid, & long_name = long_name) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) long_name = 'current seconds of current day at end of ' // step_or_bounds - call ncd_defvar(nfid(t) , 'mscur' , ncd_int, 1, dim1id , varid, & + call ncd_defvar(nfid(t,f) , 'mscur' , ncd_int, 1, dim1id , varid, & long_name = long_name) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) - call ncd_defvar(nfid(t) , 'nstep' , ncd_int, 1, dim1id , varid, & + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) + call ncd_defvar(nfid(t,f) , 'nstep' , ncd_int, 1, dim1id , varid, & long_name = 'time step') dim2id(1) = nbnd_dimid; dim2id(2) = time_dimid if (rtmhist_avgflag_pertape(t) /= '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 = 'time interval endpoints', & units=str) - call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t,f), varid, 'calendar', caldesc) end if dim2id(1) = strlen_dimid; dim2id(2) = time_dimid - call ncd_defvar(nfid(t), 'date_written', ncd_char, 2, dim2id, varid) - call ncd_defvar(nfid(t), 'time_written', ncd_char, 2, dim2id, varid) + call ncd_defvar(nfid(t,f), 'date_written', ncd_char, 2, dim2id, varid) + call ncd_defvar(nfid(t,f), 'time_written', ncd_char, 2, dim2id, varid) call ncd_defvar(varname='lon', xtype=tape(t)%ncprec, dim1name='lon', & - long_name='runoff coordinate longitude', units='degrees_east', ncid=nfid(t)) + long_name='runoff coordinate longitude', units='degrees_east', ncid=nfid(t,f)) call ncd_defvar(varname='lat', xtype=tape(t)%ncprec, dim1name='lat', & - long_name='runoff coordinate latitude', units='degrees_north', ncid=nfid(t)) + long_name='runoff coordinate latitude', units='degrees_north', ncid=nfid(t,f)) if(writeTC .and. t == 1) then call ncd_defvar(varname='fthresh', xtype=tape(t)%ncprec, dim1name='lon', & dim2name='lat', long_name='flooding threshold', & - missing_value=spval, fill_value=spval, units='m3', ncid=nfid(t)) + missing_value=spval, fill_value=spval, units='m3', ncid=nfid(t,f)) endif else if (mode == 'write') then @@ -937,32 +951,32 @@ subroutine htape_timeconst(t, mode) mcdate = yr*10000 + mon*100 + day nstep = get_nstep() - call ncd_io('mcdate', mcdate, 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('mcsec' , mcsec , 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('mdcur' , mdcur , 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('mscur' , mscur , 'write', nfid(t), nt=tape(t)%ntimes) - call ncd_io('nstep' , nstep , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mcdate', mcdate, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('mcsec' , mcsec , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('mdcur' , mdcur , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('mscur' , mscur , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) + call ncd_io('nstep' , nstep , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) timedata(1) = tape(t)%begtime ! beginning time timedata(2) = mdcur + mscur / secspday ! end time if (rtmhist_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), 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), nt=tape(t)%ntimes) + call ncd_io('time' , time , 'write', nfid(t,f), nt=tape(t)%ntimes(f)) call getdatetime (cdate, ctime) - call ncd_io('date_written', cdate, 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('date_written', cdate, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) - call ncd_io('time_written', ctime, 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('time_written', ctime, 'write', nfid(t,f), nt=tape(t)%ntimes(f)) - call ncd_io(varname='lon', data=runoff%rlon, ncid=nfid(t), flag='write') - call ncd_io(varname='lat', data=runoff%rlat, ncid=nfid(t), flag='write') + call ncd_io(varname='lon', data=runoff%rlon, ncid=nfid(t,f), flag='write') + call ncd_io(varname='lat', data=runoff%rlat, ncid=nfid(t,f), flag='write') - if(writeTC .and. t == 1 .and. tape(t)%ntimes == 1 ) then - call ncd_io(varname='fthresh', data=runoff%fthresh, ncid=nfid(t), flag='write' & + if(writeTC .and. t == 1 .and. tape(t)%ntimes(f) == 1 ) then + call ncd_io(varname='fthresh', data=runoff%fthresh, ncid=nfid(t,f), flag='write' & ,dim1name='allrof') writeTC = .false. endif @@ -1002,7 +1016,7 @@ subroutine RtmHistHtapesWrapup( rstwr, nlend ) ! !LOCAL VARIABLES: integer :: begrof, endrof ! beg and end rof indices - integer :: t,f,k,nt ! indices + integer :: fld, t, f, k, nt ! indices integer :: nstep ! current step integer :: day ! current day (1 -> 31) integer :: mon ! current month (1 -> 12) @@ -1043,163 +1057,167 @@ subroutine RtmHistHtapesWrapup( rstwr, nlend ) ! 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 - - ! Determine if end of history interval - tape(t)%is_endhist = .false. - if (tape(t)%nhtfrq==0) then !monthly average - if (mon /= monm1) then - tape(t)%is_endhist = .true. - end if - else - if (mod(nstep,tape(t)%nhtfrq) == 0) then - tape(t)%is_endhist = .true. + tape_loop1: do t = 1, ntapes + file_loop1: do f = 1, max_split_files + + ! Determine if end of history interval + tape(t)%is_endhist = .false. + if (tape(t)%nhtfrq==0) then !monthly average + if (mon /= monm1) then + tape(t)%is_endhist = .true. + end if + else + if (mod(nstep,tape(t)%nhtfrq) == 0) then + tape(t)%is_endhist = .true. + end if end if - end if - ! If end of history interval - if (tape(t)%is_endhist) then - - ! Normalize by number of accumulations for time averaged case - do f = 1,tape(t)%nflds - avgflag = tape(t)%hlist(f)%avgflag - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - do k = begrof, endrof - if ((avgflag == 'A') .and. nacs(k) /= 0) then - hbuf(k) = hbuf(k) / float(nacs(k)) - end if - end do - end do + ! If end of history interval + if (tape(t)%is_endhist) then + + ! Normalize by number of accumulations for time averaged case + fld_loop1: do fld = 1, tape(t)%nflds(f) + avgflag = tape(t)%hlist(fld,f)%avgflag + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + do k = begrof, endrof + if ((avgflag == 'A') .and. nacs(k) /= 0) then + hbuf(k) = hbuf(k) / float(nacs(k)) + end if + end do + end do fld_loop1 + + ! Increment current time sample counter. + tape(t)%ntimes(f) = tape(t)%ntimes(f) + 1 + + ! 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(f) == 1) then + locfnh(t,f) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & + rtmhist_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, f, mode='define') + + ! Define model field variables + + fld_loop2: do fld = 1, tape(t)%nflds(f) + varname = tape(t)%hlist(fld,f)%field%name + long_name = tape(t)%hlist(fld,f)%field%long_name + units = tape(t)%hlist(fld,f)%field%units + avgflag = tape(t)%hlist(fld,f)%avgflag + + select case (avgflag) + case ('A') + avgstr = 'mean' + case ('I') + avgstr = 'instantaneous' + case ('X') + avgstr = 'maximum' + case ('M') + avgstr = 'minimum' + case default + write(iulog,*) trim(subname),& + ' ERROR: unknown time averaging flag (avgflag)=',avgflag + call shr_sys_abort() + end select + + call ncd_defvar(ncid=nfid(t,f), varname=varname, xtype=tape(t)%ncprec, & + dim1name='lon', dim2name='lat', dim3name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + end do fld_loop2 + + ! Exit define model + call ncd_enddef(nfid(t,f)) - ! Increment current time sample counter. - tape(t)%ntimes = tape(t)%ntimes + 1 - - ! Create history file if appropriate and build time comment + endif - ! If first time sample, generate unique history file name, open file, - ! define dims, vars, etc. + ! Write time constant history variables + call htape_timeconst(t, f, mode='write') - if (tape(t)%ntimes == 1) then - locfnh(t) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & - rtmhist_mfilt=tape(t)%mfilt, hist_file=t) if (masterproc) then - write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t)), & - ' at nstep = ',get_nstep() - write(iulog,*)'calling htape_create for file t = ',t + 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 - call htape_create (t) - - ! Define time-constant field variables - call htape_timeconst(t, mode='define') - - ! Define model field variables - - do f = 1,tape(t)%nflds - 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 - - select case (avgflag) - case ('A') - avgstr = 'mean' - case ('I') - avgstr = 'instantaneous' - case ('X') - avgstr = 'maximum' - case ('M') - avgstr = 'minimum' - case default - write(iulog,*) trim(subname),& - ' ERROR: unknown time averaging flag (avgflag)=',avgflag - call shr_sys_abort() - end select - - call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & - dim1name='lon', dim2name='lat', dim3name='time', & - long_name=long_name, units=units, cell_method=avgstr, & - missing_value=spval, fill_value=spval) - end do - ! Exit define model - call ncd_enddef(nfid(t)) + ! Update beginning time of next interval + tape(t)%begtime = time - endif + ! Write history time slice + fld_loop3: do fld = 1, tape(t)%nflds(f) + varname = tape(t)%hlist(fld,f)%field%name + nt = tape(t)%ntimes(f) + histo => tape(t)%hlist(fld,f)%hbuf + call ncd_io(flag='write', varname=varname, dim1name='allrof', & + data=histo, ncid=nfid(t,f), nt=nt) + end do fld_loop3 - ! Write time constant history variables - call htape_timeconst(t, mode='write') + ! Zero necessary history buffers + fld_loop4: do fld = 1, tape(t)%nflds(f) + tape(t)%hlist(fld,f)%hbuf(:) = 0._r8 + tape(t)%hlist(fld,f)%nacs(:) = 0 + end do fld_loop4 - if (masterproc) then - write(iulog,*) - write(iulog,*) trim(subname),' : Writing current time sample to local history file ', & - trim(locfnh(t)),' at nstep = ',get_nstep(), & - ' for history time interval beginning at ', tape(t)%begtime, & - ' and ending at ',time - write(iulog,*) - call shr_sys_flush(iulog) - endif - - ! Update beginning time of next interval - tape(t)%begtime = time - - ! Write history time slice - do f = 1,tape(t)%nflds - varname = tape(t)%hlist(f)%field%name - nt = tape(t)%ntimes - histo => tape(t)%hlist(f)%hbuf - call ncd_io(flag='write', varname=varname, dim1name='allrof', & - data=histo, ncid=nfid(t), nt=nt) - end do - - ! Zero necessary history buffers - do f = 1,tape(t)%nflds - tape(t)%hlist(f)%hbuf(:) = 0._r8 - tape(t)%hlist(f)%nacs(:) = 0 - end do - - end if + end if - end do ! end loop over history tapes + end do file_loop1 + end do tape_loop1 ! Close open history files ! Auxilary files may have been closed and saved off without being full, ! must reopen the files - do t = 1, ntapes - if (nlend) then - if_close(t) = .true. - else if (rstwr) then - if_close(t) = .true. - else - if (tape(t)%ntimes == tape(t)%mfilt) then + tape_loop2: do t = 1, ntapes + file_loop2: do f = 1, max_split_files + if (nlend) then + if_close(t) = .true. + else if (rstwr) then if_close(t) = .true. else - if_close(t) = .false. - end if - endif - if (if_close(t)) then - if (tape(t)%ntimes /= 0) then - if (masterproc) then - write(iulog,*) - write(iulog,*) trim(subname),' : Closing local history file ',& - trim(locfnh(t)),' at nstep = ', get_nstep() - write(iulog,*) - endif - call ncd_pio_closefile(nfid(t)) - if ((.not.nlend) .and. (tape(t)%ntimes/=tape(t)%mfilt)) then - call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) + if (tape(t)%ntimes(f) == tape(t)%mfilt) then + if_close(t) = .true. + else + if_close(t) = .false. end if - else - if (masterproc) then - write(iulog,*) trim(subname),' : history tape ',t,': no open file to close' + endif + if (if_close(t)) then + if (tape(t)%ntimes(f) /= 0) then + if (masterproc) then + write(iulog,*) + write(iulog,*) trim(subname),' : Closing local history file ',& + trim(locfnh(t,f)),' at nstep = ', get_nstep() + write(iulog,*) + endif + call ncd_pio_closefile(nfid(t,f)) + if ((.not.nlend) .and. (tape(t)%ntimes(f) /= tape(t)%mfilt)) then + call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) + end if + else + if (masterproc) then + write(iulog,*) trim(subname),' : history tape ',t,': no open file to close' + end if + endif + if (tape(t)%ntimes(f) == tape(t)%mfilt) then + tape(t)%ntimes(f) = 0 end if endif - if (tape(t)%ntimes==tape(t)%mfilt) then - tape(t)%ntimes = 0 - end if - endif - end do + end do file_loop2 + end do tape_loop2 end subroutine RtmHistHtapesWrapup @@ -1223,6 +1241,7 @@ subroutine RtmHistRestart (ncid, flag, rdate) integer :: max_nflds ! max number of fields integer :: begrof ! per-proc beginning ocean runoff index integer :: endrof ! per-proc ending ocean runoff index + integer :: counter ! loop counter character(len=max_namlen) :: name ! variable name character(len=max_namlen) :: name_acc ! accumulator variable name character(len=max_namlen) :: long_name ! long name of variable @@ -1230,8 +1249,13 @@ subroutine RtmHistRestart (ncid, flag, rdate) character(len=max_chars) :: units ! units of variable character(len=max_chars) :: units_acc ! accumulator units character(len=max_chars) :: fname ! full name of history file - character(len=max_chars) :: locrest(max_tapes) ! local history restart file names + character(len=max_chars) :: locrest(max_tapes, max_split_files) ! local history restart file names + character(len=max_chars) :: locrest_onfile(max_split_files*max_tapes) ! history restart file names on file + character(len=max_chars) :: locfnh_onfile(max_split_files*max_tapes) ! history file names on file + character(len=max_chars) :: my_locfnh ! temporary version of locfnh + character(len=max_chars) :: my_locfnhr ! temporary version of locfnhr character(len=1) :: hnum ! history file index + character(len = 1) :: file_index ! instantaneous or accumulated_file_index type(var_desc_t) :: name_desc ! variable descriptor for name type(var_desc_t) :: longname_desc ! variable descriptor for long_name type(var_desc_t) :: units_desc ! variable descriptor for units @@ -1241,9 +1265,10 @@ subroutine RtmHistRestart (ncid, flag, rdate) integer :: start(2) ! Start array index integer :: k ! 1d index integer :: t ! tape index - integer :: f ! field index + integer :: f ! file index + integer :: fld ! field index integer :: varid ! variable id - integer, allocatable :: itemp(:) ! 2D temporary + integer, allocatable :: itemp(:) ! 1D temporary real(r8), pointer :: hbuf(:) ! history buffer integer , pointer :: nacs(:) ! accumulation counter character(len=*),parameter :: subname = 'hist_restart_ncd' @@ -1254,7 +1279,7 @@ subroutine RtmHistRestart (ncid, flag, rdate) if (flag == 'read') then if (nsrest == nsrBranch) then do t = 1,ntapes - tape(t)%ntimes = 0 + tape(t)%ntimes(:) = 0 end do RETURN end if @@ -1281,15 +1306,16 @@ subroutine RtmHistRestart (ncid, flag, rdate) ! call ncd_defdim( ncid, 'ntapes' , ntapes , dimid) call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) + call ncd_defdim( ncid, 'ntapes_by_max_split_files', ntapes * max_split_files, dimid) 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_by_max_split_files" ) 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_by_max_split_files" ) ! max_nflds is the maximum number of fields on any tape ! max_flds is the maximum number possible number of fields @@ -1298,104 +1324,111 @@ subroutine RtmHistRestart (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 - ! - ! Create the restart history filename and open it - ! - write(hnum,'(i1.1)') t-1 - locfnhr(t) = "./" // trim(caseid) //".rtm"// trim(inst_suffix) & - // ".rh" // hnum //"."// trim(rdate) //".nc" - call htape_create( t, histrest=.true. ) - ! - ! Add read/write accumultators and counters if needed - ! - if (.not. tape(t)%is_endhist) then - do f = 1,tape(t)%nflds - name = tape(t)%hlist(f)%field%name - long_name = tape(t)%hlist(f)%field%long_name - units = tape(t)%hlist(f)%field%units - name_acc = trim(name) // "_acc" - units_acc = "unitless positive integer" - long_name_acc = trim(long_name) // " accumulator number of samples" - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & - dim1name='lon', dim2name='lat', & - long_name=trim(long_name), units=trim(units)) - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & - dim1name='lon', dim2name='lat', & - long_name=trim(long_name_acc), units=trim(units_acc)) - end do - endif + tape_loop1: do t = 1, ntapes + file_loop1: do f = 1, max_split_files + if (f == instantaneous_file_index) then + file_index = 'i' ! instantaneous file_index + else if (f == accumulated_file_index) then + file_index = 'a' ! accumulated file_index + end if + ! + ! Create the restart history filename and open it + ! + write(hnum,'(i1.1)') t-1 + locfnhr(t,f) = "./" // trim(caseid) //".rtm"// trim(inst_suffix) & + // ".rh" // hnum // file_index //"."// trim(rdate) //".nc" + call htape_create( t, f, histrest=.true. ) + ! + ! Add read/write accumultators and counters if needed + ! + if (.not. tape(t)%is_endhist) then + fld_loop1: do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld,f)%field%name + long_name = tape(t)%hlist(fld,f)%field%long_name + units = tape(t)%hlist(fld,f)%field%units + name_acc = trim(name) // "_acc" + units_acc = "unitless positive integer" + long_name_acc = trim(long_name) // " accumulator number of samples" + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name), xtype=ncd_double, & + dim1name='lon', dim2name='lat', & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t,f), varname=trim(name_acc), xtype=ncd_int, & + dim1name='lon', dim2name='lat', & + long_name=trim(long_name_acc), units=trim(units_acc)) + end do fld_loop1 + endif - ! - ! Add namelist information to each restart history tape - ! - call ncd_defdim( ncid_hist(t), 'fname_lenp2' , max_namlen+2, dimid) - call ncd_defdim( ncid_hist(t), 'fname_len' , max_namlen , dimid) - call ncd_defdim( ncid_hist(t), 'len1' , 1 , 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='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='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", & - dim1name='len1', 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_enddef(ncid_hist(t)) - - end do ! end of ntapes loop + ! + ! 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), 'len1' , 1 , 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='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='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", & + dim1name='len1', 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_enddef(ncid_hist(t,f)) + + end do file_loop1 + end do tape_loop1 RETURN @@ -1404,10 +1437,16 @@ subroutine RtmHistRestart (ncid, flag, rdate) !================================================ ! Add history filenames to master restart file - do t = 1,ntapes - call ncd_io('locfnh', locfnh(t), 'write', ncid, nt=t) - call ncd_io('locfnhr', locfnhr(t), 'write', ncid, nt=t) - end do + counter = 0 + tape_loop2: do t = 1, ntapes + file_loop2: do f = 1, max_split_files + counter = counter + 1 + my_locfnh = locfnh(t,f) + my_locfnhr = locfnhr(t,f) + call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=counter) + call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=counter) + end do file_loop2 + end do tape_loop2 fincl(:,1) = rtmhist_fincl1(:) fincl(:,2) = rtmhist_fincl2(:) @@ -1424,40 +1463,42 @@ subroutine RtmHistRestart (ncid, flag, rdate) ! Add history namelist data to each history restart tape allocate(itemp(max_nflds)) - do t = 1,ntapes - 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), 'avgflag', varid, avgflag_desc) - - 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='is_endhist', data=tape(t)%is_endhist, 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)) - do f=1,tape(t)%nflds - start(2) = f - call ncd_io( name_desc, tape(t)%hlist(f)%field%name, & - 'write', ncid_hist(t), start ) - call ncd_io( longname_desc, tape(t)%hlist(f)%field%long_name, & - 'write', ncid_hist(t), start ) - call ncd_io( units_desc, tape(t)%hlist(f)%field%units, & - 'write', ncid_hist(t), start ) - call ncd_io( avgflag_desc, tape(t)%hlist(f)%avgflag, & - 'write', ncid_hist(t), start ) - end do - end do + tape_loop3: do t = 1, ntapes + file_loop3: do f = 1, max_split_files + 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), 'avgflag', varid, avgflag_desc) + + 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') + call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t,f), flag='write') + + itemp(:) = 0 + fld_loop2: do fld = 1, tape(t)%nflds(f) + itemp(fld) = tape(t)%hlist(fld,f)%field%hpindex + end do fld_loop2 + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t,f), flag='write') + + call ncd_io('nflds' , tape(t)%nflds(f), 'write', ncid_hist(t,f)) + call ncd_io('ntimes', tape(t)%ntimes(f), 'write', ncid_hist(t,f)) + call ncd_io('nhtfrq', tape(t)%nhtfrq, 'write', ncid_hist(t,f)) + call ncd_io('mfilt' , tape(t)%mfilt, 'write', ncid_hist(t,f)) + call ncd_io('ncprec', tape(t)%ncprec, 'write', ncid_hist(t,f)) + call ncd_io('begtime', tape(t)%begtime, 'write', ncid_hist(t,f)) + fld_loop3: do fld = 1, tape(t)%nflds(f) + start(2) = fld + call ncd_io( name_desc, tape(t)%hlist(fld,f)%field%name, & + 'write', ncid_hist(t,f), start ) + call ncd_io( longname_desc, tape(t)%hlist(fld,f)%field%long_name, & + 'write', ncid_hist(t,f), start ) + call ncd_io( units_desc, tape(t)%hlist(fld,f)%field%units, & + 'write', ncid_hist(t,f), start ) + call ncd_io( avgflag_desc, tape(t)%hlist(fld,f)%avgflag, & + 'write', ncid_hist(t,f), start ) + end do fld_loop3 + end do file_loop3 + end do tape_loop3 deallocate(itemp) !================================================ @@ -1465,11 +1506,17 @@ subroutine RtmHistRestart (ncid, flag, rdate) !================================================ call ncd_inqdlen(ncid,dimid,ntapes, name='ntapes') - call ncd_io('locfnh', locfnh(1:ntapes), 'read', ncid ) - call ncd_io('locfnhr', locrest(1:ntapes), 'read', ncid ) + counter = 0 do t = 1,ntapes - call strip_null(locrest(t)) - call strip_null(locfnh(t)) + do f = 1, max_split_files + counter = counter + 1 + call ncd_io('locfnh', locfnh_onfile, 'read', ncid ) + call ncd_io('locfnhr', locrest_onfile, 'read', ncid ) + call strip_null(locrest_onfile(counter)) + call strip_null(locfnh_onfile(counter)) + locrest(t,f) = locrest_onfile(counter) + locfnh(t,f) = locfnh_onfile(counter) + end do end do ! Determine necessary indices - the following is needed if model decomposition @@ -1478,68 +1525,70 @@ subroutine RtmHistRestart (ncid, flag, rdate) endrof = runoff%endr start(1)=1 - do t = 1,ntapes - call getfil( locrest(t), locfnhr(t), 0 ) - call ncd_pio_openfile (ncid_hist(t), trim(locfnhr(t)), ncd_nowrite) - - if ( t == 1 )then - call ncd_inqdlen(ncid_hist(1),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), 'avgflag', varid, avgflag_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', tape(t)%nflds, 'read', ncid_hist(t) ) - 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='hpindex' , data=itemp(:) , ncid=ncid_hist(t), flag='read') - do f=1,tape(t)%nflds - tape(t)%hlist(f)%field%hpindex = itemp(f) - end do + tape_loop4: do t = 1, ntapes + file_loop4: do f = 1, max_split_files + 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 .and. f == 1 )then + call ncd_inqdlen(ncid_hist(1,f),dimid,max_nflds,name='max_nflds') + allocate(itemp(max_nflds)) + end if - 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( avgflag_desc, tape(t)%hlist(f)%avgflag, & - '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)%avgflag) - - allocate (tape(t)%hlist(f)%hbuf(begrof:endrof), & - tape(t)%hlist(f)%nacs(begrof:endrof), stat=status) - if (status /= 0) then - write(iulog,*) trim(subname),' ERROR: allocation error for hbuf,nacs at t,f=',t,f - call shr_sys_abort() - endif - tape(t)%hlist(f)%hbuf(:) = 0._r8 - tape(t)%hlist(f)%nacs(:) = 0 - end do ! end of flds loop + 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), 'avgflag', varid, avgflag_desc) + + call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t,f), flag='read') + call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t,f), flag='read') + + call ncd_io('nflds', tape(t)%nflds(f), '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) ) + 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='hpindex' , data=itemp(:) , ncid=ncid_hist(t,f), flag='read') + fld_loop4: do fld = 1, tape(t)%nflds(f) + tape(t)%hlist(fld,f)%field%hpindex = itemp(fld) + end do fld_loop4 + + fld_loop5: do fld = 1, tape(t)%nflds(f) + start(2) = fld + call ncd_io( name_desc, tape(t)%hlist(fld,f)%field%name, & + 'read', ncid_hist(t,f), start ) + call ncd_io( longname_desc, tape(t)%hlist(fld,f)%field%long_name, & + 'read', ncid_hist(t,f), start ) + call ncd_io( units_desc, tape(t)%hlist(fld,f)%field%units, & + 'read', ncid_hist(t,f), start ) + call ncd_io( avgflag_desc, tape(t)%hlist(fld,f)%avgflag, & + 'read', ncid_hist(t,f), start ) + call strip_null(tape(t)%hlist(fld,f)%field%name) + call strip_null(tape(t)%hlist(fld,f)%field%long_name) + call strip_null(tape(t)%hlist(fld,f)%field%units) + call strip_null(tape(t)%hlist(fld,f)%avgflag) + + allocate (tape(t)%hlist(fld,f)%hbuf(begrof:endrof), & + tape(t)%hlist(fld,f)%nacs(begrof:endrof), stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for hbuf,nacs at t,f,fld=',t,f,fld + call shr_sys_abort() + endif + tape(t)%hlist(fld,f)%hbuf(:) = 0._r8 + tape(t)%hlist(fld,f)%nacs(:) = 0 + end do fld_loop5 - ! If history file is not full, open it + ! If history file is not full, open it - if (tape(t)%ntimes /= 0) then - call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) - end if + if (tape(t)%ntimes(f) /= 0) then + call ncd_pio_openfile (nfid(t,f), trim(locfnh(t,f)), ncd_write) + end if - end do ! end of tapes loop + end do file_loop4 + end do tape_loop4 rtmhist_fincl1(:) = fincl(:,1) rtmhist_fincl2(:) = fincl(:,2) @@ -1560,42 +1609,49 @@ subroutine RtmHistRestart (ncid, flag, rdate) if (flag == 'write') then - do t = 1,ntapes - 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" - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - - call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name), & - dim1name='allrof', data=hbuf) - call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name_acc), & - dim1name='allrof', data=nacs) - end do - end if ! end of is_endhist block - call ncd_pio_closefile(ncid_hist(t)) - end do ! end of ntapes loop + tape_loop5: do t = 1, ntapes + file_loop5: do f = 1, max_split_files + + if (.not. tape(t)%is_endhist) then + fld_loop6: do fld = 1, tape(t)%nflds(f) + name = tape(t)%hlist(fld,f)%field%name + name_acc = trim(name) // "_acc" + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + + call ncd_io(ncid=ncid_hist(t,f), flag='write', varname=trim(name), & + dim1name='allrof', data=hbuf) + call ncd_io(ncid=ncid_hist(t,f), flag='write', varname=trim(name_acc), & + dim1name='allrof', data=nacs) + end do fld_loop6 + end if ! end of is_endhist block + + call ncd_pio_closefile(ncid_hist(t,f)) + + end do file_loop5 + end do tape_loop5 else if (flag == 'read') then ! Read history restart information if history files are not full - do t = 1,ntapes - 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" - nacs => tape(t)%hlist(f)%nacs - hbuf => tape(t)%hlist(f)%hbuf - - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & - dim1name='allrof', data=hbuf) - call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & - dim1name='allrof', data=nacs) - end do - end if - call ncd_pio_closefile(ncid_hist(t)) - end do + tape_loop6: do t = 1, ntapes + file_loop6: do f = 1, max_split_files + if (.not. tape(t)%is_endhist) then + fld_loop7: do fld = 1,tape(t)%nflds(f) + name = tape(t)%hlist(fld,f)%field%name + name_acc = trim(name) // "_acc" + nacs => tape(t)%hlist(fld,f)%nacs + hbuf => tape(t)%hlist(fld,f)%hbuf + + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name), & + dim1name='allrof', data=hbuf) + call ncd_io(ncid=ncid_hist(t,f), flag='read', varname=trim(name_acc), & + dim1name='allrof', data=nacs) + end do fld_loop7 + end if + call ncd_pio_closefile(ncid_hist(t,f)) + end do file_loop6 + end do tape_loop6 end if @@ -1612,12 +1668,15 @@ integer function max_nFields() implicit none ! LOCAL VARIABLES: - integer :: t ! index + integer :: t ! tape index + integer :: f ! file index character(len=*),parameter :: subname = 'max_nFields' max_nFields = 0 do t = 1,ntapes - max_nFields = max(max_nFields, tape(t)%nflds) + do f = 1, max_split_files + max_nFields = max(max_nFields, tape(t)%nflds(f)) + end do end do end function max_nFields @@ -1715,7 +1774,7 @@ end subroutine list_index !----------------------------------------------------------------------- - character(len=max_length_filename) function set_hist_filename (hist_freq, rtmhist_mfilt, hist_file) + character(len=max_length_filename) function set_hist_filename (hist_freq, rtmhist_mfilt, hist_file, f_index) ! Determine history dataset filenames. @@ -1724,10 +1783,12 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, rtmhis integer, intent(in) :: hist_freq !history file frequency integer, intent(in) :: rtmhist_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: character(len=256) :: 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 -> ...) @@ -1742,9 +1803,16 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, rtmhis call get_curr_date (yr, mon, day, sec) write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec endif + + 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 + write(hist_index,'(i1.1)') hist_file - 1 set_hist_filename = "./"//trim(caseid)//".rtm"//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 @@ -1781,7 +1849,7 @@ subroutine RtmHistAddfld (fname, units, avgflag, long_name, ptr_rof, default) ! !LOCAL VARIABLES: integer :: n ! loop index - integer :: f ! masterlist index + integer :: fld ! masterlist index integer :: hpindex ! history buffer pointer index logical :: found ! flag indicates field found in masterlist integer, save :: lastindex = 1 @@ -1812,21 +1880,21 @@ subroutine RtmHistAddfld (fname, units, avgflag, long_name, ptr_rof, default) end if end do nfmaster = nfmaster + 1 - f = nfmaster + fld = nfmaster if (nfmaster > max_flds) then write(iulog,*) trim(subname),' ERROR: too many fields for primary history file ', & '-- max_flds,nfmaster=', max_flds, nfmaster call shr_sys_abort() end if - masterlist(f)%field%name = fname - masterlist(f)%field%long_name = long_name - masterlist(f)%field%units = units - masterlist(f)%field%hpindex = hpindex + masterlist(fld)%field%name = fname + masterlist(fld)%field%long_name = long_name + masterlist(fld)%field%units = units + masterlist(fld)%field%hpindex = hpindex ! The next two fields are only in master field list, NOT in runtime active field list ! ALL FIELDS IN THE MASTER LIST ARE INITIALIZED WITH THE ACTIVE FLAG SET TO FALSE - masterlist(f)%avgflag(:) = avgflag - masterlist(f)%actflag(:) = .false. + masterlist(fld)%avgflag(:) = avgflag + masterlist(fld)%actflag(:,:) = .false. if (present(default)) then if (trim(default) == 'inactive') return @@ -1834,9 +1902,13 @@ subroutine RtmHistAddfld (fname, units, avgflag, long_name, ptr_rof, default) ! Look through master list for input field name. ! When found, set active flag for that tape to true. found = .false. - do f = 1,nfmaster - if (trim(fname) == trim(masterlist(f)%field%name)) then - masterlist(f)%actflag(1) = .true. + do fld = 1, nfmaster + if (trim(fname) == trim(masterlist(fld)%field%name)) then + if (avgflag == 'I') then + masterlist(fld)%actflag(1,instantaneous_file_index) = .true. + else + masterlist(fld)%actflag(1,accumulated_file_index) = .true. + end if found = .true. exit end if From 9c1d7694aa6c8ec89280ec77ae019f84fee98419 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 1 Jul 2025 11:50:22 -0600 Subject: [PATCH 03/11] Change inactive 'A' history field to active 'I' for test to PASS --- src/riverroute/RtmHistFlds.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 6c7919e..082ac36 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -80,8 +80,8 @@ subroutine RtmHistFldsInit() ptr_rof=runoff%dvolrdtocn_nt2, default='inactive') call RtmHistAddfld (fname='RTMFLOOD', units='m3/s', & - avgflag='A', long_name='RTM flooding flux', & - ptr_rof=runoff%flood, default='inactive') + avgflag='I', long_name='RTM flooding flux', & + ptr_rof=runoff%flood) call RtmHistAddfld (fname='QIRRIG', units='mm/s', & avgflag='A', long_name='Irrigation flux from land', & From 40b1128e3c05d88819675d19bd0f2fa2003c394f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 1 Jul 2025 17:27:29 -0600 Subject: [PATCH 04/11] Draft ChangeLog --- docs/ChangeLog.md | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/docs/ChangeLog.md b/docs/ChangeLog.md index 942f3c2..ec88fd8 100644 --- a/docs/ChangeLog.md +++ b/docs/ChangeLog.md @@ -1,5 +1,18 @@
+# Tag name: rtm1_0_87 +### Originator(s): slevis +### Date: Jul l, 2025 +### One-line Summary: Separate instantaneous and non-inst. history files + +This is the rtm equivalent of ESCOMP/CTSM#2445. + +Resolves ESCOMP/RTM#32 + +PR ESCOMP/RTM#61 + +
+ # Tag name: rtm1_0_86 ### Originator(s): samrabin ### Date: Jan 16, 2025 From c85d3e01903df38259cc33de8b3ebc20715ab293 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:11:16 -0600 Subject: [PATCH 05/11] Remove confusing comment --- src/riverroute/RtmHistFile.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index 731dc68..a924b39 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -136,7 +136,7 @@ module RtmHistFile type history_tape integer :: nflds(max_split_files) ! number of active fields on file - integer :: ntimes(max_split_files) ! current number of time samples on tape, same value on all max_split_files + integer :: ntimes(max_split_files) ! current number of time samples on tape integer :: mfilt ! maximum number of time samples per tape integer :: nhtfrq ! number of time samples per tape integer :: ncprec ! netcdf output precision From d167482dc1eebf66bfa54109e7f0772c1ba0be92 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:17:09 -0600 Subject: [PATCH 06/11] Replace previously removed comment with a clearer comment --- src/riverroute/RtmHistFile.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index a924b39..407b7b2 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -136,7 +136,7 @@ module RtmHistFile type history_tape integer :: nflds(max_split_files) ! number of active fields on file - integer :: ntimes(max_split_files) ! current number of time samples on tape + integer :: ntimes(max_split_files) ! current number of time samples on tape; although ntimes is an array, all its values are the same integer :: mfilt ! maximum number of time samples per tape integer :: nhtfrq ! number of time samples per tape integer :: ncprec ! netcdf output precision From 621625af59f6845171ebf903cc8016c0ce981487 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 15:24:11 -0600 Subject: [PATCH 07/11] Change dim. ntapes_by_max_split_files to ntapes_multiply_by_max_split_files --- src/riverroute/RtmHistFile.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index 407b7b2..790b346 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -1306,16 +1306,16 @@ subroutine RtmHistRestart (ncid, flag, rdate) ! call ncd_defdim( ncid, 'ntapes' , ntapes , dimid) call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) - call ncd_defdim( ncid, 'ntapes_by_max_split_files', ntapes * max_split_files, dimid) + call ncd_defdim( ncid, 'ntapes_multiply_by_max_split_files', ntapes * max_split_files, dimid) call ncd_defvar(ncid=ncid, varname='locfnh', xtype=ncd_char, & long_name="History filename", & comment="This variable NOT needed for startup or branch simulations", & - dim1name='max_chars', dim2name="ntapes_by_max_split_files" ) + dim1name='max_chars', dim2name="ntapes_multiply_by_max_split_files" ) call ncd_defvar(ncid=ncid, varname='locfnhr', xtype=ncd_char, & long_name="Restart history filename", & comment="This variable NOT needed for startup or branch simulations", & - dim1name='max_chars', dim2name="ntapes_by_max_split_files" ) + dim1name='max_chars', dim2name="ntapes_multiply_by_max_split_files" ) ! max_nflds is the maximum number of fields on any tape ! max_flds is the maximum number possible number of fields From 712d791d964f48593a63f58fc72b43e307513f5f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 16:06:12 -0600 Subject: [PATCH 08/11] Correction motivated by corresponding clm commit a7fd23ca20e17a6abfc4b05d86a42bbe4adc9dd7 --- src/riverroute/RtmHistFile.F90 | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index 790b346..6639ef1 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -404,7 +404,21 @@ subroutine htapes_fieldlist() ! if field is in include list, ff > 0 and htape_addfld ! will not be called for field avgflag = getflag (fincl(ff,t)) - call htape_addfld (t, f, fld, avgflag) + if (avgflag == ' ') then + avgflag = masterlist(fld)%avgflag(t) + end if + ! This if-statement is in a loop of f (instantaneous_ or + ! accumulated_file_index) so it matters whether f is one + ! or the other when going through here. Otherwise all fields + ! would end up on all files, which is not the intent. + if (f == instantaneous_file_index .and. avgflag == 'I') then + call htape_addfld (t, f, fld, avgflag) + else if (f == accumulated_file_index .and. avgflag /= 'I') then + call htape_addfld (t, f, fld, avgflag) + else if (f /= instantaneous_file_index .and. f /= accumulated_file_index) then + write(iulog,*) trim(subname),' ERROR: invalid f =', f, ' should be one of these values:', accumulated_file_index, instantaneous_file_index + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if else ! find index of field in exclude list call list_index (fexcl(1,t), mastername, ff) From 5ba46ea24c98f9fbe26237aea79620a141858bf4 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 16:33:10 -0600 Subject: [PATCH 09/11] Add comment explaining the need for at least one 'I' field in RTM --- src/riverroute/RtmHistFlds.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 082ac36..9be31aa 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -79,6 +79,10 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='RTM ocean change of storage: '//trim(rtm_tracers(2)), & ptr_rof=runoff%dvolrdtocn_nt2, default='inactive') + ! RTM and MOSART (unlike the CLM) do not have the history_tape_in_use + ! capability, so both models throw an error when h0i is empty. For this + ! reason RTM and MOSART always need at least one instantaneous field so + ! that h0i will not be empty. call RtmHistAddfld (fname='RTMFLOOD', units='m3/s', & avgflag='I', long_name='RTM flooding flux', & ptr_rof=runoff%flood) From b435cf3d617d928f8a8541cae260e0bf32bbdc65 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 17:12:16 -0600 Subject: [PATCH 10/11] Replace call endrun with call shr_sys_abort for code to work --- src/riverroute/RtmHistFile.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index 6639ef1..46456c0 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -417,7 +417,7 @@ subroutine htapes_fieldlist() call htape_addfld (t, f, fld, avgflag) else if (f /= instantaneous_file_index .and. f /= accumulated_file_index) then write(iulog,*) trim(subname),' ERROR: invalid f =', f, ' should be one of these values:', accumulated_file_index, instantaneous_file_index - call endrun(msg=errMsg(sourcefile, __LINE__)) + call shr_sys_abort() end if else ! find index of field in exclude list From 851e4531f1cd04ce67cf572fe4d90a2684a7e380 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Jul 2025 18:16:53 -0600 Subject: [PATCH 11/11] Update ChangeLog --- docs/ChangeLog.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/ChangeLog.md b/docs/ChangeLog.md index ec88fd8..912c211 100644 --- a/docs/ChangeLog.md +++ b/docs/ChangeLog.md @@ -2,7 +2,7 @@ # Tag name: rtm1_0_87 ### Originator(s): slevis -### Date: Jul l, 2025 +### Date: Jul 03, 2025 ### One-line Summary: Separate instantaneous and non-inst. history files This is the rtm equivalent of ESCOMP/CTSM#2445.