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 retrieval and writing of dststatus fields #517

Merged
merged 1 commit into from
Dec 9, 2024
Merged

update retrieval and writing of dststatus fields #517

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
145 changes: 140 additions & 5 deletions mediator/med.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 = &
Expand Down Expand Up @@ -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
!---------------------------------------
Expand Down Expand Up @@ -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)
Expand Down
15 changes: 10 additions & 5 deletions mediator/med_internalstate_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down
Loading
Loading