File: DELTA.FT of Tape: Various/System-Tapes/eb-plot

(Source file text) 

---

	SUBROUTINE DELTA(DX,DY)
C DELTA-ZEICHEN PUFFERN UND AUSGEBEN
C 12-7-80/EB
C PLOTSCHRITT =1/1024 CM
C
	INTEGER ID(2),IB(8)
C
C
C  (IR=1/2 -> X/Y)
C
	ID(1)=DX*1024
	ID(2)=DY*1024
	IF(ID(1).EQ.0.AND.ID(2).EQ.0)RETURN
CTA	IG3=3
CTA	WRITE(IG3,3000)DX,ID(1),DY,ID(2)
CTA3000	FORMAT(' DX=',F8.2,I15,' SCHRITTE'/' DX=',F8.2,I15,' SCHRITTE')
	NBYTE=8
	JA=9
	JE=7
	JS=1
	DO 10 IR=1,2
	IDIR=ID(IR)
	IF(IDIR)4,2,6
2	IF(IR.EQ.1)JA=10
	NBYTE=NBYTE-4
	JS=2
	GOTO10
4	IDIR=-IDIR
6	IF(IR.EQ.2)JE=8
	J=IDIR/262144
	IB(IR)=J
	IREST=IDIR-J*262144
	J=IREST/4096
	IB(IR+2)=J
	IREST=IREST-J*4096
	J=IREST/64
	IB(IR+4)=J
	IB(IR+6)=IREST-J*64
10	CONTINUE
C ANZAHL BYTES BESTIMMEN
	IF(JS.EQ.1)GOTO30
	IRB=JE-7
	DO 20 J=1,7,2
	IF(IB(IRB+J).NE.0)GOTO25
20	NBYTE=NBYTE-1
25	IRB=NBYTE-1
	GOTO38
30	DO 33 J=1,7,2
	IF(IB(J).NE.0.OR.IB(J+1).NE.0)GOTO35
33	NBYTE=NBYTE-2
35	IRB=3+NBYTE/2
C
C RICHTUNGS- UND BYTEZAHL-KENNUNG
38	IF(ID(1).GT.0.AND.ID(2).GE.0)IRB=IRB+48
	IF(ID(1).LE.0.AND.ID(2).GT.0)IRB=IRB+64
	IF(ID(1).LT.0.AND.ID(2).LE.0)IRB=IRB+56
	IF(ID(1).GE.0.AND.ID(2).LT.0)IRB=IRB+72
CTA	WRITE(IG3,3005)IB
CTA3005	FORMAT(4(I5,I3))
CTA	WRITE(IG3,3005)IRB,NBYTE
CTA3001	FORMAT(I10)
	CALL PLBYTE(IRB)
	JA=8-NBYTE+1
	IF(JS.EQ.2)JA=JA-NBYTE
	IF(ID(1).EQ.0)GOTO42
	DO 40 J=JA,8,2
CTA	IBJ32=IB(J)+32
CTA	WRITE(IG3,3001)IBJ32
	CALL PLBYTE(IB(J)+32)
40	CONTINUE
	IF(ID(2).EQ.0)RETURN
42	JA=JA+1
	DO 50 J=JA,8,2
CTA	IBJ32=IB(J)+32
CTA	WRITE(IG3,3001)IBJ32
	CALL PLBYTE(IB(J)+32)
50	CONTINUE
CTA	WRITE(IG3,3010)
CTA3010	FORMAT(1X)
	RETURN
	END

---