SUBROUTINE READERME(MESG,LUNIT,SUBSET,JDATE,IRET)
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
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 ICHKSTR LMSG
C STATUS 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 /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
. MBAY(MXMSGLD4,NFILES)
CHARACTER*8 SUBSET,SEC0
CHARACTER*1 CEC0(8)
DIMENSION MESG(*),IEC0(2)
EQUIVALENCE (SEC0,IEC0,CEC0)
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)
DO I=1,LMSG(SEC0)
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 902
C PARSE THE MESSAGE SECTION CONTENTS
C ----------------------------------
CALL CKTABA(LUN,SUBSET,JDATE,IRET)
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 CALL BORT('BUFRLIB: READERME - FIRST 4 BYTES READ FROM RECORD'//
. ' NOT "BUFR", DOES NOT CONTAIN BUFR DATA')
END