Merge pull request ESCOMP#8 from mvertens/feature/fixes_for_wave_cice…

…_coupling fixes for issues encountered with wave/ice coupling
francescococetta · Jul 5, 2023 · 5592802 · 5592802
2 parents 3734e3e + fcc62f7
commit 5592802
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 13 deletions.
diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90
@@ -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
+      else
+         DO T=1,NTH
+            INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG
+         ENDDO
+      end if
     ENDDO
     !-----------------------------------------------------------
     ! Region B, Saturation level left flat while spectrum turned
@@ -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
@@ -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

diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90
@@ -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)
@@ -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)