rtrcptb.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>
C> @author J. Ator @date 2013-10-07
 
C> This subroutine reads the tank receipt time (if one exists) from
C> Section 1 of a BUFR message.  It is similar to subroutine rtrcpt(),
C> except that it operates on a BUFR message passed in via a memory
C> array, whereas rtrcpt() operates on the BUFR message that was read
C> into internal arrays via the most recent call to any of the other
C> [message-reading subroutines](@ref hierarchy) for a specified
C> Fortran logical unit.
C>
C> @param[in]  MBAY -- integer(*): BUFR message.
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 MBAY.
C>
C> @author J. Ator @date 2013-10-07
      RECURSIVE SUBROUTINE rtrcptb(MBAY,IYR,IMO,IDY,IHR,IMI,IRET)
 
      USE modv_im8b
 
      dimension mbay(*)
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C     Check for I8 integers.
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL rtrcptb(mbay,iyr,imo,idy,ihr,imi,iret)
         CALL x48(iyr,iyr,1)
         CALL x48(imo,imo,1)
         CALL x48(idy,idy,1)
         CALL x48(ihr,ihr,1)
         CALL x48(imi,imi,1)
         CALL x48(iret,iret,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      iret = -1
 
C     Check whether the message contains a tank receipt time.
 
      IF(iupbs01(mbay,'BEN').EQ.4) THEN
        is1byt = 23
      ELSE
        is1byt = 19
      ENDIF
      IF( (is1byt+5) .GT. iupbs01(mbay,'LEN1') ) RETURN
 
C     Unpack the tank receipt time.
 
C     Note that IS1BYT is a starting byte number relative to the
C     beginning of Section 1, so we still need to account for
C     Section 0 when specifying the actual byte numbers to unpack
C     within the overall message.
 
      imgbyt = is1byt + iupbs01(mbay,'LEN0')
 
      iyr = iupb(mbay,imgbyt,16)
      imo = iupb(mbay,imgbyt+2,8)
      idy = iupb(mbay,imgbyt+3,8)
      ihr = iupb(mbay,imgbyt+4,8)
      imi = iupb(mbay,imgbyt+5,8)
 
      iret = 0
 
      RETURN
      END