sntbfe.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2017-11-02
    
C> THIS SUBROUTINE READS A COMPLETE ENTRY (CORRESPONDING
C>   TO THE INPUT FXY NUMBER) FROM AN ASCII MASTER CODE/FLAG TABLE AND
C>   STORES THE OUTPUT INTO AN INTERNAL MEMORY STRUCTURE.
C>
C> PROGRAM HISTORY LOG:
C> 2017-11-02  J. ATOR    -- ORIGINAL AUTHOR
C>
C> USAGE:    CALL SNTBFE ( LUNT, IFXYN, LINE )
C>   INPUT ARGUMENT LIST:
C>     LUNT     - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING MASTER CODE/FLAG TABLE INFORMATION
C>     IFXYN    - INTEGER: BIT-WISE REPRESENTATION OF FXY NUMBER
C>     LINE     - CHARACTER*(*): FIRST LINE OF TABLE ENTRY
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        ADN30    BORT2    IFXY     IGETFXY
C>                               IGETNTBL JSTCHR   PARSTR   STRNUM
C>                               STRTBFE
C>    THIS ROUTINE IS CALLED BY: RDMTBF
C>                               Normally not called by any application
C>                               programs.
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
          CALL jstchr( cval(ii), ier )
          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

        CALL jstchr( tags(2), ier )
        CALL strnum( tags(2), ival )

C       Find the last non-blank character in the meaning string.

        CALL jstchr( tags(3), ier )
        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