C*****************************************************************************
C
C                         Forground Job Test Package
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: Partner/ Prtnr.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=============================== Procedures =================================)
C----------------------------------------------------------------------------)

C--------------------------------- GetMess ----------------------------------)

	Function GetMess
		
		Integer*2	mess(2), GetMess, res, cnt

		cnt = 0
		mess(1) = 0
		mess(2) = 1

10		res = IrcvdW( mess, 1 )
		IF ((cnt .lt. 20).and.(res .ne. 0)) THEN
			cnt = cnt + 1
			Call Isleep( 00,00,02,00 )
			Goto 10
		END IF
		
		IF (res .ne. 0) Then
			Stop 'Fatal Error! : Timeout On No Background Job'
		END IF

		IF (mess(1) .ne. 1) Then
			Stop 'Fatal Error! : Communications Failure'
		END IF
		
		GetMess = mess(2)

	End

C----------------------------------------------------------------------------)
	
C-------------------------------- SendMess ----------------------------------)

	Subroutine SendMess( mess )
		
		Integer*2	mess, res

		res = IsdatW( mess, 1 )
		
		IF (res .ne. 0) Stop 'Fatal Error! : No Background Job'

	End

C----------------------------------------------------------------------------)

C---------------------------------- FileO -----------------------------------)

	Subroutine Fileo
	
		Integer*2	Ichan
		Real*8		Spec

		Ichan = Igetc()
		Call Irad50( 12, 'DATTEST02TXT', Spec )
		Call Closec( Ichan )
		Call Lookup( Ichan, Spec )
		Call SendMess( Ichan )

	END

C----------------------------------------------------------------------------)

C---------------------------------- FileC -----------------------------------)

	Subroutine Filec
	
		Integer*2	mess, GetMess

		mess = GetMess()
		Call Closec( mess )
		Call Ifreec( mess )
		Call SendMess( 55 )

	END

C----------------------------------------------------------------------------)

C---------------------------------- SendN -----------------------------------)

	Subroutine SendN
	
		Integer*2	n, Buff( 20 ), res, i, GetMess

		n = GetMess()
		IF (n .gt. 20) n = 20

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

		res = IsdatW( Buff, n )

		IF (res .eq. 0) THEN
			Call SendMess( 0 )
		ELSE
			Call SendMess( -1 )
		END IF

		IF (res .ne. 0) Stop '- Fatal Error : No background job'

	END

C----------------------------------------------------------------------------)

C---------------------------------- RecvN -----------------------------------)

	Subroutine RecvN
	
		Integer*2	mss, Buff( 21 ), i
		Logical*2	flag

		Call Ircvdw( buff, 20 )
		mss = Buff(1)
		IF (mss .gt. 20) mss = 20
		Flag = .FALSE.
		DO 10 i = 1, mss
			IF (Buff( i+1 ) .ne. i) Flag = .TRUE.
10		Continue
		
		IF (Flag) THEN
			Call SendMess( -1 )
		ELSE
			Call SendMess( 0 )
		END IF

	END

C----------------------------------------------------------------------------)

C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||)
C                             Main Code Of Job				     )
C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||)

	Program Prtnr

C------------------------- Declaration of Variables -------------------------)

	Integer*2	Index, GetMess

C----------------------------------------------------------------------------)

C	Begin

		Call IQset( 6 )

5		Index = GetMess()
		
		Goto (10,20,30,40,50,60,70,80,90,100), Index
		Goto 1000

C		Case Index OF

10			Goto 9999

20			Call Lock
			Call SendMess( 25 )
			Goto 5

30			Call Unlock
			Call SendMess( 35 )
			Goto 5

40			Call FileO
			Goto 5

50			Call FileC
			Goto 5

60			Call SendN
			Goto 5

70			Call RecvN
			Goto 5

80			Call SendMess( 0 )
			Goto 5

90			Call SendMess( 0 )
			Goto 5

100			Call SendMess( 105 )
			Goto 5

C		Else

1000			Call SendMess( -1 )
			Goto 5

C		End Case

9999	End

C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||)
C----------------------------------------------------------------------------)
C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||)