From bf2e52d8d30639e175c50a16a52ec6312be744ae Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 29 Jan 2026 11:06:10 -0700 Subject: [PATCH 1/4] Refactor med_field_info_mod and med_methods_mod to expose some methods Expose two methods that will be useful for the water tracer work: (1) med_field_info_create_from_field: create a single field_info object from information in an ESMF_Field (extracted from med_field_info_array_from_state) (2) med_field_info_esmf_fieldcreate: create an ESMF Field based on a field_info object (extracted from med_methods_FB_init) --- mediator/med_field_info_mod.F90 | 160 +++++++++++++++++++++++--------- mediator/med_methods_mod.F90 | 20 +--- 2 files changed, 122 insertions(+), 58 deletions(-) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 197f0a1b1..ce0406d8c 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -5,8 +5,10 @@ module med_field_info_mod ! used to create an ESMF FieldBundle. !----------------------------------------------------------------------------- - use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS + use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet + use ESMF , only : ESMF_Mesh, ESMF_MeshLoc + use ESMF , only : ESMF_FieldCreate use med_utils_mod , only : ChkErr => med_utils_ChkErr use shr_log_mod , only : shr_log_error use wtracers_mod , only : wtracers_is_wtracer_field @@ -18,8 +20,11 @@ module med_field_info_mod ! Public methods !----------------------------------------------- - ! Create a single field - public :: med_field_info_create + ! Create a single field_info object from direct specification of values + public :: med_field_info_create_directly + + ! Create a single field_info object from information in an ESMF_Field + public :: med_field_info_create_from_field ! Create an array of field_info objects based on an array of names, where water tracers ! are treated specially (being given an ungridded dimension) @@ -28,6 +33,9 @@ module med_field_info_mod ! Create an array of field_info objects based on the fields in an ESMF State public :: med_field_info_array_from_state + ! Create an ESMF Field (using ESMF_FieldCreate) based on a field_info object + public :: med_field_info_esmf_fieldcreate + !----------------------------------------------- ! Types !----------------------------------------------- @@ -48,8 +56,8 @@ module med_field_info_mod contains !================================================================================ - function med_field_info_create(name, ungridded_lbound, ungridded_ubound, rc) result(field_info) - ! Create a single field + function med_field_info_create_directly(name, ungridded_lbound, ungridded_ubound, rc) result(field_info) + ! Create a single field_info object from direct specification of values ! input/output variables character(len=*), intent(in) :: name @@ -64,7 +72,7 @@ function med_field_info_create(name, ungridded_lbound, ungridded_ubound, rc) res ! local variables integer :: n_ungridded - character(len=*), parameter :: subname = '(med_field_info_create)' + character(len=*), parameter :: subname = '(med_field_info_create_directly)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -95,7 +103,69 @@ function med_field_info_create(name, ungridded_lbound, ungridded_ubound, rc) res field_info%n_ungridded = 0 end if - end function med_field_info_create + end function med_field_info_create_directly + + !----------------------------------------------------------------------------- + + function med_field_info_create_from_field(field, name, rc) result(field_info) + ! Create a single field_info object from information in an ESMF_Field + + ! input/output variables + ! We get information other than the name from this ESMF_Field object + type(ESMF_Field), intent(in) :: field + + ! We should be able to get the name from the field, but in all current uses of this + ! function, we already have the name available, so it's easy enough to just pass it in + ! rather than making this function query it again. If future users did not already + ! have the name readily available, we could either change this to optional or remove + ! it entirely and just always get the name from querying the field. + character(len=*), intent(in) :: name + + integer, intent(out) :: rc + type(med_field_info_type) :: field_info ! function result + + ! local variables + logical :: is_present + integer :: n_ungridded + integer, allocatable :: ungridded_lbound(:) + integer, allocatable :: ungridded_ubound(:) + + character(len=*), parameter :: subname = '(med_field_info_create_from_field)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", itemCount=n_ungridded, isPresent=is_present, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. is_present) then + n_ungridded = 0 + end if + + if (n_ungridded == 0) then + field_info = med_field_info_create_directly( & + name=name, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(ungridded_lbound(n_ungridded)) + allocate(ungridded_ubound(n_ungridded)) + call ESMF_AttributeGet(field, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungridded_lbound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungridded_ubound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_info = med_field_info_create_directly( & + name=name, & + ungridded_lbound=ungridded_lbound, & + ungridded_ubound=ungridded_ubound, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(ungridded_lbound) + deallocate(ungridded_ubound) + end if + end function med_field_info_create_from_field !----------------------------------------------------------------------------- @@ -134,7 +204,7 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra is_tracer = wtracers_is_wtracer_field(field_names(i)) if (is_tracer) then ! Field is a water tracer; assume a single ungridded dimension - field_info_array(i) = med_field_info_create( & + field_info_array(i) = med_field_info_create_directly( & name=field_names(i), & ungridded_lbound=[1], & ungridded_ubound=[n_tracers], & @@ -142,7 +212,7 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra if (chkerr(rc,__LINE__,u_FILE_u)) return else ! Not a water tracer; assume no ungridded dimensions - field_info_array(i) = med_field_info_create( & + field_info_array(i) = med_field_info_create_directly( & name=field_names(i), & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -168,10 +238,6 @@ subroutine med_field_info_array_from_state(state, field_info_array, rc) integer :: i, n_fields character(ESMF_MAXSTR), allocatable :: field_names(:) type(ESMF_Field) :: field - logical :: is_present - integer :: n_ungridded - integer, allocatable :: ungridded_lbound(:) - integer, allocatable :: ungridded_ubound(:) character(len=*), parameter :: subname = '(med_field_info_array_from_state)' ! ---------------------------------------------- @@ -188,38 +254,48 @@ subroutine med_field_info_array_from_state(state, field_info_array, rc) call ESMF_StateGet(state, itemName=trim(field_names(i)), field=field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", itemCount=n_ungridded, isPresent=is_present, rc=rc) + field_info_array(i) = med_field_info_create_from_field( & + field=field, & + name=field_names(i), & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (.not. is_present) then - n_ungridded = 0 - end if - - if (n_ungridded == 0) then - field_info_array(i) = med_field_info_create( & - name=field_names(i), & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(ungridded_lbound(n_ungridded)) - allocate(ungridded_ubound(n_ungridded)) - call ESMF_AttributeGet(field, name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", valueList=ungridded_lbound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", valueList=ungridded_ubound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - field_info_array(i) = med_field_info_create( & - name=field_names(i), & - ungridded_lbound=ungridded_lbound, & - ungridded_ubound=ungridded_ubound, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - deallocate(ungridded_lbound) - deallocate(ungridded_ubound) - end if end do end subroutine med_field_info_array_from_state + !----------------------------------------------------------------------------- + + subroutine med_field_info_esmf_fieldcreate(field_info, mesh, meshloc, field, rc) + ! Create an ESMF Field (using ESMF_FieldCreate) based on a field_info object + + ! input/output variables + type(med_field_info_type), intent(in) :: field_info + type(ESMF_Mesh), intent(in) :: mesh + type(ESMF_MeshLoc), intent(in) :: meshloc + type(ESMF_Field), intent(out) :: field + integer, intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname = '(med_field_info_esmf_fieldcreate)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (field_info%n_ungridded > 0) then + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & + name=field_info%name, & + ungriddedLbound=field_info%ungridded_lbound, & + ungriddedUbound=field_info%ungridded_ubound, & + gridToFieldMap=[field_info%n_ungridded+1], & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & + name=field_info%name, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine med_field_info_esmf_fieldcreate + end module med_field_info_mod diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 26dfa773b..f8d98ce3c 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -15,7 +15,7 @@ module med_methods_mod use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : spval_init => med_constants_spval_init use med_utils_mod , only : ChkErr => med_utils_ChkErr - use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_type, med_field_info_esmf_fieldcreate use shr_log_mod , only : shr_log_error implicit none private @@ -237,7 +237,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, field_info_array, FBgeom use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet use ESMF , only : ESMF_State, ESMF_Mesh, ESMF_StaggerLoc, ESMF_MeshLoc use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_FieldBundleAdd, ESMF_FieldCreate - use ESMF , only : ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_EMPTY, ESMF_AttributeGet + use ESMF , only : ESMF_FIELDSTATUS_EMPTY, ESMF_AttributeGet ! input/output variables type(ESMF_FieldBundle), intent(inout) :: FBout ! output field bundle @@ -366,20 +366,8 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, field_info_array, FBgeom end if ! Create the field - if (field_info_array(n)%n_ungridded > 0) then - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & - name=field_info_array(n)%name, & - ungriddedLbound=field_info_array(n)%ungridded_lbound, & - ungriddedUbound=field_info_array(n)%ungridded_ubound, & - gridToFieldMap=[field_info_array(n)%n_ungridded+1], & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & - name=field_info_array(n)%name, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + call med_field_info_esmf_fieldcreate(field_info_array(n), lmesh, meshloc, field, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Add the created field to field bundle FBout if (dbug_flag > 1) then From 7b745ed9f66ab8f92f5d340e7520715eff29d1e0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 29 Jan 2026 11:21:38 -0700 Subject: [PATCH 2/4] Change the mechanism for getting ungridded info from a Field The previous mechanism - using ESMF/NUOPC attributes - doesn't work in a new context where I want to use this routine. From some initial testing, it seems that this new mechanism of querying the Field for its various ungridded variables gives the same result in most cases; the one exception I see is for the cpl_scalars Fields. I'm guessing this will be okay, but I'll do some testing to verify this. --- mediator/med_field_info_mod.F90 | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index ce0406d8c..9f04ccb0f 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -6,9 +6,9 @@ module med_field_info_mod !----------------------------------------------------------------------------- use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet + use ESMF , only : ESMF_Field, ESMF_State, ESMF_StateGet use ESMF , only : ESMF_Mesh, ESMF_MeshLoc - use ESMF , only : ESMF_FieldCreate + use ESMF , only : ESMF_FieldCreate, ESMF_FieldGet use med_utils_mod , only : ChkErr => med_utils_ChkErr use shr_log_mod , only : shr_log_error use wtracers_mod , only : wtracers_is_wtracer_field @@ -125,7 +125,6 @@ function med_field_info_create_from_field(field, name, rc) result(field_info) type(med_field_info_type) :: field_info ! function result ! local variables - logical :: is_present integer :: n_ungridded integer, allocatable :: ungridded_lbound(:) integer, allocatable :: ungridded_ubound(:) @@ -135,12 +134,8 @@ function med_field_info_create_from_field(field, name, rc) result(field_info) rc = ESMF_SUCCESS - call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", itemCount=n_ungridded, isPresent=is_present, rc=rc) + call ESMF_FieldGet(field, ungriddedDimCount=n_ungridded, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (.not. is_present) then - n_ungridded = 0 - end if if (n_ungridded == 0) then field_info = med_field_info_create_directly( & @@ -150,11 +145,8 @@ function med_field_info_create_from_field(field, name, rc) result(field_info) else allocate(ungridded_lbound(n_ungridded)) allocate(ungridded_ubound(n_ungridded)) - call ESMF_AttributeGet(field, name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", valueList=ungridded_lbound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", valueList=ungridded_ubound, rc=rc) + call ESMF_FieldGet(field, & + ungriddedLBound=ungridded_lbound, ungriddedUBound=ungridded_ubound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return field_info = med_field_info_create_directly( & name=name, & From d2e1664b23847e3807a0862fd487f515d0fa058f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 30 Jan 2026 15:43:02 -0700 Subject: [PATCH 3/4] Generalize code in prep_rof to handle fields with ungridded dimensions This will be needed for water tracers. The one piece that is *not* handled yet is the irrigation-specific mapping. --- mediator/med_methods_mod.F90 | 7 +- mediator/med_phases_prep_rof_mod.F90 | 147 +++++++++++---------------- 2 files changed, 67 insertions(+), 87 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index f8d98ce3c..b577b9578 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -708,7 +708,8 @@ end subroutine med_methods_State_reset subroutine med_methods_FB_average(FB, count, rc) ! ---------------------------------------------- - ! Set all fields to zero in FB + ! Divide all fields in FB by count + ! If count is 0, nothing is done ! ---------------------------------------------- use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field @@ -1228,7 +1229,9 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) ! ---------------------------------------------- ! Accumulate common field names from FBin to FBout - ! If copy is passed in and true, the this is a copy + ! + ! If copy is passed in and true, then data is copied from FBin to FBout, overwriting + ! values in FBout, rather than accumulating ! ---------------------------------------------- use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 1f6eeb0ba..fd2ce75e2 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -21,10 +21,13 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset + use med_methods_mod , only : fldbun_accum => med_methods_FB_accum use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d - use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_create_directly, med_field_info_create_from_field + use med_field_info_mod , only : med_field_info_esmf_fieldcreate use perf_mod , only : t_startf, t_stopf use shr_log_mod , only : shr_log_error @@ -63,8 +66,6 @@ module med_phases_prep_rof_mod type(ESMF_FieldBundle), public :: FBlndAccum2rof_l type(ESMF_FieldBundle), public :: FBlndAccum2rof_r - character(len=9) :: fldnames_fr_glc(2) = (/'Fgrg_rofl', 'Fgrg_rofi'/) - character(*) , parameter :: u_FILE_u = & __FILE__ @@ -80,7 +81,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) !--------------------------------------- use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate + use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet, ESMF_FieldBundleAdd use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS @@ -96,9 +97,12 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, nflds + logical :: is_present type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r + type(ESMF_Field) :: lfield_template type(ESMF_Field) :: lfield + type(med_field_info_type) :: field_info type(med_fldList_type), pointer :: fldList type(med_fldList_entry_type), pointer :: fldptr character(len=CS) :: fldname @@ -145,13 +149,47 @@ subroutine med_phases_prep_rof_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(lnd2rof_flds) - lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + ! Determine information about this Field - particularly the sizes of any ungridded + ! dimensions - so that we can create a correctly-sized Field in the accumulation + ! FieldBundles. + call ESMF_FieldBundleGet(is_local%wrap%FBExp(comprof), & + fieldName=lnd2rof_flds(n), & + isPresent=is_present, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (is_present) then + call ESMF_FieldBundleGet(is_local%wrap%FBExp(comprof), & + fieldName=lnd2rof_flds(n), & + field=lfield_template, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_info = med_field_info_create_from_field( & + field=lfield_template, & + name=lnd2rof_flds(n), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! If this Field isn't in FBExp(comprof), then it could probably be left out of + ! the Accumulator FieldBundles. But we're leaving it in there to maintain + ! earlier behavior of the code and avoid the need to determine if it's safe to + ! leave it out. However, in this case, we don't bother determining the sizes of + ! any ungridded dimensions (because it shouldn't matter and we don't have an + ! obvious place to get this information from). + field_info = med_field_info_create_directly( & + name=lnd2rof_flds(n), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + call med_field_info_esmf_fieldcreate(field_info=field_info, & + mesh=mesh_l, meshloc=ESMF_MESHLOC_ELEMENT, & + field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleAdd(FBlndAccum2rof_l, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_l', & ESMF_LOGMSG_INFO) - lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + call med_field_info_esmf_fieldcreate(field_info=field_info, & + mesh=mesh_r, meshloc=ESMF_MESHLOC_ELEMENT, & + field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleAdd(FBlndAccum2rof_r, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -190,11 +228,8 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) ! Mapping from the land to the rof grid is then done with the time averaged fields !------------------------------------ - use NUOPC , only : NUOPC_IsConnected use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FieldBundleGet, ESMF_StateIsCreated, ESMF_StateGet - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_Field, ESMF_FieldGet ! input/output variables type(ESMF_GridComp) :: gcomp @@ -202,12 +237,6 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n - logical :: exists - real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr1d_accum(:) - type(ESMF_Field) :: lfield - type(ESMF_Field) :: lfield_accum character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_accum)' !--------------------------------------- @@ -224,24 +253,8 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Accumulate lnd input on lnd grid for fields that will be sent to rof - do n = 1,size(lnd2rof_flds) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & - isPresent=exists, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (exists) then - call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), & - field=lfield_accum, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & - field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield_accum, dataptr1d_accum, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) - end if - end do + call fldbun_accum(FBout=FBlndAccum2rof_l, FBin=is_local%wrap%FBImp(complnd,complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Accumulate counter lndAccum2rof_cnt = lndAccum2rof_cnt + 1 @@ -267,7 +280,6 @@ subroutine med_phases_prep_rof(gcomp, rc) use NUOPC , only : NUOPC_IsConnected use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use esmFlds , only : med_fldList_GetfldListTo, med_fldList_type use med_map_mod , only : med_map_field_packed @@ -280,12 +292,9 @@ subroutine med_phases_prep_rof(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n,ns,nf + integer :: ns integer :: count - logical :: exists - real(r8), pointer :: dataptr_in(:) real(r8), pointer :: dataptr_out(:) - type(ESMF_Field) :: lfield type(med_fldList_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' !--------------------------------------- @@ -315,23 +324,12 @@ subroutine med_phases_prep_rof(gcomp, rc) write(logunit,'(a)')trim(subname)//'accumulation count for land input averging to river is 0 '// & ' accumulation field is set to zero' end if - end if - - do n = 1,size(lnd2rof_flds) - call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), isPresent=exists, rc=rc) + call fldbun_reset(FB=FBlndAccum2rof_l, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (exists) then - call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr_out, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (count == 0) then - dataptr_out(:) = czero - else - dataptr_out(:) = dataptr_out(:) / real(count, r8) - end if - end if - end do + else + call fldbun_average(FB=FBlndAccum2rof_l, count=count, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if if (dbug_flag > 1) then call fldbun_diagnose(FBlndAccum2rof_l, string=trim(subname)//' FBlndAccum2rof_l after avg ', rc=rc) @@ -385,25 +383,14 @@ subroutine med_phases_prep_rof(gcomp, rc) ! custom merge for glc->rof ! glc->rof is mapped in med_phases_post_glc do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then - do nf = 1,size(fldnames_fr_glc) - if ( fldbun_fldchk(is_local%wrap%FBImp(compglc(ns),comprof), fldnames_fr_glc(nf), rc=rc) .and. & - fldbun_fldchk(is_local%wrap%FBExp(comprof), fldnames_fr_glc(nf), rc=rc) ) then - call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & - trim(fldnames_fr_glc(nf)), dataptr_in, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & - trim(fldnames_fr_glc(nf)), dataptr_out , rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Determine export data - if (ns == 1) then - dataptr_out(:) = dataptr_in(:) - else - dataptr_out(:) = dataptr_out(:) + dataptr_in(:) - end if - end if - end do - end if + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + call fldbun_accum( & + FBout=is_local%wrap%FBExp(comprof), & + FBin=is_local%wrap%FBImp(compglc(ns),comprof), & + copy=(ns==1), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end do ! Check for nans in fields export to rof @@ -424,18 +411,8 @@ subroutine med_phases_prep_rof(gcomp, rc) lndAccum2rof_cnt = 0 ! zero lnd2rof fields in FBlndAccum2rof_l - do n = 1,size(lnd2rof_flds) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & - isPresent=exists, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (exists) then - call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr_out, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr_out(:) = czero - end if - end do + call fldbun_reset(FBlndAccum2rof_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From b25b2947135327adef0a3d0868fb57de70d40249 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 5 Feb 2026 15:19:27 -0700 Subject: [PATCH 4/4] Add an explanatory comment. --- mediator/med_phases_prep_rof_mod.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index fd2ce75e2..e39fcb2aa 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -384,6 +384,16 @@ subroutine med_phases_prep_rof(gcomp, rc) ! glc->rof is mapped in med_phases_post_glc do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + ! This fldbun_accum call is used to sum the inputs from each ice sheet - so it + ! is an accumulation in space (as opposed to the accumulation in time done in + ! med_phases_prep_rof_accum). This accumulation acts over all of the fields that + ! are common to FBExp(comprof) and FBImp(compglc(ns),comprof), which is the set + ! of fields sent from glc to rof. Note that the 'copy' argument is set to true + ! for the first loop iteration and false for subsequent loop iterations; this + ! serves to initialize the export field bundle in the first loop iteration + ! (simply copying the import fields to the export) and then iteratively + ! accumulating the imports from the other ice sheets in subsequent loop + ! iterations. call fldbun_accum( & FBout=is_local%wrap%FBExp(comprof), & FBin=is_local%wrap%FBImp(compglc(ns),comprof), &