C
	PARAMETER (LINESIZE=132,NQUE=40,NUSERS=5)
C
C
C
	CHARACTER CR*(1),LF*(1),DEV*(8),NUM*(4),TEXT*(LINESIZE)
	CHARACTER DATETIME*(32),WHO(NUSERS)*30,FILE(NUSERS)*3
	CHARACTER TITLE*(LINESIZE),LIST*(LINESIZE),NAME*32
	CHARACTER PREFIX(NUSERS)*1,ISO(NUSERS)*3,LABEL*20
	CHARACTER MESS1(NUSERS)*80,MESS2(NUSERS)*80,MESS3(NUSERS)*80
	CHARACTER WHAT(NUSERS)*32
C
	LOGICAL*1 FOPEN(NUSERS)
	BYTE SRC(14)
C
	INTEGER*2 F,N,A,FNA,FNAIX,FNANQ,COMMAND(100),IE(4)
	1,IBUF(4096),IOSB(4),IOSBR(4),IOSBW(4)
C
	INTEGER*4 CHARX(2),ICHAN,NERR,IDESCR(2)
C
	INTEGER SYS$QIO,SYS$ASSIGN,SYS$ASCEFC,SYS$WFLOR
	1,SYS$READEF,SYS$CLREF,SYS$SETIMR,LIB$INSQHI
	2,SYS$TRNLOG,SYS$ASCTIM,SYS$GETTIM,SYS$QIOW
	3,SYS$DCLAST,LIB$REMQTI,SYS$SETPRI,STR$POSITION
	4,STR$TRIM,SYS$ALLOC
C
	INCLUDE 'SYS$LIBRARY:FORSYSDEF($SSDEF)/NOLIST'
	INCLUDE 'NMADEF.FOR/NOLIST'
	INCLUDE 'SYS$LIBRARY:FORSYSDEF($IODEF)/NOLIST'
	INCLUDE 'SYS$LIBRARY:FORSYSDEF($LIBDEF)/NOLIST'
C
C	TRANSLATE THE NAME
C
	DEV='   '
	NERR=SYS$TRNLOG('DATA_NET',,DEV,,,)
	IF(NERR.NE.SS$_NORMAL)THEN
		TYPE *,' TRANSLATION ERROR'
		CALL EXIT (NERR)
	ENDIF
C
C	ASSIGN CHANNEL
C'
	NERR=SYS$ASSIGN(DEV,ICHAN,,)
	IF(NERR.NE.SS$_NORMAL)THEN
		TYPE *,' ASSIGN ERROR'
		CALL EXIT (NERR)
	ENDIF
C
C	INITIALIZE
C
	IDESCR(1)=200				!SETUP DESCRIPTER
	IDESCR(2)=%LOC(COMMAND)	
	DO 30 I=1,100
30	COMMAND(I)=0
C
C	WE NOW GET THE CURRENT CHANNEL INFO
C
	NERR=SYS$QIOW(,%VAL(ICHAN),%VAL(IO$_SENSEMODE+IO$M_CTRL),IOSB,,,
	1CHARX,IDESCR,,,,)
	IF(NERR.NE.SS$_NORMAL)THEN
		TYPE *,' QIO ERROR'
		CALL EXIT (NERR)
	ENDIF
	TYPE *,' STATUS=',IOSB
	TYPE *,' CHAR=',CHARX
	TYPE *,' MODE=',COMMAND
C
C	SET THE NEW LINK
C
	DO 40 I=1,100
40	COMMAND(I)=0
	COMMAND(1)=NMA$C_PCLI_BFN
	COMMAND(2)=3
	COMMAND(3)=0
	COMMAND(4)=NMA$C_PCLI_PAD
	COMMAND(5)=NMA$C_STATE_ON
	COMMAND(6)=0
	COMMAND(7)=NMA$C_PCLI_PTY
	COMMAND(8)='0660'X
	COMMAND(9)=0
	COMMAND(10)=NMA$C_PCLI_CRC
	COMMAND(11)=NMA$C_STATE_ON
	COMMAND(12)=0
	COMMAND(13)=NMA$C_PCLI_PHA
	COMMAND(14)=8
	COMMAND(15)=NMA$C_LINMC_SET
	COMMAND(16)='00AA'X			!CAD ADDRESS
	COMMAND(17)='0004'X
	COMMAND(18)='0496'X
C
	IDESCR(1)=24				!SETUP DESCRIPTER
	IDESCR(2)=%LOC(COMMAND)	
C
	SRC(7)='AA'X				!uVAX ADDRESS
	SRC(8)='00'X
	SRC(9)='04'X
	SRC(10)='00'X
	SRC(11)='0A'X
	SRC(12)='04'X
	SRC(13)='06'X
	SRC(14)='60'X
C
C	SET MODE
C
	NERR=SYS$QIOW(,%VAL(ICHAN),%VAL(IO$_SETMODE+IO$M_CTRL+IO$M_STARTUP)
	1,IOSB,,,,IDESCR,,,,)
	IF(NERR.NE.SS$_NORMAL)THEN
		TYPE *,' QIO ERROR'
		CALL EXIT (NERR)
	ENDIF
	TYPE *,' STATUS=',IOSB
	TYPE *,' MODE=',COMMAND
