home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / libs / matlab.lzh / MATLAB / MATLAB.LZH / Source / Plot / polplt.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  9.2 KB  |  363 lines
  1.       SUBROUTINE POLPLT (XXX, YYY, M, N, INCTRL, IOCTRL, IZ)
  2.       IMPLICIT NONE
  3. C
  4. C THE POLAR PLOTTING ROUTINE
  5. C
  6.       INTEGER M, N, INCTRL, IOCTRL
  7.       REAL XXX(M,N), YYY(M,N)
  8. C
  9.       INCLUDE MATLAB$KOM:SIZEPARMS.INC
  10. C
  11.       CHARACTER*1 IZ(VARSIZE)
  12. C
  13.       INCLUDE MATLAB$KOM:IOP.KOM
  14.       INCLUDE MATLAB$KOM:MATPLT.KOM
  15.       INCLUDE MATLAB$KOM:PLTPP.KOM
  16. C
  17.       INTEGER CHOICE, ICHOICE, I, J, MN
  18. C
  19.       REAL X(LINES,VECSIZ), Y(LINES,VECSIZ), XPL(VECSIZ), YPL(VECSIZ)
  20.       COMMON /AREA/ X,Y,XPL,YPL
  21. C
  22.       CHARACTER*8 ICURS
  23.       CHARACTER*4 ROWTAG
  24. C
  25.       DATA ICURS / 'Polar >>' /
  26.       DATA ROWTAG / ' ROW' /
  27. C
  28. C
  29. C ***      FIGURE OUT WHO CALLED US AND
  30. C ***        IF SO INDICATED JUMP DIRECTLY TO THE PLOT
  31.       IF (INCTRL.NE.0) GO TO 900
  32. C
  33. C ***      SET UP THE DEFAULTS
  34.       DO 25 I = 1, 80
  35.         LABPP(I) = CHAR(0)
  36. 25    CONTINUE
  37.       DO 10 I = 1, 10
  38.         SMSZPP(I) = 0
  39.         NTSMPP(I) = 0
  40.         ISMNPP(I) = 0
  41.         LNSLPP(I) = 1
  42.         LINXPP(I) = 0
  43.         LINYPP(I) = 0
  44.         FGRPPP(I) = I+1
  45. 10    CONTINUE
  46.       LABEPP = 0
  47.       MODE1A = 1
  48.       MODE1B = 0
  49.       MODE2A = 1
  50.       MODEPP(2) = 1
  51.       MODEPP(3) = 0
  52.       MODEPP(4) = 1
  53.       MODEPP(5) = -30
  54.       MODEPP(7) = 2
  55.       XSTPP = 0
  56.       YSTPP = 0
  57.       XFRCPP = 100
  58.       YFRCPP = 100
  59.       BGRPPP = 1
  60.       IOCTRL = 0
  61.       NLINPP = 0
  62.       MN = M*N
  63. C
  64. C ***      CHOOSE THE PLOT MODE
  65.       CALL CHKEND
  66. 7     CONTINUE
  67.       CALL DSSTRN (' PLEASE CHOOSE THE POLAR PLOT MODE:', 1)
  68.       CALL DSSTRN (' [1] R-THETA PLOT (TYPE REAL)', 1)
  69.       CALL DSSTRN (' [2] COMPLEX (X+IY) PLOT', 1)
  70.       CALL DSCURS (ICURS)
  71.       CALL VALGET (0, IDEFPP, 'I')
  72.       GO TO (4, 4), IDEFPP
  73.       CALL MENUER (2)
  74.       GO TO 7
  75. C
  76. 4     CONTINUE
  77.       MODE1A = IDEFPP
  78.       IDEFPP = IDEFPP + 2
  79. C
  80. C ***      DETERMINE WHETHER TO PLOT ALONG ROWS OR COLUMNS
  81.       CALL PLTPRP (X, Y, M, N, XXX, YYY, ICURS, TAGPP, NLINPP,
  82.      .             LINXPP, LINYPP, NPTSPP, IDEFPP)
  83. C
  84. C ***      DETERMINE THE CHOICES
  85. 100   CONTINUE
  86.       CALL CHKEND
  87.       CALL DSBLLN (2)
  88.       CALL DSSTRN (' PLEASE CHOOSE AN OPTION', 1)
  89.       CALL DSSTRN (' [1]  DEFINE THE PLOT LABEL', 1)
  90.       CALL DSSTRN (' [2]  CHOOSE PLOT AXIS TYPE', 1)
  91.       CALL DSSTRN (' [3]  CHOOSE LINE OPTIONS', 1)
  92.       CALL DSSTRN (' [4]  CHOOSE PLOT AXIS AND TICK MARK OPTIONS', 1)
  93.       CALL DSSTRN (' [5]  CHOOSE THE BACKGROUND COLOR', 1)
  94.       CALL DSSTRN (' [6]  CHOOSE PLOT COLOR', 1)
  95.       CALL DSSTRN (' [7]  CHOOSE PLOT SIZE', 1)
  96.       CALL DSSTRN (' [8]  DO THE PLOT', 1)
  97.       CALL DSSTRN (' [9]  END THE CURRENT PLOT', 1)
  98.       CALL DSSTRN (' [10] EXIT POLAR PLOTS', 1)
  99.       CALL DSCURS (ICURS)
  100.       CALL VALGET (0, CHOICE, 'I')
  101.       GO TO (200, 300, 400, 500, 600, 700, 800, 900, 899, 990), CHOICE
  102.       CALL MENUER (10)
  103.       GO TO 100
  104. C
  105. C ***      SELECT THE LABELS
  106. 200   CONTINUE
  107.       CALL CHKEND
  108.       CALL DSBLLN (2)
  109.       CALL DSSTRN (' ENTER THE PLOT LABEL', 1)
  110.       CALL DSCURS (ICURS)
  111.       CALL GETLAB (LABPP)
  112.       GO TO 100
  113. C
  114. C ***      SELECT THE DATA
  115. 300   CONTINUE
  116.       CALL CHKEND
  117.       CALL DSBLLN (2)
  118.       CALL DSSTRN (' CHOOSE THE PLOT AXIS TYPE', 1)
  119.       CALL DSSTRN (' [1] LINEAR RADIUS PLOT', 1)
  120.       CALL DSSTRN (' [2] LOGARITHMIC RADIUS', 1)
  121.       CALL DSSTRN (' [3] RETURN TO MAIN MENU', 1)
  122.       CALL DSCURS (ICURS)
  123.       CALL VALGET (0, ICHOICE, 'I')
  124.       GO TO (330, 340, 100), ICHOICE
  125.       CALL MENUER (3)
  126.       GO TO 300
  127. C
  128. 330   CONTINUE
  129.       MODE2A = 1
  130.       GO TO 300
  131. C
  132. 340   CONTINUE
  133.       MODE2A = 2
  134.       GO TO 300
  135. C
  136. C ***      LINE OPTIONS
  137. 400   CONTINUE
  138.       CALL DSSTRN (' PLEASE CHOOSE A DATA LINE OPTION', 1)
  139.       CALL DSSTRN (' [1] CHOOSE LINE COLOR', 1)
  140.       CALL DSSTRN (' [2] CHOOSE LINE STYLE', 1)
  141.       CALL DSSTRN (' [3] RETURN TO POLAR PLOT MENU', 1)
  142.       CALL DSCURS (ICURS)
  143.       CALL VALGET (0, ICHOICE, 'I')
  144.       GO TO (420, 443, 100), ICHOICE
  145.       CALL MENUER (3)
  146.       GO TO 400
  147. C
  148. 420   CONTINUE
  149.       DO 425 I = 1, NLINPP
  150.         CALL DSSTRN (' FOR LINE NUMBER ', 0)
  151.         CALL DSWDI (I, 1)
  152.         CALL SETFG (FGRPPP(I), ICURS)
  153. 425   CONTINUE
  154.       GO TO 400
  155. C
  156. 443   CONTINUE
  157.       CALL CHKEND
  158.       CALL LNOPTS (NLINPP, SMSZPP, NTSMPP, ISMNPP, LNSLPP, ICURS)
  159.       GO TO 400
  160. C
  161. C ***      AXIS AND TICK MARK OPTIONS
  162. 500   CONTINUE
  163.       CALL CHKEND
  164.       CALL DSSTRN (' SELECT AXIS OR TICK MARK OPTIONS', 1)
  165.       CALL DSSTRN (' [1] NO AXIS, TICK MARKS, OR RANGE RINGS', 1)
  166.       CALL DSSTRN (' [2] DRAW AXIS ONLY', 1)
  167.       CALL DSSTRN (' [3] DRAW TICK MARKS', 1)
  168.       CALL DSSTRN (' [4] DRAW RANGE RINGS', 1)
  169.       CALL DSSTRN (' [5] RETURN TO MAIN MENU', 1)
  170.       CALL DSCURS (ICURS)
  171.       CALL VALGET (0, ICHOICE, 'I')
  172.       GO TO (510, 520, 530, 540, 100), ICHOICE
  173.       CALL MENUER (5)
  174.       GO TO 500
  175. C
  176. 510   CONTINUE
  177.       MODE1B = 2
  178.       GO TO 500
  179. C
  180. 520   CONTINUE
  181.       MODE1B = 0
  182.       GO TO 500
  183. C
  184. 530   CONTINUE
  185.       CALL DSSTRN (
  186.      .    ' ENTER THE NUMBER OF DEGREES BETWEEN EACH TICK MARK', 1)
  187.       CALL DSCURS (ICURS)
  188.       CALL VALGET (0, ICHOICE, 'I')
  189.       MODEPP(5) = ICHOICE
  190. 534   CONTINUE
  191.       CALL DSSTRN (' PLEASE CHOOSE AN OPTION', 1)
  192.       CALL DSSTRN (' [1] INWARD POINTING TICK MARKS', 1)
  193.       CALL DSSTRN (' [2] OUTWARD POINTING TICK MARKS', 1)
  194.       CALL DSCURS (ICURS)
  195.       CALL VALGET (0, ICHOICE, 'I')
  196.       GO TO (537, 538), ICHOICE
  197.       CALL MENUER (2)
  198.       GO TO 534
  199. C
  200. 537   CONTINUE
  201.       IF (MODEPP(5).GT.0) MODEPP(5) = -MODEPP(5)
  202.       GO TO 500
  203. C
  204. 538   CONTINUE
  205.       IF (MODEPP(5).LT.0) MODEPP(5) = -MODEPP(5)
  206.       GO TO 500
  207. C
  208. 540   CONTINUE
  209.       CALL DSSTRN (
  210.      .    ' PLEASE ENTER THE NUMBER OF RANGE RINGS TO PLOT', 1)
  211.       CALL DSCURS (ICURS)
  212.       CALL VALGET (0, ICHOICE, 'I')
  213.       MODEPP(3) = ICHOICE
  214. C
  215. 543   CONTINUE
  216.       CALL DSSTRN (' PLEASE CHOOSE A RANGE RING LINE OPTION', 1)
  217.       CALL DSSTRN (' [1] SOLID LINE', 1)
  218.       CALL DSSTRN (' [2] LONG DASHED LINE', 1)
  219.       CALL DSSTRN (' [3] SHORT DASHED LINE', 1)
  220.       CALL DSSTRN (' [4] DOT-DASH LINE', 1)
  221.       CALL DSCURS (ICURS)
  222.       CALL VALGET (0, ICHOICE, 'I')
  223.       GO TO (546, 546, 546, 546), ICHOICE
  224.       CALL MENUER (4)
  225.       GO TO 543
  226. C
  227. 546   CONTINUE
  228.       MODEPP(4) = ICHOICE
  229.       GO TO 500
  230. C
  231. C ***      SET THE BACKGROUND COLOR
  232. 600   CONTINUE
  233.       CALL CHKEND
  234.       CALL CHBACK (ICURS)
  235.       GO TO 100
  236. C
  237. C ***      SELECT THE PLOT COLOR
  238. 700   CONTINUE
  239.       CALL CHKEND
  240.       CALL SETFG (BGRPPP, ICURS)
  241.       GO TO 100
  242. C
  243. C ***      SELECT THE PLOT SIZE
  244. 800   CONTINUE
  245.       CALL CHKEND
  246.       CALL MAKSIZ (ICURS, XSTPP, XFRCPP, YSTPP, YFRCPP)
  247.       XSTPP = XSTPP*100.
  248.       YSTPP = YSTPP*100.
  249.       XFRCPP = XFRCPP*100.+XSTPP
  250.       YFRCPP = YFRCPP*100.+YSTPP
  251.       GO TO 100
  252. C
  253. C ***      END THE PLOT
  254. 899   CONTINUE
  255.       IF (PLTST) THEN
  256.         PLTST = .FALSE.
  257.         CALL PLTFIN
  258.       ENDIF
  259.       GO TO 100
  260. C
  261. C ***      DO THE PLOT
  262. 900   CONTINUE
  263.       CALL CHKEND
  264. C
  265. C ***      DETERMINE WHETHER THIS IS THE FIRST PLOT.
  266.        IF (.NOT.PLTST) THEN
  267.          PLTST = .TRUE.
  268.          CALL BGNPLT
  269.        ENDIF
  270.        IF (SETBG) THEN
  271.          SETBG = .FALSE.
  272.          CALL SETBAK (BGRP)
  273.        ENDIF
  274. C
  275. C ***      IF THIS IS A BATCH JOB:
  276.       IF (INCTRL.NE.0) THEN
  277.         DO 840 J = 1, NLINPP
  278.           IF (TAGPP .EQ. ROWTAG) THEN
  279.             DO 810 I = 1, N
  280.               X(J,I) = XXX(LINXPP(J),I)
  281. 810         CONTINUE
  282.           ELSE
  283.             DO 820 I = 1, M
  284.               X(J,I) = XXX(I,LINXPP(J))
  285. 820         CONTINUE
  286.           ENDIF
  287.           IF (TAGPP .EQ. ROWTAG) THEN
  288.             DO 830 I = 1, N
  289.               IF (MODE1A .EQ. 1) THEN
  290.                 Y(J,I) = XXX(LINYPP(J),I)
  291.               ELSE
  292.                 Y(J,I) = YYY(LINYPP(J),I)
  293.               ENDIF
  294. 830         CONTINUE
  295.           ELSE
  296.             DO 832 I = 1, M
  297.               IF (MODE1A .EQ. 1) THEN
  298.                 Y(J,I) = XXX(I,LINYPP(J))
  299.               ELSE
  300.                 Y(J,I) = YYY(I,LINYPP(J))
  301.               ENDIF
  302. 832         CONTINUE
  303.           ENDIF
  304. 840     CONTINUE
  305.       ENDIF
  306. C
  307. C ***      FIND THE MAXIMUM RADIUS
  308.       IF (INCTRL.EQ.0) THEN
  309.         RMAX = -1
  310.         DO 905 I = 1, NLINPP
  311.         DO 905 J = 1, NPTSPP
  312.           RMAX = AMAX1(RMAX, X(I,J))
  313. 905     CONTINUE
  314.         IF (MODE1A.EQ.2) THEN
  315.           DO 906 I = 1, NLINPP
  316.           DO 906 J = 1, NPTSPP
  317.             RMAX = AMAX1(RMAX, Y(I,J))
  318. 906       CONTINUE
  319.         ENDIF
  320.       ENDIF
  321. C
  322.       DO 920 J = 1, NPTSPP
  323.         XPL(J) = X(1,J)
  324.         YPL(J) = Y(1,J)
  325. 920   CONTINUE
  326.       IF (INCTRL.EQ.0) THEN
  327.         MODEPP(8) = LNSLPP(1)
  328.         MODEPP(7) = FGRPPP(1)
  329.         MODEPP(6) = BGRPPP
  330.         MODEPP(1) = MODE1A + MODE1B
  331.         MODEPP(2) = MODE2A
  332.         CALL SAVPLT (5)
  333.       ENDIF
  334. C
  335.       CALL MAPSIZ (XSTPP, XFRCPP, YSTPP, YFRCPP, LABEPP)
  336.       CALL POLAR (RMAX, XPL, YPL, IZ, MODEPP, NPTSPP,
  337.      .            ISMNPP(1), SMSZPP(1), NTSMPP(1), LABPP)
  338.       IF (NLINPP.GT.1) THEN
  339. C        WRITE (9, 4554)
  340. C4554    FORMAT (' TAKING MULTI LINE BRANCH')
  341.         MODEPP(1) = MODE1A+2
  342.         MODEPP(3) = 0
  343.         MODEPP(4) = 0
  344.         MODEPP(5) = 0
  345.         MODEPP(6) = 0
  346.         DO 950 I = 2, NLINPP
  347.           DO 940 J = 1, NPTSPP
  348.             XPL(J) = X(I,J)
  349.           YPL(J) = Y(I,J)
  350. 940       CONTINUE
  351.           MODEPP(7) = FGRPPP(I)
  352.           MODEPP(8) = LNSLPP(I)
  353.           CALL POLAR (RMAX, XPL, YPL, IZ, MODEPP, NPTSPP,
  354.      .                ISMNPP(I), SMSZPP(I), NTSMPP(I), LABPP)
  355. 950     CONTINUE
  356.       ENDIF
  357. C
  358.       IF (INCTRL.EQ.0) GO TO 100
  359. C
  360. 990   CONTINUE
  361.       RETURN
  362.       END
  363.