C	PROGRAM FLKR2.FT
C	----------------
C
C
C	###SUBROUTINE   FLKR2
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	JUNE 19, 1978
C	JUNE 12, 1978
C	JUNE 8, 1978
C	JUNE 7, 1978
C
C
C
C	INTRODUCTION
C	------------
C	ENTER CALIBRATION DATA INTO THE LIST OF CALIBRATION POINTS
C	FOR 1:6 (SKIP POORLY DEFINED POINTS).
C
C	THEN PLOT THE LOG-LOG PLOT IN 512X512 SPACE OF COUNTS/MIN VS
C	TOTAL DENSITY.
C
C	IVAL	FUNCTION
C	----	--------
C	1	INIT CALIBRATION LIST
C	2	ENTER NEXT POINT (INDEX) UP TO 6 POINTS
C	3	CLOSE CALIBRATION INPUT, COMPUTE CAL CURVE
C		--- AND THEN PLOT LOG-LOG OF CNTS/MIN VS TOT DENS
C		DRAWING LEAST SQ ERROR LINE (MX+B) THROUGH IT.
C	4	GIVEN DENSITY IN DMAX, COMPUTEDMIN=M(DMAX)+B
C		TO RETURN COUNTS/MIN.
C	OPDEFS
C	------
S	OPDEF	POSTA	6520
C
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	DAD	7443
S	OPDEF	DCM	7575
S	OPDEF	DST	7445
S	OPDEF	CLAMQ	7621
S	OPDEF	MUY	7405
S	OPDEF	SHL	7413
S	OPDEF	DVI	7407
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
C
	DIMENSION DTOT(6), CNTMIN(6)
C
C	NOTE:  THE SDEVICE[1:2] COMMON VARIABLE IS USED TO
C	SAVE THE STATE OF THE REGRESSION EQUATION COEFFICIENTS (FM,B).
C	[0] ENTRY
S	ENTRY FLKR2
S	CPAGE 2
S FLKR2,	BLOCK 2
C
C
C
C	DISPATCH BY IVAL
	GOTO (100,200,300,400),IVAL
C
C
C	[1] INIT CALIBRATION LIST
C	SAVE MIN COUNT
100	I18=ICNUM
	DO 102 LSNEW=1,3,2
102	WRITE(LSNEW,103)
103	FORMAT(' START CALIBRATION')
C
	DO 101 IZ=1,6
	DTOT(IZ)=1.0
C
C	DEFINE FIXED POINTS
C	IF /M THEN GET CALIBRATION FROM MERRILL TABLE
C	      ELSEIF /F THEN GET CALIB. FROM FREEZE TABLE
C			ELSE GET FROM COMMAND DECODER (MAN*100,EXP).
	I10=ISW(13)
