      SUBROUTINE TABSUB(LUN,NEMO)

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    TABSUB
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE BUILDS THE ENTIRE JUMP/LINK TREE (I.E.,
C   INCLUDING RECURSIVELY RESOLVING ALL "CHILD" MNEMONICS) FOR A TABLE
C   A MNEMONIC (NEMO) WITHIN THE INTERNAL JUMP/LINK TABLE.
C
C PROGRAM HISTORY LOG:
C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C                           ROUTINE "BORT"
C 2000-09-19  J. WOOLLEN -- ADDED CAPABILITY TO ENCODE AND DECODE DATA
C                           USING THE OPERATOR DESCRIPTORS (BUFR TABLE
C                           C) FOR CHANGING WIDTH AND CHANGING SCALE
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
C 2005-11-29  J. ATOR    -- ADDED SUPPORT FOR 207 AND 208 OPERATORS
C 2012-03-02  J. ATOR    -- ADDED SUPPORT FOR 203 OPERATOR
C 2012-04-19  J. ATOR    -- FIXED BUG FOR CASES WHERE A TABLE C OPERATOR
C                           IMMEDIATELY FOLLOWS A TABLE D SEQUENCE
C
C USAGE:    CALL TABSUB (LUN, NEMO)
C   INPUT ARGUMENT LIST:
C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C     NEMO     - CHARACTER*8: TABLE A MNEMONIC
C
C REMARKS:
C   -----------------------------------------------------------------
C    EXAMPLE SHOWING CONTENTS OF INTERNAL JUMP/LINK TABLE (WITHIN
C    COMMON /TABLES/):
C
C      INTEGER MAXTAB = maximum number of jump/link table entries
C
C      INTEGER NTAB = actual number of jump/link table entries
C                     currently in use
C
C      For I = 1, NTAB:
C
C      CHARACTER*10 TAG(I) = mnemonic
C
C      CHARACTER*3 TYP(I) = mnemonic type indicator:
C         "SUB" if TAG(I) is a Table A mnemonic
C         "SEQ" if TAG(I) is a Table D mnemonic using either short
C               (i.e. 1-bit) delayed replication, F=1 regular (i.e.
C               non-delayed) replication, or no replication at all
C         "RPC" if TAG(I) is a Table D mnemonic using either medium
C               (i.e. 8-bit) delayed replication or long (i.e. 16-bit)
C               delayed replication
C         "RPS" if TAG(I) is a Table D mnemonic using medium
C               (i.e. 8-bit) delayed replication in a stack context
C         "DRB" if TAG(I) denotes the short (i.e. 1-bit) delayed
C               replication of a Table D mnemonic (which would then
C               itself have its own separate entry in the jump/link
C               table with a corresponding TAG value of "SEQ")
C         "DRP" if TAG(I) denotes either the medium (i.e. 8-bit) or
C               long (i.e. 16-bit) delayed replication of a Table D
C               mnemonic (which would then itself have its own separate
C               entry in the jump/link table with a corresponding TAG
C               value of "RPC")
C         "DRS" if TAG(I) denotes the medium (i.e. 8-bit) delayed
C               replication, in a stack context, of a Table D mnemonic
C               (which would then itself have its own separate entry
C               in the jump/link table with a corresponding TAG value
C               of "RPS")
C         "REP" if TAG(I) denotes the F=1 regular (i.e. non-delayed)
C               replication of a Table D mnemonic (which would then
C               itself have its own separate entry in the jump/link
C               table with a corresponding TAG value of "SEQ")
C         "CHR" if TAG(I) is a Table B mnemonic with units "CCITT IA5"
C         "NUM" if TAG(I) is a Table B mnemonic with any units other
C               than "CCITT IA5"
C
C       INTEGER JMPB(I):
C
C       IF ( TYP(I) = "SUB" ) THEN
C          JMPB(I) = 0
C       ELSE IF ( ( TYP(I) = "SEQ" and TAG(I) uses either short (i.e.
C                   1-bit) delayed replication or F=1 regular (i.e.
C                   non-delayed) replication )
C                OR
C                 ( TYP(I) = "RPC" )  ) THEN
C          JMPB(I) = the index of the jump/link table entry denoting
C                    the replication of TAG(I)
C       ELSE
C          JMPB(I) = the index of the jump/link table entry for the
C                    Table A or Table D mnemonic of which TAG(I) is a
C                    child
C       END IF
C
C       INTEGER JUMP(I):
C
C       IF ( ( TYP(I) = "CHR" )  OR  ( TYP(I) = "NUM" ) ) THEN
C          JUMP(I) = 0
C       ELSE IF ( ( TYP(I) = "DRB" ) OR
C                 ( TYP(I) = "DRP" ) OR
C                 ( TYP(I) = "REP" ) ) THEN
C          JUMP(I) = the index of the jump/link table entry for the
C                    Table D mnemonic whose replication is denoted by
C                    TAG(I)
C       ELSE
C          JUMP(I) = the index of the jump/link table entry for the
C                    Table B or Table D mnemonic which, sequentially,
C                    is the first child of TAG(I)
C       END IF
C
C       INTEGER LINK(I):
C
C       IF ( ( TYP(I) = "SEQ" and TAG(I) uses either short (i.e.
C              1-bit) delayed replication or F=1 regular (i.e. non-
C              delayed) replication )
C           OR
C            ( TYP(I) = "SUB" )
C           OR
C            ( TYP(I) = "RPC" ) ) THEN
C              LINK(I) = 0
C       ELSE IF ( TAG(I) is, sequentially, the last child Table B or
C                 Table D mnemonic of the parent Table A or Table D
C                 mnemonic indexed by JMPB(I) ) THEN
C          LINK(I) = 0
C       ELSE
C          LINK(I) = the index of the jump/link table entry for the
C                    Table B or Table D mnemonic which, sequentially,
C                    is the next (i.e. following TAG(I)) child mnemonic
C                    of the parent Table A or Table D mnemonic indexed
C                    by JMPB(I)
C       END IF
C
C       INTEGER IBT(I):
C
C       IF ( ( TYP(I) = "CHR" )  OR  ( TYP(I) = "NUM" ) ) THEN
C          IBT(I) = bit width of Table B mnemonic TAG(I)
C       ELSE IF ( ( TYP(I) = "DRB" )  OR  ( TYP(I) = "DRP" ) ) THEN
C          IBT(I) = bit width of delayed descriptor replication factor
C                   (i.e. 1, 8, or 16, depending on the replication
C                   scheme denoted by TAG(I))
C       ELSE
C          IBT(I) = 0
C       END IF
C
C       INTEGER IRF(I):
C
C       IF ( TYP(I) = "NUM" ) THEN
C          IRF(I) = reference value of Table B mnemonic TAG(I)
C       ELSE IF ( TYP(I) = "REP" ) THEN
C          IRF(I) = number of F=1 regular (i.e. non-delayed)
C                   replications of Table D mnemonic TAG(JUMP(I))
C       ELSE
C          IRF(I) = 0
C       END IF
C
C       INTEGER ISC(I):
C
C       IF ( TYP(I) = "NUM" ) THEN
C          ISC(I) = scale factor of Table B mnemonic TAG(I)
C       ELSE IF ( TYP(I) = "SUB" ) THEN
C          ISC(I) = the index of the jump/link table entry which,
C                   sequentially, constitutes the last element of the
C                   jump/link tree for Table A mnemonic TAG(I)
C       ELSE
C          ISC(I) = 0
C       END IF
C
C   -----------------------------------------------------------------
C
C    THE FOLLOWING VALUES ARE STORED WITHIN COMMON /NRV203/ BY THIS
C    SUBROUTINE, FOR USE WITH ANY 2-03-YYY (CHANGE REFERENCE VALUE)
C    OPERATORS PRESENT WITHIN THE ENTIRE JUMP/LINK TABLE:
C
C      NNRV = number of nodes in the jump/link table which contain new
C             reference values (as defined using the 2-03 operator)
C
C      INODNRV(I=1,NNRV) = nodes within jump/link table which contain
C                          new reference values
C
C      NRV(I=1,NNRV) = new reference value corresponding to INODNRV(I)
C
C      TAGNRV(I=1,NNRV) = Table B mnemonic to which the new reference
C                         value in NRV(I) applies
C
C      ISNRV(I=1,NNRV) = start of node range in jump/link table,
C                        within which the new reference value defined
C                        by NRV(I) will be applied to all occurrences
C                        of TAGNRV(I)
C
C      IENRV(I=1,NNRV) = end of node range in jump/link table,
C                        within which the new reference value defined
C                        by NRV(I) will be applied to all occurrences
C                        of TAGNRV(I)
C
C      IBTNRV = number of bits in Section 4 occupied by each new
C               reference value for the current 2-03 operator
C               (if IBTNRV = 0, then no 2-03 operator is currently
C               in scope)
C
C      IPFNRV = a number between 1 and NNRV, denoting the first entry
C               within the above arrays which applies to the current
C               Table A mnemonic NEMO (if IPFNRV = 0, then no 2-03
C               operators have been applied to NEMO)
C
C   -----------------------------------------------------------------
C
C    THIS ROUTINE CALLS:        BORT     INCTAB   NEMTAB   NEMTBD
C                               TABENT
C    THIS ROUTINE IS CALLED BY: MAKESTAB
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 /TABLES/ 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)
      COMMON /TABCCC/ ICDW,ICSC,ICRV,INCW
      COMMON /NRV203/ NNRV,INODNRV(MXNRV),NRV(MXNRV),TAGNRV(MXNRV),
     .                ISNRV(MXNRV),IENRV(MXNRV),IBTNRV,IPFNRV

      CHARACTER*128 BORT_STR
      CHARACTER*10  TAG
      CHARACTER*8   NEMO,NEMS,NEM,TAGNRV
      CHARACTER*3   TYP
      CHARACTER*1   TAB
      DIMENSION     NEM(MAXCD,10),IRP(MAXCD,10),KRP(MAXCD,10)
      DIMENSION     DROP(10),JMP0(10),NODL(10),NTAG(10,2)
      LOGICAL       DROP

      DATA MAXLIM /10/

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

