dumpbf.f

Go to the documentation of this file.

C> @file
C> @brief Read the Section 1 date-time from the first two "dummy"
C> messages of an NCEP dump file
C>
C> @author J. Woollen @date 1996-12-11
 
C> Read the Section 1 date-time from the first two "dummy" messages of an
C> NCEP dump file.
C>
C> This bypasses any messages at the beginning of the
C> file which may contain embedded DX BUFR table information. Normally,
C> the first of these two "dummy" messages contains the dump center
C> date-time in Section 1, while the second message contains the dump
C> initiation date-time in Section 1. Neither of these two "dummy"
C> messages should contain any data subsets in Section 4.
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> If the subroutine fails to locate either of the two "dummy"
C> messages within the file pointed to by LUNIT, then the corresponding
C> JDATE or JDUMP array will be filled with all values set to (-1).
C>
C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR
C> dump file.
C> @param[out] JDATE - integer(5): Dump center date-time stored
C> within Section 1 of first "dummy" message:
C> - Index 1 contains the year, in format of either YY or YYYY,
C>   depending on the most recent call to subroutine datelen().
C> - Index 2 contains the month.
C> - Index 3 contains the day.
C> - Index 4 contains the hour.
C> - Index 5 contains the minute.
C> @param[out] JDUMP  -- integer(5): Dump initiation date-time stored
C> within Section 1 of second "dummy" message:
C> - Index 1 contains the year, in format of either YY or YYYY,
C>   depending on the most recent call to subroutine datelen().
C> - Index 2 contains the month.
C> - Index 3 contains the day.
C> - Index 4 contains the hour.
C> - Index 5 contains the minute.
C>
C> @author J. Woollen @date 1996-12-11
      RECURSIVE SUBROUTINE dumpbf(LUNIT,JDATE,JDUMP)
 
      USE moda_mgwa
      USE modv_im8b
 
      COMMON /quiet / iprt
 
      dimension     jdate(*),jdump(*)
 
      CHARACTER*128 errstr
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL dumpbf(my_lunit,jdate,jdump)
         CALL x48(jdate,jdate,5)
         CALL x48(jdump,jdump,5)
 
         im8b=.true.
         RETURN
      ENDIF
 
C  CALL SUBROUTINE WRDLEN TO INITIALIZE SOME IMPORTANT INFORMATION
C  ABOUT THE LOCAL MACHINE (IN CASE IT HAS NOT YET BEEN CALLED)
C  ---------------------------------------------------------------
 
      CALL wrdlen
 
      DO i=1,5
        jdate(i) = -1
        jdump(i) = -1
      ENDDO
 
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 PAST ANY DICTIONARY MESSAGES
C  ---------------------------------
 
1     CALL rdmsgw(lunit,mgwa,ier)
      IF(ier.LT.0) GOTO 200
      IF(idxmsg(mgwa).EQ.1) GOTO 1
 
C  DUMP CENTER YY,MM,DD,HH,MM IS IN THE FIRST EMPTY MESSAGE
C  --------------------------------------------------------
C  i.e. the first message containing zero subsets
 
      IF(iupbs3(mgwa,'NSUB').NE.0) GOTO 200
 
      igd = igetdate(mgwa,jdate(1),jdate(2),jdate(3),jdate(4))
      jdate(5) = iupbs01(mgwa,'MINU')
 
C  DUMP CLOCK YY,MM,DD,HH,MM IS IN THE SECOND EMPTY MESSAGE
C  --------------------------------------------------------
C  i.e. the second message containing zero subsets
 
      CALL rdmsgw(lunit,mgwa,ier)
      IF(ier.LT.0) GOTO 200
 
      IF(iupbs3(mgwa,'NSUB').NE.0) GOTO 200
 
      igd = igetdate(mgwa,jdump(1),jdump(2),jdump(3),jdump(4))
      jdump(5) = iupbs01(mgwa,'MINU')
 
      CALL closbf(lunit)
      GOTO 100
 
200   IF(iprt.GE.1 .AND. (jdate(1).EQ.-1.OR.jdump(1).EQ.-1)) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      IF(jdate(1).EQ.-1) THEN
        errstr = 'BUFRLIB: DUMPBF - FIRST  EMPTY BUFR MESSAGE '//
     .    'SECTION 1 DATE COULD NOT BE LOCATED - RETURN WITH '//
     .    'JDATE = 5*-1'
        CALL errwrt(errstr)
      ENDIF
      IF(jdump(1).EQ.-1) THEN
        errstr = 'BUFRLIB: DUMPBF - SECOND EMPTY BUFR MESSAGE '//
     .    'SECTION 1 DATE COULD NOT BE LOCATED - RETURN WITH '//
     .    'JDUMP = 5*-1'
        CALL errwrt(errstr)
      ENDIF
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
      ENDIF
 
C  EXITS
C  -----
 
100   RETURN
900   CALL bort
     . ('BUFRLIB: DUMPBF - INPUT BUFR FILE IS OPEN, IT MUST BE CLOSED')
      END