C***
C       TITLE   XMTLUP
C
C       Version 1.1     OCT0582
C
C
C    FACILITY:
C   TEST PROGRAMS FOR THE COMMUNICATIONS DRIVER PACKAGE CDPACK
C   AND THE COMMUNICATIONS DRIVER
C
C
C    ABSTRACT:
C   MAKES CALLS TO THE ROUTINES OF CDPACK TO SEND MESSAGES
C
C
C    AUTHOR     Vicky White
C               Computing Department,
C               Fermi National Accelerator Lab
C
C   CREATION DATE: JUN0382
C
C   MODIFIED BY:
C     VW- OCT0582 - ADD TIMING AND ERROR THRESHOLD
C
C***
	IMPLICIT INTEGER(A-Z)
	REAL T1,TIME,UNITT,SECNDS
	DIMENSION RBUF(10000)
	DIMENSION STAT(2)
	DATA MAXWC/2000/
	DATA MAXERR/10/
C
	DO 100 I=1,10000
100	RBUF(I)=I
	CALL DLDEC(' CD UNIT NUMBER',UNIT,UNIT)
        CALL CDASGN(2,'CD',UNIT,STAT)
	CALL DLDEC(' PTC ',PTC,PTC)
	CALL DLOUTO(' ASSIGN STATUS ',STAT(1),STAT(2))
	CALL DLDEC(' ENTER WC TO SEND',MAXWC,XMTWC)
	CALL DLDEC(' TOTAL NO OF TRANSFERS ',TOT,TOT)
	CALL DLDEC(' MAX NO. OF ERRORS ',MAXERR,MAXERR)
	NTOT=0
10	IF(NTOT.EQ.1) T1=SECNDS(0.0)
       CALL CDXMTW(2,PTC,RBUF,XMTWC,STAT)        !WAIT FOR MESSAGE
        IF(STAT(1).EQ.1) GOTO 5
        CALL DLOUTO(' XMT STATUS ',STAT(1),STAT(2))
	CALL CDERRM(STAT(1),IERR)
	NERR=NERR+1
	IF(NERR.GE.MAXERR) GOTO 99
5	NTOT=NTOT+1
	IF(NTOT.LT.TOT) GOTO 10
99	TIME=SECNDS(T1)
	UNITT=(TIME/FLOAT(NTOT))*1000.
	WRITE(5,1000) TIME,UNITT
1000	FORMAT(1X,F10.4,' SECONDS ',F10.4,'MS/TRANSFER')
	CALL EXIT
	END