      SUBROUTINE UFBTAB(LUNIN,TAB,I1,I2,IRET,STR)

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UFBTAB
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE EITHER OPENS A BUFR FILE CONNECTED TO
C   ABS(LUNIN) FOR INPUT OPERATIONS (IF IT IS NOT ALREADY OPENED AS
C   SUCH), OR SAVES ITS POSITION AND REWINDS IT TO THE FIRST DATA
C   MESSAGE (IF BUFR FILE ALREADY OPENED), THE EXTENT OF ITS PROCESSING
C   IS DETERMINED BY THE SIGN OF LUNIN.  IF LUNIN IS GREATER THAN ZERO,
C   THIS SUBROUTINE READS SPECIFIED VALUES FROM ALL DATA SUBSETS IN THE
C   BUFR FILE INTO INTERNAL ARRAYS AND RETURNS THESE VALUES ALONG WITH
C   A COUNT OF THE SUBSETS.  IF LUNIN IS LESS THAN ZERO, THIS
C   SUBROUTINE RETURNS THE BUFR ARCHIVE LIBRARY'S GLOBAL VALUE FOR
C   MISSING (REGARDLESS OF THE MNEMONICS SPECIFIED IN STR)
C   ALONG WITH A COUNT OF THE SUBSETS (SEE REMARKS 2).  FINALLY, THIS
C   SUBROUTINE EITHER CLOSES THE BUFR FILE IN ABS(LUNIN) (IF IT WAS
C   OPENED HERE) OR RESTORES IT TO ITS PREVIOUS READ/WRITE STATUS AND
C   POSITION (IF IT WAS NOT OPENED HERE).  WHEN LUNIN IS GREATER THAN
C   ZERO, THE DATA VALUES CORRESPOND TO MNEMONICS, NORMALLY WHERE THERE
C   IS NO REPLICATION (THERE CAN BE REGULAR OR DELAYED REPLICATION, BUT
C   THIS SUBROUTINE WILL ONLY READ THE FIRST OCCURRENCE OF THE MNEMONIC
C   IN EACH SUBSET).  UFBTAB PROVIDES A MECHANISM WHEREBY A USER CAN
C   EITHER DO A QUICK SCAN OF THE RANGE OF VALUES CORRESPONDING TO ONE
C   OR MORE MNEMNONICS AMONGST ALL DATA SUBSETS FOR AN ENTIRE BUFR FILE
C   (WHEN LUNIN IS GREATER THAN ZERO), OR SIMPLY OBTAIN A COUNT OF
C   SUBSETS IN THE BUFR FILE (WHEN LUNIN IS LESS THAN ZERO); NO OTHER
C   BUFR ARCHIVE LIBRARY ROUTINES HAVE TO BE CALLED.  THIS SUBROUTINE
C   IS SIMILAR TO BUFR ARCHIVE LIBRARY SUBROUTINE UFBTAM EXCEPT UFBTAM
C   READS SUBSETS FROM MESSAGES STORED IN INTERNAL MEMORY AND IT HAS NO
C   OPTION FOR RETURNING ONLY A COUNT OF THE SUBSETS.  IN ADDITION,
C   UFBTAM CURRENTLY CANNOT READ DATA FROM COMPRESSED BUFR MESSAGES.
C   UFBTAB CAN READ DATA FROM BOTH UNCOMPRESSED AND COMPRESSED BUFR
C   MESSAGES.
C
C PROGRAM HISTORY LOG:
C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08  J. WOOLLEN -- IMPROVED MACHINE PORTABILITY
C 1998-10-27  J. WOOLLEN -- MODIFIED TO CORRECT PROBLEMS CAUSED BY IN-
C                           LINING CODE WITH FPP DIRECTIVES
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 2000-09-19  J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C                           10,000 TO 20,000 BYTES
C 2002-05-14  J. WOOLLEN -- REMOVED OLD CRAY COMPILER DIRECTIVES
C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C                           INTERDEPENDENCIES
C 2003-11-04  D. KEYSER  -- MODIFIED TO NOT ABORT WHEN THERE ARE TOO
C                           MANY SUBSETS COMING IN (I.E., .GT. "I2"),
C                           BUT RATHER JUST PROCESS "I2" REPORTS AND
C                           PRINT A DIAGNOSTIC; MAXJL (MAXIMUM NUMBER
C                           OF JUMP/LINK ENTRIES) INCREASED FROM 15000
C                           TO 16000 (WAS IN VERIFICATION VERSION);
C                           MODIFIED TO CALL ROUTINE REWNBF WHEN THE
C                           BUFR FILE IS ALREADY OPENED, ALLOWS
C                           SPECIFIC SUBSET INFORMATION TO BE READ FROM
C                           A FILE IN THE MIDST OF ITS BEING READ FROM
C                           OR WRITTEN TO), BEFORE OPENBF WAS ALWAYS
C                           CALLED AND THIS WOULD HAVE LED TO AN ABORT
C                           OF THE APPLICATION PROGRAM (WAS IN
C                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
C                           WRF; ADDED DOCUMENTATION (INCLUDING
C                           HISTORY)
C 2004-08-09  J. ATOR    -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C                           20,000 TO 50,000 BYTES
C 2005-09-16  J. WOOLLEN -- WORKS FOR COMPRESSED BUFR MESSAGES; ADDED
C                           OPTION TO RETURN ONLY SUBSET COUNT (WHEN
C                           INPUT UNIT NUMBER IS LESS THAN ZERO)
C 2006-04-14  J. ATOR    -- ADD DECLARATION FOR CREF
C 2007-01-19  J. ATOR    -- REPLACED CALL TO PARSEQ WITH CALL TO PARSTR
C 2009-04-21  J. ATOR    -- USE ERRWRT
C 2009-12-01  J. ATOR    -- FIX BUG FOR COMPRESSED CHARACTER STRINGS
C                           WHICH ARE IDENTICAL ACROSS ALL SUBSETS IN
C                           A SINGLE MESSAGE
C 2010-05-07  J. ATOR    -- WHEN CALLING IREADMG, TREAT READ ERROR AS
C                           END-OF-FILE CONDITION
C 2012-03-02  J. ATOR    -- USE FUNCTION UPS
C 2012-09-15  J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE;
C                           USE NEW OPENBF TYPE 'INX' TO OPEN AND CLOSE
C                           THE C FILE WITHOUT CLOSING THE FORTRAN FILE
C
C USAGE:    CALL UFBTAB (LUNIN, TAB, I1, I2, IRET, STR)
C   INPUT ARGUMENT LIST:
C     LUNIN    - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT NUMBER
C                FOR BUFR FILE
C     I1       - INTEGER:
C                  - IF LUNIN IS GREATER THAN ZERO: LENGTH OF FIRST
C                    DIMENSION OF TAB OR THE NUMBER OF BLANK-SEPARATED
C                    MNEMONICS IN STR, (FORMER MUST BE AT LEAST AS
C                    LARGE AS LATTER)
C                  - IF LUNIN IS LESS THAN ZERO: LENGTH OF FIRST
C                    DIMENSION OF TAB (RECOMMEND PASSING IN WITH VALUE
C                    OF 1 - SEE REMARKS 2)
C     I2       - INTEGER: LENGTH OF SECOND DIMENSION OF TAB
C                  - IF LUNIN IS GREATER THAN ZERO: MUST BE AT LEAST AS
C                    LARGE AS VALUE RETURNED IN IRET, OTHERWISE ONLY
C                    FIRST I2 SUBSETS ARE RETURNED IN TAB
C                  - IF LUNIN IS LESS THAN ZERO: RECOMMEND PASSING IN
C                    WITH VALUE OF 1 - SEE REMARKS 2
C     STR      - CHARACTER*(*):
C                  - IF LUNIN IS GREATER THAN ZERO: STRING OF BLANK-
C                    SEPARATED TABLE B MNEMONICS IN ONE-TO-ONE
C                    CORRESPONDENCE WITH FIRST DIMENSION OF TAB, I1
C                    (THE NUMBER OF MNEMONICS IN THE STRING MUST BE NO
C                    LARGER THAN I1)
C                      - THERE ARE THREE "GENERIC" MNEMONICS NOT
C                        RELATED TO TABLE B, THESE RETURN THE FOLLOWING
C                        INFORMATION IN CORRESPONDING TAB LOCATION:
C                         'NUL'  WHICH ALWAYS RETURNS BMISS ("MISSING")
C                         'IREC' WHICH ALWAYS RETURNS THE CURRENT BUFR
C                                MESSAGE (RECORD) NUMBER IN WHICH THIS
C                                SUBSET RESIDES
C                         'ISUB' WHICH ALWAYS RETURNS THE CURRENT
C                                SUBSET NUMBER OF THIS SUBSET WITHIN
C                                THE BUFR MESSAGE (RECORD) NUMBER
C                                'IREC'
C                  - IF LUNIN IS LESS THAN ZERO: DUMMY {RECOMMEND
C                    PASSING IN STRING AS A 1-CHARACTER BLANK (i.e.,
C                    ' ') - SEE REMARKS 2}
C
C   OUTPUT ARGUMENT LIST:
C     TAB      - REAL*8: (I1,I2):
C                  - IF LUNIN IS GREATER THAN ZERO: STARTING ADDRESS OF
C                    DATA VALUES READ FROM BUFR FILE
C                  - IF LUNIN IS LESS THAN ZERO: STARTING ADDRESS OF
C                    ARRAY OF VALUES ALL RETURNED WITH THE BUFRLIB'S
C                    GLOBAL VALUE FOR MISSING (BMISS)
C     IRET     - INTEGER: NUMBER OF DATA SUBSETS IN BUFR FILE
C                  - IF LUNIN IS GREATER THAN ZERO: MUST BE NO LARGER
C                    THAN I2, OTHERWISE ONLY FIRST I2 SUBSETS ARE
C                    RETURNED IN TAB
C
C REMARKS:
C    1) NOTE THAT UFBMEM CAN BE CALLED PRIOR TO THIS TO STORE THE BUFR
C       MESSAGES INTO INTERNAL MEMORY.
C
C    2) BELOW ARE TWO EXAMPLES WHERE THE USER CALLS UFBTAB WITH LUNIN
C       LESS THAN ZERO SO AS TO ONLY OBTAIN A COUNT OF SUBSETS IN A
C       BUFR FILE (ALONG WITH THE BUFRLIB'S GLOBAL VALUE FOR
C       "MISSING").
C
C       EXAMPLE 1) I1 AND I2 ARE SET TO 1 SUCH THAT TAB IS A SCALAR AND
C          STR IS SET TO A 1-CHARACTER BLANK.  THESE ARE THE
C          RECOMMENDED VALUES FOR I1, I2 AND STR SINCE THEY USE THE
C          LEAST AMOUNT OF MEMORY):
C
C            REAL(8) TAB
C                 ....
C                 ....
C            CALL UFBTAB(-LUNIN,TAB,1,1,IRET,' ')
C                 ....
C                 ....
C
C          HERE IRET WILL RETURN THE COUNT OF SUBSETS IN THE BUFR FILE
C          AND TAB WILL RETURN THE BUFRLIB'S GLOBAL VALUE FOR "MISSING"
C          (BMISS).
C
C       EXAMPLE 2) I1 IS SET TO 4 AND I2 IS SET TO 8 SUCH THAT TAB IS A
C          32-WORD ARRAY, AND STR IS SET TO A NONSENSICAL STRING.
C          THESE VALUES FOR I1, I2 AND STR WASTE MEMORY BUT GIVE THE
C          SAME ANSWERS FOR TAB AND IRET AS IN EXAMPLE 1 (FOR THE SAME
C          INPUT BUFR FILE!):
C
C            REAL(8) TAB(4,8)
C                 ....
C                 ....
C            CALL UFBTAB(-LUNIN,TAB,4,8,IRET,'BUFR IS A WONDERFUL FMT')
C                 ....
C                 ....
C
C          HERE IRET WILL AGAIN RETURN THE COUNT OF SUBSETS IN THE BUFR
C          FILE AND ALL 32 VALUES OF ARRAY TAB WILL RETURN THE
C          BUFRLIB'S GLOBAL VALUE FOR "MISSING" (BMISS).
C
C       THE SIXTH ARGUMENT STR IS A DUMMY VALUE AND CAN BE SET TO
C       ANY CHARACTER STRING (AGAIN, A 1-CHARACTER BLANK ' ' IS
C       RECOMMENDED).  THE THIRD ARGUMENT I1 HAS NO RELATIONSHIP WITH
C       THE NUMBER OF BLANK-SEPARATED MNEMONICS IN STR AND CAN BE SET
C       TO ANY INTEGER VALUE (AGAIN, 1 IS RECOMMENDED).  THE FOURTH
C       ARGUMENT I2 HAS NO RELATIONSHIP WITH THE NUMBER OF DATA SUBSETS
C       IN THE BUFR FILE RETURNED IN IRET (AGAIN, 1 IS RECOMMENDED).
C
C.....................................................................
C
C    THIS ROUTINE CALLS:        BORT     CLOSBF   ERRWRT   IREADMG
C                               IREADSB  MESGBC   NMSUB    OPENBF
C                               PARSTR   REWNBF   STATUS   STRING
C                               UPB      UPBB     UPC      UPS
C                               USRTPL
C    THIS ROUTINE IS CALLED BY: None
C                               Normally called only by application
C                               programs.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE:  PORTABLE TO ALL PLATFORMS
C
C$$$

      INCLUDE 'bufrlib.prm'

      COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
     .                INODE(NFILES),IDATE(NFILES)
      COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
     .                MBAY(MXMSGLD4,NFILES)
      COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
      COMMON /USRSTR/ NNOD,NCON,NODS(20),NODC(10),IVLS(10),KONS(10)
      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 /ACMODE/ IAC
      COMMON /QUIET / IPRT

      CHARACTER*(*) STR
      CHARACTER*128 BORT_STR,ERRSTR
      CHARACTER*40  CREF
      CHARACTER*10  TAG,TGS(100)
      CHARACTER*8   SUBSET,CVAL
      CHARACTER*3   TYP
      EQUIVALENCE   (CVAL,RVAL)
      LOGICAL       OPENIT,JUST_COUNT
      REAL*8        VAL,TAB(I1,I2),RVAL,UPS

      DATA MAXTG /100/

