C	PROGRAM JGST2.FT
C	----------------
C
C
	SUBROUTINE JGST2(QQ0,JKX1,JKX2,JKY1,JKY2,JOUTSP,JD)
C
C
C	PETER LEMKIN
C	IMAGE PROCESSING UNIT, DCBD
C	NATIONAL CANCER INSTITUTE
C	NATIONAL INSTITUTES OF HEALTH
C	9000 ROCKVILLE PIKE
C	BETHESDA, MD. 20014
C
C	FEB 26, 1977
C	FEB 15, 1977
C	NOV 22, 1976
C	NOV 19, 1976
C
C
C
C	INTRODUCTION
C	------------
C	JGST2.FT IS A SUBROUTINE USED WITH JGSTXTURE.FT
C
C	COMPUTE STATISTICS
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
	DIMENSION PP0(8,8), PP45(8,8), PP90(8,8), PP135(8,8)
C
C	[1] INIT
C
C	COPY THE PP00, TO PP135 ARRAYS
	DO 50 I=1,256
	PP0(I)=QQ0
S	INC \QQ0#
50	CONTINUE
C
	IDEV=3+JOUTSPOOL
C
C*****DEBUG****
C	PRINT THE PK MATRICES
	WRITE(IDEV,399)PP0,PP45,PP90,PP135
