!***************************************************************************************************
!* ut_check_bufrrptdt                                                                              *
!*                                                                                                 *
!* This routine checks the validity of a date-time read from a BUFR report, including confirming   *
!* that the report date-time is within a specified range before or after the run date-time.        *
!*                                                                                                 *
!* ut_check_bufrrptdt( loglev, irundt, r8rptyr, r8rptmo, r8rptdy, r8rpthr, r8rptmi, imxhro,        *
!*                     imxmnn, irptdt, iret )                                                      *
!*                                                                                                 *
!* Input parameters:                                                                               *
!*   loglev    integer        Verbosity level.                                                     *
!*   irundt    integer(5)     Run date-time in UTC:                                                *
!*                              Index 1 = 4-digit year                                             *
!*                              Index 2 = month                                                    *
!*                              Index 3 = day of month                                             *
!*                              Index 4 = hour                                                     *
!*                              Index 5 = minute                                                   *
!*   r8rptyr   real*8         Report year in UTC.                                                  *
!*   r8rptmo   real*8         Report month in UTC.                                                 *
!*   r8rptdy   real*8         Report day in UTC.                                                   *
!*   r8rpthr   real*8         Report hour in UTC.                                                  *
!*   r8rptmi   real*8         Report minute in UTC.                                                *
!*   imxhro    integer        Maximum number of hours by which irptdt can precede irundt.          *
!*   imxmnn    integer        Maximum number of minutes by which irptdt can follow irundt.         *
!*                                                                                                 *
!* Output parameters:                                                                              *
!*   irptdt    integer(5)     Report date-time in UTC:                                             *
!*                              Index 1 = 4-digit year                                             *
!*                              Index 2 = month                                                    *
!*                              Index 3 = day of month                                             *
!*                              Index 4 = hour                                                     *
!*                              Index 5 = minute                                                   *
!*   iret      integer        Return code:                                                         *
!*                              0 = normal return                                                  *
!*                             -1 = irptdt is invalid                                              *
!*                             -2 = irptdt is out of specified range with respect to irundt        *
!**                                                                                                *
!* Log:                                                                                            *
!* J. Ator/NCEP         06/23                                                                      *
!***************************************************************************************************
subroutine ut_check_bufrrptdt( loglev, irundt, r8rptyr, r8rptmo, r8rptdy, r8rpthr, r8rptmi, &
    imxhro, imxmnn, irptdt, iret )

  implicit none

  integer, intent(in) :: loglev, irundt(5), imxhro, imxmnn
  integer, intent(out) :: irptdt(5), iret

  real*8, intent(in) :: r8rptyr, r8rptmo, r8rptdy, r8rpthr, r8rptmi

  integer :: iertmk

  integer*4 :: ibfms

  real :: ut_bmri

  ! Confirm that none of the report date-time values are "missing".
  if ( any( (/ibfms(r8rptyr),ibfms(r8rptmo),ibfms(r8rptdy),ibfms(r8rpthr),ibfms(r8rptmi)/) &
      == (/1,1,1,1,1/) ) ) then
    iret = -1
    return
  end if

  ! Copy the report date-time values into an integer array.
  irptdt(1) = int( ut_bmri( r8rptyr ) )
  irptdt(2) = int( ut_bmri( r8rptmo ) )
  irptdt(3) = int( ut_bmri( r8rptdy ) )
  irptdt(4) = int( ut_bmri( r8rpthr ) )
  irptdt(5) = int( ut_bmri( r8rptmi ) )

  ! Confirm that the report date-time is within the specified range before or after the run date-time.
  call dc_tmck( loglev, irundt, irptdt, imxhro, imxmnn, iertmk )
  if ( iertmk /= 0 ) then
    iret = -2
  else
    iret = 0
  end if

end subroutine ut_check_bufrrptdt