From 5a93343e7d232f1ecb32e84a56c06fa988784b61 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Mon, 27 Apr 2026 18:20:27 +0200 Subject: [PATCH 1/4] Add PDAF DA history tape to histFileMod` Introduces a dedicated DA output tape (only activated under `USE_PDAF`) that writes instantaneous snapshots of the fields registered on tape 1 (h0) before and after each DA update. The "DA-tape" is appended as ntapes+1 at initialisation, but never auto-triggered by the normal CLM driver. The DA-tape produces per-cycle files named `caseid.clm2.da_bef.YYYY-MM-DD-SSSSS.nc` or `caseid.clm2.da_aft.YYYY-MM-DD-SSSSS.nc`. Co-Authored-By: Claude Sonnet 4.6 --- src/clm5/main/histFileMod.F90 | 166 ++++++++++++++++++++++++++++++++++ 1 file changed, 166 insertions(+) diff --git a/src/clm5/main/histFileMod.F90 b/src/clm5/main/histFileMod.F90 index ca9c64e476..9628863843 100644 --- a/src/clm5/main/histFileMod.F90 +++ b/src/clm5/main/histFileMod.F90 @@ -63,6 +63,10 @@ module histFileMod ! no fields on the h2 tape). In this case, ntapes will be 4 (for h0, h1, h2 and h3, ! since h3 is the last requested file), not 3 (the number of files actually produced). integer , private :: ntapes = 0 ! index of max history file requested +#if defined USE_PDAF + integer, private :: da_tape_idx = 0 ! tape index of PDAF DA output tape; 0 if not set + character(len=3), private :: da_tape_phase = 'bef' ! 'bef' or 'aft' DA update +#endif ! ! Namelist ! @@ -143,6 +147,11 @@ module histFileMod public :: hist_htapes_wrapup ! Write history tape(s) public :: hist_restart_ncd ! Read/write history file restart data public :: htapes_fieldlist ! Define the contents of each history file based on namelist +#if defined USE_PDAF + public :: hist_init_da_tape ! Initialize dedicated PDAF DA output tape + public :: hist_update_hbuf_da ! Update history buffers for DA tape only + public :: hist_set_da_tape_phase ! Set DA tape phase string ('before' or 'after') +#endif ! ! !PRIVATE MEMBER FUNCTIONS: private :: is_mapping_upto_subgrid ! Is this field being mapped up to a higher subgrid level? @@ -3376,7 +3385,11 @@ end subroutine hfields_1dinfo !----------------------------------------------------------------------- subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & +#if defined USE_PDAF + watsat_col, sucsat_col, bsw_col, hksat_col, da_call) +#else watsat_col, sucsat_col, bsw_col, hksat_col) +#endif ! ! !DESCRIPTION: ! Write history tape(s) @@ -3412,6 +3425,9 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) real(r8) , intent(in) :: bsw_col( bounds%begc:,1: ) real(r8) , intent(in) :: hksat_col( bounds%begc:,1: ) +#if defined USE_PDAF + logical, optional, intent(in) :: da_call ! true => called from PDAF DA; only write DA tape +#endif ! ! !LOCAL VARIABLES: integer :: t ! tape index @@ -3470,11 +3486,22 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Determine if end of history interval tape(t)%is_endhist = .false. +#if defined USE_PDAF + if (present(da_call) .and. da_call) then + ! DA call: only fire the dedicated DA tape + tape(t)%is_endhist = (t == da_tape_idx) + else if (da_tape_idx > 0 .and. t == da_tape_idx) then + ! Normal CLM call: skip the DA tape; it is only written on explicit DA calls + else +#endif 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 defined USE_PDAF + end if +#endif ! If end of history interval @@ -3496,8 +3523,16 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & if (tape(t)%ntimes == 1) then call t_startf('hist_htapes_wrapup_define') +#if defined USE_PDAF + if (t == da_tape_idx) then + locfnh(t) = set_da_hist_filename() + else +#endif locfnh(t) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & hist_mfilt=tape(t)%mfilt, hist_file=t) +#if defined USE_PDAF + end if +#endif if (masterproc) then write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t)), & ' at nstep = ',get_nstep() @@ -5364,6 +5399,137 @@ function avgflag_valid(avgflag, blank_valid) result(valid) end function avgflag_valid +#if defined USE_PDAF + !----------------------------------------------------------------------- + subroutine hist_init_da_tape() + ! + ! !DESCRIPTION: + ! Initialize a dedicated history tape for PDAF DA output. + ! Called once after CLM initialization from the PDAF interface + ! (enkf_clm_5.F90), after cime_init() has completed. + ! + ! Adds tape(ntapes+1) by cloning all fields from tape 1 with + ! instantaneous ('I') averaging and mfilt=1 so that each DA write + ! produces a separate, time-stamped netCDF file. The tape is never + ! triggered by the normal CLM driver; it fires only when + ! hist_htapes_wrapup is called with da_call=.true. + ! + use clm_time_manager, only : get_prev_time + use clm_varcon, only : secspday + ! + integer :: f + integer :: day, sec + integer :: beg1d_out, end1d_out, num2d + character(len=*), parameter :: subname = 'hist_init_da_tape' + !----------------------------------------------------------------------- + + if (ntapes >= max_tapes) then + call endrun(msg=trim(subname)//' ERROR: no room for DA tape, increase max_tapes') + end if + if (ntapes < 1) then + call endrun(msg=trim(subname)//' ERROR: no base tape configured to clone from') + end if + + ntapes = ntapes + 1 + da_tape_idx = ntapes + + ! Clone field list from tape 1, using instantaneous averaging + tape(da_tape_idx)%nflds = tape(1)%nflds + do f = 1, tape(1)%nflds + ! Copy all scalar field metadata + tape(da_tape_idx)%hlist(f)%field = tape(1)%hlist(f)%field + tape(da_tape_idx)%hlist(f)%avgflag = 'I' + ! Allocate independent history and accumulation buffers + beg1d_out = tape(1)%hlist(f)%field%beg1d_out + end1d_out = tape(1)%hlist(f)%field%end1d_out + num2d = tape(1)%hlist(f)%field%num2d + allocate(tape(da_tape_idx)%hlist(f)%hbuf(beg1d_out:end1d_out, num2d)) + allocate(tape(da_tape_idx)%hlist(f)%nacs(beg1d_out:end1d_out, num2d)) + tape(da_tape_idx)%hlist(f)%hbuf(:,:) = 0._r8 + tape(da_tape_idx)%hlist(f)%nacs(:,:) = 0 + end do + + ! Tape configuration: one snapshot per file; never auto-triggered + tape(da_tape_idx)%ntimes = 0 + tape(da_tape_idx)%mfilt = 1 ! one time sample per output file + tape(da_tape_idx)%nhtfrq = huge(tape(da_tape_idx)%nhtfrq) ! never auto-triggered + tape(da_tape_idx)%ncprec = tape(1)%ncprec + tape(da_tape_idx)%dov2xy = tape(1)%dov2xy + tape(da_tape_idx)%is_endhist = .false. + + call get_prev_time(day, sec) + tape(da_tape_idx)%begtime = day + sec/secspday + + history_tape_in_use(da_tape_idx) = .true. + + if (masterproc) then + write(iulog,*) trim(subname)//' : PDAF DA history tape initialized as tape ', & + da_tape_idx, ' with ', tape(da_tape_idx)%nflds, ' instantaneous fields' + end if + + end subroutine hist_init_da_tape + + !----------------------------------------------------------------------- + subroutine hist_update_hbuf_da(bounds) + ! + ! !DESCRIPTION: + ! Update history buffers for the PDAF DA tape only. + ! Called from clm_hist_write_pdaf after the DA state update so that + ! the buffer captures the post-update model state before writing. + ! Using hist_update_hbuf (all tapes) is avoided to prevent an extra + ! accumulation step on the regular averaging tapes. + ! + type(bounds_type), intent(in) :: bounds + ! + integer :: f, num2d + !----------------------------------------------------------------------- + + if (da_tape_idx == 0) return + + do f = 1, tape(da_tape_idx)%nflds + if (tape(da_tape_idx)%hlist(f)%field%num2d == 1) then + call hist_update_hbuf_field_1d(da_tape_idx, f, bounds) + else + num2d = tape(da_tape_idx)%hlist(f)%field%num2d + call hist_update_hbuf_field_2d(da_tape_idx, f, bounds, num2d) + end if + end do + + end subroutine hist_update_hbuf_da + + !----------------------------------------------------------------------- + subroutine hist_set_da_tape_phase(phase) + ! + ! !DESCRIPTION: + ! Set the DA tape phase label used in the output filename. + ! Call with 'bef' prior to the DA update and 'aft' following it. + ! + character(len=*), intent(in) :: phase + !----------------------------------------------------------------------- + da_tape_phase = phase + end subroutine hist_set_da_tape_phase + + !----------------------------------------------------------------------- + character(len=max_length_filename) function set_da_hist_filename() + ! + ! !DESCRIPTION: + ! Generate a filename for the PDAF DA history tape. + ! Format: ./caseid.clm2{inst_suffix}.da_{phase}.YYYY-MM-DD-SSSSS.nc + ! where phase is 'before' or 'after' the DA update. + ! + use clm_varctl, only : caseid, inst_suffix + use clm_time_manager, only : get_curr_date + ! + character(len=max_chars) :: cdate + integer :: yr, mon, day, sec + !----------------------------------------------------------------------- + call get_curr_date(yr, mon, day, sec) + write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr, mon, day, sec + set_da_hist_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)// & + ".da_"//trim(da_tape_phase)//"."//trim(cdate)//".nc" + end function set_da_hist_filename +#endif + end module histFileMod From 4865d06ac9430f7021c27b5a2bd22af675e64259 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Thu, 30 Apr 2026 17:52:01 +0200 Subject: [PATCH 2/4] trial: have DA tapes close with first CLM tape Co-Authored-By: Claude Sonnet 4.6 --- src/clm5/main/histFileMod.F90 | 164 +++++++++++++++++++++------------- 1 file changed, 103 insertions(+), 61 deletions(-) diff --git a/src/clm5/main/histFileMod.F90 b/src/clm5/main/histFileMod.F90 index 9628863843..25253c3f03 100644 --- a/src/clm5/main/histFileMod.F90 +++ b/src/clm5/main/histFileMod.F90 @@ -64,8 +64,9 @@ module histFileMod ! since h3 is the last requested file), not 3 (the number of files actually produced). integer , private :: ntapes = 0 ! index of max history file requested #if defined USE_PDAF - integer, private :: da_tape_idx = 0 ! tape index of PDAF DA output tape; 0 if not set - character(len=3), private :: da_tape_phase = 'bef' ! 'bef' or 'aft' DA update + integer, private :: da_tape_bef_idx = 0 ! tape index of PDAF 'before DA' tape; 0 if not set + integer, private :: da_tape_aft_idx = 0 ! tape index of PDAF 'after DA' tape; 0 if not set + character(len=3), private :: da_tape_phase = 'bef' ! current DA phase: 'bef' or 'aft' #endif ! ! Namelist @@ -3488,10 +3489,11 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape(t)%is_endhist = .false. #if defined USE_PDAF if (present(da_call) .and. da_call) then - ! DA call: only fire the dedicated DA tape - tape(t)%is_endhist = (t == da_tape_idx) - else if (da_tape_idx > 0 .and. t == da_tape_idx) then - ! Normal CLM call: skip the DA tape; it is only written on explicit DA calls + ! DA call: fire only the tape matching the current phase + tape(t)%is_endhist = (t == da_tape_bef_idx .and. da_tape_phase == 'bef') .or. & + (t == da_tape_aft_idx .and. da_tape_phase == 'aft') + else if (t == da_tape_bef_idx .or. t == da_tape_aft_idx) then + ! Normal CLM call: skip DA tapes; they roll over with tape 1 below else #endif if (tape(t)%nhtfrq==0) then !monthly average @@ -3524,8 +3526,10 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & if (tape(t)%ntimes == 1) then call t_startf('hist_htapes_wrapup_define') #if defined USE_PDAF - if (t == da_tape_idx) then - locfnh(t) = set_da_hist_filename() + if (t == da_tape_bef_idx) then + locfnh(t) = set_da_hist_filename('bef') + else if (t == da_tape_aft_idx) then + locfnh(t) = set_da_hist_filename('aft') else #endif locfnh(t) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & @@ -3641,7 +3645,34 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape(t)%ntimes = 0 end if end do - + +#if defined USE_PDAF + ! Roll DA tapes over together with tape 1 during normal CLM calls. + ! DA tapes accumulate samples across DA updates within each tape-1 file period. + ! When tape 1 closes its file, close any open DA tape files too and reset their + ! sample counters so the next DA write starts a fresh file. + if ((.not. present(da_call) .or. .not. da_call) .and. if_disphist(1)) then + block + integer :: da_tidx, i_da + integer :: da_tape_idxs(2) + da_tape_idxs = [da_tape_bef_idx, da_tape_aft_idx] + do i_da = 1, 2 + da_tidx = da_tape_idxs(i_da) + if (da_tidx == 0) cycle + if (tape(da_tidx)%ntimes /= 0) then + if (masterproc) then + write(iulog,*) trim(subname),' : Closing DA history tape ',da_tidx, & + ' (tape-1 rollover) at nstep = ',get_nstep() + end if + call ncd_pio_closefile(nfid(da_tidx)) + tape(da_tidx)%ntimes = 0 + tape(da_tidx)%begtime = time + end if + end do + end block + end if +#endif + end subroutine hist_htapes_wrapup !----------------------------------------------------------------------- @@ -5404,67 +5435,74 @@ end function avgflag_valid subroutine hist_init_da_tape() ! ! !DESCRIPTION: - ! Initialize a dedicated history tape for PDAF DA output. - ! Called once after CLM initialization from the PDAF interface - ! (enkf_clm_5.F90), after cime_init() has completed. + ! Initialize two dedicated history tapes for PDAF DA output: + ! one for the 'before DA' (forecast) state and one for the 'after DA' + ! (analysis) state. Called once after CLM initialization from the PDAF + ! interface (enkf_clm_5.F90), after cime_init() has completed. ! - ! Adds tape(ntapes+1) by cloning all fields from tape 1 with - ! instantaneous ('I') averaging and mfilt=1 so that each DA write - ! produces a separate, time-stamped netCDF file. The tape is never - ! triggered by the normal CLM driver; it fires only when - ! hist_htapes_wrapup is called with da_call=.true. + ! Each tape clones all fields from tape 1 with instantaneous ('I') averaging. + ! mfilt is set to huge so files never auto-close by sample count; instead, + ! the tapes roll over together with tape 1 (same file period as h0). + ! The tapes fire only when hist_htapes_wrapup is called with da_call=.true. ! use clm_time_manager, only : get_prev_time use clm_varcon, only : secspday ! - integer :: f + integer :: f, t, i_da integer :: day, sec integer :: beg1d_out, end1d_out, num2d + integer :: da_tape_idxs(2) character(len=*), parameter :: subname = 'hist_init_da_tape' !----------------------------------------------------------------------- - if (ntapes >= max_tapes) then - call endrun(msg=trim(subname)//' ERROR: no room for DA tape, increase max_tapes') + if (ntapes + 2 > max_tapes) then + call endrun(msg=trim(subname)//' ERROR: no room for two DA tapes, increase max_tapes') end if if (ntapes < 1) then call endrun(msg=trim(subname)//' ERROR: no base tape configured to clone from') end if - ntapes = ntapes + 1 - da_tape_idx = ntapes - - ! Clone field list from tape 1, using instantaneous averaging - tape(da_tape_idx)%nflds = tape(1)%nflds - do f = 1, tape(1)%nflds - ! Copy all scalar field metadata - tape(da_tape_idx)%hlist(f)%field = tape(1)%hlist(f)%field - tape(da_tape_idx)%hlist(f)%avgflag = 'I' - ! Allocate independent history and accumulation buffers - beg1d_out = tape(1)%hlist(f)%field%beg1d_out - end1d_out = tape(1)%hlist(f)%field%end1d_out - num2d = tape(1)%hlist(f)%field%num2d - allocate(tape(da_tape_idx)%hlist(f)%hbuf(beg1d_out:end1d_out, num2d)) - allocate(tape(da_tape_idx)%hlist(f)%nacs(beg1d_out:end1d_out, num2d)) - tape(da_tape_idx)%hlist(f)%hbuf(:,:) = 0._r8 - tape(da_tape_idx)%hlist(f)%nacs(:,:) = 0 - end do - - ! Tape configuration: one snapshot per file; never auto-triggered - tape(da_tape_idx)%ntimes = 0 - tape(da_tape_idx)%mfilt = 1 ! one time sample per output file - tape(da_tape_idx)%nhtfrq = huge(tape(da_tape_idx)%nhtfrq) ! never auto-triggered - tape(da_tape_idx)%ncprec = tape(1)%ncprec - tape(da_tape_idx)%dov2xy = tape(1)%dov2xy - tape(da_tape_idx)%is_endhist = .false. + ntapes = ntapes + 1 + da_tape_bef_idx = ntapes + ntapes = ntapes + 1 + da_tape_aft_idx = ntapes + da_tape_idxs = [da_tape_bef_idx, da_tape_aft_idx] call get_prev_time(day, sec) - tape(da_tape_idx)%begtime = day + sec/secspday - history_tape_in_use(da_tape_idx) = .true. + do i_da = 1, 2 + t = da_tape_idxs(i_da) + + ! Clone field list from tape 1, using instantaneous averaging + tape(t)%nflds = tape(1)%nflds + do f = 1, tape(1)%nflds + tape(t)%hlist(f)%field = tape(1)%hlist(f)%field + tape(t)%hlist(f)%avgflag = 'I' + beg1d_out = tape(1)%hlist(f)%field%beg1d_out + end1d_out = tape(1)%hlist(f)%field%end1d_out + num2d = tape(1)%hlist(f)%field%num2d + allocate(tape(t)%hlist(f)%hbuf(beg1d_out:end1d_out, num2d)) + allocate(tape(t)%hlist(f)%nacs(beg1d_out:end1d_out, num2d)) + tape(t)%hlist(f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(f)%nacs(:,:) = 0 + end do + + ! Tape configuration: many samples per file (rolls with tape 1); never auto-triggered + tape(t)%ntimes = 0 + tape(t)%mfilt = huge(tape(t)%mfilt) ! never auto-closes by count + tape(t)%nhtfrq = huge(tape(t)%nhtfrq) ! never auto-triggered + tape(t)%ncprec = tape(1)%ncprec + tape(t)%dov2xy = tape(1)%dov2xy + tape(t)%is_endhist = .false. + tape(t)%begtime = day + sec/secspday + + history_tape_in_use(t) = .true. + end do if (masterproc) then - write(iulog,*) trim(subname)//' : PDAF DA history tape initialized as tape ', & - da_tape_idx, ' with ', tape(da_tape_idx)%nflds, ' instantaneous fields' + write(iulog,*) trim(subname)//' : PDAF DA history tapes initialized as tapes ', & + da_tape_bef_idx, ' (bef) and ', da_tape_aft_idx, ' (aft) with ', & + tape(da_tape_bef_idx)%nflds, ' instantaneous fields; files roll with tape 1' end if end subroutine hist_init_da_tape @@ -5481,17 +5519,20 @@ subroutine hist_update_hbuf_da(bounds) ! type(bounds_type), intent(in) :: bounds ! - integer :: f, num2d + integer :: f, num2d, active_tape !----------------------------------------------------------------------- - if (da_tape_idx == 0) return + active_tape = 0 + if (da_tape_phase == 'bef' .and. da_tape_bef_idx > 0) active_tape = da_tape_bef_idx + if (da_tape_phase == 'aft' .and. da_tape_aft_idx > 0) active_tape = da_tape_aft_idx + if (active_tape == 0) return - do f = 1, tape(da_tape_idx)%nflds - if (tape(da_tape_idx)%hlist(f)%field%num2d == 1) then - call hist_update_hbuf_field_1d(da_tape_idx, f, bounds) + do f = 1, tape(active_tape)%nflds + if (tape(active_tape)%hlist(f)%field%num2d == 1) then + call hist_update_hbuf_field_1d(active_tape, f, bounds) else - num2d = tape(da_tape_idx)%hlist(f)%field%num2d - call hist_update_hbuf_field_2d(da_tape_idx, f, bounds, num2d) + num2d = tape(active_tape)%hlist(f)%field%num2d + call hist_update_hbuf_field_2d(active_tape, f, bounds, num2d) end if end do @@ -5510,13 +5551,14 @@ subroutine hist_set_da_tape_phase(phase) end subroutine hist_set_da_tape_phase !----------------------------------------------------------------------- - character(len=max_length_filename) function set_da_hist_filename() + character(len=max_length_filename) function set_da_hist_filename(phase) ! ! !DESCRIPTION: - ! Generate a filename for the PDAF DA history tape. + ! Generate a filename for a PDAF DA history tape. ! Format: ./caseid.clm2{inst_suffix}.da_{phase}.YYYY-MM-DD-SSSSS.nc - ! where phase is 'before' or 'after' the DA update. + ! The date reflects the time of the first DA sample written to the file. ! + character(len=3), intent(in) :: phase ! 'bef' or 'aft' use clm_varctl, only : caseid, inst_suffix use clm_time_manager, only : get_curr_date ! @@ -5526,7 +5568,7 @@ character(len=max_length_filename) function set_da_hist_filename() call get_curr_date(yr, mon, day, sec) write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr, mon, day, sec set_da_hist_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)// & - ".da_"//trim(da_tape_phase)//"."//trim(cdate)//".nc" + ".da_"//trim(phase)//"."//trim(cdate)//".nc" end function set_da_hist_filename #endif From ea014672341c34fa78a0cc3571659b837516431c Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Mon, 4 May 2026 12:51:59 +0200 Subject: [PATCH 3/4] Better integrate DA tape rollover into existing hist_htapes_wrapup Instead of a separate rollover block, propagate if_disphist(1) to the DA tapes after hist_do_disp so the standard close and ntimes-reset loops handle them uniformly. DA tapes are excluded from the file-reopen branch (closing always finalises the file; the next DA write opens a fresh one) and their ntimes is reset whenever dispatched rather than only when the tape is full. Co-Authored-By: Claude Sonnet 4.6 --- src/clm5/main/histFileMod.F90 | 50 +++++++++++++++-------------------- 1 file changed, 22 insertions(+), 28 deletions(-) diff --git a/src/clm5/main/histFileMod.F90 b/src/clm5/main/histFileMod.F90 index 25253c3f03..26b701fd8a 100644 --- a/src/clm5/main/histFileMod.F90 +++ b/src/clm5/main/histFileMod.F90 @@ -151,7 +151,7 @@ module histFileMod #if defined USE_PDAF public :: hist_init_da_tape ! Initialize dedicated PDAF DA output tape public :: hist_update_hbuf_da ! Update history buffers for DA tape only - public :: hist_set_da_tape_phase ! Set DA tape phase string ('before' or 'after') + public :: hist_set_da_tape_phase ! Set DA tape phase string ('bef' or 'aft') #endif ! ! !PRIVATE MEMBER FUNCTIONS: @@ -3603,6 +3603,16 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call hist_do_disp (ntapes, tape(:)%ntimes, tape(:)%mfilt, if_stop, if_disphist, rstwr, nlend) +#if defined USE_PDAF + ! DA tapes roll over together with tape 1 during normal CLM calls. + ! Propagate tape-1 dispatch flag so the standard close and reset loops below + ! handle DA tapes without a separate rollover block. + if (.not. present(da_call) .or. .not. da_call) then + if (da_tape_bef_idx > 0) if_disphist(da_tape_bef_idx) = if_disphist(1) + if (da_tape_aft_idx > 0) if_disphist(da_tape_aft_idx) = if_disphist(1) + end if +#endif + ! Close open history file ! Auxilary files may have been closed and saved off without being full, ! must reopen the files @@ -3623,7 +3633,12 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call ncd_pio_closefile(nfid(t)) +#if defined USE_PDAF + if (.not.if_stop .and. (tape(t)%ntimes/=tape(t)%mfilt) .and. & + t /= da_tape_bef_idx .and. t /= da_tape_aft_idx) then +#else if (.not.if_stop .and. (tape(t)%ntimes/=tape(t)%mfilt)) then +#endif call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) end if else @@ -3641,38 +3656,17 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & cycle end if +#if defined USE_PDAF + ! DA tapes never fill by sample count; reset whenever they are dispatched + if (if_disphist(t) .and. (tape(t)%ntimes==tape(t)%mfilt .or. & + t==da_tape_bef_idx .or. t==da_tape_aft_idx)) then +#else if (if_disphist(t) .and. tape(t)%ntimes==tape(t)%mfilt) then +#endif tape(t)%ntimes = 0 end if end do -#if defined USE_PDAF - ! Roll DA tapes over together with tape 1 during normal CLM calls. - ! DA tapes accumulate samples across DA updates within each tape-1 file period. - ! When tape 1 closes its file, close any open DA tape files too and reset their - ! sample counters so the next DA write starts a fresh file. - if ((.not. present(da_call) .or. .not. da_call) .and. if_disphist(1)) then - block - integer :: da_tidx, i_da - integer :: da_tape_idxs(2) - da_tape_idxs = [da_tape_bef_idx, da_tape_aft_idx] - do i_da = 1, 2 - da_tidx = da_tape_idxs(i_da) - if (da_tidx == 0) cycle - if (tape(da_tidx)%ntimes /= 0) then - if (masterproc) then - write(iulog,*) trim(subname),' : Closing DA history tape ',da_tidx, & - ' (tape-1 rollover) at nstep = ',get_nstep() - end if - call ncd_pio_closefile(nfid(da_tidx)) - tape(da_tidx)%ntimes = 0 - tape(da_tidx)%begtime = time - end if - end do - end block - end if -#endif - end subroutine hist_htapes_wrapup !----------------------------------------------------------------------- From 941da8dc8d88972532e8f04d9e79eb84ae966936 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Mon, 4 May 2026 13:00:55 +0200 Subject: [PATCH 4/4] fix: USE statement cannot follow data declaration statement --- src/clm5/main/histFileMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clm5/main/histFileMod.F90 b/src/clm5/main/histFileMod.F90 index 26b701fd8a..850e41de58 100644 --- a/src/clm5/main/histFileMod.F90 +++ b/src/clm5/main/histFileMod.F90 @@ -5552,9 +5552,9 @@ character(len=max_length_filename) function set_da_hist_filename(phase) ! Format: ./caseid.clm2{inst_suffix}.da_{phase}.YYYY-MM-DD-SSSSS.nc ! The date reflects the time of the first DA sample written to the file. ! - character(len=3), intent(in) :: phase ! 'bef' or 'aft' use clm_varctl, only : caseid, inst_suffix use clm_time_manager, only : get_curr_date + character(len=3), intent(in) :: phase ! 'bef' or 'aft' ! character(len=max_chars) :: cdate integer :: yr, mon, day, sec