399	FORMAT(1,//,8(' ',8F8.0))
C******************
	KX1=JKX1
	KX2=JKX2
	KY1=JKY1
	KY2=JKY2
	ID=JD
C
C
C
C	[2] COMPUTE MEANS AND SUMS
	DO 201 I=1,8
	FI=I
C
	DO 201 J=1,8
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \2047
	FJ=J
C
C@	COMPUTE (I,J)=K
C@	K=I+(J-1)*8
	P0=PP0(I,J)/64.0
	P45=PP45(I,J)/64.0
	P90=PP90(I,J)/64.0
	P135=PP135(I,J)/64.0
	PSUM=(P0+P45+P90+P135)/4.0
C
C
C	COMPUTE SUMS
	A0=A0+P0
	A45=A45+P45
	A90=A90+P90
	A135=A135+P135
	ASUM=ASUM+PSUM
C
C	COMPUTE I MEANS
	FI0=FI0+FI*P0
	FI45=FI45+FI*P45
	FI90=FI90+FI*P90
	FI135=FI135+FI*P135
	FISUM=FISUM+(FI*P0+FI*P45+FI*P90+FI*P135)/4.0
C
C	COMPUTE J MEANS
	FJ0=FJ0+FJ*P0
	FJ45=FJ45+FJ*P45
	FJ90=FJ90+FJ*P90
	FJ135=FJ135+FJ*P135
	FJSUM=FJSUM+(FJ*P0+FJ*P45+FJ*P90+FJ*P135)/4.0
C
201	CONTINUE
C
C
C
C
C
C	[3] COMPUTE VARIANCES
	DO 301 I=1,8
	FI=I
C
	DO 301 J=1,8
	FJ=J
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \2047
C
C@	COMPUTE: (I,J)=I+(J-1)*8
C@	K=I+(J-1)*8
	P0=PP0(I,J)/64.0
	P45=PP45(I,J)/64.0
	P90=PP90(I,J)/64.0
	P135=PP135(I,J)/64.0
	PSUM=(P0+P45+P90+P135)/4.0
C
C
C	COMPUTE I VARIANCE
	VI0=VI0+((FI-FI0)**2)*P0/A0
	VI45=VI45+((FI-FI45)**2)*P45/A45
	VI90=VI90+((FI-FI90)**2)*P90/A90
	VI135=VI135+((FI-FI135)**2)*P135/A135
	VISUM=VISUM+((FI-FISUM)**2)*PSUM/ASUM
C
C	COMPUTE J  VARIANCE
	VJ0=VJ0+((FJ-FJ0)**2)*P0/A0
	VJ45=VJ45+((FJ-FJ45)**2)*P45/A45
	VJ90=VJ90+((FJ-FJ90)**2)*P90/A90
	VJ135=VJ135+((FJ-FJ135)**2)*P135/A135
	VJSUM=VJSUM+((FJ-FJSUM)**2)*PSUM/ASUM
C
C	COMPUTE IJ  COVARIANCE
	VIJ0=VIJ0+(FJ-FJ0)*(FI-FI0)*P0/A0
	VIJ45=VIJ45+(FJ-FJ45)*(FI-FI45)*P45/A45
	VIJ90=VIJ90+(FJ-FJ90)*(FI-FI90)*P90/A90
	VIJ135=VIJ135+(FJ-FJ135)*(FI-FI135)*P135/A135
	VIJSUM=VIJSUM+(FJ-FJSUM)*(FI-FISUM)*PSUM/ASUM
C
301	CONTINUE
C
C
C
C
C
C
C	[5.1] GET STANDARD DEVIATION
C	COMPUTE I VARIANCE
	SI0=SQRT(VI0)
	SI45=SQRT(VI45)
	SI90=SQRT(VI90)
	SI135=SQRT(VI135)
	SISUM=SQRT(VISUM)
C
C	COMPUTE J  VARIANCE
	SJ0=SQRT(VJ0)
	SJ45=SQRT(VJ45)
	SJ90=SQRT(VJ90)
	SJ135=SQRT(VJ135)
	SJSUM=SQRT(VJSUM)
C
C	COMPUTE IJ  COVARIANCE
	SIJ0=SQRT(VIJ0)
	SIJ45=SQRT(VIJ45)
	SIJ90=SQRT(VIJ90)
	SIJ135=SQRT(VIJ135)
	SIJSUM=SQRT(VIJSUM)
C
C
C
C
C
C	[6] PRINT STATISTICS
	WRITE(IDEV,601)FI0,FI45,FI90,FI135,FISUM
601	FORMAT(' MEANS(I:0;45;90;135;SUM)=',5F9.1)
C
	WRITE(IDEV,602)FJ0,FJ45,FJ90,FJ135,FJSUM
602	FORMAT(' MEANS(J:0;45;90;135;SUM)=',5F9.1)
C
C
	WRITE(IDEV,603)SI0,SI45,SI90,SI135,SISUM
603	FORMAT(' STD DEV.(I:0;45;90;135;SUM)=',5F9.2)
C
	WRITE(IDEV,604)SJ0,SJ45,SJ90,SJ135,SJSUM
604	FORMAT(' STD DEV.(J:0;45;90;135;SUM)=',5F9.2)
C
	WRITE(IDEV,605)SIJ0,SIJ45,SIJ90,SIJ135,SIJSUM
605	FORMAT(' SQRT(COVAR).(IJ:0;45;90;135;SUM)=',5F9.2)
C
2047	RETURN

C	************************************************************
C	SUBROUTINE:	T T Y C T L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RTTYC,	JMP I TTYCTL
S TTYCTL,	0000	/ENTRY
C
S	KSF	/ANYTHING TYPED
S	JMP NORMAL	/NO, RETURN NORMALLY
S	KRB	/GET TYPED CHARACTER
S	AND (0177	/TAKE CARE OF PARITY PROBLEMS
S	TAD (-17	/TEST FOR CTRL/O
S	SNA	/SKIP IF NOT CTRL/O
S	JMP RTTYC	/ABORT CALLING ROUTINE (ERROR RETURN)
S	TAD (-4	/TEST FOR CTRL/S [-17-4=-23(OCTAL)]
S	SZA CLA	/SKIP IF CTRL/S
S	JMP NORMAL	/NOT CTRL/O OR CTRL/S SO RETURN NORMALLY
C
S SLEEP,KSF	/WAIT FOR CTRL/Q
S	JMP SLEEP	/KEEP WAITING
S	KRB	/READ CHARACTER
S	AND (0177
S	TAD (-17	/IS IT A CTRL/O?
S	SNA	/SKIP IF NOT
S	JMP RTTYC	/YES, ABORT
S	TAD (-2	/TEST FOR CTRL/Q (-17-2=-21 OCTAL)
S	SZA CLA	/SKIP IF SO
S	JMP SLEEP	/NOPE, KEEP SLEEPING
C
S NORMAL,INC TTYCTL	/INCREMENT RETURN ADDRESS FOR NORMAL RETURN
S	CLA	/SAFETY VALVE
S	JMP RTTYC	/RETURN
C
C
	END