C  CHECK THE MNEMONIC
C  ------------------

C     Note that Table A mnemonics, in addition to being stored within
C     internal BUFR Table A array TABA(*,LUN), are also stored as
C     Table D mnemonics within internal BUFR Table D array TABD(*,LUN).
C     Thus, the following test is valid.

      CALL NEMTAB(LUN,NEMO,IDN,TAB,ITAB)
      IF(TAB.NE.'D') GOTO 900

C  STORE A SUBSET NODE AND JUMP/LINK THE TREE
C  ------------------------------------------

      CALL INCTAB(NEMO,'SUB',NODE)
      JUMP(NODE) = NODE+1
      JMPB(NODE) = 0
      LINK(NODE) = 0
      IBT (NODE) = 0
      IRF (NODE) = 0
      ISC (NODE) = 0

      CALL NEMTBD(LUN,ITAB,NSEQ,NEM(1,1),IRP(1,1),KRP(1,1))
      NTAG(1,1) = 1
      NTAG(1,2) = NSEQ
      JMP0(1)   = NODE
      NODL(1)   = NODE
      LIMB      = 1

      ICDW = 0
      ICSC = 0
      ICRV = 1
      INCW = 0

      IBTNRV = 0
      IPFNRV = 0

C  THIS LOOP RESOLVES ENTITIES IN A SUBSET BY EMULATING RECURSION
C  --------------------------------------------------------------