C
C	READ IT BACK
C
	IDESCR(1)=200				!SETUP DESCRIPTER
	IDESCR(2)=%LOC(COMMAND)	
	NERR=SYS$QIOW(,%VAL(ICHAN),%VAL(IO$_SENSEMODE+IO$M_CTRL),IOSB,,,
	1CHARX,IDESCR,,,,)
	IF(NERR.NE.SS$_NORMAL)THEN
		TYPE *,' QIO ERROR'
		CALL EXIT (NERR)
	ENDIF
	TYPE *,' STATUS=',IOSB
	TYPE *,' CHAR=',CHARX
	TYPE *,' MODE=',COMMAND
C
C	SET THE FIRST READ
C
	ISTAT=SYS$QIO(%VAL(33),%VAL(ICHAN),%VAL(IO$_READVBLK),IOSBR,,,
	1IBUF,%VAL(512),,,SRC,)
	IF(ISTAT.NE.SS$_NORMAL)THEN
		TYPE *,' READ QIO ERROR ',ISTAT
		TYPE *, IOSBR
		CALL LIB$SIGNAL(%VAL(ISTAT))
		CALL LIB$SIGNAL(%VAL(IOSBR(1)))
	ENDIF
	TYPE *,' INITIALIZED READ'
C
C	TEST DIRECTION
C
	TYPE *,' ENTER OUTPUT DATA (CTRL-Z READ)'
	READ(*,999,END=90)INIT
C
C	SET BUFFER
C
	DO 50 I=1,256
50	IBUF(I)=INIT
C
C	SEND IT OUT
C
	ISTAT=SYS$QIO(%VAL(32),%VAL(ICHAN),%VAL(IO$_WRITEVBLK),IOSBW,,,
	1IBUF,%VAL(512),,,SRC(7),)
	IF(ISTAT.NE.SS$_NORMAL)THEN
		TYPE *,' WRITE QIO ERROR ',ISTAT
		TYPE *, IOSBW
		CALL LIB$SIGNAL(%VAL(ISTAT))
		CALL LIB$SIGNAL(%VAL(IOSBW(1)))
	ENDIF
	TYPE *,' SENT FIRST BUFFER'
C
C
C	EVENT FLAGS USED ARE
C	32	WRITE NET DONE
C	33	READ NET DONE
C	34	TIMER
C
C
C
C	NOW WAIT FOR EVENT
C
90	MASK=7
	ISTAT=SYS$WFLOR(%VAL(32),%VAL(MASK))
C
C	NOW READ ALL EVENT FLAGS
C
	ISTAT=SYS$READEF(%VAL(32),IFLAG)
C
C	FANOUT TO CORRECT ROUTINE
C
	IFAN=IAND(IFLAG,MASK)
	GO TO (100,200,300),IFAN
C
C	EVENT ROUTINES
C
C
C	TIMER HERE SIGNAL 34
C
	ISTAT=SYS$CLREF(%VAL(34))
	GO TO 90
C
C	WRITE DONE EVENT NUMBER 32
C
100	ISTAT=SYS$CLREF(%VAL(32))
	GO TO 90
C
C	READ DONE EVENT NUMBER 33
C
200	IF(IOSBR(1).NE.SS$_NORMAL)THEN
		TYPE *, IOSBR
		CALL LIB$SIGNAL(%VAL(IOSBR(1)))
	ELSE
		TYPE *,' DATA=',IBUF(1),IBUF(2),IBUF(3),IBUF(4)
	ENDIF
C
C	REQUE THE OPERATION
C
	ISTAT=SYS$QIO(%VAL(33),%VAL(ICHAN),%VAL(IO$_READVBLK),IOSBR,,,
	1IBUF,%VAL(512),,,SRC,)
	IF(ISTAT.NE.SS$_NORMAL)THEN
		TYPE *,' READ QIO ERROR ',ISTAT
		TYPE *, IOSBR
		CALL LIB$SIGNAL(%VAL(ISTAT))
		CALL LIB$SIGNAL(%VAL(IOSBR(1)))
	ENDIF
C
C	RESET BUFFER
C
C	DO 210 I=1,256
C210	IBUF(I)=IBUF(I)+1
C
C	SEND IT BACK
C
	ISTAT=SYS$QIO(%VAL(32),%VAL(ICHAN),%VAL(IO$_WRITEVBLK),IOSBW,,,
	1IBUF,%VAL(512),,,SRC(7),)
	IF(ISTAT.NE.SS$_NORMAL)THEN
		TYPE *,' WRITE QIO ERROR ',ISTAT
		TYPE *, IOSBW
		CALL LIB$SIGNAL(%VAL(ISTAT))
		CALL LIB$SIGNAL(%VAL(IOSBW(1)))
	ENDIF
	GO TO 90
C
C	BOTH DONE
C
300	ISTAT=SYS$CLREF(%VAL(32))
	GO TO 200
C
C	FORMATS
C
999	FORMAT(I)
	END