C	PROGRAM BNDSTAT.FT
C	----------------
C
C
C	#### SUBROUTINE BNDSTAT(KFREQ)
C
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	OCT 11, 1977
C	JULY 6, 1977
C	JUNE 29, 1977
C
C
C
C	INTRODUCTION
C	------------
C	PRINT THE [6] SECTION BNDPRINT OUTPUT.
C	CONSISTING OF
C
C	1. BENDING ENERGY
C
C	2. CHAIN CODE AND CHAIN CODE DIFFERENCE HISTOGRAMS
C
C	3. 0X90 RLM SEM DISTRIBUTION
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	ISZI	2400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
C	USE OF IBUFi
C	------------
C	IBUF1[1:8] - CHAIN CODE HISTOGRAM
C	IBUF1[10:19] - CHAIN CODE DIFFERENCE HISTOGRAM
C	IBUF1[21:28] - AVG CHAIN CODE HISTOGRAM
C	IBUF1[30:39] - AVG CHAIN CODE DIFF HIST.
C
C	IBUF2[1:689] - SEMANTIC LABEL TEST ARRAY
C
	DIMENSION KNAME(3)
	EQUIVALENCE(KNAME,PNAME)
C
S	DUMMY KFREQ
S	DUMMY CDUM
S	CPAGE 4
S KFREQ,	BLOCK 2
S CDUM,	BLOCK 2
C
C
C	[0] SETUP GET THE ARG
S	ENTRY BNDST
S	CPAGE 2
S BNDST,	BLOCK 2
S	TAD I BNDST
S	DCA KFREQ
S	TAD KFREQ
S	DCA CDUM
S	INC BNDST#
C
S	TAD I BNDST
S	DCA KFREQ#
S	INC BNDST# /SETUP RETURN
C
C
C
C	[1] PRINT BENDING ENERGY
	WRITE(3,387)CURSYM
387	FORMAT(9X,'BENDING ENERGY=',F9.3)
C
C
C	[2] PRINT CHAIN CODE HISTOGRAMS
	BP=0.0
C	IF NOT /B
C		THEN PRINT HISTOGRAMS
S	TAD \ISW# /"/B"
S	SZA CLA
S	JMP \2047 /NO
C
	DO 384 I=1,9
	IX=I-1
	IY=-5+I
	ICC=IBUF1(I)
	BP=BP+FLOAT(ICC)
384	WRITE(3,381)IX,ICC,IY,IBUF1(I+9)
381	FORMAT(' CHAIN CODE[',I1,']=',I5,', CHAIN DIFF[',I2,']=',I5)
C
C
C	IF NOT /F
C		THEN PRINT HEADER!
	IFSW=ISW(6)
S	TAD \IFSW
S	SZA CLA
S	JMP \444 /NO
	DO 1500 I13=1,3
	DO 1500 I12=1,2
C	COPY LETTER TO PRINT (IN 6 LINES) INTO IBUF1(I10)
	DO 1501 I10=1,26
	I=(I10-1)*3+(I13-1)
S	TAD \I
S	TAD PTABLE
S	DCA 7
S	TADI 7
S	MQL
S	CLA CMA
S	TAD \I12  /LEFT OR RIGHT BYTE?
S	CLL RAR /BIT 11 ==>LINK (2=LINK)
S	MQA /GET A2 WORD
S	SZL
S	BSW /MOVE 2ND BYTE TO A1 POSITION
S	DCA \I
1501	IBUF1(I10)=I
1500	WRITE(3,385)(IBUF1(I),I=1,26)
385	FORMAT(15X,26(A1,1X))
	GOTO 500
C
C	PRINT RUN LENGTH FREQUENCY DISTR. HEADER
444	WRITE(3,445)
445	FORMAT(15X,'SEM LABEL (0 DEG) RUN LENGTHS DISTRIBUTION.'
     1,/,7X,'NDR\LTH 1',16X,'10',17X,'20')
C
C
C	[3] PRINT RLM SEM 0X90 JOINT DISTR.
C	PRINT MATRIX BY ROW
500	DO 382 I=1,26
C	COPY: IBUF1[1:26]<==KFREQ[I,1:26]
	DO 388 J=1,26
	K=(J-1)*27+(I-1)
