nemtbb.f

Go to the documentation of this file.

C> @file
C> @brief Get information about a Table B descriptor
C>
C> @author J. Woollen @date 1994-01-06
 
C> Get information about a Table B descriptor.
C>
C> This subroutine returns information about a Table B descriptor
C> from the internal DX BUFR tables.
C>
C> @param[in] LUN - integer: File ID.
C> @param[in] ITAB - integer: Positional index of descriptor within
C> internal Table B.
C> @param[out] UNIT - character*24: Units of descriptor.
C> @param[out] ISCL - integer: Scale factor of descriptor.
C> @param[out] IREF - integer: Reference value of descriptor.
C> @param[out] IBIT - integer: Bit width of descriptor.
C>
C> @author J. Woollen @date 1994-01-06
 
      SUBROUTINE nemtbb(LUN,ITAB,UNIT,ISCL,IREF,IBIT)
 
      USE moda_tababd
 
      CHARACTER*128 BORT_STR
      CHARACTER*24  UNIT
      CHARACTER*8   NEMO
      real*8        mxr
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
      mxr = 1e11-1
 
      IF(itab.LE.0 .OR. itab.GT.ntbb(lun)) GOTO 900
 
C  PULL OUT TABLE B INFORMATION
C  ----------------------------
 
      idn  = idnb(itab,lun)
      nemo = tabb(itab,lun)( 7:14)
      unit = tabb(itab,lun)(71:94)
      CALL strnum(tabb(itab,lun)( 95: 98),iscl,ierns)
      CALL strnum(tabb(itab,lun)( 99:109),iref,ierns)
      CALL strnum(tabb(itab,lun)(110:112),ibit,ierns)
 
C  CHECK TABLE B CONTENTS
C  ----------------------
 
      IF(idn.LT.ifxy('000000')) GOTO 901
      IF(idn.GT.ifxy('063255')) GOTO 901
 
      IF(iscl.LT.-999 .OR. iscl.GT.999) GOTO 902
      IF(iref.LE.-mxr .OR. iref.GE.mxr) GOTO 903
      IF(ibit.LE.0) GOTO 904
      IF(unit(1:5).NE.'CCITT' .AND. ibit.GT.32      ) GOTO 904
      IF(unit(1:5).EQ.'CCITT' .AND. mod(ibit,8).NE.0) GOTO 905
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str,'("BUFRLIB: NEMTBB - ITAB (",I7,") NOT FOUND IN '//
     . 'TABLE B")') itab
      CALL bort(bort_str)
901   WRITE(bort_str,'("BUFRLIB: NEMTBB - INTEGER REPRESENTATION OF '//
     . 'DESCRIPTOR FOR TABLE B MNEMONIC ",A," (",I7,") IS OUTSIDE '//
     . 'RANGE 0-16383 (16383 -> 0-63-255)")') nemo,idn
      CALL bort(bort_str)
902   WRITE(bort_str,'("BUFRLIB: NEMTBB - SCALE VALUE FOR TABLE B '//
     .'MNEMONIC ",A," (",I7,") IS OUTSIDE RANGE -999 TO 999")')
     . nemo,iscl
      CALL bort(bort_str)
903   WRITE(bort_str,'("BUFRLIB: NEMTBB - REFERENCE VALUE FOR TABLE B'//
     .' MNEMONIC ",A," (",I7,") IS OUTSIDE RANGE +/- 1E11-1")')
     . nemo,iref
      CALL bort(bort_str)
904   WRITE(bort_str,'("BUFRLIB: NEMTBB - BIT WIDTH FOR NON-CHARACTER'//
     . ' TABLE B MNEMONIC ",A," (",I7,") IS > 32")') nemo,ibit
      CALL bort(bort_str)
905   WRITE(bort_str,'("BUFRLIB: NEMTBB - BIT WIDTH FOR CHARACTER '//
     . 'TABLE B MNEMONIC ",A," (",I7,") IS NOT A MULTIPLE OF 8")')
     . nemo,ibit
      CALL bort(bort_str)
      END