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 / xyplt.for < prev   
Encoding:
Text File  |  1991-04-13  |  12.4 KB  |  469 lines
  1.       SUBROUTINE XYPLT (XXX, M, N, INCTRL, IOCTRL)
  2.       IMPLICIT NONE
  3. C
  4. C ***      GENERAL X-Y PLOTTING
  5. C
  6.       INTEGER M, N, INCTRL, IOCTRL
  7.       REAL XXX(M,N)
  8. C
  9.       INCLUDE MATLAB$KOM:SIZEPARMS.INC
  10.       INCLUDE MATLAB$KOM:IOP.KOM
  11.       INCLUDE MATLAB$KOM:MATPLT.KOM
  12.       INCLUDE MATLAB$KOM:PLTXY.KOM
  13. C
  14.       REAL X(LINES,VECSIZ), Y(LINES,VECSIZ), XPL(VECSIZ), YPL(VECSIZ),
  15.      .     XLIM, YLIM, XMINH, XMAXH, YMINH, YMAXH, YYY,
  16.      .     SYMNXY, SYMXXY, SYMMXY
  17.       INTEGER IANS, I, J, K, IERR, IOPTNS
  18.       CHARACTER*8 ICURS
  19.       CHARACTER*4 ROWTAG
  20.       COMMON /AREA/ X,Y,XPL,YPL
  21. C
  22. C ***      FUNCTIONS
  23.       REAL GSXLCM, GSYLCM
  24. C
  25.       DATA ROWTAG / ' ROW' /
  26.       DATA ICURS / 'XYPlot>>' /
  27. C
  28. C
  29. C ***      FIND OUT WHO CALLED US
  30.       IF (INCTRL.NE.0) GO TO 800
  31. C
  32. C ***      SET UP THE DEFAULTS
  33.       ISECY = .FALSE.
  34.       CHRSIZ = 0
  35.       ISYOPT = 0
  36.       IAXSPN = 1
  37.       DO 1 I = 1, 80
  38.         XLABXY(I) = ' '
  39.         YLABXY(I) = ' '
  40.         SYLBXY(I) = ' '
  41.         LABXY(I) = ' '
  42. 1     CONTINUE
  43.       XLABXY(2) = Z'00'
  44.       YLABXY(2) = Z'00'
  45.       SYLBXY(2) = Z'00'
  46.       LABXY(2) = Z'00'
  47.       IPLTP1 = 0
  48.       IPLTP2 = 0
  49.       IPLTP3 = 0
  50.       NLINES = 0
  51.       DO 2 I = 1, LINES
  52.         LINSYL(I) = 1
  53.         SYMSZ(I) = .2
  54.         INTSYM(I) = 5
  55.         ISYMNO(I) = 0
  56.         FGRPXY(I) = I+1
  57. 2     CONTINUE
  58.       XLIM = GSXLCM ()
  59.       YLIM = GSYLCM ()
  60.       XSTXY = 0.
  61.       YSTXY = 0.
  62.       XFRCXY = 100.
  63.       YFRCXY = 95
  64. C
  65. C ***      CHOOSE THE PLOT MODE
  66.       CALL CHKEND
  67. 7     CONTINUE
  68.       CALL DSSTRN (' PLEASE CHOOSE THE X-Y PLOT MODE:', 1)
  69.       CALL DSSTRN (' [1] IMPLICIT X, EXPLICIT Y', 1)
  70.       CALL DSSTRN (' [2] EXPLICIT X, EXPLICIT Y', 1)
  71.       CALL DSCURS (ICURS)
  72.       CALL VALGET (0, IDEFXY, 'I')
  73.       GO TO (4, 4), IDEFXY
  74.       CALL MENUER (2)
  75.       GO TO 7
  76. C
  77. C ***      DO AN ERROR TEST
  78. 4     CONTINUE
  79.       IF ( (M.EQ.1 .OR. N.EQ.1) .AND. IDEFXY.EQ.2) THEN
  80.         CALL DSERR ('ERROR.  ARRAY IS ONE DIMENSIONAL.  INSUFFICIENT')
  81.         CALL DSERR ('INFORMATION TO DO AN EXPLICIT X, EXPLICIT Y PLOT')
  82.         GO TO 995
  83.       ENDIF
  84. C
  85. C ***      DETERMINE WHETHER TO PLOT ALONG ROWS OR COLUMNS
  86.       CALL PLTPRP (X, Y, M, N, XXX, YYY, ICURS, TAG, NLINES,
  87.      .             LINXYX, LINXYY, NPTS, IDEFXY)
  88. C
  89. C ***      DETERMINE AXIS SCALING
  90.       XMINXY = 9999
  91.       YMINXY = 9999
  92.       XMAXXY = -99999
  93.       YMAXXY = -99999
  94.       DO 150 J = 1, NLINES
  95.         XMINH = 99999
  96.         XMAXH = -99999
  97.         YMINH = 99999
  98.         YMAXH = -99999
  99.         DO 130 K = 1, NPTS
  100.           XMINH = AMIN1 (XMINH, X(J,K))
  101.           XMAXH = AMAX1 (XMAXH, X(J,K))
  102.           YMINH = AMIN1 (YMINH, Y(J,K))
  103.           YMAXH = AMAX1 (YMAXH, Y(J,K))
  104. 130     CONTINUE
  105.         XMINXY = AMIN1 (XMINH, XMINXY)
  106.         XMAXXY = AMAX1 (XMAXH, XMAXXY)
  107.         YMINXY = AMIN1 (YMINH, YMINXY)
  108.         YMAXXY = AMAX1 (YMAXH, YMAXXY)
  109. 150   CONTINUE
  110.       XLO = XMINXY
  111.       XHI = XMAXXY
  112.       YLO = YMINXY
  113.       YHI = YMAXXY
  114.       SYMNXY = YMINXY
  115.       SYMXXY = YMAXXY
  116. C
  117. C ***      SELECT PLOT OPTIONS
  118. 160   CONTINUE
  119.       CALL CHKEND
  120.       CALL DSSTRN (' PLEASE CHOOSE AN OPTION', 1)
  121.       CALL DSSTRN (' [1]  SELECT THE TYPE OF PLOT AXES', 1)
  122.       CALL DSSTRN (' [2]  SELECT THE X AND Y GRID MARKINGS', 1)
  123.       CALL DSSTRN (' [3]  SELECT X AND Y AXIS TICK MARK OPTIONS', 1)
  124.       CALL DSSTRN (' [4]  SELECT THE LINE OPTIONS', 1)
  125.       CALL DSSTRN (' [5]  SELECT THE PLOT COLORS', 1)
  126.       CALL DSSTRN (' [6]  SELECT THE BACKGROUND COLOR', 1)
  127.       CALL DSSTRN (' [7]  SELECT THE AXIS SCALES', 1)
  128.       CALL DSSTRN (' [8]  CHOOSE THE PLOT SIZE', 1)
  129.       CALL DSSTRN (' [9]  CHOOSE THE PLOT LABELS', 1)
  130.       CALL DSSTRN (' [10] DO THE PLOT', 1)
  131.       CALL DSSTRN (' [11] END THE CURRENT PLOT', 1)
  132.       CALL DSSTRN (' [12] EXIT XYPLOT', 1)
  133.       CALL DSCURS (ICURS)
  134.       CALL VALGET (0, IANS, 'I')
  135.       GO TO  (180, 300, 400, 620, 500, 750,
  136.      .        550, 600, 700, 800, 899, 995), IANS
  137.       CALL MENUER (12)
  138.       GO TO 160
  139. C
  140. 180   CONTINUE
  141.       CALL SETAXS (ICURS, IPLTP1, ISYOPT, ISECY, SYMNXY, SYMMXY,
  142.      .             XLO, YLO)
  143.       GO TO 160
  144. C
  145. C ***      SELECT THE GRID LINES OPTIONS
  146. 300   CONTINUE
  147.       CALL CHKEND
  148.       CALL DSSTRN (' PLEASE CHOOSE A GRID LINE OPTION', 1)
  149.       CALL DSSTRN (' [1] NO GRID LINES', 1)
  150.       CALL DSSTRN (' [2] GRID LINES ON X AXIS ONLY', 1)
  151.       CALL DSSTRN (' [3] GRID LINES ON Y AXIS ONLY', 1)
  152.       CALL DSSTRN (' [4] GRID LINES ON BOTH AXES', 1)
  153.       CALL DSCURS (ICURS)
  154.       CALL VALGET (0, IPLTP2, 'I')
  155.       GO TO  (320, 330, 340, 350), IPLTP2
  156.       CALL MENUER (4)
  157.       GO TO 300
  158. C
  159. 320   CONTINUE
  160.       IPLTP2 = 0
  161.       GO TO 160
  162. C
  163. 330   CONTINUE
  164.       IPLTP2 = 4
  165.       GO TO 160
  166. C
  167. 340   CONTINUE
  168.       IPLTP2 = 8
  169.       GO TO 160
  170. C
  171. 350   CONTINUE
  172.       IPLTP2 = 12
  173.       GO TO 160
  174. C
  175. C ***      SELECT THE TICK MARK OPTIONS
  176. 400   CONTINUE
  177.       IPLTP3 = 0
  178. 405   CONTINUE
  179.       CALL CHKEND
  180.       CALL DSSTRN (' PLEASE CHOOSE TICK MARK OPTIONS, ONE BY ONE.', 1)
  181.       CALL DSSTRN ('   NOTE THAT TICK MARK OPTIONS ARE CUMULATIVE.', 1)
  182.       CALL DSSTRN (' [1] CLEAR ALL TICK MARK OPTIONS', 1)
  183.       CALL DSSTRN (' [2] ALLOW X AXIS TO END NOT ON A TICK MARK', 1)
  184.       CALL DSSTRN (' [3] ALLOW Y AXIS TO END NOT ON A TICK MARK', 1)
  185.       CALL DSSTRN (' [4] DO NOT PLOT X AXIS TICK MARKS', 1)
  186.       CALL DSSTRN (' [5] DO NOT PLOT Y AXIS TICK MARKS', 1)
  187.       CALL DSSTRN (' [6] EXTRA X-AXIS AND TICKS ON TOP OF PLOT', 1)
  188.       CALL DSSTRN (' [7] EXTRA Y-AXIS AND TICKS TO RIGHT OF PLOT', 1)
  189.       CALL DSSTRN (' [8] SELECT TICK MARK AND TICK CHARACTER SIZE', 1)
  190.       CALL DSSTRN (' [9] RETURN TO XYPLOT MENU', 1)
  191.       CALL DSCURS (ICURS)
  192.       CALL VALGET (0, IANS, 'I')
  193.       GO TO  (420, 430, 440, 450, 460, 470, 480, 490, 160), IANS
  194.       CALL MENUER (9)
  195.       GO TO 405
  196. C
  197. 420   CONTINUE
  198.       GO TO 400
  199. C
  200. 430   CONTINUE
  201.       IPLTP3 = IPLTP3+16
  202.       GO TO 405
  203. C
  204. 440   CONTINUE
  205.       IPLTP3 = IPLTP3+32
  206.       GO TO 405
  207. C
  208. 450   CONTINUE
  209.       IPLTP3 = IPLTP3+512
  210.       GO TO 405
  211. C
  212. 460   CONTINUE
  213.       IPLTP3 = IPLTP3+1024
  214.       GO TO 405
  215. C
  216. 470   CONTINUE
  217.       IPLTP3 = IPLTP3+64
  218.       GO TO 405
  219. C
  220. 480   CONTINUE
  221.       IPLTP3 = IPLTP3+128
  222.       GO TO 405
  223. C
  224. 490   CONTINUE
  225.       CALL CHKEND
  226.       CALL DSSTRN (' PLEASE CHOOSE A TICK MARK SIZING OPTION', 1)
  227.       CALL DSSTRN (' [1] USE AUTO SIZING', 1)
  228.       CALL DSSTRN (' [2] CHOOSE THE SIZE', 1)
  229.       CALL DSCURS (ICURS)
  230.       CALL VALGET (0, IANS, 'I')
  231.       GO TO  (494, 496), IANS
  232.       CALL MENUER (2)
  233.       GO TO 490
  234. C
  235. 494   CONTINUE
  236.       CHRSIZ = 0
  237.       GO TO 405
  238. C
  239. 496   CONTINUE
  240.       CALL DSSTRN (' ENTER THE TICK MARK CHARACTER SIZE (CM)', 1)
  241.       CALL DSCURS (ICURS)
  242.       CALL VALGET (CHRSIZ, 0, 'F')
  243.       GO TO 405
  244. C
  245. C ***      DEFINE THE PLOT COLORS
  246. 500   CONTINUE
  247.       CALL CHKEND
  248.       CALL DSSTRN (' PLEASE CHOOSE A PLOT COLOR OPTION', 1)
  249.       CALL DSSTRN (' [1] SELECT THE LINE COLORS', 1)
  250.       CALL DSSTRN (' [2] SELECT THE AXIS COLORS', 1)
  251.       CALL DSSTRN (' [3] RETURN TO XYPLOT MENU', 1)
  252.       CALL DSCURS (ICURS)
  253.       CALL VALGET (0, IANS, 'I')
  254.       GO TO  (520, 540, 160), IANS
  255.       CALL MENUER (3)
  256.       GO TO 500
  257. C
  258. 520   CONTINUE
  259.       DO 536 I = 1, NLINES
  260.         CALL DSSTRN (' FOR LINE NUMBER ', 0)
  261.         CALL DSWDI (I, 1)
  262.         CALL SETFG (FGRPXY(I), ICURS)
  263. 536   CONTINUE
  264.       GO TO 500
  265. C
  266. 540   CONTINUE
  267.       CALL DSSTRN (' FOR THE X-Y AXES', 1)
  268.       CALL SETFG (IAXSPN, ICURS)
  269.       GO TO 500
  270. C
  271. C ***      SET THE AXIS SCALING
  272. 550   CONTINUE
  273.       CALL CHKEND
  274.       CALL DSSTRN (' PLEASE CHOOSE PLOT SCALE OPTIONS', 1)
  275.       CALL DSSTRN (' [1] USE AUTO-SCALING', 1)
  276.       CALL DSSTRN (' [2] SELECT X-AXIS SCALE', 1)
  277.       CALL DSSTRN (' [3] SELECT Y-AXIS SCALE', 1)
  278.       CALL DSSTRN (' [4] RETURN TO XYPLOT MENU', 1)
  279.       CALL DSCURS (ICURS)
  280.       CALL VALGET (0, IANS, 'I')
  281.       GO TO  (565, 570, 580, 160), IANS
  282.       CALL MENUER (4)
  283. C
  284. 565   CONTINUE
  285.       XMINXY = XLO
  286.       XMAXXY = XHI
  287.       YMINXY = YLO
  288.       YMAXXY = YHI
  289.       GO TO 160
  290. C
  291. 570   CONTINUE
  292.       CALL DSSTRN (' CHOOSE MINIMUM X-AXIS VALUE', 1)
  293.       CALL DSCURS (ICURS)
  294.       CALL VALGET (XMINXY, 0, 'F')
  295.       CALL DSSTRN (' CHOOSE MAXIMUM X-AXIS VALUE', 1)
  296.       CALL DSCURS (ICURS)
  297.       CALL VALGET (XMAXXY, 0, 'F')
  298.       GO TO 550
  299. C
  300. 580   CONTINUE
  301.       CALL DSSTRN (' CHOOSE MINIMUM Y-AXIS VALUE', 1)
  302.       CALL DSCURS (ICURS)
  303.       CALL VALGET (YMINXY, 0, 'F')
  304.       CALL DSSTRN (' CHOOSE MAXIMUM Y-AXIS VALUE', 1)
  305.       CALL DSCURS (ICURS)
  306.       CALL VALGET (YMAXXY, 0, 'F')
  307.       GO TO 550
  308. C
  309. C ***      CHOOSE THE PLOT SIZE
  310. 600   CONTINUE
  311.       CALL CHKEND
  312.       CALL MAKSIZ (ICURS, XSTXY, XFRCXY, YSTXY, YFRCXY)
  313.       XSTXY = XSTXY*100.
  314.       YSTXY = YSTXY*100.
  315.       XFRCXY = XFRCXY*100.+XSTXY
  316.       YFRCXY = YFRCXY*100.+YSTXY
  317.       GO TO 160
  318. C
  319. C ***      SET LINE OPTIONS
  320. 620   CONTINUE
  321.       CALL CHKEND
  322.       CALL LNOPTS (NLINES, SYMSZ, INTSYM, ISYMNO, LINSYL, ICURS)
  323.       GO TO 160
  324. C
  325. C ***      SET THE PLOT LABELS
  326. 700   CONTINUE
  327.       CALL CHKEND
  328.       CALL DSSTRN (' ENTER THE X-AXIS LABEL', 1)
  329.       CALL DSCURS (ICURS)
  330.       CALL GETLAB (XLABXY)
  331.       CALL DSSTRN (' ENTER THE Y-AXIS LABEL', 1)
  332.       CALL DSCURS (ICURS)
  333.       CALL GETLAB (YLABXY)
  334.       CALL DSSTRN (' ENTER THE PLOT LABEL', 1)
  335.       CALL DSCURS (ICURS)
  336.       CALL GETLAB (LABXY)
  337.       IF (ISECY) THEN
  338.         CALL DSSTRN (' ENTER THE SECOND Y-AXIS LABEL', 1)
  339.         CALL DSCURS (ICURS)
  340.         CALL GETLAB (SYLBXY)
  341.       ENDIF
  342.       GO TO 160
  343. C
  344. C ***      SET BACKGROUND COLOR
  345. 750    CONTINUE
  346.        CALL CHKEND
  347.        CALL CHBACK (ICURS)
  348.        GO TO 160
  349. C
  350. C ***      END THE PLOT
  351. 899   CONTINUE
  352.       IF (PLTST) THEN
  353.         PLTST = .FALSE.
  354.         CALL PLTFIN
  355.       ENDIF
  356.       GO TO 160
  357. C
  358. C ***      BEGIN PLOTTING
  359. 800   CONTINUE
  360.       CALL CHKEND
  361. C
  362. C ***      SAVE THE SETTINGS UNLESS WE ARE PLOTTING FROM SAVED SETTINGS
  363. C           IF SO, RESTORE THE VALUES TO BE PLOTTED.
  364.       IF (INCTRL.EQ.0) THEN
  365.         CALL SAVPLT (2)
  366.       ELSE
  367.         DO 840 J = 1, NLINES
  368.           IF (TAG.EQ.ROWTAG) THEN
  369.             DO 810 I = 1, N
  370.               IF (IDEFXY.EQ.2)THEN
  371.                 X(J,I) = XXX(LINXYX(J),I)
  372.               ELSE
  373.                 X(J,I) = FLOAT(I)
  374.               ENDIF
  375. 810         CONTINUE
  376.           ELSE
  377.             DO 820 I = 1, M
  378.               IF (IDEFXY.EQ.2)THEN
  379.                 X(J,I) = XXX(I,LINXYX(J))
  380.               ELSE
  381.                 X(J,I) = FLOAT(I)
  382.               ENDIF
  383. 820         CONTINUE
  384.           ENDIF
  385.           IF (TAG.EQ.ROWTAG) THEN
  386.             DO 830 I = 1, N
  387.               Y(J,I) = XXX(LINXYY(J),I)
  388. 830         CONTINUE
  389.           ELSE
  390.             DO 832 I = 1, M
  391.               Y(J,I) = XXX(I,LINXYY(J))
  392. 832         CONTINUE
  393.           ENDIF
  394. 840     CONTINUE
  395.       ENDIF
  396. C
  397. C ***      IF MODE 1, SCALE THE X-AXES
  398.       IF (IDEFXY.EQ.1) THEN
  399.         DO 845 J = 1, NLINES
  400.           IF (TAG.EQ.ROWTAG) THEN
  401.             DO 843 I = 1, N
  402.               X(J,I) = X(J,I)*XMAXXY/FLOAT(N)
  403. 843         CONTINUE
  404.           ELSE
  405.             DO 844 I = 1, M
  406.               X(J,I) = X(J,I)*XMAXXY/FLOAT(M)
  407. 844         CONTINUE
  408.           ENDIF
  409. 845     CONTINUE
  410.       ENDIF
  411.       IF ( (XMINXY.LE.0 .AND. (IPLTP1.EQ.1 .OR. IPLTP1.EQ.3)) .OR.
  412.      .     (YMINXY.LE.0 .AND. (IPLTP1.EQ.2 .OR. IPLTP1.EQ.3))) THEN
  413.         CALL DSERR ('ERROR. AXIS LIMITS INCOMPATIBLE WITH LOG PLOT')
  414.         GO TO 160
  415.       ENDIF
  416.       IF (ISECY .AND. SYMNXY.LE.0 .AND. ISYOPT.EQ.2) THEN
  417.         CALL DSERR (
  418.      .      'ERROR. SECOND Y-AXIS LIMITS INCOMPATIBLE WITH LOG PLOT')
  419.         GO TO 160
  420.       ENDIF
  421. C
  422.       IF (.NOT.PLTST) THEN
  423.         PLTST = .TRUE.
  424.         CALL BGNPLT
  425.       ENDIF
  426.       IF (SETBG) THEN
  427.         SETBG = .FALSE.
  428.         CALL SETBAK (BGRP)
  429.       ENDIF
  430.       CALL GSCOLR (IAXSPN, IERR)
  431. C
  432. C ***      DEFINE PLOT SIZE
  433.       IF (ISECY) THEN
  434.         CALL MAPSZ2 (XSTXY, XFRCXY, YSTXY, YFRCXY, CHRSIZ)
  435.       ELSE
  436.         CALL MAPSIZ (XSTXY, XFRCXY, YSTXY, YFRCXY, CHRSIZ)
  437.       ENDIF
  438. C
  439. C ***      GENERATE THE AXES
  440.       IOPTNS = IPLTP1+IPLTP2+IPLTP3
  441.       CALL GSLTYP (1)
  442.       CALL MAPIT (XMINXY, XMAXXY, YMINXY, YMAXXY,
  443.      .            XLABXY, YLABXY, LABXY, IOPTNS)
  444.  
  445. C
  446. C ***      DO THE LINES ON THE PLOT
  447.       DO 900 INDEX = 1, NLINES
  448.         DO 882 I = 1, NPTS
  449.           XPL(I) = X(INDEX,I)
  450.           YPL(I) = Y(INDEX,I)
  451. 882     CONTINUE
  452.         CALL GSCOLR (FGRPXY(INDEX), IERR)
  453.         CALL GSLTYP (LINSYL(INDEX))
  454.         CALL CURVE (XPL, YPL, NPTS, ISYMNO(INDEX), SYMSZ(INDEX),
  455.      .              INTSYM(INDEX))
  456. 900   CONTINUE
  457. C
  458. C ***      DO THE SECOND Y AXIS
  459.       IF (ISECY) THEN
  460.         CALL GSCOLR (IAXSPN, IERR)
  461.         CALL GSLTYP (1)
  462.         CALL SYAXIS (SYMNXY, SYMXXY, SYLBXY, ISYOPT)
  463.       ENDIF
  464.       IF (INCTRL.EQ.0) GO TO 160
  465. C
  466. 995   CONTINUE
  467.       RETURN
  468.       END
  469.