Skip to content

Commit e1f50a2

Browse files
DeniseWorthenDeniseWorthen
committed
update retrieval and writing of dststatus fields
* create a FB to hold the returned dststatus fields * write all dststatus fields into one file via med_io_write_FB in med.F90 if requested * add mask to the FBdststatus
1 parent 63a4a31 commit e1f50a2

File tree

3 files changed

+207
-84
lines changed

3 files changed

+207
-84
lines changed

‎mediator/med.F90

Lines changed: 140 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ module MED
4242
use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask
4343
use med_internalstate_mod , only : ncomps, compname
4444
use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc
45-
use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite
45+
use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite, write_dststatus
4646
use esmFlds , only : med_fldList_GetocnalbfldList, med_fldList_type
4747
use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo
4848
use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging
@@ -58,14 +58,15 @@ module MED
5858
public SetServices
5959
public SetVM
6060
private InitializeP0
61-
private AdvertiseFields ! advertise fields
61+
private AdvertiseFields ! advertise fields
6262
private RealizeFieldsWithTransferProvided ! realize connected Fields with transfer action "provide"
63-
private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh
64-
private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept"
65-
private DataInitialize ! finish initialization and resolve data dependencies
63+
private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh
64+
private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept"
65+
private DataInitialize ! finish initialization and resolve data dependencies
6666
private SetRunClock
6767
private med_meshinfo_create
6868
private med_grid_write
69+
private med_dststatus_write
6970
private med_finalize
7071

7172
character(len=*), parameter :: u_FILE_u = &
@@ -2177,6 +2178,14 @@ subroutine DataInitialize(gcomp, rc)
21772178
call med_diag_zero(mode='all', rc=rc)
21782179
if (ChkErr(rc,__LINE__,u_FILE_u)) return
21792180

2181+
!---------------------------------------
2182+
! write dstStatus fields if requested
2183+
!---------------------------------------
2184+
if (write_dststatus) then
2185+
call med_dststatus_write(gcomp, rc)
2186+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2187+
end if
2188+
21802189
!---------------------------------------
21812190
! read mediator restarts
21822191
!---------------------------------------
@@ -2563,6 +2572,132 @@ subroutine med_grid_write(grid, fileName, rc)
25632572

25642573
end subroutine med_grid_write
25652574

