Merge pull request #437 from NOAA-EMC/jba_morewflgs

more cleanup for eventual removal of -w flag

src/drfini.f

@@ -4,24 +4,23 @@
 C>
 C> @author J. Woollen @date 2002-05-14
 
+C> Initialize replication factors for delayed replication sequences.
+C>
 C> This subroutine explicitly initializes delayed replication factors
 C> and allocates a corresponding amount of space within internal arrays,
 C> thereby allowing the subsequent use of subroutine ufbseq() to write
 C> data into delayed replication sequences.
 C>
-C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR
-C>                     file
-C> @param[in] MDRF  -- integer(*): Array of delayed replication factors,
-C>                     in one-to-one correspondence with the number
-C>                     of occurrences of DRFTAG within the overall
-C>                     subset definition, and explicitly defining
-C>                     how much space (i.e. how many replications)
-C>                     to allocate within each successive occurrence
-C> @param[in] NDRF  -- integer: Number of delayed replication factors
-C>                     within MDRF
-C> @param[in] DRFTAG -- character*(*): Table D sequence mnemonic,
-C>                      bracketed by appropriate delayed replication
-C>                      notation (e.g. {}, () OR <>)
+C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR file.
+C> @param[in] MDRF - integer(*): Array of delayed replication factors,
+C> in one-to-one correspondence with the number of occurrences of DRFTAG
+C> within the overall subset definition, and explicitly defining how much
+C> space (i.e. how many replications) to allocate within each successive
+C> occurrence.
+C> @param[in] NDRF - integer: Number of delayed replication factors
+C> within MDRF.
+C> @param[in] DRFTAG - character*(*): Table D sequence mnemonic, bracketed
+C> by appropriate delayed replication notation (e.g. {}, () OR <>)
 C>
 C> Logical unit LUNIT should have already been opened for output
 C> operations (i.e. writing/encoding BUFR) via a previous call to
@@ -72,7 +71,7 @@ RECURSIVE SUBROUTINE DRFINI(LUNIT,MDRF,NDRF,DRFTAG)
 
          CALL X84(LUNIT,MY_LUNIT,1)
          CALL X84(NDRF,MY_NDRF,1)
-         CALL X84(MDRF,MY_MDRF,MY_NDRF)
+         CALL X84(MDRF,MY_MDRF,MY_NDRF(1))
          CALL DRFINI(MY_LUNIT,MY_MDRF,MY_NDRF,DRFTAG)
 
          IM8B=.TRUE.

src/idn30.f

@@ -1,11 +1,11 @@
 C> @file
 C> @brief Convert an FXY value from a character string to the
-C> WMO bit-wise represtation.
+C> WMO bit-wise representation.
 C>
 C> @author J. Woollen @date 1994-01-06
 
 C> Convert an FXY value from a character string to the
-C> WMO bit-wise represtation.
+C> WMO bit-wise representation.
 C>
 C> For an description of the WMO bit-wise representation of the FXY
 C> value, see ifxy().

src/igetrfel.f

@@ -210,7 +210,7 @@ INTEGER FUNCTION IGETRFEL ( N, LUN )
      .                      ( TAG(NODRFE)(1:8) .EQ. TAGNRV(II) ) .AND.
      .                      ( NODRFE .GE. ISNRV(II) ) .AND.
      .                      ( NODRFE .LE. IENRV(II) ) ) THEN
-                          IRF(NODE) = NRV(II)
+                          IRF(NODE) = INT(NRV(II))
                           RETURN
                         END IF
                       END DO

src/iupm.f

@@ -7,9 +7,9 @@
 C> specified number of bits of a character string, starting
 C> with the first bit of the first byte of the string.
 C>
-C> @param[in] CBAY   -- character*(*): String
-C> @param[in] NBITS  -- integer: Number of bits from CBAY to be decoded
-C> @returns iupm     -- integer: Decoded value
+C> @param[in] CBAY  - character*(*): String
+C> @param[in] NBITS - integer: Number of bits from CBAY to be decoded
+C> @returns iupm - integer: Decoded value
 C>
 C> @author J. Woollen @date 1994-01-06
       RECURSIVE FUNCTION IUPM(CBAY,NBITS) RESULT(IRET)
