PROGRAM MONITR
C
C  TEST PROGRAM TO GET EVENT VIA CD REQUEST TO A SUPPLIER
C
C  AUTHOR:
C      VICKY WHITE
C      COMPUTER DEPARTMENT
C      FERMILAB
C      BATAVIA,IL 60510
C
C  CREATED:
C      29 OCT 1982
C   
C  MODIFIED:
C     23 DEC 1982 - VW- ADD EXTRA 1ST WORD TO REQUEST BUFFER = CODE 1
C     28 SEP 1984 - DB- MODIFY REQUEST MESSAGE TO CONFORM TO IN-66.4
C
	IMPLICIT INTEGER(A-Z)
	REAL T1,SECNDS,DELTA,UNITT
	DIMENSION RCVBUF(6000)
	DIMENSION ISTAT(2)
	DIMENSION REQBUF(20)
	DATA CDLUN,GETPTC/2,3/
	DATA NDMP/16/
	DATA MAXLEN/6000/
	DATA REQLEN/8/		!REQUEST MESSAGE MUST BE 8 WORDS
	DATA RCVDON/4/
	DATA BUFLEN/1000/
	DATA MYPTC/100/
C
        CALL DLDEC(' CD UNIT NUMBER',UNIT,UNIT,,)
        CALL CDASGN(CDLUN,'CD',UNIT,ISTAT)
	IF(ISTAT(1).NE.1) GOTO 999
        CALL DLDEC(' PTC',MYPTC,MYPTC)
        CALL CDOPEN(CDLUN,MYPTC,ISTAT)
	IF(ISTAT(1).NE.1) GOTO 999
        CALL DLYENO(' Q RECEIVE',QR,QR)
	IF(QR.EQ.1) CALL CDMODE(1,0,0,0)
        CALL DLDEC(' NUMBER OF EVENTS',TOT,TOT,,)
        CALL DLDEC(' LEN OF BUFFER (WORDS)',BUFLEN,BUFLEN,1,MAXLEN)
        CALL DLYENO(' CHECK LENGTH OF BUFFER',LENCHK,LENCHK)
        CALL DLYENO(' DUMP BUFFER RECEIVER',DMP,DMP)
        IF(DMP.EQ.1) CALL DLDEC(' NO OF WORDS TO DUMP',NDMP,NDMP,,)
	REQBUF(1)=1		!REQUEST CODE = NEXT EVENT
	REQBUF(2)=MYPTC
	REQBUF(3)=BUFLEN
	REQBUF(4)=0		!EVENT TYPE = ALL EVENTS
	REQBUF(5)=24		!EVENT SELECTION SCHEME = NON-CALIB ONLY
	REQBUF(6)=3		!DEVICE = BULK MEMORY
	T1=SECNDS(0.0)
	DO 10 NTOT=1,TOT
        CALL CDRCV(CDLUN,MYPTC,RCVBUF,BUFLEN,ISTAT)
	IF(ISTAT(1).NE.1) GOTO 999
	MBN=ISTAT(2)
        CALL CDXMTW(CDLUN,GETPTC,REQBUF,REQLEN,ISTAT)
	IF(ISTAT(1).NE.1) GOTO 999
	CALL CDWAIT(MBN)
	CALL CDSTAT(MBN,INF,ISTAT)
	IF(INF.NE.RCVDON.AND.ISTAT(1).NE.1) GOTO 999
	IF(LENCHK.NE.1) GOTO 5
	IF((RCVBUF(1)/2).NE.ISTAT(2))
	1 CALL DLOUT(' LEN ERROR',RCVBUF(1),ISTAT(2))
5	IF(DMP.NE.1) GOTO 10
	WRITE(5,1001) (RCVBUF(I),I=1,NDMP)
1001	FORMAT(1X,8(O6,2X))
10	CONTINUE
	DELTA=SECNDS(T1)
	UNITT=(DELTA*1000.)/FLOAT(TOT)
	WRITE(5,1000) DELTA,UNITT
1000	FORMAT(1X,F8.4,' SECONDS = ',F8.4,' MS PER EVENT')
	CALL EXIT
C
999     CALL DLOUT(' INF',INF)
	CALL CDERRM(ISTAT,IERR)
	CALL EXIT
	END