Skip to content

Commit

Permalink
Merge pull request ESCOMP#317 from mvertens/feature/fix_auxhist
Browse files Browse the repository at this point in the history 
fixes for auxhist output
  • Loading branch information
@jedwards4b
jedwards4b authored Nov 2, 2022
2 parents ff8726f + 76306f6 commit fa2ac92
Show file tree
Hide file tree
Showing 2 changed files with 62 additions and 44 deletions.
41 changes: 15 additions & 26 deletions mediator/med_methods_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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(:)
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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)'
Expand Down Expand Up @@ -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", &
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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)
Expand Down
65 changes: 47 additions & 18 deletions mediator/med_phases_history_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -1257,21 +1259,28 @@ 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)

! 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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit fa2ac92

Please sign in to comment.