C-----------------------------------------------------------------------
      MPS(NODE) = 2**(IBT(NODE))-1
      LPS(LBIT) = MAX(2**(LBIT)-1,1)
C-----------------------------------------------------------------------

C  SET COUNTERS TO ZERO
C  --------------------

      IRET = 0
      IREC = 0
      ISUB = 0
      IACC = IAC

C  CHECK FOR COUNT SUBSET ONLY OPTION (RETURNING THE BUFRLIB'S GLOBAL
C   VALUE FOR MISSING IN OUTPUT ARRAY) INDICATED BY NEGATIVE UNIT
C  ------------------------------------------------------------------

      LUNIT = ABS(LUNIN)
      JUST_COUNT = LUNIN.LT.LUNIT

      CALL STATUS(LUNIT,LUN,IL,IM)
      OPENIT = IL.EQ.0

      IF(OPENIT) THEN

C  OPEN BUFR FILE CONNECTED TO UNIT LUNIT IF IT IS NOT ALREADY OPEN
C  ----------------------------------------------------------------

         CALL OPENBF(LUNIT,'INX',LUNIT)
      ELSE

C  IF BUFR FILE ALREADY OPENED, SAVE POSITION & REWIND TO FIRST DATA MSG
C  ---------------------------------------------------------------------

         CALL REWNBF(LUNIT,0)        
      ENDIF

      IAC = 1

