sntbfe.f

Go to the documentation of this file.

C> @file
C> @brief Store a master Code/Flag table entry into internal memory.
C>
C> @author J. Ator @date 2017-11-02
 
C> Store a master Code/Flag table entry into internal memory.
C>
C> This subroutine reads an entire entry from a previously-opened
C> ASCII master Code/Flag table file and stores it into an
C> internal memory structure.
C>
C> @param[in] LUNT   - integer: Fortran logical unit number for
C> ASCII file containing Code/Flag table information.
C> @param[in] IFXYN  - integer: Bit-wise representation of FXY number.
C>
C> @author J. Ator @date 2017-11-02
        SUBROUTINE sntbfe ( LUNT, IFXYN )
 
        use bufrlib
 
        CHARACTER*160   CLINE, TAGS(4), CDSTR(2), ADSC(10), CVAL(25)
        CHARACTER*128   BORT_STR1, BORT_STR2
        CHARACTER*6     ADN30, CLEMON, CDSC
        dimension       idfxy(10), idval(25)
 
        LOGICAL DONE, LSTNBLK
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C       We already have the FXY number.  Now we need to read and parse
C       all of the remaining lines from the table entry for this FXY
C       number.  The information for each individual code figure or bit
C       number will then be stored as a separate entry within the
C       internal memory structure.
 
        done = .false.
        nidfxy = 0
        nidval = 0
 
        DO WHILE ( .NOT. done )
 
            IF ( igetntbl( lunt, cline ) .NE. 0 ) THEN
                bort_str2 = '                  IS INCOMPLETE'
                GOTO 900
            ENDIF
 
            CALL parstr ( cline, tags, 4, ntag, '|', .false. )
            IF ( ( ntag .LT. 2 ) .OR. ( ntag .GT. 3 ) ) THEN
                bort_str2 = '                  HAS BAD CARD'
                GOTO 900
            ENDIF
 
            IF ( ntag .EQ. 2 ) THEN
 
C               This line contains a list of dependencies.
 
                CALL parstr ( tags(2), cdstr, 2, ntag, '=', .false. )
                IF ( ntag .NE. 2 ) THEN
                  bort_str2 = '           HAS BAD DEPENDENCY CARD'
                  GOTO 900
                ENDIF
 
C               Parse the list of FXY numbers.
 
                CALL parstr ( cdstr(1), adsc, 10, nidfxy, ',', .false. )
                IF ( nidfxy .EQ. 0 ) THEN
                  bort_str2 = '        HAS BAD DEPENDENCY LIST (FXY)'
                  GOTO 900
                ENDIF
                DO ii = 1, nidfxy
                  IF ( igetfxy( adsc(ii), cdsc ) .NE. 0 ) THEN
                    bort_str2 = '        HAS BAD DEPENDENCY (FXY)'
                    GOTO 900
                  ENDIF
                  idfxy(ii) = ifxy( cdsc )
                ENDDO
 
C               Parse the list of values.
 
                CALL parstr ( cdstr(2), cval, 25, nidval, ',', .false. )
                IF ( nidval .EQ. 0 ) THEN
                  bort_str2 = '        HAS BAD DEPENDENCY LIST (VAL)'
                  GOTO 900
                ENDIF
                DO ii = 1, nidval
                  cval(ii) = adjustl( cval(ii) )
                  CALL strnum ( cval(ii), ival, ier )
                  idval(ii) = ival
                ENDDO
 
            ELSE
 
C               This line contains a value (code figure or bit number)
C               and corresponding meaning.
 
                ipt = index( tags(2), ' >' )
                IF ( ipt .EQ. 0 ) THEN
 
C                 This is the last line for this table entry.
 
                  done = .true.
                ELSE
                  tags(2)(ipt+1:ipt+1) = ' '
                ENDIF
 
                tags(2) = adjustl( tags(2) )
                CALL strnum ( tags(2), ival, ier )
 
C               Find the last non-blank character in the meaning string.
 
                tags(3) = adjustl( tags(3) )
                lt3 = len(tags(3))
                lstnblk = .false.
                DO WHILE ( ( lt3 .GT. 0 ) .AND. ( .NOT. lstnblk ) )
                  IF ( tags(3)(lt3:lt3) .NE. ' ' ) THEN
                    lstnblk = .true.
                  ELSE
                    lt3 = lt3 - 1
                  ENDIF
                ENDDO
 
C               Store the information for this value within the internal
C               memory structure.
 
                IF ( ( nidfxy .EQ. 0 ) .AND. ( nidval .EQ. 0 ) ) THEN
                  CALL strtbfe_c ( ifxyn, ival, tags(3), lt3, -1, -1 )
                ELSE
                  DO ii = 1, nidfxy
                    DO jj = 1, nidval
                      CALL strtbfe_c ( ifxyn, ival, tags(3), lt3,
     +                                 idfxy(ii), idval(jj) )
                    ENDDO
                  ENDDO
                ENDIF
 
            ENDIF
 
        ENDDO
 
        RETURN
 
 900    clemon = adn30( ifxyn, 6 )
        WRITE(bort_str1,'("BUFRLIB: SNTBFE - TABLE F ENTRY FOR' //
     .     ' ELEMENT DESCRIPTOR: ",5A)')
     .     clemon(1:1), '-', clemon(2:3), '-', clemon(4:6)
        CALL bort2(bort_str1,bort_str2)
        END