var/external/bufr/nemtbb.f

   1       SUBROUTINE NEMTBB(LUN,ITAB,UNIT,ISCL,IREF,IBIT)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    NEMTBB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE CHECKS ALL OF THE PROPERTIES (E.G. FXY
   9 C   VALUE, UNITS, SCALE FACTOR, REFERENCE VALUE, ETC.) OF A SPECIFIED
  10 C   MNEMONIC WITHIN THE INTERNAL BUFR TABLE B ARRAYS (IN COMMON BLOCK
  11 C   /TABABD/) IN ORDER TO VERIFY THAT THE VALUES OF THOSE PROPERTIES
  12 C   ARE ALL LEGAL AND WELL-DEFINED.  IF ANY ERRORS ARE FOUND, THEN AN
  13 C   APPROPRIATE CALL IS MADE TO BUFR ARCHIVE LIBRARY SUBROUTINE BORT.
  14 C
  15 C PROGRAM HISTORY LOG:
  16 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  17 C 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
  18 C                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
  19 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  20 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  21 C                           ROUTINE "BORT"; CORRECTED SOME MINOR ERRORS
  22 C 1999-11-18  J. WOOLLEN -- CHANGED CALL TO FUNCTION "VAL$" TO "VALX"
  23 C                           (IT HAS BEEN RENAMED TO REMOVE THE
  24 C                           POSSIBILITY OF THE "$" SYMBOL CAUSING
  25 C                           PROBLEMS ON OTHER PLATFORMS)
  26 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  27 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  28 C                           INTERDEPENDENCIES
  29 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  30 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  31 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  32 C                           ABNORMALLY
  33 C
  34 C USAGE:    CALL NEMTBB (LUN, ITAB, UNIT, ISCL, IREF, IBIT)
  35 C   INPUT ARGUMENT LIST:
  36 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  37 C     ITAB     - INTEGER: POSITIONAL INDEX INTO INTERNAL BUFR TABLE B
  38 C                ARRAYS FOR MNEMONIC TO BE CHECKED
  39 C
  40 C   OUTPUT ARGUMENT LIST:
  41 C     UNIT     - CHARACTER*24: UNITS OF MNEMONIC
  42 C     ISCL     - INTEGER: SCALE FACTOR OF MNEMONIC
  43 C     IREF     - INTEGER: REFERENCE VALUE OF MNEMONIC
  44 C     IBIT     - INTEGER: BIT WIDTH OF MNEMONIC
  45 C
  46 C REMARKS:
  47 C    THIS ROUTINE CALLS:        BORT     IFXY     VALX
  48 C    THIS ROUTINE IS CALLED BY: CHEKSTAB RESTD    TABENT
  49 C                               Normally not called by any application
  50 C                               programs.
  51 C
  52 C ATTRIBUTES:
  53 C   LANGUAGE: FORTRAN 77
  54 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  55 C
  56 C$$$
  57
  58       INCLUDE 'bufrlib.prm'
  59
  60       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  61      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  62      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  63      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  64      .                TABD(MAXTBD,NFILES)
  65
  66       CHARACTER*600 TABD
  67       CHARACTER*128 BORT_STR
  68       CHARACTER*128 TABB
  69       CHARACTER*128 TABA
  70       CHARACTER*24  UNIT
  71       CHARACTER*8   NEMO
  72       REAL*8        MXR
  73
  74 C-----------------------------------------------------------------------
  75 C-----------------------------------------------------------------------
  76
  77       MXR = 1E11-1
  78
  79       IF(ITAB.LE.0 .OR. ITAB.GT.NTBB(LUN)) GOTO 900
  80
  81 C  PULL OUT TABLE B INFORMATION
  82 C  ----------------------------
  83
  84       IDN  = IDNB(ITAB,LUN)
  85       NEMO = TABB(ITAB,LUN)( 7:14)
  86       UNIT = TABB(ITAB,LUN)(71:94)
  87       ISCL = VALX(TABB(ITAB,LUN)( 95: 98))
  88       IREF = VALX(TABB(ITAB,LUN)( 99:109))
  89       IBIT = VALX(TABB(ITAB,LUN)(110:112))
  90
  91 C  CHECK TABLE B CONTENTS
  92 C  ----------------------
  93
  94       IF(IDN.LT.IFXY('000000')) GOTO 901
  95       IF(IDN.GT.IFXY('063255')) GOTO 901
  96
  97       IF(ISCL.LT.-999 .OR. ISCL.GT.999) GOTO 902
  98       IF(IREF.LE.-MXR .OR. IREF.GE.MXR) GOTO 903
  99       IF(IBIT.LE.0) GOTO 904
 100       IF(UNIT(1:5).NE.'CCITT' .AND. IBIT.GT.32      ) GOTO 904
 101       IF(UNIT(1:5).EQ.'CCITT' .AND. MOD(IBIT,8).NE.0) GOTO 905
 102
 103 C  EXITS
 104 C  -----
 105
 106       RETURN
 107 900   WRITE(BORT_STR,'("BUFRLIB: NEMTBB - ITAB (",I7,") NOT FOUND IN '//
 108      . 'TABLE B")') ITAB
 109       CALL BORT(BORT_STR)
 110 901   WRITE(BORT_STR,'("BUFRLIB: NEMTBB - INTEGER REPRESENTATION OF '//
 111      . 'DESCRIPTOR FOR TABLE B MNEMONIC ",A," (",I7,") IS OUTSIDE '//
 112      . 'RANGE 0-16383 (16383 -> 0-63-255)")') NEMO,IDN
 113       CALL BORT(BORT_STR)
 114 902   WRITE(BORT_STR,'("BUFRLIB: NEMTBB - SCALE VALUE FOR TABLE B '//
 115      .'MNEMONIC ",A," (",I7,") IS OUTSIDE RANGE -999 TO 999")')
 116      . NEMO,ISCL
 117       CALL BORT(BORT_STR)
 118 903   WRITE(BORT_STR,'("BUFRLIB: NEMTBB - REFERENCE VALUE FOR TABLE B'//
 119      .' MNEMONIC ",A," (",I7,") IS OUTSIDE RANGE +/- 1E11-1")')
 120      . NEMO,IREF
 121       CALL BORT(BORT_STR)
 122 904   WRITE(BORT_STR,'("BUFRLIB: NEMTBB - BIT WIDTH FOR NON-CHARACTER'//
 123      . ' TABLE B MNEMONIC ",A," (",I7,") IS > 32")') NEMO,IBIT
 124       CALL BORT(BORT_STR)
 125 905   WRITE(BORT_STR,'("BUFRLIB: NEMTBB - BIT WIDTH FOR CHARACTER '//
 126      . 'TABLE B MNEMONIC ",A," (",I7,") IS NOT A MULTIPLE OF 8")')
 127      . NEMO,IBIT
 128       CALL BORT(BORT_STR)
 129       END