Bugfix/prtide (#394)

* cleanup print statements * improve the mpi_gather with in_place option * correct print format * correct a bug on a bad statement for _fillvalue and addoffset reading * correct minor bugs detected with gnu compiler with debug options
NOAA-EMC · Jun 16, 2021 · 6cfe1bd · 6cfe1bd
1 parent f4d0927
commit 6cfe1bd
Show file tree

Hide file tree

Showing 5 changed files with 99 additions and 45 deletions.
diff --git a/model/ftn/w3gridmd.ftn b/model/ftn/w3gridmd.ftn
@@ -6258,13 +6258,13 @@
                '     OF GRID INDEX CLOSURE (NONE, SMPL or TRPL).'/    &
                ' *** PLEASE UPDATE YOUR GRID INPUT FILE ACCORDINGLY ***'/)
 !
- 1014 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &
-               '   SMC CELL LONGITUDE RANGE OUTSIDE BASE GRID RANGE:'/&
-               '   ISEA =', I6, '; IX =', I4, ':', I4,'; NX =', I4/)
+!/SMC 1014 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &
+!/SMC               '   SMC CELL LONGITUDE RANGE OUTSIDE BASE GRID RANGE:'/&
+!/SMC               '   ISEA =', I6, '; IX =', I4, ':', I4,'; NX =', I4/)
 !
- 1015 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &
-               '   SMC CELL LATITUDE RANGE OUTSIDE BASE GRID RANGE: '/&
-               '   ISEA =', I6, '; IY =', I4, ':', I4,'; NY =', I4/)
+!/SMC 1015 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &
+!/SMC               '   SMC CELL LATITUDE RANGE OUTSIDE BASE GRID RANGE: '/&
+!/SMC               '   ISEA =', I6, '; IY =', I4, ':', I4,'; NY =', I4/)
 !
  1020 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &
                '     SOURCE TERMS REQUESTED BUT NOT SELECTED'/)

diff --git a/model/ftn/w3ounfmetamd.ftn b/model/ftn/w3ounfmetamd.ftn
@@ -1942,9 +1942,6 @@
       ENDIF
 
       RETURN
-!
- 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNFMETA : '            / &
-               '     WRITEMETA: Unknown meta data type: ', A1         / )
 !
       END SUBROUTINE WRITE_META
 
@@ -2057,7 +2054,7 @@
             IF(ERR /= NF90_NOERR) RETURN
 
           CASE DEFAULT
-            WRITE(1000,*) P%TYPE
+            WRITE(NDSE,1000) P%TYPE
             CALL EXTCDE(10)
         END SELECT
 

diff --git a/model/ftn/w3tidemd.ftn b/model/ftn/w3tidemd.ftn
@@ -584,6 +584,11 @@
 !
       JBASE=0
 
+      ! initialize arrays to avoid NaN values
+      FA(:)=0
+      UA(:)=0
+      VA(:)=0
+
       DO K=1,NTIDAL_CON
         J1=JBASE+1
         JL=JBASE+NJ(K)

diff --git a/model/ftn/ww3_prnc.ftn b/model/ftn/ww3_prnc.ftn
@@ -1,4 +1,5 @@
 #include "w3macros.h"
+#define CHECK_ERR(I) CHECK_ERROR(I, __LINE__)
 !/ ------------------------------------------------------------------- /
       PROGRAM W3PRNC
 !/
@@ -285,7 +286,6 @@
 !
       INTEGER                 :: K, L, TIDEFLAG,                      &
                                  TIDE_NDEF, TIDE_ITREND
-!/MPI      INTEGER                   :: STAT_MPI(MPI_STATUS_SIZE)
 !/T      INTEGER, PARAMETER      :: LRB = 4
 !/T      INTEGER(KIND=8)         :: RPOS
 !/T      INTEGER                 ::   LRECL, NREC
@@ -305,6 +305,9 @@
 !
       CHARACTER*256           :: TIDECONSTNAMES
       CHARACTER*100           :: LIST(70)
+!
+      LOGICAL, ALLOCATABLE    :: TIDALCOMP(:,:)
+!
 !/T      CHARACTER*21            :: FNAMETXT
 !
       EQUIVALENCE              ( NXI , NXJ(1) ) , ( NYI , NYJ(1) )
