Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

update esmFldsExchange_nems for ungridded wave fields; fix incorrect units in mediator files #338

Merged
merged 4 commits into from
Jan 12, 2023
Merged

update esmFldsExchange_nems for ungridded wave fields; fix incorrect units in mediator files #338

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
7cb0874
use ungridded dimensions for stokes drift exchange; update to latest …
DeniseWorthen Jan 4, 2023
6de45f3
Merge remote-tracking branch 'escomp/main' into feature/updcmeps
DeniseWorthen Jan 10, 2023
bb86899
remove unused variables, add fix for coord units
DeniseWorthen Jan 10, 2023
5824c8c
Merge remote-tracking branch 'escomp/main' into feature/updcmeps
DeniseWorthen Jan 12, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
43 changes: 22 additions & 21 deletions mediator/esmFlds.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ module esmflds

public :: med_fldList_addfld_aoflux
public :: med_fldList_addmap_aoflux

private :: med_fldList_AddFld
private :: med_fldList_AddMap
private :: med_fldList_AddMrg
Expand Down Expand Up @@ -93,7 +93,7 @@ subroutine med_fldlist_init1(ncomps)
end subroutine med_fldlist_init1

!================================================================================

function med_fldList_GetaofluxFldList() result(fldList)
! Return a pointer to the aoflux fldlist
type(med_fldList_type), pointer :: fldList
Expand Down Expand Up @@ -129,7 +129,7 @@ function med_fldList_GetFldListTo(index) result(fldList)

fldList => fldListTo(index)
end function Med_FldList_GetFldListTo

!================================================================================

subroutine med_fldList_addfld_from(index, stdname, shortname)
Expand All @@ -139,7 +139,7 @@ subroutine med_fldList_addfld_from(index, stdname, shortname)
character(len=*) , intent(in) , optional :: shortname

call med_fldList_AddFld(FldListFr(index)%fields, stdname, shortname)

end subroutine med_fldList_addfld_from

!================================================================================
Expand All @@ -150,7 +150,7 @@ subroutine med_fldList_addfld_aoflux(stdname, shortname)
character(len=*) , intent(in) , optional :: shortname

call med_fldList_AddFld(fldlist_aoflux%fields, stdname, shortname)

end subroutine med_fldList_addfld_aoflux

!================================================================================
Expand All @@ -160,7 +160,7 @@ subroutine med_fldList_addfld_ocnalb(stdname, shortname)
character(len=*) , intent(in) , optional :: shortname

call med_fldList_AddFld(fldlist_ocnalb%fields, stdname, shortname)

end subroutine med_fldList_addfld_ocnalb

!================================================================================
Expand All @@ -171,7 +171,7 @@ subroutine med_fldList_addfld_to(index, stdname, shortname)
character(len=*) , intent(in) , optional :: shortname

call med_fldList_AddFld(FldListTo(index)%fields, stdname, shortname)

end subroutine med_fldList_addfld_to

!================================================================================
Expand Down Expand Up @@ -220,7 +220,7 @@ subroutine med_fldList_AddFld(fields, stdname, shortname)
type(med_fldList_entry_type), pointer :: newfld
character(len=*), parameter :: subname='(med_fldList_AddFld)'
! ----------------------------------------------

call med_fldList_findName(fields, stdname, found, newfld)
! create new entry if fldname is not in original list
mapsize = size(fldListTo)
Expand Down Expand Up @@ -293,13 +293,13 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr
character(len=*) , intent(in) :: mrg_fld
character(len=*) , intent(in) :: mrg_type
character(len=*) , intent(in), optional :: mrg_fracname

! local variables
integer :: rc
type(med_fldList_entry_type), pointer :: newfld
character(len=*), parameter :: subname='(med_fldList_AddMrg)'
! ----------------------------------------------

newfld => med_fldList_GetFld(flds, fldname, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
newfld%merge_fields(mrg_from) = mrg_fld
Expand All @@ -315,7 +315,7 @@ end subroutine med_fldList_AddMrg
function med_fldList_GetFld(fields, fldname, rc) result(newfld)
use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO
use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT


type(med_fldList_entry_type) , intent(in), target :: fields
character(len=*) , intent(in) :: fldname
Expand All @@ -324,7 +324,7 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld)
logical :: found
integer :: rc
character(len=*), parameter :: subname='(med_fldList_GetFld)'


call med_fldList_findName(fields, fldname, found, newfld)

Expand All @@ -339,7 +339,7 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld)
call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_ERROR)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif

end function med_fldList_GetFld

