C	PROGRAM SECT1.FT
C	----------------
C
C
C	### SUBROUTINE SECT1
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	JULY 21, 1977
C
C
C
C	INTRODUCTION
C	------------
C	SECT1 MOVES THE STAGE DOWN ICNUM(4) STEPS AND DOES A GET==>BM0H
C	OR BM0:3H (IF /A SWITCH).
C	THE NEW Z POSITION IS UPDATED IN COMMON MDPDATA ARRAY.
C
C	A 1 SECOND DELAY IS USED to ALLOW STAGE SETTLING
C	AFTER MOVING THE STAGE.
C
C	NOTE: BM'S ARE POSITIONED ACCORDING TO THE F&S.
C	[1] "INITIALIZATION DONE IN MAIN"
C	POSITION BMS ACCORDING TO F&S;
C	ICHAN_NUMBER OF SECTIONS (ICNUM(1));
C
C	IVAL	FUNCTION
C	----	--------
C	1	MOVE FOCUS DOWN ICNUM(4) STEPS AND DO GET
C	2	RESTORE FOCUS TOTAL NUMBER OF SECTIONS*STEPS
C
C
C
C	[1.1] SET ALL BM'S TO F&S POSITION IN ORDER TO TO GET
C	STDBM/B;
C
C
C
C	[2] "Data acquisition loop"
C			If (ICHAN_ICHAN-1) < 0
C				Then Return to BMON2
C				Else
C				Begin "Get next serial section"
C				MOVSTATE,SF,ABS,K;
C				GET, <BMi>;
C				Goto [3.3];
C				End "Get next serial section";
C				RETURN;
C	OPDEFS
C	------
C
C
C
S	OPDEF	DISP2	6436
S	OPDEF	DISP1	6435
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
C
S	OPDEF	STQMT	6300
S	SKPDF	QMSKP	6301 /SKIP ON QMT READY
C
S	OPDEF	HPL	6360
S	OPDEF	VPL	6362
S	OPDEF	HSL	6361
S	OPDEF	VSL	6363
C
S	OPDEF	HPR	6320
S	OPDEF	VPR	6322
S	OPDEF	GETA	6522
S	OPDEF	GETB	6523
S	OPDEF 	POSTA	6520
S	OPDEF	POSTB	6521
C
S	OPDEF	BMX0	6500
S	OPDEF	BMY0	6504
C
S	OPDEF	MSTAG	6366 /AC==>MSTAG REG
S	OPDEF	STEP	6305 /MOVE STAGE ACCORDING TO MSTAG REG
C	[0] ENTRY
S	ENTRY SECT1
S	CPAGE 2
S SECT1,	BLOCK 2
	GOTO (100,200),IVAL