@@ -39,6 +39,7 @@ RECURSIVE FUNCTION IUPM(CBAY,NBITS) RESULT(IRET)
          RETURN
       ENDIF
 
+      IRET = 0
       IF(NBITS.GT.NBITW) GOTO 900
       CINT = CBAY
       INT(1) = IREV(INT(1))

src/nemspecs.f

@@ -120,7 +120,7 @@ RECURSIVE SUBROUTINE NEMSPECS
      .          ( TAGN(1:8) .EQ. TAGNRV(JJ) ) .AND.
      .          ( NODE .GE. ISNRV(JJ) ) .AND.
      .          ( NODE .LE. IENRV(JJ) ) ) THEN
-              NREF = NRV(JJ)
+              NREF = INT(NRV(JJ))
               RETURN
             END IF
           END DO

src/nevn.f

@@ -57,7 +57,7 @@ FUNCTION NEVN(NODE,LUN,INV1,INV2,I1,I2,I3,USR)
       INVN = INVWIN(NDRS,LUN,INV1,INV2)
       IF(INVN.EQ.0) GOTO 900
 
-      NEVN = VAL(INVN,LUN)
+      NEVN = NINT(VAL(INVN,LUN))
       IF(NEVN.GT.I3) GOTO 901
 
 C  SEARCH EACH STACK LEVEL FOR THE REQUESTED NODE AND COPY THE VALUE
@@ -67,7 +67,7 @@ FUNCTION NEVN(NODE,LUN,INV1,INV2,I1,I2,I3,USR)
 
       DO L=1,NEVN
         N1 = N2
-        N2 = N2 + VAL(N1,LUN)
+        N2 = N2 + NINT(VAL(N1,LUN))
         DO N=N1,N2
         IF(INV(N,LUN).EQ.NODE) USR(1,1,L) = VAL(N,LUN)
         ENDDO

src/newwin.f

@@ -1,7 +1,7 @@
 C> @file
 C> @brief Computes the ending index of the window.
 C>
