C	PROGRAM STPROP.FT
C	-------------------
C
C
C
	SUBROUTINE STPROP(IB,IFL,NBP,A,P,D,KX1,KX2,KY1,KY2,NC,LB,IT)
C
C
C	P LEMKIN
C	NIH
C	BETHESDA, MD
C	
C
C	JUNE 16, 1977
C	JUNE 11, 1977
C	JUNE 2, 1977
C	MAY 27, 1977
C	MAY 24, 1977
C
C	PURPOSE
C	-------
C	SET THE PROPERTY LIST OF LIST IA[1:2].
C
C			IB
C			|
C			|
C		       \|/
C		--------RT: PROP LIST PTR
C		|	D1: CC#
C		|	D2: PTR TO BOUNDARY LIST-->
C		|
C	       \|/
C		PROP LIST:
C		NODE 1<==>NODE 2<==>NODE 3
C
C
C		NODE 1
C		------
C	right ptr: #B.P. IN [5:15], TOUCHING EDGE IN [2:3].

C	datum 1: true perimeter
C	datum 2: area under RLM
C
C		NODE 2
C		------
C	right ptr: area FILLED under RLM
C	datum 1: horizontal position
C	datum 2: vertical position
C
C		NODE 3
C		------
C	right ptr: DENSITY under RLM
C	datum 1: horizontal size
C	datum 2: vertical size
C
C
C
C
	DIMENSION NODE(2,3),IPLIST(2),IDATA(2),ID(2)
C	[0] INIT
C	DEFINE BNODE CALLS
	KAPPENDXY=1
	KLASTXY=7
	KNEXTXY=8
	KREADINFO=18
	KWRITEINFO=17
	KGETLIST=5
C
C	[0.1] GET THE MAIN LIST PTR
	ID=IB
S	INC \IB#
S	TAD I \IB
S	DCA \ID#
	CALL BNODE(0,0,IPLIST,KGETLIST)
C
C	FILL THE INFO FIELD
	CALL BNODE(NODE,0,ID,KREADINFO)
S	CLA CMA
S	TAD PNODE
S	DCA 11
S	TAD \IPLIST /PTR TO PROP LIST
S	DCA I 11
S	TAD \IPLIST#
S	DCA I 11
C
S	TAD I \NC /CC#
S	DCA I 11
S	DCA I 11
C
S	TAD I \LB /BOUNDARY LIST PTR
S	DCA I 11
S	INC \LB#
S	TAD I \LB
S	DCA I 11
C
	CALL BNODE(NODE,0,ID,KWRITEINFO)
C
C
C
C	[1] GET NODE INFO FOR NODE 1
	CALL BNODE(NODE,0,IPLIST,KREADINFO)
S	CLA CMA
S	TAD PNODE
S	DCA 11
C
S	TAD I \NBP
S	DCA I 11
S	TAD I \IT
S	DCA I 11
C
	CALL DPCVRT(IDATA,P,1)
S	TAD \IDATA
S	DCA I 11
S	TAD \IDATA#
S	DCA I 11
C
	CALL DPCVRT(IDATA,A,1)
S	TAD \IDATA
S	DCA I 11
S	TAD \IDATA#
S	DCA I 11
C
C	WRITE OUT THE NODE
	CALL BNODE(NODE,0,IPLIST,KWRITENODE)
C
C
C	[2] GET NODE INFO FOR NODE 2
	CALL BNODE(IX,IY,IPLIST,KAPPENDXY)
	CALL BNODE(IX,IY,IPLIST,KLASTXY)
	CALL BNODE(NODE,0,IPLIST,KREADINFO)
S	CLA CMA
S	TAD PNODE
S	DCA 11
C
S	TAD I \IFL
S	DCA I 11
S	INC \IFL#
S	TAD I \IFL
S	DCA I 11
C
S	TAD I \KX1
S	DCA I 11
S	DCA I 11
C
S	TAD I \KY1
S	DCA I 11
S	DCA I 11
C
C	WRITE OUT THE NODE
	CALL BNODE(NODE,0,IPLIST,KWRITENODE)
C
C	MOVE PTR FORWARD 1 NODE
	CALL BNODE(IX,IY,IPLIST,KNEXTXY)
C
C
C	[3] GET NODE INFO FOR NODE 3
	CALL BNODE(IX,IY,IPLIST,KAPPENDXY)
	CALL BNODE(IX,IY,IPLIST,KLASTXY)
	CALL BNODE(NODE,0,IPLIST,KREADINFO)
S	CLA CMA
S	TAD PNODE
S	DCA 11
C
	CALL DPCVRT(IDATA,D,1)
S	TAD \IDATA
S	DCA I 11
S	TAD \IDATA#
S	DCA I 11
C
S	TAD I \KX1
S	CIA
S	TAD I \KX2
S	DCA I 11
S	DCA I 11
C
S	TAD I \KY1
S	CIA
S	TAD I \KY2
S	DCA I 11
S	DCA I 11
C
C	WRITE OUT THE NODE
	CALL BNODE(NODE,0,IPLIST,KWRITENODE)
C
C
	RETURN
C
C	****PARAMETERS****
S PNODE,	\NODE
	END
 