C***
C       TITLE   RCVXMT
C
C       Version 1.1     OCT1182
C
C
C    FACILITY:
C   TEST PROGRAMS FOR THE COMMUNICATIONS DRIVER PACKAGE CDPACK
C
C
C    ABSTRACT:
C   PERFORMS MULTIPLE READ AND WRITES ON THE LINK WITH NO-WAIT
C   I/O.
C   PROGRAM IS IMPLEMENTED IN 4 PARTS
C	INITIALISATION - DEFINES WHICH PTC TO USE FOR XMT AND
C                        RECEIVE, HOW MANY WORDS TO XMT/RCV AND
C                        HOW MANY MESSAGES OF EACH TYPE TO XMT
C       STARTING I/O   - FOR EACH PTC, EITHER XMT OR RECEIVE, IF
C                        I/O IS NO LONGER ACTIVE FOR IT STARTS
C                        A NEW I/O OPERATION
C       CHECKING STATUS- CHECKS THE STATUS OF EACH I/O OPERATION
C                        REPORTS ANY ERRORS
C	RESULT SUMMARY - GIVES THE OVERALL PICTURE OF HOW MANY
C                        MESSAGES TRANSMITTED AND RECEIVED AND
C                        HOW MANY ERRORS
C
C
C    AUTHOR     Vicky White
C               Computing Department,
C               Fermi National Accelerator Lab
C
C   CREATION DATE: JUN2282
C
C   MODIFIED BY:
C   VW-OCT1182 - DELAY AFTER ALL OPENS DONE TO SYNCHRONISE WITH PARTNER
C                PUT IN FORM SUITABLE FOR RT TOO, USING PRE INSTEAD OF
C                INCLUDE FILES
C
C***
C	INCLUDE FILE FOR RCVXMT TEST PROGRAM
C
C       VICKY WHITE, FNAL       JUN2282
C
	IMPLICIT INTEGER(A-Z)
        LOGICAL*1 RBSY,XBSY,STOP
	COMMON/CHANN/CHAN
	COMMON/ERRCOM/IERR
C
C  ARRAYS OF RECEIVER PTCS AND PARAMETERS FOR EACH RECEIVER PTC
C
        COMMON/OPPARS/
     &  RPTC(20),TOTRCV(20),RBSY(20),RWC(20),RDEV(20),RUNT(20),
     &  RCHAN(20),RMBN(20),RINDX(20),RERRS(20),RMODE(20),
     &  XPTC(20),TOTXMT(20),XBSY(20),XWC(20),XDEV(20),XUNT(20),
     &  XCHAN(20),XMBN(20),XNUM(20),XERRS(20),XMODE(20),
     &  XMTMAX,RCVMAX,NXMT,NRCV,MAXR,MAXX,MAXERR,ERRTOT,
     &  STOP                          !STOP ALWAYS AT END - 1 BYTE
C
	DATA RDEV,XDEV/40*'CD'/
	DATA RUNT,XUNT/40* 0  /
        DATA RBSY,XBSY/40*.TRUE./
	DATA RMODE/20*1/
	DATA RCHAN,XCHAN/40*2/
	DATA XWC/20*1000/
	DATA RWC/20*1000/
	DATA RCVLEN,XMTLEN/8000,4000/
	DATA RCVMAX,XMTMAX/1000,1000/
	DATA MAXR,MAXX/20,20/
	DATA MAXERR/5/
C
	DIMENSION STAT(2)
	COMMON/CDCM82/ARRAY(350)	!ALLOW PLENTY ROOM FOR MBS
	COMMON/CDCM83/DUM		!FORCE CONTIGUOUS FOR RT11
        DIMENSION RCVBUF(4000),XBUF(4000)
C
C  SET UP PARAMETERS - PTC TO USE, BUFFER SIZES ETC.
C
C
C  ASSIGN CHANNELS TO LINK DEVICE
C
        CALL RXINIT
C
C  OPEN ALL SESSIONS FOR RECEIVE PTCS
C
	DO 10 IR=1,MAXR
        IF(RPTC(IR).EQ.0) GOTO 10
	CALL CDOPEN(RCHAN(IR),RPTC(IR),STAT)
        IF(STAT(1).NE.1) CALL CDERRM(STAT,MERR)
	IF(STAT(1).NE.1) RPTC(IR) = 0
        IF(STAT(1).EQ.1) RBSY(IR) = .FALSE.
10	CONTINUE
C
C  NOW WAIT TO SYNCHRONISE WITH PARTNER IF NECESSARY
C
	CALL DLKEY
