rtrcpt.f

Go to the documentation of this file.

C> @file
C> @brief Read the tank receipt time from Section 1 of a BUFR message.

C> This subroutine reads the tank receipt time (if one exists) from 
C> Section 1 of a BUFR message.  It is similar to subroutine rtrcptb(),
C> except that rtrcptb() operates on a BUFR message passed in via a
C> memory array, whereas this subroutine operates on the BUFR message
C> that was read into internal arrays via the most recent call to any
C> of the other [message-reading subroutines](@ref hierarchy) for a
C> specified Fortran logical unit.
C>
C> @author J. Ator
C> @date 2009-03-23
C>
C> @param[in] LUNIT -- integer: Fortran logical unit number for
C>                     BUFR file
C> @param[out] IYR  -- integer: Tank receipt year
C> @param[out] IMO  -- integer: Tank receipt month
C> @param[out] IDY  -- integer: Tank receipt day
C> @param[out] IHR  -- integer: Tank receipt hour
C> @param[out] IMI  -- integer: Tank receipt minute
C> @param[out] IRET -- integer: return code
C>                     - 0 = normal return
C>                     - -1 = no tank receipt time exists within the
C>                            BUFR message currently open for input
C>                            within internal arrays
C> 
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2009-03-23 | J. Ator | Original author |
C> | 2013-10-07 | J. Ator | Modified to call rtrcptb() |
C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
C>
      SUBROUTINE rtrcpt(LUNIT,IYR,IMO,IDY,IHR,IMI,IRET)

      USE moda_bitbuf

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

C     Check the file status.

      CALL status(lunit,lun,il,im)
      IF(il.EQ.0) goto 900
      IF(il.GT.0) goto 901
      IF(im.EQ.0) goto 902

C     Unpack the tank receipt time.

      CALL rtrcptb(mbay(1,lun),iyr,imo,idy,ihr,imi,iret)
    
C  EXITS
C  -----

      RETURN
900   CALL bort('BUFRLIB: RTRCPT - INPUT BUFR FILE IS CLOSED; IT '//
     . 'MUST BE OPEN FOR INPUT')
901   CALL bort('BUFRLIB: RTRCPT - INPUT BUFR FILE IS OPEN FOR '//
     . 'OUTPUT; IT MUST BE OPEN FOR INPUT')
902   CALL bort('BUFRLIB: RTRCPT - A MESSAGE MUST BE OPEN IN INPUT '//
     . 'BUFR FILE; NONE ARE')
      END