C*****************************************************************************
C
C                  Test of Radix-50 Support Syslib Routines.
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: Radix-50 Support/ Radix.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	IRAD50, R50ASC, RAD50
C
C*****************************************************************************


C---------------------------------- IRAD50 -----------------------------------

	Function TstIrad50

		Integer*4	TstIrad50
		Integer*2	IRAD50
		Integer*2	Result, res, rsl(2), srl(2)
		Character*12	Str
		Real*8		Val
		
		Call CenterString( '--- Testing IRAD50 ---\' )
		Call WriteLn
		Call CenterString( 'Converts ascii to radix-50 w/o result codes\')
		Call WriteLn
		TstIrad50 = 0

		res = Irad50( 3, 'ABC', Result )
		IF (result .ne. 1683) THEN
			Call MtFail( 'convrt', 1 )
			Call Write2Int( 1683,   10 )
			Call Write2Int( result, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**1
		END IF
		IF (res .ne. 3) THEN
			Call MtFail( 'chrcnt', 2 )
			Call Write2Int( 3,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**2
		END IF

		res = Irad50( 3, 'CBA', result )
		IF (result .ne. 4881) THEN
			Call MtFail( 'convrt', 3 )
			Call Write2Int( 4881,   10 )
			Call Write2Int( result, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**3
		END IF
		IF (res .ne. 3) THEN
			Call MtFail( 'chrcnt', 4 )
			Call Write2Int( 3,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**4
		END IF

		res = Irad50( 6, 'ABCCBA', rsl )
		IF ((rsl(2) .ne. 4881).or.(rsl(1) .ne. 1683)) THEN
			Call MtFail( 'convrt', 5 )
			srl(1) = 1683
			srl(2) = 4881
			Call WriteInt( srl, 10 )
			Call WriteInt( rsl, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**5
		END IF
		IF (res .ne. 6) THEN
			Call MtFail( 'chrcnt', 6 )
			Call Write2Int( 6,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**6
		END IF

		res = Irad50( 7, 'ABC!CBA', rsl )
		IF (rsl(1) .ne. 1683) THEN
			Call MtFail( 'convrt', 7 )
			Call Write2Int( 1683,   10 )
			Call Write2Int( rsl(1), 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**7
		END IF
		IF (res .ne. 3) THEN
			Call MtFail( 'chrcnt', 8 )
			Call Write2Int( 6,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**8
		END IF

		Call Irad50( 12, 'ABCDEFGHIJKL', Val )
		Call R50Asc( 12, Val, Str )
		IF (Str .ne. 'ABCDEFGHIJKL') THEN
			Call MtFail( 'convrt', 9 )
			Call WriteString( 'ABCDEFGHIJKL\', 0, 10 )
			Call WriteString( Str,             0, 10 )
			Call WriteLn
			TstIrad50 = TstIrad50 + 2**9
		END IF

		Call TestFail( TstIrad50 )

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

	END

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

C---------------------------------- R50ASC -----------------------------------

	Function TstR50asc

		Integer*4	TstR50asc
		Integer*2	res, rsl(2), srl(2)
		Character*12	Str
		Character*3	Tst
		Character*6     Tst2
		Real*8		Val

		Call CenterString( '--- Testing R50ASC ---\' )
		Call WriteLn
		Call CenterString( 'Converts radix-50 to ascii w/o result codes\')
		Call WriteLn
		TstR50asc = 0

		Call R50asc( 3, 1683, Tst)
		IF (Tst .ne.'ABC') THEN
			Call MtFail( 'convrt', 1 )
			Call WriteString( 'ABC\', 0, 10 )
			Call WriteString( Tst,    0, 10 )
			Call WriteLn
			TstR50asc = TstR50asc + 2**1
		END IF

		Call R50asc( 3, 4881, Tst )
		IF (Tst .ne. 'CBA') THEN
			Call MtFail( 'convrt', 2 )
			Call WriteString( 'ABC\', 0, 10 )
			Call WriteString( Tst,    0, 10 )
			Call WriteLn
			TstR50asc = TstR50asc + 2**2
		END IF

		srl(1) = 4881
		srl(2) = 1683
		Call R50asc( 6, srl, Tst2 )
		IF (Tst2 .ne. 'CBAABC') THEN
			Call MtFail( 'convrt', 3 )
			Call WriteString( 'CBAABC\', 0, 10 )
			Call WriteString( Tst2,      0, 10 )
			Call WriteLn
			TstR50asc = TstR50asc + 2**3
		END IF

		Call Irad50( 12, '123456789ZXY', Val )
		Call R50Asc( 12, Val, Str )
		IF (Str .ne. '123456789ZXY') THEN
			Call MtFail( 'convrt', 4 )
			Call WriteString( '123456789ZXY\', 0, 10 )
			Call WriteString( Str,             0, 10 )
			Call WriteLn
			TstR50asc = TstR50asc + 2**4
		END IF

		Call R50asc( 6, 13061967, Tst2 )
		IF (Tst2 .ne. 'L$W D9') THEN
			Call MtFail( 'convrt', 5 )
			Call WriteString( 'ABC\', 0, 10 )
			Call WriteString( Tst2,   0, 10 )
			Call WriteLn
			TstR50asc = TstR50asc + 2**5
		END IF

		Call TestFail( TstR50asc )

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

	END

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

C------------------------------------ RAD50 ----------------------------------

	Function Tstrad50

		Integer*4	TstRad50
		Integer*4	Rad50, res

		Call CenterString( '--- Testing RAD50 ---\' )
		Call WriteLn
		Call CenterString( 'Converts 6 byte ascii to real*4 radix-50 output\')
		Call WriteLn
		TstRad50 = 0

		res = Rad50( 'L$W D9' )
		IF (res .ne. 13061967) THEN
			Call MtFail( 'convrt', 1 )
			Call WriteInt( 13061967, 10 )
			Call WriteInt( res,      10 )
			Call WriteLn
			Tstrad50 = tstRad50 + 2**1
		END IF
			
		res = Rad50( 'RT 11$' )
		IF (res .ne. -961317984) THEN
			Call MtFail( 'convrt', 2 )
			Call WriteInt( -961317984, 10 )
			Call WriteInt( res,        10 )
			Call WriteLn
			Tstrad50 = tstRad50 + 2**2
		END IF

		res = Rad50( 'LEHNVA' )
		IF (res .ne. 1525763024) THEN
			Call MtFail( 'convrt', 3 )
			Call WriteInt( 1525763024, 10 )
			Call WriteInt( res,        10 )
			Call WriteLn
			Tstrad50 = tstRad50 + 2**3
		END IF

		Call TestFail( TstRad50 )

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

	END

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