Skip to content

Commit

Permalink
replace couple_slow with nml field
Browse files Browse the repository at this point in the history 
* use nml setting to list additional fields needed and then
write those additional fields if required. Still no b4b on
slow-couple loop
* verified that current dev/ufs-weather-model does restart repro in
slow loop if restart contains va,mapsta and ice only
  • Loading branch information
@DeniseWorthen
DeniseWorthen committed Sep 20, 2024
1 parent 0ad634c commit 610606b
Show file tree
Hide file tree
Showing 4 changed files with 131 additions and 103 deletions.
54 changes: 30 additions & 24 deletions model/src/w3odatmd.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -558,30 +558,36 @@ MODULE W3ODATMD
LOGICAL, POINTER :: FLFORM, FLCOMB, O6INIT
INTEGER, POINTER :: PTMETH ! C. Bunney; Partitioning method
REAL, POINTER :: PTFCUT ! C. Bunney; Part. 5 freq cut
character(len=8) :: runtype = '' !< @public the run type (startup,branch,continue)
character(len=256) :: initfile = '' !< @public name of wave initial condition file
!! if runtype is startup or branch run, then initfile is used
character(len=512) :: user_histfname = '' !< @public user history filename prefix, timestring
!! YYYY-MM-DD-SSSSS will be appended
character(len=512) :: user_restfname = '' !< @public user restart filename prefix, timestring
!! YYYY-MM-DD-SSSSS will be appended
logical :: histwr = .false. !< @public logical to trigger history write
!! if true => write history file (snapshot)
logical :: rstwr = .false. !< @public logical to trigger restart write
!! if true => write restart
logical :: use_historync = .false. !< @public logical flag to use netCDF for gridded
!! field output
logical :: use_restartnc = .false. !< @public logical flag to read and write netCDF restarts
logical :: restart_from_binary = .false. !< @public logical flag for restarting from binary restart
! when use_restartnc is true
logical :: logfile_is_assigned = .false. !< @public logical flag for assignment of nds(1) to specified
!! log file in mesh cap
logical :: verboselog = .true. !< @public logical flag to enable verbose WW3 native logging
logical :: couple_slow = .false. !< @public logical flag to indicate slow loop coupling, which
!! requires ice to be written to the restart file
character(len= 36) :: time_origin = '' !< @public the time_origin used for netCDF output
character(len= 36) :: calendar_name = '' !< @public the calendar used for netCDF output
integer(kind=8) :: elapsed_secs = 0 !< @public the time in seconds from the time_origin

