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> 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> @author J. Woollen
C> @date 1994-01-06
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> <p>Logical unit LUNIT must already be associated with a filename
C> on the local system, typically via a Fortran "OPEN" statement.
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
C> | 1998-08-31 | J. Woollen | Modified to correct an error which led to MEAR being returned as 2-digit when it was requested as 4-digit via a prior call to datelen() |
C> | 1998-10-27 | J. Woollen | Modified to correct problems caused by in-lining code with fpp directives |
C> | 2003-05-19 | M. Shirey  | Replaced calls to Fortran insrinsic function ICHAR with the NCEP W3LIB function MOVA2I |
C> | 2003-11-04 | D. Keyser  | Modified date calculations to no longer use floating point arithmetic |
C> | 2004-08-18 | J. Ator    | Modified 'BUFR' string test for portability to EBCDIC machines |
C> | 2004-12-20 | D. Keyser  | Calls wrdlen() to initialize local machine information, in case it has not yet been called |
C> | 2005-11-29 | J. Ator    | Use igetdate(), iupbs01() and rdmsgw() |
C> | 2009-03-23 | J. Ator    | Use idxmsg() and errwrt() |
C> | 2012-09-15 | J. Woollen | Modified for C/I/O/BUFR interface; use new openbf type 'INX' to open and close the C file without closing the Fortran file |
C> | 2014-12-10 | J. Ator    | Use modules instead of COMMON blocks |
C>                           
      SUBROUTINE datebf(LUNIT,MEAR,MMON,MDAY,MOUR,IDATE)

      USE moda_mgwa

      COMMON /quiet / iprt

      CHARACTER*128 errstr

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

C  Initialization, in case OPENBF hasn't been called yet.

      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