@@ -717,6 +720,7 @@
         WRITE(NDSE,1029)
       END IF
       IRET=NF90_GET_ATT(NCID,VARIDTMP,"units",TIMEUNITS)
+      CALL CHECK_ERR(IRET)
       CALL U2D(TIMEUNITS,REFDATE,IERR)
       CALL D2J(REFDATE,REFJULDAY,IERR)
 
@@ -1332,8 +1336,8 @@
 !/MPI                         ' points. This can take hours ...'
 !/MPI     ENDIF 
 !/MPI     IF (NX*NY.LT.4000) THEN 
-          WRITE(NDSE,*) 'Starting tidal analysis for ',NX*NY, ' points.'
-          IF (NAPROC.EQ.1) WRITE(NDSE,*) 'This can take hours ...Consider running this with MPI '
+          WRITE(NDSE,'(A,I8,A)') 'Starting tidal analysis for ',NX*NY, ' points.'
+          IF (NAPROC.EQ.1) WRITE(NDSE,'(A)') 'This can take hours ...Consider running this with MPI '
           END IF
 !/MPI     END IF
         IRET=NF90_INQ_VARID(NCID,"time",VARIDTMP)
@@ -1365,26 +1369,27 @@
         TIDAL_CONST(:,:,:,:,:)=0.
         DO I=1,NFIELDS
           IRET=NF90_INQ_VARID(NCID,FIELDSNAME(I),VARIDF(I))
+          CALL CHECK_ERR(IRET)
         END DO
-        IRET=NF90_GET_ATT(NCID,VARIDTMP,"_FillValue", FILLVALUE)
-
+        IRET=NF90_GET_ATT(NCID,VARIDF(1),"_FillValue", FILLVALUE)
+        CALL CHECK_ERR(IRET)
         IRET = NF90_GET_ATT(NCID,VARIDF(1),'scale_factor',SCFAC(1))
         IF (IRET .NE. 0) SCFAC(1) = 1.0
         IRET = NF90_GET_ATT(NCID,VARIDF(1),'add_offset',ADDOFF(1))
         IF (IRET .NE. 0) ADDOFF(1) = 0.0
         IF ( NFCOMP.EQ.2 .OR. (IFLD.GE.3 .AND. IFLD.NE.7) .OR. FLBERG ) THEN
           IRET = NF90_GET_ATT(NCID,VARIDF(2),'scale_factor',SCFAC(2))
           IF (IRET .NE. 0) SCFAC(2) = 1.0
-          IRET = NF90_GET_ATT(NCID,VARIDF(2),'add_offset',ADDOFF(1))
-          IF (IRET .NE. 0) ADDOFF(1) = 0.0
+          IRET = NF90_GET_ATT(NCID,VARIDF(2),'add_offset',ADDOFF(2))
+          IF (IRET .NE. 0) ADDOFF(2) = 0.0
         END IF
 
 
 !
 ! Set arrays for MPI exchanges
 !
         IF (NX .LT. NAPROC) THEN
-          WRITE(NDSE,*) 'NUMBER OF NX POINTS LESS THAN NUMBER OF PROC'
+          WRITE(NDSE,'(A)') 'NUMBER OF NX POINTS LESS THAN NUMBER OF PROC'
           CALL EXTCDE (30)
         END IF
 
@@ -1411,9 +1416,11 @@
 !/MPI          NELEM(I) = NX / NAPROC
 !/MPI          IF (REST .GT. I-1) NELEM(I) = NELEM(I) + 1
 !/MPI        END DO
-
+
+
 !/MPIT        WRITE(100+IAPROC,*) "Number of points for this processor ", IAPROC, " : ", NELEM(IAPROC), ' / ', NX
 !/MPIT        WRITE(100+IAPROC,*) "Cumul of points for this processor ", IAPROC, " : ", CUMUL(IAPROC), ' / ', NX
+!/MPIT        WRITE(100+IAPROC,*) "Slice of values per processor ", SLICE
 
         ALLOCATE(TIDE_DATA_ALL(NELEM(IAPROC),NTI,NFIELDS))
 
@@ -1423,6 +1430,9 @@
 
 !
 ! Loops on Y dimension
