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