sntbbe.f

Go to the documentation of this file.

C> @file
C> @brief Store a master Table B entry into Fortran arrays
 
C> This subroutine stores an entry that was previously read from an
C> ASCII master Table B file into a set of merged Fortran arrays.
C>
C> @author J. Ator
C> @date 2007-01-19
C>
C> @param[in] IFXYN  -- integer: Bit-wise representation of FXY number
C> @param[in]  LINE  -- character*(*): Table B entry
C> @param[in] MXMTBB -- 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[out] NMTBB -- 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] CMSCL -- character*4(*): Merged array containing
C>                      scale factors
C> @param[out] CMSREF -- character*12(*): Merged array containing
C>                       reference values
C> @param[out] CMBW  -- character*4(*): Merged array containing
C>                      bit widths
C> @param[out] CMUNIT -- character*24(*): Merged array containing units
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] CMELEM -- 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-05-17 | J. Ator | Allow up to 24 characters in cmunit |
C> | 2021-09-30 | J. Ator | Replace jstchr with Fortran intrinsic adjustl; replace rjust with Fortran intrinsic adjustr |
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(24,*)
    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.
 
    tags(2) = adjustl( tags(2) )
    IF ( tags(2) .EQ. ' ' ) THEN
        bort_str2 = '                  HAS MISSING SCALE FACTOR'
        GOTO 901
    ENDIF
    tags(2)(1:4) = adjustr( tags(2)(1:4) )
        DO ii = 1, 4
        cmscl ( ii, nmtbb ) = tags(2)(ii:ii)
        ENDDO
 
C   Reference value.
 
    tags(3) = adjustl( tags(3) )
    IF ( tags(3) .EQ. ' ' ) THEN
        bort_str2 = '                  HAS MISSING REFERENCE VALUE'
        GOTO 901
    ENDIF
    tags(3)(1:12) = adjustr( tags(3)(1:12) )
        DO ii = 1, 12
        cmsref ( ii, nmtbb ) = tags(3)(ii:ii)
        ENDDO
 
C   Bit width.
 
    tags(4) = adjustl( tags(4) )
    IF ( tags(4) .EQ. ' ' ) THEN
        bort_str2 = '                  HAS MISSING BIT WIDTH'
        GOTO 901
    ENDIF
    tags(4)(1:4) = adjustr( 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
        tags(5) = adjustl( tags(5) )
            DO ii = 1, 24
            cmunit( ii, nmtbb ) = tags(5)(ii:ii)
            ENDDO
    ELSE
            DO ii = 1, 24
            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.
        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, nmtbb ) = 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( nmtbb ) = tags(2)(1:4)
        ENDIF
        IF ( ntag .GT. 2 ) THEN
C       The third additional field contains the element name.
        tags(3) = adjustl( tags(3) )
                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