C  SET THE OUTPUT ARRAY VALUES TO THE BUFRLIB'S GLOBAL VALUE FOR
C   MISSING (BMISS)
C  -------------------------------------------------------------

      DO J=1,I2
      DO I=1,I1
      TAB(I,J) = BMISS
      ENDDO
      ENDDO

      IF(JUST_COUNT) THEN

C  COME HERE FOR COUNT ONLY OPTION (OUTPUT ARRAY VALUES REMAIN MISSING)
C  --------------------------------------------------------------------

         DO WHILE(IREADMG(-LUNIT,SUBSET,IDATE).GE.0)
         IRET = IRET+NMSUB(LUNIT)
         ENDDO
         GOTO 25
      ENDIF

C  OTHERWISE, CHECK FOR SPECIAL TAGS IN STRING
C  -------------------------------------------

      CALL PARSTR(STR,TGS,MAXTG,NTG,' ',.TRUE.)
      DO I=1,NTG
      IF(TGS(I).EQ.'IREC') IREC = I
      IF(TGS(I).EQ.'ISUB') ISUB = I
      ENDDO

C  READ A MESSAGE AND PARSE A STRING
C  ---------------------------------

10    IF(IREADMG(-LUNIT,SUBSET,JDATE).LT.0) GOTO 25
      CALL STRING(STR,LUN,I1,0)
      IF(IREC.GT.0) NODS(IREC) = 0
      IF(ISUB.GT.0) NODS(ISUB) = 0

