home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / diglib.lha / Diglib / diglib.zoo / diglib / POLAR.FOR < prev    next >
Text File  |  1989-06-20  |  9KB  |  326 lines
  1.       SUBROUTINE POLAR(RADIAL,RR,THETA,DATA,MODE,NUM,ISYMNO,SYMSIZ,
  2.      1                  NPBSYM,PLTLAB)
  3. C
  4. C  POLAR PLOT SUBROUTINE FOR DIGLIB
  5. C
  6. C  AUTHOR: JIM LOCKER, SOFTECH INC.
  7. C          MAY 1989
  8. C
  9. C  POLAR ACCEPTS DATA IN THE FOLLOWING MODES;
  10. C
  11. C  MODE(1) CONTROLS THE TYPE OF DATA AND WHETHER OR NOT AXES/RANGE
  12. C  RINGS ARE DRAWN
  13. C
  14. C  MODE(1)= 1 IS R-THETA INFORMATION AND THE PLOT IS TYPE REAL
  15. C
  16. C  MODE(1)= 2 IS REAL-IMAGINARY TYPE INFORMATION AND THE PLOT REPRESENTS
  17. C  A COMPLEX PLANE PLOT
  18. C
  19. C  IF MODE(1)= 1, RR IS AN ARRAY OF RADIAL INFORMATION
  20. C  AND THETA IS AN ARRAY OF ANGULAR INFORMATION CORRESPONDING
  21. C  TO THE RADIAL INFORMATION
  22. C
  23. C  IF MODE(1)= 2, RR IS THE REAL DATA
  24. C  AND THETA IS THE IMAGINARY DATA SO THAT THE DATA SET IS OF THE
  25. C  FORM X+IY
  26.  
  27. C  MODE(1) = 3 IS LIKE MODE(1) = 1 EXCEPT NO AXES OR RANGE RINGS ARE DRAWN
  28. C  MODE(1) = 4 IS LIKE MODE(1) = 2 EXCEPT NO AXES OR RANGE RINGS.
  29. C
  30. C  MODE(2) CONTROLS THE SCALE OF THE PLOT
  31. C
  32. C  MODE(2) = 1 INDICATES A LINEAR RADIAL SCALE
  33. C
  34. C  MODE(2) = 2 INDICATES A LOGARITHMIC RADIAL SCALE
  35. C
  36. C  MODE(3) TELLS THE NUMBER OF RANGE RINGS TO DRAW.  IN LINEAR RADIAL
  37. C  MODE, THIS IS THE NUMBER THAT WILL BE DRAWN.  IN LOGARITHMIC MODE,
  38. C  THIS IS THE NUMBER THAT WILL BE DRAWN PER DECADE.
  39. C
  40. C  MODE(4) DICTATES THE STYLE OF THE LINE FOR RANGE RINGS, FOLLOWING
  41. C  DIGLIB CONVENTION.
  42. C
  43. C  MODE(5) TELLS WHETHER OR NOT RADIAL TICK MARKS ARE TO BE USED.  IF
  44. C  MODE(5) = 0, NO RADIAL TICK MARKS.  IF MODE(5) .GT. 0, THEN OUTWARD
  45. C  POINTING TICKS AT DEGREE INCREMENTS SPECIFIED BY THE VALUE IN MODE(5)
  46. C  IF MODE(5) .LT. 0, THEN INWARD POINTING TICKS.
  47. C
  48. C  MODE(6) SPECIFIES THE COLOR OF THE AXES, RANGE RINGS, AND TICK MARKS
  49. C  MODE(7) SPECIFIES THE COLOR OF THE DATA
  50. C  MODE(8) SPECIFIES THE LINE STYLE OF THE DATA, FOLLOWING DIGLIB 
  51. C  CONVENTION
  52. C
  53. C  NUM IS THE NUMBER OF DATA POINTS
  54. C
  55. C  DATA IS A WORKSPACE PASSED FROM THE CALLING ROUTINE
  56. C
  57. C  ISYMNO IS THE CODE FOR THE SYMBOLS TO DRAW
  58. C
  59. C  SYMSIZ IS THE SIZE OF THE SYMBOLS TO DRAW
  60. C
  61. C  NPBSYM IS THE NUMBER OF DATA POINTS TO SKIP BETWEEN SYMBOLS
  62. C
  63. C  PLTLAB IS THE PLOT LABEL
  64. C
  65.       EXTERNAL LEN
  66.       INTEGER*4 NUM,ISYMNO,NPBSYM
  67.       INTEGER*2 MODE(8)
  68.       REAL*4 RADIAL,RADIUS,SYMSIZ,MOD
  69.       REAL*4 RR(NUM),THETA(NUM),DATA(NUM,2)
  70.       REAL*4 XVSTRT,YVSTRT,XVLEN,YVLEN,XOFF,YOFF,CXSIZE,CYSIZE,
  71.      1   TICKLN
  72.       INCLUDE PLTSIZ.PRM
  73.       INCLUDE PLTPRM.PRM
  74.       INCLUDE GCLTYP.PRM
  75.       REAL*4 DEVID,XLENCM,YLENCM,XRES,YRES,NDCLRS,IDVBTS,NFLINE,
  76.      1   XCLIPD,YCLIPD
  77.       COMMON /GCDCHR/ DEVID, XLENCM, YLENCM, XRES, YRES,
  78.      1   NDCLRS, IDVBTS, NFLINE, XCLIPD, YCLIPD
  79.       REAL*4 XMIN,XMAX,YMIN,YMAX
  80.       COMMON/PLTCLP/XMIN,XMAX,YMIN,YMAX
  81.  
  82.       INTEGER*4 JJ,KK,COLR
  83.       CHARACTER*1 LAB(14),TAG(27),PLTLAB(2)
  84.       CHARACTER*13 HEADER
  85.       REAL*4 XORG,YORG,XSKAL,YSKAL
  86.       COMMON/POL/XORG,YORG,XSKAL,YSKAL
  87.  
  88.       EQUIVALENCE (HEADER,TAG)
  89.       DATA HEADER/'MAX RADIUS = '/
  90. C
  91. C  SAVE THE OLD LINE TYPE
  92. C
  93.       IOLDLT = ILNTYP
  94.       ILNTYP = 1
  95. C
  96. C  DETERMINE THE PLOT ORIGIN IN VIRTUAL COORDINATES
  97. C
  98.       RADIUS = RADIAL
  99.       XORG = XVSTRT + (XVLEN-XVSTRT)/2
  100.       YORG = YVSTRT + (YVLEN-YVSTRT)/2
  101. C
  102. C  LOGARITHMIC?
  103. C
  104.       IF(MODE(2) .EQ. 2) RADIUS = ALOG10(RADIUS)
  105. C
  106. C     SET THE PLOT SCALE
  107. C
  108.       XSKAL = (XVLEN - XORG)/RADIUS
  109.       YSKAL = (YVLEN - YORG)/RADIUS
  110. C
  111. C  DEPENDING UPON MODE, DRAW THE AXES AND RANGE RINGS OR NOT.
  112. C
  113.       COLR = MODE(6)
  114.       CALL GSCOLR(COLR,IERR)
  115.       IF (MODE(1) .EQ. 1 .OR. MODE(1) .EQ. 2) THEN
  116.         CALL GSMOVE(XVSTRT,YORG)
  117.         CALL GSDRAW(XVLEN,YORG)
  118.         CALL GSMOVE(XORG,YVSTRT)
  119.         CALL GSDRAW(XORG,YVLEN)
  120.         CALL CIRCLE(RADIUS)
  121. C
  122. C  NOW DO RANGE RINGS, IF INDICATED
  123. C
  124.         IF (MODE(3) .GT. 0) THEN
  125.           MOD = FLOAT(MODE(3))
  126.           LINSYL = MODE(4)
  127.           CALL GSLTYP(LINSYL)
  128. C
  129. C  TEST FOR LOG OR LIN
  130. C
  131.           IF(MODE(2) .NE. 2) THEN
  132. C
  133. C  LIN
  134. C
  135.             RINC = RADIUS/MOD
  136.             DO 3 II = 1,MODE(3)-1
  137.               RAD = FLOAT(II)*RINC
  138.               CALL CIRCLE(RAD)
  139. 3           CONTINUE
  140.           ELSE
  141. C
  142. C LOG
  143. C
  144.             RINC = 10/MOD
  145.             JJ = RADIUS
  146.             DO 103 II = 0,JJ+1
  147.               DO 102 KK = 1,MODE(3)
  148.                 RAD = ALOG10(FLOAT(KK)*RINC*(10**II))
  149.                 IF(RAD .LT. RADIUS) THEN
  150.                   CALL CIRCLE(RAD)
  151.                 ENDIF
  152. 102           CONTINUE
  153. 103         CONTINUE
  154.           ENDIF
  155.         ENDIF
  156.       ENDIF
  157.       CALL GSLTYP(1)
  158. C
  159. C  NOW DETERMINE CHARACTER SIZES FOR LABELS AND TICK MARKS
  160. C
  161.       CSIZE = GOODCS(AMAX1(0.3,AMIN1(YTOP-YBOT,XRIGHT-XLEFT)/80.0))
  162.       CALL GSSETC(CSIZE,0)
  163. C
  164. C  AND DO THE TICK MARKS AND TICK LABELS, IF INDICATED
  165. C
  166.       IF(MODE(5) .NE. 0) THEN
  167.         TICKLN = CSIZE * 0.9
  168.         DO 122 JJ = 0,360,ABS(MODE(5))
  169.           ANG = FLOAT(JJ)*6.283185/360
  170.           ANGX = COS(ANG)
  171.           ANGY = SIN(ANG)
  172.           XX1 = RADIUS*ANGX*XSKAL
  173.           YY1 = RADIUS*ANGY*YSKAL
  174.           DELTAX = TICKLN*ANGX
  175.           DELTAY = TICKLN*ANGY
  176.           SPOSX = XORG + XX1
  177.           SPOSY = YORG + YY1
  178.           IF(MODE(5) .GT. 0) THEN
  179.             FPOSX = SPOSX + DELTAX
  180.             FPOSY = SPOSY + DELTAY
  181.           ELSE
  182.             FPOSX = SPOSX - DELTAX
  183.             FPOSY = SPOSY - DELTAY
  184.           ENDIF
  185.           CALL GSMOVE(SPOSX,SPOSY)
  186.           CALL GSDRAW(FPOSX,FPOSY)
  187. C
  188. C  AND LABEL THE TICKS
  189. C
  190.           CALL LINLAB(JJ,0,LAB,0)
  191.           LENGTH = LEN(LAB)
  192.           IF(JJ .GT. 90 .AND. JJ .LT.270) THEN
  193.             CPOSX = CSIZE*ANGX*(LENGTH + 0.75)
  194.           ELSE
  195.             CPOSX = CSIZE*ANGX*.5
  196.           ENDIF
  197.           IF(JJ .LT. 180) THEN
  198.             CPOSY = .6*ANGY*CSIZE
  199.           ELSE
  200.             CPOSY = ANGY*1.8*CSIZE
  201.           ENDIF
  202.           IF(JJ .GE. 355) CYCLE
  203.           IF(MODE(5) .GT. 0) THEN
  204.             CALL GSMOVE(FPOSX+CPOSX,FPOSY+CPOSY)
  205.           ELSE
  206.             CALL GSMOVE(SPOSX+ 1.1*CPOSX,SPOSY+ 1.5*CPOSY)
  207.           ENDIF
  208.           CALL GSPSTR(LAB)
  209. 122     CONTINUE
  210.       ENDIF
  211. C
  212. C  NOW PROVIDE THE MAXIMUM RADIUS VALUE AS A LABEL
  213. C
  214.       IF(MODE(1) .EQ. 1 .OR. MODE(1) .EQ. 2) THEN
  215.         IRAD = RADIAL
  216.         CALL LINLAB(IRAD,0,LAB,0)
  217.         CALL GSMOVE(XORG + RADIUS*XSKAL*0.8,YORG+RADIUS*YSKAL)
  218.         DO 123 JJ = 1,14
  219. 123     TAG(JJ+13) = LAB(JJ)
  220.         CALL GSPSTR(TAG)
  221.       ENDIF
  222. C
  223. C  AND PLACE THE PLOT LABEL ON THE PLOT
  224. C
  225.       LENGTH = LEN(PLTLAB)
  226.       CALL GSMOVE(XORG-CSIZE*LENGTH/2,YORG - RADIUS*YSKAL - 5*CSIZE)
  227.       CALL GSPSTR(PLTLAB)
  228. C
  229. C DEPENDING UPON MODE, CONVERT POLAR DATA TO X-Y FOR PLOT, OR NOT
  230. C
  231.       IF(MODE(1) .EQ. 1 .OR. MODE(1) .EQ. 3) THEN
  232.         DO 150, JJ = 1,NUM
  233. C
  234. C  LOG OR LIN RADIUS
  235. C
  236.           IF(MODE(2) .NE. 2) THEN
  237.             R = RR(JJ)
  238.           ELSE
  239.             R = ALOG10(RR(JJ))
  240.           ENDIF
  241.           DATA(JJ,1)=R * COS(THETA(JJ))
  242.           DATA(JJ,2)=R * SIN(THETA(JJ))
  243. 150     CONTINUE
  244.       ELSE
  245.         DO 155 JJ = 1,NUM
  246.           DATA(JJ,1)=RR(JJ)
  247.           DATA(JJ,2)=THETA(JJ)
  248. 155     CONTINUE
  249.       ENDIF
  250. C
  251. C  LOGARITHMIC AND OF FORM X+IY ?
  252. C
  253.       IF(MODE(2) .EQ. 2 .AND. (MODE(1) .EQ. 2 .OR. MODE(1) .EQ. 4)) THEN
  254.         DO 165 II = 1,NUM
  255.           DO 165 KK = 1,2
  256.             IF(DATA(II,KK) .GT. 0)DATA(II,KK) = ALOG10(DATA(II,KK))
  257. C
  258. C  DON'T PLOT ANYTHING THAT IS A NEGATIVE VALUE ON A LOG POLAR PLOT
  259. C
  260.             IF(DATA(II,KK) .LT. 0)DATA(II,KK) = 0
  261. 165     CONTINUE
  262.       ENDIF
  263. C
  264. C  NOW SCALE THE DATA TO FIT THE PLOT
  265. C
  266.       DO 170 JJ = 1,NUM
  267.         DATA(JJ,1) = DATA(JJ,1)*XSKAL + XORG
  268.         DATA(JJ,2) = DATA(JJ,2)*YSKAL + YORG
  269. 170   CONTINUE
  270.       LINSYL = MODE(8)
  271.       CALL GSLTYP(LINSYL)
  272.       CALL GSMOVE(DATA(1,1),DATA(1,2))
  273.       COLR = MODE(7)
  274.       CALL GSCOLR(COLR,IERR)
  275.       DO 211 JJ = 2,NUM
  276.         CALL GSDRAW(DATA(JJ,1),DATA(JJ,2))
  277. 211   CONTINUE
  278.       CALL GSLTYP(1)
  279. C
  280. C       NOW ADD SYMBOLS IF DESIRED
  281. C
  282.       IF (ISYMNO .LE. 0) GO TO 800
  283. C
  284. C   DO SYMBOLS IN SOLID LINES
  285. C
  286.       DO 400 I=1,NUM,NPBSYM
  287.       CALL GSMOVE(DATA(I,1),DATA(I,2))
  288.       CALL SYMBOL(ISYMNO,SYMSIZ)
  289. 400   CONTINUE
  290. C
  291. C   RESTORE LINE TYPE
  292. C
  293.  
  294.       ILNTYP = IOLDLT
  295. 800   CONTINUE
  296.       RETURN
  297.       END
  298. C
  299. C  THIS SUBROUTINE DRAWS THE CIRCLES FOR THE RANGE RINGS
  300. C
  301.       SUBROUTINE CIRCLE(RADIUS)
  302.       REAL*4 RADIUS
  303.       REAL*4 XVSTRT,YVSTRT,XVLEN,YVLEN,XOFF,YOFF,CXSIZE,CYSIZE,
  304.      1   TICKLN
  305.       INCLUDE PLTSIZ.PRM
  306.       INCLUDE PLTPRM.PRM
  307.       INCLUDE GCLTYP.PRM
  308.       REAL*4 DEVID,XLENCM,YLENCM,XRES,YRES,NDCLRS,IDVBTS,NFLINE,
  309.      1   XCLIPD,YCLIPD
  310.       COMMON /GCDCHR/ DEVID, XLENCM, YLENCM, XRES, YRES,
  311.      1   NDCLRS, IDVBTS, NFLINE, XCLIPD, YCLIPD
  312.       REAL*4 XMIN,XMAX,YMIN,YMAX
  313.       COMMON/PLTCLP/XMIN,XMAX,YMIN,YMAX
  314.       REAL*4 XORG,YORG,XSKAL,YSKAL
  315.       COMMON/POL/XORG,YORG,XSKAL,YSKAL
  316.       DTORAD = 6.283185/360
  317.       CALL GSMOVE(XORG+XSKAL*RADIUS,YORG)
  318.       DO 10 II = 1,360,2
  319.       XX = FLOAT(II)
  320.       X = XORG+RADIUS*XSKAL*COS(DTORAD*XX)
  321.       Y = YORG+RADIUS*YSKAL*SIN(DTORAD*XX)
  322.       CALL GSDRAW(X,Y)
  323. 10    CONTINUE
  324.       RETURN
  325.       END
  326.