sntbde.f

Go to the documentation of this file.

C> @file
C> @brief Store a master Table D entry into Fortran arrays
 
C> This subroutine stores the first line of an entry that was
C> previously read from an ASCII master Table D file into a set of
C> merged Fortran arrays.  It then reads and stores all remaining
C> lines of that same entry into the same merged Fortran arrays.
C>
C> @author J. Ator
C> @date 2007-01-19
C>
C> @param[in] LUNT   -- integer: Fortran logical unit number for
C>                      ASCII file containing Table D information
C> @param[in] IFXYN  -- integer: Bit-wise representation of FXY number
C> @param[in]  LINE  -- character*(*): First line of Table D entry
C> @param[in] MXMTBD -- integer: Dimensioned size (in integers) of
C>                      merged output arrays; used by the subroutine
C>                      to ensure that it doesn't overflow these
C>                      arrays
C> @param[in] MXELEM -- integer: Maximum number of elements to be
C>                      stored per Table D sequence within merged
C>                      output arrays; used by the subroutine to
C>                      ensure that it doesn't overflow these arrays
C> @param[out] NMTBD -- integer: Number of entries in merged output
C>                      arrays
C> @param[out] IMFXYN -- integer(*): Merged array containing bit-wise
C>                       representations of FXY numbers
C> @param[out] CMMNEM -- character*8(*): Merged array containing
C>                       mnemonics
C> @param[out] CMDSC -- character*4(*): Merged array containing
C>                      descriptor codes
C> @param[out] CMSEQ -- character*120(*): Merged array containing
C>                      sequence names
C> @param[out] NMELEM -- integer(*): Merged array containing number of
C>                       elements stored for each sequence
C> @param[out] IEFXYN -- integer(*,*): Merged array containing bit-wise
C>                       representations of element FXY numbers
C> @param[out] CEELEM -- character*120(*,*): Merged array containing
C>                       element names
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2007-01-19 | J. Ator | Original author |
C> | 2021-01-08 | J. Ator | Modified mstabs array declarations for GNUv10 portability |
C> | 2021-09-30 | J. Ator | Replace jstchr with Fortran intrinsic adjustl |
C>
    SUBROUTINE sntbde ( LUNT, IFXYN, LINE, MXMTBD, MXELEM,
     .              NMTBD, IMFXYN, CMMNEM, CMDSC, CMSEQ,
     .              NMELEM, IEFXYN, CEELEM )
 
    character*(*)   line
    character*200   tags(10), cline
    character*128   bort_str1, bort_str2
    character*120   ceelem(mxmtbd,mxelem)
    character*6 adn30, adsc, clemon
    character*4 cmdsc(*)
    character   cmseq(120,*)
    character   cmmnem(8,*)
 
    integer     imfxyn(*), nmelem(*),
     .                  iefxyn(mxmtbd,mxelem)
 
    logical done
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
    IF ( nmtbd .GE. mxmtbd ) GOTO 900
    nmtbd = nmtbd + 1
 
C   Store the FXY number.  This is the sequence descriptor.
 
    imfxyn( nmtbd ) = ifxyn
 
C   Is there any other information within the first line of the
C   table entry?  If so, it follows a "|" separator.
 
        DO ii = 1, 8
        cmmnem ( ii, nmtbd ) = ' '
        ENDDO
    cmdsc( nmtbd ) = ' '
        DO ii = 1, 120
        cmseq ( ii, nmtbd ) = ' '
        ENDDO
    ipt = index( line, '|' )
    IF ( ipt .NE. 0 ) THEN
 
C       Parse the rest of the line.  Any of the fields may be blank.
 
        CALL parstr ( line(ipt+1:), tags, 10, ntag, ';', .false. )
        IF ( ntag .GT. 0 ) THEN
C       The first additional field contains the mnemonic.
        tags(1) = adjustl( tags(1) )
C               If there is a mnemonic, then make sure it's legal.
                IF ( ( tags(1) .NE. ' ' ) .AND.
     .          ( nemock( tags(1) ) .NE. 0 ) ) THEN
            bort_str2 = '                  HAS ILLEGAL MNEMONIC'
            GOTO 901
        ENDIF
                DO ii = 1, 8
            cmmnem( ii, nmtbd ) = tags(1)(ii:ii)
                ENDDO
        ENDIF
        IF ( ntag .GT. 1 ) THEN
C       The second additional field contains descriptor codes.
        tags(2) = adjustl( tags(2) )
        cmdsc( nmtbd ) = tags(2)(1:4)
        ENDIF
        IF ( ntag .GT. 2 ) THEN
C       The third additional field contains the sequence name.
        tags(3) = adjustl( tags(3) )
                DO ii = 1, 120
            cmseq( ii, nmtbd ) = tags(3)(ii:ii)
                ENDDO
        ENDIF
    ENDIF
 
C   Now, read and parse all remaining lines from this table entry.
C   Each line should contain an element descriptor for the sequence
C   represented by the current sequence descriptor.
 
    nelem = 0
    done = .false.
    DO WHILE ( .NOT. done ) 
        IF ( igetntbl( lunt, cline ) .NE. 0 ) THEN
        bort_str2 = '                  IS INCOMPLETE'
        GOTO 901
        ENDIF
        CALL parstr ( cline, tags, 10, ntag, '|', .false. )
        IF ( ntag .LT. 2 ) THEN
        bort_str2 = '                  HAS BAD ELEMENT CARD'
        GOTO 901
        ENDIF
 
C       The second field contains the FXY number for this element.
 
        IF ( igetfxy( tags(2), adsc ) .NE. 0 ) THEN
        bort_str2 = '                  HAS BAD OR MISSING' //
     .              ' ELEMENT FXY NUMBER'
        GOTO 901
        ENDIF
        IF ( nelem .GE. mxelem ) GOTO 900
        nelem = nelem + 1
        iefxyn ( nmtbd, nelem ) = ifxy( adsc )
 
C       The third field (if it exists) contains the element name.
 
        IF ( ntag .GT. 2 ) THEN
        tags(3) = adjustl( tags(3) )
        ceelem( nmtbd, nelem ) = tags(3)(1:120)
        ELSE
        ceelem( nmtbd, nelem ) = ' '
        ENDIF
 
C       Is this the last line for this table entry?
 
        IF ( index( tags(2), ' >' ) .EQ. 0 ) done = .true.
    ENDDO
    nmelem( nmtbd ) = nelem
 
    RETURN
    
 900    CALL bort('BUFRLIB: SNTBDE - OVERFLOW OF MERGED ARRAYS')
 901    clemon = adn30( ifxyn, 6 )
    WRITE(bort_str1,'("BUFRLIB: SNTBDE - TABLE D ENTRY FOR' //
     .     ' SEQUENCE DESCRIPTOR: ",5A)')    
     .     clemon(1:1), '-', clemon(2:3), '-', clemon(4:6)
    CALL bort2(bort_str1,bort_str2)
    END