31 SUBROUTINE nemtbb(LUN,ITAB,UNIT,ISCL,IREF,IBIT)
35 CHARACTER*128 bort_str
45 IF(itab.LE.0 .OR. itab.GT.ntbb(lun)) goto 900
51 nemo = tabb(itab,lun)( 7:14)
52 unit = tabb(itab,lun)(71:94)
53 iscl =
valx(tabb(itab,lun)( 95: 98))
54 iref =
valx(tabb(itab,lun)( 99:109))
55 ibit =
valx(tabb(itab,lun)(110:112))
60 IF(idn.LT.
ifxy(
'000000')) goto 901
61 IF(idn.GT.
ifxy(
'063255')) goto 901
63 IF(iscl.LT.-999 .OR. iscl.GT.999) goto 902
64 IF(iref.LE.-mxr .OR. iref.GE.mxr) goto 903
65 IF(ibit.LE.0) goto 904
66 IF(unit(1:5).NE.
'CCITT' .AND. ibit.GT.32 ) goto 904
67 IF(unit(1:5).EQ.
'CCITT' .AND. mod(ibit,8).NE.0) goto 905
73 900
WRITE(bort_str,
'("BUFRLIB: NEMTBB - ITAB (",I7,") NOT FOUND IN '//
76 901
WRITE(bort_str,
'("BUFRLIB: NEMTBB - INTEGER REPRESENTATION OF '//
77 .
'DESCRIPTOR FOR TABLE B MNEMONIC ",A," (",I7,") IS OUTSIDE '//
78 .
'RANGE 0-16383 (16383 -> 0-63-255)")') nemo,idn
80 902
WRITE(bort_str,
'("BUFRLIB: NEMTBB - SCALE VALUE FOR TABLE B '//
81 .
'MNEMONIC ",A," (",I7,") IS OUTSIDE RANGE -999 TO 999")')
84 903
WRITE(bort_str,
'("BUFRLIB: NEMTBB - REFERENCE VALUE FOR TABLE B'//
85 .
' MNEMONIC ",A," (",I7,") IS OUTSIDE RANGE +/- 1E11-1")')
88 904
WRITE(bort_str,
'("BUFRLIB: NEMTBB - BIT WIDTH FOR NON-CHARACTER'//
89 .
' TABLE B MNEMONIC ",A," (",I7,") IS > 32")') nemo,ibit
91 905
WRITE(bort_str,
'("BUFRLIB: NEMTBB - BIT WIDTH FOR CHARACTER '//
92 .
'TABLE B MNEMONIC ",A," (",I7,") IS NOT A MULTIPLE OF 8")')
function valx(STR)
This function decodes a real number from a character string.
This module contains array and variable declarations used to store DX BUFR tables internally for mult...
subroutine nemtbb(LUN, ITAB, UNIT, ISCL, IREF, IBIT)
This subroutine returns information about a Table B descriptor from the internal DX BUFR tables...
function ifxy(ADSC)
This function converts an FXY value from its 6 character representation to its bit-wise (integer) rep...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...