-C> @author Woollen @date 1994-01-06
+C> @author J. Woollen @date 1994-01-06
 
 C> Given an index within the internal jump/link table which
 C> points to the start of an "rpc" window (which is the iteration of an 8-bit
@@ -17,7 +17,7 @@
 C> @param[in] IWIN - integer: starting index of window iteration.
 C> @param[out] JWIN - integer: ending index of window iteration.
 C>
-C> @author WOOLLEN @date 1994-01-06
+C> @author J. Woollen @date 1994-01-06
       SUBROUTINE NEWWIN(LUN,IWIN,JWIN)
 
       USE MODA_USRINT
@@ -40,7 +40,7 @@ SUBROUTINE NEWWIN(LUN,IWIN,JWIN)
 
       NODE = INV(IWIN,LUN)
       IF(LSTJPB(NODE,LUN,'RPC').NE.NODE) GOTO 900
-      JWIN = IWIN+VAL(IWIN,LUN)
+      JWIN = IWIN+NINT(VAL(IWIN,LUN))
 
 C  EXITS
 C  -----

src/nxtwin.f

@@ -1,7 +1,7 @@
 C> @file
 C> @brief Computes the start and end indices of the next window.
 C>
-C> @author WOOLLEN @date 1994-01-06
+C> @author J. Woollen @date 1994-01-06
 
 C> Given indices within the internal jump/link table which
 C> point to the start and end of an "rpc" window (which is an iteration of
@@ -19,7 +19,7 @@
 C>  - on input, contains ending index of current window iteration.
 C>  - on output, contains ending index of next window iteration.
 C>
-C> @author WOOLLEN @date 1994-01-06
+C> @author J. Woollen @date 1994-01-06
       SUBROUTINE NXTWIN(LUN,IWIN,JWIN)
 
       USE MODA_USRINT
@@ -43,7 +43,7 @@ SUBROUTINE NXTWIN(LUN,IWIN,JWIN)
          IWIN = 0
       ELSE
          IWIN = JWIN
-         JWIN = IWIN+VAL(IWIN,LUN)
+         JWIN = IWIN+NINT(VAL(IWIN,LUN))
       ENDIF
 
 C  EXITS

src/parusr.f

@@ -86,7 +86,7 @@ SUBROUTINE PARUSR(STR,LUN,I1,IO)
 
          VAL     = IVLS(I)
          IVLS(I) = IVLS(J)
-         IVLS(J) = VAL
+         IVLS(J) = NINT(VAL)
       ENDIF
       ENDDO
       ENDDO

src/pkb8.f

@@ -43,12 +43,10 @@ subroutine pkb8(nval,nbits,ibay,ibit)
       if(nbits<0 ) call bort('bufrlib: pkb8 - nbits < zero !!!!!')
       if(nbits>64) call bort('bufrlib: pkb8 - nbits > 64   !!!!!')
 
-      if(nbitw==32) then
-         nval8=nval
-         nval4=nvals(2); call pkb(nval4,max(nbits-nbitw,0),ibay,ibit)
-         nval4=nvals(1); call pkb(nval4,min(nbits,nbitw  ),ibay,ibit)
-      else
-         call pkb(nval,nbits,ibay,ibit)
-      endif
+      nval8=nval
+      nval4=nvals(2)
+      call pkb(nval4,max(nbits-nbitw,0),ibay,ibit)
+      nval4=nvals(1)
+      call pkb(nval4,min(nbits,nbitw  ),ibay,ibit)
 
       end subroutine

src/rdcmps.f

@@ -91,7 +91,8 @@ SUBROUTINE RDCMPS(LUN)
             IVAL = LREF+NINC
          ENDIF
          IF(ITYP.EQ.1) THEN
-            NBMP=IVAL; CALL USRTPL(LUN,N,NBMP)
+            NBMP=INT(IVAL)
+            CALL USRTPL(LUN,N,NBMP)
             GOTO 1
          ENDIF
          IF(IVAL.LT.LPS(NBIT)) VAL(N,LUN) = UPS(IVAL,NODE)

src/ufbget.f

@@ -109,7 +109,8 @@ RECURSIVE SUBROUTINE UFBGET(LUNIT,TAB,I1,IRET,STR)
          GOTO 20
       ELSEIF(ITP(NODE).EQ.1) THEN
          CALL UPB8(IVAL,NBIT(N),MBIT(N),MBAY(1,LUN))
-         NBMP=IVAL; CALL USRTPL(LUN,N,NBMP)
+         NBMP=INT(IVAL)
+         CALL USRTPL(LUN,N,NBMP)
          GOTO 10
       ENDIF
       ENDDO

src/ufbmex.f

@@ -22,22 +22,18 @@
 C> with actual filenames on the local system, typically via a Fortran
 C> "OPEN" statement.
 C>
-C> @param[in] LUNIT   -- integer: Fortran logical unit number for BUFR
-C>                       file
-C> @param[in] LUNDX   -- integer: Fortran logical unit number
-C>                       containing DX BUFR table information
-C>                       associated with BUFR messages in LUNIT
-C> @param[in] INEW    -- integer: Processing option
-C>                       - 0 = Initialize the internal arrays, then
-C>                             read all BUFR messages from LUNIT into
-C>                             internal arrays
-C>                       - Otherwise, read all BUFR messages from LUNIT
-C>                         and append them to the existing messages
-C>                         within the internal arrays
-C> @param[out] IRET   -- integer: Number of BUFR messages that were
-C>                       read from LUNIT and stored into internal arrays
-C> @param[out] MESG   -- integer(*): Types of BUFR messages that were
-C>                       read from LUNIT and stored into internal arrays
+C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR file.
+C> @param[in] LUNDX - integer: Fortran logical unit number containing DX
+C> BUFR table information associated with BUFR messages in LUNIT.
+C> @param[in] INEW - integer: Processing option
+C> - 0 = Initialize the internal arrays, then read all BUFR messages
+C> from LUNIT into internal arrays
+C> - Otherwise, read all BUFR messages from LUNIT and append them to the
+C> existing messages within the internal arrays
+C> @param[out] IRET - integer: Number of BUFR messages that were read
+C> from LUNIT and stored into internal arrays.
+C> @param[out] MESG - integer(*): Types of BUFR messages that were read
+C> from LUNIT and stored into internal arrays.
 C>
 C> @author J. Woollen @date 2012-01-26
       RECURSIVE SUBROUTINE UFBMEX(LUNIT,LUNDX,INEW,IRET,MESG)
@@ -53,7 +49,8 @@ RECURSIVE SUBROUTINE UFBMEX(LUNIT,LUNDX,INEW,IRET,MESG)
 
       CHARACTER*128 BORT_STR,ERRSTR
 
-      INTEGER       MESG(*), IRET(*)
+      INTEGER MESG(*), IRET(*), LUNIT(*), LUNDX(*), INEW(*)
+      INTEGER MY_LUNIT(1), MY_LUNDX(1), MY_INEW(1)
 
 C-----------------------------------------------------------------------
 C-----------------------------------------------------------------------
@@ -67,7 +64,7 @@ RECURSIVE SUBROUTINE UFBMEX(LUNIT,LUNDX,INEW,IRET,MESG)
          CALL X84(LUNIT,MY_LUNIT,1)
          CALL X84(LUNDX,MY_LUNDX,1)
          CALL X84(INEW,MY_INEW,1)
-         IF (MY_INEW.EQ.0) THEN
+         IF (MY_INEW(1).EQ.0) THEN
             NMESG = 0
          ELSE
             NMESG = MSGP(0)
@@ -86,7 +83,7 @@ RECURSIVE SUBROUTINE UFBMEX(LUNIT,LUNDX,INEW,IRET,MESG)
 
       CALL OPENBF(LUNIT,'IN',LUNDX)
 
-      IF(INEW.EQ.0) THEN
+      IF(INEW(1).EQ.0) THEN
          MSGP(0) = 0
          MUNIT = 0
          MLAST = 0
@@ -192,14 +189,14 @@ RECURSIVE SUBROUTINE UFBMEX(LUNIT,LUNDX,INEW,IRET,MESG)
          CALL CLOSBF(LUNIT)
       ELSE
          IF(MUNIT.NE.0) CALL CLOSBF(LUNIT)
-         IF(MUNIT.EQ.0) MUNIT = LUNIT
+         IF(MUNIT.EQ.0) MUNIT = LUNIT(1)
       ENDIF
 
 C  EXITS
 C  -----
 
       RETURN
 900   WRITE(BORT_STR,'("BUFRLIB: UFBMEX - ERROR READING MESSAGE '//
-     . 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') NMSG+1,LUNIT
+     . 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') NMSG+1,LUNIT(1)
       CALL BORT(BORT_STR)
       END

src/ufbtab.f

@@ -228,7 +228,8 @@ RECURSIVE SUBROUTINE UFBTAB(LUNIN,TAB,I1,I2,IRET,STR)
          NBIT = IBT(NODE)
          IF(ITP(NODE).EQ.1) THEN
             CALL UPB8(IVAL,NBIT,MBIT,MBAY(1,LUN))
-            NBMP=IVAL; CALL USRTPL(LUN,N,NBMP)
+            NBMP=INT(IVAL)
+            CALL USRTPL(LUN,N,NBMP)
          ENDIF
          DO I=1,NNOD
          IF(NODS(I).EQ.NODE) THEN

src/ufbtam.f

@@ -154,7 +154,8 @@ RECURSIVE SUBROUTINE UFBTAM(TAB,I1,I2,IRET,STR)
             NBIT = IBT(NODE)
             IF(ITP(NODE).EQ.1) THEN
                CALL UPB8(IVAL,NBIT,MBIT,MBAY(1,LUN))
-               NBMP=IVAL; CALL USRTPL(LUN,N,NBMP)
+               NBMP=INT(IVAL)
+               CALL USRTPL(LUN,N,NBMP)
             ENDIF
             DO I=1,NNOD
             IF(NODS(I).EQ.NODE) THEN

src/upb8.f

@@ -37,16 +37,15 @@ subroutine upb8(nval,nbits,ibit,ibay)
 !----------------------------------------------------------------------
 
       if(nbits<0 ) call bort('BUFRLIB: UPB8 - nbits < zero !!!!!')
-      if(nbits>64) nval=0
-      if(nbits>64) return
-
-      if(nbitw==32) then
-         jbit=ibit; nvals=0
-         call upb(nvals(2),max(nbits-nbitw,0),ibay,jbit)
-         call upb(nvals(1),min(nbitw,nbits  ),ibay,jbit)
-         nval=nval8
-      else
-         call upbb(nval,nbits,ibit,ibay)
+      if(nbits>64) then
+         nval=0
+         return
       endif
 
+      jbit=ibit
+      nvals=0
+      call upb(nvals(2),max(nbits-nbitw,0),ibay,jbit)
+      call upb(nvals(1),min(nbitw,nbits  ),ibay,jbit)
+      nval=nval8
+
       end subroutine

src/usrtpl.f

@@ -8,7 +8,7 @@
 C> such as when the node is either a Table A mnemonic or a delayed
 C> replication factor.
 C>
-C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
+C> @param[in] LUN - integer: file ID.
 C> @param[in] INVN - integer: starting jump/link table index of the node
 C> to be expanded within the subset template.
 C> @param[in] NBMP - integer: number of times by which INVN is to be
@@ -74,7 +74,7 @@ SUBROUTINE USRTPL(LUN,INVN,NBMP)
          DRS  = TYP(NODI) .EQ. 'DRS'
          DRB  = TYP(NODI) .EQ. 'DRB'
          DRX  = DRP .OR. DRS .OR. DRB
-         IVAL = VAL(INVN,LUN)
+         IVAL = NINT(VAL(INVN,LUN))
          JVAL = 2**IBT(NODI)-1
          VAL(INVN,LUN) = IVAL+NBMP
          IF(DRB.AND.NBMP.NE.1) GOTO 901

src/writlc.f

@@ -113,7 +113,8 @@ RECURSIVE SUBROUTINE WRITLC(LUNIT,CHR,STR)
             N = N+1
             NODE = INV(N,LUN)
             IF(ITP(NODE).EQ.1) THEN
-               CALL USRTPL(LUN,N,MATX(N,NCOL))
+               NBMP=INT(MATX(N,NCOL))
+               CALL USRTPL(LUN,N,NBMP)
             ELSEIF(CTAG.EQ.TAG(NODE)) THEN
                ITAGCT = ITAGCT + 1
                IF(ITAGCT.EQ.IOID) THEN
@@ -223,8 +224,4 @@ RECURSIVE SUBROUTINE WRITLC(LUNIT,CHR,STR)
 904   WRITE(BORT_STR,'("BUFRLIB: WRITLC - MNEMONIC ",A," DOES NOT '//
      . 'REPRESENT A CHARACTER ELEMENT (TYP=",A,")")') CTAG,TYP(NODE)
       CALL BORT(BORT_STR)
-905   WRITE(BORT_STR,'("BUFRLIB: WRITLC - THE MOST RECENTLY WRITTEN '//
-     . ' SUBSET NO. (",I3,") IN MSG .NE. THE STORED VALUE FOR THE NO.'//
-     . ' OF SUBSETS (",I3,") IN MSG")') NSUBS,NSUB(LUN)
-      CALL BORT(BORT_STR)
       END