sntbfe.f

Go to the documentation of this file.

C> @file
C> @brief Store a master Code/Flag table entry into internal memory
 
C> This subroutine stores the first line of an entry that was
C> previously read from an ASCII master Code/Flag table file into an
C> internal memory structure.  It then reads and stores all remaining
C> lines of that same entry into the same internal memory structure.
C>
C> @author J. Ator
C> @date 2017-11-02
C>
C> @param[in] LUNT   -- integer: Fortran logical unit number for
C>                      ASCII file containing Code/Flag table
C>                      information
C> @param[in] IFXYN  -- integer: Bit-wise representation of FXY number
C> @param[in]  LINE  -- character*(*): First line of Code/Flag table
C>                      entry
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2017-11-02 | J. Ator | Original author |
C> | 2021-09-30 | J. Ator | Replace jstchr with Fortran intrinsic adjustl |
C>
    SUBROUTINE sntbfe ( LUNT, IFXYN, LINE )
 
    character*(*)   line
    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 )
          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 )
 
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 ( ifxyn, ival, tags(3), lt3, -1, -1 )
        ELSE
          DO ii = 1, nidfxy
            DO jj = 1, nidval
              CALL strtbfe ( 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