C*****************************************************************************
C
C                   Test of Data Transfer SYSLIB Routines.
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: Data Transfer/ DataT.For
C Author	: John Malcolmson
C Date		: July 1986
C Language	: FORTRAN-77
C Note		: Uses subroutines imported from both SYSLIB and RTNS 
C		  libraries.
C Revised	03-May-89	check environment before J(READ/WRIT)
C		28-Jul-89	More work on JREAD/JWRITE tests
C		09-Aug-89	Move CHECK2 to COMMN.FOR
C
C*****************************************************************************

C*****************************************************************************
C
C List of functions:
C	IRcvd,  IRcvdC, IRcvdF, IRcvdW, IRead,  IReadC, IReadF, IReadW
C	JRead,  JReadC, JreadF, JReadW,	ISdat,  ISdatC, ISdatF, ISdatW
C	ISpfn,  ISpfnC, ISpfnF, ISpfnW, IWrite, IwritC, IWritF, IWritW
C	JWrite,	JWritC, JWritF, JWritW
C
C*****************************************************************************

C-------------------------------- CmplRes ------------------------------------

C  FORTRAN Completion routine

	Subroutine CmplRes

	Logical*2	SJ

		Call CentLn( 'Entered FORTRAN Completion Routine\' )
		IF (.not.SJ()) THEN
			Call Isleep( 0,0,1,0 )
			Call Resume
		END IF
		Return

	END

C--------------------------------- IRcvd -------------------------------------

	Function DTIRcvd

		Integer*4	DTIRcvd
		Integer*2	res, buff(5), i, GetMess
		Logical*2	SJ

		Call CentLn( '--- Testing IRCVD ---\' )
		Call CentLn( 'Receives data and returns immediately\')
		DTIRcvd = 0

		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Call SendMess( 10 )
		res = Ircvd( buff, 1 )
		Call Mwait
		IF (buff(1) .ne. 1) THEN
			Call MtFail( 'wrdcnt', 1 )
			Call Write2Int( 1,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIrcvd = DtIrcvd + 2**1
		END IF

		IF (buff(2) .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105,     10 )
			Call Write2Int( buff(2), 10 )
			Call WriteLn
			DtIrcvd = DtIrcvd + 2**2
		END IF

		IF (res .ne. 0) THEN
			Call RsltFail( 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIrcvd = DtIrcvd + 2**3
		END IF

		Call SendMess( 6 )
		Call SendMess( 4 )
		res = Ircvd( buff, 4 )
		Call Mwait
		IF (buff(1) .ne. 4) THEN
			Call MtFail( 'wrdcnt', 4 )
			Call Write2Int( 4,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIrcvd = DtIrcvd + 2**4
		END IF

		DO 10 i = 1, 4
			IF (buff(i+1) .ne. i) THEN
				Call IMtFail( 'wrdval', 4+i )
				Call Write2Int( i,         06 )
				Call Write2Int( i,         10 )
				Call Write2Int( buff(i+1), 10 )
				Call WriteLn
				DtIrcvd = DtIrcvd + 2**(4+i)
			END IF
10		Continue

		IF (res .ne. 0) THEN
			Call RsltFail( 9 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIrcvd = DtIrcvd + 2**9
		END IF

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 10 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIrcvd = DtIrcvd + 2**10
		END IF

999		Call TestFail( DTIRcvd )

		Call CentLn( '--- Testing IRCVD completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IRCVDC ------------------------------------

	Function DTICRcvd

		External	Acmpl

		Integer*4	DTICRcvd
		Integer*2	Buff(5), res, i, GetMess
		Logical*2	SJ

		Call CentLn( '--- Testing IRCVDC ---\' )
		Call CentLn(
	1 'Receives data and enters an assembly routine\')
		DTICRcvd = 0
		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Call SendMess( 10 )
		res = Ircvdc( buff, 1, Acmpl )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (buff(1) .ne. 1) THEN
			Call MtFail( 'wrdcnt', 1 )
			Call Write2Int( 1,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIcrcvd = DtIcrcvd + 2**1
		END IF

		IF (buff(2) .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105,     10 )
			Call Write2Int( buff(2), 10 )
			Call WriteLn
			DtIcrcvd = DtIcrcvd + 2**2
		END IF

		IF (res .ne. 0) THEN
			Call RsltFail( 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcrcvd = DtIcrcvd + 2**3
		END IF

		Call SendMess( 6 )
		Call SendMess( 4 )
		res = Ircvdc( buff, 4, Acmpl )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (buff(1) .ne. 4) THEN
			Call MtFail( 'wrdcnt', 4 )
			Call Write2Int( 4,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIcrcvd = DtIcrcvd + 2**4
		END IF

		DO 10 i = 1, 4
			IF (buff(i+1) .ne. i) THEN
				Call IMtFail( 'wrdval', 4+i )
				Call Write2Int( i,         06 )
				Call Write2Int( i,         10 )
				Call Write2Int( buff(i+1), 10 )
				Call WriteLn
				DtIcrcvd = DtIcrcvd + 2**(4+i)
			END IF
10		Continue

		IF (res .ne. 0) THEN
			Call RsltFail( 9 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcrcvd = DtIcrcvd + 2**9
		END IF

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 10 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcrcvd = DtIcrcvd + 2**10
		END IF

999		Call TestFail( DTICRcvd )

		Call CentLn( '--- Testing IRCVDC completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IRcvdF ------------------------------------

	Function DTIFRcvd

		External	CmplRes

		Integer*4	DTIFRcvd
		Integer*2	Buff(5), res, i, area(4), GetMess
		Logical*2	SJ

		Integer*2	J

		Call CentLn( '--- Testing IRCVDF ---\' )
		Call CentLn(
	1	'Receives data and enters a FORTRAN routine\')
		DTIFRcvd = 0
		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Call SendMess( 10 )
		res = Ircvdf( buff, 1, area, CmplRes )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (buff(1) .ne. 1) THEN
			Call MtFail( 'wrdcnt', 1 )
			Call Write2Int( 1,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIfrcvd = DtIfrcvd + 2**1
		END IF

		IF (buff(2) .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105,     10 )
			Call Write2Int( buff(2), 10 )
			Call WriteLn
			DtIfrcvd = DtIfrcvd + 2**2
		END IF

		IF (res .ne. 0) THEN
			Call RsltFail( 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfrcvd = DtIfrcvd + 2**3
		END IF

		Call SendMess( 6 )
		Call SendMess( 4 )
		res = Ircvdf( buff, 4, area, CmplRes )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (buff(1) .ne. 4) THEN
			Call MtFail( 'wrdcnt', 4 )
			Call Write2Int( 4,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIfrcvd = DtIfrcvd + 2**4
		END IF

		DO 10 i = 1, 4
			IF (buff(i+1) .ne. i) THEN
				Call IMtFail( 'wrdval', 4+i )
				Call Write2Int( i,         06 )
				Call Write2Int( i,         10 )
				Call Write2Int( buff(i+1), 10 )
				Call WriteLn
				DtIfrcvd = DtIfrcvd + 2**(4+i)
			END IF
10		Continue

		IF (res .ne. 0) THEN
			Call RsltFail( 9 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtfIrcvd = DtfIrcvd + 2**9
		END IF

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 10 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfrcvd = DtIfrcvd + 2**10
		END IF

999		Call TestFail( DTIFRcvd )

		Call CentLn( '--- Testing IRCVDF completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IRcvdW ------------------------------------

	Function DTIWRcvd

		Integer*4	DTIWRcvd
		Integer*2	buff(5), res, i, GetMess
		Logical*2	SJ

		Call CentLn( '--- Testing IRCVDW ---\' )
		Call CentLn( 'Receives data and Waits for completion\')
		DTIWRcvd = 0

		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Call SendMess( 10 )
		res = Ircvdw( buff, 1 )
		IF (buff(1) .ne. 1) THEN
			Call MtFail( 'wrdcnt', 1 )
			Call Write2Int( 1,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIwrcvd = DtIwrcvd + 2**1
		END IF

		IF (buff(2) .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105,     10 )
			Call Write2Int( buff(2), 10 )
			Call WriteLn
			DtIwrcvd = DtIwrcvd + 2**2
		END IF

		IF (res .ne. 0) THEN
			Call RsltFail( 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwrcvd = DtIwrcvd + 2**3
		END IF

		Call SendMess( 6 )
		Call SendMess( 4 )
		res = Ircvdw( buff, 4 )
		IF (buff(1) .ne. 4) THEN
			Call MtFail( 'wrdcnt', 4 )
			Call Write2Int( 4,       10 )
			Call Write2Int( buff(1), 10 )
			Call WriteLn
			DtIwrcvd = DtIwrcvd + 2**4
		END IF

		DO 10 i = 1, 4
			IF (buff(i+1) .ne. i) THEN
				Call IMtFail( 'wrdval', 4+i )
				Call Write2Int( i,         06 )
				Call Write2Int( i,         10 )
				Call Write2Int( buff(i+1), 10 )
				Call WriteLn
				DtIwrcvd = DtIwrcvd + 2**(4+i)
			END IF
10		Continue

		IF (res .ne. 0) THEN
			Call RsltFail( 9 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwrcvd = DtIwrcvd + 2**9
		END IF

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 10 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwrcvd = DtIwrcvd + 2**10
		END IF

999		Call TestFail( DTIWRcvd )

		Call CentLn( '--- Testing IRCVDW completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- IREAD ------------------------------------

	Function DtIread

		Integer*4	DtIread
		Integer*2	Ichan, res, res1, blk, i
		Integer*2	Fail
		Byte		Buff(40)
		Integer*2	Spec(4)
		Data Spec/ 3rDAT, 3rTES, 3rTRD, 3rTST/

		Call CentLn( '--- Testing IREAD ---\' )
		Call CentLn( 'Transfers data on a channel to memory\')
		DtIread = 0

5		Ichan = IgetC()
		IF (Ichan .lt. 0) Stop 'no channel'
		Call Fallt( IENTER( Ichan, Spec, 1),
	1		'*** IENTER Failed 01.01 ***\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue
		blk = 0
		Call IWritw( 20, Buff, blk, Ichan )
		Call Closec( Ichan )

		blk  = 0
		res  = IREAD( 20, Buff, blk, Ichan )
		res1 = Iwait( Ichan )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTIread= DtIread + 2**1
		END IF

		Call Fallt( LOOKUP( Ichan, Spec),
	1		'*** LOOKUP Failed 01.01 ***\')
		blk  = 0
		res  = IREAD( 20, Buff, blk, Ichan )
		res1 = Iwait( Ichan )
		
		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 2 )
			Call Write2Int( 20,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIread = DtIread + 2**2
		END IF

		IF (res1 .ne. 0) THEN
			Call MtFail( 'nmread', 3 )
			Call Write2Int( 0,    10 )
			Call Write2Int( res1, 10 )
			Call WriteLn
			DtIread = DtIread + 2**3
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 4 )
			Call Write2Int( fail,       06 )
			Call Write2Int( 65+fail,    10 )
			Call WriteBool( Buff(fail), 10 )
			Call WriteLn
			DTIread = DTIread + 2**4
		END IF

		blk  = 10
		res  = IREAD( 20, Buff, blk, Ichan )
		res1 = Iwait( Ichan )
		IF (res .ne. -1) THEN
			Call MtFail( 'dcteof', 5 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIread = DtIread + 2**5
		END IF
		
		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )

		Call TestFail( DtIread )

		Call CentLn( '--- Testing IREAD completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IREADC ------------------------------------

	Function DtICread

		External	Acmpl

		Integer*4	DtICread
		Integer*2	Ichan, res, res1, blk, i
		Integer*2	Fail
		Logical*2	SJ
		Byte		Buff(40)
		Integer*2	Spec(4)
		Data Spec/ 3rDAT, 3rTES, 3rTRD, 3rTST /

		Call CentLn( '--- Testing IREADC ---\' )
		Call CentLn( 'Performs IREAD with assembly completion\')
		DtICread = 0

5		Ichan = IgetC()
		IF (Ichan .lt. 0) Stop 'no channel'
		Call Fallt( IENTER( Ichan, Spec,1),
	1		'*** IENTER Failed 02.01 ***\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue
		blk = 0
		Call IWritw( 20, Buff, blk, Ichan )
		Call Closec( Ichan )

		blk  = 0
		res  = IREADC( 20, Buff, blk, Ichan, Acmpl )
c
c		  TYPE 74, RES
c74	FORMAT(' RES= ',O6,/)
c
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
c
c			   TYPE 75, RES
c75	FORMAT(' RES before Isleep=',O6,/)
c

				Call Isleep(0,0,3,0)
c
c			   TYPE 76, RES
c76	FORMAT(' RES after Isleep=',O6,/)
c
			ELSE
c			   TYPE 77, RES
c77	FORMAT(' RES after Suspnd=',O6,/)
c
				Call Suspnd

			END IF
		END IF
c
c		  TYPE 78, RES
c78	FORMAT(' RES after Isleep and Suspnd=',O6,/)
c
		IF (res .ne. -3) THEN

c			   TYPE 79, RES
c79	FORMAT(' RES inside IF statement=',O6,/)
c

			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTIcread= DtIcread + 2**1
		END IF

c			   TYPE 80, RES
c80	FORMAT(' RES outside IF statement =',O6,/)
c

		Call Fallt( LOOKUP(Ichan, Spec),
	1		'*** LOOKUP Failed 02.01 ***\')
		blk  = 0
		res  = IREADC( 20, Buff, blk, Ichan, Acmpl )
		IF (res .ge. 0) THEN

			IF (SJ()) THEN

c			   TYPE 81, RES
c81	FORMAT(' RES before second Isleep=',O6,/)
c

				Call Isleep(0,0,3,0)

c			   TYPE 82, RES
c82	FORMAT(' RES after Isleep=',O6,/)
c

			ELSE
				Call Suspnd
			END IF
		END IF
		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 2 )
			Call Write2Int( 20,   10 )
			Call Write2Int( res,  10 )
			Call WriteLn
			DtIcread = DtIcread + 2**2
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 3 )
			Call Write2Int( fail,       06 )
			Call WriteBool( 65+fail,    10 )
			Call WriteBool( Buff(fail), 10 )
			Call WriteLn
			DTIcread = DTIcread + 2**3
		END IF
		
		blk  = 10
		res  = IREADC( 20, Buff, blk, Ichan, acmpl )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. -1) THEN
			Call MtFail( 'dcteof', 4 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcread = DtIcread + 2**4
		END IF

		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )
	
		Call TestFail( DtICread )

		Call CentLn( '--- Testing IREADC completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IREADF ------------------------------------

	Function DtIFread

		External	cmplres

		Integer*4	DtIFread
		Integer*2	Ichan, res, res1, blk, i, area(4)
		Integer*2	Fail
		Logical*2	SJ
		Byte		Buff(40)
		Integer*2	Spec(4)
		Data Spec/ 3rDAT, 3rTES, 3rTRD, 3rTST /

		Call CentLn( '--- Testing IREADF ---\' )
		Call CentLn( 'Performs IREAD with FORTRAN completion\')
		DtIFread = 0

		Ichan = IgetC()
		IF (Ichan .lt. 0) Stop 'no channel'
		Call Fallt( IENTER(Ichan, Spec,1),
	1		'*** IENTER Failed 03.01 ***\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue
		blk = 0
		Call IWritw( 20, Buff, blk, Ichan )
		Call Closec( Ichan )

		blk  = 0
		res  = Ireadf( 20, Buff, blk, Ichan, area, cmplres )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTIfread= DtIfread + 2**1
		END IF

		Call Fallt( LOOKUP(Ichan, Spec),
	1		'*** LOOKUP Failed 03.01 ***\')
		blk  = 0
		res  = Ireadf( 20, Buff, blk, Ichan, area, cmplres )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF

		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 2 )
			Call Write2Int( 20,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfread = DtIfread + 2**2
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 3 )
			Call Write2Int( fail,       06 )
			Call Write2Int( 65+fail,    10 )
			Call Write2Int( Buff(fail), 10 )
			Call WriteLn
			DTIfread = DTIfread + 2**3
		END IF
		
		blk  = 10
		res  = Ireadf( 20, Buff, blk, Ichan, area, cmplres )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. -1) THEN
			Call MtFail( 'dcteof', 4 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfread = DtIfread + 2**4
		END IF

		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )

		Call TestFail( DtIFread )

		Call CentLn( '--- Testing IREADF completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IREADW ------------------------------------

	Function DtIWread

		Integer*4	DtIWread
		Integer*2	Ichan, res, blk, i
		Integer*2	Fail
		Byte		Buff(40)
		Integer*2	Spec(4)
		Data Spec/ 3rDAT, 3rTES, 3rTRD, 3rTST /

		Call CentLn( '--- Testing IREADW ---\' )
		Call CentLn( 'Performs IREAD and then waits\')
		DtIWread = 0

5		Ichan = IgetC()
		IF (Ichan .lt. 0) Stop 'no channel'
		Call Fallt( IENTER(Ichan, Spec, 1),
	1		'*** IENTER Failed 04.01 ***\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue
		blk = 0
		Call IWritw( 20, Buff, blk, Ichan )
		Call Closec( Ichan )

		blk  = 0
		res  = Ireadw( 20, Buff, blk, Ichan )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTIwread= DtIwread + 2**1
		END IF

		Call Fallt( LOOKUP( Ichan, Spec),
	1		'*** LOOKUP Failed 04.01 ***\')
		blk  = 0
		res  = Ireadw( 20, Buff, blk, Ichan )
		
		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 2 )
			Call Write2Int( 20,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwread = DtIwread + 2**2
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 3 )
			Call Write2Int( fail,       06 )
			Call Write2Int( 65+fail,    10 )
			Call Write2Int( Buff(fail), 10 )
			Call WriteLn
			DTIwread = DTIwread + 2**3
		END IF

		blk  = 10
		res  = Ireadw( 20, Buff, blk, Ichan )
		IF (res .ne. -1) THEN
			Call MtFail( 'dcteof', 4 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwread = DtIwread + 2**4
		END IF

		
		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )

		Call TestFail( DtIWread )

		Call CentLn( '--- Testing IREADW completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- JREAD ------------------------------------

	Function DtJread

c+
c  This is the first function in a series that test the JREADx and JWRITx
c  routines in SYSLIB.  Those routines read and write data to MSCP disks
c  without regard to partition boundaries.  At least two free adjacent 
c  MSCP disk partitions are required to test JREADx and JWRITx.  The first
c  of those partitions must be assigned to RT-11 device DU7:.  Function
c  JSETUP determines whether DU7 exists, whether other environmental 
c  conditions are properly set, and how many blocks are available for
c  testing.  It is called from the main test controllers, TDATAT and
c  TDATA2.  This routine gets information from JSETUP through subroutine
c  JGETDV.
c  
c  Test modules include DtJread (this module), DtJCread, DtJFread, DtJWread, 
c  DtJWrit, DtJFwrit, DtJCwrit, and DtJWwrit.
c
c  This test checks the following:
c
c	1.  Response to absent arguments
c	2.  Proper return code when channel is not open
c	3.  Proper return code when device is NOT DU
c	4.  Proper return code when channel is open to a file
c	5.  Proper positive success code
c-

	Integer*2	ARGER
	Integer*2	WCNT
	Parameter	(ARGER= -257)	! Error for WRONG NUMBER OF ARGS
	Parameter	(NTB=5)		! Number of test starting blocks
	Parameter	(NBPIO=1)	! Number of blocks per I/O
	Parameter	(WCNT=256)	! Number of words per I/O

	Integer*4	DtJread, status
	Integer*4	jblk, jsiz
	Integer*4	jsblk(NTB)	! Array of starting blocks

	Integer*2	area(80)	! optional & obsolete work area
	Integer*2	Fail, i, Ichan, dblk(4)
	Integer*2	res, res1	! function result variables
	Integer*2	Buff(WCNT)	! I/O buffer
	Integer*2	NLSpec(4)	! RAD50 NL: spec
	Integer*2	SWSpec(4)	! RAD50 DU0:SWAP.SYS spec

	Logical*2	CHECK2		! diagnostic routine

c  List of starting block numbers for I/O testing

	Data jsblk / 	     0, 32767, 65535, 65536, 68000 /

	Data NLSpec / 3rNL , 0, 0, 0 /			! NL device spec
	Data SWSpec / 3rDU0, 3rSWA, 3rP  , 3rSYS /	! DU0:SWAP.SYS spec

c  Begin:

	Call CentLn('--- Testing JREAD ---\' )
	Call CentLn('Transfers data from an MSCP device to memory\')

	status = 0

c  Get a channel, and make sure that a big MSCP device is ready

	Ichan = IgetC()
	IF (Ichan .lt. 0) Stop 'no channel'
	If ( JGETDV( dblk, jsiz) .lt. 0) go to 990
	jblk = 68000			! typical large block

c  Test 1:  Try calling JREAD with inadequate arguments

	res = JREAD( , Buff, jblk, Ichan )
	IF (res .ne. ARGER) goto 5
	res = JREAD( WCNT, , jblk, Ichan )
	IF (res .ne. ARGER) goto 5
	res = JREAD( WCNT, Buff, , Ichan )
	IF (res .ne. ARGER) goto 5
	res = JREAD( WCNT, Buff, jblk,  )
	IF (res .ne. ARGER) goto 5
	res = JREAD( )

    5	Call CHECK2( 'MISSING ARGUMENTS\', 1, 
	1	'Argerr', ARGER, res, status )

c  Test 2:  Try reading from closed channel

	Call CloseC( Ichan )
	res  = JREAD( WCNT, Buff, jblk, Ichan, area )
	res1 = IWAIT( Ichan )

	Call CHECK2( 'CHANNEL NOT OPEN\', 2,
	1	'Notopn', -3, res, status )

	Call CloseC( Ichan )

c  Test 3:  Try reading from NL:

	Call Fallt( LOOKUP( Ichan, NLSpec),
	1		' LOOKUP Failed 05.01 \')

	res  = JREAD( WCNT, Buff, jblk, Ichan, area )
	res1 = IWAIT( Ichan )

	Call CHECK2( 'INVALID DEVICE\', 3, 
	1	'JREAD ', -4, res, status)

	Call CloseC( Ichan )

c  Test 4:  Try performing JREAD on channel open to DU0:SWAP.SYS
c  (file I/O is not allowed)

	Call Fallt( LOOKUP( Ichan, SWSpec),
	1		' LOOKUP Failed 05.02 \')

	res  = JREAD( WCNT, Buff, jblk, Ichan, area )
	res1 = IWAIT( Ichan )

	Call CHECK2( 'CHANNEL OPEN TO FILE\', 4,
	1	'JREAD ', -5, res, status)

	Call CloseC( Ichan )


c  Test 5-8:  Functionality Testing:  Try reading from DU7:

	Call Fallt( LOOKUP( Ichan, dblk),
	1		' LOOKUP Failed 05.03 \')

c  For various starting blocks on DU7:, store unique values at various 
c  locations on the disk.  

	Call CentLn(' Writing blocks...\')
	Do 50 indx=1,NTB			! For each test block
	    jblk = jsblk(indx)		! get the test block number

	    Do 40 i = 1, WCNT		! Store a 
		Buff(i) = i*indx		!  unique value in each word,
   40	    Continue			!   in each block
						! (assumes WCNT*NTB < 32767)

	    res  = JWRITW( WCNT, Buff, jblk, Ichan, area )

	    If (indx .ne. 1) go to 50	! check JWRITW only once
	    Call CHECK2( '\', 5, 'writit', WCNT, res, status)
						!  if test fails.
   50	Continue				! Next test starting block

c  Now read back all the test blocks and make certain that they contain
c  the proper data.

   60	Call CentLn(' Reading and comparing...\')
	Do 100 indx=1,NTB
	    jblk = jsblk(indx)		! get the test block number

	    Do 65 i = 1, WCNT
		Buff(i) = -1		! spoil the buffer
   65	    Continue

	    res  = JREAD( WCNT, Buff, jblk, Ichan, area )
	    res1 = IWAIT( Ichan )

	    Call CHECK2( '\', 6, 'JREAD ', 0, res, status)
	    Call CHECK2( '\', 7, 'nmread', 0, res1, status)

c  Check to make sure that the buffer contents were read correctly.
c  Make an exception for the last block.  That test tries to read beyond
c  the end of the disk and should fail when it reaches the 257'th word.

	    Fail = 0
	    Do 80 i = 1, WCNT
		IF (Buff(i) .ne. (i*indx)) THEN
		    Fail = i
		    Goto 200		! abort the test
		END IF
   80	    Continue
  100	Continue				! next test block

  200	IF (Fail .gt. 0) THEN
	    Call IMtFail( 'datavl', 8 )
	    Call Write2Int( indx,       06 )
	    Call Write2Int( Fail*indx,  10 )
	    Call Write2Int( Buff(Fail), 10 )
	    Call WriteLn
	    status = status + 2**8
	END IF

c  Test complete

	Call Closec( Ichan )
	Call Ifreec( Ichan )
	Dtjread = status
	Call TestFail( Dtjread )

	Call CentLn( '--- Testing JREAD completed ---\' )
  990	Call WriteLn
	Return

	END

C -------------------------------- JREADC ------------------------------------

	Function DtJCread

	External	Acmpl		! Assembly language completion routine
	Logical*2	SJ		! Tests for SJ environment
	Logical*2	CHECK2		! diagnostic routine

	Integer*2	WCNT
	Parameter	(NTB=10)	! Number of test starting blocks
	Parameter	(NBPIO=2)	! Number of blocks per I/O
	Parameter	(WCNT=NBPIO*256)! Number of words per I/O

	Integer*4	jblk, jsiz	! I*4 block variables
	Integer*4	JLIMIT
	Integer*4	jsblk(NTB)	! Array of starting blocks

	Integer*2	area(80)	! optional & obsolete work area
	Integer*2	Fail, i, Ichan, dblk(4)
	Integer*2	res, res1	! function result variables
	Integer*2	Buff(WCNT)	! I/O buffer
	Integer*2	NLSpec(4)	! RAD50 NL: spec

	Integer*4	DtJCread

	Data NLSpec / 3rNL , 0, 0, 0 /	! NL device spec

c  List of starting block numbers for I/O testing

	Data jsblk / 	     0,     2, 98304, 65500, 65535,
	1		 65537, 68304, 16384, 81920,     0 /
c		Largest block gets put here dynamically--^

	Call CentLn( '--- Testing JREADC ---\' )
	Call CentLn( 'Performs JREAD with assembly completion\' )
	DtJcread = 0

c  Get a channel, and make sure that a big MSCP device is ready

	Ichan = IgetC()
	If ( JGETDV( dblk, jsiz) .lt. 0) go to 990
	jsblk(NTB) = jsiz-1			! last good block on device
	jblk  = 68000
	jlimit = jsiz-NBPIO

c	WRITE (5, 1001)
c 1001	FORMAT(/,' Enter JLIMIT: ',$)
c	READ (5, *) JLIMIT

c  Test 1: Try reading from closed channel

	Call CloseC( Ichan )
	res  = JREADC( 256, Buff, jblk, Ichan, area, acmpl )

	Call CHECK2( 'CHANNEL NOT OPEN\', 1,
	1		'notopn', -3, res, Dtjcread)

c  Test 2: Try reading from NL:
c
c  (COMMENTED OUT DUE TO SPACE CONSTRAINTS - THIS IS THOROUGHLY TESTED IN
c  DTJREAD, AND JREADx uses common code.  RHH)
c
c	Call Fallt( LOOKUP( Ichan, NLSpec),
c	1		'LOOKUP Failed 06.01\')
c
c	res  = JREADC( 256, Buff, jblk, Ichan, area, acmpl )
c	IF (res .ge. 0) THEN
c		Call Isleep( 0, 0, 2, 0)
c	END IF
c
c	Call CHECK2( 'INVALID DEVICE\', 2, 
c	1		'JREADC', -4, res, Dtjcread)
	Call CloseC( Ichan )

c  Tests 3-7: Try to read from DU7:

	Call Fallt( LOOKUP( Ichan, dblk), 'LOOKUP Failed 07.01\')

c  For various starting blocks on DU7:, store unique values at various 
c  locations on the disk.  The JSETUP routine allows devices as small
c  as 70000 blocks.  Use this opportunity to adjust down particular
c  test blocks if necessary.

	Call CentLn(' Writing scattered blocks...\')

	Do 50 indx=1,NTB			! For each test block
	    if (indx .lt. NTB .and. jsblk(indx) .gt. jlimit)
     1			go to 50		! skip this block

	    jblk = jsblk(indx)			! get the test block number

c	ENCODE (26, 1021, BUFF) JBLK
c 1021	FORMAT(' JWRITW of block ',I8, '\')
c	CALL CENTLN( BUFF )

	    Do 10 i = 1, WCNT			! Store a 
		Buff(i) = i*indx		!  unique value in each word,
 10	    Continue				!   in each block
						! (assumes WCNT*NTB < 32767)
	    i = WCNT
	    if (indx .eq. NTB) i = 256		! last block test?

	    res  = JWRITW( i, Buff, jblk, Ichan, area )
	    If (indx .ne. 1) go to 50		! check JWRITW only once
	    Call CHECK2( '\', 3, 'writit', WCNT, res, Dtjcread)
						!  if test fails.
   50	Continue				! Next test starting block

c  Now read back all the test blocks and make certain that they contain
c  the proper data.

   60	Call CentLn(' Reading and comparing...\')

	Do 100 indx=1,NTB
	    if (indx .lt. NTB .and. jsblk(indx) .gt. jlimit)
     1			go to 100		! skip this block

	    jblk = jsblk(indx)		! get the test block number

	    Do 65 i = 1, WCNT
		Buff(i) = -1		! spoil the buffer
   65	    Continue

c Here's the main test...

c	ENCODE (26, 1023, BUFF) JBLK
c 1023	FORMAT(' JREADC of block ',I8, '\')
c	CALL CENTLN( BUFF )

	    i = WCNT
	    if (indx .eq. NTB) i = 256		! last block test?

	    res  = JREADC( i, Buff, jblk, Ichan, area, acmpl )

	    IF (res .ge. 0) THEN
		IF (SJ()) THEN
		    Call Isleep(0, 0, 3, 0)
		ELSE
		    Call Suspnd		! until awakened by acmpl
		END IF
	    END IF

	    Call Check2( '\', 4, 'JREADC', 0, res, Dtjcread)

	    Call CheckX( '\', 5, 'Hardwr', 0, -2, res, 'NE', Dtjcread )

c  Check to make sure that the buffer contents were read correctly.
c  Make an exception for the last block.  That test tries to read beyond
c  the end of the disk and should fail when it reaches the 257'th word.

	    Fail = 0
	    isawit = 0
	    Do 80 i = 1, WCNT
		IF (Buff(i) .ne. (i*indx)) THEN
		    IF (i .eq. 257 .and. indx .eq. NTB) THEN
			isawit = 1		! must be end of disk.
			goto 100		! that's ok.
		    ELSE
			Fail = i
			Goto 200		! abort the test
		    ENDIF
		ENDIF
   80	    Continue
  100	Continue				! next test block

c	Call CHECK2( 'END DISK\', 6, 'NoEnd?', 1, isawit, Dtjcread)

  200	IF (Fail .gt. 0) THEN
	    Call IMtFail( 'datavl', 7 )
	    Call Write2Int( indx,       06 )
	    Call Write2Int( fail*indx,  10 )
	    Call Write2Int( Buff(fail), 10 )
	    Call WriteLn
	    Dtjcread = Dtjcread + 2**7
	END IF

	Call Closec( Ichan )
	Call Ifreec( Ichan )
	Call TestFail( Dtjcread )
	Call CentLn( '--- Testing JREADC completed ---\' )
  990	Call WriteLn
	Return

	END

C--------------------------------- JREADF ------------------------------------

	Function DtjFread

	External	cmplres

	Integer*4	DtjFread
	Integer*2	Buff(256)
	Integer*2	Ichan, res, i, dblk(4), area(80)
	Integer*2	lnk(4), Fail
	Logical*2	SJ
	Integer*4	jblk, jsiz
	Integer*2	NLSpec(4)
	Data NLSpec / 3rNL , 0, 0, 0 /	! NL device spec

	Call CentLn( '--- Testing JREADF ---\' )
	Call CentLn(
	1	'Performs JREAD with FORTRAN completion\')
	DtJfread = 0

c  Get a channel, and make sure that a big MSCP device is ready

	Ichan = IgetC()
	If ( JGETDV( dblk, jsiz) .lt. 0) go to 990
	jblk  = 68000

c  Try reading from closed channel

	Call CloseC( Ichan )
	res  = JREADF( 256, Buff, jblk, Ichan, area, lnk,
	1		cmplres )
	IF (res .ge. 0) THEN
		IF (SJ()) THEN
			Call Isleep(0,0,3,0)
		ELSE
			Call Suspnd
		END IF
	END IF

	Call CHECK2( '\', 1, 'notopn', -3, res, Dtjfread)

	Call CloseC( Ichan )

c  Try reading from NL:

	Call Fallt( LOOKUP( Ichan, NLSpec),
	1		'LOOKUP Failed 07.01\')

	res  = JREADF( 256, Buff, jblk, Ichan, area, lnk, cmplres )
	IF (res .ge. 0) THEN
		IF (SJ()) THEN
			Call Isleep(0,0,3,0)
		ELSE
			Call Suspnd
		END IF
	END IF

	Call CHECK2( 'INVALID DEVICE\', 2, 'JREADF', -4, res,
	1			Dtjfread)

	Call CloseC( Ichan )

c  Test JREADF on genuine MSCP device

	Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 07.02\')

	DO 10 i = 1, 256
		Buff(i) = 3
10	Continue

	res  = JWRITW( 256, Buff, jblk, Ichan, area )
	Call CHECK2( '\', 3, 'writit', 256, res, Dtjfread)
c
	DO 15 i = 1, 256
		Buff(i) = -1
15	Continue

	Call CloseC( Ichan )

	Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 07.03\')

	Call Isleep( 0,0,1,0 )
	res  = JREADF( 256, Buff, jblk, Ichan, area, lnk, cmplres )
	IF (res .ge. 0) THEN
		IF (SJ()) THEN
			Call Isleep(0,0,3,0)
		ELSE
			Call Suspnd
		END IF
	END IF

	Call CHECK2( '\', 4, 'JREADF', 0, res, Dtjfread)

c		IF (res .eq. -2) THEN
c			Call MtFail( 'hardwr', 5 )
c			Call Write2Int( 0,   10 )
c			Call Write2Int( res, 10 )
c			Call WriteLn
c			Dtjfread = Dtjfread + 2**5
c		END IF

	Call CHECKX( '\', 5, 'hardwr', 0, -2, res, 'NE', Dtjfread)

	Fail = 0
	DO 20 i = 1, 256
		IF (Buff(i) .ne. 3) Then
			Fail = i
			Goto 21
		END IF
   20	Continue

   21	IF (Fail .gt. 0) THEN
		Call MtFail( 'datavl', 6 )
		Call Write2Int( Fail,       06 )
		Call Write2Int( 3,          10 )
		Call Write2Int( Buff(fail), 10 )
		Call WriteLn
		Dtjfread = Dtjfread + 2**6
	END IF

	Call Closec( Ichan )
	Call Ifreec( Ichan )

	Call TestFail( Dtjfread )

	Call CentLn( '--- Testing JREADF completed ---\' )
  990	Call WriteLn
	Return

	END

C--------------------------------- JREADW ------------------------------------

	Function DtjWread

	Integer*4	DtjWread
	Integer*4	jblk, jsiz
	Integer*2	Ichan, res, i, area(80), dblk(4), Fail
	Integer*2	Buff(256)
	Integer*2	NLSpec(4)
	Integer*2	J
	Data NLSpec / 3rNL , 0, 0, 0 /	! NL device spec

	Call CentLn( '--- Testing JREADW ---\' )
	Call CentLn( 'Performs JREAD with wait\')
	DtJwread = 0

c  Get a channel, and make sure that a big MSCP device is ready

	Ichan = IgetC()
c	If (Ichan .lt. 0) Stop 'no channel'
	If ( JGETDV( dblk, jsiz) .lt. 0) go to 990
	jblk  = 68000

c  Try reading from closed channel

	Call CloseC( Ichan )
	res  = JREADW( 256, Buff, jblk, Ichan, area )
c	IF (res .ne. -3) THEN
c		Call MtFail( 'notopn', 1 )
c		Call Write2Int( -3,  10 )
c		Call Write2Int( res, 10 )
c		Call WriteLn
c		Dtjwread = Dtjwread + 2**1
c	END IF
	Call CHECK2( '\', 1, 'notopn', -3, res, Dtjwread)
	Call CloseC( Ichan )

c  Try reading from NL

	Call Fallt( LOOKUP( Ichan, NLSpec),
	1		'LOOKUP Failed 08.01\')

	res  = JREADW( 256, Buff, jblk, Ichan, area )
c	IF (res .ne. -4) THEN
c		Call MtFail( 'JREADW', 2 )
c		Call Write2Int( -4,  10 )
c		Call Write2Int( res, 10 )
c		Call WriteLn
c		DTjwread= Dtjwread + 2**2
c	END IF
	Call CHECK2( '\', 2, 'JREADW', -4, res, Dtjwread)
	Call CloseC( Ichan )

c  Try reading from DU7:

	Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 08.02\')

c  Start at block 71683, and write a test pattern at intervals of 2048
c  blocks down to block 3.  This assures overlap (equivalent blocks in
c  partitions 0 and 1).

	jblk = 2048*35+3		! arbitrary high block number
	Do 30 itest=1,36
	    Do 10 i = 1, 256
		Buff(i) = (itest*3+i)	! arbitrary unique pattern
   10	    Continue

	    res  = JWRITW( 256, Buff, jblk, Ichan, Area )
	    IF (res .lt. 0) THEN
		Call MtFail( 'writit', 3 )
		Call WriteLn
	    ENDIF
	    jblk = jblk - 2048
   30	Continue

c  Read the blocks back and compare them

	Fail = 0
	jblk = 2048*35+3		! start at same block number

	Do 50 itest=1,36
	    res  = JREADW( 256, Buff, jblk, Ichan, area )
c	IF (res .ne. 256) THEN
c		Call MtFail( 'JREADW', 3 )
c		Call Write2Int( 256, 10 )
c		Call Write2Int( res, 10 )
c		Call WriteLn
c		DTjwread= Dtjwread + 2**3
c	END IF
	    Call CHECK2( '\', 3, 'JREADW', 256, res, Dtjwread)

	    IF (res .eq. -2) THEN
		Call MtFail( 'hardwr', 4 )
		Call Write2Int( 256, 10 )
		Call Write2Int( res, 10 )
		Call WriteLn
		Dtjwread = Dtjwread + 2**4
	    END IF

	    DO 40 i = 1, 256
		IF (Buff(i) .ne. (itest*3+i)) Then
			Fail = i
			Goto 210
		END IF
   40	    Continue
	    jblk = jblk - 2048
   50	Continue

  210	IF (Fail .gt. 0) THEN
		Call IMtFail( 'datavl', 5 )
		Call Write2Int( itest,      06 )
		Call Write2Int( 4,          10 )
		Call Write2Int( Buff(fail), 10 )
		Call WriteLn
		Dtjwread = Dtjwread + 2**5
	END IF

	Call Closec( Ichan )
	Call Ifreec( Ichan )

	Call TestFail( Dtjwread )

	Call CentLn( '--- Testing JREADW completed ---\' )
  990	Call WriteLn
	Return

	END

C----------------------------------- ISDAT -----------------------------------

	Function DtIsdat

		Integer*4	DtIsdat
		Integer*2	Buff(5), res, i, GetMess
		Logical*2	SJ

		Call CentLn( '--- Testing ISDAT ---\' )
		Call CentLn( 'Sends data to another job\' )
		DtIsdat = 0

		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Buff(1) = 10
		res = Isdat( Buff, 1 )
		Call Mwait
		IF (res .ne. 0) THEN
			Call RsltFail( 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIsdat = DtIsdat + 2**1
		ELSE
			res = GetMess()
		END IF

		IF (res .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIsdat = DtIsdat + 2**2
		END IF

		DO 10 i = 1, 5
			Buff(i) = i
10		Continue

		Call SendMess( 7 )
		res = Isdat( buff, 5 )
		Call Mwait

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIsdat = DtIsdat + 2**3
		END IF

999		Call TestFail( DtIsdat )

		Call CentLn( '--- Testing ISDAT completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- ISDATC -----------------------------------

	Function DtICsdat

		External	Acmpl

		Integer*4	DtICsdat
		Integer*2	Buff(5), res, i, GetMess
		Logical*2	SJ

		Call CentLn( '--- Testing ISDATC ---\' )
		Call CentLn(
	1		'Sends data and then enters an assembly routine\')
		DtICsdat = 0

		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Buff(1) = 10
		res = Isdatc( buff, 1, Acmpl )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. 0) THEN
			Call RsltFail( 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcsdat = DtIcsdat + 2**1
		ELSE
			res = GetMess()
		END IF

		IF (res .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcsdat = DtIcsdat + 2**2
		END IF

		Call SendMess( 7 )

		DO 10 i = 1, 5
			Buff(i) = i
10		Continue

		res = Isdatc( buff, 5, Acmpl )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcsdat = DtIcsdat + 2**3
		END IF

999		Call TestFail( DtICsdat )

		Call CentLn( '--- Testing ISDATC completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- ISDATF -----------------------------------

	Function DtIFsdat

		External	CmplRes

		Integer*4	DtIFsdat
		Integer*2	Buff(5), res, i, area(4), GetMess
		Logical*2	SJ

		Call CentLn( '--- Testing ISDATF ---\' )
		Call CentLn(
	1	'Sends data and then enters a FORTRAN routine\')
		DtIFsdat = 0

		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Buff(1) = 10
		res = Isdatf( buff, 1, area, CmplRes )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. 0) THEN
			Call RsltFail( 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfsdat = DtIfsdat + 2**1
		ELSE
			res = GetMess()
		END IF

		IF (res .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfsdat = DtIfsdat + 2**2
		END IF

		Call SendMess( 7 )

		DO 10 i = 1, 5
			Buff(i) = i
10		Continue

		res = Isdatf( buff, 5, area, CmplRes )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfsdat = DtIfsdat + 2**3
		END IF

999		Call TestFail( DtIFsdat )

		Call CentLn( '--- Testing ISDATF completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- ISDATW -----------------------------------

	Function DtIWsdat

		Integer*4	DtIWsdat
		Integer*2	Buff(5), res, i, GetMess
		Logical*2	SJ

		Call CentLn( '--- Testing ISDATW ---\' )
		Call CentLn( 'Sends data to another job and waits\' )
		DtIWsdat = 0

		IF (SJ()) THEN
			Call CentLn('--- Not supported under SJ ---\')
			Goto 999
		END IF

		Buff(1) = 10
		res = Isdatw( buff, 1 )
		IF (res .ne. 0) THEN
			Call RsltFail( 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwsdat = DtIwsdat + 2**1
		ELSE
			res = GetMess()
		END IF

		IF (res .ne. 105) THEN
			Call MtFail( 'wrdval', 2 )
			Call Write2Int( 105, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwsdat = DtIwsdat + 2**2
		END IF

		Call SendMess( 7 )

		DO 10 i = 1, 5
			Buff(i) = i
10		Continue

		res = Isdatw( buff, 5 )

		res = GetMess()
		IF (res .ne. 0) THEN
			Call MtFail( 'snderr', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwsdat = DtIwsdat + 2**3
		END IF

999		Call TestFail( DtIWsdat )

		Call CentLn( '--- Testing ISDATW completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- ISPFN ------------------------------------

	Function DtIspfn

		Integer*4	DtIspfn, val
		Integer*2	stts(4), dev, size(2), res, Ichan
		Logical*2	Bitst2
		Integer*2	Spec(4), vardev
		Equivalence	(Val, size(1) )
		Data vardev / 3rDU /
		Data Spec/ 3rSY , 0, 0, 0 /

		Call CentLn( '--- Testing ISPFN ---\' )
		Call CentLn( 'Queues an SPFUN and returns\')
		DtIspfn = 0
	
		Call IDSTAT( vardev, stts )
		IF ( .Not. Bitst2(stts(1),8) ) THEN
		    Call CentLn( 'DU not variable sized?\')
		    Goto 999
		END IF

5		Ichan = Igetc()
		IF (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )
		res = ISPFN( '373'O, Ichan, 1, size(1), 0 )
		Call Iwait( Ichan )
		IF (res .ne. 3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( 3,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIspfn = DtIspfn + 2**1
		END IF
		Call CloseC( Ichan )

		Call Fallt( LOOKUP( Ichan, Spec),
	1		'LOOKUP Failed 09.01\')

		res = ISPFN( '373'O, Ichan, 1, size(1), 0 )
		Call Iwait( Ichan )
		IF (res .ne. 0) THEN
			Call MtFail( 'cispfn', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIspfn = DtIspfn + 2**2
		END IF

		IF (Val .le. 0) THEN
			Call RsltFail( 3 )
			Call WriteInt( 1,   10 )
			Call WriteInt( Val, 10 )
			Call WriteLn
			DtIspfn = DtIspfn + 2**3
		END IF
		
		Call Closec( Ichan )
		Call Ifreec( Ichan )

999		Call TestFail( DtIspfn )

		Call CentLn( '--- Testing ISPFN completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- ISPFNC ------------------------------------

	Function DtICspfn

		External	Acmpl

		Integer*4	DtICspfn, Val
		Integer*2	stts(4), dev, size(2), res, Ichan
		Logical*2	SJ
		Logical*2	Bitst2
		Integer*2	Spec(4), vardev
		Equivalence	(Val, size(1) )
		Data vardev / 3rDU /
		Data Spec/ 3rSY , 0, 0, 0 /

		Call CentLn( '--- Testing ISPFNC ---\' )
		Call CentLn(
	1	'Queues an SPFUN and enters an assembly routine\')
		DtICspfn = 0

		Call IDSTAT( vardev, stts )
		IF ( .Not. Bitst2(stts(1),8) ) THEN
		    Call CentLn( 'DU not variable sized?\')
		    Goto 999
		END IF

5		Ichan = Igetc()
		If (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )
		res = ISPFNC( '373'O, Ichan, 1, size(1), 0, Acmpl )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. 3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( 3,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcspfn = DtIcspfn + 2**1
		END IF
		Call CloseC( Ichan )

		Call Fallt( LOOKUP( Ichan, Spec),
	1		'LOOKUP Failed 10.01\')

		res = ISPFNC( '373'O, Ichan, 1, size(1), 0, Acmpl )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. 0) THEN
			Call MtFail( 'cispfn', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcspfn = DtIcspfn + 2**2
		END IF

		IF (Val .le. 0) THEN
			Call RsltFail( 3 )
			Call WriteInt( 1,   10 )
			Call WriteInt( Val, 10 )
			Call WriteLn
			DtIcspfn = DtIcspfn + 2**3
		END IF
		
		Call Closec( Ichan )
		Call Ifreec( Ichan )

999		Call TestFail( DtICspfn )

		Call CentLn( '--- Testing ISPFNC completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- ISPFNF ------------------------------------

	Function DtIFspfn

		External	Cmplres

		Integer*4	DtIFspfn, Val
		Integer*2	stts(4), dev, size(2)
		Integer*2	res, Ichan, area(4)
		Logical*2	SJ
		Logical*2	Bitst2
		Integer*2	SYSpec(4), vardev
		Equivalence	(Val, size(1) )
		Data vardev / 3rDU /
		Data SYSpec / 3rSY , 0, 0, 0 /	! SY device spec

		Call CentLn( '--- Testing ISPFNF ---\' )
		Call CentLn(
	1	'Queues an SPFUN and enters a FORTRAN routine\')
		DtIFspfn = 0

		Call IDSTAT( vardev, stts )
		IF ( .Not. Bitst2(stts(1),8) ) THEN
		    Call CentLn( 'DU not variable sized?\')
		    Goto 999
		END IF

5		Ichan = Igetc()
		If (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )
		res = ISPFNF( '373'O, Ichan, 1, size(1), 0, area, cmplres )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. 3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( 3,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfspfn = DtIfspfn + 2**1
		END IF
		Call CloseC( Ichan )
c
		Call Fallt( LOOKUP(Ichan, SYSpec),
	1		'LOOKUP Failed 11.01\')

		res = ISPFNF( '373'O, Ichan, 1, size(1), 0, Area, cmplres )
		IF (res .eq. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. 0) THEN
			Call MtFail( 'cispfn', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfspfn = DtIfspfn + 2**2
		END IF

		IF (Val .le. 0) THEN
			Call RsltFail( 3 )
			Call WriteInt( 1,   10 )
			Call WriteInt( Val, 10 )
			Call WriteLn
			DtIfspfn = DtIfspfn + 2**3
		END IF
		
		Call Closec( Ichan )
		Call Ifreec( Ichan )

999		Call TestFail( DtIFspfn )

		Call CentLn( '--- Testing ISPFNF completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- ISPFNW ------------------------------------

	Function DtIWspfn

		Integer*4	DtIWspfn, Val
		Integer*2	stts(4), dev, size(2), res, Ichan
		Logical*2	Bitst2
		Integer*2	SYSpec(4), vardev
		Equivalence	(Val, size(1) )
		Data vardev / 3rDU /
		Data SYSpec / 3rSY , 0, 0, 0 /	! SY device spec

		Call CentLn( '--- Testing ISPFNW ---\' )
		Call CentLn(
	1	'Queues an SPFUN and waits for completion\')
		DtIWspfn = 0

		Call IDSTAT( vardev, stts )
		IF ( .Not. Bitst2(stts(1),8) ) THEN
		    Call CentLn( 'DU not variable sized?\')
		    Goto 999
		END IF

		Ichan = Igetc()
c		If (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )
		res = ISPFNW( '373'O, Ichan, 1, size(1), 0 )
		
		IF (res .ne. 3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( 3,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwspfn = DtIwspfn + 2**1
		END IF
		Call CloseC( Ichan )
c
		Call Fallt( LOOKUP( Ichan, SYSpec),
	1		'LOOKUP Failed 12.01\')

		res = ISPFNW( '373'O, Ichan, 1, size(1), 0 )
		IF (res .ne. 0) THEN
			Call MtFail( 'cispfn', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwspfn = DtIwspfn + 2**2
		END IF

		IF (Val .le. 0) THEN
			Call RsltFail( 3 )
			Call WriteInt( 1,   10 )
			Call WriteInt( Val, 10 )
			Call WriteLn
			DtIwspfn = DtIwspfn + 2**3
		END IF
		
		Call Closec( Ichan )
		Call Ifreec( Ichan )

999		Call TestFail( DtIWspfn )

		Call CentLn( '--- Testing ISPFNW completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- IWRITE -----------------------------------

	Function DtIwrite

		Integer*4	DtIwrite
		Integer*2	i, res, res1, Ichan, blk
		Byte		Buff(40)
		Integer*2	Fail
		Integer*2	Spec(4)
		Data Spec / 3rDAT, 3rTES, 3rTWR, 3rTST/	! test filespec

		Call CentLn( '--- Testing IWRITE ---\' )
		Call CentLn( 'Writes data on a channel and returns\')
		DtIwrite = 0

5		Ichan = IgetC()
		If (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )

		blk  = 0
		res  = IWrite( 20, Buff, blk, Ichan )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTIwrite = DtIwrite + 2**1
		END IF

		Call Fallt( IENTER( Ichan, Spec,1),
	1		'IENTER Failed 05.01\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue

		blk  = 0
		res  = Iwrite( 20, Buff, blk, Ichan )
		Call Iwait( Ichan )
		IF (res .lt. 0) THEN
			Call MtFail( 'nrmwrt', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIWrite = DtIwrite + 2**2
		END IF

		blk  = 10
		res  = Iwrite( 20, Buff, blk, Ichan )
		Call Iwait( Ichan )
		IF (res .lt. -1) THEN
			Call MtFail( 'dcteof', 3 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIWrite = DtIwrite + 2**3
		END IF
		
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP( Ichan, Spec),
	1		'LOOKUP Failed 13.01\')

		Blk = 0
		res = Ireadw( 20, Buff, blk, Ichan )		

		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 4 )
			Call Write2Int( 20,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwrite = DtIwrite + 2**4
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 5 )
			Call Write2Int( Fail,       06 )
			Call Write2Int( 65+Fail,    10 )
			Call Write2Int( Buff(Fail), 10 )
			Call WriteLn
			DTIwrite = DTIwrite + 2**5
		END IF
		
		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )

		Call TestFail( DtIwrite )

		Call CentLn( '--- Testing IWRITE completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IWRITC -----------------------------------

	Function DtICwrit

		External	Acmpl

		Integer*4	DtICwrit
		Integer*2	i, res, res1, Ichan, blk
		Byte		Buff(40)
		Logical*2	SJ
		Integer*2	Fail
		Integer*2	Spec(4)
		Data Spec / 3rDAT, 3rTES, 3rTWR, 3rTST/	! test filespec

		Call CentLn( '--- Testing IWRITC ---\' )
		Call CentLn(
	1		'Writes data and enters an assembly routine\')
		DtICwrit = 0

5		Ichan = IgetC()
		If (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )

		blk  = 0
		res  = IWritC( 20, Buff, blk, Ichan, Acmpl )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTICwrit = DtICwrit + 2**1
		END IF

		Call Fallt( IENTER( Ichan, Spec, 1),
	1		'IENTER Failed 06.01\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue

		blk  = 0
		res  = Iwritc( 20, Buff, blk, Ichan, Acmpl )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .lt. 0) THEN
			Call MtFail( 'nrmwrt', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtICWrit = DtICwrit + 2**2
		END IF

		blk  = 10
		res  = Iwritc( 20, Buff, blk, Ichan, Acmpl )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .lt. -1) THEN
			Call MtFail( 'dcteof', 3 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtICWrit = DtICwrit + 2**3
		END IF
		
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP(Ichan, Spec),
	1		'LOOKUP Failed 14.01\')

		Blk = 0
		res = Ireadw( 20, Buff, blk, Ichan )		

		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 4 )
			Call Write2Int( 20,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIcwrit = DtIcwrit + 2**4
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 5 )
			Call Write2Int( fail,       06 )
			Call Write2Int( fail+65,    10 )
			Call Write2Int( Buff(fail), 10 )
			Call WriteLn
			DTIcwrit = DTIcwrit + 2**5
		END IF
		
		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )

		Call TestFail( DtICwrit )

		Call CentLn( '--- Testing IWRITC completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IWRITF -----------------------------------

	Function DtIFwrit

		External	Cmplres

		Integer*4	DtIFwrit
		Integer*2	i, res, res1, Ichan, blk, area(4)
		Byte		Buff(40)
		Integer*2	Fail
		Logical*2	SJ
		Integer*2	Spec(4)
		Data Spec / 3rDAT, 3rTES, 3rTWR, 3rTST/	! test filespec

		Call CentLn( '--- Testing IWRITF ---\' )
		Call CentLn(
	1	'Writes data and enters a FORTRAN routine\')
		DtIFwrit = 0

		Ichan = IgetC()
		If (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )

		blk  = 0
		res  = IWritf( 20, Buff, blk, Ichan, area, cmplres )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTIfwrit = DtIfwrit + 2**1
		END IF

		Call Fallt( IENTER(Ichan, Spec,1),
	1		'IENTER Failed 07.01\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue

		blk  = 0
		res  = Iwritf( 20, Buff, blk, Ichan, area, cmplres )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .lt. 0) THEN
			Call MtFail( 'nrmwrt', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfWrit = DtIfwrit + 2**2
		END IF

		blk  = 10
		res  = Iwritf( 20, Buff, blk, Ichan, area, cmplres )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .lt. -1) THEN
			Call MtFail( 'dcteof', 3 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfWrit = DtIfwrit + 2**3
		END IF
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP(Ichan, Spec),
	1		'LOOKUP Failed 15.01\')

		Blk = 0
		res = Ireadw( 20, Buff, blk, Ichan )		

		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 4 )
			Call Write2Int( 20,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIfwrit = DtIfwrit + 2**4
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 5 )
			Call Write2Int( fail,       06 )
			Call Write2Int( fail+65,    10 )
			Call Write2Int( Buff(fail), 10 )
			Call WriteLn
			DTIfwrit = DTIfwrit + 2**5
		END IF
		
		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )

		Call TestFail( DtIFwrit )

		Call CentLn( '--- Testing IWRITF completed ---\' )
		Call WriteLn
		Return

	END

C--------------------------------- IWRITW -----------------------------------

	Function DtIWwrit

		Integer*4	DtIWwrit
		Integer*2	i, res, res1, Ichan, blk
		Byte		Buff(40)
		Integer*2	Fail
		Integer*2	Spec(4)
		Data Spec / 3rDAT, 3rTES, 3rTWR, 3rTST/	! test filespec

		Call CentLn( '--- Testing IWRITW ---\' )
		Call CentLn( 'Writes data and waits for completion\')
		DtIWwrit = 0

		Ichan = IgetC()
		If (Ichan .lt. 0) Stop 'no channel'
		Call Closec( Ichan )

		blk  = 0
		res  = IWritw( 20, Buff, blk, Ichan )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTIwwrit = DtIwwrit + 2**1
		END IF

		Call Fallt( IENTER( Ichan, Spec, 1),
	1		'IENTER Failed 08.01\')

		DO 10 i = 1, 40
			Buff(i) = 65+i
10		Continue

		blk  = 0
		res  = Iwritw( 20, Buff, blk, Ichan )
		IF (res .lt. 0) THEN
			Call MtFail( 'nrmwrt', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwWrit = DtIwwrit + 2**2
		END IF

		blk  = 10
		res  = Iwritw( 20, Buff, blk, Ichan )
		IF (res .lt. -1) THEN
			Call MtFail( 'dcteof', 3 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwWrit = DtIwwrit + 2**3
		END IF
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP( Ichan, Spec),
	1		'LOOKUP Failed 16.01\')

		Blk = 0
		res = Ireadw( 20, Buff, blk, Ichan )		

		Fail = 0
		DO 20 i = 1, 40
			IF (buff(i) .ne. 65+i) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 20) THEN
			Call MtFail( 'rdblk0', 4 )
			Call Write2Int( 20,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtIwwrit = DtIwwrit + 2**4
		END IF

		IF (Fail .ne. 0) THEN
			Call IMtFail( 'dtaval', 5 )
			Call Write2Int( Fail,       06 )
			Call Write2Int( Fail+65,    10 )
			Call Write2Int( Buff(fail), 10 )
			Call WriteLn
			DTIwwrit = DTIwwrit + 2**5
		END IF
		
		Call Closec( Ichan )
		Call IDelet( Ichan, Spec )
		Call Ifreec( Ichan )

		Call TestFail( DtIWwrit )

		Call CentLn( '--- Testing IWRITW completed ---\' )
		Call WriteLn
		Return

	END

C---------------------------------- JWRITE -----------------------------------

	Function DtJwrite

	Integer*4	DtJwrite, jblk, jsiz
	Integer*2	i, res, res1, Ichan, area(80)
	Byte		Buff(512)
	Integer*2	Fail
	Integer*2	NLSpec(4)
	Integer*2	dblk(4)
	Data NLSpec / 3rNL , 0, 0, 0 /	! NL device spec

	Call CentLn( '--- Testing JWRITE ---\' )
	Call CentLn(
	1	'Writes data on MSCP device and returns\')
	DtJwrite = 0

c  Get a channel, and make sure that a big MSCP device is ready

	Ichan = IgetC()
c	If (Ichan .lt. 0) Stop 'no channel'
	if (JGETDV( dblk, jsiz) .lt. 0) go to 990

	jblk  = 68000			! typical large block

c  Try writing to a closed channel

	Call Closec( Ichan )
	res  = JWRITE( 256, Buff, jblk, Ichan, area )
	IF (res .ne. -3) THEN
		Call MtFail( 'notopn', 1 )
		Call Write2Int( -3,  10 )
		Call Write2Int( res, 10 )
		Call WriteLn
		DTJwrite = DtJwrite + 2**1
	END IF

	Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 17.01\')

	DO 10 i = 1, 512
		Buff(i) = 101
10	Continue

	res  = JWRITE( 256, Buff, jblk, Ichan, area )
	Call Iwait( Ichan )
	IF (res .lt. 0) THEN
		Call MtFail( 'nrmwrt', 2 )
		Call Write2Int( 0,   10 )
		Call Write2Int( res, 10 )
		Call WriteLn
		DtJWrite = DtJwrite + 2**2
	END IF
	Call Closec( Ichan )
c
	Call Fallt( LOOKUP( Ichan, NLSpec),
	1		'LOOKUP Failed 18.01\')

	res  = JWRITE( 256, Buff, jblk, Ichan, area )
	Call Iwait( Ichan )
	IF (res .ne. -4) THEN
		Call MtFail( 'invdev', 3 )
		Call Write2Int( -4,  10 )
		Call Write2Int( res, 10 )
		Call WriteLn
		DtJWrite = DtJwrite + 2**3
	END IF
	Call Closec( Ichan )
c
	Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 19.01\')

	DO 15 i = 1, 512
		Buff(i) = -1
15	Continue
	res = JREADW( 256, Buff, jblk, Ichan, area )

	Fail = 0
	DO 20 i = 1, 512
		IF (buff(i) .ne. 101) Then
			Fail = i
			Goto 21
		END IF
20	Continue

21	IF (res .ne. 256) THEN
		Call MtFail( 'rdblk0', 4 )
		Call Write2Int( 256, 10 )
		Call Write2Int( res, 10 )
		Call WriteLn
		DtJwrite = DtJwrite + 2**4
	END IF

	IF (Fail .gt. 0) THEN
		Call IMtFail( 'datval', 5 )
		Call Write2Int( Fail,       06 )
		Call Write1Int( i,          10 )
		Call Write1Int( Buff(fail), 10 )
		Call WriteLn
		DTJwrite = DTJwrite + 2**5
	END IF
		
	Call Closec( Ichan )
	Call Ifreec( Ichan )

	Call TestFail( DtJwrite )

	Call CentLn( '--- Testing JWRITE completed ---\' )
990	Call WriteLn
	Return

	END

C--------------------------------- JWRITC -----------------------------------

	Function DtJCwrit

	External	Acmpl

	Integer*4	DtJCwrit, jblk, jsiz
	Integer*2	i, res, res1, Ichan, area(80)
	Byte		Buff(512)
	Integer*2	Fail
	Logical*2	SJ
	Integer*2	dblk(4)
	Integer*2	NLSpec(4)
	Data NLSpec / 3rNL , 0, 0, 0 /	! NL device spec

		Call CentLn( '--- Testing JWRITC ---\' )
		Call CentLn(
	1	'Writes data on MSCP device and enters MACRO routine\')
		DtJCwrit = 0

c  Get a channel, and make sure that a big MSCP device is ready

		Ichan = IgetC()
c		If (Ichan .lt. 0) Stop 'no channel'
		if (JGETDV( dblk, jsiz) .lt. 0) go to 990
		jblk  = 68000

c  Try writing to a closed channel

		Call Closec( Ichan )
		res  = JWRITC( 256, Buff, jblk, Ichan, area, Acmpl )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTJCwrit = DtJCwrit + 2**1
		END IF

		Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 20.01\')

		DO 10 i = 1, 512
			Buff(i) = 102
10		Continue

		res  = JWRITC( 256, Buff, jblk, Ichan, area, Acmpl )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .lt. 0) THEN
			Call MtFail( 'nrmwrt', 2 )
			Call Write2Int( 0, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJCWrit = DtJCwrit + 2**2
		END IF

		Call Closec( Ichan )
c
		Call Fallt( LOOKUP( Ichan, NLSpec),
	1		'LOOKUP Failed 20.02\')

		res  = JWRITC( 256, Buff, jblk, Ichan, area, Acmpl )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. -4) THEN
			Call MtFail( 'invdev', 3 )
			Call Write2Int( -4,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJCWrit = DtJCwrit + 2**3
		END IF
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 20.03\')

		DO 15 i = 1, 512
			Buff(i) = -1
15		Continue

		res = JREADW( 256, Buff, jblk, Ichan, area )		

		Fail = 0
		DO 20 i = 1, 512
			IF (buff(i) .ne. 102) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 256) THEN
			Call MtFail( 'rdblk0', 4 )
			Call Write2Int( 256, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJcwrit = DtJcwrit + 2**4
		END IF

		IF (Fail .gt. 0) THEN
			Call IMtFail( 'dtaval', 5 )
			Call Write2Int( Fail,       06 )
			Call Write1Int( 2,          10 )
			Call Write1Int( Buff(fail), 10 )
			Call WriteLn
			DTJcwrit = DTJcwrit + 2**5
		END IF
		
		Call Closec( Ichan )
		Call Ifreec( Ichan )

		Call TestFail( DtJCwrit )

		Call CentLn( '--- Testing JWRITC completed ---\' )
990		Call WriteLn
		Return

	END

C--------------------------------- JWRITF -----------------------------------

	Function DtJFwrit

	External	Cmplres
	Integer*4	DtJFwrit, jblk, jsiz
	Integer*2	i, res, res1, Ichan, area(4), wrk(80)
	Byte		Buff(512)
	Integer*2	Fail
	Logical*2	SJ
	Integer*2	dblk(4)
	Integer*2	NLSpec(4)
	Data NLSpec / 3rNL , 0, 0, 0 /	! NL device spec

		Call CentLn( '--- Testing JWRITF ---\' )
		Call CentLn(
	1	'Writes data on MSCP device and enters FORTRAN routine\')
		DtJFwrit = 0

c  Get a channel, and make sure that a big MSCP device is ready

		Ichan = IgetC()
		If (Ichan .lt. 0) Stop 'no channel'
		if (JGETDV( dblk, jsiz) .lt. 0) go to 990
		jblk  = 68000

c  Try writing to a closed channel

		Call Closec( Ichan )
		res  = JWRITF( 256, Buff, jblk, Ichan, wrk, area, cmplres )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTJfwrit = DtJfwrit + 2**1
		END IF

		Call Fallt( LOOKUP(Ichan, dblk),
	1		'LOOKUP Failed 21.01\')

		DO 10 i = 1, 512
			Buff(i) = 103
10		Continue

		res  = JWRITF( 256, Buff, jblk, Ichan, wrk, area, cmplres )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .lt. 0) THEN
			Call MtFail( 'nrmwrt', 2 )
			Call Write2Int( 0, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJfWrit = DtJfwrit + 2**2
		END IF
		
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP( Ichan, NLSpec),
	1		'LOOKUP Failed 21.02\')

		res  = JWRITF( 256, Buff, jblk, Ichan, wrk, area, cmplres )
		IF (res .ge. 0) THEN
			IF (SJ()) THEN
				Call Isleep(0,0,3,0)
			ELSE
				Call Suspnd
			END IF
		END IF
		IF (res .ne. -4) THEN
			Call MtFail( 'invdev', 3 )
			Call Write2Int( -4,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJfWrit = DtJfwrit + 2**3
		END IF
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP(Ichan, dblk),
	1		'LOOKUP Failed 21.03\')

		DO 15 i = 1, 512
			Buff(i) = -1
15		Continue

		res = JREADW( 256, Buff, jblk, Ichan, wrk )		

		Fail = 0
		DO 20 i = 1, 512
			IF (buff(i) .ne. 103) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 256) THEN
			Call MtFail( 'rdblk0', 4 )
			Call Write2Int( 256, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJfwrit = DtJfwrit + 2**4
		END IF

		IF (Fail .gt. 0) THEN
			Call IMtFail( 'dtaval', 5 )
			Call Write2Int( Fail,       06 )
			Call Write1Int( 3,          10 )
			Call Write1Int( Buff(fail), 10 )
			Call WriteLn
			DTJfwrit = DTJfwrit + 2**5
		END IF
		
		Call Closec( Ichan )
		Call Ifreec( Ichan )

		Call TestFail( DtJFwrit )

		Call CentLn( '--- Testing JWRITF completed ---\' )
990		Call WriteLn
		Return

	END
C--------------------------------- JWRITW -----------------------------------

	Function DtJWwrit

	Integer*4	DtJWwrit, jblk, jsiz
	Integer*2	i, res, res1, Ichan, area(80)
	Byte		Buff(512)
	Integer*2	Fail
	Integer*2	dblk(4)
	Integer*2	NLSpec(4)
	Data NLSpec / 3rNL , 0, 0, 0 /	! NL device spec

		Call CentLn( '--- Testing JWRITW ---\' )
		Call CentLn(
	1	'Writes data on MSCP device and waits for completion\')
		DtJWwrit = 0

c  Get a channel, and make sure that a big MSCP device is ready

		Ichan = IgetC()
		If (Ichan .lt. 0) Stop 'no channel'
		if (JGETDV( dblk, jsiz) .lt. 0) go to 990
		jblk  = 68000

c  Try writing to a closed channel

		Call Closec( Ichan )
		res  = JWRITW( 256, Buff, jblk, Ichan, area )
		IF (res .ne. -3) THEN
			Call MtFail( 'notopn', 1 )
			Call Write2Int( -3,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DTJwwrit = DtJwwrit + 2**1
		END IF

		Call Fallt( LOOKUP(Ichan, dblk),
	1		'LOOKUP Failed 22.01\')

		DO 10 i = 1, 512
			Buff(i) = 104
10		Continue

		res  = JWRITW( 256, Buff, jblk, Ichan, area )
		IF (res .lt. 256) THEN
			Call MtFail( 'nrmwrt', 2 )
			Call Write2Int( 256, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJwWrit = DtJwwrit + 2**2
		END IF
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP( Ichan, NLSpec),
	1		'LOOKUP Failed 22.02\')

		res  = JWRITW( 256, Buff, jblk, Ichan, area )
		IF (res .ne. -4) THEN
			Call MtFail( 'invdev', 3 )
			Call Write2Int( -4,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJwWrit = DtJwwrit + 2**3
		END IF
		Call Closec( Ichan )
c
		Call Fallt( LOOKUP( Ichan, dblk),
	1		'LOOKUP Failed 22.03\')

		DO 15 i = 1, 512
			Buff(i) = -1
15		Continue

		res = JREADW( 256, Buff, jblk, Ichan, area )		

		Fail = 0
		DO 20 i = 1, 512
			IF (buff(i) .ne. 104) Then
				Fail = i
				Goto 21
			END IF
20		Continue

21		IF (res .ne. 256) THEN
			Call MtFail( 'rdblk0', 4 )
			Call Write2Int( 256, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			DtJwwrit = DtJwwrit + 2**4
		END IF

		IF (Fail .gt. 0) THEN
			Call IMtFail( 'datval', 5 )
			Call Write2Int( fail,       06 )
			Call Write1Int( 4,          10 )
			Call Write1Int( Buff(fail), 10 )
			Call WriteLn
			DTJwwrit = DTJwwrit + 2**5
		END IF
		
		Call Closec( Ichan )
		Call Ifreec( Ichan )

		Call TestFail( DtJWwrit )

		Call CentLn( '--- Testing JWRITW completed ---\' )
990		Call WriteLn
		Return

	End
	Integer*2 Function JSETUP( ichan, dblk, jsiz)
c+
c  Check for existance of a large usable MSCP partition.  Use the passed
c  RT-11 channel number and return a suitable DBLK for MSCP JREADx/JWRITx
c  testing.  Also return the size of the device in blocks.
c
c  A common block JSETCM saves the information so that a smaller routine,
c  JGETDV, can be used to retrieve it cheaply.  JSETUP, and it's workhorse
c  IGTDUS in SYSLIB, are called once by the test controller; TDATAT or 
c  TDATA2.  Thereafter, the needed information is accessed through JGETDV.
c-
	integer*4 MINSIZ
	Parameter (MINSIZ=70000)		! minimum MSCP disk size

	integer*2 ichan				! passed in
	integer*4 jsiz, dblk(4)			! returned

	byte unityp(6)				! The COMMON block
	integer*4 jsizc				!  through which
	integer*2 dblkc(4)			!   JGETDV retrieves
	Common	/JSETCM/ unityp, jsizc, dblkc	!    the information.

	logical*2 XM				! Environment test routine
c
	integer*2 CNFG3, CF3AT
	byte dname(3), errbuf(80), ibufb(14)
	integer*2 device(4), ibuf(7)
	integer*4 jlocal

	equivalence (jlocal, ibuf(3))		! MSCP unit size
	equivalence (ibuf, ibufb)		! byte equivalent 

	data CNFG3 / "466 /, CF3AT / "001000 /	! Test for AT loaded
c
	data device / 3RDU7, 0, 0, 0 /	! <--- JREAD/JWRITE device

c  Check to see whether DU7 exists, whether enough room exists for 
c  testing, whether AT is loaded, etc.

	call R50ASC( 3, device(1), dname)
	if (XM() .and. (ISPY( CNFG3) .and. CF3AT).eq.0) go to 950

c  Use IGTDUS to get the status of the device designated for JREAD/JWRITE
c  testing.  If IGTDUS returns a negative code, report the problem to
c  the user or log file.

	i = IGTDUS( device(1), ichan, ibuf, , 'RT11')
	if (i .lt. 0) go to 960			! no such device?

	do 100 i=1,4
	    dblk(i) = device(i)
	    dblkc(i) = device(i)		! put into COMMON
  100	continue

c  Make unit type string available to the caller through COMMON.  Doing
c  it this way saves calling overhead (parameter block space), because
c  the name is seldom looked at.

	do 110 i=1,6
	    unityp(i) = ' '			! ensure no nulls
  110	continue

	k = 1
	do 120 i=9,14				! get name of device
	    if (ibufb(i) .gt. "40) then		!  (like "RD54", etc.)
		unityp(k) = ibufb(i)
	  	k = k+1
	    endif
  120	continue

c  Tell the user what we know about the device

	Encode( 48, 1011, errbuf) (unityp(k),k=1,5), jlocal
 1011	Format( 'Device DU7 is ',5A1,' and contains ',I7,' blocks\')
	Call CentLn( errbuf )

c  Check for DEVICE_AVAILABLE and WRITE_ENABLED

	if (ibuf(1).ne.0) go to 970			! not available?
	if ((ibuf(2).and."20000).ne.0) go to 980	! write protected?

	jsiz = jlocal
	if (jlocal .lt. MINSIZ) go to 940	! at least 1+ partitions
	jsizc = jlocal				! put into common
	JSETUP = 0
	Return
c
  940	JSETUP = -4
	Encode( 80, 1041, errbuf) dname
 1041	Format( ' *** Device ',3A1,': TOO SMALL - TEST NOT
	1 PERFORMED ***\')
	go to 990
c
  950	JSETUP = -5
	Encode( 80, 1051, errbuf) dname
 1051	Format( ' *** AT handler NOT LOADED for ',3A1,': - TEST NOT
	1 PERFORMED ***\')
	go to 990

  960	JSETUP = -6
	Encode( 80, 1061, errbuf) dname
 1061	Format( ' *** No such device ',3A1,': - TEST NOT
	1 PERFORMED ***\')
	Call CentLn( errbuf )
	Call CentLn( '(Enter SET DU7 UNIT=0 PART=n, then REBOOT)\')
	go to 992

  970	JSETUP = -7
	Encode( 80, 1071, errbuf) dname
 1071	Format( ' *** Device ',3A1,': OFFLINE - TEST NOT
	1 PERFORMED ***\')
	go to 990

  980	JSETUP = -8
	Encode( 80, 1081, errbuf) dname
 1081	Format( ' *** Device ',3A1,': WRITE PROTECTED - TEST NOT
	1 PERFORMED ***\')

  990	Call CentLn( errbuf )
  992  	Call Closec( Ichan )
	Call Ifreec( Ichan )
	jsizc = 0			! give clear indication of failure
	Return				!  for when JGETDV is called.
c
	End
	Integer*2 Function JGETDV( dblk, jsiz)
c+
c  This function returns the dblk and jsiz values that were previously 
c  determined by JSETUP.  It provides a smaller (cheaper) routine
c  that doesn't require IGTDUS, all the error messages, etc.
c-
	integer*2 dblk(4)
	integer*4 jsiz

	byte unityp(6)
	integer*4 jsizc
	integer*2 dblkc(4)
	Common	/JSETCM/ unityp, jsizc, dblkc
	Data jsizc / 0 /		! recognize when JSETUP hasn't
					!  been called

	If (jsizc .eq. 0) Then		! do we have values to give?
	    Call CentLn('NO DEVICE - TEST NOT PERFORMED\')
	    JGETDV = -1			!  apparently not.
	    Return
	Endif

	do 100 i=1,4			! give the caller our DBLK
	dblk(i) = dblkc(i)
  100	continue

	jsiz = jsizc			! give the caller the device size

	JGETDV = 0			! indicate success
	Return

	End