datebf.f

Go to the documentation of this file.

C> @file
C> @brief Read the Section 1 date-time from the first data message
C> of a BUFR file.
C> @author J. Woollen @date 1994-01-06
 
C> This subroutine reads and returns the Section 1 date-time from
C> the first data message of a BUFR file, bypassing any messages
C> at the beginning of the file which may contain embedded DX BUFR
C> table information.
C>
C> @param[in] LUNIT   -- integer: Fortran logical unit number for BUFR
C>                       file
C> @param[out] MEAR   -- integer: Year stored within Section 1 of
C>                       first data message, in format of either
C>                       YY or YYYY, depending on the most
C>                       recent call to subroutine datelen()
C> @param[out] MMON   -- integer: Month stored within Section 1 of
C>                       first data message
C> @param[out] MDAY   -- integer: Day stored within Section 1 of
C>                       first data message
C> @param[out] MOUR   -- integer: Hour stored within Section 1 of
C>                       first data message
C> @param[out] IDATE   -- integer: Date-time stored within Section 1 of
C>                        first data message, in format of either
C>                        YYMMDDHH or YYYYMMDDHH, depending on the most
C>                        recent call to subroutine datelen()
C>
C> Logical unit LUNIT must already be associated with a filename
C> on the local system, typically via a Fortran "OPEN" statement.
C>
C>
C> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE datebf(LUNIT,MEAR,MMON,MDAY,MOUR,IDATE)
 
      USE moda_mgwa
      USE modv_im8b
 
      COMMON /quiet / iprt
 
      CHARACTER*128 errstr
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL datebf(my_lunit,mear,mmon,mday,mour,idate)
         CALL x48(mear,mear,1)
         CALL x48(mmon,mmon,1)
         CALL x48(mday,mday,1)
         CALL x48(mour,mour,1)
         CALL x48(idate,idate,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
C  Initialization, in case OPENBF hasn't been called yet.
C  ------------------------------------------------------
 
      IF ( .NOT. ALLOCATED(mgwa) ) THEN
        CALL openbf(lunit,'FIRST',lunit)
      ENDIF
 
      idate = -1
 
C  SEE IF THE FILE IS ALREADY OPEN TO BUFR INTERFACE (A NO-NO)
C  -----------------------------------------------------------
 
      CALL status(lunit,lun,jl,jm)
      IF(jl.NE.0) GOTO 900
      CALL openbf(lunit,'INX',lunit)
 
C  READ TO A DATA MESSAGE AND PICK OUT THE DATE
C  --------------------------------------------
 
1     CALL rdmsgw(lunit,mgwa,ier)
      IF(ier.LT.0) GOTO 100
      IF(idxmsg(mgwa).EQ.1) GOTO 1
 
      idate = igetdate(mgwa,mear,mmon,mday,mour)
 
100   IF(iprt.GE.1 .AND. idate.EQ.-1) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      errstr = 'BUFRLIB: DATEBF - SECTION 1 DATE COULD NOT BE '//
     .  'LOCATED - RETURN WITH IDATE = -1'
      CALL errwrt(errstr)
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
      ENDIF
 
C  EXITS
C  -----
 
      CALL closbf(lunit)
      RETURN
900   CALL bort
     . ('BUFRLIB: DATEBF - INPUT BUFR FILE IS OPEN, IT MUST BE CLOSED')
      END