C***
C       TITLE   ECHO
C
C       Version 1.1     JUN 10 1983
C
C
C    FACILITY:
C
C    TEST PROGRAM USING CDPACK, FOR RT AND RSX COMMUNICATIONS DRIVERS
C    
C
C    ABSTRACT:
C
C    THIS IS A SIMPLE ECHO TEST PROGRAM WHICH GIVES THE TIME TO
C    TRANSFER A BUFFER FROM ONE MACHINE TO THE OTHER, ASSURING THAT
C    THERE IS ALWAYS A BUFFER AVAILABLE TO RECEIVE THE DATA.  THIS
C    AVOIDS HAVING THE UNKNOWN AND EXTRA OVERHEADS INCURRED WHEN
C    ONE MACHINE IS FASTER THAN THE OTHER.  NORMALLY IF A MESSAGE
C    ARRIVES, BEFORE A BUFFER TO RECEIVE IT HAS BEEN ALLOCATED
C    IN BOTH RT-11 AND RSX THERE IS A TIME DELAY AND EXTRA OVERHEAD
C    RT-11 WILL ONLY WAIT ONE CLOCK TICK, WHEREAS RSX WILL QUEUE
C    AN AST TO A TASK AND WAIT ABOUT 2 SECONDS BEFORE ACTUALLY 
C    DECLARING AN ERROR.
C    ON SIDE MUST BE STARTED AS A SLAVE, THE OTHER AS A MASTER
C
C
C    AUTHOR     Vicky White
C               Computing Department,
C               Fermi National Accelerator Lab
C
C   CREATION DATE:
C     JAN 05 1983
C
C   MODIFIED BY:
C     OCT 03 1984 - David M. Berg
C		  - make compatible with F77 (make SLV integer variable)
C		  - initialize transmit buffer
C		  - make max word count 4000
C		  - fix a couple of typos
C
C***
	PROGRAM ECHO
	IMPLICIT INTEGER(A-Z)
	DIMENSION STAT(2)
        DIMENSION BUF(4000),RCVBUF(4000)
	REAL T1,DT,SECNDS
	DATA NLOOP/1000/
        DATA MAXWC,WC/4000,2000/
	DATA LUN/3/
	DATA DEV/'CD'/
        CALL DLDEC(' CD UNIT NUMBER',UNIT,UNIT,0,)
        CALL CDASGN(LUN,DEV,UNIT,STAT)
        CALL DLOUTO(' ASSIGN STATUS ',STAT(1),STAT(2))
        CALL DLDEC(' PTC ',PTC,PTC,,)
        IF(STAT(1).NE.1) GOTO 991
        CALL CDOPEN(LUN,PTC,STAT)
        IF(STAT(1).NE.1) GOTO 992
        CALL CDMODE(1,0,0,0)
        CALL DLDEC(' NUMBER OF LOOPS',NLOOP,NLOOP,,)
	N=NLOOP
	CALL DLYENO(' SLAVE SIDE',SLV,SLV)
        IF(SLV.EQ.0) GOTO 2
        CALL CDRCV(LUN,PTC,BUF,MAXWC,STAT)
        IF(STAT(1).NE.1) GOTO 993
        RCVMBN=STAT(2)
d       type *, 'RCV done MBN = ',RCVMBN
        GOTO 3
C
C  FIRST TIME FOR THE MASTER - I.E. THE ONE WHICH INITIATES THE
C  FIRST TRANSMIT
C
2       CALL DLDEC(' NO OF WORDS TO TRANSMIT',WC,WC,,)
	DO 27 I=1,WC
27	BUF(I)=I
        T1=SECNDS(0.0)
C
C  MAIN LOOP OF PROGRAM.  THIS ISSUES A RECEIVE FIRST TO MAKE
C  SURE THAT THERE IS ALWAYS A RECEIVE BUFFER AVAILABLE WHEN
C  THE OTHER SIDE SENDS ITS MESSAGE. THEN SENDS A BUFFER AND
C  FINALLY WAITS TO RECEIVE IT BACK.
C
1       CALL CDRCV(LUN,PTC,RCVBUF,MAXWC,STAT)
        IF(STAT(1).NE.1) GOTO 993
	RCVMBN=STAT(2)
d       type *, 'RCV done MBN = ',RCVMBN
        CALL CDXMTW(LUN,PTC,BUF,WC,STAT)
        IF(STAT(1).NE.1) GOTO 994
d	type *, 'XMT done OK'
        IF(SLV.EQ.0) N=N-1
	IF(N.LE.0) GOTO 50
3	CONTINUE
d	type *, 'About to Wait'
        CALL CDWAIT(RCVMBN)
d	type *, 'Came through wait'
5       CALL CDSTAT(RCVMBN,INF,STAT)
d	type *, 'CDSTAT status = ',INF
	IF(INF.NE.4) GOTO 995
        IF(STAT(1).NE.1) GOTO 995
        IF(SLV.EQ.0) GOTO 1
	IF(N.EQ.NLOOP) T1=SECNDS(0.0)
	WC=STAT(2)
        N=N-1
        IF(N.GT.0) GOTO 1
50	DT=SECNDS(T1)
	T1=DT*1000./FLOAT(2*NLOOP)
        TYPE 1000, NLOOP,DT,T1,WC
1000    FORMAT(I6,' LOOPS IN ',F6.2,' SECS = ',F6.2,' MS /',I6,'WD XFR')
	CALL EXIT
C
C  ERROR CONDITIONS ON INITIATING OR COMPLETING CD OPERATIONS
C
991	TYPE 1001
	GOTO 999
992	TYPE 1002
	GOTO 999
993	TYPE 1003
	GOTO 999
994	TYPE 1004
	GOTO 999
995	TYPE 1005
	GOTO 999
999     CALL CDERRM(STAT,IERR)
	CALL EXIT
1001    FORMAT(' ERROR ON CDASGN')
1002    FORMAT(' ERROR ON CDOPEN')
1003    FORMAT(' ERROR ON CDRCV')
1004    FORMAT(' ERROR ON CDXMTW')
1005    FORMAT(' ERROR ON RCV')
	END