sntbde.f

Go to the documentation of this file.

C> @file
C> @brief Store a master Table D entry into Fortran arrays
C>
C> @author J. Ator @date 2007-01-19
 
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> @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> @author J. Ator @date 2007-01-19
        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