!
!	In the realtime system, ARPS format files arrive after they become
!	available.  To process them as soon as them become available requires
!	that "arpsintrp" wait for files to arrive instead of assuming that they
!	are present.  This routine does all the "magic".
!

	subroutine check_file( s, ntries, sleeptime ) 1,1
	character(*) s
	character*200 s2
	logical iexist
	integer ntries, sleeptime

!	Find first white space, if any.

	last = len(s)

	do i=1,last
		if ( s(i:i) == ' ' ) then
			last = i - 1
			exit
		endif
	enddo

!
!	We want the "ready" file.
!

	s2 = s(1:last) // "_ready"

	do i=1,ntries
		inquire(file=s2,exist=iexist)
		if ( iexist ) return
		write(6,*) "Waiting for ",s2
		call flush(6)			! so we see the message!
		call sleep( sleeptime )
	end do

!	It looks like the file isn't going to arrive, so just exit so the rest
!	of the programs can run as far as possible.

	write(6,*) 'arpsintrp:  check_file:  time limit exceeded'

!	Even though this is an error, we need to exit 0 due to realtime needs.
!	Cntl_arps considers an exit code of 1 meaning the program failed to
!	produce any useful output.

	call exit( 0 )
	end