SUBROUTINE MAKESTAB

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    MAKESTAB
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE CONSTRUCTS AN INTERNAL JUMP/LINK TABLE
C  WITHIN COMMON BLOCK /TABLES/, USING THE INFORMATION WITHIN THE
C  INTERNAL BUFR TABLE ARRAYS (WITHIN COMMON BLOCK /TABABD/) FOR ALL OF
C  THE LUN (I.E., I/O STREAM INDEX) VALUES THAT ARE CURRENTLY DEFINED TO
C  THE BUFR ARCHIVE LIBRARY SOFTWARE.  NOTE THAT THE ENTIRE JUMP/LINK
C  TABLE WILL ALWAYS BE COMPLETELY RECONSTRUCTED FROM SCRATCH, EVEN IF
C  SOME OF THE INFORMATION WITHIN THE INTERNAL BUFR TABLE ARRAYS
C  ALREADY EXISTED THERE AT THE TIME OF THE PREVIOUS CALL TO THIS
C  SUBROUTINE, BECAUSE THERE MAY HAVE BEEN OTHER EVENTS THAT HAVE TAKEN
C  PLACE SINCE THE PREVIOUS CALL TO THIS SUBROUTINE THAT HAVE NOT YET
C  BEEN REFLECTED WITHIN THE INTERNAL JUMP/LINK TABLE, SUCH AS, E.G.
C  THE UNLINKING OF AN LUN VALUE FROM THE BUFR ARCHIVE LIBRARY SOFTWARE
C  VIA A CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE CLOSBF.
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"
C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
C                           BUFR FILES UNDER THE MPI)
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  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
C                           INCREASED FROM 15000 TO 16000 (WAS IN
C                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
C                           WRF; ADDED HISTORY DOCUMENTATION; OUTPUTS
C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C                           TERMINATES ABNORMALLY; NOW ALLOWS FOR THE
C                           POSSIBILITY THAT A CONNECTED FILE MAY NOT
C                           CONTAIN ANY DICTIONARY TABLE INFO (E.G.,
C                           AN EMPTY FILE), SUBSEQUENT CONNECTED FILES
C                           WHICH ARE NOT EMPTY WILL NO LONGER GET
C                           TRIPPED UP BY THIS (THIS AVOIDS THE NEED
C                           FOR AN APPLICATION PROGRAM TO DISCONNECT
C                           ANY EMPTY FILES VIA A CALL TO CLOSBF)
C
C USAGE:    CALL MAKESTAB
C
C   OUTPUT FILES:
C     UNIT 06  - STANDARD OUTPUT PRINT
C
C REMARKS:
C    THIS ROUTINE CALLS:        BORT     CHEKSTAB STRCLN   TABSUB
C    THIS ROUTINE IS CALLED BY: RDBFDX   RDUSDX
C                               Normally not called by any application
C                               programs.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE:  PORTABLE TO ALL PLATFORMS
C
C$$$

      INCLUDE 'bufrlib.prm'

      COMMON /QUIET/  IPRT
      COMMON /STBFR/  IOLUN(NFILES),IOMSG(NFILES)
      COMMON /USRINT/ NVAL(NFILES),INV(MAXJL,NFILES),VAL(MAXJL,NFILES)
      COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
     .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
     .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
     .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
     .                TABD(MAXTBD,NFILES)
      COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
     .                JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
     .                IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
     .                ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
     .                ISEQ(MAXJL,2),JSEQ(MAXJL)

      CHARACTER*600 TABD
      CHARACTER*128 TABB
      CHARACTER*128 TABA
      CHARACTER*128 BORT_STR
      CHARACTER*10  TAG
      CHARACTER*8   NEMO
      CHARACTER*3   TYP
      DIMENSION     LUS(NFILES)
      LOGICAL       EXPAND
      REAL*8        VAL

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

C  RESET POINTER TABLE AND STRING CACHE
C  ------------------------------------

      NTAB = 0
      CALL STRCLN

C  FIGURE OUT WHICH UNITS SHARE TABLES
C  -----------------------------------

C     First, determine how many LUN values are currently being used and,
C     for each such one, whether it uses the same dictionary table
C     information as any other LUN values that we have examined so far.
C     If so, then set LUS(LUN) to a nonzero value.

C     Note that, for each LUN value, the MTAB(*,LUN) array contains
C     pointer indices into the internal jump/link table for each of the
C     Table A mnemonics that is currently defined for that LUN value.
C     Thus, the code within the following DO loop is simply checking
C     whether the first Table A mnemonic is the same for two different
C     LUN values as the determination of whether those LUN values indeed
C     share the same dictionary tables.

      DO LUN=1,NFILES
      LUS(LUN) = 0
      IF(IOLUN(LUN).NE.0) THEN
         IF(LUN.GT.1) THEN
         DO LUM=1,LUN-1
cccccccc IF(MTAB(1,LUN).EQ.MTAB(1,LUM)) LUS(LUN) = LUM
         IF(MTAB(1,LUN).EQ.MTAB(1,LUM) .AND. MTAB(1,LUM).NE.0)
     .    LUS(LUN) = LUM
         ENDDO
         ENDIF
      ENDIF
      ENDDO

C  INITIALIZE JUMP/LINK TABLES WITH SUBSETS/SEQUENCES/ELEMENTS
C  -----------------------------------------------------------

      DO LUN=1,NFILES

ccccc IF(IOLUN(LUN).NE.0) THEN
      IF(IOLUN(LUN).NE.0 .AND. NTBA(LUN).GT.0) THEN

C  RESET ANY EXISTING INVENTORY POINTERS
C  -------------------------------------

         IF(IOMSG(LUN).NE.0) THEN
            IF(LUS(LUN).EQ.0) INC = (NTAB+1)-MTAB(1,LUN)
            IF(LUS(LUN).NE.0) INC = MTAB(1,LUS(LUN))-MTAB(1,LUN)
            DO N=1,NVAL(LUN)
            INV(N,LUN) = INV(N,LUN)+INC
            ENDDO
         ENDIF

C  CREATE NEW TABLE ENTRIES IF THIS UNIT DOESN'T SHARE EXISTING ONES
C  -----------------------------------------------------------------

         IF(LUS(LUN).EQ.0) THEN

C     The dictionary table information corresponding to this LUN
C     has not yet been written into the internal jump/link table,
C     so add it in now.

            CALL CHEKSTAB(LUN)
            DO ITBA=1,NTBA(LUN)
            INOD = NTAB+1
            NEMO = TABA(ITBA,LUN)(4:11)
            CALL TABSUB(LUN,NEMO)
            MTAB(ITBA,LUN) = INOD
            ISC(INOD)      = NTAB

C**** note that the following lines are commented out****
cccc        DO N1=INOD,ISC(INOD)-1
cccc        DO N2=N1+1,ISC(INOD)
cccc        IF(TAG(N1).EQ.TAG(N2)) GOTO 900
cccc        ENDDO
cccc        ENDDO
C********************************************************

            ENDDO
         ENDIF

      ENDIF
      ENDDO

C  STORE TYPES AND INITIAL VALUES AND COUNTS
C  -----------------------------------------

      DO NODE=1,NTAB
      IF(TYP(NODE).EQ.'SUB') THEN
         VALI(NODE) = 0
         KNTI(NODE) = 1
         ITP (NODE) = 0
      ELSEIF(TYP(NODE).EQ.'SEQ') THEN
         VALI(NODE) = 0
         KNTI(NODE) = 1
         ITP (NODE) = 0
      ELSEIF(TYP(NODE).EQ.'RPC') THEN
         VALI(NODE) = 0
         KNTI(NODE) = 0
         ITP (NODE) = 0
      ELSEIF(TYP(NODE).EQ.'RPS') THEN
         VALI(NODE) = 0
         KNTI(NODE) = 0
         ITP (NODE) = 0
      ELSEIF(TYP(NODE).EQ.'REP') THEN
         VALI(NODE) = BMISS
         KNTI(NODE) = IRF(NODE)
         ITP (NODE) = 0
      ELSEIF(TYP(NODE).EQ.'DRS') THEN
         VALI(NODE) = 0
         KNTI(NODE) = 1
         ITP (NODE) = 1
      ELSEIF(TYP(NODE).EQ.'DRP') THEN
         VALI(NODE) = 0
         KNTI(NODE) = 1
         ITP (NODE) = 1
      ELSEIF(TYP(NODE).EQ.'DRB') THEN
         VALI(NODE) = 0
         KNTI(NODE) = 0
         ITP (NODE) = 1
      ELSEIF(TYP(NODE).EQ.'NUM') THEN
         VALI(NODE) = BMISS
         KNTI(NODE) = 1
         ITP (NODE) = 2
      ELSEIF(TYP(NODE).EQ.'CHR') THEN
         VALI(NODE) = BMISS
         KNTI(NODE) = 1
         ITP (NODE) = 3
      ELSE
         GOTO 901
      ENDIF
      ENDDO

C  SET UP EXPANSION SEGMENTS FOR TYPE 'SUB', 'DRP', AND 'DRS' NODES
C  ----------------------------------------------------------------

      NEWN = 0

      DO N=1,NTAB
      ISEQ(N,1) = 0
      ISEQ(N,2) = 0
      EXPAND = TYP(N).EQ.'SUB' .OR. TYP(N).EQ.'DRP' .OR. TYP(N).EQ.'DRS'
     .                         .OR. TYP(N).EQ.'REP' .OR. TYP(N).EQ.'DRB'
      IF(EXPAND) THEN
         ISEQ(N,1) = NEWN+1
         NODA = N
         NODE = N+1
         DO K=1,MAXJL
         KNT(K) = 0
         ENDDO
         IF(TYP(NODA).EQ.'REP') KNT(NODE) = KNTI(NODA)
         IF(TYP(NODA).NE.'REP') KNT(NODE) = 1

1        NEWN = NEWN+1
         IF(NEWN.GT.MAXJL) GOTO 902
         JSEQ(NEWN) = NODE
         KNT(NODE) = MAX(KNTI(NODE),KNT(NODE))
2        IF(JUMP(NODE)*KNT(NODE).GT.0) THEN
            NODE = JUMP(NODE)
            GOTO 1
         ELSE IF(LINK(NODE).GT.0) THEN
            NODE = LINK(NODE)
            GOTO 1
         ELSE
            NODE = JMPB(NODE)
            IF(NODE.EQ.NODA) GOTO 3
            IF(NODE.EQ.0   ) GOTO 903
            KNT(NODE) = MAX(KNT(NODE)-1,0)
            GOTO 2
         ENDIF
3        ISEQ(N,2) = NEWN
      ENDIF
      ENDDO

C  PRINT THE SEQUENCE TABLES
C  ------------------------

      IF(IPRT.GE.2) THEN
      PRINT*
      PRINT*,'+++++++++++++++++BUFR ARCHIVE LIBRARY++++++++++++++++++++'
         PRINT*
         DO I=1,NTAB
         PRINT99,I,
     .   TAG(I),TYP(I),JMPB(I),JUMP(I),LINK(I),IBT(I),IRF(I),ISC(I)
         ENDDO
         PRINT*
99       FORMAT('BUFRLIB: MAKESTAB ',I5,2X,A10,A5,6I8)
      PRINT*,'+++++++++++++++++BUFR ARCHIVE LIBRARY++++++++++++++++++++'
      PRINT*
      ENDIF

C  EXITS
C  -----

      RETURN
900   WRITE(BORT_STR,'("BUFRLIB: MAKESTAB - MNEMONIC ",A," IS '//
     . 'DUPLICATED IN SUBSET: ",A)') NEMO,TAG(N1)
      CALL BORT(BORT_STR)
901   WRITE(BORT_STR,'("BUFRLIB: MAKESTAB - UNKNOWN TYPE ",A)')TYP(NODE)
      CALL BORT(BORT_STR)
902   WRITE(BORT_STR,'("BUFRLIB: MAKESTAB - NUMBER OF JSEQ ENTRIES IN'//
     . ' JUMP/LINK TABLE EXCEEDS THE LIMIT (",I6,")")') MAXJL
      CALL BORT(BORT_STR)
903   WRITE(BORT_STR,'("BUFRLIB: MAKESTAB - NODE IS ZERO, FAILED TO '//
     . 'CIRCULATE (TAG IS ",A,")")') TAG(N)
      CALL BORT(BORT_STR)
      END