nemtbb.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS SUBROUTINE CHECKS ALL OF THE PROPERTIES (E.G. FXY
C>   VALUE, UNITS, SCALE FACTOR, REFERENCE VALUE, ETC.) OF A SPECIFIED
C>   MNEMONIC WITHIN THE INTERNAL BUFR TABLE B ARRAYS (IN MODULE
C>   TABABD) IN ORDER TO VERIFY THAT THE VALUES OF THOSE PROPERTIES
C>   ARE ALL LEGAL AND WELL-DEFINED.  IF ANY ERRORS ARE FOUND, THEN AN
C>   APPROPRIATE CALL IS MADE TO BUFR ARCHIVE LIBRARY SUBROUTINE BORT.
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
C>                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
C> 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C>                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C>                           ROUTINE "BORT"; CORRECTED SOME MINOR ERRORS
C> 1999-11-18  J. WOOLLEN -- CHANGED CALL TO FUNCTION "VAL$" TO "VALX"
C>                           (IT HAS BEEN RENAMED TO REMOVE THE
C>                           POSSIBILITY OF THE "$" SYMBOL CAUSING
C>                           PROBLEMS ON OTHER PLATFORMS)
C> 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           INTERDEPENDENCIES
C> 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C>                           DOCUMENTATION; OUTPUTS MORE COMPLETE
C>                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
C>                           ABNORMALLY
C> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C>
C> USAGE:    CALL NEMTBB (LUN, ITAB, UNIT, ISCL, IREF, IBIT)
C>   INPUT ARGUMENT LIST:
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>     ITAB     - INTEGER: POSITIONAL INDEX INTO INTERNAL BUFR TABLE B
C>                ARRAYS FOR MNEMONIC TO BE CHECKED
C>
C>   OUTPUT ARGUMENT LIST:
C>     UNIT     - CHARACTER*24: UNITS OF MNEMONIC
C>     ISCL     - INTEGER: SCALE FACTOR OF MNEMONIC
C>     IREF     - INTEGER: REFERENCE VALUE OF MNEMONIC
C>     IBIT     - INTEGER: BIT WIDTH OF MNEMONIC
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT     IFXY     VALX
C>    THIS ROUTINE IS CALLED BY: CHEKSTAB RESTD    TABENT
C>                               Normally not called by any application
C>                               programs.
C>
      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)
      iscl = valx(tabb(itab,lun)( 95: 98))
      iref = valx(tabb(itab,lun)( 99:109))
      ibit = valx(tabb(itab,lun)(110:112))

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