S	TAD \I10 /"/M"
S	SNA CLA
S	JMP \106
C
C	GET FROM MERRILL TABLE
S	CLA CMA
S	TAD \IZ
S	CLL RAL /*2
S	TAD (-1 /FOR AUTOINDEX
S	TAD PMERRILL
S	DCA 11
S	TAD I 11 /MANTISSA
S	MQL
S	TAD I 11 /EXP
S	DCA \I12
S	MQA
S	DCA \I11
	GOTO 104
C
C	TEST /F
106	I10=ISW(6)
S	TAD \I10 /"/F"
S	SNA CLA
S	JMP \107
C
C	GET FROM FREEZE TABLE
S	CLA CMA
S	TAD \IZ
S	CLL RAL /*2
S	TAD (-1 /FOR AUTOINDEX
S	TAD PFREEZE
S	DCA 11
S	TAD I 11 /MANTISSA
S	MQL
S	TAD I 11 /EXP
S	DCA \I12
S	MQA
S	DCA \I11
	GOTO 104
C
C	GET THE TABLE FROM THE CD.:
107	WRITE(1,1017)IZ,
1017	FORMAT(' COUNTS/MIN SAMPLE #',I3)
C	GET FROM COMMAND DECODER AS (MANTISSA*100, EXPONENT)
C	I.E. BCDSPEC
S	CALL 0,BCDSP
C
	I11=ICNUM
S	TAD \ICNUM#
S	DCA \I12
C
C	CVT TO F.P. #
104	FA=(FLOAT(I11)/100.0)*(10.0**I12)
C
101	CNTMIN(IZ)=ALOG(FA)
C
C	RESTORE MIN COUNT
	ICNUM=I18
	GOTO 2047
C	[2] ENTER NEXT POINT (INDEX) UP TO 6 POINTS
200	DTOT(INDEX)=ALOG(DMAX)
	DO 202 LSNEW=1,3,2
202	WRITE(LSNEW,201)INDEX
201	FORMAT(' ENTERED CALIBRATION POINT #',I2)
C
C
C	IF INDEX=6
C		THEN GO COMPUTE REGRESSION
S	TAD (-6
S	TAD \INDEX
S	SNA CLA
S	JMP \300 /GOTO [3] TO COMPUTE REGRESSION
	GOTO 2047
C
C
C	[3] CLOSE CALIBRATION INPUT, COMPUTE CAL CURVE
C		--- AND THEN PLOT LOG-LOG OF CNTS/MIN VS TOT DENS
C		DRAWING LEAST SQ ERROR LINE (MX+B) THROUGH IT.
300	MODECAL=1
C	SET # CAL SAMPLE POINTS
	Z=7-ICNUM
C
C	SET 512X512 CALIBRATION FOR LOG-LOG PLOT!
	DEVICE=30
C
	DO 301 LSNEW=1,3,2
301	WRITE(LSNEW,302)
302	FORMAT(/,' COMPUTING CALIBRATION REGRESSION')
C
C	[3.1] UNPOST K8BIT, AND POST 1-K8BIT
	IBYTE=1-K8BIT
S	TAD \IBYTE
S	SZA CLA
S	TAD (7400 /HIGH BMS
S	TAD (0017 /BM0:3
S	POSTA
C
C
C	[3.2] ZERO BM0:3 IBYTE.
	IBYTE=1-K8BIT
	DO 320 LSNEW=1,4
	MEM=LSNEW-1
S	CALL 7,BMOMN
S	ARG \MEM
S	ARG \IBYTE
S	ARG (0
S	ARG (0
S	ARG (0
S	ARG \IH
S	ARG (4 /"MCOLOR"
320	CONTINUE
C
C
C	[3.3] DRAW DATA POINTS.
	DO 330 INDEX=ICNUM,6
	FA=DTOT(INDEX)
	IX=DEVICE*FA
	FB=CNTMIN(INDEX)
	IY=511.0-DEVICE*FB
C	PRINT THE LOG VALUES
	DO 332 LSNEW=1,3,2
332	WRITE(LSNEW,331)INDEX,FA,EXP(FB),FB
331	FORMAT(' #',I1', LN(DTOT)=',F7.3,,' CNT/MIN=',F11.0
     1', LN(CNT/MIN)=',F7.3)
S	JMS SQUARE
330	CONTINUE
C
C
C	[3.4] DO LINEAR REGRESSION ON DATA
C	SO THAT Yi' = FM*Xi + B.
C	LET SXY = SUM (XiYi)
C	Let SXSQ = SUM (XiXi)
C	Let SYSQ = SUM (YiYi)
C	Let SX = SUM Xi
C	Let SY = SUM Yi
C
C
C	ZERO SUMS
	SXY=0.0
	SXSQ=0.0
	SYSQ=0.0
	SX=0.0
	SY=0.0
C
C	DRAW ONLY VALID POINTS
	DO 340 IZ=ICNUM,6
	FA=DTOT(IZ)
	FB=CNTMIN(IZ)
C
	SXY=SXY+FA*FB
	SXSQ=SXSQ+FA*FA
	SYSQ=SYSQ+FB*FB
	SX=SX+FA
340	SY=SY+FB
C
	FM = (Z*SXY - SX*SY) / (Z*SXSQ - SX*SX)
C
	B = (SY - FM*SX)/Z
C
C	UPDATE VALUES SAVE IN COMMON
	SDEVICE(1)=FM
	SDEVICE(2)=B
C
C
C	[3.5] DRAW REGRESSION LINE AS FUNCTION OF Y (COUNTS/MIN)
	IZ=255
	IBYTE=1-K8BIT
	DO 350 IY2=1,512
	IY1=IY2-1
	FA=FLOAT(IY1)/DEVICE
	IX1=DEVICE * (FA-B)/FM
C	IF IX1 > 511
C		THEN NOP;
S	TAD \IX1
S	TAD (-D512
S	SMA CLA
S	JMP \350 /NOP!
	IY1=512-IY1
S	JMS CVT512
S	CALL 0,PACK2
350	CONTINUE
C
C
C	[3.6] DRAW RETICULE MARKS IN STEPS OF LOG(10**X).
	KWC=DEVICE
	LSNUM=512/KWC
	DO 360 LSNEW=1,LSNUM
C
C	DRAW MARKS 6 PIXELS LONG
	I11=(LSNEW*KWC)-1
	DO 360 I12=1,6
C	DRAW HORIZONTAL LINES
	IY1=511-I11
	IX1=I12
S	JMS CVT512
S	CALL 0,PACK2
C	DRAW VERTICAL LINES
	IX1=I11
	IY1=511-I12
S	JMS CVT512
S	CALL 0,PACK2
360	CONTINUE
C
C
C	[3.7] PRINT LABELS ON X AND Y AXIS
C	LABEL Y AXIS WITH "COUNTS/MIN"
S	CALL 7,BMOMN
S	ARG (0
S	ARG \IBYTE
S	ARG (10 /X POSITION
S	ARG (20 /Y POSITION
S	ARG (377 /DENSITY
S	ARG YMSG /TEXT POINTER
S	ARG (1 /BMOMNI "MTEXT" CALL
C
C	LABEL X AXIS WITH "TOTAL DENSITY"
S	CALL 7,BMOMN
S	ARG (3
S	ARG \IBYTE
S	ARG (200 /X POSITION
S	ARG (340 /Y POSITION
S	ARG (377 /DENSITY
S	ARG XMSG /TEXT POINTER
S	ARG (1 /BMOMNI "MTEXT" CALL
C
C	LABEL 10.0 ON Y AXIS NEAR RETICLE MARK
	I11=KWC*10
C	COMPUTE Y AXIS MEMORY
	I13=511-I11
S	TAD \I13
S	AND (400
S	SZA CLA
S	TAD (2 /BM2 RATHER THAN BM0
S	DCA \I13
C
C	COMPUTE X AXIS MEMORY
S	TAD \I11
S	AND (0400
S	SZA CLA
S	IAC
S	TAD (2 /BM2 OR BM3
S	DCA \I14
C
C	GET WITHIN BM ADDRESS
S	TAD \I11
S	AND (377
S	DCA \I11
C
	I15=255-I11
S	CALL 7,BMOMN
S	ARG \I13 /MEM
S	ARG \IBYTE
S	ARG (12 /X POSITION
S	ARG \I15 /Y POSITION
S	ARG (377 /DENSITY
S	ARG VMSG /TEXT POINTER
S	ARG (1 /BMOMNI "MTEXT" CALL
C
C	LABEL 10.0 ON X AXIS NEAR RETICLE MARK
S	CALL 7,BMOMN
S	ARG \I14 /MEM
S	ARG \IBYTE
S	ARG \I11 /X POSITION
S	ARG (363 /Y POSITION
S	ARG (377 /DENSITY
S	ARG VMSG /TEXT POINTER
S	ARG (1 /BMOMNI "MTEXT" CALL
C
C
C	[3.8] PRINT THE REGRESSION COEFFICIENTS
C	NOTE: REGRESSION COEFFICIENT 
	CURSYM= (Z*SXY - SX*SY)/SQRT((Z*SXSQ-SX*SX)*(Z*SYSQ-SY*SY))

C
	DO 380 LSNEW=1,3,2
380	WRITE(LSNEW,381)FM,B,CURSYM
381	FORMAT(' CALIB. REGRESSION. M=',F7.3,', B=',F8.2
     1,', COR.COEF.=',F7.3)
	GOTO 2047
C
C
C	[4] GIVEN DENSITY IN DMAX, COMPUTEDMIN=M(DMAX)+B
C		TO RETURN COUNTS/MIN.
C	RESET FM,B FROM COMMON
400	FM=SDEVICE(1)
	B=SDEVICE(2)
	DMIN=EXP(FM*ALOG(DMAX)+B)
	GOTO 2047
C
C
C	[999] RETURN
S\2047,	RETRN FLKR2
C	*******************************
C	*SUBROUTINE    S Q U A R E
C	**************************************************
C	DRAW DIGIT(INDEX) AND SQUARE OF SIZE 14X14 AT (IX,IY)
S	CPAGE 3
S RSQUARE,	JMP I SQUARE
S SQUARE,	0
C
C	SAVE IX,IY
	IX2=IX
	IY2=IY
C
C	YES, DRAW SQUARE IN (1-K8BIT) BMS
	IBYTE=1-K8BIT
	IZ=255
C
C	SET UP THE RANGE
	LSPALSIZE2=7
C	COMPUTE:  	I11=MAX(1,IX-LSPALSIZE2)
	I11=IX-LSPALSIZE2
S	CLA CMA
S	TAD \I11
S	SPA
S	CLA
S	IAC 
S	DCA \I11
C
C	COMPUTE:	I12=MIN(511,IX+LSPALSIZE2)
	I12=IX+LSPALSIZE2
S	TAD \I12
S	TAD (-D512
S	SMA
S	CLA CMA /-1
S	TAD (D512
S	DCA \I12
C
C	COMPUTE:	I13=MAX(1,IY-LSPALSIZE2)
	I13=IY-LSPALSIZE2
S	CLA CMA
S	TAD \I13
S	SPA
S	CLA
S	IAC 
S	DCA \I13
C
C	COMPUTE:	I14=MIN(511,IY+LSPALSIZE2)
	I14=IY+LSPALSIZE2
S	TAD \I14
S	TAD (-D512
S	SMA
S	CLA CMA /-1
S	TAD (D512
S	DCA \I14
C
C
C
C	[SQ.1] DISPLAY CHARACTER IN INDEX[6:8]
C	AT (IX,IY) AT CURRENT IZ DENSITY AT THE CURRENT IBYTE.
C
C	DEFINE WINDOW
C	DEFINE TOP
	I15=IY-2
C
C	DEFINE BOT
	I16=I15+5
C
C	DEFINE LEFT
	I17=IX-2
C
C	DEFINE RIGHT
	I18=I17+3
C
C
C	[SQ.2] MAP CHARACTER IN INDEX AND POST
S	TAD \INDEX
S	TAD (0060 /"0"
S	AND (0077
S	CLL RAL /MULTIPLY BY 2
C
C	GO LOOKUP THE CHARACTER
S	TAD (-1 /FOR AUTOINDEX REG
S	TAD PTAB	/GET TABLE POINTER
S	DCA 11	/STUFF INTO AUTO-INDEX REGISTER
C
S	TAD I 11	/GET FIRST HALF OF BIT PATTERN
S	DCA BUFF#	/PUT IT IN HI-ORDER HALF OF WORD
S	TAD I 11	/GET SECOND HALF OF BIT PATTERN
S	DCA BUFF	/PUT IN IN LOW-ORDER HALF
C
C	WRITE A CHARACTER
	DO 424 IX1=I17,I18
	DO 424 IY1=I15,I16
C
S	SWAB	/CHANGE TO MODE B
S	CPAGE 16
S	JMS 45
S	NOP
S	DAD	/GET...
S	BUFF	/DOUBLE PRECISION BIT PATTERN INTO AC-MQ
S	SHL	/SHIFT LEFT..
S	0001	/...ONE PLACE (INTO LINK)
S	DST	/RESTORE...
S	BUFF	/...REMAINDER OF BIT PATTERN
S	CLAMQ	/CLEAN IT OUT
S	SWBA	/RESTORE MODE A
S	SNL	/SKIP ON ZERO LINK
S	JMP \424 /DO NOT WRITE IT OUT
C
C	DISPLAY THE LOC
S	JMS CVT512
S	CALL 0,PACK2
424	CONTINUE
C
C
C	[SQ.3] DRAW THE ENCLOSING SQUARE
	DO 1800 IY1=I13,I14
	IX1=I11
S	JMS CVT512
S	CALL 0,PACK2
	IX1=I12
S	JMS CVT512
S	CALL 0,PACK2
1800	CONTINUE
C
	DO 1801	IX1=I11,I12
	IY1=I13
S	JMS CVT512
S	CALL 0,PACK2
	IY1=I14
S	JMS CVT512
S	CALL 0,PACK2
1801	CONTINUE
S	JMP RSQUARE
C
C
C	******************************************
C	*SUBROUTINE    C V T 5 1 2
C	***********************************************
C	MAP (IX1,IY1) IN [0:511] ==> (MBM,IX,IY)[0:255].
S RCVT512,	JMP I CVT512
S CVT512,	0
C
C	COMPUTE BMi
S	CLA CMA
S	TAD \IX1
S	AND (400
S	SZA CLA
S	IAC /EITHER 0 OR 2
S	DCA \MEM
S	CLA CMA
S	TAD \IY1
S	AND (400
S	SZA CLA
S	TAD (2 /EITHER 2 OR 3
S	TAD \MEM
S	DCA \MEM
C
C	GET LOW ORDER 8-BITS
S	TAD \IX1
S	AND (377
S	DCA \IX
S	TAD \IY1
S	AND (377
S	DCA \IY
C
S	JMP RCVT512
C
C************** P A R A M E T E R S *************
C
S PMERRILL,	MERRILL
S	CPAGE 12
S MERRILL,776; 1 /(5.10E+1)
S	144; 2 /(1.00E+2)
S	1274; 2 /(7.00E+2)
S	1152; 3 /(6.18E+3)
S	1104; 4 /(5.80E+4)
S	1130; 5 /(6.00E+5)
C
S PFREEZE,	FREEZE
S	CPAGE 12
S FREEZE, 776; 1 /(5.10E+1)
S	144; 2 /(1.00E+2)
S	1274; 2 /(7.00E+2)
S	1152; 3 /(6.18E+3)
S	1104; 4 /(5.80E+4)
S	1130; 5 /(6.00E+5)
C
S PTAB,	TABLE /POINTER
S	CPAGE 2
S PIH,	\IH
S BUFF,	BLOCK 2
C
C
S	LAP
S	PAGE
S TABLE,
S	0000	/@
S	0000
S	7744	/A
S	4477
S	7751	/B
S	5126
S	3641	/C
S	4122
S	7741	/D
S	4136
S	7745	/E
S	4541
S	7744	/F
S	4440
S	3641	/G
S	4526
S	7710	/H
S	1077
S	4177	/I
S	4100
S	4241	/J
S	7640
S	7710	/K
S	2443
S	7701	/L
S	0103
S	7730	/M
S	3077
S	7730	/N
S	0677
S	3641	/O
S	4136
S	7744	/P
S	4430
S	7642	/Q
S	7603
S	7744	/R
S	4631
S	2151	/S
S	5146
S	4040	/T
S	7740
S	7701	/U
S	0177
S	7601	/V
S	0274
S	7706	/W
S	0177
S	6314	/X
S	1463
S	7007	/Y
S	0770
S	4345	/Z
S	5161
S	7741	/[
S	0000
S	6010	/\
S	0403
S	0000	/]
S	4177
S	0010	/^
S	2010
S	0101	/_
S	0101
S	0000	/SPACE
S	0000
S	0075	/!
S	0000
S	6000	/"
S	0060
S	7227	/#
S	7227
S	0677	/$ 
S	7730
S	6374	/% 
S	2543
S	6625	/& 
S	1067
S	0000	/'
S	6000
S	3641	/(
S	0000
S	0000	/)
S	4136
S	2214	/*
S	1422
S	1034	/+
S	1000
S	0102	/,
S	0000
S	1010	/-
S	1000
S	0303	/.
S	0000
S	0304	//
S	1060
S	7745	/0
S	5177
S	0121	/1
S	7701
S	2345	/2
S	5121
S	2241	/3
S	5126
S	1424	/4
S	7704
S	7251	/5
S	5106
S	0615	/6
S	2542
S	4344	/7
S	5060
S	2651	/8
S	5126
S	2051	/9
S	5136
S	0063	/:
S	6300
S	6162	/;
S	0000
S	1024	/<
S	4200
S	2222	/=
S	2222
S	0042	/>
S	2410
S	5550	/?
S	2000
C
C
S YMSG,	TEXT #LOG(COUNTS/MIN)#
S	0000
S XMSG,	TEXT #LOG(TOTAL DENSITY)#
S	0000
S VMSG,	TEXT #10.0#
S	0000
C
	END