!================================================================================
Expand All @@ -353,7 +353,7 @@ subroutine med_fldList_addmap_from(index, fldname, destcomp, maptype, mapnorm, m
character(len=*), optional , intent(in) :: mapfile

call med_fldList_AddMap(FldListFr(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile)

end subroutine med_fldList_addmap_from

!================================================================================
Expand All @@ -366,7 +366,7 @@ subroutine med_fldList_addmap_aoflux(fldname, destcomp, maptype, mapnorm, mapfil
character(len=*), optional , intent(in) :: mapfile

call med_fldList_AddMap(fldlist_aoflux%fields, fldname, destcomp, maptype, mapnorm, mapfile)

end subroutine med_fldList_addmap_aoflux

!================================================================================
Expand All @@ -379,7 +379,7 @@ subroutine med_fldList_addmap_ocnalb(fldname, destcomp, maptype, mapnorm, mapfil
character(len=*), optional , intent(in) :: mapfile

call med_fldList_AddMap(fldlist_ocnalb%fields, fldname, destcomp, maptype, mapnorm, mapfile)

end subroutine med_fldList_addmap_ocnalb

!================================================================================
Expand All @@ -399,6 +399,7 @@ subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfi
! local variables
type(med_fldList_entry_type), pointer :: newfld
integer :: rc

character(len=CX) :: lmapfile
character(len=*),parameter :: subname='(med_fldList_AddMap)'
! ----------------------------------------------
Expand Down Expand Up @@ -700,7 +701,7 @@ subroutine med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, map
character(len=*) , optional, intent(out) :: merge_type
character(len=*) , optional, intent(out) :: merge_fracname
integer , optional, intent(out) :: rc

! local variables
integer :: lrc
integer :: lcompsrc
Expand Down Expand Up @@ -761,7 +762,7 @@ integer function med_fldList_GetNumFlds(fldList)
type(med_fldList_type), intent(in), target :: fldList
! ----------------------------------------------
type(med_fldList_entry_type), pointer :: newfld

newfld => fldList%fields
med_fldList_GetNumFlds = 0
do while(associated(newfld))
Expand All @@ -770,7 +771,7 @@ integer function med_fldList_GetNumFlds(fldList)
endif
newfld => newfld%next
end do

end function med_fldList_GetNumFlds

!================================================================================
Expand Down Expand Up @@ -874,7 +875,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active)
if ( mapindex /= mapunset) then
call med_fld_GetFldInfo(newfld, stdname=fldname, compsrc=ndst, mapnorm=mapnorm, mapfile=mapfile, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (trim(mapnorm) == 'unset') then
cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // &
' via '// trim(mapnames(mapindex))
Expand Down Expand Up @@ -936,7 +937,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active)
do while(associated(newfld))
call med_fld_GetFldInfo(newfld, stdname=dst_field, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

! Loop over all possible source components for destination component field
mrgstr = ' '
do nsrc = 1,size(fldListFr)
Expand Down
2 changes: 1 addition & 1 deletion mediator/esmFldsExchange_cesm_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2305,7 +2305,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc)
end if
end if
!-----------------------------
! to ocn: Stokes drift depth from wave
! to ocn: Partitioned stokes drift components in y-direction
!-----------------------------
if (phase == 'advertise') then
call addfld_from(compwav, 'Sw_pstokes_y')
Expand Down
5 changes: 2 additions & 3 deletions mediator/esmFldsExchange_nems_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -560,9 +560,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
deallocate(flds)

! to ocn: partitioned stokes drift from wav
allocate(flds(6))
flds = (/'Sw_ustokes1', 'Sw_ustokes2', 'Sw_ustokes3', &
'Sw_vstokes1', 'Sw_vstokes2', 'Sw_vstokes3'/)
allocate(flds(2))
flds = (/'Sw_pstokes_x', 'Sw_pstokes_y'/)
do n = 1,size(flds)
fldname = trim(flds(n))
if (phase == 'advertise') then
Expand Down
2 changes: 1 addition & 1 deletion mediator/med.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -891,7 +891,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc)
call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO)
fld => fld%next
end do

fldListTo => med_fldList_GetFldListTo(ncomp)
fld => fldListTo%fields
do while(associated(fld))
Expand Down
64 changes: 37 additions & 27 deletions mediator/med_io_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -435,7 +435,7 @@ subroutine med_io_init(gcomp, rc)
else
pio_rearr_comm_enable_isend_comp2io = .false.
end if

! pio_rearr_comm_max_pend_req_comp2io
call NUOPC_CompAttributeGet(gcomp, name='pio_rearr_comm_max_pend_req_comp2io', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
Expand Down Expand Up @@ -576,7 +576,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url)
if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then
nmode = ior(nmode,pio_ioformat)
endif

rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode)
if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename)
rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version)
Expand Down Expand Up @@ -753,10 +753,12 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
! Write FB to netcdf file
!---------------