1     DO N=NTAG(LIMB,1),NTAG(LIMB,2)

      NTAG(LIMB,1) = N+1
      DROP(LIMB)   = N.EQ.NTAG(LIMB,2)

      CALL NEMTAB(LUN,NEM(N,LIMB),IDN,TAB,ITAB)
      NEMS = NEM(N,LIMB)

C  SPECIAL TREATMENT FOR CERTAIN OPERATOR DESCRIPTORS (TAB=C)
C  ----------------------------------------------------------

      IF(TAB.EQ.'C') THEN
         READ(NEMS,'(3X,I3)') IYYY
         IF(ITAB.EQ.1) THEN
            IF(IYYY.NE.0) THEN
              IF(ICDW.NE.0) GOTO 907
              ICDW = IYYY-128
            ELSE
              ICDW = 0
            ENDIF
         ELSEIF(ITAB.EQ.2) THEN
            IF(IYYY.NE.0) THEN
              IF(ICSC.NE.0) GOTO 908
              ICSC = IYYY-128
            ELSE
              ICSC = 0
            ENDIF
         ELSEIF(ITAB.EQ.3) THEN
            IF(IYYY.EQ.0) THEN

C             Stop applying new reference values to subset nodes.
C             Instead, revert to the use of standard Table B values.

              IF(IPFNRV.EQ.0) GOTO 911
	      DO JJ=IPFNRV,NNRV
                IENRV(JJ) = NTAB
              ENDDO
              IPFNRV = 0
            ELSEIF(IYYY.EQ.255) THEN

C             End the definition of new reference values.

              IBTNRV = 0
            ELSE

C             Begin the definition of new reference values.

              IF(IBTNRV.NE.0) GOTO 909
              IBTNRV = IYYY
            ENDIF
         ELSEIF(ITAB.EQ.7) THEN
            IF(IYYY.GT.0) THEN
              IF(ICDW.NE.0) GOTO 907
              IF(ICSC.NE.0) GOTO 908
              ICDW = ((10*IYYY)+2)/3
              ICSC = IYYY
              ICRV = 10**IYYY
            ELSE
              ICSC = 0
              ICDW = 0
              ICRV = 1
            ENDIF
         ELSEIF(ITAB.EQ.8) THEN
            INCW = IYYY
         ENDIF
      ELSE
         NODL(LIMB) = NTAB+1
         IREP = IRP(N,LIMB)
         IKNT = KRP(N,LIMB)
         JUM0 = JMP0(LIMB)
         CALL TABENT(LUN,NEMS,TAB,ITAB,IREP,IKNT,JUM0)
      ENDIF

      IF(TAB.EQ.'D') THEN

