Directory of image this file is from
This file as a plain text file

	COMMON IDATA
	DIMENSION IPA(2),ISET(9),ICODE(180),NN(12),NC(12)
	DIMENSION DATA(12),NNS(3,5),NCS(3,5),DATS(3,5),IDATA(800)
	DO 10 I=1,3
	DO 11 J=1,5
	NNS(I,J)=0
	NCS(I,J)=0
 11	DATS(I,J)=0.
	DO 10 J=1,2
	DO 10 K=1,2
	JKI=(I-1)*4+(J-1)*2+K
	NN(JKI)=0
	NC(JKI)=0
10	DATA(JKI)=0.
	IPA(1)=-1
	IPA(2)=0
	DO 1 I=1,9
1	ISET(I)=I
	DO 2 I=1,180
2	ICODE(I)=I-1
	CALL SRAND
	READ(1,200)ITON,ITOFF,IDEL,ITOUT,IRAN
200	FORMAT(I5)
	DO 3 I=1,IRAN
3	J=IRAND(0)
	NEXT=0
	DO 80 NS=1,3
	CALL SHUF1(ICODE,1,180,1)
S	CLA;6132;TAD (2100;6132;TAD (-144;6133
	DO 20 N=1,180
	CALL SHUF1(ISET,1,9,1)
	NO=ICODE(N)
	I1=NO/90
	NO=NO-I1*90
	I2=NO/45
	NO=NO-I2*45
	I3=NO/15
	II3=I3
	I3=I3*2+1
	IF(I2)21,21,22
 22	NO=NO-15*II3
	I4=NO/(15/I3)+1
21	CONTINUE
	I1=I1+1
	I2=I2+1
	GO TO(23,24),I1
23	ITEST=IPA(I2)
	GO TO 19
24	ITEST=ISET(I3+1)
	IF(I2-2)19,28,19
28	ITEST=ISET(I4)
19	CONTINUE
S	6141;1000;1;2;DCA SAVE1
S	6135
S	WW, 6135;SMA CLA;JMP WW
	DO 1100 III=1,I3
	J=ISET(III)
	DO 1050 K=1,ITON
S	JMS SYNC;JMS SHOW
 1050	CONTINUE
	DO 1060 K=1,ITOFF
S	JMS SYNC
 1060	CONTINUE
 1100	CONTINUE
	DO 1150 K=1,IDEL
S	JMS SYNC
 1150	CONTINUE
	J=ITEST
S	6314
	DO 1200 K=1,ITOUT
S	JMS SYNC;JMS SHOW
S	6316
S	SZA
S	JMP RESP
 1200	CONTINUE
	IRESP=-1
	LAT=ITOUT
	GO TO 1300
S	RESP, TAD (-1000
S	SZA CLA;IAC;DCA \IRESP
	LAT=K
 1300	CONTINUE
S	6141;61
S	SAVE1,0
S	2
	KK=ITI-LAT
	DO 1400 K=1,KK
S	JMS SYNC
 1400	CONTINUE
	GO TO 1500
S	R,0
S	SHOW,0
S	CLA CLL;TAD \J;RAL;TAD ADPWS;TAD (-1;DCA 10
S	TAD I 10;DCA PW1;TAD I 10;DCA PW2;6141;61;374
S	1760
S	PW1,0
S	1760
S	PW2,0
S	2;CLA CLL;JMP I SHOW
S	SYNC,0
S	CLA;6135;SPA CLA;HLT
S	W1,  6135
S	SMA CLA;JMP W1
S	JMP I SYNC
S	ADPWS,PWS
S	404	/"-" PWS
S	404
S	PWS, 1212	/"=" PWS
S	1212
S	2101;177	/"1"
S	4523;2151
S	4122;2651
S	2414;477
S	5172;651
S	1506;4225
S	4443;6050
S	5126;2651
S	5120;3651	/"9"
1500	WRITE(1,100)N,I1,I2,I3,I4,IRESP,LAT
100	FORMAT(I3,I2,3I1,I2,I5)
	NEXT=NEXT+1
	IDATA(NEXT)=ICODE(N)+1+1000*IRESP
	NEXT=NEXT+1
	IDATA(NEXT)=LAT
	IF(NS-1)30,31,30
 31	IF (N-40) 20,9,20
 30	I3=I3/2+1
	IJK=(I1-1)*4+(I2-1)*2+I3
	NN(IJK)=NN(IJK)+1
	IF(IRESP+1-I2)20,34,20
 34	NC(IJK)=NC(IJK)+1
	DATA(IJK)=DATA(IJK)+FLOAT(LAT)
	IF(2*I1+I2-6)20,35,20
 35	NNS(I3,I4)=NNS(I3,I4)+1
	IF(IRESP+1-I2)20,36,20
36	NCS(I3,I4)=NCS(I3,I4)+1
	DATS(I3,I4)=DATS(I3,I4)+FLOAT(LAT)
20	CONTINUE
 9	PAUSE
 80	CALL OPEN
	DO 50 I=1,2
	DO 50 J=1,2
	DO 50 K=1,3
	IJK=(I-1)*4+(J-1)*2+K
50	DATA(IJK)=DATA(IJK)/FLOAT(NC(IJK))
	DO 51 I=1,3
	II=I*2-1
	DO 51 J=1,II
 51	DATS(I,J)=DATS(I,J)/FLOAT(NCS(I,J))
	WRITE(1,110)NC,DATA,((NCS(I,J),J=1,5),I=1,3)
	WRITE(1,113)((DATS(I,J),J=1,5),I=1,3)
 113	FORMAT(//3(5F10.0/))
 110	FORMAT(4(3I10/)//4(3F10.0/)///3(5I10/)//3(5F10.0/))
	WRITE(1,111)
 111	FORMAT(//'ENTER BLOCK #, UNIT 1, TO SAVE DATA')
	READ(1,112)IBLK
 112	FORMAT(I4)
S	TAD \IBLK;TAD (4000;DCA INBLK1;TAD INBLK1;IAC;DCA INBLK2
S	TAD INBLK2;IAC;DCA INBLK3;TAD INBLK3;IAC;DCA INBLK4
S	6141;644
S	714; INBLK1,0
S	714; INBLK2,0
S	714; INBLK3,0
S	714; INBLK4,0
S	2;CLA CLL
	STOP
	END