diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index f25b024cd..203b1923d 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -102,10 +102,8 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r integer :: lrank integer :: fieldCount integer :: ungriddedCount - integer :: gridToFieldMapCount integer :: ungriddedLBound(1) integer :: ungriddedUBound(1) - integer :: gridToFieldMap(1) real(R8), pointer :: dataptr1d(:) real(R8), pointer :: dataptr2d(:,:) character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) @@ -165,16 +163,13 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r return end if - ! set ungridded dimensions and GridToFieldMap for field + ! set ungridded dimensions for field call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedLBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & purpose="Instance", valueList=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", valueList=gridToFieldMap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return ! get 2d pointer for field call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) @@ -183,7 +178,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r ! create new field with an ungridded dimension newfield = ESMF_FieldCreate(lmesh, dataptr2d, ESMF_INDEX_DELOCAL, & meshloc=meshloc, name=lfieldNameList(n), & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=gridtoFieldMap, rc=rc) + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (lrank == 1) then @@ -256,10 +251,9 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc integer :: ungriddedCount + integer :: ungriddedCount_in integer, allocatable :: ungriddedLBound(:) integer, allocatable :: ungriddedUBound(:) - integer :: gridToFieldMapCount - integer, allocatable :: gridToFieldMap(:) logical :: isPresent character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) character(len=*), parameter :: subname='(med_methods_FB_init)' @@ -359,7 +353,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S call ESMF_StateGet(STgeom, itemNameList=lfieldNameList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STgeom", ESMF_LOGMSG_INFO) end if else call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", & @@ -376,7 +370,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. & trim(lfieldnamelist(n)) == '') then do n1 = n, fieldCount-1 - lfieldnamelist(n1) = lfieldnamelist(n1+1) + lfieldnamelist(n1) = lfieldnamelist(n1+1) enddo fieldCount = fieldCount - 1 endif @@ -445,7 +439,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! ungridded dimensions might be present in the input states or field bundles if (present(FBflds)) then - call med_methods_FB_getFieldN(FBflds, n, lfield, rc=rc) + call ESMF_FieldBundleGet(FBflds, fieldName=lfieldnamelist(n), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (present(STflds)) then call med_methods_State_getNameN(STflds, n, lname, rc) @@ -455,10 +449,14 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S end if ! Determine ungridded lower and upper bounds for lfield - ungriddedCount=0 ! initialize in case it was not set - call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount_in, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + ungriddedCount = ungriddedCount_in + else + ungriddedCount=0 ! initialize in case it was not set + end if ! Create the field on a lmesh if (ungriddedCount > 0) then @@ -471,20 +469,11 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S purpose="Instance", valueList=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(gridToFieldMap(gridToFieldMapCount)) - call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", valueList=gridToFieldMap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, & - gridToFieldMap=gridToFieldMap) + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/)) if (chkerr(rc,__LINE__,u_FILE_u)) return - deallocate( ungriddedLbound, ungriddedUbound, gridToFieldMap) + deallocate( ungriddedLbound, ungriddedUbound) else ! No ungridded dimensions in field field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7cfc6fc89..f98ece233 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -896,7 +896,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then call med_methods_FB_init(avgfile%FBaccum_import, scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBimp(compid,compid), rc=rc) + STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_import, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -905,7 +905,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then call med_methods_FB_init(avgfile%FBaccum_export, scalar_name, & - FBgeom=is_local%wrap%FBExp(compid), FBflds=is_local%wrap%FBexp(compid), rc=rc) + STgeom=is_local%wrap%NStateExp(compid), STflds=is_local%wrap%NStateExp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_export, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1021,6 +1021,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! ----------------------------- use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove + use ESMF , only : ESMF_Field, ESMF_FieldGet !DEBUG use med_constants_mod, only : czero => med_constants_czero use med_io_mod , only : med_io_write_time, med_io_define_time use med_methods_mod , only : med_methods_FB_init @@ -1166,7 +1167,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(auxcomp%files(nfcnt)%FBaccum)) then call med_methods_FB_init(auxcomp%files(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBImp(compid,compid), rc=rc) + STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nfcnt)%FBaccum, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1257,12 +1259,6 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Write time sample to file if ( write_now ) then - ! Determine time_val and tbnds data for history as well as history file name - call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & - time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & - auxname=auxcomp%files(nf)%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set shorthand variables nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) @@ -1270,8 +1266,21 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Increment number of time samples on file auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 + ! Determine time_val and tbnds data for history as well as history file name + if (auxcomp%files(nf)%nt == 1) then + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & + auxname=auxcomp%files(nf)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! Write header if (auxcomp%files(nf)%nt == 1) then + ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1313,6 +1322,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Close file if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 @@ -1406,30 +1417,48 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) integer :: n type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum + integer :: fieldCount_accum + character(CL), pointer :: fieldnames_accum(:) integer :: fieldCount character(CL), pointer :: fieldnames(:) real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: dataptr1d_accum(:) real(r8), pointer :: dataptr2d_accum(:,:) + integer :: ungriddedUBound_accum(1) integer :: ungriddedUBound(1) + character(len=64) :: msg !--------------------------------------- rc = ESMF_SUCCESS - ! Accumulate field - call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount, rc=rc) + ! Loop over field names in fldbun_accum + + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(fieldnames(fieldCount)) - call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames, rc=rc) + allocate(fieldnames_accum(fieldCount_accum)) + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, fieldcount - call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames(n)), field=lfield_accum, rc=rc) + call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldcount_accum + call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames_accum(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames_accum(n)), field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, ungriddedUBound=ungriddedUBound_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (ungriddedUBound(1) /= ungriddedUBound_accum(1)) then + call ESMF_LogWrite(" upper bounds for field and field_accum do not match", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + end if + if (ungriddedUBound(1) > 0) then call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1444,7 +1473,7 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) end if end do - deallocate(fieldnames) + deallocate(fieldnames_accum) ! Accumulate counter count = count + 1