      SUBROUTINE READLC(LUNIT,CHR,STR)

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    READLC
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2003-11-04
C
C ABSTRACT: THIS SUBROUTINE RETURNS A CHARACTER DATA ELEMENT ASSOCIATED
C   WITH A PARTICULAR SUBSET MNEMONIC FROM THE INTERNAL MESSAGE BUFFER
C   (ARRAY MBAY IN COMMON BLOCK /BITBUF/).  IT IS DESIGNED TO BE USED
C   TO RETURN CHARACTER ELEMENTS GREATER THAN THE USUAL LENGTH OF EIGHT
C   BYTES.
C
C PROGRAM HISTORY LOG:
C 2003-11-04  J. WOOLLEN -- ORIGINAL AUTHOR
C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
C                           ABNORMALLY OR UNUSUAL THINGS HAPPEN
C 2004-08-09  J. ATOR    -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C                           20,000 TO 50,000 BYTES
C 2007-01-19  J. ATOR    -- REPLACED CALL TO PARSEQ WITH CALL TO PARSTR
C 2009-03-23  J. ATOR    -- ADDED CAPABILITY FOR COMPRESSED MESSAGES;
C                           ADDED CHECK FOR OVERFLOW OF CHR; ADDED '#'
C                           OPTION FOR MORE THAN ONE OCCURRENCE OF STR
C 2009-04-21  J. ATOR    -- USE ERRWRT
C 2012-12-07  J. ATOR    -- ALLOW STR MNEMONIC LENGTH OF UP TO 14 CHARS
C                           WHEN USED WITH '#' OCCURRENCE CODE
C
C USAGE:    CALL READLC (LUNIT, CHR, STR)
C   INPUT ARGUMENT LIST:
C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C     STR      - CHARACTER*(*): STRING (I.E., MNEMONIC)
C
C   OUTPUT ARGUMENT LIST:
C     CHR      - CHARACTER*(*): UNPACKED CHARACTER STRING (I.E.,
C                CHARACTER DATA ELEMENT GREATER THAN EIGHT BYTES)
C
C REMARKS:
C    THIS ROUTINE CALLS:        BORT     ERRWRT   PARSTR   PARUTG
C                               STATUS   UPC
C    THIS ROUTINE IS CALLED BY: UFBDMP   UFDUMP   WRTREE
C                               Also called by application programs.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE:  PORTABLE TO ALL PLATFORMS
C
C$$$

      INCLUDE 'bufrlib.prm'

      COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
     .                MBAY(MXMSGLD4,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)
      COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
      COMMON /RLCCMN/ NRST,IRNCH(MXRST),IRBIT(MXRST),CRTAG(MXRST)
      COMMON /USRBIT/ NBIT(MAXSS),MBIT(MAXSS)
      COMMON /UNPTYP/ MSGUNP(NFILES)
      COMMON /QUIET / IPRT

      CHARACTER*(*) CHR,STR
      CHARACTER*128 BORT_STR,ERRSTR
      CHARACTER*10  TAG,CTAG,CRTAG
      CHARACTER*14  TGS(10)
      CHARACTER*3   TYP
      REAL*8        VAL

      DATA MAXTG /10/

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

      CHR = ' '

C  CHECK THE FILE STATUS
C  ---------------------

      CALL STATUS(LUNIT,LUN,IL,IM)
      IF(IL.EQ.0) GOTO 900
      IF(IL.GT.0) GOTO 901
      IF(IM.EQ.0) GOTO 902

C  CHECK FOR TAGS (MNEMONICS) IN INPUT STRING (THERE CAN ONLY BE ONE)
C  ------------------------------------------------------------------

      CALL PARSTR(STR,TGS,MAXTG,NTG,' ',.TRUE.)
      IF(NTG.GT.1) GOTO 903

C     Check if a specific occurrence of the input string was requested;
C     if not, then the default is to return the first occurrence.

      CALL PARUTG(LUN,0,TGS(1),NNOD,KON,ROID)
      IF(KON.EQ.6) THEN
         IOID=NINT(ROID)
         IF(IOID.LE.0) IOID = 1
         CTAG = ' '
         II = 1
         DO WHILE((II.LE.10).AND.(TGS(1)(II:II).NE.'#'))
            CTAG(II:II)=TGS(1)(II:II)
            II = II + 1
         ENDDO
      ELSE
         IOID = 1
         CTAG = TGS(1)(1:10)
      ENDIF

