sntbde.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2007-01-19
    
C> THIS SUBROUTINE PARSES THE FIRST LINE OF AN ENTRY THAT WAS
C>   PREVIOUSLY READ FROM AN ASCII MASTER TABLE D FILE AND STORES THE
C>   OUTPUT INTO THE MERGED ARRAYS.  IT THEN READS AND PARSES ALL
C>   REMAINING LINES FOR THAT SAME ENTRY AND THEN LIKEWISE STORES THAT
C>   OUTPUT INTO THE MERGED ARRAYS.  THE RESULT IS THAT, UPON OUTPUT,
C>   THE MERGED ARRAYS NOW CONTAIN ALL OF THE INFORMATION FOR THE
C>   CURRENT TABLE ENTRY.
C>
C> PROGRAM HISTORY LOG:
C> 2007-01-19  J. ATOR    -- ORIGINAL AUTHOR
C> 2021-01-08  J. ATOR    -- MODIFIED MSTABS ARRAY DECLARATIONS
C>                           FOR GNUv10 PORTABILITY
C>
C> USAGE:    CALL SNTBDE ( LUNT, IFXYN, LINE, MXMTBD, MXELEM,
C>                         NMTBD, IMFXYN, CMMNEM, CMDSC, CMSEQ,
C>                         NMELEM, IEFXYN, CEELEM )
C>   INPUT ARGUMENT LIST:
C>     LUNT     - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING MASTER TABLE D INFORMATION
C>     IFXYN    - INTEGER: BIT-WISE REPRESENTATION OF FXY NUMBER FOR
C>                TABLE ENTRY; THIS FXY NUMBER IS THE SEQUENCE DESCRIPTOR
C>     LINE     - CHARACTER*(*): FIRST LINE OF TABLE ENTRY
C>     MXMTBD   - INTEGER: MAXIMUM NUMBER OF ENTRIES TO BE STORED IN
C>                MERGED MASTER TABLE D ARRAYS; THIS SHOULD BE THE SAME
C>                NUMBER AS WAS USED TO DIMENSION THE OUTPUT ARRAYS IN
C>                THE CALLING PROGRAM, AND IT IS USED BY THIS SUBROUTINE
C>                TO ENSURE THAT IT DOESN'T OVERFLOW THESE ARRAYS
C>     MXELEM   - INTEGER: MAXIMUM NUMBER OF ELEMENTS TO BE STORED PER
C>                ENTRY WITHIN THE MERGED MASTER TABLE D ARRAYS; THIS
C>                SHOULD BE THE SAME NUMBER AS WAS USED TO DIMENSION THE
C>                OUTPUT ARRAYS IN THE CALLING PROGRAM, AND IT IS USED
C>                BY THIS SUBROUTINE TO ENSURE THAT IT DOESN'T OVERFLOW
C>                THESE ARRAYS
C>
C>   OUTPUT ARGUMENT LIST:
C>     NMTBD    - INTEGER: NUMBER OF ENTRIES IN MERGED MASTER TABLE D
C>                ARRAYS
C>     IMFXYN(*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
C>                REPRESENTATIONS OF FXY NUMBERS (I.E. SEQUENCE
C>                DESCRIPTORS)
C>     CMMNEM(*)- CHARACTER*8: MERGED ARRAY CONTAINING MNEMONICS
C>     CMDSC(*) - CHARACTER*4: MERGED ARRAY CONTAINING DESCRIPTOR CODES 
C>     CMSEQ(*) - CHARACTER*120: MERGED ARRAY CONTAINING SEQUENCE NAMES
C>     NMELEM(*)- INTEGER: MERGED ARRAY CONTAINING NUMBER OF ELEMENTS
C>                STORED FOR EACH ENTRY
C>   IEFXYN(*,*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
C>                REPRESENTATIONS OF ELEMENT FXY NUMBERS
C>   CEELEM(*,*)- CHARACTER*120: MERGED ARRAY CONTAINING ELEMENT NAMES 
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        ADN30    BORT     BORT2    IFXY
C>                               IGETFXY  IGETNTBL JSTCHR   NEMOCK
C>                               PARSTR
C>    THIS ROUTINE IS CALLED BY: RDMTBD
C>                               Normally not called by any application
C>                               programs.
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.
        CALL jstchr( tags(1), iret )
C       If there is a mnemonic, then make sure it's legal.
        IF ( ( iret .EQ. 0 ) .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.
        CALL jstchr( tags(2), iret )
        cmdsc( nmtbd ) = tags(2)(1:4)
        ENDIF
        IF ( ntag .GT. 2 ) THEN
C       The third additional field contains the sequence name.
        CALL jstchr( tags(3), iret )
                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
        CALL jstchr( tags(3), iret )
        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