Skip to content

Add index to cpl_scalars to allow CSG or regional (single tile) mediator history files for ATM component in UFS #436

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

Merged
jedwards4b merged 11 commits into from
Mar 19, 2024
Merged

Add index to cpl_scalars to allow CSG or regional (single tile) mediator history files for ATM component in UFS #436

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
4127636
fix dummy arguments w/o values
DeniseWorthen Jan 31, 2024
8cd4a32
Update ccpp-physics in CMEPS to consider sea surface ocean current in…
binli2337 Feb 1, 2024
624920d
Update CMEPS (#110)
uturuncoglu Feb 5, 2024
fa78b46
Merge branch 'NOAA-EMC:emc/develop' into feature/nowarn
DeniseWorthen Feb 5, 2024
14878f4
add cpl_scalar for tiled grids, other minor fixes
DeniseWorthen Mar 3, 2024
91cc86e
Merge remote-tracking branch 'ESCOMP/main' into feature/cplscalars
DeniseWorthen Mar 3, 2024
f8fb572
Merge remote-tracking branch 'origin/feature/nowarn' into feature/cpl…
DeniseWorthen Mar 3, 2024
3515360
set ntile=0 when ntile scalar doesn't exist
DeniseWorthen Mar 3, 2024
ac5520f
fix restarts when ntile>0
DeniseWorthen Mar 4, 2024
45d63c4
add two fixes
DeniseWorthen Mar 13, 2024
8309884
modify dstmask for lnd->atm in UFS
DeniseWorthen Mar 13, 2024
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
40 changes: 30 additions & 10 deletions mediator/med.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc)

#ifdef CDEPS_INLINE
!------------------
! phase routine for cdeps inline capabilty
! phase routine for cdeps inline capability
!------------------

call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, &
Expand Down Expand Up @@ -832,10 +832,10 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc)
if (trim(coupling_mode) == 'cesm') then
call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else if (trim(coupling_mode(1:3)) == 'ufs') then
else if (coupling_mode(1:3) == 'ufs') then
call esmFldsExchange_ufs(gcomp, phase='advertise', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else if (trim(coupling_mode(1:4)) == 'hafs') then
else if (coupling_mode(1:4) == 'hafs') then
call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
Expand Down Expand Up @@ -867,13 +867,22 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
read(cvalue,*) is_local%wrap%flds_scalar_index_ny

call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNTile", value=cvalue, &
isPresent=isPresent, isSet=isSet,rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) is_local%wrap%flds_scalar_index_ntile
else
is_local%wrap%flds_scalar_index_ntile = 0
end if

call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, &
isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) is_local%wrap%flds_scalar_index_nextsw_cday
else
is_local%wrap%flds_scalar_index_nextsw_cday = spval
is_local%wrap%flds_scalar_index_nextsw_cday = 0
end if

call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxPrecipFactor", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
Expand Down Expand Up @@ -962,7 +971,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc)
endif
if (maintask) then
write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp)
endif
endif
end if
end do

Expand Down Expand Up @@ -1067,7 +1076,7 @@ subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

!------------------
! Recieve Grids
! Receive Grids
!------------------