C  LOCATE AND DECODE THE LONG CHARACTER STRING
C  -------------------------------------------

      IF(MSGUNP(LUN).EQ.0.OR.MSGUNP(LUN).EQ.1) THEN

C        The message is uncompressed

         ITAGCT = 0
         DO N=1,NVAL(LUN)
           NOD = INV(N,LUN)
           IF(CTAG.EQ.TAG(NOD)) THEN
             ITAGCT = ITAGCT + 1
             IF(ITAGCT.EQ.IOID) THEN
               IF(ITP(NOD).NE.3) GOTO 904
               NCHR = NBIT(N)/8
               IF(NCHR.GT.LEN(CHR)) GOTO 905
               KBIT = MBIT(N)
               CALL UPC(CHR,NCHR,MBAY(1,LUN),KBIT)
               GOTO 100
             ENDIF
           ENDIF
         ENDDO
      ELSEIF(MSGUNP(LUN).EQ.2) THEN

C        The message is compressed

         IF(NRST.GT.0) THEN
           ITAGCT = 0
           DO II=1,NRST
             IF(CTAG.EQ.CRTAG(II)) THEN
               ITAGCT = ITAGCT + 1
               IF(ITAGCT.EQ.IOID) THEN
                 NCHR = IRNCH(II)
                 IF(NCHR.GT.LEN(CHR)) GOTO 905
                 KBIT = IRBIT(II)
                 CALL UPC(CHR,NCHR,MBAY(1,LUN),KBIT)
                 GOTO 100
               ENDIF
             ENDIF
           ENDDO
         ENDIF
      ELSE
         GOTO 906
      ENDIF

C     If we made it here, then we couldn't find the requested string.

      IF(IPRT.GE.0) THEN
      CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
      ERRSTR = 'BUFRLIB: READLC - MNEMONIC ' // TGS(1) //
     .   ' NOT LOCATED IN REPORT SUBSET - RETURN WITH BLANK' //
     .   ' STRING FOR CHARACTER DATA ELEMENT'
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
      CALL ERRWRT(' ')
      ENDIF

C  EXITS
C  -----

100   RETURN
900   CALL BORT('BUFRLIB: READLC - INPUT BUFR FILE IS CLOSED, IT MUST'//
     . ' BE OPEN FOR INPUT')
901   CALL BORT('BUFRLIB: READLC - INPUT BUFR FILE IS OPEN FOR '//
     . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
902   CALL BORT('BUFRLIB: READLC - A MESSAGE MUST BE OPEN IN INPUT '//
     . 'BUFR FILE, NONE ARE')
903   WRITE(BORT_STR,'("BUFRLIB: READLC - THERE CANNOT BE MORE THAN '//
     . 'ONE MNEMONIC IN THE INPUT STRING (",A,") (HERE THERE ARE ",'//
     . 'I3,")")') STR,NTG
      CALL BORT(BORT_STR)
904   WRITE(BORT_STR,'("BUFRLIB: READLC - MNEMONIC ",A," DOES NOT '//
     . 'REPRESENT A CHARACTER ELEMENT (ITP=",I2,")")') TGS(1),ITP(NOD)
      CALL BORT(BORT_STR)
905   WRITE(BORT_STR,'("BUFRLIB: READLC - MNEMONIC ",A," IS A '//
     . 'CHARACTER STRING OF LENGTH",I4," BUT SPACE WAS PROVIDED '//
     . 'FOR ONLY",I4, " CHARACTERS")') TGS(1),NCHR,LEN(CHR)
      CALL BORT(BORT_STR)
906   WRITE(BORT_STR,'("BUFRLIB: READLC - MESSAGE UNPACK TYPE",I3,'//
     . '" IS NOT RECOGNIZED")') MSGUNP
      CALL BORT(BORT_STR)
      END
