Skip to content

fixes for issues encountered with wave/ice coupling #8

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
mvertens merged 2 commits into from
Jul 5, 2023
Merged

fixes for issues encountered with wave/ice coupling #8

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
bd4225c
fixes encountered with wave/ice coupling
mvertens Jul 4, 2023
fcc62f7
changes made to address comments in PR
mvertens Jul 5, 2023
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
35 changes: 24 additions & 11 deletions model/src/w3fld1md.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1115,9 +1115,13 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT)
!----------------------------------------------
DO K=KA1, KA2-1
AVG=SUM(INSPC(K,:))/MAX(REAL(NTH),1.)
DO T=1,NTH
INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG
ENDDO
if (AVG == 0.) then
write(6,*)'WARNING: SUM(INSPC(K,:)) is zero for K = ',K
Comment thread
mvertens marked this conversation as resolved.
else
DO T=1,NTH
INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG
Comment thread
mvertens marked this conversation as resolved.
ENDDO
end if
ENDDO
!-----------------------------------------------------------
! Region B, Saturation level left flat while spectrum turned
Expand All @@ -1133,10 +1137,15 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT)
ENDIF
ENDDO
AVG=SUM(NORMSPC)/MAX(REAL(NTH),1.)
DO T=1, NTH
INSPC(K,T) = SAT * NORMSPC(T)/TPI/(WN2(K)**3.0)/AVG
ENDDO
if (AVG == 0.) then
write(6,*)'WARNING: SUM(NORMSPC) is zero for K = ',K
else
DO T=1, NTH
INSPC(K,T) = SAT * NORMSPC(T)/TPI/(WN2(K)**3.0)/AVG
ENDDO
end if
ENDDO

DO T=1, NTH
angdif=th(t)-wnddir
IF (COS(ANGDIF) .GT. 0.0) THEN
Expand All @@ -1146,11 +1155,15 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT)
ENDIF
ENDDO
AVG=SUM(NORMSPC)/MAX(REAL(NTH),1.)!1./4.
DO K=KA3+1, NKT
DO T=1, NTH
INSPC(K,T)=NORMSPC(T)*(SAT)/TPI/(WN2(K)**3.0)/AVG
ENDDO
ENDDO
if (AVG == 0.) then
write(6,*)'WARNING: SUM(NORMSPC) is zero'
else
DO K=KA3+1, NKT
DO T=1, NTH
INSPC(K,T)=NORMSPC(T)*(SAT)/TPI/(WN2(K)**3.0)/AVG
ENDDO
ENDDO
end if
DEALLOCATE(ANGLE1)
!
! Formats
Expand Down
4 changes: 2 additions & 2 deletions model/src/w3iorsmd.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -892,7 +892,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT )
WRITEBUFF(:) = 0.
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF
WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &
TLEV, TICE, TRHO
TLEV, TICE, TRHO, TIC1, TIC5
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
Expand Down Expand Up @@ -1073,7 +1073,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT )
IF (TYPE.EQ.'FULL') THEN
RPOS = 1_8 + LRECL*(NREC-1_8)
READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) &
TLEV, TICE, TRHO
TLEV, TICE, TRHO, TIC1, TIC5
DO IPART=1,NPART
NREC = NREC + 1
RPOS = 1_8 + LRECL*(NREC-1_8)
Expand Down