	subroutine eprod(error)
#
# E-Produktionen 
#	EP1:	E	->	F
#	EP2:	E	->	F A
# Bei Nichtanwendbarkeit bzw. Stack-Ueberlauf ist error=true, sonst =false.
#
# Externe Routinen:
# Name		File, Bibliothek
# durchp	SUBS		best. den Durchtrittspunkt
# winkr		SUBS		Steigung nach Winkelinkrement
# stgg		SUBS		neue Steigung nach Bogenkonstante
# groegl	SUBS		1.Winkel groesser-gleich 2.Winkel?
# idist		SUBS		Integer-Abstand
# push		SUBS		bringt Element in den Stack
#
# Version 0.1	15.05.85
#
include defsym.rat
#
logical	error		# Error Flag
logical	show		# mit/ohne Bildschirm-Ausgabe
logical	groegl		# function, Winkel gloesser-gleich?
#
integer	prod		# Produktionsnummer
integer	bog,minbog	# Bogenlaenge, minimale B.
integer	ddx,ddy		# alte und
integer	dx,dy		# neue Koord'differenzen
integer	dxu,dyu		# Koord'diff. von v nach u
integer	laenge		# Strahllaenge
integer	px,py,		# Durchtrittspunkt
	tx,ty,ux,uy,	# Anf. und Endpunkt des Kurvensegments
	vx,vy		# Strahl ab v
integer	bb,breite	# alte und ggf. neue Bandbreite
integer	idist		# function, liefert Punktabstand
#
real	c		# Bogenkonstante
#
common	/punkte/tx,ty,ux,uy,vx,vy,bb
common	/para/bog,minbog
common	/flags/show
#
#	Segmentierung
#
if (show) write(1,10) 
10 format(' EPROD')
#
error=.false.
call winkr(minbog,dx,dy)		# Steigung nach Winkelinkrement
if (dx==0 && dy==0) prod=0		# Widerspruch: Gap-Laenge=0 
else
[	dxu=ux-vx ; dyu=uy-vy
	i=idist(vx,vy,tx,ty) ; j=idist(vx,vy,ux,uy)
	laenge=max0(2*i,j) ; c=float(minbog)/i
	px=0 ; py=0
	repeat					# Winkel inkrementieren
	[	ddx=dx ; ddy=dy
		call stgg(c,ddx,ddy,dx,dy)	# mit wachsender Steigung
		if (groegl(dx,dy,dxu,dyu)) break	# bis W'ende
		call durchp(laenge,dx,dy,px,py,breite)
	] until (px<>0)				# bzw. Peak gefunden
	if (px==0) prod=EP1
	else prod=EP2
]
#
#	Anwendung der Produktion
#
if (prod==EP1)
[	if (show) write(1,20)
	20 format(' (E1) E->F')
	call push(XF,tx,ty,ux,uy,vx,vy,bb,error)
]
else if (prod==EP2)
[	if (show) write(1,30)
	30 format(' (E2) E->FA')
	call push(XA,px,py,ux,uy,vx,vy,breite,error)
	call push(XF,tx,ty,px,py,vx,vy,bb,error)
]
else
[	error=.true.
	write(1,90) 
	90 format(' *** EPROD - nicht anwendbar ***')
]
return
end