C  PARSE THE MESSAGE DEPENDING ON WHETHER COMPRESSED OR NOT
C  --------------------------------------------------------

      CALL MESGBC(-LUNIT,MTYP,ICMP)
      IF(ICMP.EQ.0) THEN
         GOTO 15
      ELSEIF(ICMP.EQ.1) then
         GOTO 115
      ELSE
         GOTO 900
      ENDIF

C  ---------------------------------------------
C  THIS BRANCH IS FOR UNCOMPRESSED MESSAGES
C  ---------------------------------------------
C  SEE IF THERE IS ANOTHER SUBSET IN THE MESSAGE
C  ---------------------------------------------

15    IF(NSUB(LUN).EQ.MSUB(LUN)) GOTO 10
      IF(IRET+1.GT.I2) GOTO 99
      IRET = IRET+1

      DO I=1,NNOD
      NODS(I) = ABS(NODS(I))
      ENDDO

C  PARSE THE STRING NODES FROM A SUBSET
C  ------------------------------------

      MBIT = MBYT(LUN)*8 + 16
      NBIT = 0
      N = 1
      CALL USRTPL(LUN,N,N)
20    IF(N+1.LE.NVAL(LUN)) THEN
         N = N+1
         NODE = INV(N,LUN)
         MBIT = MBIT+NBIT
         NBIT = IBT(NODE)
         IF(ITP(NODE).EQ.1) THEN
            CALL UPBB(IVAL,NBIT,MBIT,MBAY(1,LUN))
            CALL USRTPL(LUN,N,IVAL)
         ENDIF
         DO I=1,NNOD
         IF(NODS(I).EQ.NODE) THEN
            IF(ITP(NODE).EQ.1) THEN
               CALL UPBB(IVAL,NBIT,MBIT,MBAY(1,LUN))
               TAB(I,IRET) = IVAL
            ELSEIF(ITP(NODE).EQ.2) THEN
               CALL UPBB(IVAL,NBIT,MBIT,MBAY(1,LUN))
               IF(IVAL.LT.MPS(NODE)) TAB(I,IRET) = UPS(IVAL,NODE)
            ELSEIF(ITP(NODE).EQ.3) THEN
               CVAL = ' '
               KBIT = MBIT
               CALL UPC(CVAL,NBIT/8,MBAY(1,LUN),KBIT)
               TAB(I,IRET) = RVAL
            ENDIF
            NODS(I) = -NODS(I)
            GOTO 20
         ENDIF
         ENDDO
         DO I=1,NNOD
         IF(NODS(I).GT.0) GOTO 20
         ENDDO
      ENDIF

