diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90
index 54e20ea18..bcb3d5471 100644
--- a/mediator/esmFlds.F90
+++ b/mediator/esmFlds.F90
@@ -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
@@ -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
@@ -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)
@@ -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
!================================================================================
@@ -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
!================================================================================
@@ -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
!================================================================================
@@ -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
!================================================================================
@@ -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)
@@ -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
@@ -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
@@ -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)
@@ -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
!================================================================================
@@ -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
!================================================================================
@@ -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
!================================================================================
@@ -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
!================================================================================
@@ -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)'
! ----------------------------------------------
@@ -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
@@ -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))
@@ -770,7 +771,7 @@ integer function med_fldList_GetNumFlds(fldList)
endif
newfld => newfld%next
end do
-
+
end function med_fldList_GetNumFlds
!================================================================================
@@ -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))
@@ -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)
diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90
index ae3627491..6ebd49e0f 100644
--- a/mediator/esmFldsExchange_cesm_mod.F90
+++ b/mediator/esmFldsExchange_cesm_mod.F90
@@ -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')
diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90
index f37a9c898..f93739618 100644
--- a/mediator/esmFldsExchange_nems_mod.F90
+++ b/mediator/esmFldsExchange_nems_mod.F90
@@ -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
diff --git a/mediator/med.F90 b/mediator/med.F90
index acbd28948..79a43a4c9 100644
--- a/mediator/med.F90
+++ b/mediator/med.F90
@@ -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))
diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90
index 6bd9a4663..69d1891fb 100644
--- a/mediator/med_io_mod.F90
+++ b/mediator/med_io_mod.F90
@@ -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
@@ -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)
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)
diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90
index 1e1808357..18752dc2f 100644
--- a/mediator/med_map_mod.F90
+++ b/mediator/med_map_mod.F90
@@ -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
@@ -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
diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90
index fc2d5c965..f09c9311d 100644
--- a/mediator/med_merge_mod.F90
+++ b/mediator/med_merge_mod.F90
@@ -122,7 +122,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f
else if (.not. coupling_active(compsrc)) then
CYCLE
end if
-
+
! Determine the merge information for the import field
call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
@@ -269,7 +269,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo,
! Determine merge field name from source field
call merge_listGetName(merge_fields, nm, merge_field, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
-
+
! Initialize initial output field data to zero before doing merge
if (zero_output) then
if (ungriddedUBound_out(1) > 0) then
@@ -283,12 +283,12 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo,
end if
zero_output = .false.
end if
-
+
! Perform merge
call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, &
FB=FBIn, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
-
+
end do ! end of nm loop
end if ! end of check of merge_type and merge_field not unset
end if ! end of check if stdname and fldname are the same