var/external/bufr/chekstab.f

   1       SUBROUTINE CHEKSTAB(LUN)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    CHEKSTAB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE CHECKS THAT AN INTERNAL BUFR TABLE
   9 C   REPRESENTATION IS SELF-CONSISTENT AND FULLY DEFINED.  IF ANY ERRORS
  10 C   ARE FOUND, THEN AN APPROPRIATE CALL IS MADE TO BUFR ARCHIVE LIBRARY
  11 C   SUBROUTINE BORT.
  12 C
  13 C PROGRAM HISTORY LOG:
  14 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  15 C 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
  16 C                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
  17 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  18 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  19 C                           ROUTINE "BORT"
  20 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  21 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  22 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  23 C                           BUFR FILES UNDER THE MPI)
  24 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  25 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  26 C                           INTERDEPENDENCIES
  27 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  28 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  29 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  30 C                           ABNORMALLY
  31 C
  32 C USAGE:    CALL CHEKSTAB (LUN)
  33 C   INPUT ARGUMENT LIST:
  34 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  35 C
  36 C REMARKS:
  37 C    THIS ROUTINE CALLS:        BORT     NEMTAB   NEMTBB   NEMTBD
  38 C    THIS ROUTINE IS CALLED BY: MAKESTAB
  39 C                               Normally not called by any application
  40 C                               programs.
  41 C
  42 C ATTRIBUTES:
  43 C   LANGUAGE: FORTRAN 77
  44 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  45 C
  46 C$$$
  47
  48       INCLUDE 'bufrlib.prm'
  49
  50       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  51      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  52      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  53      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  54      .                TABD(MAXTBD,NFILES)
  55
  56       CHARACTER*600 TABD
  57       CHARACTER*128 TABB
  58       CHARACTER*128 TABA
  59       CHARACTER*128 BORT_STR
  60       CHARACTER*24  UNIT
  61       CHARACTER*8   NEMO,NEMS(MAXCD)
  62       CHARACTER*1   TAB
  63       DIMENSION     IRPS(MAXCD),KNTS(MAXCD)
  64
  65 C-----------------------------------------------------------------------
  66 C-----------------------------------------------------------------------
  67
  68 C  THERE MUST BE ENTRIES IN TABLES A, B, AND D
  69 C  -------------------------------------------
  70
  71       IF(NTBA(LUN).EQ.0) GOTO 900
  72       IF(NTBB(LUN).EQ.0) GOTO 901
  73       IF(NTBD(LUN).EQ.0) GOTO 902
  74
  75 C  MAKE SURE EACH TABLE A ENTRY DEFINED AS A SEQUENCE
  76 C  --------------------------------------------------
  77
  78       DO I=1,NTBA(LUN)
  79       NEMO = TABA(I,LUN)(4:11)
  80       CALL NEMTAB(LUN,NEMO,IDN,TAB,IRET)
  81       IF(TAB.NE.'D') GOTO 903
  82       ENDDO
  83
  84 C  CHECK TABLE B CONTENTS
  85 C  ----------------------
  86
  87       DO ITAB=1,NTBB(LUN)
  88       CALL NEMTBB(LUN,ITAB,UNIT,ISCL,IREF,IBIT)
  89       ENDDO
  90
  91 C  CHECK TABLE D CONTNETS
  92 C  ----------------------
  93
  94       DO ITAB=1,NTBD(LUN)
  95       CALL NEMTBD(LUN,ITAB,NSEQ,NEMS,IRPS,KNTS)
  96       ENDDO
  97
  98 C  EXITS
  99 C  -----
 100
 101       RETURN
 102 900   CALL BORT
 103      . ('BUFRLIB: CHEKSTAB - EMPTY TABLE A IN INTERNAL BUFR TABLES')
 104 901   CALL BORT
 105      . ('BUFRLIB: CHEKSTAB - EMPTY TABLE B IN INTERNAL BUFR TABLES')
 106 902   CALL BORT
 107      . ('BUFRLIB: CHEKSTAB - EMPTY TABLE D IN INTERNAL BUFR TABLES')
 108 903   WRITE(BORT_STR,'("BUFRLIB: CHEKSTAB - TABLE A ENTRY: ",A," NOT '//
 109      . 'DEFINED AS A SEQUENCE")') NEMO
 110       CALL BORT(BORT_STR)
 111       END