readmg.f

Go to the documentation of this file.

C> @file
C> @brief Read the next message from a BUFR file that was previously
C> opened for reading.
C>
C> @authors J. Woollen, J. Ator @date 1994-01-06
 
C> Reads the next BUFR message from logical unit
C> ABS(LUNXX) into internal arrays.
C>
C> Logical unit ABS(LUNXX) should have already been opened for
C> input operations via a previous call to subroutine openbf().
C>
C> Whenever this subroutine returns with IRET = 0, this indicates
C> that a new BUFR message of type SUBSET and date-time JDATE was
C> successfully read into internal arrays within the NCEPLIBS-bufr
C> software, and from where it can then be easily manipulated or further
C> parsed via a call to one of the
C> [subset-reading subroutines](@ref hierarchy). Otherwise,
C> if the subroutine returns with IRET = -1, then this indicates that
C> there are no more BUFR messages (i.e. end-of-file) within the file
C> connected to logical unit ABS(LUNXX).
C>
C> @remarks
C> - Any DX BUFR table messages encountered within ABS(LUNXX) will be
C> automatically processed and stored internally, so a successful return
C> from this subroutine will always result in a BUFR message containing
C> actual data values within the internal arrays.
C> - In prior versions of the NCEPLIBS-bufr software, an input value of
C> LUNXX < 0 was an indicator to the subroutine to treat any read error
C> from ABS(LUNXX) the same as an end-of-file condition. This option is
C> no longer supported, but the capability to call this subroutine with
C> LUNXX < 0 is itself still supported for backwards-compatibility with
C> certain legacy application programs.
C>
C> @param[in] LUNXX   -- integer: Absolute value is Fortran logical unit
C>                       number for BUFR file
C> @param[out] SUBSET  -- character*8: Table A mnemonic for type of BUFR
C>                        message that was read
C>                        (see [DX BUFR Tables](@ref dfbftab)
C>                        for further information about Table A mnemonics)
C> @param[out] JDATE   -- integer: Date-time stored within Section 1 of
C>                        BUFR message that was read, in format of either
C>                        YYMMDDHH or YYYYMMDDHH, depending on the most
C>                        recent call to subroutine datelen()
C> @param[out] IRET    -- integer: return code
C> - 0 = new BUFR message was successfully read into internal arrays.
C> - -1 = there are no more BUFR messages in the file connected to logical unit
C> ABS(LUNXX).
C>
C> @authors J. Woollen, J. Ator @date 1994-01-06
      RECURSIVE SUBROUTINE readmg(LUNXX,SUBSET,JDATE,IRET)
 
      use bufrlib
 
      USE moda_msgcwd
      USE moda_sc3bfr
      USE moda_bitbuf
      USE modv_im8b
 
      COMMON /quiet / iprt
 
      CHARACTER*128 errstr
      CHARACTER*8 subset
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunxx,my_lunxx,1)
         CALL readmg(my_lunxx,subset,jdate,iret)
         CALL x48(jdate,jdate,1)
         CALL x48(iret,iret,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      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 NCEPLIBS-bufr 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_c(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')
      END