character(len=8) :: runtype = '' !< @public the run type (startup,branch,continue)
character(len=256) :: initfile = '' !< @public name of wave initial condition file
!! if runtype is startup or branch run, then initfile is used
character(len=512) :: user_histfname = '' !< @public user history filename prefix, timestring
!! YYYY-MM-DD-SSSSS will be appended
character(len=512) :: user_restfname = '' !< @public user restart filename prefix, timestring
!! YYYY-MM-DD-SSSSS will be appended
logical :: histwr = .false. !< @public logical to trigger history write
!! if true => write history file (snapshot)
logical :: rstwr = .false. !< @public logical to trigger restart write
!! if true => write restart
logical :: use_historync = .false. !< @public logical flag to use netCDF for gridded
!! field output
logical :: use_restartnc = .false. !< @public logical flag to read and write netCDF restarts
logical :: restart_from_binary = .false. !< @public logical flag for restarting from binary restart
! when use_restartnc is true
logical :: logfile_is_assigned = .false. !< @public logical flag for assignment of nds(1) to specified
!! log file in mesh cap
logical :: verboselog = .true. !< @public logical flag to enable verbose WW3 native logging
logical :: addrstflds = .false. !< @public logical flag for additional restart fields
integer :: rstfldcnt = 0 !< @public the actual number of additional restart fields
character(len=10), dimension(10) :: rstfldlist = '' !< @public a list of additional fields for the restart fields,
!! currently set to a maximum of 10. Additional restart fields
!! are required only when waves are in the slow loop and ice
!! is present. Note that waves should not be in the slow loop
!! if coupling to CICE is set
character(len=36) :: time_origin = '' !< @public the time_origin used for netCDF output
character(len=36) :: calendar_name = '' !< @public the calendar used for netCDF output
integer(kind=8) :: elapsed_secs = 0 !< @public the time in seconds from the time_origin
!/
CONTAINS
!/ ------------------------------------------------------------------- /
Expand Down
42 changes: 23 additions & 19 deletions model/src/wav_comp_nuopc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -601,7 +601,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
runtype = "branch"
end if
if ( root_task ) then
write(stdout,'(a)') 'WW3 runtype is '//trim(runtype)
write(stdout,'(a)') ' WW3 runtype is '//trim(runtype)
end if
call ESMF_LogWrite('WW3 runtype is '//trim(runtype), ESMF_LOGMSG_INFO)

Expand Down Expand Up @@ -676,7 +676,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
call stme21 ( time0 , dtme21 )
if ( root_task ) then
write (stdout,'(a)')' Starting time : '//trim(dtme21)
write (stdout,'(a,i8,2x,i8)') 'start_ymd, stop_ymd = ',start_ymd, stop_ymd
write (stdout,'(a,i8,2x,i8)') ' start_ymd, stop_ymd = ',start_ymd, stop_ymd
end if
#ifndef W3_CESMCOUPLED
stime = time0
Expand Down Expand Up @@ -1674,9 +1674,10 @@ subroutine waveinit_ufs( gcomp, stdout, ntrace, mpi_comm, mds, rc)

! Initialize ww3 for ufs (called from InitializeRealize)

use w3odatmd , only : fnmpre, couple_slow
use w3odatmd , only : fnmpre, addrstflds, rstfldlist, rstfldcnt
use w3gdatmd , only : dtcfl, dtcfli, dtmax, dtmin
use w3initmd , only : w3init
use w3servmd , only : strsplit
use w3timemd , only : set_user_timestring
use wav_shel_inp , only : read_shel_config
use wav_shel_inp , only : npts, odat, iprt, x, y, pnames, prtfrm
Expand All @@ -1694,7 +1695,10 @@ subroutine waveinit_ufs( gcomp, stdout, ntrace, mpi_comm, mds, rc)
logical :: isPresent, isSet
character(len=CL) :: cvalue
character(len=CL) :: logmsg
character(len=CL) :: fldrst = ''
character(len=100) :: tmplist(100) = ''
integer :: dt_in(4)
integer :: i, cnt
character(len=*), parameter :: subname = '(wav_comp_nuopc:wavinit_ufs)'
! -------------------------------------------------------------------

Expand All @@ -1703,7 +1707,7 @@ subroutine waveinit_ufs( gcomp, stdout, ntrace, mpi_comm, mds, rc)

fnmpre = './'
if (root_task) write(stdout,'(a)') trim(subname)//' call read_shel_config'
call read_shel_config(mpi_comm, mds, time0_overwrite=time0, timen_overwrite=timen)
call read_shel_config(mpi_comm, mds, time0_overwrite=time0, timen_overwrite=timen, rstfldlist=fldrst)

call ESMF_LogWrite(trim(subname)//' call w3init', ESMF_LOGMSG_INFO)
call w3init ( 1, .false., 'ww3', mds, ntrace, odat, flgrd, flgr2, flgd, flg2, &
Expand All @@ -1723,25 +1727,25 @@ subroutine waveinit_ufs( gcomp, stdout, ntrace, mpi_comm, mds, rc)
dtcfli = real(dt_in(3),4)
dtmin = real(dt_in(4),4)
end if
!TODO: why doesn't this line get written?
write(cvalue,'(4f10.1)')dtmax,dtcfl,dtcfli,dtmin
if (root_task) write(stdout,'(a)') trim(subname)//': WW3 timesteps '//trim(cvalue)

! Determine if waves are in the slow loop
couple_slow = .false.
call NUOPC_CompAttributeGet(gcomp, name='couple_slow', value=cvalue, isPresent=isPresent, &
isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) couple_slow
end if
write(logmsg,'(A,l)') trim(subname)//': Wave couple_slow setting is ',couple_slow
call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO)
! Define any additional restart fields
if(len_trim(fldrst) > 0) then
addrstflds = .true.
call strsplit(fldrst, tmplist)

if (wav_coupling_to_cice .and. couple_slow) then
if (root_task) write(stdout,'(a)') 'Wave-ice coupling requires fast loop coupling '
call ESMF_LogWrite('Wave-ice coupling requires fast loop coupling ', ESMF_LOGMSG_INFO)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i = 1,size(rstfldlist)
rstfldlist(i) = trim(tmplist(i))
if (len_trim(rstfldlist(i)) > 0) rstfldcnt = rstfldcnt + 1
end do
if (root_task) then
do i = 1,rstfldcnt
write(stdout,'(a,i3,a)') trim(subname)//': WW3 additional restart field : ',i,' '//trim(rstfldlist(i))
end do
end if
else
if (root_task) write(stdout,'(/,a)') trim(subname)//': WW3 NO additional restart fields will be written '
end if

if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO)
Expand Down
121 changes: 66 additions & 55 deletions model/src/wav_restart_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ module wav_restart_mod
use w3parall , only : init_get_isea
use w3adatmd , only : nsealm
use w3gdatmd , only : nth, nk, nx, ny, mapsf, nspec, nseal, nsea
use w3odatmd , only : ndso, iaproc, couple_slow
use w3odatmd , only : ndso, iaproc, addrstflds, rstfldlist, rstfldcnt
use w3wdatmd , only : ice
use wav_pio_mod , only : pio_iotype, pio_ioformat, wav_pio_subsystem
use wav_pio_mod , only : handle_err, wav_pio_initdecomp
Expand All @@ -36,7 +36,7 @@ module wav_restart_mod

! used/reused in module
character(len=12) :: vname
integer :: ik, ith, ix, iy, kk, nseal_cpl, isea, jsea, ierr
integer :: ik, ith, ix, iy, kk, nseal_cpl, isea, jsea, ierr, i

!===============================================================================
contains
Expand Down Expand Up @@ -116,20 +116,23 @@ subroutine write_restart (fname, va, mapsta)
ierr = pio_put_att(pioid, varid, '_FillValue', nf90_fill_int)
call handle_err(ierr, 'define _FillValue '//trim(vname))

if (couple_slow) then
vname = 'ice'
ierr = pio_def_var(pioid, trim(vname), PIO_REAL, (/xtid, ytid, timid/), varid)
call handle_err(ierr, 'define variable '//trim(vname))
ierr = pio_put_att(pioid, varid, '_FillValue', nf90_fill_float)
call handle_err(ierr, 'define _FillValue '//trim(vname))
! define any requested additional fields
if (addrstflds) then
do i = 1,rstfldcnt
vname = trim(rstfldlist(i))
ierr = pio_def_var(pioid, trim(vname), PIO_REAL, (/xtid, ytid, timid/), varid)
call handle_err(ierr, 'define variable '//trim(vname))
ierr = pio_put_att(pioid, varid, '_FillValue', nf90_fill_float)
call handle_err(ierr, 'define _FillValue '//trim(vname))
end do
end if
! end variable definitions
ierr = pio_enddef(pioid)
call handle_err(ierr, 'end variable definition')

! initialize the decomp
call wav_pio_initdecomp(iodesc2dint, use_int=.true.)
call wav_pio_initdecomp(iodesc2d)
if (addrstflds) call wav_pio_initdecomp(iodesc2d)
call wav_pio_initdecomp(nspec, iodesc3dk)

! write the time
Expand Down Expand Up @@ -174,25 +177,30 @@ subroutine write_restart (fname, va, mapsta)
call pio_write_darray(pioid, varid, iodesc3dk, lva, ierr)
call handle_err(ierr, 'put variable '//trim(vname))

if (couple_slow) then
! ice is global
lvar(:) = 0.0
do jsea = 1,nseal_cpl
call init_get_isea(isea, jsea)
lvar(jsea) = ice(isea)
end do
! write requested additional fields
if (addrstflds) then
do i = 1,rstfldcnt
vname = trim(rstfldlist(i))
! TODO: make generic routine (in=ice, out=lvar)
if (vname == 'ice') then
lvar(:) = 0.0
do jsea = 1,nseal_cpl
call init_get_isea(isea, jsea)
lvar(jsea) = ice(isea)
end do
end if

! write PE local ice
vname = 'ice'
ierr = pio_inq_varid(pioid, trim(vname), varid)
call handle_err(ierr, 'inquire variable '//trim(vname))
call pio_setframe(pioid, varid, int(1,kind=Pio_Offset_Kind))
call pio_write_darray(pioid, varid, iodesc2d, lvar, ierr)
call handle_err(ierr, 'put variable '//trim(vname))
! write PE local field
ierr = pio_inq_varid(pioid, trim(vname), varid)
call handle_err(ierr, 'inquire variable '//trim(vname))
call pio_setframe(pioid, varid, int(1,kind=Pio_Offset_Kind))
call pio_write_darray(pioid, varid, iodesc2d, lvar, ierr)
call handle_err(ierr, 'put variable '//trim(vname))
end do
end if

call pio_syncfile(pioid)
if (couple_slow) call pio_freedecomp(pioid, iodesc2d)
if (addrstflds) call pio_freedecomp(pioid, iodesc2d)
call pio_freedecomp(pioid, iodesc2dint)
call pio_freedecomp(pioid, iodesc3dk)
call pio_closefile(pioid)
Expand Down Expand Up @@ -289,7 +297,7 @@ subroutine read_restart (fname, va, mapsta, mapst2)

! initialize the decomp
call wav_pio_initdecomp(iodesc2dint, use_int=.true.)
call wav_pio_initdecomp(iodesc2d)
if (addrstflds) call wav_pio_initdecomp(iodesc2d)
call wav_pio_initdecomp(nspec, iodesc3dk)

vname = 'va'
Expand Down Expand Up @@ -328,8 +336,6 @@ subroutine read_restart (fname, va, mapsta, mapst2)
global_output = 0.0
do jsea = 1,nseal_cpl
call init_get_isea(isea, jsea)
ix = mapsf(isea,1)
iy = mapsf(isea,2)
if (lmap(jsea) .ne. ifill) then
global_input(isea) = real(lmap(jsea))
end if
Expand All @@ -348,38 +354,43 @@ subroutine read_restart (fname, va, mapsta, mapst2)
mapsta = mod(lmap2d+2,8) - 2
mapst2 = st2init + (lmap2d-mapsta)/8

if (couple_slow) then
vname = 'ice'
ierr = pio_inq_varid(pioid, trim(vname), varid)
call handle_err(ierr, 'inquire variable '//trim(vname))
call pio_setframe(pioid, varid, frame)
call pio_read_darray(pioid, varid, iodesc2d, lvar, ierr)
call handle_err(ierr, 'get variable '//trim(vname))
ierr = pio_get_att(pioid, varid, "_FillValue", rfill)
call handle_err(ierr, 'get variable _FillValue'//trim(vname))

! fill global array with PE local values
global_input = 0.0
global_output = 0.0
do jsea = 1,nseal_cpl
call init_get_isea(isea, jsea)
if (lmap(jsea) .ne. rfill) then
global_input(isea) = lvar(jsea)
! read additional restart fields
if (addrstflds) then
do i = 1,size(rstfldlist)
vname = trim(rstfldlist(i))
ierr = pio_inq_varid(pioid, trim(vname), varid)
call handle_err(ierr, 'inquire variable '//trim(vname))
call pio_setframe(pioid, varid, frame)
call pio_read_darray(pioid, varid, iodesc2d, lvar, ierr)
call handle_err(ierr, 'get variable '//trim(vname))
ierr = pio_get_att(pioid, varid, "_FillValue", rfill)
call handle_err(ierr, 'get variable _FillValue'//trim(vname))

! fill global array with PE local values
global_input = 0.0
global_output = 0.0
do jsea = 1,nseal_cpl
call init_get_isea(isea, jsea)
if (lvar(jsea) .ne. rfill) then
global_input(isea) = lvar(jsea)
end if
end do
! reduce across all PEs to create global array
call MPI_AllReduce(global_input, global_output, nsea, MPI_REAL, MPI_SUM, wave_communicator, ierr)

if (vname == 'ice') then
! fill global array on each PE
! TODO : make generic routine (in=global_ouput, out=ice)
ice = 0.0
do isea = 1,nsea
ice(isea) = global_output(isea)
end do
end if
end do
! reduce across all PEs to create global array
call MPI_AllReduce(global_input, global_output, nsea, MPI_REAL, MPI_SUM, wave_communicator, ierr)

! fill global array on each PE
ice = 0.0
do isea = 1,nsea
ix = mapsf(isea,1)
iy = mapsf(isea,2)
ice(isea) = global_output(isea)
end do
end if

call pio_syncfile(pioid)
if (couple_slow) call pio_freedecomp(pioid, iodesc2d)
if (addrstflds) call pio_freedecomp(pioid, iodesc2d)
call pio_freedecomp(pioid, iodesc2dint)
call pio_freedecomp(pioid, iodesc3dk)
call pio_closefile(pioid)
Expand Down
17 changes: 12 additions & 5 deletions model/src/wav_shel_inp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,10 +100,14 @@ end subroutine set_shel_io
!> Read ww3_shel.inp Or ww3_shel.nml
!!
!! @param[in] mpi_comm mpi communicator
!! @param[in] mds an array of unit numbers
!! @param[in] time0_overwrite the initial time for overwriting the nml file, optional
!! @param[in] timen_overwrite the endding time for overwriting the nml file, optional
!! @param[out] rstfldlist a list of additional restart fields, optional
!!
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 01-05-2022
subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite)
subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite, rstfldlist)

use wav_shr_flags
use w3nmlshelmd , only : nml_domain_t, nml_input_t, nml_output_type_t
Expand All @@ -127,12 +131,14 @@ subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite)
#ifdef W3_NL5
use w3wdatmd , only : qi5tbeg
#endif
use wav_kind_mod , only : CL => shr_kind_cl

! input/output parameters
integer, intent(in) :: mpi_comm
integer, intent(in) :: mds(:)
integer, intent(in), optional :: time0_overwrite(2)
integer, intent(in), optional :: timen_overwrite(2)
integer, intent(in) :: mpi_comm
integer, intent(in) :: mds(:)
integer, intent(in), optional :: time0_overwrite(2)
integer, intent(in), optional :: timen_overwrite(2)
character(len=CL), intent(out), optional :: rstfldlist

! local parameters
integer, parameter :: nhmax = 200
Expand Down Expand Up @@ -639,6 +645,7 @@ subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite)
! Extra fields to be written in the restart
fldrst = nml_output_type%restart%extra
call w3flgrdflag ( ndso, ndso, ndse, fldrst, flogr, flogrr, iaproc, napout, ierr )
if (present(rstfldlist))rstfldlist = trim(fldrst)
if ( ierr .ne. 0 ) goto 2222

! force minimal allocation to avoid memory seg fault
Expand Down

0 comments on commit 610606b

Please sign in to comment.