do n1 = 1,ncomps
Expand Down Expand Up @@ -1644,7 +1653,7 @@ subroutine DataInitialize(gcomp, rc)
logical :: read_restart
logical :: allDone = .false.
logical,save :: first_call = .true.
real(r8) :: real_nx, real_ny
real(r8) :: real_nx, real_ny, real_ntile
character(len=CX) :: msgString
character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)'
!-----------------------------------------------------------
Expand Down Expand Up @@ -1832,7 +1841,7 @@ subroutine DataInitialize(gcomp, rc)
if (trim(coupling_mode) == 'cesm') then
call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else if (trim(coupling_mode(1:3)) == 'ufs') then
else if (coupling_mode(1:3) == 'ufs') then
call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else if (coupling_mode(1:4) == 'hafs') then
Expand Down Expand Up @@ -2128,11 +2137,22 @@ subroutine DataInitialize(gcomp, rc)
flds_scalar_name=is_local%wrap%flds_scalar_name, &
flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (is_local%wrap%flds_scalar_index_ntile > 0) then
call State_GetScalar(scalar_value=real_ntile, &
scalar_id=is_local%wrap%flds_scalar_index_ntile, &
state=is_local%wrap%NstateImp(n1), &
flds_scalar_name=is_local%wrap%flds_scalar_name, &
flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
is_local%wrap%ntile(n1) = nint(real_ntile)
else
is_local%wrap%ntile(n1) = 0
end if
is_local%wrap%nx(n1) = nint(real_nx)
is_local%wrap%ny(n1) = nint(real_ny)
write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1)
write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1)
if (maintask) then
write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString)
write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString)
end if
call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO)
end if
Expand Down
6 changes: 3 additions & 3 deletions mediator/med_fraction_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -293,7 +293,7 @@ subroutine med_fraction_init(gcomp, rc)
! If ice and atm are on the same mesh - a redist route handle has already been created
maptype = mapfcopy
else
if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then
if (coupling_mode(1:9) == 'ufs.nfrac' ) then
maptype = mapnstod_consd
else
maptype = mapconsd
Expand Down Expand Up @@ -345,7 +345,7 @@ subroutine med_fraction_init(gcomp, rc)
! If ocn and atm are on the same mesh - a redist route handle has already been created
maptype = mapfcopy
else
if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then
if (coupling_mode(1:9) == 'ufs.nfrac' ) then
maptype = mapnstod_consd
else
maptype = mapconsd
Expand Down Expand Up @@ -756,7 +756,7 @@ subroutine med_fraction_set(gcomp, rc)

call t_startf('MED:'//trim(subname)//' fbfrac(compatm)')
! Determine maptype
if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then
if (coupling_mode(1:9) == 'ufs.nfrac' ) then
maptype = mapnstod_consd
else
if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then
Expand Down
8 changes: 6 additions & 2 deletions mediator/med_internalstate_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -121,7 +121,7 @@ module med_internalstate_mod
! Present/allowed coupling/active coupling logical flags
logical, pointer :: comp_present(:) ! comp present flag
logical, pointer :: med_coupling_active(:,:) ! computes the active coupling
logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill
logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill
logical, pointer :: med_data_force_first(:) ! force to use stream data for first coupling timestep
integer :: num_icesheets ! obtained from attribute
logical :: ocn2glc_coupling = .false. ! obtained from attribute
Expand All @@ -133,12 +133,15 @@ module med_internalstate_mod

! Global nx,ny dimensions of input arrays (needed for mediator history output)
integer, pointer :: nx(:), ny(:)
! Number of nx*ny domains (needed for cubed-sphere and regional domains)
integer, pointer :: ntile(:)

! Import/Export Scalars
character(len=CL) :: flds_scalar_name = ''
integer :: flds_scalar_num = 0
integer :: flds_scalar_index_nx = 0
integer :: flds_scalar_index_ny = 0
integer :: flds_scalar_index_ntile = 0
integer :: flds_scalar_index_nextsw_cday = 0
integer :: flds_scalar_index_precip_factor = 0
real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn
Expand Down Expand Up @@ -312,6 +315,7 @@ subroutine med_internalstate_init(gcomp, rc)
allocate(is_local%wrap%med_data_force_first(ncomps))
allocate(is_local%wrap%nx(ncomps))
allocate(is_local%wrap%ny(ncomps))
allocate(is_local%wrap%ntile(ncomps))
allocate(is_local%wrap%NStateImp(ncomps))
allocate(is_local%wrap%NStateExp(ncomps))
allocate(is_local%wrap%FBImp(ncomps,ncomps))
Expand Down Expand Up @@ -601,7 +605,7 @@ subroutine med_internalstate_defaultmasks(gcomp, rc)
if (is_local%wrap%comp_present(compocn)) defaultMasks(compocn,:) = 0
if (is_local%wrap%comp_present(compice)) defaultMasks(compice,:) = 0
if (is_local%wrap%comp_present(compwav)) defaultMasks(compwav,:) = 0
if ( trim(coupling_mode(1:3)) == 'ufs') then
if ( coupling_mode(1:3) == 'ufs') then
if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1
endif
if ( trim(coupling_mode) == 'hafs') then
Expand Down
41 changes: 20 additions & 21 deletions mediator/med_io_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -698,7 +698,7 @@ end function med_io_sec2hms

!===============================================================================
subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
fillval, pre, flds, tavg, use_float, tilesize, rc)
fillval, pre, flds, tavg, use_float, ntile, rc)