+!
+        ALLOCATE(TIDALCOMP(NX,NY))
+        TIDALCOMP=.TRUE.
 !
         DO IY=1,NY
 !/MPI            IND=0
@@ -1499,8 +1509,8 @@
 !/T    WRITE (990,POS=RPOS),NULLBUFF(1:NREC)
 !/T    WRITE (990,POS=RPOS),TIDE_AMPC(1:TIDE_MF,1:NFIELDS),TIDE_PHG(1:TIDE_MF,1:NFIELDS)
 
-            ELSE ! TIDE_NTI.GT.(TIDE_MF*3)
-              WRITE(NDSE,*) 'WARNING NOT ENOUGH DATA AT POINT:',IX,IY, NTI, TIDE_NTI
+            ELSE
+              TIDALCOMP(IX,IY)=.FALSE.
               TIDE_AMPC(1:TIDE_MF,1:NFIELDS)=0.
               TIDE_PHG(1:TIDE_MF,1:NFIELDS)=0.
             END IF ! end of test on TIDE_NTI
@@ -1510,8 +1520,8 @@
 ! Save tidal amplitude and phase
 !
 
-!/MPI          IF (IAPROC.EQ.NAPOUT) WRITE(NDSO,'(A,I6,A,I6,A,I6)') 'IY, JX = ', &
-!/MPI                                      IY,',',JX, ' out of  ', NELEM(IAPROC)
+!/MPIT          IF (IAPROC.EQ.NAPOUT) WRITE(NDSO,'(A,I6,A,I6,A,I6)') 'IY, JX = ', &
+!/MPIT                                      IY,',',JX, ' out of  ', NELEM(IAPROC)
 !/MPI          DO J=1,TIDE_MF
 !/MPI            DO K=1,NFIELDS
 !/MPI              IND=IND+1
@@ -1534,6 +1544,17 @@
 !/MPI            CALL MPI_GATHERV(TIDE1DL, SLICE * TIDE_MF * NFIELDS * 2, MPI_REAL, &
 !/MPI                             TIDE1D, NELEM * TIDE_MF * NFIELDS * 2, CUMUL * TIDE_MF * NFIELDS * 2, &
 !/MPI                             MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
+
+!/MPI            IF (IAPROC.EQ.NAPOUT) THEN
+!/MPI              CALL MPI_GATHERV(MPI_IN_PLACE,NELEM(IAPROC), &
+!/MPI                               MPI_LOGICAL, TIDALCOMP(:,IY), NELEM, CUMUL, MPI_LOGICAL, NAPOUT-1,     &
+!/MPI                               MPI_COMM_WORLD, IERR_MPI)
+!/MPI            ELSE
+!/MPI              CALL MPI_GATHERV(TIDALCOMP(CUMUL(IAPROC)+1:CUMUL(IAPROC)+NELEM(IAPROC),IY),NELEM(IAPROC), &
+!/MPI                               MPI_LOGICAL, TIDALCOMP(:,IY), NELEM, CUMUL, MPI_LOGICAL, NAPOUT-1,     &
+!/MPI                               MPI_COMM_WORLD, IERR_MPI)
+!/MPI            END IF
+
 !/MPI          ELSE
 !/MPI            TIDE1D = TIDE1DL
 !/MPI          END IF
@@ -1555,7 +1576,6 @@
 !/MPI            END DO
 !/MPI          END IF
 
-
 
         END DO ! IY=1,NY
 
@@ -1564,20 +1584,34 @@
 !/T  IF (IDFLD.EQ.'CUR') WRITE(986,'(F10.3,/)') TIDAL_CONST(:,1,15,1,1) 
 !/T  IF (IDFLD.EQ.'CUR') WRITE(986,'(F10.3,/)') TIDAL_CONST(:,1,15,2,1)
 
-!/MPI        IF (IAPROC .EQ. NAPOUT )  THEN 
-!/MPI          WRITE(NDSO,*) "parallelization done"
-!/MPI        ELSE
+!/MPI        IF (IAPROC .NE. NAPOUT )  THEN 
 !/MPI          GOTO 888
+!/MPIT        ELSE
+!/MPIT          WRITE(NDSO,'(A)') "parallelization done"
 !/MPI        END IF
 
+
+!
+! Warn about not computed nodes for tidal constituents
+!
+        IF ( IAPROC .EQ. NAPOUT) THEN
+          DO IX=1,NX
+            DO IY=1,NY
+              IF(TIDALCOMP(IX,IY).EQV..FALSE.) THEN
+                WRITE(NDSO,1047) IX, IY
+              END IF
+            END DO
+          END DO
+        END IF
+
 !
 ! After loop on points, write tidal constituents to file.
 !
         IF ( IAPROC .EQ. NAPOUT.AND.TIDEFLAG.GE.1)  &
           CALL W3FLDTIDE1 ( 'WRITE',  NDSDAT, NDST, NDSE, NX, NY, IDFLD, IERR )
         CALL W3FLDTIDE2 ( 'WRITE',  NDSDAT, NDST, NDSE, NX, NY, IDFLD, 0, IERR )
 !
-   GOTO 880
+        GOTO 880
 
       END IF ! end of test   IF (ITYPE.GE.6.AND.TIDEFLAG.GT.0)
 
@@ -1823,8 +1857,8 @@
 !
                 IF (NFCOMP.EQ.2) THEN
 !/O3             IF ( IAPROC .EQ. NAPOUT )    WRITE (NDSO,976) ' (2) '
-                    CALL INTERP(YC, JX21, JX22, JY21, JY22, XD11, XD12,&
-                                             XD21, XD22, FILLVALUE, FA)
+                    CALL INTERP(MXM, MYM, YC, JX21, JX22, JY21, JY22,  &
+                                 XD11, XD12, XD21, XD22, FILLVALUE, FA)
                 END IF
 !
 ! ... Two-component fields
@@ -2210,6 +2244,9 @@
  1046 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/               &
                '     ERROR IN OPENING MASK FILE'/                     &
                '     IOSTAT =',I5/)