C
C  MAIN PART OF CODE - 2 LOOPS ONE FOR INITIATING I/O REQUESTS
C  ONE FOR DEALING WITH COMPLETED I/O
C
15	IF(STOP) GOTO 500
C
C  LOOP OVER ALL RCV PTC - STARTING NEW READ ON ANY IDLE ONES
C
	DO 20 IR=1,MAXR
	IF(RBSY(IR)) GOTO 20
        IF(MODE.NE.RMODE(IR)) CALL CDMODE(RMODE(IR),0,0,0)    ! CHANGE MODE
	MODE=RMODE(IR)
        CALL CDRCV(RCHAN(IR),RPTC(IR),RCVBUF(RINDX(IR)),RWC(IR),STAT)
        IF(STAT(1).EQ.1) GOTO 16
        CALL CDERRM(STAT,MERR)
	ERRTOT=ERRTOT+1
        GOTO 20
16      RMBN(IR) = STAT(2)
	RBSY(IR) = .TRUE.
20	CONTINUE
C
C  LOOP OVER ALL XMT PTCS
C
	DO 30 IX=1,MAXX
	IF(XBSY(IX)) GOTO 30
        IF(MODE.NE.XMODE(IX)) CALL CDMODE(XMODE(IX),0,0,0)
        MODE=XMODE(IR)
	NXMT=NXMT + 1
	TOTXMT(IX) = TOTXMT(IX) + 1
        IF(TOTXMT(IX).LE.XWC(IX)) XBUF(TOTXMT(IX)) = TOTXMT(IX)
	CALL CDXMT(XCHAN(IX),XPTC(IX),XBUF,XWC(IX),STAT)
        IF(STAT(1).EQ.1) GOTO 22
        CALL CDERRM(STAT,MERR)
	TOTXMT(IX) = TOTXMT(IX) - 1
	ERRTOT=ERRTOT+1
        GOTO 30
22      XMBN(IX) = STAT(2)
	XBSY(IX) = .TRUE.
30	CONTINUE
C
C  LOOP OVER ALL RECEIVE PTCS CHECKING FOR COMPLETION
C
	DO 40 IR=1,MAXR
        IF(.NOT.RBSY(IR) .OR. RPTC(IR).EQ.0) GOTO 40
	CALL CDSTAT(RMBN(IR),INF,STAT)
        IF(INF.EQ.2.OR.INF.EQ.0) GOTO 40  ! RECEIVE STILL PENDING
	IF(INF.EQ.4) GOTO 32
	WRITE(5,1000) RMBN(IR),INF,STAT(1),STAT(2)
1000	FORMAT(' ERROR - ILLEGAL STATUS MB=',I2,' INF=',I6,' STAT=',
     &    2(2X,O6))
        GOTO 35
32	NRCV=NRCV+1
	TOTRCV(IR) = TOTRCV(IR) + 1
	IF(STAT(1).EQ.1) GOTO 33
        RERRS(IR) = RERRS(IR) + 1
        WRITE(5,1010) STAT(1)
1010	FORMAT(' RCV ERROR ',I6)
        CALL CDERRM(STAT(1),MERR)
        ERRTOT=ERRTOT+1
	GOTO 35
33      IF(TOTRCV(IR).GT.STAT(2)) GOTO 35
        IF(RCVBUF(RINDX(IR)+TOTRCV(IR)-1).EQ.TOTRCV(IR)) GOTO 35
        WRITE(5,1002) RPTC(IR),NRCV,RCVBUF(RINDX(IR)+NRCV-1)
1002	FORMAT(' ERROR IN DATA RECEIVED, PTC=',I3,' MSG NO ',I6,
     &     'MSG DATA ',I6)
35      RBSY(IR)=.FALSE.
40	CONTINUE
C
C
C  LOOP OVER ALL TRANSMITS CHECKING FOR COMPLETION
C
	DO 50 IX=1,MAXX
        IF(.NOT.XBSY(IX) .OR. XPTC(IX).EQ.0) GOTO 50
        CALL CDSTAT(XMBN(IX),INF,STAT)
        IF(INF.EQ.1) GOTO 50            ! XMT STILL PENDING
        IF(INF.EQ.3) GOTO 45
        WRITE(5,1001) XMBN(IX),INF,STAT(1),STAT(2)
1001    FORMAT(' ERROR - ILLEGAL STATUS MB=',I3,' INF=',I6,' STAT=',
     &    2(2X,O6))
45      XBSY(IX)=.FALSE.
        IF(STAT(1).EQ.1) GOTO 50
        XERRS(IX) = XERRS(IX) + 1
        WRITE(5,1011) STAT(1)
1011	FORMAT(' XMT ERROR ',I6)
	CALL CDERRM(STAT(1),MERR)
        ERRTOT=ERRTOT+1
50      CONTINUE
C
C  CHECK IF TIME TO STOP
C
        IF(NXMT.GE.XMTMAX .OR. NRCV.GE.RCVMAX) STOP = .TRUE.
        IF(ERRTOT.GE.MAXERR) STOP = .TRUE.
	GOTO 15
C
C  GIVE SUMMARY OF RESULTS AND STOP
C
500     CALL RXSUMM
	CALL EXIT
	END
C	INCLUDE FILE FOR RCVXMT TEST PROGRAM
C	INCLUDE FILE FOR RCVXMT TEST PROGRAM