sntbbe.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2007-01-19
    
C> THIS SUBROUTINE PARSES AN ENTRY THAT WAS PREVIOUSLY READ
C>   FROM AN ASCII MASTER TABLE B FILE AND THEN STORES THE OUTPUT INTO
C>   THE MERGED ARRAYS.
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 SNTBBE ( IFXYN, LINE, MXMTBB,
C>                         NMTBB, IMFXYN, CMSCL, CMSREF, CMBW,
C>                         CMUNIT, CMMNEM, CMDSC, CMELEM )
C>   INPUT ARGUMENT LIST:
C>     IFXYN    - INTEGER: BIT-WISE REPRESENTATION OF FXY NUMBER FOR
C>                TABLE ENTRY; THIS FXY NUMBER IS THE ELEMENT DESCRIPTOR
C>     LINE     - CHARACTER*(*): TABLE ENTRY
C>     MXMTBB   - INTEGER: MAXIMUM NUMBER OF ENTRIES TO BE STORED IN
C>                MERGED MASTER TABLE B 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>
C>   OUTPUT ARGUMENT LIST:
C>     NMTBB    - INTEGER: NUMBER OF ENTRIES IN MERGED MASTER TABLE B
C>                ARRAYS
C>     IMFXYN(*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
C>                REPRESENTATIONS OF FXY NUMBERS (I.E. ELEMENT
C>                DESCRIPTORS)
C>     CMSCL(*) - CHARACTER*4: MERGED ARRAY CONTAINING SCALE FACTORS
C>     CMSREF(*)- CHARACTER*12: MERGED ARRAY CONTAINING REFERENCE VALUES
C>     CMBW(*)  - CHARACTER*4: MERGED ARRAY CONTAINING BIT WIDTHS
C>     CMUNIT(*)- CHARACTER*14: MERGED ARRAY CONTAINING UNITS
C>     CMMNEM(*)- CHARACTER*8: MERGED ARRAY CONTAINING MNEMONICS
C>     CMDSC(*) - CHARACTER*4: MERGED ARRAY CONTAINING DESCRIPTOR CODES 
C>     CMELEM(*)- CHARACTER*120: MERGED ARRAY CONTAINING ELEMENT NAMES 
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT     BORT2    JSTCHR   NEMOCK
C>                               PARSTR   RJUST
C>    THIS ROUTINE IS CALLED BY: RDMTBB
C>                               Normally not called by any application
C>                               programs.
C>
    SUBROUTINE sntbbe ( IFXYN, LINE, MXMTBB,
     .              nmtbb, imfxyn, cmscl, cmsref, cmbw,
     .              cmunit, cmmnem, cmdsc, cmelem )



    character*(*)   line
    character*200   tags(10), wktag
    character*128   bort_str1, bort_str2
    character*4 cmdsc(*)
    character   cmelem(120,*)
    character   cmunit(14,*)
    character   cmsref(12,*)
    character   cmmnem(8,*)
    character   cmscl(4,*), cmbw(4,*)

    integer     imfxyn(*)

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

    IF ( nmtbb .GE. mxmtbb ) goto 900
    nmtbb = nmtbb + 1

C   Store the FXY number.  This is the element descriptor.

    imfxyn( nmtbb ) = ifxyn

C   Parse the table entry.

    CALL parstr( line, tags, 10, ntag, '|', .false. )
    IF ( ntag .LT. 4 ) THEN
        bort_str2 = '                  HAS TOO FEW FIELDS'
        goto 901
    ENDIF

C   Scale factor.

    CALL jstchr( tags(2), iret )
    IF ( iret .NE. 0 ) THEN
        bort_str2 = '                  HAS MISSING SCALE FACTOR'
        goto 901
    ENDIF
    rj = rjust( tags(2)(1:4) )
        DO ii = 1, 4
        cmscl( ii, nmtbb ) = tags(2)(ii:ii)
        ENDDO

C   Reference value.

    CALL jstchr( tags(3), iret )
    IF ( iret .NE. 0 ) THEN
        bort_str2 = '                  HAS MISSING REFERENCE VALUE'
        goto 901
    ENDIF
    rj = rjust( tags(3)(1:12) )
        DO ii = 1, 12
        cmsref( ii, nmtbb ) = tags(3)(ii:ii)
        ENDDO

C   Bit width.

    CALL jstchr( tags(4), iret )
    IF ( iret .NE. 0 ) THEN
        bort_str2 = '                  HAS MISSING BIT WIDTH'
        goto 901
    ENDIF
    rj = rjust( tags(4)(1:4) )
        DO ii = 1, 4
        cmbw( ii, nmtbb ) = tags(4)(ii:ii)
        END DO

C   Units.  Note that this field is allowed to be blank.

    IF ( ntag .GT. 4 ) THEN
        CALL jstchr( tags(5), iret )
            DO ii = 1, 14
            cmunit( ii, nmtbb ) = tags(5)(ii:ii)
            ENDDO
    ELSE
            DO ii = 1, 14
            cmunit( ii, nmtbb ) = ' '
            ENDDO
    ENDIF

C   Comment (additional) fields.  Any of these fields may be blank.

    cmdsc( nmtbb ) = ' '
        DO ii = 1, 8
        cmmnem( ii, nmtbb ) = ' '
        ENDDO
        DO ii = 1, 120 
        cmelem( ii, nmtbb ) = ' '
        ENDDO
    IF ( ntag .GT. 5 ) THEN
        wktag = tags(6)
        CALL parstr( wktag, 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, nmtbb ) = 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( nmtbb ) = tags(2)(1:4)
        ENDIF
        IF ( ntag .GT. 2 ) THEN
C       The third additional field contains the element name.
        CALL jstchr( tags(3), iret )
                DO ii = 1, 120 
            cmelem( ii, nmtbb ) = tags(3)(ii:ii)
                ENDDO
        ENDIF
    ENDIF

    RETURN
 900    CALL bort('BUFRLIB: SNTBBE - OVERFLOW OF MERGED ARRAYS')
 901    bort_str1 = 'BUFRLIB: SNTBBE - CARD BEGINNING WITH: ' //
     .     line(1:20)
    CALL bort2(bort_str1,bort_str2)
    END