+!
+ 1047 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/             &
+               '     NO TIDAL COMPUTATION AT NODE [',I8,',',I8,']'/)
 !
  1062 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/               &
                '     ERROR IN READING NDAT FROM FILE'/                &
@@ -2382,25 +2419,26 @@
 
 !==============================================================================
 
-      SUBROUTINE CHECK_ERR(IRET)
+      SUBROUTINE CHECK_ERROR(IRET, ILINE)
 
       USE NETCDF
       USE W3ODATMD, ONLY: NDSE
       USE W3SERVMD, ONLY: EXTCDE
 
       IMPLICIT NONE
 
-      INTEGER IRET
+      INTEGER IRET, ILINE
 
       IF (IRET .NE. NF90_NOERR) THEN
-        WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN PRNC :'
+        WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN OUNF :'
+        WRITE(NDSE,*) ' LINE NUMBER ', ILINE
         WRITE(NDSE,*) ' NETCDF ERROR MESSAGE: '
         WRITE(NDSE,*) NF90_STRERROR(IRET)
         CALL EXTCDE ( 59 )
       END IF
       RETURN
 
-      END SUBROUTINE CHECK_ERR
+      END SUBROUTINE CHECK_ERROR
 
 !==============================================================================
 

diff --git a/model/ftn/ww3_prtide.ftn b/model/ftn/ww3_prtide.ftn
@@ -395,7 +395,11 @@
             TIDE_MAX=TIDE_MAX+1
             INDMAX(TIDE_MAX)=J
             READ(TIDECON_MAXVALS(TIDE_MAXI),*) MAXVALCON(TIDE_MAX)
-            IF (IAPROC.EQ.NAPOUT) WRITE(NDSO,*) 'Maximum allowed value for amplitude:',J,TRIM(TIDECON_NAME(J)),MAXVALCON(TIDE_MAX)
+            IF (IAPROC.EQ.NAPOUT) THEN
+              WRITE(NDSO,'(A,I8,A,F10.2)') &
+                   'Maximum allowed value for amplitude:',&
+                   J,TRIM(TIDECON_NAME(J)),MAXVALCON(TIDE_MAX)
+            END IF
           END IF
         END DO
       END DO
@@ -501,7 +505,10 @@
                 IF (ABS(TIDAL_CONST(IX,IY,INDMAX(I),1,1)) .GT.MAXVALCON(I) .OR. &
                     ABS(TIDAL_CONST(IX,IY,INDMAX(I),2,1)) .GT.MAXVALCON(I)) THEN
                   TIDEOK = 0