S	TAD \K
S	TAD KFREQ#
S	DCA CDUM#
S	TAD I CDUM
S	DCA \K
388	IBUF1(J)=K
C
C	GET SYMBOL
S	CLA CMA
S	TAD \I
S	DCA \IZ
S	TAD \IZ
S	CLL RAL
S	TAD \IZ /MULT BY 3
S	TAD PTABLE
S	TAD (-1
S	DCA 11 
S	TAD I 11
S	DCA \KNAME
S	TAD I 11
S	DCA \KNAME#
S	TAD I 11
S	DCA \IZ
	KNAME(3)=IZ
382	WRITE(3,383)I,PNAME,(IBUF1(J),J=1,26)
383	FORMAT(' ',I3,' [',A6,']=',26I2)
C
C	IF /F THEN DONE
S	TAD \IFSW
S	SZA CLA
S	JMP \2047 /DONE
C
C
C	[4] COMPUTE AND PRINT GLOBAL STATISTICS
C	SET SC TO GIVE AS % OF TOTAL BOUNDARY POINTS (NOTE BP=1/2 TOT P)
	SC=100.0/(2.0*BP)
C
	ICPRUN=0
	IEXRUN=0
	IHAIR=0
	IMPRUN=0
	MRGRUN=0
	ISPRLRUN=0
C
C	DO SEARCH FOR ALL OCCURANCES
	DO 400 J=1,26
C
	DO 401 I=3,6
S	JMS GK090
401	ICPRUN=ICPRUN+ISUM
C
	DO 402 I=9,12
S	JMS GK090
402	IEXRUN=IEXRUN+ISUM
C
	I=13
S	JMS GK090
	IHAIR=IHAIR+ISUM
C
	DO 403 I=14,17
S	JMS GK090
403	IMPRUN=IMPRUN+ISUM
C
	DO 404 I=19,20
S	JMS GK090
404	MRGRUN=MRGRUN+ISUM
C
	DO 405 I=23,26
S	JMS GK090
405	ISPRLRUN=ISPRLRUN+ISUM
400	CONTINUE
C
C
C	[4.1] COMPUTE AS %
	CPRUN=FLOAT(ICPRUN)*SC
	EXRUN=FLOAT(IEXRUN)*SC
	HAIR=FLOAT(IHAIR)*SC
	FIMPRUN=FLOAT(IMPRUN)*SC
	FMRGRUN=FLOAT(MRGRUN)*SC
	SPRLRUN=FLOAT(ISPRLRUN)*SC
C
C
C	[4.2] PRINT STATISTICS
	WRITE(3,490)CPRUN,EXRUN,HAIR,FIMPRUN,FMRGRUN,SPRLRUN
490	FORMAT(/,' % RUN COMPLET.=',F7.2,/,' % RUN EXTENS.= ',F7.2
     1,/,' % HAIRS=',7X,F7.2,/,' % IMP. SPLITS= ',F7.2
     2,/,' % MERGES=',6X,F7.2,/,' % SPIRALS=',5X,F7.2)
C
C
C	[999] RETURN
S\2047,	RETRN BNDST
C	****************************************************
C	*SUBROUTINE    G K 0 9 0
C	****************************************************
C	COMPUTE BOTH POINTS ON (I,J) AND RETURN IN ISUM
S	CPAGE 3
S RGK090,	JMP I GK090
S GK090,	0
C
	K=(J-1)*27+(I-1)
C	COMPUTE: ISUM=KFREQ(K)
S	TAD \K
S	TAD KFREQ#
S	DCA CDUM#
S	TAD I CDUM
S	DCA \ISUM
C
	K=(I-1)*27+(J-1)
C	COMPUTE: ISUM=KFREQ(K)+ISUM
S	TAD \K
S	TAD KFREQ#
S	DCA CDUM#
S	TAD I CDUM
S	TAD \ISUM
S	DCA \ISUM
C
S	JMP RGK090
C************** P A R A M E T E R S *************
S PKNAME,	\KNAME
S PIBUF1,	\IBUF1
S PIBUF2,	\IBUF2
S PTABLE,	TABLE
C
S	CPAGE 121
S TABLE,	BLOCK 0
S	TEXT /CGLHSP/
S	TEXT /CGRHSP/
S	TEXT /CPALFT/
S	TEXT /CPARHT/
S	TEXT /CPNLFT/
S	TEXT /CPNRHT/
S	TEXT /CMPUNY/
S	TEXT /DUP-PT/
S	TEXT /EXALFT/
S	TEXT /EXARHT/
S	TEXT /EXNLFT/
S	TEXT /EXNRHT/
S	TEXT /HAIREP/
S	TEXT /IMPLFT/
S	TEXT /IMPRHT/
S	TEXT /IMPLFH/
S	TEXT /IMPRHH/
S	TEXT /INCDPT/
S	TEXT /MRGLFT/
S	TEXT /MRGRHT/
S	TEXT /NEWRUN/
S	TEXT /NULPNT/
S	TEXT /SPCW*L/
S	TEXT /SPCW*R/
S	TEXT /SPCCWL/
S	TEXT /SPCCWR/
S	TEXT /NULOVF/
	END
 