C*****************************************************************************
C
C                  Test of Device & File Spec Syslib Routines.
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: DeviceSpecs/ DeviS.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
C*****************************************************************************

C*****************************************************************************
C
C List of functions:
C		Iasign, Icsi
C
C*****************************************************************************


C--------------------------------- IASIGN ------------------------------------

	Function TstIasign

		Integer*4	TstIasign
		Integer*2	res, dev, file(3), Ichan
		Character*80	st
		Real*8		Spec

		Call CenterString( '--- Testing IASIGN ---\' )
		Call WriteLn
		Call CenterString( 'Sets information in the fortran unit table\')
		Call WriteLn
		TstIasign = 0
		
		Call Irad50( 2, 'TT', dev )
		res = Iasign( 3, dev )
c
c	Return to test package if module fails & Continue testing
c	Problem will be fixed later.
c
		 IF (res .ne. 0) THEN
    			GOTO 555
		  END IF
c
		IF (res .eq. 0) THEN
			Call MtFail( 'Alyopn', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIasign = TstIasign + 2**1
		END IF

		Close(Unit=10)
		Call Irad50( 3, 'BIN', dev )    	
C		Call Irad50( 9, 'TESTYYTST', file, 0 )
		Call Irad50( 9, 'TESTYYTST', file)
		res = Iasign( 10, dev, file, 0 )
c
c     Return to test package if module fails.
		   IF (res .ne. 0) THEN
		      GOTO 555
		   END IF
c
		Open(Unit=10)
		IF (res .ne. 0) THEN
			Call MtFail( 'normal', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIasign = TstIasign + 2**2
		END IF
		
		Write( 10, 10, err=20 ) ' This is a message of highest',13,10
10		Format( A40, A, A )
		Goto 30
20		Call MtFail( 'writefl', 3 )
		Call Write2Int( 0,   10 )
		Call Write2Int( -1,  10 )
		Call WriteLn
		TstIasign = TstIasign + 2**3
30		Close(Unit=10)

		res = Iasign( 10, dev, file, 0, 32 )
c
c    Return to test package if module fails. 
		   IF (res .ne. 0) THEN
		      GOTO 555
		   END IF
c
		Open(Unit=10)
		IF (res .ne. 0) THEN
			Call MtFail( 'normal', 4 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIasign = TstIasign + 2**4
		END IF
		Read( 10, 40, err=50 ) st
40		Format( A80 )
		Goto 60
50		Call MtFail( 'readfl', 5 )
		Call Write2Int( 0,   10 )
		Call Write2Int( -1,  10 )
		Call WriteLn
		TstIasign = TstIasign + 2**5
60		Close(Unit=10)
		
		res = Iasign( 10, dev, file, 0, 4 )
c
c    Return to test package if module fails.
		   IF (res .ne. 0) THEN
 		      GOTO 555
		   END IF
c
		Open(Unit=10)
		IF (res .ne. 0) THEN
			Call MtFail( 'normal', 6 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIasign = TstIasign + 2**6
		END IF

		Close(Unit=10)
	
		res = Iasign( 10, dev, file, 0, 1 )
c
c     Return to test package if module fails.
		   IF (res .ne. 0) THEN
		       GOTO 555
		   END IF
c
		Open(Unit=10)
		IF (res .ne. 0) THEN
			Call MtFail( 'normal', 7 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIasign = TstIasign + 2**7
		END IF
		Write( 10, 70, err=80 ) 'This is a message'
70		Format( ' ', A20 )
		Goto 90
80		Call MtFail( 'writefl', 8 )
		Call Write2Int( 0,   10 )
		Call Write2Int( -1,  10 )
		Call WriteLn
		TstIasign = TstIasign + 2**8
90		Close(Unit=10)

		Ichan = Igetc()
		Call Irad50( 12, 'BINTESTYYTST', Spec ) 	
		Call Closec( Ichan )
		Call Idelet( Ichan, Spec )
		Call CloseC( Ichan )
		Call Ifreec( Ichan )
		res = Iasign( 10, dev, file, 0, 2 )
c
c   Return to test package if module fails.
		  IF (res .ne. 0 ) THEN
			GOTO 555
		  END IF
c
		Open(Unit=10)
		IF (res .ne. 0) THEN
			Call MtFail( 'normal', 9 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIasign = TstIasign + 2**9
		END IF
		Write( 10, 100, err=110 ) 'This is a message'
100		Format( ' ', A20 )
		Goto 120
110		Call MtFail( 'writefl', 10 )
		Call Write2Int( 0,   10 )
		Call Write2Int( -1,  10 )
		Call WriteLn
		TstIasign = TstIasign + 2**10
120		Close(Unit=10)
		Ichan = Igetc()
		Call Closec( Ichan )
		res = Lookup( Ichan, Spec )
c
c    Return to test package if module fails.
		  IF (res .ne. 0) THEN
		     GOTO 555
		  END IF
c
		IF (res .ge. 1) THEN
			Call MtFail( 'tempfl', 11 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIasign = TstIasign + 2**11
		END IF
		Call CloseC( Ichan )
		Call Ifreec( Ichan )
				
		Call TestFail( TstIasign )

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

		GOTO 999
c
c		GIVE ERROR MESSAGE, RETURN TO TEST PACKAGE, AND
c		           CONTINUE TESTING.
c
555	    Call CenterString( 'ERROR IN   IASIGN   SYSLIB ROUTINE \' )
	    Call WriteLn
	    Call CenterString( 'PROBLEM TO BE FIXED LATER \' )
	    Call WriteLn
	    Call CenterString( 'TEST EXITING  IASIGN  MODULE DUE TO ERROR\' )
	    Call WriteLn
	RETURN
C
999	END

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

C------------------------------------ ICSI -----------------------------------

	Function TstFIcsi

		Integer*4	TstFIcsi
		Integer*2	res, spec(39), deftype(4), option(4,4)
		Character*50	str
		Character*12    Filen

		Call CenterString( '--- Testing ICSI ---\' )
		Call WriteLn
		Call CenterString( 'Decodes file specifications\')
		Call WriteLn
		TstFIcsi = 0

		option(1,1) = Ichar( 'A' )
		option(1,2) = Ichar( 'B' )
		option(1,3) = Ichar( 'C' )
		option(1,4) = Ichar( 'D' )
		
		Call Irad50( 3, 'TST', deftype(1) )
		Call Irad50( 3, 'TST', deftype(2) )
		Call Irad50( 3, 'DAT', deftype(3) )
		Call Irad50( 3, 'LST', deftype(4) )

		str = 'FILE=FILE'
		Call settrm( str, 10 )

		res = Icsi( spec, deftype, str, option, 4 )
		IF (res .ne. 0) THEN
			Call MtFail( 'normal', 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**1
		END IF

		str = '#@&$)(@uroer=--294094lksf'
		Call Settrm( str, 26 )
		res = Icsi( spec, deftype, str, option, 4 )
		IF (res .ne. 1) THEN
			Call Mtfail( 'badlin', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**2
		END IF
		
		str = 'QQ:FILE'
		Call Settrm( str, 8 )
		res = Icsi( spec, deftype, str, option, 4 )
		IF (res .eq. 2) THEN
			Call Mtfail( 'invdev', 3 )
			Call Write2Int( 2,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**3
		END IF

		str = 'FILE/Q'
		Call Settrm( str, 7 )
		res = Icsi( spec, deftype, str, option, 4 )
		IF (res .ne. 3) THEN
			Call Mtfail( 'invopt', 4 )
			Call Write2Int( 3,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**4
		END IF

		str = 'DK:FILE/A:2/B=WERT/C:6/D '
		Call Settrm( str, 25 )
		res = Icsi( spec, deftype, str, option, 4 )
		IF (res .ne. 0) THEN
			Call Mtfail( 'normal', 5 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**5
		END IF

		IF (option(2,1) .ne. 2) THEN
			Call Mtfail( 'optprs', 6 )
			Call Write2Int( 2,           10 )
			Call Write2Int( option(2,1), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**6
		END IF
		
		IF (option(3,1) .ne. 0) THEN
			Call Mtfail( 'filnum', 7 )
			Call Write2Int( 0,           10 )
			Call Write2Int( option(3,1), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**7
		END IF
		
		IF (option(4,1) .ne. 2) THEN
			Call Mtfail( 'optval', 8 )
			Call Write2Int( 2,           10 )
			Call Write2Int( option(4,1), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**8
		END IF
		
		IF (option(2,2) .ne. 1) THEN
			Call Mtfail( 'optprs', 9 )
			Call Write2Int( 1,           10 )
			Call Write2Int( option(2,2), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**9
		END IF
		
		IF (option(3,2) .ne. 0) THEN
			Call Mtfail( 'filnum', 10 )
			Call Write2Int( 0,           10 )
			Call Write2Int( option(3,2), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**10
		END IF
		
		IF (option(2,3) .ne. 2) THEN
			Call Mtfail( 'optprs', 11 )
			Call Write2Int( 2,   10 )
			Call Write2Int( option(2,3), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**11
		END IF
		
		IF (option(3,3) .ne. 3) THEN
			Call Mtfail( 'filnum', 12 )
			Call Write2Int( 3,           10 )
			Call Write2Int( option(3,3), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**12
		END IF
		
		IF (option(2,4) .ne. 1) THEN
			Call Mtfail( 'optprs', 13 )
			Call Write2Int( 1,           10 )
			Call Write2Int( option(2,4), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**13
		END IF
		
		IF (option(3,4) .ne. 3) THEN
			Call Mtfail( 'filnum', 14 )
			Call Write2Int( 3,           10 )
			Call Write2Int( option(3,4), 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**14
		END IF

		Call R50asc( 12, Spec(1), filen )
		IF (filen .ne. 'DK FILE  TST') THEN
			Call Mtfail( 'filenm', 15 )
			Call WriteString( 'DK FILE  TST', 0, 10 )
			Call WriteString( filen,          0, 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**15
		END IF

		Call R50asc( 12, Spec(16), filen )
		IF (filen .ne. 'DK WERT  TST') THEN
			Call Mtfail( 'filenm', 16 )
			Call WriteString( 'DK FILE  TST', 0, 10 )
			Call WriteString( filen,          0, 10 )
			Call WriteLn
			TstFicsi = TstFicsi + 2**16
		END IF
		
		Call TestFail( TstFIcsi )

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

	END

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