-                  WRITE(NDSO,*) 'BAD: ', INDMAX(I), MAXVALCON(I), '/', ABS(TIDAL_CONST(IX,IY,INDMAX(I),1:2,1))
+                  WRITE(NDSO,'(A,I8,F10.2,A,2F10.2)') &
+                       '[BAD POINT] GREATER THAN THRESHOLD ', MAXVALCON(I), &
+                       ' AT INDEX ', INDMAX(I),                             &
+                       ' WITH X-Y COMPONENTS : ', ABS(TIDAL_CONST(IX,IY,INDMAX(I),1:2,1))
                 END IF
                 BADPOINTS(IX,IY) = BADPOINTS(IX,IY) + (1-TIDEOK)
               END DO
@@ -593,8 +600,9 @@
                 END IF         
               END DO
               IF (ABS(WCURTIDEX).GT.10..OR.ABS(WCURTIDEY).GT.10.)  THEN
-                WRITE(NDSE,*) 'WARNING: VERY STRONG CURRENT... BAD CONSTITUENTS?', &
-                        IX, WCURTIDEX, WCURTIDEY ,  TIDAL_CONST(IX,IY,:,1,1),'##',TIDAL_CONST(IX,IY,:,2,1)
+                WRITE(NDSE,*) &
+                     'WARNING: VERY STRONG CURRENT... BAD CONSTITUENTS?', &
+                     IX, WCURTIDEX, WCURTIDEY ,  TIDAL_CONST(IX,IY,:,1,1),'##',TIDAL_CONST(IX,IY,:,2,1)
                 STOP
               END IF
 !/MPI                IND=IND+1
@@ -611,9 +619,12 @@
 !
 
 !/MPI            IF (NAPROC.GT.1) THEN
-!/MPI              CALL MPI_GATHERV(FX1DL, SLICE, MPI_REAL, FX1D, NELEM, CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
-!/MPI              CALL MPI_GATHERV(FY1DL, SLICE, MPI_REAL, FY1D, NELEM, CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
-!/MPI              CALL MPI_GATHERV(FA1DL, SLICE, MPI_REAL, FA1D, NELEM, CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
+!/MPI              CALL MPI_GATHERV(FX1DL, SLICE, MPI_REAL, FX1D, NELEM, &
+!/MPI                               CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
+!/MPI              CALL MPI_GATHERV(FY1DL, SLICE, MPI_REAL, FY1D, NELEM, &
+!/MPI                               CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
+!/MPI              CALL MPI_GATHERV(FA1DL, SLICE, MPI_REAL, FA1D, NELEM, &
+!/MPI                               CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
 !/MPI            ELSE
 !/MPI              FX1D = FX1DL
 !/MPI              FY1D = FY1DL
@@ -689,9 +700,12 @@
 !
 
 !/MPI            IF (NAPROC.GT.1) THEN
-!/MPI              CALL MPI_GATHERV(FX1DL, SLICE, MPI_REAL, FX1D, NELEM, CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
-!/MPI              CALL MPI_GATHERV(FY1DL, SLICE, MPI_REAL, FY1D, NELEM, CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
-!/MPI              CALL MPI_GATHERV(FA1DL, SLICE, MPI_REAL, FA1D, NELEM, CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
+!/MPI              CALL MPI_GATHERV(FX1DL, SLICE, MPI_REAL, FX1D, NELEM,&
+!/MPI                               CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
+!/MPI              CALL MPI_GATHERV(FY1DL, SLICE, MPI_REAL, FY1D, NELEM,&
+!/MPI                               CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
+!/MPI              CALL MPI_GATHERV(FA1DL, SLICE, MPI_REAL, FA1D, NELEM,&
+!/MPI                               CUMUL, MPI_REAL, NAPOUT-1, MPI_COMM_WORLD, IERR_MPI)
 !/MPI            ELSE
 !/MPI              FX1D = FX1DL
 !/MPI              FY1D = FY1DL
@@ -760,7 +774,7 @@
       CALL EXTCDE ( 42 )
 !
   803 CONTINUE
-      WRITE (NDSE,1003) IERR
+      WRITE (NDSE,1003)
       CALL EXTCDE ( 43 )
 !
   888 CONTINUE