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

Jump to bottom

fixes for issues encountered with wave/ice coupling #8

Merged
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 1 commit
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
38 changes: 27 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,14 @@ 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
mvertens marked this conversation as resolved.
Show resolved Hide resolved
end if
if (AVG /= 0.) then
mvertens marked this conversation as resolved.
Show resolved Hide resolved
DO T=1,NTH
INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG
mvertens marked this conversation as resolved.
Show resolved Hide resolved
ENDDO
end if
ENDDO
!-----------------------------------------------------------
! Region B, Saturation level left flat while spectrum turned
Expand All @@ -1133,10 +1138,16 @@ 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
end if
if (AVG /= 0.) then
mvertens marked this conversation as resolved.
Show resolved Hide resolved
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 +1157,16 @@ 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'
end if
if (AVG /= 0.) then
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
Loading