C	PROGRAM BNDIO.FT
C	----------------
C
C
C
	SUBROUTINE BNDIO(IX,IY,ICHAIN,ISEM,PTR,IOPR)
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 28, 1977
C	JUNE 23, 1977
C
C
C
C	INTRODUCTION
C	------------
C	BNDIO.FT IS A SUBROUTINE TO OPEN AND READ BOUNDARY FILES
C	PRODUCED BY SEGBND.SV IN BMON2.
C	NOTE THAT THE FOLLOWING CODING SCHEME IS USED!
C
C	IX DATA IS BITS [4:11]
C	IY DATA IS BITS [4:11]
C	ICHAIN DATA IS C1[3:5], C2[9:11]
C	ISEM DATA IS S1[0:5] AND S2[6:11].
C
C
C
C	IOPR	FUNCTION
C	----	--------
C	1	INIT THE BOUNDARY STORE IN FIELD 6 AND 70000:73777.
C		NOTE: PTR IS THE BOUNDARY SIZE (ISIZE=IFIX(PTR)).
C
C	2	STORE (IX,IY,ICHAIN,ISEM) AT PTR;
C
C	3	READ (IX,IY,ICHAIN,ISEM) FROM PTR;
C
C	4	STORE (IX,IY,ICHAIN,ISEM) MOD ISIZE AT PTR;
C
C	5	READ (IX,IY,ICHAIN,ISEM) MOD ISIZE AT PTR
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
C
C	[0.1] INITIALIZATION
C
	IF(IOPR)900,900,901
901	IF(IOPR-5)902,902,900
900	WRITE(1,903)IOPR
903	FORMAT(' ILLEGAL BNDIO IOPR=',I5)
	CALL CHAIN('BMON2')
C
C	[0.2] DISPATCH
902	IPTR=PTR
	GOTO(100,200,300,400,500),IOPR
C
C
C	[1]	INIT THE BOUNDARY STORE IN FIELD 6 AND 70000:73777.
100	CONTINUE
S	CLA CMA
S	DCA 11 /PTR TO 60000:63777
S	DCA 11
S	CLA CMA
S	DCA 12 /PTR TO 70000:73777
S	TAD (3777
S	DCA 13 /PTR 64000:67777
C
S	TAD (-4000
S	DCA 7 /COUNTER
C
C	ZERO BUFFER
S	CPAGE 7
S \101,	6261
S	DCAI 11
S	DCAI 13
S	6271
S	DCAI 12
S	ISZ 7
S	JMP \101 /NOT DONE
C
C	FORCE DF TO CURRENT
S	CPAGE 3
S	JMS 45
S	CLA
C
C	GET THE BOUNDARY SIZE
	ISIZE=PTR
	RETURN
C
C	[2]	STORE (IX,IY,ICHAIN,ISEM) AT PTR;
200	KPTR=IPTR
C
C	CHECK PTR
210	IF(KPTR)999,999,201
C
C	ERRO
999	WRITE(1,998)KPTR
998	FORMAT(' BNDIO ILL IPTR=',I5)
	CALL EXIT
C
201	KX=IX
	KY=IY
	KCHAIN=ICHAIN
	KSEM=ISEM
C
S	TAD \KX
S	AND (377
S	DCA 25
C
S	TAD \KY
S	AND (377
S	DCA 26
C
S	TAD \KCHAIN
S	RTL; RAL /[3:5]&[9:11]
S	AND (7000
S	TAD 25
S	DCA 25
C
S	TAD \KCHAIN
S	RTR;RTR
S	AND (7000
S	TAD 26
S	DCA 26
C
S	TAD \KSEM
S	DCA 27
S	CLA CMA
S	TAD \KPTR
S	DCA 30 /IPTR-1
C
S	TAD 30 /SETUP FIELD 6 PTR
S	TAD (4000 /IY PTR OFFSET
S	DCA 7
C
C	PACK DATA
S	CPAGE 10
S	6261
S	TAD 25 /C1&X
S	DCAI 30
S	TAD 26 /C2&Y
S	DCAI 7
S	6271
S	TAD 27
S	DCAI 30 /S1&S2
C
S	CPAGE 3
S	JMS 45
S	CLA
	RETURN
C
C	[3]	READ (IX,IY,ICHAIN,ISEM) FROM PTR;
300	CONTINUE
	KPTR=IPTR
C
C	CHECK PTR
310	IF(KPTR)999,999,301
C
S\301,	CLA CMA
S	TAD \KPTR
S	DCA 30
S	TAD 30
S	TAD (4000
S	DCA 7
C
S	CPAGE 10
S	6261
S	TADI 30 /C1&X
S	DCA 25
C
S	TADI 7 /C2&Y
S	DCA 26
S	6271
S	TADI 30 /S1&S2
S	DCA 27
S	CPAGE 3
S	JMS 45
C
S	TAD 25
S	AND (377
S	DCA \KX
S	TAD 26
S	AND (377
S	DCA \KX
C
S	TAD 25
S	RTR;RAR
S	AND (0700
S	MQL
C
S	TAD 26
S	RTL;RTL
S	AND (0007
S	MQA
S	DCA \KCHAIN
C
S	TAD 27
S	DCA \KSEM
C
	IX=KX
	IY=KY
	ICHAIN=KCHAIN
	ISEM=KSEM
	RETURN
C
C	[4]	STORE (IX,IY,ICHAIN,ISEM) MOD ISIZE AT PTR;
C		WHERE ISIZE IS THE MAXIMUM SIZE SET UP WITH CALL 2.
400	IF(PTR-1.0)410,420,420
C
C	PTR < 1
410	KPTR=FLOAT(ISIZE)+PTR
	GOTO 210
C
C	PTR > 1
420	KPTR=PTR-FLOAT(ISIZE)
	IF(KPTR)421,421,210
421	KPTR=PTR
	GOTO 210
C
	RETURN
C	[5]	READ (IX,IY,ICHAIN,ISEM) MOD ISIZE AT PTR
C		WHERE ISIZE IS THE MAX SIZE SET UP WITH CALL 2.
500	IF(PTR-1.0)510,520,520
C
C	PTR < 1
510	KPTR=FLOAT(ISIZE)+PTR
	GOTO 310
C
C	PTR > 1
520	KPTR=PTR-FLOAT(ISIZE)
	IF(KPTR)521,521,310
521	KPTR=PTR
	GOTO 310
C
	RETURN
	END