sntbbe.f

Go to the documentation of this file.

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