BYTE LFCR(2),UIC(6),NAME(18),IFL(200)
	BYTE NID(12),IBEG(6),IEND(6)
	DIMENSION IST(2),IR(6),IL(60),IP(200)
	EQUIVALENCE(UIC(6),NAME(1))
	EQUIVALENCE (IL,IFL)
	DATA IBEG/'7','7','7','B','E','G'/
	DATA IEND/'7','7','7','E','N','D'/
	DATA NID/4*' ','R','U','N','I','D',' ','*',' '/
	DATA MM,MMREAD,MMWRIT,MMREW,MMREWU,MMEOF,MMATT,MMSMO,IS16
     * /'MM',"1000,"400,"2400,"2540,"3000,"1400,"2560,"4000/
	DATA UIC/'[','5',',','5',']',' '/
	DATA LFCR/"12,"14/
	IOUT=2
	IPR=5
	INDX=4
	LUN=3
	CALL GETADR(IR,IP)
	OPEN(UNIT=LUN,NAME='PLOT.LST',CARRIAGECONTROL='NONE',
     *	TYPE='NEW',ERR=995)
	CALL GETMCR(NAME,LEN)
	TYPE 930,(NAME(I),I=1,LEN)
  930	FORMAT(' ',80A1)
	CALL ERRSET(31,.TRUE.,.FALSE.,.TRUE.,.FALSE.,500)
	NAME(LEN+1)=0
	CALL WTQIO(MMATT,IOUT,6,50,IST,IR,IDS)
	CALL ASNLUN(IOUT,MM,0,IDS)
    2	OPEN(UNIT=1,NAME=NAME(5),TYPE='OLD',ERR=999)
	EOF=0
	ILINE=0
    5 READ(1,60,END=94)IQ,(IFL(I),I=1,IQ)
    	WRITE(LUN,61)(IFL(I),I=1,IQ)
	ILINE=ILINE+1
	IF(ILINE.LT.25)GO TO 7
	DO 8 I=1,12
	IF(IFL(I).NE.NID(I))GO TO 7
    8	CONTINUE
	TYPE 901,(IFL(I),I=13,18,1)
  901	FORMAT(' RUNID FOR THIS PLOT JOB IS ',6A1)
	GO TO 5
    7	DO 6 IAAA=1,6
	IF(IFL(IAAA+1).NE.IBEG(IAAA))GO TO 5
    6	CONTINUE
   10	WRITE(LUN,61)(IFL(I),I=1,IQ)
   	TYPE 903
	ACCEPT 904,TAPE
  903	FORMAT('$ENTER TAPE NUMBER:')
  904	FORMAT(1A4)
	IF(TAPE.EQ.'-   ')GO TO 97
	IF(TAPE.EQ.'MORE')GO TO 5
	CALL WTQIO(MMREW,IOUT,6,50,IST,IR,IDS)
	IF(IST(1).LT.1)
     * TYPE 902,IST,IST
	IF(IST(1).LT.1)STOP ' TOOBAD!'
  902	FORMAT(' TAPE REWIND ERROR =',2O7,2I7)
	CALL WTQIO(MMSMO,IOUT,6,50,IST,IS16,IDS)
	WRITE(LUN,905)LFCR(1),TAPE,LFCR
  905	FORMAT(1A1,' TAPE NUMBER FOR THIS PLOT IS **** ',1A5,' ****',2A1)
	ICOUNT=0
	IPLOTS=IPLOTS+1
   13	IND=0
	DO 990 I=1,183
  990	IP(I)=0
	I=-77
	CALL STORE3(IP,I)
	DO 20 INC=1,9
    3	READ(1,60,END=1318)IQ,IAA,(IFL(III),III=1,(IQ-1))
   60 FORMAT(Q,200A1)
   61	FORMAT(200A1)
	IF(IQ.LT.5)GO TO 3
	IF(INC.NE.1)GO TO 14
	IF(IQ.NE.9)GO TO 14
	DO 12,I=1,6
	IF(IFL(I).NE.IEND(I))GO TO 1319
   12	CONTINUE
	GO TO 95
   14	CONTINUE
	IF(INC.EQ.9.AND.IQ.NE.39)GO TO 1319
	IQ=(IQ-2)/2
	DO 19 I=1,IQ,2
	K=(IL(I))
	K=IAND(K,"3407)
	J=IAND(K,7)
	CALL STORE3(IP,J)
	J=ISHFT(K,-8)
	CALL STORE3(IP,J)
	M=(IL(I+1))
	M=IAND(M,"3407)
	N=IAND(M,7)
	CALL STORE3(IP,N)
	N=ISHFT(M,-8)
	CALL STORE3(IP,N)
   19	CONTINUE
   20 CONTINUE
	ICOUNT=ICOUNT+1
	IR(2)=376
	IF(ICOUNT.EQ.1)IR(2)=360
	CALL WTQIO(MMWRIT,IOUT,6,50,IST,IR,IDS)
	IF(IST(1).EQ.1)GO TO 13
      TYPE 906,IST
  906	FORMAT(' WRITE ERROR ON TAPE=',2O7)
		TYPE 907
  907	FORMAT(' LOAD A GOOD TAPE WITH WRITE RING..')
	CALL WTQIO(MMREWU,IOUT,6,50,IST,IR,IDS)
	CLOSE(UNIT=1)
	GO TO 2
   90	FORMAT(20O3)
   50	STOP
   95	TYPE 1313,ICOUNT
	WRITE(LUN,1313)ICOUNT
 1313 FORMAT(' PLOT COMPLETED...',1I5,' RECORDS WRITTEN.')
  96	CALL WTQIO(MMEOF,IOUT,6,50,IST,IR,IDS)
	CALL WTQIO(MMREWU,IOUT,6,50,IST,IR,IDS)
	GO TO 97
   94	EOF=77
   97  IF(EOF.NE.77)GO TO 5
	CLOSE(UNIT=1)
	STOP
  520	IFILES=IFILES-1
	CLOSE(UNIT=LUN)
	TYPE 920,INUMBR,IPLOTS
  920	FORMAT(1I5,' FILES READ, AND',1I5,' PLOT FILES WRITTEN.')
	STOP
C 999	TYPE 1010,(O(I),I=1,40)
C1010	FORMAT(4(' ',10O3/))
C	GO TO 13
  999 TYPE 1390,(UIC(I),I=1,(INL))
 1390	FORMAT(' CANT OPEN INPUT FILE ',30A1)
	STOP
  499	STOP ' COULDNT OPEN PLOT FILE INDEX.'
 1318	EOF=77
 1319	WRITE(LUN,925)INC,IQ
  925	FORMAT(' ERROR ON INPUT FILE...','INC=',1I2,'IQ=',I13)
	WRITE(LUN,926)IAA,(IFL(I),I=1,(IQ-1))
  926	FORMAT(' RECORD IS',/' ',130A1)
	GO TO 96
  500	TYPE 931,(NAME(I),I=1,LEN)
  931	FORMAT(' ERRSET ERROR ',50A1)
	STOP
  995	STOP ' CANT OPEN PRINT FILE'
	END