C        Note here how a new tree "LIMB" is created (and is then
C        immediately recursively resolved) whenever a Table D mnemonic
C        contains another Table D mnemonic as one of its children.

         LIMB = LIMB+1
         IF(LIMB.GT.MAXLIM) GOTO 901
         CALL NEMTBD(LUN,ITAB,NSEQ,NEM(1,LIMB),IRP(1,LIMB),KRP(1,LIMB))
         NTAG(LIMB,1) = 1
         NTAG(LIMB,2) = NSEQ
         JMP0(LIMB)   = NTAB
         GOTO 1
      ELSEIF(DROP(LIMB)) THEN
2        LINK(NODL(LIMB)) = 0
         LIMB = LIMB-1
         IF(LIMB.EQ.0 ) THEN
            IF(ICRV.NE.1) GOTO 904
            IF(ICDW.NE.0) GOTO 902
            IF(ICSC.NE.0) GOTO 903
            IF(INCW.NE.0) GOTO 905
            IF(IBTNRV.NE.0) GOTO 910
            IF(IPFNRV.NE.0) THEN

C             One or more new reference values were defined for this
C             subset, but there was no subsequent 2-03-000 operator,
C             so set all IENRV(*) values for this subset to point to
C             the last element of the subset within the jump/link table.
C             Note that, if there had been a subsequent 2-03-000
C             operator, then these IENRV(*) values would have already
C             been properly set above.

	      DO JJ=IPFNRV,NNRV
                IENRV(JJ) = NTAB
              ENDDO
            ENDIF
            GOTO 100
         ENDIF
         IF(DROP(LIMB)) GOTO 2
         LINK(NODL(LIMB)) = NTAB+1
         GOTO 1
      ELSEIF(TAB.NE.'C') THEN
         LINK(NODL(LIMB)) = NTAB+1
      ENDIF

      ENDDO

      GOTO 906

C  EXITS
C  -----

100   RETURN
900   WRITE(BORT_STR,'("BUFRLIB: TABSUB - SUBSET NODE NOT IN TABLE D '//
     . '(TAB=",A,") FOR INPUT MNEMONIC ",A)') TAB,NEMO
      CALL BORT(BORT_STR)
901   WRITE(BORT_STR,'("BUFRLIB: TABSUB - THERE ARE TOO MANY NESTED '//
     . 'TABLE D SEQUENCES (TREES) WITHIN INPUT MNEMONIC ",A," - THE '//
     . 'LIMIT IS",I4)') NEMO,MAXLIM
      CALL BORT(BORT_STR)
902   WRITE(BORT_STR,'("BUFRLIB: TABSUB - A 2-01-YYY OPERATOR WAS '//
     . 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
903   WRITE(BORT_STR,'("BUFRLIB: TABSUB - A 2-02-YYY OPERATOR WAS '//
     . 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
904   WRITE(BORT_STR,'("BUFRLIB: TABSUB - A 2-07-YYY OPERATOR WAS '//
     . 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
905   WRITE(BORT_STR,'("BUFRLIB: TABSUB - A 2-08-YYY OPERATOR WAS '//
     . 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
906   WRITE(BORT_STR,'("BUFRLIB: TABSUB - ENTITIES WERE NOT '//
     . 'SUCCESSFULLY RESOLVED (BY EMULATING RESURSION) FOR SUBSET '//
     . 'DEFINED BY TBL A MNEM. ",A)') NEMO
      CALL BORT(BORT_STR)
907   WRITE(BORT_STR,'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '//
     . 'CHANGE DATA WIDTH OPERATIONS IN THE TREE BUILT FROM INPUT ' //
     . 'MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
908   WRITE(BORT_STR,'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '//
     . 'CHANGE DATA SCALE OPERATIONS IN THE TREE BUILT FROM INPUT ' //
     . 'MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
909   WRITE(BORT_STR,'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '//
     . 'CHANGE REF VALUE OPERATIONS IN THE TREE BUILT FROM INPUT ' //
     . 'MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
910   WRITE(BORT_STR,'("BUFRLIB: TABSUB - A 2-03-YYY OPERATOR WAS '//
     . 'APPLIED WITHOUT ANY SUBSEQUENT 2-03-255 OPERATOR FOR '//
     . 'INPUT MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
911   WRITE(BORT_STR,'("BUFRLIB: TABSUB - A 2-03-000 OPERATOR WAS '//
     . 'ENCOUNTERED WITHOUT ANY PRIOR 2-03-YYY OPERATOR FOR '//
     . 'INPUT MNEMONIC ",A)') NEMO
      CALL BORT(BORT_STR)
      END