C  UPDATE THE SUBSET POINTERS BEFORE NEXT READ
C  -------------------------------------------

      IBIT = MBYT(LUN)*8
      CALL UPB(NBYT,16,MBAY(1,LUN),IBIT)
      MBYT(LUN) = MBYT(LUN) + NBYT
      NSUB(LUN) = NSUB(LUN) + 1
      IF(IREC.GT.0) TAB(IREC,IRET) = NMSG(LUN)
      IF(ISUB.GT.0) TAB(ISUB,IRET) = NSUB(LUN)
      GOTO 15

C  ---------------------------------------------
C  THIS BRANCH IS FOR COMPRESSED MESSAGES
C  ---------------------------------------------
C  STORE ANY MESSAGE AND/OR SUBSET COUNTERS
C  ---------------------------------------------

C  CHECK ARRAY BOUNDS
C  ------------------

115   IF(IRET+MSUB(LUN).GT.I2) GOTO 99

C  STORE MESG/SUBS TOKENS
C  ----------------------

      IF(IREC.GT.0.OR.ISUB.GT.0) THEN
         DO NSB=1,MSUB(LUN)
         IF(IREC.GT.0) TAB(IREC,IRET+NSB) = NMSG(LUN)
         IF(ISUB.GT.0) TAB(ISUB,IRET+NSB) = NSB
         ENDDO
      ENDIF