use ESMF, only : operator(==)
use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT
use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid
use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet
use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet
use ESMF , only : ESMF_CoordSys_Flag, ESMF_COORDSYS_SPH_DEG, ESMF_COORDSYS_SPH_RAD, ESMF_COORDSYS_CART
use pio , only : var_desc_t, io_desc_t, pio_offset_kind
use pio , only : pio_def_dim, pio_inq_dimid, pio_real, pio_def_var, pio_put_att, pio_double
use pio , only : pio_inq_varid, pio_setframe, pio_write_darray, pio_initdecomp, pio_freedecomp
Expand All @@ -783,6 +785,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
type(ESMF_Field) :: field
type(ESMF_Mesh) :: mesh
type(ESMF_Distgrid) :: distgrid
type(ESMF_CoordSys_Flag) :: coordsys
integer :: rcode
integer :: nf,ns,ng
integer :: k,n
Expand All @@ -798,6 +801,9 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
character(CL) :: name1 ! var name
character(CL) :: cunit ! var units
character(CL) :: lpre ! local prefix
character(CS) :: coordvarnames(2) ! coordinate variable names
character(CS) :: coordnames(2) ! coordinate long names
character(CS) :: coordunits(2) ! coordinate units
integer :: lnx,lny
logical :: luse_float
real(r8) :: lfillvalue
Expand Down Expand Up @@ -873,12 +879,25 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
if (chkerr(rc,__LINE__,u_FILE_u)) return

! Get mesh distgrid and number of elements
call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc)
call ESMF_MeshGet(mesh, elementDistgrid=distgrid, coordSys=coordsys, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_MeshGet(mesh, spatialDim=ndims, numOwnedElements=nelements, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
write(tmpstr,*) subname, 'ndims, nelements = ', ndims, nelements
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
! Define coordinate attributes according to CoordSys
if (coordsys == ESMF_COORDSYS_CART) then
coordvarnames(1) = trim(lpre)//'_x'
coordvarnames(2) = trim(lpre)//'_y'
coordnames = (/'x-coordinate', 'y-coordinate'/)
coordunits = (/'unitless','unitless'/)
else
coordvarnames(1) = trim(lpre)//'_lon'
coordvarnames(2) = trim(lpre)//'_lat'
coordnames = (/'longitude', 'latitude '/)
if (coordsys == ESMF_COORDSYS_SPH_DEG) coordunits = (/'degrees_E', 'degrees_N'/)
if (coordsys == ESMF_COORDSYS_SPH_RAD) coordunits = (/'radians ', 'radians '/)
end if

! Set element coordinates
if (.not. allocated(ownedElemCoords) .and. ndims > 0 .and. nelements > 0) then
Expand Down Expand Up @@ -1034,25 +1053,16 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
end do

! Add coordinate information to file
name1 = trim(lpre)//'_lon'
if (luse_float) then
rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid)
else
rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid)
end if
rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "longitude")
rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_east")
rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "longitude")

name1 = trim(lpre)//'_lat'
if (luse_float) then
rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid)
else
rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid)
end if
rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "latitude")
rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_north")
rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "latitude")
do n = 1,ndims
if (luse_float) then
rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid)
else
rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid)
end if
rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n)))
rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n)))
rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n)))
end do
end if

if (wdata) then
Expand All @@ -1078,7 +1088,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
else
itemc = trim(fieldNameList(k))
end if

call FB_getFldPtr(FB, itemc, &
fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
Expand Down Expand Up @@ -1119,19 +1129,19 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
end do ! end loop over fields in FB

! Fill coordinate variables - why is this being done each time?
name1 = trim(lpre)//'_lon'
rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid)
rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid)
call pio_setframe(io_file(lfile_ind),varid,frame)
call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue)

name1 = trim(lpre)//'_lat'
rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid)
rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid)
call pio_setframe(io_file(lfile_ind),varid,frame)
call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue)

call pio_syncfile(io_file(lfile_ind))
call pio_freedecomp(io_file(lfile_ind), iodesc)
endif
deallocate(fieldNameList)
deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y)

if (dbug_flag > 5) then
call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO)
Expand Down
4 changes: 2 additions & 2 deletions mediator/med_map_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -183,7 +183,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun
fldptr => fldptr%next
end do ! loop over fields


end if ! if coupling active
end if ! if n1 not equal to n2
end do ! loop over n2
Expand Down Expand Up @@ -664,7 +664,7 @@ end function med_map_RH_is_created_RH3d

!================================================================================

logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc)
logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc)

use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated
use med_internalstate_mod , only : mapconsd, mapconsf, mapnstod
Expand Down
Loading