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

allow tiled history files on regional grid #112

Closed
wants to merge 5 commits into from
Closed

allow tiled history files on regional grid #112

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
4127636
fix dummy arguments w/o values
DeniseWorthen Jan 31, 2024
320517f
allow single tiled history files if requested
DeniseWorthen Feb 5, 2024
fa78b46
Merge branch 'NOAA-EMC:emc/develop' into feature/nowarn
DeniseWorthen Feb 5, 2024
9aaaf61
Merge branch 'feature/nowarn' into feature/tiledhistory
DeniseWorthen Feb 5, 2024
8370c00
allow tiled history for single history file
DeniseWorthen Feb 27, 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
12 changes: 6 additions & 6 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 capabilty
!------------------

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 @@ -962,7 +962,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 +1067,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 @@ -1832,7 +1832,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
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
4 changes: 2 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 Down Expand Up @@ -601,7 +601,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
28 changes: 14 additions & 14 deletions mediator/med_io_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
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) :: tilesize(3) ! if first element is non-zero, write component history on tiles
integer , intent(out):: rc

! local variables
Expand Down Expand Up @@ -770,7 +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
logical :: comptiles
integer :: ntiles = 1
character(CL), allocatable :: fieldNameList(:)
character(*),parameter :: subName = '(med_io_write_FB) '
Expand All @@ -785,9 +785,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.
comptiles = .false.
if (present(tilesize)) then
if (tilesize > 0) atmtiles = .true.
if (tilesize(1) > 0) comptiles = .true.
end if

! Error check
Expand Down Expand Up @@ -870,14 +870,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)
if (comptiles) then
ntiles = tilesize(1)
lnx = tilesize(2)
lny = tilesize(3)
write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles
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 (ntiles*lnx*lny /= ng) then
call ESMF_LogWrite(trim(subname)//' ERROR: component tile sizes are not consistent ', ESMF_LOGMSG_INFO)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
else
Expand All @@ -900,7 +900,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &

! Write header
if (whead) then
if (atmtiles) then
if (comptiles) 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))
Expand Down Expand Up @@ -1020,7 +1020,7 @@ 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
if (comptiles) then
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntiles/), dof, iodesc)
else
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
Expand Down Expand Up @@ -1579,8 +1579,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
102 changes: 51 additions & 51 deletions mediator/med_map_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -408,7 +408,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex,
dstMaskValue = ispval_mask
endif
end if
if (trim(coupling_mode(1:3)) == 'ufs') then
if (coupling_mode(1:3) == 'ufs') then
if (n1 == compatm .and. n2 == complnd) then
srcMaskValue = ispval_mask
dstMaskValue = ispval_mask
Expand All @@ -424,7 +424,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex,
call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO)

polemethod=ESMF_POLEMETHOD_ALLAVG
if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode(1:3)) == 'ufs') then
if (trim(coupling_mode) == 'cesm' .or. coupling_mode(1:3) == 'ufs') then
if (n1 == compwav .or. n2 == compwav) then
polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place.
endif
Expand Down Expand Up @@ -949,7 +949,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_
type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source
type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types
type(ESMF_RouteHandle) , intent(inout) :: routehandles(:)
type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle
type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle
logical, optional , intent(in) :: use_data ! skip mapping and use data instead
integer, optional , intent(out) :: rc

Expand Down Expand Up @@ -1008,7 +1008,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_
allocate(field_namelist_dat(fieldcount_dat))
call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

if (present(use_data)) skip_mapping = use_data
end if
end if
Expand Down Expand Up @@ -1072,7 +1072,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_
call t_stopf('MED:'//trim(subname)//' copy from src')

! -----------------------------------
! Fill destination field with background data provided by CDEPS inline
! Fill destination field with background data provided by CDEPS inline
! -----------------------------------

if (fieldcount_dat > 0) then
Expand All @@ -1085,52 +1085,52 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_
! Get the indices into the packed data structure
np = packed_data(mapindex)%fldindex(nf)
if (np > 0) then
! Get size of ungridded dimension and name of the field
call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill."

! Check if field has match in data fields
isFound = .false.
do nfd = 1, fieldcount_dat
! Debug output for checked fields to find match
if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd))

if (trim(field_name) == trim(field_namelist_dat(nfd))) then
! Debug output about match
if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!"
! Get pointer from data field
call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (dbug_flag > 1) then
call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if

! Fill destination field with background data coming from stream
dataptr2d_packed(np,:) = dataptr(:)

if (dbug_flag > 1) then
call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if

! Exit from loop since match is already found
isFound = .true.
exit
end if
end do ! loop for stream fields

! Could not find match in the list of stream fields
if (.not. isFound) then
if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!"

! Fill destination field with very large background data
dataptr2d_packed(np,:) = fillValue
end if
! Get size of ungridded dimension and name of the field
call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill."

! Check if field has match in data fields
isFound = .false.
do nfd = 1, fieldcount_dat
! Debug output for checked fields to find match
if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd))

if (trim(field_name) == trim(field_namelist_dat(nfd))) then
! Debug output about match
if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!"

! Get pointer from data field
call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (dbug_flag > 1) then
call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if

! Fill destination field with background data coming from stream
dataptr2d_packed(np,:) = dataptr(:)

if (dbug_flag > 1) then
call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if

! Exit from loop since match is already found
isFound = .true.
exit
end if
end do ! loop for stream fields

! Could not find match in the list of stream fields
if (.not. isFound) then
if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!"

! Fill destination field with very large background data
dataptr2d_packed(np,:) = fillValue
end if
end if
end do ! loop for destination fields

Expand Down
Loading