C  SETUP A NEW SUBSET TEMPLATE, PREPARE TO SUB-SURF
C  ------------------------------------------------

      CALL USRTPL(LUN,1,1)
      IBIT = MBYT(LUN)
      N = 0

C  UNCOMPRESS CHOSEN NODES INTO THE TAB ARRAY (FIRST OCCURANCES ONLY)
C  ------------------------------------------------------------------

C  READ ELEMENTS LOOP
C  ------------------

120   DO N=N+1,NVAL(LUN)
      NODE = INV(N,LUN)
      NBIT = IBT(NODE)
      ITYP = ITP(NODE)

C  FIRST TIME IN RESET NODE INDEXES, OR CHECK FOR NODE(S) STILL NEEDED
C  -------------------------------------------------------------------

      IF(N.EQ.1) THEN
         DO I=1,NNOD
         NODS(I) = ABS(NODS(I))
         ENDDO
      ELSE
         DO I=1,NNOD
         IF(NODS(I).GT.0) GOTO 125
         ENDDO
         GOTO 135
      ENDIF

C  FIND THE EXTENT OF THE NEXT SUB-GROUP
C  -------------------------------------

125   IF(ITYP.EQ.1.OR.ITYP.EQ.2) THEN
         CALL UPB(LREF,NBIT,MBAY(1,LUN),IBIT)
         CALL UPB(LINC,   6,MBAY(1,LUN),IBIT)
         NIBIT = IBIT + LINC*MSUB(LUN)
      ELSEIF(ITYP.EQ.3) THEN
         CREF=' '
         CALL UPC(CREF,NBIT/8,MBAY(1,LUN),IBIT)
         CALL UPB(LINC,   6,MBAY(1,LUN),IBIT)
         NIBIT = IBIT + 8*LINC*MSUB(LUN)
      ELSE
         GOTO 120
      ENDIF

C  LOOP OVER STRING NODES
C  ----------------------

      DO I=1,NNOD

