<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='READERME'><A href='../../html_code/bufr/readerme.f.html#READERME' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE READERME(MESG,LUNIT,SUBSET,JDATE,IRET) 1,18
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: READERME
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1995-06-28
C
C ABSTRACT: THIS SUBROUTINE READS INFORMATION FROM A BUFR DATA MESSAGE
C ALREADY IN MEMORY, PASSED IN AS AN INPUT ARGUMENT. IT IS SIMILAR
C TO BUFR ARCHIVE LIBRARY SUBROUTINE READMG EXCEPT, INSTEAD OF
C READING BUFR MESSAGES DIRECTLY FROM A BUFR FILE THAT IS PHYSICALLY
C STORED ON THE LOCAL SYSTEM AND INTERFACED TO THE SOFTWARE VIA A
C LOGICAL UNIT NUMBER, IT READS BUFR MESSAGES DIRECTLY FROM A MEMORY
C ARRAY WITHIN THE APPLICATION PROGRAM ITSELF. THIS PROVIDES USERS
C WITH GREATER FLEXIBILITY FROM AN INPUT/OUTPUT PERSPECTIVE.
C READERME CAN BE USED IN ANY CONTEXT IN WHICH READMG MIGHT OTHERWISE
C BE USED. IF THIS MESSAGE IS NOT A BUFR MESSAGE, THEN AN
C APPROPRIATE CALL IS MADE TO BUFR ARCHIVE LIBRARY SUBROUTINE BORT.
C
C PROGRAM HISTORY LOG:
C 1995-06-28 J. WOOLLEN -- ORIGINAL AUTHOR (FOR ERS DATA)
C 1997-07-29 J. WOOLLEN -- MODIFIED TO PROCESS GOES SOUNDINGS FROM
C NESDIS
C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C ROUTINE "BORT"; MODIFIED TO MAKE Y2K
C COMPLIANT; IMPROVED MACHINE PORTABILITY
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); INCREASED THE
C MAXIMUM NUMBER OF POSSIBLE DESCRIPTORS IN A
C SUBSET FROM 1000 TO 3000
C 2000-09-19 J. WOOLLEN -- REMOVED MESSAGE DECODING LOGIC THAT HAD
C BEEN REPLICATED IN THIS AND OTHER READ
C ROUTINES AND CONSOLIDATED IT INTO A NEW
C ROUTINE CKTABA, CALLED HERE, WHICH IS
C ENHANCED TO ALLOW COMPRESSED AND STANDARD
C BUFR MESSAGES TO BE READ (ROUTINE UNCMPS,
C WHICH HAD BEEN CALLED BY THIS AND OTHER
C ROUTINES IS NOW OBSOLETE AND HAS BEEN
C REMOVED FROM THE BUFRLIB; MAXIMUM MESSAGE
C LENGTH INCREASED FROM 10,000 TO 20,000
C BYTES
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED
C DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C TERMINATES ABNORMALLY
C 2004-08-18 J. ATOR -- MODIFIED 'BUFR' STRING TEST FOR PORTABILITY
C TO EBCDIC MACHINES; MAXIMUM MESSAGE LENGTH
C INCREASED FROM 20,000 TO 50,000 BYTES
C 2005-11-29 J. ATOR -- USE ICHKSTR
C 2009-03-23 D. KEYSER -- CALL BORT IN CASE OF MBAY OVERFLOW
C 2009-03-23 J. ATOR -- ADD LOGIC TO ALLOW SECTION 3 DECODING;
C ADD LOGIC TO PROCESS DICTIONARY MESSAGES
C 2012-06-07 J. ATOR -- DON'T RESPOND TO DX TABLE MESSAGES IF
C SECTION 3 DECODING IS BEING USED
C
C USAGE: CALL READERME
(MESG, LUNIT, SUBSET, JDATE, IRET)
C INPUT ARGUMENT LIST:
C MESG - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
C MESSAGE
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C
C OUTPUT ARGUMENT LIST:
C SUBSET - CHARACTER*8: TABLE A MNEMONIC FOR TYPE OF BUFR MESSAGE
C BEING READ
C JDATE - INTEGER: DATE-TIME STORED WITHIN SECTION 1 OF BUFR
C MESSAGE BEING READ, IN FORMAT OF EITHER YYMMDDHH OR
C YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
C IRET - INTEGER: RETURN CODE:
C 0 = normal return
C -1 = unrecognized Table A message type
C 11 = this is a BUFR table (dictionary) message
C
C REMARKS:
C THIS ROUTINE CALLS: BORT CKTABA DXINIT ERRWRT
C ICHKSTR IDXMSG IUPBS3 LMSG
C MAKESTAB READS3 STATUS STBFDX
C WTSTAT
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 /SC3BFR/ ISC3(NFILES),TAMNEM(NFILES)
COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
. MBAY(MXMSGLD4,NFILES)
COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)
COMMON /QUIET/ IPRT
CHARACTER*128 BORT_STR,ERRSTR
CHARACTER*8 SUBSET,SEC0,TAMNEM
CHARACTER*1 CEC0(8)
DIMENSION MESG(*),IEC0(2)
DIMENSION IDRDM(NFILES)
LOGICAL ENDTBL
EQUIVALENCE (SEC0,IEC0,CEC0)
DATA IDRDM/NFILES*0/
SAVE IDRDM
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
IRET = 0
C CHECK THE FILE STATUS
C ---------------------
CALL STATUS(LUNIT,LUN,IL,IM)
IF(IL.EQ.0) GOTO 900
IF(IL.GT.0) GOTO 901
CALL WTSTAT(LUNIT,LUN,IL, 1)
C COPY THE INPUT MESSAGE INTO THE INTERNAL MESSAGE BUFFER
C -------------------------------------------------------
IEC0(1) = MESG(1)
IEC0(2) = MESG(2)
LNMSG = LMSG(SEC0)
IF(LNMSG*NBYTW.GT.MXMSGL) GOTO 902
DO I=1,LNMSG
MBAY(I,LUN) = MESG(I)
ENDDO
C Confirm that the first 4 bytes of SEC0 contain 'BUFR' encoded in
C CCITT IA5 (i.e. ASCII).
IF(ICHKSTR('BUFR',CEC0,4).NE.0) GOTO 903
C PARSE THE MESSAGE SECTION CONTENTS
C ----------------------------------
IF(ISC3(LUN).NE.0) CALL READS3(LUN)
CALL CKTABA(LUN,SUBSET,JDATE,IRET)
IF(ISC3(LUN).NE.0) RETURN
C CHECK FOR A DX DICTIONARY MESSAGE
C ---------------------------------
C A new DX dictionary table can be passed in as a consecutive set of
C DX dictionary messages. Each message should be passed in one at a
C time, via input argument MESG during consecutive calls to this
C subroutine, and will be processed as a single dictionary table up
C until the next message is passed in which either contains no data
C subsets or else is a non-DX dictionary message.
ENDTBL = .FALSE.
IF(IDXMSG(MBAY(1,LUN)).EQ.1) THEN
C This is a DX dictionary message that was generated by the
C BUFRLIB archive library software.
IF(IUPBS3(MBAY(1,LUN),'NSUB').EQ.0) THEN
C But it doesn't contain any actual dictionary information, so
C assume we've reached the end of the dictionary table.
IF(IDRDM(LUN).GT.0) THEN
ENDTBL = .TRUE.
ENDIF
ELSE
IF(IDRDM(LUN).EQ.0) THEN
C This is the first DX dictionary message that is part of a
C new dictionary table.
CALL DXINIT(LUN,0)
ENDIF
IDRDM(LUN) = IDRDM(LUN) + 1
CALL STBFDX(LUN,MBAY(1,LUN))
ENDIF
ELSE IF(IDRDM(LUN).GT.0) THEN
C This is the first non-DX dictionary message received following a
C string of DX dictionary messages, so assume we've reached the
C end of the dictionary table.
ENDTBL = .TRUE.
ENDIF
IF(ENDTBL) THEN
IF ( IPRT .GE. 2 ) THEN
CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
WRITE ( UNIT=ERRSTR, FMT='(A,I3,A)' )
. 'BUFRLIB: READERME - STORED NEW DX TABLE CONSISTING OF (',
. IDRDM(LUN), ') MESSAGES;'
CALL ERRWRT(ERRSTR)
ERRSTR = 'WILL APPLY THIS TABLE TO ALL SUBSEQUENT DATA '//
. 'MESSAGES UNTIL NEXT DX TABLE IS PASSED IN'
CALL ERRWRT(ERRSTR)
CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
IDRDM(LUN) = 0
CALL MAKESTAB
ENDIF
C EXITS
C -----
RETURN
900 CALL BORT('BUFRLIB: READERME - INPUT BUFR FILE IS CLOSED, IT '//
. 'MUST BE OPEN FOR INPUT')
901 CALL BORT('BUFRLIB: READERME - INPUT BUFR FILE IS OPEN FOR '//
. 'OUTPUT, IT MUST BE OPEN FOR INPUT')
902 WRITE(BORT_STR,'("BUFRLIB: READERME - INPUT BUFR MESSAGE LENGTH",
. 1X,I6," BYTES) IS LARGER THAN LIMIT OF ",I6," BYTES")')
. LNMSG*NBYTW,MXMSGL
CALL BORT(BORT_STR)
903 CALL BORT('BUFRLIB: READERME - FIRST 4 BYTES READ FROM RECORD'//
. ' NOT "BUFR", DOES NOT CONTAIN BUFR DATA')
END