Skip to content

Commit

Permalink
fix unset value for fldrst, setting of addrstflds
Browse files Browse the repository at this point in the history
  • Loading branch information
@DeniseWorthen
DeniseWorthen committed Sep 21, 2024
1 parent 7b01bde commit adcc30f
Show file tree
Hide file tree
Showing 5 changed files with 129 additions and 144 deletions.
4 changes: 4 additions & 0 deletions model/src/w3initmd.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -520,6 +520,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD,
integer :: memunit
character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS
character(len=1024) :: fname
!debug
real :: tmpice(nx,ny)
character(len=40) :: icefilename, mapfilename
integer :: iceio, mapio
!/
!/ ------------------------------------------------------------------- /
!
Expand Down
207 changes: 79 additions & 128 deletions model/src/w3iorsmd.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -853,14 +853,15 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT , filename)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
TLEV, TICE, TRHO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
(WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
! (WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO

DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
Expand All @@ -869,37 +870,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT , filename)
(ICE(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO

#ifdef W3_WRST
! The WRST switch saves the values of wind in the
! restart file and then uses the wind for the first
! time step here. This is needed when coupling with
! an atm model that does not have 10m wind speeds at
! initialization. If there is no restart, wind is zero
#endif

#ifdef W3_WRST
DO IX=1, NX
DO IPART=1,NPRTY2
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
(WXN(IX,IYL),IYL=1+(IPART-1)*NSIZE, &
MIN(NY,IPART*NSIZE))
END DO
END DO
DO IX=1, NX
DO IPART=1,NPRTY2
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
(WYN(IX,IYL),IYL=1+(IPART-1)*NSIZE, &
MIN(NY,IPART*NSIZE))
END DO
END DO
#endif
ALLOCATE ( MAPTMP(NY,NX) )
MAPTMP = MAPSTA + 8*MAPST2
DO IY=1, NY
Expand All @@ -914,38 +884,38 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT , filename)
END DO
END DO
DEALLOCATE ( MAPTMP )
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
(UST(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
(USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
(ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
(FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
! (UST(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
! (USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
! (ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
! WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
! (FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
IF (OARST) THEN
#ifdef W3_MPI
CALL W3XETA ( IGRD, NDSE, NDST )
Expand Down Expand Up @@ -1036,42 +1006,23 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT , filename)
ELSE
IF (TYPE.EQ.'FULL') THEN
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
TLEV, TICE, TRHO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
TLEV, TICE, TRHO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
! (WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(ICE(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
#ifdef W3_WRST
DO IX=1, NX
DO IPART=1,NPRTY2
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(WXNwrst(IX,IYL),IYL=1+(IPART-1)*NSIZE, &
MIN(NY,IPART*NSIZE))
END DO
END DO
DO IX=1, NX
DO IPART=1,NPRTY2
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(WYNwrst(IX,IYL),IYL=1+(IPART-1)*NSIZE, &
MIN(NY,IPART*NSIZE))
END DO
END DO
#endif

ALLOCATE ( MAPTMP(NY,NX) )
DO IY=1, NY
DO IPART=1,NPRTX2
Expand All @@ -1095,34 +1046,34 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT , filename)
#endif
ENDIF
!
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(UST(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
(FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, &
MIN(NSEA,IPART*NSIZE))
END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
! (UST(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
! (USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
! (ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
! DO IPART=1,NPART
! NREC = NREC + 1
! RPOS = 1_8 + LRECL*(NREC-1_8)
! READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
! (FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, &
! MIN(NSEA,IPART*NSIZE))
! END DO
IF (OARST) THEN
IF ( FLOGOA(1,2) ) THEN
READ (NDSR,ERR=802,IOSTAT=IERR) CX(1:NSEA)
Expand Down
35 changes: 20 additions & 15 deletions model/src/wav_comp_nuopc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1709,12 +1709,22 @@ subroutine waveinit_ufs( gcomp, stdout, ntrace, mpi_comm, mds, rc)
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, rstfldlist=fldrst)

call ESMF_LogWrite(trim(subname)//' call w3init', ESMF_LOGMSG_INFO)
! Define any additional restart fields
if(len_trim(fldrst) > 0) then
addrstflds = .true.
call strsplit(fldrst, tmplist)
do i = 1,size(rstfldlist)
rstfldlist(i) = trim(tmplist(i))
if (len_trim(rstfldlist(i)) > 0) rstfldcnt = rstfldcnt + 1
end do
end if

if (root_task) write(stdout,'(a,/)') trim(subname)//' call w3init'
call w3init ( 1, .false., 'ww3', mds, ntrace, odat, flgrd, flgr2, flgd, flg2, &
npts, x, y, pnames, iprt, prtfrm, mpi_comm )

write(cvalue,'(4f10.1)')dtmax,dtcfl,dtcfli,dtmin
if (root_task) write(stdout,'(a)') trim(subname)//': WW3 timesteps from mod_def '//trim(cvalue)
write(logmsg,'(a)')trim(subname)//': WW3 timesteps from mod_def '//trim(cvalue)

call NUOPC_CompAttributeGet(gcomp, name='dt_in', isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
Expand All @@ -1727,25 +1737,20 @@ subroutine waveinit_ufs( gcomp, stdout, ntrace, mpi_comm, mds, rc)
dtcfli = real(dt_in(3),4)
dtmin = real(dt_in(4),4)
end if
write(cvalue,'(4f10.1)')dtmax,dtcfl,dtcfli,dtmin
if (root_task) write(stdout,'(a)') trim(subname)//': WW3 timesteps '//trim(cvalue)

! Define any additional restart fields
if(len_trim(fldrst) > 0) then
addrstflds = .true.
call strsplit(fldrst, tmplist)
! log info
if (root_task) then
write(stdout,'(a)') trim(logmsg)
write(cvalue,'(4f10.1)')dtmax,dtcfl,dtcfli,dtmin
write(stdout,'(a)') trim(subname)//': WW3 timesteps '//trim(cvalue)

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
if (addrstflds) then
do i = 1,rstfldcnt
write(stdout,'(a,i3,a)') trim(subname)//': WW3 additional restart field : ',i,' '//trim(rstfldlist(i))
end do
else
write(stdout,'(/,a)') trim(subname)//': WW3 NO additional restart fields will be written '
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
19 changes: 19 additions & 0 deletions model/src/wav_restart_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -225,6 +225,7 @@ subroutine read_restart (fname, va, mapsta, mapst2)
use mpi_f08
use w3adatmd , only : mpi_comm_wave
use w3gdatmd , only : sig
use w3idatmd , only : icei
use w3wdatmd , only : time, tlev, tice, trho, tic1, tic5, wlv, asf, fpis

character(len=*) , intent(in) :: fname
Expand All @@ -242,6 +243,9 @@ subroutine read_restart (fname, va, mapsta, mapst2)
integer, allocatable :: lmap(:)
integer, allocatable :: lmap2d(:,:)
integer, allocatable :: st2init(:,:)
! debug
character(len=40) :: icefilename, mapfilename
integer :: iceio, mapio
!-------------------------------------------------------------------------------

! cold start, set initial values and return.
Expand Down Expand Up @@ -377,11 +381,16 @@ subroutine read_restart (fname, va, mapsta, mapst2)
! reduce across all PEs to create global array
call MPI_AllReduce(global_input, global_output, nsea, MPI_REAL, MPI_SUM, wave_communicator, ierr)

!icei(ix,iy)
if (vname == 'ice') then
! fill global array on each PE
! TODO : make generic routine (in=global_ouput, out=ice)
ice = 0.0
icei = 0.0
do isea = 1,nsea
ix = mapsf(isea,1)
iy = mapsf(isea,2)
icei(ix,iy) = global_output(isea)
ice(isea) = global_output(isea)
end do
end if
Expand All @@ -394,5 +403,15 @@ subroutine read_restart (fname, va, mapsta, mapst2)
call pio_freedecomp(pioid, iodesc3dk)
call pio_closefile(pioid)

if ( iaproc == 1 ) then
write(icefilename,'(a,i8.8,a,i6.6,a)')'icerst_read.',time(1),'.',time(2),'.dat'
open(newunit=iceio,file=trim(icefilename))

do iy = 1,ny
write(iceio,'(360f8.4)')(icei(ix,iy),ix=1,nx)
end do
close(iceio)
end if

end subroutine read_restart
end module wav_restart_mod
8 changes: 7 additions & 1 deletion model/src/wav_shel_inp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -645,7 +645,13 @@ subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite, rst
! 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 (present(rstfldlist)) then
if (trim(fldrst) .ne. 'unset')then
rstfldlist = trim(fldrst)
else
rstfldlist = ' '
end if
end if
if ( ierr .ne. 0 ) goto 2222

! force minimal allocation to avoid memory seg fault
Expand Down

0 comments on commit adcc30f

Please sign in to comment.