c************
c  Description: Preliminary HOST NOOP routine
c
c  Author:	JGS   12/19/90
c
c  $Revision: 1.3 $
c  $Modtime:   18 Mar 1996 17:32:24  $
c
c************
	program NOOP
c
	implicit none
	include 'primitive.inc'
c
	record /HEADER/ HIN,HOUT
	integer*4 L_buf,lper,mode,idm,ngot,istat
	parameter (L_buf=32768)
	record /M_PTR/ buf
	real*8 srate,srate_z,otime,act_rt,act_pts,act_time
	real*4 ctime, aa
	integer*4 irt,iar
	integer*4 nnqq
	logical*4 rt
c
	call M$CHECKIN
c
	rt = M$GET_PSWITCH('RT')
c
	srate = M$DPICK(3)
c
c open and test input file #1
	call M$INIT (HIN, M$APICK(1), ' ', ' ', 0)
	call M$OPEN (HIN, HCBF_INPUT)
c
c setup and allocate output file
	call M$PROPAGATE (HIN, HOUT)
	HOUT.file_name = M$APICK(2)
	call M$OPEN (HOUT, HCBF_OUTPUT)
c
c force 1000 type file handling
	if (HIN.class .eq. 2) then
	  call M$FORCE1000(HIN)
	  call M$FORCE1000(HOUT)
	endif
c
c set transfer lengths
	if (HIN.class.eq.4) then
	  LPER = 1
	  call M$MALLOC (lper*L_vrbhead, buf.p)
	  istat = M$VRBINIT(%val(buf.p),0,HIN.record_len)
	else
	  LPER = M$XFER_LENGTH (HIN.bpe,-L_buf)
	  call M$MALLOC (lper*HIN.bpe, buf.p)
	endif
	HIN.cons_len = M$GET_SWITCH_DEF('CL',HIN.cons_len)
c
c init the real-time mode
	mode = M$GET_SWITCH_DEF('MODE',1)
	act_rt = 0
	idm = M$MWINIT('MODE',mode,'MODE;Normal,Block,Consume,Abort')
	irt = M$DWINIT('Samp Rate',srate, 0d0, -1d0, 1d0)
	iar = M$DWINIT('Actual Rate',act_rt, 0d0, -1d0, 1d0)

	ngot = 0
c
	call M$SYNC
	otime = secnds(0.0)
	act_time = otime
c
	if (rt) then
c loop through RT buffers
	  do while ( M$DO(LPER,HIN.xfer_len) )
 10    continue
	    srate_z = srate
	    istat = M$DWGET(irt,srate)
	    if (srate .le. 0d0) srate = srate_z
	    istat = M$MWGET(idm,mode)
	    do while (mode.eq.2)
	      istat = M$MWGET(idm,mode)
	      call M$PAUSE(Mc.pause)
	      if (Mc.break) goto 99
	    enddo
	    if (mode.eq.4) goto 99
	    ctime = secnds(0.0)
	    aa = ctime - otime
	    if (aa .lt. -40000.0) then
	      otime = otime - 86400.0d0	! rolled over rayday
	      aa = aa + 86400.0
	    endif
	    if ((aa .lt. 0.0) .and. (mode .ne. 3)) then
	      call M$PAUSE (Mc.pause)
	      if (Mc.break) goto 99
	      goto 10
	    endif
	    if (mode .ne. 3) then
	      otime = otime + dble(Hin.xfer_len)/srate
	    else
	      otime = secnds(0.0)
	    endif
	    call M$GRABX (HIN, %val(buf.p), ngot)
	    if (mode.ne.3) then
	      call M$FILAD (HOUT, %val(buf.p), ngot)
	      nnqq = nnqq + 1
	      if (nnqq .gt. 100) then
	         act_pts = nnqq*HIN.xfer_len
	         act_time = secnds(0.0) - act_time
	         act_rt = act_pts / act_time
	         call M$DWPUT (iar, act_rt)
	         act_time = secnds(0.0)
	         nnqq = 0
	      endif
	    endif
	    if (mode.lt.0) then
	      mode = mode+1
	      if (mode.eq.0) mode = 2
	      call M$MWPUT(idm,mode)
	    endif
	  enddo
	else
c
c loop through buffers
	  do while ( M$DO(LPER,HIN.xfer_len) )
	    istat = M$MWGET(idm,mode)
	    do while (mode.eq.2)
	      istat = M$MWGET(idm,mode)
	      call M$PAUSE(Mc.pause)
	      if (Mc.break) goto 99
	    enddo
	    if (mode.eq.4) goto 99
	    call M$GRABX (HIN, %val(buf.p), ngot)
	    if (mode.ne.3) call M$FILAD (HOUT, %val(buf.p), ngot)
	    if (mode.lt.0) then
	      mode = mode+1
	      if (mode.eq.0) mode = 2
	      call M$MWPUT(idm,mode)
	    endif
	  enddo
	endif
c
c close files
  99	call M$CLOSE (HIN)
	call M$CLOSE (HOUT)
c
	call M$RETURN
c
	end