C
C
C	[1] INITIALIZATION
C	GET FOCUS STEP PARAMETERS
100	KSTEPS=MAX(ICNUM(4),1)
S	TAD \KSTEPS
S	SNA
S	TAD (2 /.2 MICRONS
S	DCA \KSTEPS
C
C
C	IF IFIRST=0
C		THEN PRINT OUT HEADER
	IF(IFIRST)110,101,110
C	NOTE: /N MUST BE ZERO TO GET MICRONS!
101	IFIRST=1
	ISW(14)=0
	CALL BMAP(LENS,ZOOM,PUC,UNAME)
C
C	MAGIC CALIBRATIO # FOR MICRONS/PIXEL IN Z
	ZSTEPS=FLOAT(KSTEPS)*0.0627
	ASPECTRATION=PUC/ZSTEP
C
	DO 102 I=1,3,2
	WRITE(I,103)KSTEPS,ZSTEPS,LENS,ZOOM
102	WRITE(I,104)PUC,ASPECTRATIO
103	FORMAT(' DOING MICROSCOPE SERIAL SECTIONS OF ',I4,
     1' STEPS OR ',F5.2,' MICRONS.',/
     2,' LENS=',I3,'X, ZOOM=',F6.2,'X.')
104	FORMAT(' MICRONS/PIXEL=',F7.3,' (X/Z) ASPECT RATIO=',F7.3)
C
C
C	[1.1] DO STDBM/B;
S\110,	JMS MOVPOSFS
C
C
C	[1.2] GET CURRENT STAGE POSITION
	IZ=MDPDATA(7,4)
C
C
C	[1.3] PROCESS DATA
C	IF /A
C		THEN IAPATTERN_'7417 ELSE IAPATTERN_7410
	IAPATTERN=0
C
S	TAD \JBM
S	AND (0003
S	IAC
S	DCA \JBMP1
	GOTO(130,131,132,133),JBMP1
130	I=8
	GOTO 134
131	I=4
	GOTO 134
132	I=2
	GOTO 134
133	I=1
S\134,	TAD \I
S	MQL
C
S	TAD \ISW
S	SZA CLA
S	TAD (0017 /BM0:3
S	MQA /OR BITS
C
S	TAD (7400 /TURN ON HIGH BITS
S	DCA \IAPATTERN
C
C
C	[1.3.1] GET SERIAL SECTION DATA
C		BEGIN "GET SERIAL SECTIONS"
C		 MOVSTATE SF,REL,KSTEPS
C
C	MOVE THE FOCUS 10 STEPS "UP"
	DO 135 ITIME=1,10
S	TAD (0040 /+FOCUS BIT PATTERN
S	MSTAG
S	STEP
S	CLA
	CALL CLOCK
135	CONTINUE
C
C	MOVE THE FOCUS 10+ KSTEPS "DOWN"
	NSTPS=KSTEPS+10
	DO 136 ITIME=1,NSTPS
S	TAD (0020 /-FOCUS BIT PATTERN
S	MSTAG
S	STEP
S	CLA
	CALL CLOCK
136	CONTINUE
C
C	WAIT .25 SEC
	DO 137 ITIME=1,50
	CALL CLOCK
137	CONTINUE
C
C	GO GET DATA AND SAVE IT
C	WRITE OUT SECTION NAME
	IZ=IZ+KSTEPS
C	UPDATE CURREN AND DESIRE
	DO 138 IUPDATE=5,7,2
138	MDPDATA(IUPDATE,4)=IZ
C	INCR FRAME COUNTER
	ISECTION=ISECTION+1
C
C@	DO 327 LSNEW=1,3,2
C@327	WRITE(LSNEW,326)IZ,ISECTION
C@326	FORMAT(' FOCUS STEPS:',I5,' FOR SECTION:',I5)
C	END "GET SERIAL SECTIONS";
C
C
C
C
C	[1.3.2] BEGIN "GET DATA";
C	IF NOT /A
C		THEN GET, BMi
C		ELSE GET, BM0,BM1,BM2,BM3;
S	TAD \IAPATTERN
S	GETA
C
S GOQ,	STQMT
S GQ,	QMSKP
S	JMP GQ
C	END "GET DATA";
C
C
C	[1.4] RESTORE BM POSITIONS
	DO 140 I=1,4
	IBM1=I-1
	IX=LSAVE(13,I)
	IY=LSAVE(14,I)
S	JMS POSXY
140	CONTINUE
C
C
S	RETRN SECT1
C
C	[2] RESTORE FOCUS 
200	NSTEPS=ISECTION*KSTEPS
C
	DO 201 ITIME=1,NSTEPS
S	TAD (0040 /MOVE IT +
S	MSTAG
S	STEP
S	CLA
	CALL CLOCK
201	CONTINUE
S	RETRN SECT1
C	*************************************************************
C	*SUBROUTINE    M O V P O S F S
C	**********************************************************
S	CPAGE 3
S RMOVPOSFS,	JMP I MOVPOSFS
S MOVPOSFS,	0
C
C
C	POSITION BM(S) ACCORDING TO F&S
S	HPR
S	DCA \IX
S	VPR
S	DCA \IY
C
	IX=IBCD(IX,1)
	IY=IBCD(IY,1)
C
C	IF /A
C		THEN ISTART_1 ELSE ISTART_4
S	TAD \ISW
S	SNA CLA
S	TAD (3
S	IAC
S	DCA \ISTART
C
	DO 1499 IZ=ISTART,4
C	IF /A
C		THEN SETUP THE POSITIONING
S	TAD \ISW
S	SNA CLA
S	JMP \1405 /NOT /A
C
	GOTO(1400,1401,1402,1403),IZ
C
C	MAP BM0 TO F&S
1400	CONTINUE
	IBM1=0
	GOTO 1405
C
C	MAP BM1 (X+256)
1401	IX=IX+256
	IBM1=1
	GOTO 1405
C
C	MAP BM2 (Y+256)
1402	IY=IY+256
	IBM1=2
	GOTO 1405
C
C	MAP BM3 (X+256,Y+256)
1403	IX=IX+256
	IY=IY+256
	IBM1=3
C
C	MAP BM0, BM4,5,6,7 OR NOT /A
S \1405,	JMS POSXY /LOAD BMI FROM IX,IY
1499	CONTINUE
S	JMP RMOVPOSFS
C	***********************************************************
C	*SUBROUTINE    P O S X Y
C	**********************************************************
S	CPAGE 3
S RPOSXY,	JMP I POSXY
S POSXY,	0
C
C
S	TAD \IBM1 /COMPUTE OFFSET
S	TAD (-4
S	SMA CLA
S	TAD (10 /OFFSET FOR GROUP B
S	MQL
S	TAD \IBM1
S	AND (0003
S	MQA
S	MQL /OR IN POSSIBLE GROUP B, 0:3, OR 10:13.
C
S	MQA
S	TAD PBMX0
S	DCA LODX
S	TAD \IX
S LODX,	BMX0
C
S	MQA
S	TAD PBMY0
S	DCA LODY
S	TAD \IY
S LODY,	BMY0
S	JMP RPOSXY
C
C
C
C	****PARAMETERS****
S PBMX0,	BMX0
S PBMY0,	BMY0
	END
    