sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/greek.ft

   1         SUBROUTINE GREEK (X0,Y0,HEIGHT,CHARAC,ANGLE)
   2         REAL X0,Y0,HEIGHT,CHARAC,ANGLE
   3         REAL WORD(24),
   4      *  X,Y,F,CANGLE,SANGLE
   5         INTEGER GREEK1
   6         EXTERNAL GREEK1
   7         INTEGER I,N1,N2,N3,M1,M2,M3,PENPOS
   8 C
   9         DATA WORD /'THETA','TAU','GAMMA','RHO','ALPHA','BETA','DELTA',
  10      *'EPSILO','ETA','KAPPA','LAMBDA','MY','PHI','PI','ZETA','JOTA',
  11      *'NY','CHI','PSI','OMEGA','XI','SIGMA','OMIKRO','YPSILO'/
  12 C
  13 C
  14         DO 10 I=1,24
  15         CALL CGET(CHARAC,1,N1)
  16         CALL CGET(CHARAC,2,N2)
  17         CALL CGET(CHARAC,3,N3)
  18         CALL CGET(WORD(I),1,M1)
  19         CALL CGET(WORD(I),2,M2)
  20         CALL CGET(WORD(I),3,M3)
  21         IF (N3.EQ.32) M3=32
  22         IF (M1.EQ.N1.AND.M2.EQ.N2.AND.M3.EQ.N3) GOTO 20
  23 10      CONTINUE
  24         WRITE (0,1) CHARAC
  25 1       FORMAT (' GREEK DOES NOT KNOW HOW TO PLOT:',A6)
  26         RETURN
  27 C
  28 C
  29 20      CONTINUE
  30         F=HEIGHT*5.E-2
  31         CANGLE=COS(ANGLE*1.7453293E-2)
  32         SANGLE=SIN(ANGLE*1.7453293E-2)
  33         N1=0
  34 30      PENPOS=GREEK1(X,Y,I,N1)
  35         IF (PENPOS.LE.0) RETURN
  36         XX=F*X
  37         Y=F*Y
  38         X=XX*CANGLE-Y*SANGLE+X0
  39         Y=XX*SANGLE+Y*CANGLE+Y0
  40         CALL XYPLOT (X,Y,PENPOS)
  41         GOTO 30
  42         END
  43 \1a