diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 197f0a1b..9f04ccb0 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_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet + use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_Field, ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Mesh, ESMF_MeshLoc + 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 @@ -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,61 @@ 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 + 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_FieldGet(field, ungriddedDimCount=n_ungridded, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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_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, & + 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 +196,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 +204,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 +230,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 +246,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 26dfa773..b577b957 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 @@ -720,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 @@ -1240,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 1f6eeb0b..e39fcb2a 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,24 @@ 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 + ! 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), & + 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 +421,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)