<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='READMG'><A href='../../html_code/bufr/readmg.f.html#READMG' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE READMG(LUNXX,SUBSET,JDATE,IRET) 15,16
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: READMG
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE READS THE NEXT BUFR MESSAGE FROM LOGICAL
C UNIT NUMBER ABS(LUNXX) INTO AN INTERNAL MESSAGE BUFFER (I.E. ARRAY
C MBAY IN COMMON BLOCK /BITBUF/). ABS(LUNXX) SHOULD ALREADY BE OPENED
C FOR INPUT OPERATIONS. IF LUNXX < 0, THEN A READ ERROR FROM
C ABS(LUNXX) IS TREATED THE SAME AS THE END-OF-FILE (EOF) CONDITION;
C OTHERWISE, BUFR ARCHIVE LIBRARY SUBROUTINE BORT IS NORMALLY CALLED
C IN SUCH SITUATIONS. ANY DX DICTIONARY MESSAGES ENCOUNTERED WITHIN
C ABS(LUNXX) ARE AUTOMATICALLY PROCESSED AND STORED INTERNALLY, SO A
C SUCCESSFUL RETURN FROM THIS SUBROUTINE WILL ALWAYS RESULT IN A BUFR
C MESSAGE CONTAINING ACTUAL DATA VALUES.
C
C PROGRAM HISTORY LOG:
C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
C 1996-11-25 J. WOOLLEN -- MODIFIED TO EXIT GRACEFULLY WHEN THE BUFR
C FILE IS POSITIONED AFTER AN "END-OF-FILE"
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
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); MODIFIED WITH
C SEMANTIC ADJUSTMENTS TO AMELIORATE COMPILER
C COMPLAINTS FROM LINUX BOXES (INCREASES
C PORTABILITY)
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; MAXIMUM MESSAGE
C LENGTH INCREASED FROM 10,000 TO 20,000
C BYTES
C 2002-05-14 J. WOOLLEN -- REMOVED ENTRY POINT DATELEN (IT BECAME A
C SEPARATE ROUTINE IN THE BUFRLIB TO INCREASE
C PORTABILITY TO OTHER PLATFORMS)
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 -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C DOCUMENTATION; OUTPUTS MORE COMPLETE
C DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
C ABNORMALLY
C 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C 20,000 TO 50,000 BYTES
C 2005-11-29 J. ATOR -- ADDED RDMSGW AND RDMSGB CALLS TO SIMULATE
C READIBM; ADDED LUNXX < 0 OPTION TO SIMULATE
C READFT
C 2009-03-23 J. ATOR -- ADD LOGIC TO ALLOW SECTION 3 DECODING;
C ADD LOGIC TO PROCESS INTERNAL DICTIONARY
C MESSAGES
C 2012-06-07 J. ATOR -- DON'T RESPOND TO INTERNAL DICTIONARY
C MESSAGES IF SECTION 3 DECODING IS BEING USED
C 2012-09-15 J. WOOLLEN -- CONVERT TO C LANGUAGE I/O INTERFACE;
C REMOVE CODE TO REREAD MESSAGE AS BYTES;
C REPLACE FORTRAN BACKSPACE WITH C BACKBUFR
C
C USAGE: CALL READMG
(LUNXX, SUBSET, JDATE, IRET)
C INPUT ARGUMENT LIST:
C LUNXX - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT NUMBER
C FOR BUFR FILE (IF LUNXX IS LESS THAN ZERO, THEN READ
C ERRORS FROM ABS(LUNXX) ARE TREATED THE SAME AS EOF)
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 = there are no more BUFR mesages in ABS(LUNXX)
C
C REMARKS:
C THIS ROUTINE CALLS: BORT CKTABA ERRWRT IDXMSG
C RDBFDX RDMSGW READS3 STATUS
C WTSTAT BACKBUFR
C THIS ROUTINE IS CALLED BY: IREADMG READNS RDMGSB REWNBF
C UFBINX UFBPOS
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 /SC3BFR/ ISC3(NFILES),TAMNEM(NFILES)
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
. MBAY(MXMSGLD4,NFILES)
COMMON /QUIET / IPRT
CHARACTER*128 ERRSTR
CHARACTER*8 SUBSET,TAMNEM
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
IRET = 0
LUNIT = ABS(LUNXX)
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 READ A MESSAGE INTO THE INTERNAL MESSAGE BUFFER
C -----------------------------------------------
1 CALL RDMSGW(LUNIT,MBAY(1,LUN),IER)
IF(IER.EQ.-1) GOTO 200
C PARSE THE MESSAGE SECTION CONTENTS
C ----------------------------------
IF(ISC3(LUN).NE.0) CALL READS3(LUN)
CALL CKTABA(LUN,SUBSET,JDATE,IRET)
C LOOK FOR A DICTIONARY MESSAGE
C -----------------------------
IF(IDXMSG(MBAY(1,LUN)).NE.1) RETURN
C This is an internal dictionary message that was
C generated by the BUFRLIB archive library software.
IF(ISC3(LUN).NE.0) RETURN
C Section 3 decoding isn't being used, so backspace the
C file pointer and then use subroutine RDBFDX to read in
C all such dictionary messages (they should be stored
C consecutively!) and reset the internal tables.
CALL BACKBUFR(LUN)
CALL RDBFDX(LUNIT,LUN)
IF(IPRT.GE.1) THEN
CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
ERRSTR = 'BUFRLIB: READMG - INTERNAL DICTIONARY MESSAGE READ;'//
.' ACCOUNT FOR IT THEN READ IN NEXT MESSAGE WITHOUT RETURNING'
CALL ERRWRT(ERRSTR)
CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
C Now go read another message.
GOTO 1
C EOF ON ATTEMPTED READ
C ---------------------
200 CALL WTSTAT(LUNIT,LUN,IL,0)
INODE(LUN) = 0
IDATE(LUN) = 0
SUBSET = ' '
JDATE = 0
IRET = -1
RETURN
C EXITS
C -----
900 CALL BORT('BUFRLIB: READMG - INPUT BUFR FILE IS CLOSED, IT MUST'//
. ' BE OPEN FOR INPUT')
901 CALL BORT('BUFRLIB: READMG - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
. ', IT MUST BE OPEN FOR INPUT')
902 CALL BORT('BUFRLIB: READMG - ERROR READING A BUFR MESSAGE')
END