Directory of image this file is from
This file as a plain text file

	SUBROUTINE CIRC(XA,YA,XC,YC,T,PSI,M)
C  KREISBOGEN
	CALL PLOTT(XA,YA,3)
	JP1=1
	A=0.2
	XD=XC-XA
	YD=YC-YA
	R=SQRT(XD*XD+YD*YD)
	SINA=YD/R
	COSA=XD/R
	BW1=ATAN(YD/(XD+1E-38))
	BW2=1.5707963-BW1
	WRITE(1,2)PSI
2	FORMAT(' CIRC, PSI=',E16.8)
	PSIE=PSI*0.17453293E-1
18	DPSI=1.5708/R
	IF(PSIE)20,22,22
20	DPSI=-DPSI
22	PSIQ=0.0
24	PSIQ=PSIQ+DPSI
	C=2.0*R*SIN(PSIQ/2.0)
	DELTQ=BW2+PSIQ/2.0
	X=XA-COS(DELTQ)*C
	Y=YA+SIN(DELTQ)*C
	CALL PLOTT(X,Y,2)
	IF(ABS(PSIQ)-ABS(PSIE))24,26,26
26	GOTO (27,906)JP1
C
C	CENTRUM
27	IF(M-1)28,510,28
28	IF(M-2)29,520,29
29	IF(M-3)900,530,900
C
C
C  ZENTRALKREUZ M=1
510	CALL PLOTT (XC-A,YC,3)
	CALL PLOTT (XC+A,YC,2)
	CALL PLOTT (XC,YC-A,3)
	CALL PLOTT (XC,YC+A,2)
	GOTO 900
C
C
C  BOGEN-ENDACHSEN M=2
520	ZETA=PSIE-BW1
	SI=SIN(ZETA)
	CO=COS(ZETA)
	JUMP=1
	GOTO 523
521	SI=SINA
	CO=COSA
	JUMP=2
C
C
C	RADIUSACHSEN
523	B=R+2.5*A
	JU=1
	IPEN=3
	GOTO 527
524	B=R+1.5*A
	JU=2
	IPEN=2
	GOTO 527
525	B=R-T-1.5*A
	JU=3
	IPEN=3
	GOTO 527
526	B=2.0*A
	JU=4
	IPEN=2
527	CALL PLOTT (XC-B*CO,YC+B*SI,IPEN)
	GOTO (524,525,526,528)JU
528	GOTO (521,510,532)JUMP
C
C
C  X-Y-ACHSENKREUZ M=3
530	JUMP=3
	ZETA=0.0
	DO 532 N=1,4
	ZETA=ZETA+1.5707963
	SI=SIN(ZETA)
	CO=COS(ZETA)
	GOTO 523
532	CONTINUE
	GOTO 510
C
C
900	XE1=X
	YE1=Y
	R1=R
	IF(T)904,906,904
904	R=R-T
	XA=XA+T*COSA
	YA=YA+T*SINA
	CALL PLOTT (XA,YA,3)
	JP1=2
	GOTO 18
906	XA=XE1
	YA=YE1
	XC=X
	YC=Y
	PSI=R1
	T=R
	CALL PLOTT (X,Y,3)
	RETURN
	END