PROGRAM WRTQ

C	THIS PROGRAM WILL WRITE MESSAGES TO THE QUEUE.  THE SEQUENCE
C	IS GENERATED BY THE RANDOM FUNCTION 'RAN'.  AS LONG
C	AS THE SAME SEED IS USED, THE SAME SEQUENCE OF NUMBERS (AND 
C	THE SAME SEQUENCE OF WRITES) IS GENERATED EACH TIME.  PROGRAM
C	'RAND' WILL PRINT THE SEQUENCE OF WRITES.  IT WILL PROMPT FOR
C	THE SEEDS.  THESE MUST BE THE SAME AS THE SEEDS ENTERED IN
C	THIS PROGRAM.

	PARAMETER	ZLUN = 1	! ZQ: DEVICE LUN
	PARAMETER	ZEFN = 1	! EFN FOR I/O SYNC TO ZQ:
	PARAMETER	MAXMSG = 50	! MAX NUMBER OF MESSAGES TO WRITE
					!   BEFORE EXIT

	INTEGER * 2	WRITEQ		! FUNCTION VALUE
	INTEGER * 2	STATUS		! RETURN STATUS
	BYTE		BSTAT(2)
	EQUIVALENCE	(STATUS,BSTAT)
	INTEGER * 2	ITYPE		! MESSAGE TYPE
	INTEGER * 2	BUFSIZ(8)	! ARRAY OF MESSAGE SIZES
	CHARACTER*16	MESGID		! MESSAGE ID
	BYTE		BUFFER(4000)	! MESSAGE BUFFER
	INTEGER * 2	IBLKS		! NUMBER OF BLOCKS MESSAGE WILL USE
	INTEGER * 2	ISEED1,ISEED2	! SEEDS FOR RANDOM FUNCTION; ENTERED
					!   BY USER
	REAL * 4	RES1,RES2	! RESULTS RETURNED FROM RANDOM FUNCTION
	INTEGER * 2	MSGTYP		! DESIRED MESSAGE TYPE ENTERED BY USER
	INTEGER * 2	MSGCNT		! NUMBER OF MESSAGES WRITTEN TO QUEUE
			
	DATA	BUFSIZ	/400,900,1400,1900,2300,2900,
	1		 3400,4000/	! MESSAGE SIZES 

	DATA	MESGID	/'TEST30'/

	DATA	BUFFER	/250*'A',250*'1',250*'B',250*'2',
	1		 250*'Y',250*'8',250*'Z',250*'9',
	1		 250*'Y',250*'8',250*'Z',250*'9',
	1		 250*'A',250*'1',250*'B',250*'2'/

	WRITE (5,1000)
1000	FORMAT('$ENTER ''BLOCK SIZE OF MSG'' RANDOM SEED USED IN ',
	1      '''WRTQ'' > ')
	READ  (5,1010,END=2000) ISEED1
1010	FORMAT(I3)
	WRITE (5,1020)
1020	FORMAT('$ENTER ''MESSAGE TYPE'' RANDOM SEED USED IN ''WRTQ'' > ')
	READ  (5,1030,END=2000) ISEED2
1030	FORMAT(I3)
	WRITE (5,1040)
1040	FORMAT(' ENTER ''0'' FOR ONLY TYPE 0 MESSAGES,'
	1      /'       ''1'' FOR ONLY TYPE 1 MESSAGES,'
	2      /'$      ''2'' FOR BOTH TYPES OF MESSAGES > ')
	READ  (5,1050,END=2000) MSGTYP
1050	FORMAT(I1)

	MSGCNT = 0

5	CONTINUE
	
	RES1 = RAN(ISEED1)		
	IBLKS = RES1 * 10.0		! CALC BLOCK SIZE OF MESG
	IF (IBLKS.EQ.0) THEN
		IBLKS = 1
	ELSE IF (IBLKS.EQ.9) THEN
		IBLKS = 8
	END IF

	IF (MSGTYP.EQ.0) THEN		! CALC TYPE OF MESSAGE
		ITYPE = 0
	ELSE IF (MSGTYP.EQ.1) THEN
		ITYPE = 1
	ELSE 
		RES2 = RAN(ISEED2)
		IF (RES2.LT.0.5) THEN 
			ITYPE = 0
		ELSE
			ITYPE = 1
		END IF
	END IF

	STATUS = WRITEQ(ZLUN,ZEFN,MESGID,BUFFER,
	1		BUFSIZ(IBLKS),ITYPE)

	IF (STATUS.NE."401) THEN
		TYPE *,' '
		TYPE *,' BAD QUEUE STATUS ON WRITE'
		TYPE *,' DIRECTIVE STATUS: ',BSTAT(1)
		TYPE *,' I/O STATUS: ',BSTAT(2)
	END IF			

	MSGCNT = MSGCNT + 1
	IF (MSGCNT.LT.MAXMSG) GOTO 5
	
2000	CONTINUE
	END