      SUBROUTINE UFBMEX(LUNIT,LUNDX,INEW,IRET,MESG) 

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UFBMEX
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2012-01-26
C
C ABSTRACT: THIS SUBROUTINE OPENS A BUFR FILE FOR INPUT, READS EACH
C   MESSAGE AND TRANSFERS THEM ONE-BY-ONE TO INTERNAL MEMORY (ARRAY
C   MSGS IN COMMON BLOCK /MSGMEM/).  IF MESSAGES ARE APPENDED TO
C   EXISTING MESSAGES IN INTERNAL MEMORY, THE BUFR FILE READ HERE IS
C   CLOSED PRIOR TO RETURNING TO THE CALLING PROGRAM.  AN ARRAY IS
C   ALSO RETURNED CONTAINING A LIST OF MESSAGE TYPES READ IN.
C
C   THIS IS A VARIATION OF UFBMEM WHICH ENABLES MESSAGE SORTING BEFORE
C   READING.  BECAUSE OF THIS RE-ORDERING, EMBEDDED TABLE MESSAGES ARE
C   NOT STORED IN COMMON /MSGMEM/, SINCE THEY ARE NO LONGER RELEVANT
C   ONCE THE RE-ORDERING (I.E. SORTING) HAS TAKEN PLACE.  INSTEAD, A
C   SEPARATE UNIT NUMBER IS ADDED TO THE INPUT ARGUMENTS TO SPECIFY
C   WHERE THE NECESSARY BUFR TABLE INFORMATION CAN BE FOUND.
C
C PROGRAM HISTORY LOG:
C 2012-01-26  J. WOOLLEN -- MODIFIED UFBMEM TO READ AND SORT MEMORY
C                           MESSAGES FOR TRANJB INGEST ROUTINES AND
C                           RETURN A LIST OF MESSAGE TYPES READ IN.
C                           ALSO, A SEPARATE INPUT ARGUMENT IS ADDED
C                           TO SPECIFY WHERE TO FIND THE BUFR TABLE,
C                           INSTEAD OF SAVING EMBEDDED DICTIONARY
C                           MESSAGES IN COMMON /MSGMEM/
C
C USAGE:    CALL UFBMEX (LUNIT, LUNDX, INEW, IRET, MESG)
C   INPUT ARGUMENT LIST:
C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C     LUNDX    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR USER-
C                SUPPLIED BUFR DICTIONARY TABLE IN CHARACTER FORMAT
C     INEW     - INTEGER: SWITCH:
C                       0 = initialize internal arrays prior to
C                           transferring messages here
C                    else = append the messages transferred here to
C                           internal memory arrays
C
C   OUTPUT ARGUMENT LIST:
C     IRET     - INTEGER: NUMBER OF MESSAGES TRANSFERRED
C     MESG     - INTEGER: ARRAY OF MESSAGE TYPES READ INTO MEMORY
C
C   INPUT FILES:
C     UNIT "LUNIT" - BUFR FILE
C     UNIT "LUNDX" - BUFR DICTIONARY TABLE IN CHARACTER FORMAT
C
C REMARKS:
C    NOTE THAT IREADMM, RDMEMM, READMM, UFBMMS, UFBMNS, UFBRMS, UFBTAB
C    OR UFBTAM CAN BE CALLED AFTER THIS TO READ SPECIFIC BUFR MESSAGES
C    FROM INTERNAL MEMORY.
C
C    THIS ROUTINE CALLS:        BORT     CLOSBF   ERRWRT   IUPBS01
C                               NMWRD    OPENBF   RDMSGW
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 /MSGMEM/ MUNIT,MLAST,MSGP(0:MAXMSG),MSGS(MAXMEM),
     .                MDX(MXDXW),IPDXM(MXDXM),LDXM,NDXM,LDXTS,NDXTS,
     .                IFDXTS(MXDXTS),ICDXTS(MXDXTS),IPMSGS(MXDXTS)

      CHARACTER*128 BORT_STR,ERRSTR
      DIMENSION     MBAY(MXMSGLD4)
      INTEGER       MESG(MAXMSG)

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