2575+
!-----------------------------------------------------------------------------
2576+
subroutine med_dststatus_write (gcomp, rc)
2577+
2578+
use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS, ESMF_VM
2579+
use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy
2580+
use ESMF , only : ESMF_FieldBundleAdd, ESMF_Array, ESMF_Field, ESMF_MeshGet
2581+
use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy
2582+
use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_TYPEKIND_I4
2583+
use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite
2584+
use NUOPC , only : NUOPC_CompAttributeGet
2585+
use med_kind_mod , only : I4=>SHR_KIND_I4, R8=>SHR_KIND_R8
2586+
use med_internalstate_mod , only : ncomps, compname
2587+
use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close
2588+
use pio , only : file_desc_t
2589+
use med_methods_mod , only : med_methods_FB_getFieldN
2590+
2591+
2592+
! input/output variables
2593+
type(ESMF_GridComp) :: gcomp
2594+
integer, intent(out) :: rc
2595+
2596+
! local variables
2597+
type(file_desc_t) :: io_file
2598+
type(InternalState) :: is_local
2599+
type(ESMF_VM) :: vm
2600+
type(ESMF_Mesh) :: mesh_dst
2601+
type(ESMF_Field) :: flddst, lfield
2602+
type(ESMF_Field) :: maskfield
2603+
type(ESMF_Array) :: maskarray
2604+
integer(I4), pointer :: meshmask(:)
2605+
real(R8), pointer :: r8ptr(:)
2606+
integer :: m,n1,n2
2607+
character(CL) :: case_name, dststatusfile
2608+
logical :: elementMaskIsPresent
2609+
logical :: whead(2) = (/.true. , .false./)
2610+
logical :: wdata(2) = (/.false., .true. /)
2611+
character(len=*), parameter :: subname = '('//__FILE__//':med_dststatus_write)'
2612+
!-------------------------------------------------------------------------------
2613+
2614+
rc = ESMF_SUCCESS
2615+
2616+
! Get the internal state
2617+
nullify(is_local%wrap)
2618+
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)
2619+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2620+
2621+
! Create dststatus file
2622+
call ESMF_GridCompGet(gcomp, vm=vm, rc=rc)
2623+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2624+
call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc)
2625+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2626+
dststatusfile = trim(case_name)//'.dststatus.nc'
2627+
2628+
! add mesh masks for any destination component in the dststatusFB
2629+
do n2 = 2,ncomps
2630+
if (is_local%wrap%comp_present(n2)) then
2631+
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then
2632+
call med_methods_FB_getFieldN(is_local%wrap%FBdststatus(n2), 1, flddst, rc=rc)
2633+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2634+
call ESMF_FieldGet(flddst, mesh=mesh_dst, rc=rc)
2635+
if (chkerr(rc,__LINE__,u_FILE_u)) return
2636+
2637+
call ESMF_MeshGet(mesh_dst, elementMaskIsPresent=elementMaskIsPresent, rc=rc)
2638+
if (chkerr(rc,__LINE__,u_FILE_u)) return
2639+
if (elementMaskIsPresent) then
2640+
maskfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
2641+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2642+
! get mask Array
2643+
call ESMF_FieldGet(maskfield, array=maskarray, rc=rc)
2644+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2645+
call ESMF_MeshGet(mesh_dst, elemMaskArray=maskarray, rc=rc)
2646+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2647+
call ESMF_FieldGet(maskfield, localDe=0, farrayPtr=meshmask, rc=rc)
2648+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2649+
! now create an R8 mask for writing
2650+
lfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, &
2651+
name=trim(compname(n2))//'mask', rc=rc)
2652+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2653+
call ESMF_FieldGet(lfield, farrayPtr=r8ptr, rc=rc)
2654+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2655+
r8ptr = real(meshmask,R8)
2656+
call ESMF_FieldBundleAdd(is_local%wrap%FBdststatus(n2), (/lfield/), rc=rc)
2657+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2658+
call ESMF_FieldDestroy(maskfield, rc=rc)
2659+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2660+
end if
2661+
end if
2662+
end if
2663+
end do
2664+
2665+
! write the FB
2666+
call med_io_wopen(trim(dststatusfile), io_file, vm, rc, clobber=.true.)
2667+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2668+
2669+
! Loop over whead/wdata phases
2670+
do m = 1,2
2671+
if (m == 2) then
2672+
call med_io_enddef(io_file)
2673+
end if
2674+
2675+
! write dststatusfields for each dst component
2676+
do n2 = 2,ncomps
2677+
if (is_local%wrap%comp_present(n2)) then
2678+
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then
2679+
call med_io_write(io_file, is_local%wrap%FBdststatus(n2), whead(m), wdata(m), &
2680+
is_local%wrap%nx(n2), is_local%wrap%ny(n2), pre='dst'//trim(compname(n2)), &
2681+
use_float=.true., ntile=is_local%wrap%ntile(n2), rc=rc)
2682+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2683+
endif
2684+
end if
2685+
end do
2686+
end do ! do m = 1,2
2687+
! Close file
2688+
call med_io_close(io_file, rc=rc)
2689+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
2690+
2691+
! Destroy the dststatus FBs
2692+
do n2 = 2,ncomps
2693+
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then
2694+
call ESMF_FieldBundleDestroy(is_local%wrap%FBdststatus(n2), rc=rc)
2695+
if (chkerr(rc,__LINE__,u_FILE_u)) return
2696+
end if
2697+
end do
2698+
2699+
end subroutine med_dststatus_write
2700+
25662701
!-----------------------------------------------------------------------------
25672702

25682703
subroutine med_finalize(gcomp, rc)

‎mediator/med_internalstate_mod.F90

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,7 @@ module med_internalstate_mod
106106
type(ESMF_Field) :: field_fracdst
107107
end type packed_data_type
108108

109-
logical, public :: dststatus_print = .false.
109+
logical, public :: write_dststatus = .false.
110110

111111
! Mesh info
112112
type, public :: mesh_info_type
@@ -189,6 +189,8 @@ module med_internalstate_mod
189189

190190
! Data
191191
type(ESMF_FieldBundle) , pointer :: FBData(:) ! Background data for various components, on their grid, provided by CDEPS inline
192+
! DstStatus
193+
type(ESMF_FieldBundle) , pointer :: FBDstStatus(:) ! DstStatus fields for components for each source component and maptype
192194

193195
! Accumulators for export field bundles
194196
type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid
@@ -429,12 +431,15 @@ subroutine med_internalstate_init(gcomp, rc)
429431
write(logunit,*)
430432
end if
431433

432-
! Obtain dststatus_print setting if present
433-
call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
434+
! Allocate dststatus FB if needed
435+
call NUOPC_CompAttributeGet(gcomp, name='write_dststatus', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
434436
if (ChkErr(rc,__LINE__,u_FILE_u)) return
435-
if (isPresent .and. isSet) dststatus_print=(trim(cvalue) == "true")
436-
write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print
437+
if (isPresent .and. isSet) write_dststatus=(trim(cvalue) == "true")
438+
write(msgString,*) trim(subname)//': Mediator write_dststatus is ',write_dststatus
437439
call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO)
440+
if (write_dststatus) then
441+
allocate(is_local%wrap%FBDstStatus(ncomps))
442+
end if
438443

439444
! Initialize flag for background fill using data
440445
is_local%wrap%med_data_active(:,:) = .false.

0 commit comments

Comments
 (0)