diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 67d650aded..938f6bdfda 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -122,6 +122,8 @@ module MOM_cap_mod character(len=64) :: stdname character(len=64) :: shortname character(len=64) :: transferOffer + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type integer,parameter :: fldsMax = 100 @@ -2091,25 +2093,43 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) if (present(grid)) then - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0.0 + if (field_defs(i)%ungridded_lbound > 0 .and. field_defs(i)%ungridded_ubound > 0) then + call ESMF_LogWrite(trim(subname)//": ERROR ungridded dimensions not supported in MOM6 nuopc cap when "//& + "ESMF_GEOMTYPE_GRID is used. Use ESMF_GEOMTYPE_MESH instead.", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + else + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0.0 + endif else if (present(mesh)) then - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0.0 + if (field_defs(i)%ungridded_lbound > 0 .and. field_defs(i)%ungridded_ubound > 0) then + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, ungriddedLbound=(/field_defs(i)%ungridded_lbound/), & + ungriddedUbound=(/field_defs(i)%ungridded_ubound/), gridToFieldMap=(/2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0.0 + else + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0.0 + endif endif @@ -2166,12 +2186,14 @@ end subroutine MOM_RealizeFields !=============================================================================== !> Set up list of field information -subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) +subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname, ungridded_lbound, ungridded_ubound) integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname character(len=*), intent(in) :: transferOffer character(len=*), optional, intent(in) :: shortname + integer, optional, intent(in) :: ungridded_lbound + integer, optional, intent(in) :: ungridded_ubound ! local variables integer :: rc @@ -2193,6 +2215,10 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) fldlist(num)%shortname = trim(stdname) endif fldlist(num)%transferOffer = trim(transferOffer) + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound + end if end subroutine fld_list_add diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 index bb9743bb84..f0f0c1ee46 100644 --- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 @@ -32,7 +32,11 @@ module MOM_cap_methods public :: state_diagnose public :: ChkErr -private :: State_getImport +interface State_getImport + module procedure State_getImport_2d + module procedure State_getImport_3d ! third dimension being an ungridded dimension +end interface + private :: State_setExport !> Get field pointer @@ -648,8 +652,8 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_2d -!> Map import state field to output array -subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, areacor, rc) +!> Map 2d import state field to output array +subroutine State_GetImport_2d(state, fldname, isc, iec, jsc, jec, output, do_sum, areacor, rc) type(ESMF_State) , intent(in) :: state !< ESMF state character(len=*) , intent(in) :: fldname !< Field name integer , intent(in) :: isc !< The start i-index of cell centers within @@ -672,7 +676,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport)' + character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport_2d)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -731,7 +735,80 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a endif -end subroutine State_GetImport +end subroutine State_GetImport_2d + +!> Map 3d import state field to output array (where 3rd dim is an ungridded dimension) +subroutine State_GetImport_3d(state, fldname, isc, iec, jsc, jec, lbd, ubd, output, do_sum, areacor, rc) + type(ESMF_State) , intent(in) :: state !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + integer , intent(in) :: isc !< The start i-index of cell centers within + !! the computational domain + integer , intent(in) :: iec !< The end i-index of cell centers within the + !! computational domain + integer , intent(in) :: jsc !< The start j-index of cell centers within + !! the computational domain + integer , intent(in) :: jec !< The end j-index of cell centers within + !! the computational domain + integer , intent(in) :: lbd !< lower bound of ungridded dimension + integer , intent(in) :: ubd !< upper bound of ungridded dimension + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec,lbd:ubd)!< Output 3D array + logical, optional , intent(in) :: do_sum !< If true, sums the data + real (ESMF_KIND_R8), optional, intent(in) :: areacor(:) !< flux area correction factors + !! applicable to meshes + integer , intent(out) :: rc !< Return code + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: n, i, j, i1, j1, u + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport_3d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine output array and apply area correction if present + do u = lbd, ubd ! ungridded dims + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + if (present(areacor)) then + output(i,j,u) = output(i,j,u) + dataPtr2d(u,n) * areacor(n) + else + output(i,j,u) = output(i,j,u) + dataPtr2d(u,n) + end if + else + if (present(areacor)) then + output(i,j,u) = dataPtr2d(u,n) * areacor(n) + else + output(i,j,u) = dataPtr2d(u,n) + end if + endif + enddo + enddo + enddo + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_LogWrite(trim(subname)//": ERROR ungridded dimensions not supported in MOM6 nuopc cap when "// & + "ESMF_GEOMTYPE_GRID is used. Use ESMF_GEOMTYPE_MESH instead.", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + endif + +end subroutine State_GetImport_3d !> Map input array to export state subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, areacor, rc)