diff --git a/mediator/med.F90 b/mediator/med.F90 index 914e35ada..89cc2f917 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -42,7 +42,7 @@ module MED use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc - use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite + use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite, write_dststatus use esmFlds , only : med_fldList_GetocnalbfldList, med_fldList_type use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging @@ -58,14 +58,15 @@ module MED public SetServices public SetVM private InitializeP0 - private AdvertiseFields ! advertise fields + private AdvertiseFields ! advertise fields private RealizeFieldsWithTransferProvided ! realize connected Fields with transfer action "provide" - private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh - private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" - private DataInitialize ! finish initialization and resolve data dependencies + private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh + private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" + private DataInitialize ! finish initialization and resolve data dependencies private SetRunClock private med_meshinfo_create private med_grid_write + private med_dststatus_write private med_finalize character(len=*), parameter :: u_FILE_u = & @@ -2177,6 +2178,14 @@ subroutine DataInitialize(gcomp, rc) call med_diag_zero(mode='all', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + ! write dstStatus fields if requested + !--------------------------------------- + if (write_dststatus) then + call med_dststatus_write(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !--------------------------------------- ! read mediator restarts !--------------------------------------- @@ -2563,6 +2572,132 @@ subroutine med_grid_write(grid, fileName, rc) end subroutine med_grid_write + !----------------------------------------------------------------------------- + subroutine med_dststatus_write (gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS, ESMF_VM + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy + use ESMF , only : ESMF_FieldBundleAdd, ESMF_Array, ESMF_Field, ESMF_MeshGet + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy + use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_TYPEKIND_I4 + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite + use NUOPC , only : NUOPC_CompAttributeGet + use med_kind_mod , only : I4=>SHR_KIND_I4, R8=>SHR_KIND_R8 + use med_internalstate_mod , only : ncomps, compname + use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close + use pio , only : file_desc_t + use med_methods_mod , only : med_methods_FB_getFieldN + + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(file_desc_t) :: io_file + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: mesh_dst + type(ESMF_Field) :: flddst, lfield + type(ESMF_Field) :: maskfield + type(ESMF_Array) :: maskarray + integer(I4), pointer :: meshmask(:) + real(R8), pointer :: r8ptr(:) + integer :: m,n1,n2 + character(CL) :: case_name, dststatusfile + logical :: elementMaskIsPresent + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + character(len=*), parameter :: subname = '('//__FILE__//':med_dststatus_write)' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create dststatus file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + dststatusfile = trim(case_name)//'.dststatus.nc' + + ! add mesh masks for any destination component in the dststatusFB + do n2 = 2,ncomps + if (is_local%wrap%comp_present(n2)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call med_methods_FB_getFieldN(is_local%wrap%FBdststatus(n2), 1, flddst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(flddst, mesh=mesh_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh_dst, elementMaskIsPresent=elementMaskIsPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (elementMaskIsPresent) then + maskfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! get mask Array + call ESMF_FieldGet(maskfield, array=maskarray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_dst, elemMaskArray=maskarray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(maskfield, localDe=0, farrayPtr=meshmask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! now create an R8 mask for writing + lfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(compname(n2))//'mask', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=r8ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + r8ptr = real(meshmask,R8) + call ESMF_FieldBundleAdd(is_local%wrap%FBdststatus(n2), (/lfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(maskfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + end do + + ! write the FB + call med_io_wopen(trim(dststatusfile), io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over whead/wdata phases + do m = 1,2 + if (m == 2) then + call med_io_enddef(io_file) + end if + + ! write dststatusfields for each dst component + do n2 = 2,ncomps + if (is_local%wrap%comp_present(n2)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call med_io_write(io_file, is_local%wrap%FBdststatus(n2), whead(m), wdata(m), & + is_local%wrap%nx(n2), is_local%wrap%ny(n2), pre='dst'//trim(compname(n2)), & + use_float=.true., ntile=is_local%wrap%ntile(n2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + end do + end do ! do m = 1,2 + ! Close file + call med_io_close(io_file, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Destroy the dststatus FBs + do n2 = 2,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call ESMF_FieldBundleDestroy(is_local%wrap%FBdststatus(n2), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_dststatus_write + !----------------------------------------------------------------------------- subroutine med_finalize(gcomp, rc) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index d09903be5..6f7c49f73 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -106,7 +106,7 @@ module med_internalstate_mod type(ESMF_Field) :: field_fracdst end type packed_data_type - logical, public :: dststatus_print = .false. + logical, public :: write_dststatus = .false. ! Mesh info type, public :: mesh_info_type @@ -189,6 +189,8 @@ module med_internalstate_mod ! Data type(ESMF_FieldBundle) , pointer :: FBData(:) ! Background data for various components, on their grid, provided by CDEPS inline + ! DstStatus + type(ESMF_FieldBundle) , pointer :: FBDstStatus(:) ! DstStatus fields for components for each source component and maptype ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid @@ -429,12 +431,15 @@ subroutine med_internalstate_init(gcomp, rc) write(logunit,*) end if - ! Obtain dststatus_print setting if present - call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! Allocate dststatus FB if needed + call NUOPC_CompAttributeGet(gcomp, name='write_dststatus', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) dststatus_print=(trim(cvalue) == "true") - write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print + if (isPresent .and. isSet) write_dststatus=(trim(cvalue) == "true") + write(msgString,*) trim(subname)//': Mediator write_dststatus is ',write_dststatus call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + if (write_dststatus) then + allocate(is_local%wrap%FBDstStatus(ncomps)) + end if ! Initialize flag for background fill using data is_local%wrap%med_data_active(:,:) = .false. diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 3d888bcfa..6282ddc3e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -78,14 +78,15 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleCreate - use ESMF , only : ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleAdd use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_TYPEKIND_I4, ESMF_FieldIsCreated use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN use med_constants_mod , only : czero => med_constants_czero use esmFlds , only : med_fldList_GetfldListFr, med_fldlist_type use esmFlds , only : med_fld_GetFldInfo, med_fldList_entry_type - use med_internalstate_mod , only : mapunset, compname + use med_internalstate_mod , only : mapunset, compname, write_dststatus use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables @@ -98,6 +99,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(InternalState) :: is_local type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst + type(ESMF_Field) :: dstatfield integer :: n1,n2 integer :: nf integer :: fieldCount @@ -155,9 +157,10 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun else call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + end if + - ! Loop over fields + ! Loop over fields fldListFr => med_fldList_getFldListFr(n1) fldptr => fldListFr%fields nf = 0 @@ -169,21 +172,31 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! determine if route handle has already been created mapexists = med_map_RH_is_created(is_local%wrap%RH,n1,n2,mapindex,rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Create route handle for target mapindex if route handle is required ! (i.e. mapindex /= mapunset) and route handle has not already been created if (.not. mapexists) then call med_fld_GetFldInfo(fldptr, compsrc=n2, mapfile=mapfile) call med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, & - mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), rc=rc) + mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), & + dstatfield=dstatfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + ! Save the FBdststatus fields + if (write_dststatus) then + if (mapindex /= mapfcopy) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBDststatus(n2), rc=rc)) then + is_local%wrap%FBDstStatus(n2) = ESMF_FieldBundleCreate(name='dstStatus'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldBundleAdd(is_local%wrap%FBDststatus(n2), (/dstatfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if end if ! end if mapindex is mapunset 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 @@ -263,7 +276,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun //trim(mapnames(mapindex)) end if end if - end do ! end of loop over map_indiex mappers + end do ! end of loop over map_index mappers end if ! end of if block for creating destination field end do ! end of loop over n2 @@ -331,7 +344,8 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin end subroutine med_map_routehandles_initfrom_fieldbundle !================================================================================ - subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, mapfile, rc) + subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, & + mapfile, dstatfield, rc) use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE @@ -343,13 +357,13 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use ESMF , only : ESMF_EXTRAPMETHOD_NEAREST_STOD use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_I4 use ESMF , only : ESMF_MeshGet, ESMF_DistGridGet, ESMF_DistGrid, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldWrite, ESMF_FieldDestroy + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm - use med_internalstate_mod , only : coupling_mode, dststatus_print + use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -361,21 +375,21 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer , intent(in) :: mapindex type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) character(len=*), optional , intent(in) :: mapfile + type(ESMF_Field), optional , intent(out) :: dstatfield integer , intent(out) :: rc ! local variables - type(ESMF_Mesh) :: dstmesh - type(ESMF_Field) :: dststatusfield, doffield - type(ESMF_DistGrid) :: distgrid + type(ESMF_Mesh) :: mesh_dst + type(ESMF_Field) :: lfield character(len=CS) :: string character(len=CS) :: mapname - character(len=CL) :: fname + character(len=CS) :: dstatname integer :: srcMaskValue integer :: dstMaskValue + real(R8), pointer :: r8ptr(:) + integer(I4), pointer :: i4ptr(:) character(len=ESMF_MAXSTR) :: lmapfile - logical :: rhprint = .false., ldstprint = .false. - integer :: ns - integer(I4), pointer :: dof(:) + logical :: rhprint = .false. integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag) :: polemethod character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' @@ -390,12 +404,11 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(subname)//": mapname "//trim(mapname), ESMF_LOGMSG_INFO) ! create a field to retrieve the dststatus field - call ESMF_FieldGet(flddst, mesh=dstmesh, rc=rc) + dstatname = trim(compname(n1))//'_'//trim(compname(n2))//'_'//mapname + call ESMF_FieldGet(flddst, mesh=mesh_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dststatusfield = ESMF_FieldCreate(dstmesh, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + lfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(dstatname), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! set local flag to false - ldstprint = .false. ! set src and dst masking using defaults srcMaskValue = defaultMasks(n1,1) @@ -466,10 +479,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. end if else if (mapindex == mapfillv_bilnr) then if (maintask) then @@ -482,10 +494,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapbilnr_nstod) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -498,10 +509,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -513,11 +523,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapconsf_aofrac) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then if (maintask) then @@ -530,11 +539,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else ! Copy existing consf RH if (maintask) then @@ -554,11 +562,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_DSTAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then if (maintask) then @@ -571,10 +578,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. end if else if (maintask) then @@ -586,31 +592,6 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, return end if - ! Output destination status field to file if requested - if (dststatus_print .and. ldstprint) then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & - overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the sequence index in order to sort the dststatus field - call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(dof(ns)) - call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & - overwrite=.true., rc=rc) - deallocate(dof) - call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) - end if - ! consd_nstod method requires a second routehandle if (mapindex == mapnstod .or. mapindex == mapnstod_consd .or. mapindex == mapnstod_consf) then call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapnstod), & @@ -619,20 +600,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. - - ! Output destination status field to file if requested - if (dststatus_print .and. ldstprint) then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'_2.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if end if ! Output route handle to file if requested @@ -644,7 +615,19 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return endif - call ESMF_FieldDestroy(dststatusfield, rc=rc, noGarbage=.true.) + ! Copy R8 values into a returned field + if (present(dstatfield)) then + dstatfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(dstatname), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=i4ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(dstatfield, farrayPtr=r8ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + r8ptr = real(i4ptr,R8) + call ESMF_FieldDestroy(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end subroutine med_map_routehandles_initfrom_field