Bug fix and small simplification/optimization change (#18)

* Fixes NOAA-EMC#290 (ww3_multi hanging when generating restart with IOSTYP >= 2) * Also fixes out-of-bounds array access error. * Includes some MPI optimizations
ukmo-waves · Mar 4, 2021 · 6930fac · 6930fac
1 parent 8b725a5
commit 6930fac
Show file tree

Hide file tree

Showing 4 changed files with 7 additions and 11 deletions.
diff --git a/model/ftn/w3iorsmd.ftn b/model/ftn/w3iorsmd.ftn
@@ -584,7 +584,7 @@
 !
 !/MPI                  ALLOCATE ( STAT1(MPI_STATUS_SIZE,NRQ) )
 !/MPI                  IF ( IAPROC .EQ. NAPRST ) CALL MPI_STARTALL    &
-!/MPI                                      ( NRQ, IRQRSS, IERR_MPI )
+!/MPI                                      ( NRQ*NBLKRS, IRQRSS, IERR_MPI )
 !
 !/MPI                  DO IB=1, NBLKRS
 !/MPI                    ISEA0  = 1 + (IB-1)*RSBLKS*NAPROC
@@ -595,11 +595,6 @@
 !/MPI                        IH     = 1 + NRQ * (IB-1)
 !/MPI                        CALL MPI_WAITALL                         &
 !/MPI                           ( NRQ, IRQRSS(IH), STAT1, IERR_MPI )
-!/MPI                        IF ( IB .LT. NBLKRS ) THEN
-!/MPI                            IH     = 1 + NRQ * IB
-!/MPI                            CALL MPI_STARTALL                    &
-!/MPI                               ( NRQ, IRQRSS(IH), IERR_MPI )
-!/MPI                          END IF
 !
 !/MPI                        DO ISEA=ISEA0, ISEAN
 !/MPI                          NREC   = ISEA + 2
@@ -609,7 +604,7 @@
 !/MPI                          IF ( IP .EQ. NAPRST ) THEN
 !/MPI                              WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA)
 !/MPI                            ELSE
-!/MPI                              JSEA   = JSEA - 2*((IB-1)/2)*RSBLKS
+!/MPI                              JSEA = 1 + MOD(IB-1,2)*RSBLKS
 !/MPI                              WRITEBUFF(1:NSPEC) = VAAUX(1:NSPEC,JSEA,IP)
 !/MPI                            END IF
 !/MPI                            WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) &

diff --git a/model/ftn/w3odatmd.ftn b/model/ftn/w3odatmd.ftn
@@ -1591,9 +1591,9 @@
 !/MPI      RSBLKS => OUTPTS(IMOD)%OUT4%RSBLKS
 !/MPI      IF ( NRQRS .NE. 0 ) THEN
 !/MPI          IRQRS  => OUTPTS(IMOD)%OUT4%IRQRS
-!/MPI          IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS
 !/MPI          VAAUX  => OUTPTS(IMOD)%OUT4%VAAUX
 !/MPI        END IF
+!/MPI      IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS
 !
       NBI    => OUTPTS(IMOD)%OUT5%NBI
       NBI2   => OUTPTS(IMOD)%OUT5%NBI2

diff --git a/regtests/mww3_test_04/input/ww3_multi_grdset_d.inp b/regtests/mww3_test_04/input/ww3_multi_grdset_d.inp
@@ -15,7 +15,7 @@ $
    19680606 000000   1200  19680608 000000
 $
   N
-  DPT CUR HS FP DP DIR SPR
+  DPT CUR HS FP DP DIR SPR WND UST LM
 $
    19680606 000000   3600  19680608 000000
     -100.E3    50.E3  'A1'
@@ -43,7 +43,7 @@ $
        0.E3     0.E3  'STOPSTRING'
 $
    19680606 000000      0  19680608 000000
-   19680606 011200      0  19680606 011200
+   19680606 020000   3600  19680606 020000
    19680606 000000      0  19680608 000000
    19680606 000000      0  19680608 000000
 $

diff --git a/regtests/mww3_test_04/input/ww3_multi_grdset_d.nml b/regtests/mww3_test_04/input/ww3_multi_grdset_d.nml
@@ -164,7 +164,7 @@
 !     ITYPE(3)%TRACK%FORMAT      =  F
 ! -------------------------------------------------------------------- !
 &OUTPUT_TYPE_NML
-  ALLTYPE%FIELD%LIST       = 'DPT CUR HS FP DP DIR SPR'
+  ALLTYPE%FIELD%LIST       = 'DPT CUR HS FP DP DIR SPR WND UST LM'
   ALLTYPE%POINT%NAME       = 'points'
   ALLTYPE%POINT%FILE       = '../input/points.list'
 /
@@ -208,6 +208,7 @@
 &OUTPUT_DATE_NML
   ALLDATE%FIELD          = '19680606 000000' '1200' '19680608 000000'
   ALLDATE%POINT          = '19680606 000000' '3600' '19680608 000000'
+  ALLDATE%RESTART        = '19680606 020000' '3600' '19680606 020000'
 /
 
 ! -------------------------------------------------------------------- !