C  TRY TO OPEN BUFR FILE AND SET TO INITIALIZE OR CONCATENATE
C  ----------------------------------------------------------

      CALL OPENBF(LUNIT,'IN',LUNDX)

      IF(INEW.EQ.0) THEN
         MSGP(0) = 0
         MUNIT = 0
         MLAST = 0
         NDXTS = 0
         LDXTS = 0
         NDXM = 0
         LDXM = 0
      ENDIF

      NMSG = MSGP(0)
      IRET = 0
      IFLG = 0
      ITIM = 0

C  SET SOME FLAGS SO THAT SUBSEQUENT CALLS TO THE MESSAGE READING
C  ROUTINES WILL KNOW THERE IS A BUFR TABLE IN SCOPE.

      NDXTS = 1
      LDXTS = 1
      IPMSGS(1) = 1

C  TRANSFER MESSAGES FROM FILE TO MEMORY - SET MESSAGE POINTERS
C  ------------------------------------------------------------

1     CALL RDMSGW(LUNIT,MBAY,IER)
      IF(IER.EQ.-1) GOTO 100
      IF(IER.EQ.-2) GOTO 900

      NMSG = NMSG+1
      MESG(NMSG) = IUPBS01(MBAY,'MTYP')
      IF(NMSG      .GT.MAXMSG) IFLG = 1
      LMEM = NMWRD(MBAY)
      IF(LMEM+MLAST.GT.MAXMEM) IFLG = 2

      IF(IFLG.EQ.0) THEN
         IRET = IRET+1
         DO I=1,LMEM
            MSGS(MLAST+I) = MBAY(I)
         ENDDO
         MSGP(0)    = NMSG
         MSGP(NMSG) = MLAST+1
      ELSE
         IF(ITIM.EQ.0) THEN
            MLAST0 = MLAST
            ITIM=1
         ENDIF
      ENDIF
      MLAST = MLAST+LMEM
      GOTO 1

C  EXITS
C  -----

100   IF(IFLG.EQ.1) THEN

C  EMERGENCY ROOM TREATMENT FOR MAXMSG ARRAY OVERFLOW
C  --------------------------------------------------

      IF(IPRT.GE.0) THEN
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      WRITE ( UNIT=ERRSTR, FMT='(A,A,I8,A)' )
     . 'BUFRLIB: UFBMEX - THE NO. OF MESSAGES REQUIRED TO STORE ',
     . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', MAXMSG, 
     . ') - INCOMPLETE READ'
      CALL ERRWRT(ERRSTR)
      WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
     . '>>>UFBMEX STORED ', MSGP(0), ' MESSAGES OUT OF ', NMSG, '<<<'
      CALL ERRWRT(ERRSTR)
      WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
     . '>>>UFBMEX STORED ', MLAST0, ' BYTES OUT OF ', MLAST, '<<<'
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL ERRWRT(' ')
      ENDIF
      MLAST=MLAST0
      ENDIF

      IF(IFLG.EQ.2) THEN

C  EMERGENCY ROOM TREATMENT FOR MAXMEM ARRAY OVERFLOW
C  --------------------------------------------------

      IF(IPRT.GE.0) THEN
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      WRITE ( UNIT=ERRSTR, FMT='(A,A,I8,A)' )
     . 'BUFRLIB: UFBMEX - THE NO. OF BYTES REQUIRED TO STORE ',
     . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', MAXMEM, 
     . ') - INCOMPLETE READ'
      CALL ERRWRT(ERRSTR)
      WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
     . '>>>UFBMEX STORED ', MLAST0, ' BYTES OUT OF ', MLAST, '<<<'
      CALL ERRWRT(ERRSTR)
      WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
     . '>>>UFBMEX STORED ', MSGP(0), ' MESSAGES OUT OF ', NMSG, '<<<'
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL ERRWRT(' ')
      ENDIF
      MLAST=MLAST0
      ENDIF

      IF(IRET.EQ.0) THEN
         CALL CLOSBF(LUNIT)
      ELSE
         IF(MUNIT.NE.0) CALL CLOSBF(LUNIT)
         IF(MUNIT.EQ.0) MUNIT = LUNIT
      ENDIF
      IUNIT = MUNIT

C  EXITS
C  -----

      RETURN
900   WRITE(BORT_STR,'("BUFRLIB: UFBMEX - ERROR READING MESSAGE '//
     . 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') NMSG+1,LUNIT
      CALL BORT(BORT_STR)
      END
