From 89b880b9cfdd921c151f926363ff44998acc5a39 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 5 Jul 2026 22:27:33 -0500 Subject: [PATCH 1/5] Add cpl avg history capability to driver-moab Add avg_buf_type with raw 2D arrays for time-averaging buffers. Buffer sizes are now derived from MOAB mesh cell counts and field list lengths. Remove currently unused glc, wav, and iac averaging support and eliminate dependency on component_get_c2x_cx/x2c_cx accessors. --- driver-moab/main/seq_hist_mod.F90 | 798 ++++++++++++++++-------------- 1 file changed, 436 insertions(+), 362 deletions(-) diff --git a/driver-moab/main/seq_hist_mod.F90 b/driver-moab/main/seq_hist_mod.F90 index 8e8ce4959afd..8f961f8e5353 100644 --- a/driver-moab/main/seq_hist_mod.F90 +++ b/driver-moab/main/seq_hist_mod.F90 @@ -469,30 +469,23 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & integer(IN) :: fk ! index character(CL) :: time_units ! units of time variable character(CL) :: calendar ! calendar type - integer(IN) :: lsize ! local size of an aVect character(CL) :: case_name ! case name character(CL) :: hist_file ! Local path to history filename logical :: whead, wdata ! flags write header vs. data integer(IN) :: iidx ! component instance counter - type(mct_aVect), save :: a2x_ax_avg(num_inst_atm) ! tavg aVect/bundle - type(mct_aVect), save :: x2a_ax_avg(num_inst_atm) - type(mct_aVect), save :: l2x_lx_avg(num_inst_lnd) - type(mct_aVect), save :: x2l_lx_avg(num_inst_lnd) - type(mct_aVect), save :: r2x_rx_avg(num_inst_rof) - type(mct_aVect), save :: x2r_rx_avg(num_inst_rof) - type(mct_aVect), save :: o2x_ox_avg(num_inst_ocn) - type(mct_aVect), save :: x2o_ox_avg(num_inst_ocn) - type(mct_aVect), save :: i2x_ix_avg(num_inst_ice) - type(mct_aVect), save :: x2i_ix_avg(num_inst_ice) - type(mct_aVect), save :: g2x_gx_avg(num_inst_glc) - type(mct_aVect), save :: x2g_gx_avg(num_inst_glc) - type(mct_aVect), save :: w2x_wx_avg(num_inst_wav) - type(mct_aVect), save :: x2w_wx_avg(num_inst_wav) - type(mct_aVect), save :: z2x_zx_avg(num_inst_iac) - type(mct_aVect), save :: x2z_zx_avg(num_inst_iac) - type(mct_aVect), save, pointer :: xao_ox_avg(:) - type(mct_aVect), save, pointer :: xao_ax_avg(:) + type(avg_buf_type), save :: a2x_ax_avg(num_inst_atm) + type(avg_buf_type), save :: x2a_ax_avg(num_inst_atm) + type(avg_buf_type), save :: l2x_lx_avg(num_inst_lnd) + type(avg_buf_type), save :: x2l_lx_avg(num_inst_lnd) + type(avg_buf_type), save :: r2x_rx_avg(num_inst_rof) + type(avg_buf_type), save :: x2r_rx_avg(num_inst_rof) + type(avg_buf_type), save :: o2x_ox_avg(num_inst_ocn) + type(avg_buf_type), save :: x2o_ox_avg(num_inst_ocn) + type(avg_buf_type), save :: i2x_ix_avg(num_inst_ice) + type(avg_buf_type), save :: x2i_ix_avg(num_inst_ice) + type(avg_buf_type), save, allocatable :: xao_ox_avg(:) + type(avg_buf_type), save, allocatable :: xao_ax_avg(:) integer(IN) , save :: cnt ! counts samples in tavg real(r8) , save :: tbnds(2) ! CF1.0 time bounds @@ -500,10 +493,12 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & logical , save :: first_call = .true. ! flags 1st call of this routine - type(mct_gsMap), pointer :: gsmap ! component decomp on cpl pes - type(mct_gGrid), pointer :: dom ! component domain on cpl pes - type(mct_avect), pointer :: c2x ! component->coupler avs on cpl pes - type(mct_avect), pointer :: x2c ! coupler->component avs on cpl pes + integer(IN) :: numpts, nflds, ii + real(r8), allocatable :: tag_data(:) + real(r8), allocatable, target :: matrix_data(:,:) + real(r8), dimension(:,:), pointer :: p_matrix + type(mct_list) :: temp_list + type(mct_string) :: mctOStr character(CL) :: model_doi_url !------------------------------------------------------------------------------- @@ -563,125 +558,110 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & if (first_call) then if (atm_present .and. histavg_atm) then - do iidx = 1, num_inst_atm - c2x => component_get_c2x_cx(atm(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(a2x_ax_avg(iidx), c2x, lsize) - call mct_aVect_zero(a2x_ax_avg(iidx)) - - x2c => component_get_x2c_cx(atm(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2a_ax_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2a_ax_avg(iidx)) + numpts = mbGetnCells(mbaxid) + call mct_list_init(temp_list, seq_flds_a2x_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_atm + allocate(a2x_ax_avg(iidx)%data(numpts, nflds)) + a2x_ax_avg(iidx)%data = 0.0_r8 + enddo + call mct_list_init(temp_list, seq_flds_x2a_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_atm + allocate(x2a_ax_avg(iidx)%data(numpts, nflds)) + x2a_ax_avg(iidx)%data = 0.0_r8 enddo endif if (lnd_present .and. histavg_lnd) then - do iidx = 1, num_inst_lnd - c2x => component_get_c2x_cx(lnd(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(l2x_lx_avg(iidx), c2x, lsize) - call mct_aVect_zero(l2x_lx_avg(iidx)) - - x2c => component_get_x2c_cx(lnd(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2l_lx_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2l_lx_avg(iidx)) + numpts = mbGetnCells(mblxid) + call mct_list_init(temp_list, seq_flds_l2x_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_lnd + allocate(l2x_lx_avg(iidx)%data(numpts, nflds)) + l2x_lx_avg(iidx)%data = 0.0_r8 + enddo + call mct_list_init(temp_list, seq_flds_x2l_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_lnd + allocate(x2l_lx_avg(iidx)%data(numpts, nflds)) + x2l_lx_avg(iidx)%data = 0.0_r8 enddo endif if (rof_present .and. histavg_rof) then - do iidx = 1, num_inst_rof - c2x => component_get_c2x_cx(rof(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(r2x_rx_avg(iidx), c2x, lsize) - call mct_aVect_zero(r2x_rx_avg(iidx)) - - x2c => component_get_x2c_cx(rof(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2r_rx_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2r_rx_avg(iidx)) + numpts = mbGetnCells(mbrxid) + call mct_list_init(temp_list, seq_flds_r2x_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_rof + allocate(r2x_rx_avg(iidx)%data(numpts, nflds)) + r2x_rx_avg(iidx)%data = 0.0_r8 enddo - endif - if (ocn_present .and. histavg_ocn) then - do iidx = 1, num_inst_ocn - c2x => component_get_c2x_cx(ocn(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(o2x_ox_avg(iidx), c2x, lsize) - call mct_aVect_zero(o2x_ox_avg(iidx)) - - x2c => component_get_x2c_cx(ocn(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2o_ox_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2o_ox_avg(iidx)) + call mct_list_init(temp_list, seq_flds_x2r_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_rof + allocate(x2r_rx_avg(iidx)%data(numpts, nflds)) + x2r_rx_avg(iidx)%data = 0.0_r8 enddo endif - if (ice_present .and. histavg_ice) then - do iidx = 1, num_inst_ice - c2x => component_get_c2x_cx(ice(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(i2x_ix_avg(iidx), c2x, lsize) - call mct_aVect_zero(i2x_ix_avg(iidx)) - - x2c => component_get_x2c_cx(ice(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2i_ix_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2i_ix_avg(iidx)) + if (ocn_present .and. histavg_ocn) then + numpts = mbGetnCells(mboxid) + call mct_list_init(temp_list, seq_flds_o2x_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_ocn + allocate(o2x_ox_avg(iidx)%data(numpts, nflds)) + o2x_ox_avg(iidx)%data = 0.0_r8 enddo - endif - if (glc_present .and. histavg_glc) then - do iidx = 1, num_inst_glc - c2x => component_get_c2x_cx(glc(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(g2x_gx_avg(iidx), c2x, lsize) - call mct_aVect_zero(g2x_gx_avg(iidx)) - - x2c => component_get_x2c_cx(glc(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2g_gx_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2g_gx_avg(iidx)) + call mct_list_init(temp_list, seq_flds_x2o_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_ocn + allocate(x2o_ox_avg(iidx)%data(numpts, nflds)) + x2o_ox_avg(iidx)%data = 0.0_r8 enddo endif - if (wav_present .and. histavg_wav) then - do iidx = 1, num_inst_wav - c2x => component_get_c2x_cx(wav(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(w2x_wx_avg(iidx), c2x, lsize) - call mct_aVect_zero(w2x_wx_avg(iidx)) - - x2c => component_get_x2c_cx(wav(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2w_wx_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2w_wx_avg(iidx)) + if (ice_present .and. histavg_ice) then + numpts = mbGetnCells(mbixid) + call mct_list_init(temp_list, seq_flds_i2x_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_ice + allocate(i2x_ix_avg(iidx)%data(numpts, nflds)) + i2x_ix_avg(iidx)%data = 0.0_r8 enddo - endif - if (iac_present .and. histavg_iac) then - do iidx = 1, num_inst_iac - c2x => component_get_c2x_cx(iac(iidx)) - lsize = mct_aVect_lsize(c2x) - call mct_aVect_init(z2x_zx_avg(iidx), c2x, lsize) - call mct_aVect_zero(z2x_zx_avg(iidx)) - - x2c => component_get_x2c_cx(iac(iidx)) - lsize = mct_aVect_lsize(x2c) - call mct_aVect_init(x2z_zx_avg(iidx), x2c, lsize) - call mct_aVect_zero(x2z_zx_avg(iidx)) + call mct_list_init(temp_list, seq_flds_x2i_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) + do iidx = 1, num_inst_ice + allocate(x2i_ix_avg(iidx)%data(numpts, nflds)) + x2i_ix_avg(iidx)%data = 0.0_r8 enddo endif if (ocn_present .and. histavg_xao) then + numpts = mbGetnCells(mbofxid) + call mct_list_init(temp_list, seq_flds_xao_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) allocate(xao_ox_avg(num_inst_xao)) - xao_ox => prep_aoflux_get_xao_ox() - do iidx = 1, num_inst_xao - lsize = mct_aVect_lsize(xao_ox(iidx)) - call mct_aVect_init(xao_ox_avg(iidx), xao_ox(iidx), lsize) - call mct_aVect_zero(xao_ox_avg(iidx)) + do iidx = 1, num_inst_xao + allocate(xao_ox_avg(iidx)%data(numpts, nflds)) + xao_ox_avg(iidx)%data = 0.0_r8 enddo endif if (atm_present .and. histavg_xao) then + numpts = mbGetnCells(mbaxid) + call mct_list_init(temp_list, seq_flds_xao_fields) + nflds = mct_list_nitem(temp_list) + call mct_list_clean(temp_list) allocate(xao_ax_avg(num_inst_xao)) - xao_ax => prep_aoflux_get_xao_ax() - do iidx = 1, num_inst_xao - lsize = mct_aVect_lsize(xao_ax(iidx)) - call mct_aVect_init(xao_ax_avg(iidx), xao_ax(iidx), lsize) - call mct_aVect_zero(xao_ax_avg(iidx)) + do iidx = 1, num_inst_xao + allocate(xao_ax_avg(iidx)%data(numpts, nflds)) + xao_ax_avg(iidx)%data = 0.0_r8 enddo endif cnt = 0 @@ -691,163 +671,301 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & if (.not.write_now) then cnt = cnt + 1 + allocate(tag_data(max(mbGetnCells(mbaxid),mbGetnCells(mblxid), & + mbGetnCells(mbrxid),mbGetnCells(mboxid), & + mbGetnCells(mbixid),mbGetnCells(mbofxid)))) if (atm_present .and. histavg_atm) then - do iidx = 1, num_inst_atm - c2x => component_get_c2x_cx(atm(iidx)) - x2c => component_get_x2c_cx(atm(iidx)) - a2x_ax_avg(iidx)%rAttr = a2x_ax_avg(iidx)%rAttr + c2x%rAttr - x2a_ax_avg(iidx)%rAttr = x2a_ax_avg(iidx)%rAttr + x2c%rAttr + numpts = mbGetnCells(mbaxid) + call mct_list_init(temp_list, seq_flds_a2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_atm + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + a2x_ax_avg(iidx)%data(:,ii) = a2x_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2a_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_atm + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2a_ax_avg(iidx)%data(:,ii) = x2a_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo + enddo + call mct_list_clean(temp_list) endif if (lnd_present .and. histavg_lnd) then - do iidx = 1, num_inst_lnd - c2x => component_get_c2x_cx(lnd(iidx)) - x2c => component_get_x2c_cx(lnd(iidx)) - l2x_lx_avg(iidx)%rAttr = l2x_lx_avg(iidx)%rAttr + c2x%rAttr - x2l_lx_avg(iidx)%rAttr = x2l_lx_avg(iidx)%rAttr + x2c%rAttr + numpts = mbGetnCells(mblxid) + call mct_list_init(temp_list, seq_flds_l2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_lnd + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) + l2x_lx_avg(iidx)%data(:,ii) = l2x_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2l_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_lnd + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2l_lx_avg(iidx)%data(:,ii) = x2l_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo + enddo + call mct_list_clean(temp_list) endif if (rof_present .and. histavg_rof) then - do iidx = 1, num_inst_rof - c2x => component_get_c2x_cx(rof(iidx)) - x2c => component_get_x2c_cx(rof(iidx)) - r2x_rx_avg(iidx)%rAttr = r2x_rx_avg(iidx)%rAttr + c2x%rAttr - x2r_rx_avg(iidx)%rAttr = x2r_rx_avg(iidx)%rAttr + x2c%rAttr + numpts = mbGetnCells(mbrxid) + call mct_list_init(temp_list, seq_flds_r2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_rof + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + r2x_rx_avg(iidx)%data(:,ii) = r2x_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo - endif - if (ocn_present .and. histavg_ocn) then - do iidx = 1, num_inst_ocn - c2x => component_get_c2x_cx(ocn(iidx)) - x2c => component_get_x2c_cx(ocn(iidx)) - o2x_ox_avg(iidx)%rAttr = o2x_ox_avg(iidx)%rAttr + c2x%rAttr - x2o_ox_avg(iidx)%rAttr = x2o_ox_avg(iidx)%rAttr + x2c%rAttr + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2r_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_rof + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2r_rx_avg(iidx)%data(:,ii) = x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo + call mct_list_clean(temp_list) endif - if (ice_present .and. histavg_ice) then - do iidx = 1, num_inst_ice - c2x => component_get_c2x_cx(ice(iidx)) - x2c => component_get_x2c_cx(ice(iidx)) - i2x_ix_avg(iidx)%rAttr = i2x_ix_avg(iidx)%rAttr + c2x%rAttr - x2i_ix_avg(iidx)%rAttr = x2i_ix_avg(iidx)%rAttr + x2c%rAttr + if (ocn_present .and. histavg_ocn) then + numpts = mbGetnCells(mboxid) + call mct_list_init(temp_list, seq_flds_o2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ocn + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + o2x_ox_avg(iidx)%data(:,ii) = o2x_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo - endif - if (glc_present .and. histavg_glc) then - do iidx = 1, num_inst_glc - c2x => component_get_c2x_cx(glc(iidx)) - x2c => component_get_x2c_cx(glc(iidx)) - g2x_gx_avg(iidx)%rAttr = g2x_gx_avg(iidx)%rAttr + c2x%rAttr - x2g_gx_avg(iidx)%rAttr = x2g_gx_avg(iidx)%rAttr + x2c%rAttr + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2o_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ocn + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2o_ox_avg(iidx)%data(:,ii) = x2o_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo + call mct_list_clean(temp_list) endif - if (wav_present .and. histavg_wav) then - do iidx = 1, num_inst_wav - c2x => component_get_c2x_cx(wav(iidx)) - x2c => component_get_x2c_cx(wav(iidx)) - w2x_wx_avg(iidx)%rAttr = w2x_wx_avg(iidx)%rAttr + c2x%rAttr - x2w_wx_avg(iidx)%rAttr = x2w_wx_avg(iidx)%rAttr + x2c%rAttr + if (ice_present .and. histavg_ice) then + numpts = mbGetnCells(mbixid) + call mct_list_init(temp_list, seq_flds_i2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ice + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + i2x_ix_avg(iidx)%data(:,ii) = i2x_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo - endif - if (iac_present .and. histavg_iac) then - do iidx = 1, num_inst_iac - c2x => component_get_c2x_cx(iac(iidx)) - x2c => component_get_x2c_cx(iac(iidx)) - z2x_zx_avg(iidx)%rAttr = z2x_zx_avg(iidx)%rAttr + c2x%rAttr - x2z_zx_avg(iidx)%rAttr = x2z_zx_avg(iidx)%rAttr + x2c%rAttr + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2i_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ice + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + x2i_ix_avg(iidx)%data(:,ii) = x2i_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo + call mct_list_clean(temp_list) endif if (ocn_present .and. histavg_xao) then - xao_ox => prep_aoflux_get_xao_ox() - do iidx = 1, num_inst_ocn - xao_ox_avg(iidx)%rAttr = xao_ox_avg(iidx)%rAttr + xao_ox(iidx)%rAttr + numpts = mbGetnCells(mbofxid) + call mct_list_init(temp_list, seq_flds_xao_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_xao + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbofxid, mct_string_toChar(mctOStr), tag_data, numpts) + xao_ox_avg(iidx)%data(:,ii) = xao_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo + call mct_list_clean(temp_list) endif if (atm_present .and. histavg_xao) then - xao_ax => prep_aoflux_get_xao_ax() - do iidx = 1, num_inst_ocn - xao_ax_avg(iidx)%rAttr = xao_ax_avg(iidx)%rAttr + xao_ax(iidx)%rAttr + numpts = mbGetnCells(mbaxid) + call mct_list_init(temp_list, seq_flds_xao_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_xao + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + xao_ax_avg(iidx)%data(:,ii) = xao_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo + call mct_list_clean(temp_list) endif + deallocate(tag_data) else cnt = cnt + 1 tbnds(2) = curr_time + allocate(tag_data(max(mbGetnCells(mbaxid),mbGetnCells(mblxid), & + mbGetnCells(mbrxid),mbGetnCells(mboxid), & + mbGetnCells(mbixid),mbGetnCells(mbofxid)))) if (atm_present .and. histavg_atm) then - do iidx = 1, num_inst_atm - c2x => component_get_c2x_cx(atm(iidx)) - x2c => component_get_x2c_cx(atm(iidx)) - a2x_ax_avg(iidx)%rAttr = (a2x_ax_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2a_ax_avg(iidx)%rAttr = (x2a_ax_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + numpts = mbGetnCells(mbaxid) + call mct_list_init(temp_list, seq_flds_a2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_atm + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + a2x_ax_avg(iidx)%data(:,ii) = (a2x_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo + enddo + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2a_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_atm + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2a_ax_avg(iidx)%data(:,ii) = (x2a_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo + call mct_list_clean(temp_list) endif if (lnd_present .and. histavg_lnd) then - do iidx = 1, num_inst_lnd - c2x => component_get_c2x_cx(lnd(iidx)) - x2c => component_get_x2c_cx(lnd(iidx)) - l2x_lx_avg(iidx)%rAttr = (l2x_lx_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2l_lx_avg(iidx)%rAttr = (x2l_lx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + numpts = mbGetnCells(mblxid) + call mct_list_init(temp_list, seq_flds_l2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_lnd + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) + l2x_lx_avg(iidx)%data(:,ii) = (l2x_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo + enddo + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2l_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_lnd + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2l_lx_avg(iidx)%data(:,ii) = (x2l_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo + call mct_list_clean(temp_list) endif if (rof_present .and. histavg_rof) then - do iidx = 1, num_inst_rof - c2x => component_get_c2x_cx(rof(iidx)) - x2c => component_get_x2c_cx(rof(iidx)) - r2x_rx_avg(iidx)%rAttr = (r2x_rx_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2r_rx_avg(iidx)%rAttr = (x2r_rx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + numpts = mbGetnCells(mbrxid) + call mct_list_init(temp_list, seq_flds_r2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_rof + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + r2x_rx_avg(iidx)%data(:,ii) = (r2x_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo - endif - if (ocn_present .and. histavg_ocn) then - do iidx = 1, num_inst_ocn - c2x => component_get_c2x_cx(ocn(iidx)) - x2c => component_get_x2c_cx(ocn(iidx)) - o2x_ox_avg(iidx)%rAttr = (o2x_ox_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2o_ox_avg(iidx)%rAttr = (x2o_ox_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2r_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_rof + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2r_rx_avg(iidx)%data(:,ii) = (x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo + call mct_list_clean(temp_list) endif - if (ice_present .and. histavg_ice) then - do iidx = 1, num_inst_ice - c2x => component_get_c2x_cx(ice(iidx)) - x2c => component_get_x2c_cx(ice(iidx)) - i2x_ix_avg(iidx)%rAttr = (i2x_ix_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2i_ix_avg(iidx)%rAttr = (x2i_ix_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + if (ocn_present .and. histavg_ocn) then + numpts = mbGetnCells(mboxid) + call mct_list_init(temp_list, seq_flds_o2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ocn + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + o2x_ox_avg(iidx)%data(:,ii) = (o2x_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo - endif - if (glc_present .and. histavg_glc) then - do iidx = 1, num_inst_glc - c2x => component_get_c2x_cx(glc(iidx)) - x2c => component_get_x2c_cx(glc(iidx)) - g2x_gx_avg(iidx)%rAttr = (g2x_gx_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2g_gx_avg(iidx)%rAttr = (x2g_gx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2o_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ocn + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2o_ox_avg(iidx)%data(:,ii) = (x2o_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo + call mct_list_clean(temp_list) endif - if (wav_present .and. histavg_wav) then - do iidx = 1, num_inst_wav - c2x => component_get_c2x_cx(wav(iidx)) - x2c => component_get_x2c_cx(wav(iidx)) - w2x_wx_avg(iidx)%rAttr = (w2x_wx_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2w_wx_avg(iidx)%rAttr = (x2w_wx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + if (ice_present .and. histavg_ice) then + numpts = mbGetnCells(mbixid) + call mct_list_init(temp_list, seq_flds_i2x_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ice + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + i2x_ix_avg(iidx)%data(:,ii) = (i2x_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo - endif - if (iac_present .and. histavg_iac) then - do iidx = 1, num_inst_iac - c2x => component_get_c2x_cx(iac(iidx)) - x2c => component_get_x2c_cx(iac(iidx)) - z2x_zx_avg(iidx)%rAttr = (z2x_zx_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) - x2z_zx_avg(iidx)%rAttr = (x2z_zx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + call mct_list_clean(temp_list) + call mct_list_init(temp_list, seq_flds_x2i_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_ice + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + x2i_ix_avg(iidx)%data(:,ii) = (x2i_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo + call mct_list_clean(temp_list) endif if (ocn_present .and. histavg_xao) then - xao_ox => prep_aoflux_get_xao_ox() - do iidx = 1, num_inst_ocn - xao_ox_avg(iidx)%rAttr = (xao_ox_avg(iidx)%rAttr + xao_ox(iidx)%rAttr) / (cnt * 1.0_r8) + numpts = mbGetnCells(mbofxid) + call mct_list_init(temp_list, seq_flds_xao_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_xao + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbofxid, mct_string_toChar(mctOStr), tag_data, numpts) + xao_ox_avg(iidx)%data(:,ii) = (xao_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo + call mct_list_clean(temp_list) endif if (atm_present .and. histavg_xao) then - xao_ax => prep_aoflux_get_xao_ax() - do iidx = 1, num_inst_ocn - xao_ax_avg(iidx)%rAttr = (xao_ax_avg(iidx)%rAttr + xao_ax(iidx)%rAttr) / (cnt * 1.0_r8) + numpts = mbGetnCells(mbaxid) + call mct_list_init(temp_list, seq_flds_xao_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_xao + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + xao_ax_avg(iidx)%data(:,ii) = (xao_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + enddo enddo + call mct_list_clean(temp_list) endif + deallocate(tag_data) call seq_infodata_GetData( infodata, case_name=case_name) call seq_timemgr_EClockGetData( EClock_d, prev_ymd=prev_ymd, prev_tod=prev_tod) @@ -901,114 +1019,88 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & endif if (atm_present .and. histavg_atm) then - gsmap => component_get_gsmap_cx(atm(1)) - dom => component_get_dom_cx(atm(1)) - !call seq_io_write(hist_file, gsmap, dom%data, 'dom_ax', & - ! nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='doma') - - !call seq_io_write(hist_file, gsmap, x2a_ax_avg, 'x2a_ax', & - ! nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2aavg', tavg=.true.) - !call seq_io_write(hist_file, gsmap, a2x_ax_avg, 'a2x_ax', & - ! nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='a2xavg', tavg=.true.) + call seq_io_write(hist_file, mbaxid, 'doma', & + trim(seq_flds_dom_fields), nx=atm_nx, ny=atm_ny, nt=1, & + whead=whead, wdata=wdata) + matrix_data = x2a_ax_avg(1)%data + p_matrix => matrix_data + call seq_io_write(hist_file, mbaxid, 'x2aavg', & + trim(seq_flds_x2a_fields), nx=atm_nx, ny=atm_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) + matrix_data = a2x_ax_avg(1)%data + call seq_io_write(hist_file, mbaxid, 'a2xavg', & + trim(seq_flds_a2x_fields), nx=atm_nx, ny=atm_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) endif if (lnd_present .and. histavg_lnd) then - gsmap => component_get_gsmap_cx(lnd(1)) - dom => component_get_dom_cx(lnd(1)) - !call seq_io_write(hist_file, gsmap, dom%data, 'dom_lx', & - ! nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='doml') - !call seq_io_write(hist_file, gsmap, l2x_lx_avg, 'l2x_lx', & - ! nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='l2xavg', tavg=.true.) - !call seq_io_write(hist_file, gsmap, x2l_lx_avg, 'x2l_lx', & - ! nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2lavg', tavg=.true.) + call seq_io_write(hist_file, mblxid, 'doml', & + trim(seq_flds_dom_fields), nx=lnd_nx, ny=lnd_ny, nt=1, & + whead=whead, wdata=wdata) + matrix_data = l2x_lx_avg(1)%data + p_matrix => matrix_data + call seq_io_write(hist_file, mblxid, 'l2xavg', & + trim(seq_flds_l2x_fields), nx=lnd_nx, ny=lnd_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) + matrix_data = x2l_lx_avg(1)%data + call seq_io_write(hist_file, mblxid, 'x2lavg', & + trim(seq_flds_x2l_fields), nx=lnd_nx, ny=lnd_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) endif - if (rof_present .and. histavg_rof) then - gsmap => component_get_gsmap_cx(rof(1)) - dom => component_get_dom_cx(rof(1)) - ! call seq_io_write(hist_file, gsmap, dom%data, 'dom_rx', & - ! nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='domr') - ! call seq_io_write(hist_file, gsmap, r2x_rx_avg, 'r2x_rx', & - ! nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='r2xavg', tavg=.true.) - ! call seq_io_write(hist_file, gsmap, x2r_rx_avg, 'x2r_rx', & - ! nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2ravg', tavg=.true.) + call seq_io_write(hist_file, mbrxid, 'domr', & + trim(seq_flds_dom_fields), nx=rof_nx, ny=rof_ny, nt=1, & + whead=whead, wdata=wdata) + matrix_data = r2x_rx_avg(1)%data + p_matrix => matrix_data + call seq_io_write(hist_file, mbrxid, 'r2xavg', & + trim(seq_flds_r2x_fields), nx=rof_nx, ny=rof_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) + matrix_data = x2r_rx_avg(1)%data + call seq_io_write(hist_file, mbrxid, 'x2ravg', & + trim(seq_flds_x2r_fields), nx=rof_nx, ny=rof_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) endif if (ocn_present .and. histavg_ocn) then - gsmap => component_get_gsmap_cx(ocn(1)) - dom => component_get_dom_cx(ocn(1)) - ! call seq_io_write(hist_file, gsmap, dom%data, 'dom_ox', & - ! nx=ocn_nx, ny=ocn_ny, nt=1, whead=whead, wdata=wdata, pre='domo') - ! call seq_io_write(hist_file, gsmap, o2x_ox_avg, 'o2x_ox', & - ! nx=ocn_nx, ny=ocn_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='o2xavg', tavg=.true.) - ! call seq_io_write(hist_file, gsmap, x2o_ox_avg, 'x2o_ox', & - ! nx=ocn_nx, ny=ocn_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2oavg', tavg=.true.) + call seq_io_write(hist_file, mboxid, 'domo', & + trim(seq_flds_dom_fields), nx=ocn_nx, ny=ocn_ny, nt=1, & + whead=whead, wdata=wdata) + matrix_data = o2x_ox_avg(1)%data + p_matrix => matrix_data + call seq_io_write(hist_file, mboxid, 'o2xavg', & + trim(seq_flds_o2x_fields), nx=ocn_nx, ny=ocn_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) + matrix_data = x2o_ox_avg(1)%data + call seq_io_write(hist_file, mboxid, 'x2oavg', & + trim(seq_flds_x2o_fields), nx=ocn_nx, ny=ocn_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) endif if (ice_present .and. histavg_ice) then - gsmap => component_get_gsmap_cx(ice(1)) - dom => component_get_dom_cx(ice(1)) - ! call seq_io_write(hist_file, gsmap, dom%data, 'dom_ix', & - ! nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, pre='domi') - ! call seq_io_write(hist_file, gsmap, i2x_ix_avg, 'i2x_ix', & - ! nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='i2xavg', tavg=.true.) - ! call seq_io_write(hist_file, gsmap, x2i_ix_avg, 'x2i_ix', & - ! nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2iavg', tavg=.true.) - endif - if (glc_present .and. histavg_glc) then - gsmap => component_get_gsmap_cx(glc(1)) - dom => component_get_dom_cx(glc(1)) - ! call seq_io_write(hist_file, gsmap, dom%data, 'dom_gx', & - ! nx=glc_nx, ny=glc_ny, nt=1, whead=whead, wdata=wdata, pre='domg') - ! call seq_io_write(hist_file, gsmap, g2x_gx_avg, 'g2x_gx', & - ! nx=glc_nx, ny=glc_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='g2xavg', tavg=.true.) - ! call seq_io_write(hist_file, gsmap, x2g_gx_avg, 'x2g_gx', & - ! nx=glc_nx, ny=glc_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2gavg', tavg=.true.) - endif - if (wav_present .and. histavg_wav) then - gsmap => component_get_gsmap_cx(wav(1)) - dom => component_get_dom_cx(wav(1)) - ! call seq_io_write(hist_file, gsmap, dom%data, 'dom_wx', & - ! nx=wav_nx, ny=wav_ny, nt=1, whead=whead, wdata=wdata, pre='domw') - ! call seq_io_write(hist_file, gsmap, w2x_wx_avg, 'w2x_wx', & - ! nx=wav_nx, ny=wav_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='w2xavg', tavg=.true.) - ! call seq_io_write(hist_file, gsmap, x2w_wx_avg, 'x2w_wx', & - ! nx=wav_nx, ny=wav_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2wavg', tavg=.true.) - endif - if (iac_present .and. histavg_iac) then - gsmap => component_get_gsmap_cx(iac(1)) - dom => component_get_dom_cx(iac(1)) - ! call seq_io_write(hist_file, gsmap, dom%data, 'dom_zx', & - ! nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='domz') - ! call seq_io_write(hist_file, gsmap, z2x_zx_avg, 'z2x_zx', & - ! nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='z2xavg', tavg=.true.) - ! call seq_io_write(hist_file, gsmap, x2z_zx_avg, 'x2z_zx', & - ! nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='x2zavg', tavg=.true.) + call seq_io_write(hist_file, mbixid, 'domi', & + trim(seq_flds_dom_fields), nx=ice_nx, ny=ice_ny, nt=1, & + whead=whead, wdata=wdata) + matrix_data = i2x_ix_avg(1)%data + p_matrix => matrix_data + call seq_io_write(hist_file, mbixid, 'i2xavg', & + trim(seq_flds_i2x_fields), nx=ice_nx, ny=ice_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) + matrix_data = x2i_ix_avg(1)%data + call seq_io_write(hist_file, mbixid, 'x2iavg', & + trim(seq_flds_x2i_fields), nx=ice_nx, ny=ice_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) endif if (ocn_present .and. histavg_xao) then - gsmap => component_get_gsmap_cx(ocn(1)) - ! call seq_io_write(hist_file, gsmap, xao_ox_avg, 'xao_ox', & - ! nx=ocn_nx, ny=ocn_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='xaooavg', tavg=.true.) + matrix_data = xao_ox_avg(1)%data + p_matrix => matrix_data + call seq_io_write(hist_file, mbofxid, 'xaooavg', & + trim(seq_flds_xao_fields), nx=ocn_nx, ny=ocn_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) endif if (atm_present .and. histavg_xao) then - gsmap => component_get_gsmap_cx(atm(1)) - ! call seq_io_write(hist_file, gsmap, xao_ax_avg, 'xao_ax', & - ! nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, & - ! pre='xaoaavg', tavg=.true.) + matrix_data = xao_ax_avg(1)%data + p_matrix => matrix_data + call seq_io_write(hist_file, mbaxid, 'xaoaavg', & + trim(seq_flds_xao_fields), nx=atm_nx, ny=atm_ny, nt=1, & + whead=whead, wdata=wdata, matrix=p_matrix) endif enddo @@ -1017,61 +1109,43 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) if (atm_present .and. histavg_atm) then - do iidx = 1, num_inst_atm - call mct_aVect_zero(a2x_ax_avg(iidx)) - call mct_aVect_zero(x2a_ax_avg(iidx)) + do iidx = 1, num_inst_atm + a2x_ax_avg(iidx)%data = 0.0_r8 + x2a_ax_avg(iidx)%data = 0.0_r8 enddo endif if (lnd_present .and. histavg_lnd) then - do iidx = 1, num_inst_lnd - call mct_aVect_zero(l2x_lx_avg(iidx)) - call mct_aVect_zero(x2l_lx_avg(iidx)) + do iidx = 1, num_inst_lnd + l2x_lx_avg(iidx)%data = 0.0_r8 + x2l_lx_avg(iidx)%data = 0.0_r8 enddo endif if (rof_present .and. histavg_rof) then - do iidx = 1, num_inst_rof - call mct_aVect_zero(r2x_rx_avg(iidx)) - call mct_aVect_zero(x2r_rx_avg(iidx)) + do iidx = 1, num_inst_rof + r2x_rx_avg(iidx)%data = 0.0_r8 + x2r_rx_avg(iidx)%data = 0.0_r8 enddo endif if (ocn_present .and. histavg_ocn) then - do iidx = 1, num_inst_ocn - call mct_aVect_zero(o2x_ox_avg(iidx)) - call mct_aVect_zero(x2o_ox_avg(iidx)) + do iidx = 1, num_inst_ocn + o2x_ox_avg(iidx)%data = 0.0_r8 + x2o_ox_avg(iidx)%data = 0.0_r8 enddo endif if (ice_present .and. histavg_ice) then - do iidx = 1, num_inst_ice - call mct_aVect_zero(i2x_ix_avg(iidx)) - call mct_aVect_zero(x2i_ix_avg(iidx)) - enddo - endif - if (glc_present .and. histavg_glc) then - do iidx = 1, num_inst_glc - call mct_aVect_zero(g2x_gx_avg(iidx)) - call mct_aVect_zero(x2g_gx_avg(iidx)) - enddo - endif - if (wav_present .and. histavg_wav) then - do iidx = 1, num_inst_wav - call mct_aVect_zero(w2x_wx_avg(iidx)) - call mct_aVect_zero(x2w_wx_avg(iidx)) - enddo - endif - if (iac_present .and. histavg_iac) then - do iidx = 1, num_inst_wav - call mct_aVect_zero(z2x_zx_avg(iidx)) - call mct_aVect_zero(x2z_zx_avg(iidx)) + do iidx = 1, num_inst_ice + i2x_ix_avg(iidx)%data = 0.0_r8 + x2i_ix_avg(iidx)%data = 0.0_r8 enddo endif if (ocn_present .and. histavg_xao) then - do iidx = 1, num_inst_xao - call mct_aVect_zero(xao_ox_avg(iidx)) + do iidx = 1, num_inst_xao + xao_ox_avg(iidx)%data = 0.0_r8 enddo endif if (atm_present .and. histavg_xao) then - do iidx = 1, num_inst_xao - call mct_aVect_zero(xao_ax_avg(iidx)) + do iidx = 1, num_inst_xao + xao_ax_avg(iidx)%data = 0.0_r8 enddo endif cnt = 0 From bfc2c1ab8a423b74f796cff102c86b12fb873a4b Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 2 Aug 2026 23:39:40 -0500 Subject: [PATCH 2/5] Add a check for history averaging period. The coupler average-history averaging period must not be smaller than the smallest component coupling period. Otherwise an averaging window can close before some components have coupled even once, leaving their fields unset. Add this check to both drivers. --- driver-mct/shr/seq_timemgr_mod.F90 | 37 ++++++++++++++++++++++++++++ driver-moab/shr/seq_timemgr_mod.F90 | 38 +++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+) diff --git a/driver-mct/shr/seq_timemgr_mod.F90 b/driver-mct/shr/seq_timemgr_mod.F90 index f6a56e5b4e4d..ec32179ca361 100644 --- a/driver-mct/shr/seq_timemgr_mod.F90 +++ b/driver-mct/shr/seq_timemgr_mod.F90 @@ -376,6 +376,8 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi integer(SHR_KIND_IN) :: wav_cpl_dt ! Wav coupling interval integer(SHR_KIND_IN) :: iac_cpl_dt ! Iac coupling interval integer(SHR_KIND_IN) :: esp_cpl_dt ! Esp coupling interval + integer(SHR_KIND_IN) :: min_cpl_dt ! Smallest component coupling interval (s) + integer(SHR_KIND_IN) :: histavg_dt ! Histavg interval in seconds integer(SHR_KIND_IN) :: atm_cpl_offset ! Atmosphere coupling interval integer(SHR_KIND_IN) :: lnd_cpl_offset ! Land coupling interval integer(SHR_KIND_IN) :: ice_cpl_offset ! Sea-Ice coupling interval @@ -711,6 +713,41 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_sys_abort( subname//': ERROR invalid start_ymd') end if + ! --- Histavg period vs coupling period --------------------------------- + ! The coupler average-history averaging period must not be smaller than + ! the smallest component coupling period. Otherwise an averaging window + ! can close before some components have coupled even once, leaving their + ! fields unset and producing wrong averages for that window. + min_cpl_dt = min(atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt, ocn_cpl_dt, & + glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, esp_cpl_dt, iac_cpl_dt) + + ! Convert the absolute-time averaging options to seconds so they can be + ! compared with the coupling period. nsteps averaging is always a whole + ! number of driver steps (>= the smallest coupling period), and + ! nmonth/nyear are always larger, so those need no check. never/none/ + ! other/date do no fixed-length averaging that can be compared here. + histavg_dt = -1 + if ( trim(histavg_option) == trim(seq_timemgr_optNSeconds) .or. & + trim(histavg_option) == trim(seq_timemgr_optNSecond) ) then + histavg_dt = histavg_n + elseif ( trim(histavg_option) == trim(seq_timemgr_optNMinutes) .or. & + trim(histavg_option) == trim(seq_timemgr_optNMinute) ) then + histavg_dt = histavg_n * 60 + elseif ( trim(histavg_option) == trim(seq_timemgr_optNHours) .or. & + trim(histavg_option) == trim(seq_timemgr_optNHour) ) then + histavg_dt = histavg_n * 3600 + elseif ( trim(histavg_option) == trim(seq_timemgr_optNDays) .or. & + trim(histavg_option) == trim(seq_timemgr_optNDay) ) then + histavg_dt = histavg_n * 86400 + end if + + if ( histavg_dt > 0 .and. histavg_dt < min_cpl_dt ) then + write(logunit,*) trim(subname),' ERROR: histavg period (', histavg_dt, & + ' s) is smaller than the smallest coupling period (', min_cpl_dt, ' s)' + call shr_sys_abort( subname// & + ': ERROR histavg period must not be smaller than the smallest coupling period' ) + end if + endif !--------------------------------------------------------------------------- diff --git a/driver-moab/shr/seq_timemgr_mod.F90 b/driver-moab/shr/seq_timemgr_mod.F90 index 1fd5fcaee00f..f5b115f63c0b 100644 --- a/driver-moab/shr/seq_timemgr_mod.F90 +++ b/driver-moab/shr/seq_timemgr_mod.F90 @@ -369,6 +369,8 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi integer(SHR_KIND_IN) :: wav_cpl_dt ! Wav coupling interval integer(SHR_KIND_IN) :: iac_cpl_dt ! Iac coupling interval integer(SHR_KIND_IN) :: esp_cpl_dt ! Esp coupling interval + integer(SHR_KIND_IN) :: min_cpl_dt ! Smallest component coupling interval (s) + integer(SHR_KIND_IN) :: histavg_dt ! Histavg interval in seconds integer(SHR_KIND_IN) :: atm_cpl_offset ! Atmosphere coupling interval integer(SHR_KIND_IN) :: lnd_cpl_offset ! Land coupling interval integer(SHR_KIND_IN) :: ice_cpl_offset ! Sea-Ice coupling interval @@ -701,6 +703,42 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_sys_abort( subname//': ERROR invalid start_ymd') end if + ! --- Histavg period vs coupling period --------------------------------- + ! The coupler average-history averaging period must not be smaller than + ! the smallest component coupling period. Otherwise an averaging window + ! can close before some components have coupled even once, leaving their + ! fields unset (all zero in the MCT AVs, but uninitialized MOAB tags in + ! the MOAB driver) and producing wrong averages for that window. + min_cpl_dt = min(atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt, ocn_cpl_dt, & + glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, esp_cpl_dt, iac_cpl_dt) + + ! Convert the absolute-time averaging options to seconds so they can be + ! compared with the coupling period. nsteps averaging is always a whole + ! number of driver steps (>= the smallest coupling period), and + ! nmonth/nyear are always larger, so those need no check. never/none/ + ! other/date do no fixed-length averaging that can be compared here. + histavg_dt = -1 + if ( trim(histavg_option) == trim(seq_timemgr_optNSeconds) .or. & + trim(histavg_option) == trim(seq_timemgr_optNSecond) ) then + histavg_dt = histavg_n + elseif ( trim(histavg_option) == trim(seq_timemgr_optNMinutes) .or. & + trim(histavg_option) == trim(seq_timemgr_optNMinute) ) then + histavg_dt = histavg_n * 60 + elseif ( trim(histavg_option) == trim(seq_timemgr_optNHours) .or. & + trim(histavg_option) == trim(seq_timemgr_optNHour) ) then + histavg_dt = histavg_n * 3600 + elseif ( trim(histavg_option) == trim(seq_timemgr_optNDays) .or. & + trim(histavg_option) == trim(seq_timemgr_optNDay) ) then + histavg_dt = histavg_n * 86400 + end if + + if ( histavg_dt > 0 .and. histavg_dt < min_cpl_dt ) then + write(logunit,*) trim(subname),' ERROR: histavg period (', histavg_dt, & + ' s) is smaller than the smallest coupling period (', min_cpl_dt, ' s)' + call shr_sys_abort( subname// & + ': ERROR histavg period must not be smaller than the smallest coupling period' ) + end if + endif !--------------------------------------------------------------------------- From b028e79acb172365b190a0b4a929fe799f19a9ae Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 16 Aug 2026 00:07:33 -0500 Subject: [PATCH 3/5] Fix cpl avg history diffs in driver-moab The coupler average-history file did not match driver-mct. Fix four bugs; with all four the cpl.ha files are bit-for-bit with driver-mct and reproducible from run to run. Fix a dangling pointer in seq_hist_writeavg. Each component block writes a pair of fields by assigning the averaging buffer into the allocatable matrix_data and passing the pointer p_matrix to seq_io_write, but p_matrix was associated only once, before the first write of the pair. The paired field counts always differ (r2x has 8 fields and x2r 10, l2x 58 and x2l 42, and so on), so the second assignment reallocates matrix_data and frees the block p_matrix still points at. The second write of every pair therefore read freed memory. This is undefined behavior and was the source of run-to-run differences in the first averaging window, which produced a different garbage value in x2ravg_coszen_str on each run. Associate p_matrix after every assignment. This affected the atm, lnd, rof, ocn and ice blocks; the two xao blocks were already correct. Accumulate x2l from the x2l_lm snapshot taken during the land merge rather than from the live MOAB tag. Flrr_volr is mapped into x2l by prep_lnd_calc_r2x_lx in cime_run_rof_recv_post, which runs after the land merge in the same step, so reading the tag picked the new value up a step early and counted it one extra time. In the first window that made x2lavg_Flrr_volr and x2lavg_Flrr_volrmch exactly twice the driver-mct values. The instantaneous history already used this snapshot. Add a rof_coupled latch, false until the first rof coupling, and pass rofrun_alarm in from the driver. x2r tags are not written until rof couples for the first time, and with ROF_NCPL less than ATM_NCPL the first averaging window opens several driver steps before that, so seq_hist_writeavg accumulated tags that had never been set. While the latch is false x2r contributes zero, which is what driver-mct does since its x2r attribute vector is zero-filled at allocation. Zero x2r_rm in prep_rof_mrg_moab instead of reading the x2r tag back. The merge read the whole tag, overwrote only the fields it computes, and wrote the array back, so fields not computed for a given configuration, such as So_ssh when ocn_rof_two_way is off, carried the MOAB define-time default forward. This merge is the only writer of the x2r tag on mbrxid and the merge inputs are separate tags, so the read-back served no purpose. The instantaneous history never showed this because seq_io_write_moab_tags scrubs MOAB defaults on output. Co-Authored-By: Claude --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 17 +++--- driver-moab/main/seq_hist_mod.F90 | 93 +++++++++++++++++++----------- 3 files changed, 70 insertions(+), 42 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 594a2f5456da..de18668a4519 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -5151,7 +5151,7 @@ subroutine cime_run_write_history(lnd2glc_averaged_now) call t_startf('CPL:seq_hist_writeavg') call seq_hist_writeavg(infodata, EClock_d, & atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & - trim(cpl_inst_tag)) + trim(cpl_inst_tag), rofrun_alarm) call t_stopf('CPL:seq_hist_writeavg') endif diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index bc69bbb704e5..e5b427ca8c7f 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -1396,13 +1396,16 @@ subroutine prep_rof_mrg_moab (infodata, timer_mrg) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting fractions_om from rof instance ') endif - ! fill the r2x_rm, etc double array fields nflds - tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR - arrsize = nflds * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, x2r_rm) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting x2r_rm array ') - endif + ! Zero-initialize x2r_rm rather than reading back the existing x2r tag. + ! This merge is the only writer of the x2r tag on mbrxid, and it explicitly + ! sets every field it computes below. Fields that are not computed for this + ! configuration (e.g. So_ssh when ocn_rof_two_way is off, or the disabled + ! coszen_str) must be zero to match driver-mct, whose x2r attribute vector is + ! zero-filled at allocation. Reading the tag back instead would carry the + ! MOAB define-time default (garbage) into those unset fields, contaminating + ! the coupler average-history file (the instantaneous history is unaffected + ! because seq_io_write_moab_tags scrubs MOAB defaults on output). + x2r_rm(:,:) = 0.0_R8 ! a2x_rm (lsize, naflds)) if (rof_heat) then diff --git a/driver-moab/main/seq_hist_mod.F90 b/driver-moab/main/seq_hist_mod.F90 index 8f961f8e5353..a86bf7643c98 100644 --- a/driver-moab/main/seq_hist_mod.F90 +++ b/driver-moab/main/seq_hist_mod.F90 @@ -439,7 +439,8 @@ end subroutine seq_hist_write !=============================================================================== subroutine seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, write_now, cpl_inst_tag) + atm, lnd, ice, ocn, rof, glc, wav, iac, write_now, cpl_inst_tag, & + rof_coupled_now) implicit none @@ -455,6 +456,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & type (component_type) , intent(in) :: iac(:) logical , intent(in) :: write_now ! write or accumulate character(len=*) , intent(in) :: cpl_inst_tag + logical , intent(in) :: rof_coupled_now ! .true. if rof coupled this step integer(IN) :: curr_ymd ! Current date YYYYMMDD integer(IN) :: curr_tod ! Current time-of-day (s) @@ -492,11 +494,13 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & character(len=18) :: date_str logical , save :: first_call = .true. ! flags 1st call of this routine + logical , save :: rof_coupled = .false. ! .true. once rof has coupled at least once integer(IN) :: numpts, nflds, ii real(r8), allocatable :: tag_data(:) real(r8), allocatable, target :: matrix_data(:,:) real(r8), dimension(:,:), pointer :: p_matrix + real(r8), dimension(:,:), pointer :: p_x2l_lm ! land merge snapshot of x2l type(mct_list) :: temp_list type(mct_string) :: mctOStr character(CL) :: model_doi_url @@ -669,7 +673,12 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & first_call = .false. endif - if (.not.write_now) then + ! Latch whether rof has coupled at least once. Until then the x2r MOAB tags + ! have never been written, so x2r must contribute zero to the average (this + ! matches driver-mct, where the x2r attribute vector is zero-filled at alloc). + rof_coupled = rof_coupled .or. rof_coupled_now + + if (.not.write_now) then ! accumulate values in buffer cnt = cnt + 1 allocate(tag_data(max(mbGetnCells(mbaxid),mbGetnCells(mblxid), & mbGetnCells(mbrxid),mbGetnCells(mboxid), & @@ -709,16 +718,18 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & enddo enddo call mct_list_clean(temp_list) - call mct_list_init(temp_list, seq_flds_x2l_fields) - nflds = mct_list_nitem(temp_list) - do iidx = 1, num_inst_lnd - do ii = 1, nflds - call mct_list_get(mctOStr, ii, temp_list) - call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) - x2l_lx_avg(iidx)%data(:,ii) = x2l_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts) + ! Accumulate x2l from the x2l_lm snapshot taken during the land merge, + ! not from the live MOAB tag. Fields mapped into x2l later in the same + ! step (e.g. Flrr_volr, mapped in cime_run_rof_recv_post after the land + ! merge has already run) would otherwise be picked up a step early and + ! counted one extra time relative to driver-mct. This is the same + ! source the instantaneous history uses. + if (lnd_prognostic) then + do iidx = 1, num_inst_lnd + p_x2l_lm => prep_lnd_get_x2l_lm() + x2l_lx_avg(iidx)%data(:,:) = x2l_lx_avg(iidx)%data(:,:) + p_x2l_lm(:,:) enddo - enddo - call mct_list_clean(temp_list) + endif endif if (rof_present .and. histavg_rof) then numpts = mbGetnCells(mbrxid) @@ -732,16 +743,19 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & enddo enddo call mct_list_clean(temp_list) - call mct_list_init(temp_list, seq_flds_x2r_fields) - nflds = mct_list_nitem(temp_list) - do iidx = 1, num_inst_rof - do ii = 1, nflds - call mct_list_get(mctOStr, ii, temp_list) - call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) - x2r_rx_avg(iidx)%data(:,ii) = x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts) + ! x2r tags are unwritten until rof first couples; add zero until then + if (rof_coupled) then + call mct_list_init(temp_list, seq_flds_x2r_fields) + nflds = mct_list_nitem(temp_list) + do iidx = 1, num_inst_rof + do ii = 1, nflds + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2r_rx_avg(iidx)%data(:,ii) = x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts) + enddo enddo - enddo - call mct_list_clean(temp_list) + call mct_list_clean(temp_list) + endif endif if (ocn_present .and. histavg_ocn) then numpts = mbGetnCells(mboxid) @@ -817,7 +831,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & endif deallocate(tag_data) - else + else ! accumulate one more slice, make average, write cnt = cnt + 1 tbnds(2) = curr_time @@ -859,16 +873,16 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & enddo enddo call mct_list_clean(temp_list) - call mct_list_init(temp_list, seq_flds_x2l_fields) - nflds = mct_list_nitem(temp_list) + ! See the comment in the accumulate branch: x2l comes from the land + ! merge snapshot, not the live MOAB tag. do iidx = 1, num_inst_lnd - do ii = 1, nflds - call mct_list_get(mctOStr, ii, temp_list) - call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) - x2l_lx_avg(iidx)%data(:,ii) = (x2l_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) - enddo + if (lnd_prognostic) then + p_x2l_lm => prep_lnd_get_x2l_lm() + x2l_lx_avg(iidx)%data(:,:) = (x2l_lx_avg(iidx)%data(:,:) + p_x2l_lm(:,:)) / (cnt * 1.0_r8) + else + x2l_lx_avg(iidx)%data(:,:) = x2l_lx_avg(iidx)%data(:,:) / (cnt * 1.0_r8) + endif enddo - call mct_list_clean(temp_list) endif if (rof_present .and. histavg_rof) then numpts = mbGetnCells(mbrxid) @@ -886,9 +900,15 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & nflds = mct_list_nitem(temp_list) do iidx = 1, num_inst_rof do ii = 1, nflds - call mct_list_get(mctOStr, ii, temp_list) - call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) - x2r_rx_avg(iidx)%data(:,ii) = (x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + if (rof_coupled) then + ! rof has coupled: fold in this step's x2r sample, then average + call mct_list_get(mctOStr, ii, temp_list) + call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + x2r_rx_avg(iidx)%data(:,ii) = (x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) + else + ! rof never coupled this window: buffer is a sum of zeros; just average + x2r_rx_avg(iidx)%data(:,ii) = x2r_rx_avg(iidx)%data(:,ii) / (cnt * 1.0_r8) + endif enddo enddo call mct_list_clean(temp_list) @@ -1028,6 +1048,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & trim(seq_flds_x2a_fields), nx=atm_nx, ny=atm_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) matrix_data = a2x_ax_avg(1)%data + p_matrix => matrix_data call seq_io_write(hist_file, mbaxid, 'a2xavg', & trim(seq_flds_a2x_fields), nx=atm_nx, ny=atm_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) @@ -1042,6 +1063,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & trim(seq_flds_l2x_fields), nx=lnd_nx, ny=lnd_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) matrix_data = x2l_lx_avg(1)%data + p_matrix => matrix_data call seq_io_write(hist_file, mblxid, 'x2lavg', & trim(seq_flds_x2l_fields), nx=lnd_nx, ny=lnd_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) @@ -1056,6 +1078,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & trim(seq_flds_r2x_fields), nx=rof_nx, ny=rof_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) matrix_data = x2r_rx_avg(1)%data + p_matrix => matrix_data call seq_io_write(hist_file, mbrxid, 'x2ravg', & trim(seq_flds_x2r_fields), nx=rof_nx, ny=rof_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) @@ -1070,6 +1093,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & trim(seq_flds_o2x_fields), nx=ocn_nx, ny=ocn_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) matrix_data = x2o_ox_avg(1)%data + p_matrix => matrix_data call seq_io_write(hist_file, mboxid, 'x2oavg', & trim(seq_flds_x2o_fields), nx=ocn_nx, ny=ocn_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) @@ -1084,6 +1108,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & trim(seq_flds_i2x_fields), nx=ice_nx, ny=ice_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) matrix_data = x2i_ix_avg(1)%data + p_matrix => matrix_data call seq_io_write(hist_file, mbixid, 'x2iavg', & trim(seq_flds_x2i_fields), nx=ice_nx, ny=ice_ny, nt=1, & whead=whead, wdata=wdata, matrix=p_matrix) @@ -1151,8 +1176,8 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & cnt = 0 tbnds(1) = curr_time - endif - endif + endif ! if CPL task + endif ! end of average and write block end subroutine seq_hist_writeavg From 2a97bc1ab7316c40c88210b2f74156b1d38b050a Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 16 Aug 2026 19:34:16 -0500 Subject: [PATCH 4/5] Return zero cells from mbGetnCells for an unset moab app id The coupler app ids default to -1 and stay there when the component is absent, and several callers pass them without checking. The largest is the tag_data allocation in seq_hist_writeavg, which takes the max over all six coupler meshes whether or not each one exists. This does not fail today. iMOAB_GetMeshInfo indexes context.appDatas with the id, and appDatas is a std::map, so operator[] silently default-constructs an entry for -1 and returns success with zero counts. A MOSART case with stub ocean and ice, where three of the ids are -1, runs the average history code and writes its cpl.ha files. But that is correct only by accident. It relies on a MOAB container choice that is not visible from the Fortran side and would become an out-of-bounds access if appDatas ever became a vector, and it inserts a junk entry into the map on every call. The comparisons against mbaxid and mblxid further down would also match spuriously when those ids are themselves unset, so an absent component could take the vertex count branch instead of the cell count branch. Return zero early instead. No component means no cells, which is the same answer the map insertion produced, so output is unchanged: the coupled ne4pg2 case is still bit-for-bit with driver-mct and the MOSART case is unchanged across all 216 fields. mbGetCellTagVals and mbSetCellTagVals keep aborting on a bad id. Zero cells is a sensible answer for a count, but silently returning from a field read or write would hide a real failure. Co-Authored-By: Claude --- driver-moab/shr/shr_moab_mod.F90 | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/driver-moab/shr/shr_moab_mod.F90 b/driver-moab/shr/shr_moab_mod.F90 index ec3c78720d49..518562bb64ce 100644 --- a/driver-moab/shr/shr_moab_mod.F90 +++ b/driver-moab/shr/shr_moab_mod.F90 @@ -49,6 +49,17 @@ integer function mbGetnCells(moabid) character(*), parameter :: subname = '(mbGetnCells) ' !----------------------------------------------------------------------- ! + ! An unset app id (-1) means the component/mesh is absent, so it has no + ! cells. Return early rather than calling into iMOAB: iMOAB_GetMeshInfo + ! indexes context.appDatas with the id and would silently insert a default + ! entry for -1 (appDatas is a std::map, so this is not currently an error, + ! but it pollutes the map and would become out-of-bounds if that container + ! ever changed). Returning here also avoids the mbaxid/mblxid comparisons + ! below spuriously matching when those ids are themselves unset. + if (moabid < 0) then + mbGetnCells = 0 + return + endif ierr = iMOAB_GetMeshInfo ( moabid, nvert, nvise, nbl, nsurf, nvisBC ); From 0f2dbeb8ace27981ee3d48cab391721883ca48be Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 16 Aug 2026 21:00:04 -0500 Subject: [PATCH 5/5] Free the mct_string returned by mct_list_get in seq_hist_writeavg mct_list_get allocates a new character buffer on every call, by way of the init() in m_List.F90, and mct_string_clean is what deallocates it. seq_hist_mod.F90 had 26 mct_list_get calls and no matching cleans, so every field of every component leaked a small buffer on every call to seq_hist_writeavg. In the ne4pg2 configuration that is roughly 350 buffers per call, so about 8000 per model day at ATM_NCPL=24 and three million per model year. Each one is small but nothing ever reclaims them, so the cost grows with run length. Add the clean after the 24 sites that consume the string immediately in a mbGetCellTagVals call. The remaining two, in the field subset block of seq_hist_writeaux, already cleaned both strings correctly including on the early exit path, and are left alone. Output is unchanged; the coupled ne4pg2 case is still bit-for-bit with driver-mct in both averaging windows. Co-Authored-By: Claude --- driver-moab/main/seq_hist_mod.F90 | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/driver-moab/main/seq_hist_mod.F90 b/driver-moab/main/seq_hist_mod.F90 index a86bf7643c98..dfa34c2b8e03 100644 --- a/driver-moab/main/seq_hist_mod.F90 +++ b/driver-moab/main/seq_hist_mod.F90 @@ -691,6 +691,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) a2x_ax_avg(iidx)%data(:,ii) = a2x_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -701,6 +702,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2a_ax_avg(iidx)%data(:,ii) = x2a_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -714,6 +716,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) l2x_lx_avg(iidx)%data(:,ii) = l2x_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -739,6 +742,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) r2x_rx_avg(iidx)%data(:,ii) = r2x_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -751,6 +755,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2r_rx_avg(iidx)%data(:,ii) = x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -765,6 +770,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) o2x_ox_avg(iidx)%data(:,ii) = o2x_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -775,6 +781,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2o_ox_avg(iidx)%data(:,ii) = x2o_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -788,6 +795,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) i2x_ix_avg(iidx)%data(:,ii) = i2x_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -798,6 +806,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2i_ix_avg(iidx)%data(:,ii) = x2i_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -811,6 +820,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbofxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) xao_ox_avg(iidx)%data(:,ii) = xao_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -824,6 +834,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) xao_ax_avg(iidx)%data(:,ii) = xao_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts) enddo enddo @@ -846,6 +857,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) a2x_ax_avg(iidx)%data(:,ii) = (a2x_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -856,6 +868,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2a_ax_avg(iidx)%data(:,ii) = (x2a_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -869,6 +882,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mblxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) l2x_lx_avg(iidx)%data(:,ii) = (l2x_lx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -892,6 +906,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) r2x_rx_avg(iidx)%data(:,ii) = (r2x_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -904,6 +919,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & ! rof has coupled: fold in this step's x2r sample, then average call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbrxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2r_rx_avg(iidx)%data(:,ii) = (x2r_rx_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) else ! rof never coupled this window: buffer is a sum of zeros; just average @@ -921,6 +937,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) o2x_ox_avg(iidx)%data(:,ii) = (o2x_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -931,6 +948,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mboxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2o_ox_avg(iidx)%data(:,ii) = (x2o_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -944,6 +962,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) i2x_ix_avg(iidx)%data(:,ii) = (i2x_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -954,6 +973,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbixid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) x2i_ix_avg(iidx)%data(:,ii) = (x2i_ix_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -967,6 +987,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbofxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) xao_ox_avg(iidx)%data(:,ii) = (xao_ox_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -980,6 +1001,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & do ii = 1, nflds call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbaxid, mct_string_toChar(mctOStr), tag_data, numpts) + call mct_string_clean(mctOStr) xao_ax_avg(iidx)%data(:,ii) = (xao_ax_avg(iidx)%data(:,ii) + tag_data(1:numpts)) / (cnt * 1.0_r8) enddo enddo @@ -1381,6 +1403,7 @@ subroutine seq_hist_writeaux(infodata, EClock_d, comp, flow, aname, dname, inst_ call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbxid, mct_string_toChar(mctOStr), tag_data, numpts) call mct_string_clean(mctOStr) + call mct_string_clean(mctOStr) avavg(found)%data(:,ii) = (avavg(found)%data(:,ii) + tag_data(:)) / (avcnt(found) * 1.0_r8) enddo else @@ -1389,6 +1412,7 @@ subroutine seq_hist_writeaux(infodata, EClock_d, comp, flow, aname, dname, inst_ call mct_list_get(mctOStr, ii, temp_list) call mbGetCellTagVals(mbxid, mct_string_toChar(mctOStr), tag_data, numpts) call mct_string_clean(mctOStr) + call mct_string_clean(mctOStr) avavg(found)%data(:,ii) = avavg(found)%data(:,ii) + tag_data(:) enddo endif