!---------------
! Write FB to netcdf file
Expand Down Expand Up @@ -728,7 +728,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out
logical, optional , intent(in) :: tavg ! is this a tavg
logical, optional , intent(in) :: use_float ! write output as float rather than double
integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles
integer, optional , intent(in) :: ntile ! number of nx * ny tiles
integer , intent(out):: rc

! local variables
Expand All @@ -754,7 +754,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
character(CS) :: coordvarnames(2) ! coordinate variable names
character(CS) :: coordnames(2) ! coordinate long names
character(CS) :: coordunits(2) ! coordinate units
integer :: lnx,lny
integer :: lnx,lny,lntile
logical :: luse_float
real(r8) :: lfillvalue
integer, pointer :: minIndexPTile(:,:)
Expand All @@ -770,8 +770,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
integer :: rank
integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields
integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields
logical :: atmtiles
integer :: ntiles = 1
logical :: tiles
character(CL), allocatable :: fieldNameList(:)
character(*),parameter :: subName = '(med_io_write_FB) '
!-------------------------------------------------------------------------------
Expand All @@ -785,9 +784,9 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
luse_float = .false.
if (present(use_float)) luse_float = use_float

atmtiles = .false.
if (present(tilesize)) then
if (tilesize > 0) atmtiles = .true.
tiles = .false.
if (present(ntile)) then
if (ntile > 0) tiles = .true.
end if

! Error check
Expand Down Expand Up @@ -870,14 +869,14 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
! all the global grid values in the distgrid - e.g. CTSM

ng = maxval(maxIndexPTile)
if (atmtiles) then
lnx = tilesize
lny = tilesize
ntiles = ng/(lnx*lny)
write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles
if (tiles) then
lnx = nx
lny = ny
lntile = ng/(lnx*lny)
write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
if (ntiles /= 6) then
call ESMF_LogWrite(trim(subname)//' ERROR: only cubed sphere atm tiles valid ', ESMF_LOGMSG_INFO)
if (lntile /= ntile) then
call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
else
Expand All @@ -900,10 +899,10 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &

! Write header
if (whead) then
if (atmtiles) then
if (tiles) then
rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1))
rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2))
rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3))
rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3))
if (present(nt)) then
dimid4(1:3) = dimid3
rcode = pio_inq_dimid(io_file, 'time', dimid4(4))
Expand Down Expand Up @@ -1020,8 +1019,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc)
write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof)
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
if (atmtiles) then
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntiles/), dof, iodesc)
if (tiles) then
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc)
else
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
!call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom)
Expand Down Expand Up @@ -1579,8 +1578,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc)
allocate(fldptr1_tmp(lsize))

do n = 1,ungriddedUBound(1)
! Creat a name for the 1d field on the mediator history or restart file based on the
! ungridded dimension index of the field bundle 2d fiedl
! Create a name for the 1d field on the mediator history or restart file based on the
! ungridded dimension index of the field bundle 2d field
write(cnumber,'(i0)') n
name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber)

Expand Down
Loading