C  CHOSEN NODES LOOP - KEEP TRACK OF NODES NEEDED AND NODES FOUND
C  --------------------------------------------------------------

      IF(NODE.NE.NODS(I)) GOTO 130
      NODS(I) = -NODS(I)
      LRET = IRET

C  PROCESS A FOUND NODE INTO TAB
C  -----------------------------

      IF(ITYP.EQ.1.OR.ITYP.EQ.2) THEN
         DO NSB=1,MSUB(LUN)
         JBIT = IBIT + LINC*(NSB-1)
         CALL UPB(NINC,LINC,MBAY(1,LUN),JBIT)
         IVAL = LREF+NINC
         LRET = LRET+1
         IF(NINC.LT.LPS(LINC)) TAB(I,LRET) = UPS(IVAL,NODE)
         ENDDO
      ELSEIF(ITYP.EQ.3) THEN
         DO NSB=1,MSUB(LUN)
         IF(LINC.EQ.0) THEN
           CVAL = CREF
         ELSE
           JBIT = IBIT + LINC*(NSB-1)*8
           CVAL = ' '
           CALL UPC(CVAL,LINC,MBAY(1,LUN),JBIT)
         ENDIF
         LRET = LRET+1
         TAB(I,LRET) = RVAL
         ENDDO
      ELSE
         CALL BORT('UFBTAB - INVALID ELEMENT TYPE SPECIFIED')
      ENDIF

C  END OF LOOPS FOR COMPRESSED MESSAGE PARSING
C  -------------------------------------------

130   CONTINUE
      ENDDO
      IF(ITYP.EQ.1) CALL USRTPL(LUN,N,IVAL)
      IBIT = NIBIT

C  END OF READ ELEMENTS LOOP
C  -------------------------

      ENDDO
135   IRET = IRET+MSUB(LUN)

C  END OF MESSAGE PARSING - GO BACK FOR ANOTHER
C  --------------------------------------------

      GOTO 10

C  -------------------------------------------
C  ERROR PROCESSING AND EXIT ROUTES BELOW
C  -------------------------------------------
C  EMERGENCY ROOM TREATMENT FOR ARRAY OVERFLOW
C  -------------------------------------------

99    NREP = IRET
      DO WHILE(IREADSB(LUNIT).EQ.0)
      NREP = NREP+1
      ENDDO
      DO WHILE(IREADMG(-LUNIT,SUBSET,JDATE).GE.0)
      NREP = NREP+NMSUB(LUNIT)
      ENDDO
      IF(IPRT.GE.0) THEN
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      WRITE ( UNIT=ERRSTR, FMT='(A,A,I8,A,A)' )
     . 'BUFRLIB: UFBTAB - THE NO. OF DATA SUBSETS IN THE BUFR FILE ',
     . 'IS .GT. LIMIT OF ', I2, ' IN THE 4TH ARG. (INPUT) - ',
     . 'INCOMPLETE READ'
      CALL ERRWRT(ERRSTR)
      WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
     . '>>>UFBTAB STORED ', IRET, ' REPORTS OUT OF ', NREP, '<<<'
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL ERRWRT(' ')
      ENDIF


25    IF(OPENIT) THEN

C  CLOSE BUFR FILE IF IT WAS OPENED HERE
C  -------------------------------------

         CALL CLOSBF(LUNIT)
      ELSE

C  RESTORE BUFR FILE TO PREV. STATUS & POSITION IF NOT ORIG. OPENED HERE
C  ---------------------------------------------------------------------

         CALL REWNBF(LUNIT,1)
      ENDIF

      IAC = IACC

C  EXITS
C  -----

      RETURN
900   WRITE(BORT_STR,'("BUFRLIB: UFBTAB - INVALID COMPRESSION '//
     . 'INDICATOR (ICMP=",I3," RETURNED FROM BUFR ARCHIVE LIBRARY '//
     . 'ROUTINE MESGBC")') ICMP
      CALL BORT(BORT_STR)
      END
