C*****************************************************************************
C
C                  Test of Channel-Oriented Syslib Routines.
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: ChannelOriented/ ChanO.For
C Author	: John Malcolmson
C Date		: June 1986
C Language	: Fortran 77
C Note		: Uses subroutines imported from both syslib and RTNS 
C		  libraries.
C
C*****************************************************************************

C*****************************************************************************
C
C List of functions:
C	IABTIO, ICDFN, ICHCPY, ICSTAT, IFREEC, IGETC, ILUN, IREOPN
C	ISAVES, IWAIT, MWAIT,  PURGE
C
C*****************************************************************************


C---------------------------------- IABTIO -----------------------------------

	Function TstIabtio

		Integer*4	TstIabtio
		Integer*2	res, Blk, Ichan, i
		Byte		Buff(20)
		Real*8		Spec

		Call CenterString( '--- Testing IABTIO ---\' )
		Call WriteLn
		Call CenterString( 'Aborts I/O on a specified Channel\')
		Call WriteLn
		TstIabtio = 0

		Ichan = IGetC()
		Call Closec( Ichan )
		Call Iabtio( Ichan )
		Call Irad50( 12, 'DATTEST01TXT', Spec )
		res = Lookup( Ichan, Spec )
		IF (res .eq. -1) Then 
			Call MtFail( 'Iabtio', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIabtio = TstIabtio + 2**1
		END IF
		Call CloseC( Ichan )
		
		Call Irad50( 12, 'DATTESTQQTST', Spec )
		Call Ienter( Ichan, Spec, 1 )
		DO 10 i = 1, 20
			buff(i) = 65
10		Continue
		Blk = 1
		Call IWrite( 10, buff, Blk, Ichan )
		Call Iabtio( Ichan )
		res = LookUp( Ichan, Spec )
		IF (res .ne. -1) Then
			Call MtFail( 'Iabtio', 2 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIabtio = TstIabtio + 2**2
		END IF

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

		Call TestFail( TstIabtio )

		Call CenterString( '--- Testing IABTIO completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C---------------------------------- ICDFN ------------------------------------

	Function TstIcdfn

		Integer*4	TstIcdfn
		Integer*2	res

		Integer*2	J

		J = ISPY("300)

c
c	  Test if FP11 Floating point hardware exists. If not, DON'T
c	      perform the ICDFN Test. The processor does some floating
c	                  point arithmetic operation.
c

	        IF (( J .AND. "100) .EQ. 0 ) THEN

		  Call CenterString( '?ICDFN-I-ICDFN Test not performed ---
     1FP11 Floating-point hardware does not exist. \')
		  Call WriteLn
		  Call CenterString( 'Processor does Floating-point 
     1arithmetic operation \')
		  Call WriteLn
		  Call WriteLn

	          Goto 999

		END IF


		Call CenterString( '--- Testing ICDFN ---\' )
		Call WriteLn
		Call CenterString( 'Defines additional channels for I/O\' )
		Call WriteLn
		TstIcdfn = 0
		
		res = Icdfn(2)
		IF (res .ne. 1) THEN
			Call IRsltFail( 1 )
			Call Write2Int( 2,   06 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIcdfn = TstIcdfn + 2**1
		END IF

		res = Icdfn(16)
		IF (res .ne. 1) THEN
			Call IRsltFail( 2 )
			Call Write2Int( 16,  06 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIcdfn = TstIcdfn + 2**2
		END IF

		res = Icdfn(20)
		IF (res .ne. 0) THEN
			Call IRsltFail( 3 )
			Call Write2Int( 20,  06 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIcdfn = TstIcdfn + 2**3
		END IF

		res = CloseC( 19 )
		IF (res .ne. 0) THEN
			Call IRsltFail( 4 )
			Call Write2Int( 19,  06 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIcdfn = TstIcdfn + 2**4
		END IF
	
999		Call TestFail( TstIcdfn )

		Call CenterString( '--- Testing ICDFN completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C---------------------------------- ICHCPY -----------------------------------

	Function TstIchcpy

		Integer*4	TstIchcpy
		Integer*2	res, GetMess, Ichan, Ochan, Envior
		Byte		JobName(6)
		Real*8		Spec

		Call CenterString( '--- Testing ICHCPY ---\' )
		Call WriteLn
		Call CenterString( 'Allows access to currently active files\')
		Call WriteLn
		TstIchcpy = 0

		IF (IIAND(Envior(),1) .eq. 0) THEN
			Call CenterString( 'Not tested in SJ Monitor.\' )
			Call WriteLn
			Goto 999
		END IF
		
		Call SendMess( 4 )
		Ochan = GetMess()
		Ichan = Igetc()
		Call IRad50( 12, 'DATTEST01TXT', Spec )
		Call Lookup( Ichan, Spec )
		res = IChCpy( Ichan, Ochan )
		Call Closec( Ichan )
		IF (res .ne. 2) Then
			Call MtFail( 'AlyOpn', 1 )
			Call Write2Int( 2,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIchcpy = TstIchcpy + 2**1
		END IF

		Call SendMess( 5 )
		Call SendMess( Ochan )
		Ochan = GetMess()
		Call SendMess( 4 )
		Ochan = GetMess()
		Call Scopy( 'XXXXXX', JobName, 6 )
		Call Closec( Ichan )
		res = IChCpy( Ichan, Ochan, JobName )
		IF (res .eq. 0) Then
		    IF (IIAND(Envior(),1) .eq. 1) THEN
			IF (IIAND(Envior(),2) .eq. 0) Goto 12
		    END IF
		END IF
		IF (res .ne. 1) Then
			Call MtFail( 'notfnd', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIchcpy = TstIchcpy + 2**2
		END IF

12		Call SendMess( 5 )
		Call SendMess( Ochan )
		Ochan = GetMess()
		Call SendMess( 4 )
		Ochan = GetMess()
		Call Scopy( 'PRTNR', JobName, 5 )
		JobName(6) = 0
		Call Closec( Ichan )
		res = IChCpy( Ichan, Ochan, JobName )
		IF (res .ne. 0) Then
			Call MtFail( 'ichcpy', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIchcpy = TstIchcpy + 2**3
		END IF

		Call Closec( Ichan )
		Call SendMess( 5 )
		Call SendMess( Ochan )
		Ochan = GetMess()
		Call SendMess( 4 )
		Ochan = GetMess()			
		Call Closec( Ichan )
		res = IChCpy( Ichan, Ochan )
		IF (res .ne. 0) Then
			Call MtFail( 'ichcpy', 4 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIchcpy = TstIchcpy + 2**4
		END IF

		Call Closec( Ichan )
		Call Ifreec( Ichan )
		Call SendMess( 5 )
		Call SendMess( Ochan )
		Res = GetMess()

999		Call TestFail( TstIchcpy )

		Call CenterString( '--- Testing ICHCPY completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C----------------------------------- ICSTAT ----------------------------------

	Function TstIcstat

		Integer*4	TstIcstat
		Integer*2	stat(6), res, Ichan
		Character*3	dev
		Real*8		Spec
		
		Call CenterString( '--- Testing ICSTAT ---\' )
		Call WriteLn
		Call CenterString( 'Returns the status of a specified channel\')
		Call WriteLn
		TstIcstat = 0
		
		Ichan = IgetC()
		Call Closec( Ichan )
		res   = Icstat( Ichan, stat )
		IF (res .ne. 1) THEN
			Call RsltFail( 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIcstat = TstIcstat + 2**1
		END IF

		Call Irad50( 12, 'DATTEST01TXT', Spec )
		Call Lookup( Ichan, Spec )
		res   = Icstat( Ichan, stat )
		IF (res .ne. 0) THEN
			Call RsltFail( 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIcstat = TstIcstat + 2**2
		END IF

		Call CenterString( 'The Status Block is as follows:\' )
		Call WriteLn
		Call WriteString( ' \', 30, 1 )
		Call Wbinary( 1+Stat(1)-1, 16 )
		Call WriteChar( 'B' )
		Call WriteLn
		Call WriteString( ' \', 32, 1 )
		Call Write2Int( Stat(2), 14 )
		Call WriteChar( 'D' )
		Call WriteLn
		Call WriteString( ' \', 32, 1 )
		Call Write2Int( Stat(3), 14 )
		Call WriteChar( 'D' )
		Call WriteLn
		Call WriteString( ' \', 32, 1 )
		Call Write2Int( Stat(4), 14 )
		Call WriteChar( 'D' )
		Call WriteLn
		Call WriteString( ' \', 32, 1 )
		Call Write2Int( Stat(5), 14 )
		Call WriteChar( 'D' )
		Call WriteLn
		Call R50asc( 3, stat(6), dev )
		Call WriteString( dev, 39, 3 )
		Call WriteLn
	
		Call Closec( Ichan )
		Call Ifreec( Ichan )

		Call TestFail( TstIcstat )

		Call CenterString( '--- Testing ICSTAT completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C----------------------------------- IFREEC ----------------------------------

	Function TstIfreec

		Integer*4	TstIfreec
		Integer*2	i, res, Ichan(40), gti, lti, cnt, eqi, nei
		Integer*2	gtres, ltres, eqres, neres
		Logical*2	lt, gt, eq, ne

		Call CenterString( '--- Testing IFREEC ---\' )
		Call WriteLn
		Call CenterString( 'Returns the specified channel to the pool\')
		Call WriteLn
		TstIfreec = 0

		cnt = 0
		lt  = .FALSE.
		gt  = .FALSE.
		eq  = .FALSE.
		ne  = .FALSE.

		DO 10 i = 1, 40
			Ichan(i) = Igetc()
			IF ((Ichan(i) .eq. -1).and.(cnt .eq. 0)) cnt = i - 1
10		Continue

		DO 20 i = 1, cnt
			res =  Ifreec( Ichan(i) )
			IF (res .lt. -1) THEN
				lt    = .TRUE.
				ltres = res
				lti   = i
			END IF
			IF (res .gt. 0) THEN
				gt    = .TRUE.
				gtres = res
				gti   = i
			END IF
			IF (res .eq. -1) THEN
				eq    = .TRUE.
				eqres = res
				eqi   = i
			END IF
			res = Ifreec( Ichan(i) )
			IF (res .ne. -1) THEN
				ne    = .TRUE.
				neres = res
				nei   = i
			END IF
20		Continue
		
		Call CenterString( 'Available Channels\' )
		Call WriteLn
		Call WriteString( '   \', 36, 0 )
		Call Write2Int( cnt, 2 )
		Call WriteLn

		IF (lt) THEN
			Call IRsltFail( 1 )
			Call Write2Int( Ichan(lti), 06 )
			Call Write2Int( 0,          10 )
			Call Write2Int( ltres,      10 )
			Call WriteLn
			TstIfreec = TstIfreec + 2**1
		END IF

		IF (gt) THEN
			Call IRsltFail( 2 )
			Call Write2Int( Ichan(gti), 06 )
			Call Write2Int( 0,          10 )
			Call Write2Int( gtres,      10 )
			Call WriteLn
			TstIfreec = TstIfreec + 2**2
		END IF

		IF (eq) THEN
			Call IRsltFail( 3 )
			Call Write2Int( Ichan(eqi), 06 )
			Call Write2Int( 0,          10 )
			Call Write2Int( eqres,      10 )
			Call WriteLn
			TstIfreec = TstIfreec + 2**3
		END IF

		IF (ne) THEN
			Call IRsltFail( 4 )
			Call Write2Int( Ichan(nei), 06 )
			Call Write2Int( -1,         10 )
			Call Write2Int( neres,      10 )
			Call WriteLn
			TstIfreec = TstIfreec + 2**4
		END IF

C		neres = Ifreec( -1 )
C		IF (neres .ne. -2) THEN
C			Call IRsltFail( 5 )
C			Call Write2Int( -1,     06 )
C			Call Write2Int( -2,     10 )
C			Call Write2Int( neres,  10 )
C			Call WriteLn
C			TstIfreec = TstIfreec + 2**5
C		END IF

		Call TestFail( TstIfreec )

		Call CenterString( '--- Testing IFREEC completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C------------------------------------ IGETC ----------------------------------

	Function TstIgetc

		Integer*4	TstIgetc
		Integer*2	i, res, Ichan(40), gti, lti
		Logical*2	lt, gt

		Call CenterString( '--- Testing IGETC ---\' )
		Call WriteLn
		Call CenterString( 'Allocates a channel from the pool\')
		Call WriteLn
		TstIgetc = 0

		res = 0
		lt  = .FALSE.
		gt  = .FALSE.
		DO 10 i = 1, 40
			Ichan(i) = Igetc()
			IF ((Ichan(i) .eq. -1).and.(res .eq. 0)) res = i - 1
			IF (Ichan(i) .lt. -1) THEN
				lt  = .TRUE.
				lti = i
			END IF
			IF (Ichan(i) .gt. 32767) THEN
				gt  = .TRUE.
				gti = i
			END IF
10		Continue

		DO 20 i = 1, res
			Call Ifreec( Ichan (i) )
20		Continue
		
		Call CenterString( 'Available Channels\' )
		Call WriteLn
		Call WriteString( '   \', 36, 0 )
		Call Write2Int( res, 2 )
		Call WriteLn

		IF (lt) THEN
			Call RsltFail( 1 )
			Call Write2Int( 0,          10 )
			Call Write2Int( Ichan(lti), 10 )
			Call WriteLn
			TstIgetc = TstIgetc + 2**1
		END IF

		IF (gt) THEN
			Call RsltFail( 2 )
			Call Write2Int( 0,          10 )
			Call Write2Int( Ichan(gti), 10 )
			Call WriteLn
			TstIgetc = TstIgetc + 2**2
		END IF

		Call TestFail( TstIgetc )

		Call CenterString( '--- Testing IGETC completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C------------------------------------ ILUN -----------------------------------

	Function TstIlun

		Integer*4	TstILun
		Integer*2	res, Ilun

		Call CenterString( '--- Testing ILUN ---\' )
		Call WriteLn
		Call CenterString( 'Associates a channel with fortran logical units\')
		Call WriteLn
		TstIlun = 0

		Close( Unit=99 )
		res = Ilun( 99 )
		IF (res .ne. -1) Then 
			Call RsltFail( 1 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIlun = TstIlun + 2**1
		END IF

		res = ILun( 3 )
		IF (res .lt. -2) Then 
			Call RsltFail( 2 )
			Call Write2Int( -2,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIlun = TstIlun + 2**2
		END IF

		IF (res .eq. -1) Then
			Call MtFail( 'consol', 3 )
			Call Write2Int( -2,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIlun = TstIlun + 2**3
		END IF

		IF (res .ge. 0) Then 
			Call CenterString( 'Completed a Conversion\' )
			Call WriteLn
			Call WriteString(  '   \', 34, 0 )
			Call Write2Int(    3,   2 )
			Call WriteString(  ' => \', 0, 4 )
			Call Write2Int(    res, 2 )
			Call WriteLn
		END IF

		Call TestFail( TstIlun )

		Call CenterString( '--- Testing ILUN completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C---------------------------------- IREOPN -----------------------------------

	Function TstReopn

		Integer*4	TstReopn
		Real*8		Spec
		Integer*2	Res, Ichan, Status(5)
		
		Call CenterString( '--- Testing IREOPN ---\' )
		Call WriteLn
		Call CenterString( 'Restores a saved channel\')
		Call WriteLn
		TstReopn = 0

10		Ichan = IgetC()
		IF (Ichan .lt. 0) Goto 10
		Call CloseC(  Ichan )
		Call IRAD50(  12,    'DATTEST01TXT', Spec )
		Call Lookup(  Ichan, Spec )
		Call Isaves(  Ichan, Status )
		res = IReopn( Ichan, Status )
		IF (res .ne. 0) Then 
			Call RsltFail( 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstReopn = TstReopn + 2**1
		END IF
		res = Ireopn( Ichan, Status )
		IF (res .ne. 1) Then 
			Call MtFail( 'CInUse', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 ) 
			Call WriteLn
			TstReopn = TstReopn + 2**2
		END IF
		res = Lookup( Ichan, Spec )
		IF (res .ne. -1) Then 
			Call RsltFail( 3 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstReopn = TstReopn + 2**3
		END IF

		Call CloseC( Ichan )
		Call Ifreec( Ichan )

		Call TestFail( TstReopn )

		Call CenterString( '--- Testing IREOPN completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C---------------------------------- ISAVES -----------------------------------

	Function TstIsaves

		Integer*4	TstIsaves
		Real*8		Spec
		Integer*2	Ichan, res, status(5)

		Call CenterString( '--- Testing ISAVES ---\' )
		Call WriteLn
		Call CenterString( 'Saves the channel status in an array.\')
		Call WriteLn
		TstIsaves = 0

10		Ichan = IgetC()
		If (Ichan .lt. 0) Goto 10

		Call Closec( Ichan )
		res = Isaves( Ichan, status )
		IF (res .ne. 1) Then 
			Call MtFail( 'ChkOpn', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIsaves = TstIsaves + 2**1
		END IF

		Call Irad50( 12, 'DATTESTQQTST', spec )
		Call Ienter( Ichan, spec, 1)
		res = Isaves( Ichan, status )
		IF (res .ne. 2) Then 
			Call MtFail( 'Ienter', 2 )
			Call Write2Int( 2,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIsaves = TstIsaves + 2**2
		END IF
		Call CloseC( Ichan )
		Call Idelet( Ichan, Spec )

		Call Irad50( 12, 'DATTEST01TXT', Spec )
		Call Lookup( Ichan, Spec )
		res = Isaves( Ichan, status )
		IF (res .ne. 0) Then 
			Call RsltFail( 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIsaves = TstIsaves + 2**3
		END IF
		res = Lookup( Ichan, spec )
		IF (res .lt. 1) THEN
			Call MtFail( 'FileSv', 4 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIsaves = TstIsaves + 2**4
		END IF
		Call Closec( Ichan )

		Call IReopn( Ichan, status )
		res = Lookup( Ichan, spec )
		IF ( res .ne. -1 ) THEN
			Call MtFail( 'IReopn', 5 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIsaves = TstIsaves + 2**5
		END IF

		Call CloseC( Ichan )
		Call Ifreec( Ichan )

		Call TestFail( TstIsaves )

		Call CenterString( '--- Testing ISAVES completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C----------------------------------- IWAIT -----------------------------------

	Function TstIwait

		Integer*4	TstIwait
		Byte		Buff(20)
		Integer*2	res, Ichan, blk, i, Ilun
		Real*8		Spec

		Call CenterString( '--- Testing IWAIT ---\' )
		Call WriteLn
		Call CenterString( 'Waits for completion of I/O on a channel\')
		Call WriteLn
		TstIwait = 0

		Ichan = IGetC()
		Call Closec( Ichan )
		res = Iwait( Ichan )
		IF (res .ne. 1) Then 
			Call MtFail( 'clschk', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIwait = TstIwait + 2**1
		END IF
		Call CloseC( Ichan )
		
		Call Irad50( 12, 'DATTESTQQTST', Spec )
		Call Ienter( Ichan, Spec, 1 )
		DO 10 i = 1, 20
			buff(i) = 65
10		Continue
		Blk = 1
		Call IWrite( 10, buff, Blk, Ichan )
		res = Iwait( Ichan )
		IF (res .ne. 0) Then
			Call MtFail( 'writeT', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIwait = TstIwait + 2**2
		END IF

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

		Call TestFail( TstIwait )

		Call CenterString( '--- Testing IWAIT completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C---------------------------------- MWAIT ------------------------------------

	Function TstMwait

		Integer*4	TstMwait
		Integer*2	res, Buff, Buffah(2), Envior

		Call CenterString( '--- Testing MWAIT ---\' )
		Call WriteLn
		Call CenterString( 'Waits for messages to be processed\')
		Call WriteLn
		TstMwait = 0

		IF (IIAND(Envior(),1) .eq. 0) THEN
			Call CenterString( 'Not tested in SJ Monitor.\' )
			Call WriteLn
			Goto 999
		END IF

		buff = 10
		Call Isdat( buff, 1 )
		Call Mwait
		Call ircvd( buffah, 1 )
		Call Mwait
		
999		Call TestFail( TstMwait )

		Call CenterString( '--- Testing MWAIT completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C---------------------------------- PURGE ------------------------------------

	Function TstPurge

		Integer*4	TstPurge
		Real*8		Spec
		Integer*2	Ichan, res

		Call CenterString( '--- Testing PURGE ---\' )
		Call WriteLn
		Call CenterString('Deactivates a channel without performing a close\')
		Call WriteLn
		TstPurge = 0

10		Ichan = IgetC()
		IF (Ichan .lt. 0) Goto 10

		Call Irad50( 12, 'DATTESTQQTST', Spec )
		Call Ienter( Ichan, Spec, 1 )
		Call Purge( Ichan )
		res = LookUp( Ichan, Spec )
		If (res .ge. 1) THEN
			Call MtFail( 'purge ', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			Call Closec( Ichan )
			Call Idelet( Ichan, Spec )
			TstPurge = TstPurge + 2**1
		END IF
		Call CloseC( Ichan )

		Call Irad50( 12, 'DATTEST02TXT', Spec )
		Call LookUp( Ichan, Spec )
		Call Purge( Ichan )
		res = LookUp( Ichan, Spec )
		If (res .lt. 1) THEN
			Call MtFail( 'purge ', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstPurge = TstPurge + 2**2
		END IF

		Call CloseC( Ichan )
		Call Ifreec( Ichan )

		Call TestFail( TstPurge )

		Call CenterString( '--- Testing PURGE completed ---\' )
		Call WriteLn
		Call WriteLn

	END

C-----------------------------------------------------------------------------