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 / d3plot.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  6.5 KB  |  241 lines
  1.       SUBROUTINE D3PLOT (XXX, M, N, INCTRL, IOCTRL, IZ)
  2.       IMPLICIT NONE
  3. C
  4. C ***      3D PLOTTING
  5. C
  6.       INTEGER M, N, INCTRL, IOCTRL
  7.       REAL XXX(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:PLT3D.KOM
  16. C
  17.       INTEGER CHOICE, I, MN, IERR
  18.       CHARACTER*8 ICURS
  19.       REAL LABSIZ, XMAX, YMAX, ZMAX, ZMIN
  20. C
  21. C ***      FUNCTIONS
  22.       REAL GSXLCM, GSYLCM
  23. C
  24.       DATA ICURS / '3DPlot>>' /
  25. C
  26. C
  27. C ***      FIGURE OUT WHO CALLED US AND
  28. C ***        IF SO INDICATED JUMP DIRECTLY TO THE PLOT
  29.       IF (INCTRL.NE.0) GO TO 900
  30. C
  31. C ***      SET UP THE DEFAULTS
  32.       DO 25 I = 1, 80
  33.         XLAB3D(I) = Z'20'
  34.         YLAB3D(I) = Z'20'
  35.         ZLAB3D(I) = Z'20'
  36. 25    CONTINUE
  37.       LABE3D = 0
  38.       XST3D = 0
  39.       YST3D = 0
  40.       XFRC3D = 1
  41.       YFRC3D = 1
  42.       XYLIM(1,1) = 0
  43.       XYLIM(2,1) = M
  44.       XYLIM(1,2) = 0
  45.       XYLIM(2,2) = N
  46.       XYLIM(1,4) = 0.0
  47.       XYLIM(2,4) = 0.0
  48.       XYLIM(1,6) = XST3D
  49.       XYLIM(2,6) = YST3D
  50.       CAMLOC(1) = 2000.
  51.       CAMLOC(2) = 45
  52.       CAMLOC(3) = 30
  53.       FGRP3D = 1
  54.       IOCTRL = 0
  55.       MARPLT = 0
  56.       XMAX = GSXLCM ()
  57.       YMAX = GSYLCM ()
  58.       XYLIM(1,5) = XMAX
  59.       XYLIM(2,5) = YMAX * .9
  60.       MN = M*N
  61. C      WRITE (WTE, 657) ((XXX(J,K), J = 1, M), K = 1, N)
  62. C657   FORMAT (1X, F10.2)
  63.       CALL MINMAX (XXX, MN, ZMIN, ZMAX)
  64.       XYLIM(1,3) = ZMIN
  65.       XYLIM(2,3) = ZMAX
  66. C
  67. C ***      DETERMINE THE CHOICES
  68. C75    CONTINUE
  69.       CALL CHKEND
  70. C      CALL DSSTRN (' USE THE DEFAULT VALUES?', 1)
  71. C      CALL DSCURS (ICURS)
  72. C      READ (RTE, 80) ANS
  73. C80    FORMAT (A1)
  74. C      IF (ANS.EQ.'N' .OR. ANS.EQ.'n') THEN
  75. C        GO TO 100
  76. C      ELSE IF (ANS.EQ.'Y' .OR. ANS.EQ.'y') THEN
  77. C        GO TO 900
  78. C      ELSE
  79. C        CALL DSERR ('ERROR.  PLEASE ANSWER YES (Y) OR NO (N)')
  80. C        GO TO 75
  81. C      ENDIF
  82. 100   CONTINUE
  83.       CALL CHKEND
  84.       CALL DSBLLN (2)
  85.       CALL DSSTRN (' PLEASE CHOOSE AN OPTION', 1)
  86.       CALL DSSTRN (' [1] CHOOSE PLOT LABELS', 1)
  87.       CALL DSSTRN (' [2] CHOOSE PLOT VALUES', 1)
  88.       CALL DSSTRN (' [3] CHOOSE VIEWER PERSPECTIVE', 1)
  89.       CALL DSSTRN (' [4] CHOOSE HIDDEN LINES OPTIONS', 1)
  90.       CALL DSSTRN (' [5] CHOOSE PLOT COLOR', 1)
  91.       CALL DSSTRN (' [6] CHOOSE PLOT SIZE', 1)
  92.       CALL DSSTRN (' [7] DO THE PLOT', 1)
  93.       CALL DSSTRN (' [8] END THE CURRENT PLOT', 1)
  94.       CALL DSSTRN (' [9] EXIT 3D PLOT', 1)
  95.       CALL DSCURS (ICURS)
  96.       CALL VALGET (0, CHOICE, 'I')
  97.       GO TO (200, 300, 400, 500, 700, 800, 900, 899, 990), CHOICE
  98.       CALL MENUER (9)
  99.       GO TO 100
  100. C
  101. C ***      SELECT THE LABELS
  102. 200   CONTINUE
  103.       CALL CHKEND
  104.       CALL DSBLLN (2)
  105.       CALL DSSTRN (' ENTER THE X AXIS LABEL', 1)
  106.       CALL DSCURS (ICURS)
  107.       CALL GETLAB (XLAB3D)
  108.       CALL DSBLLN (2)
  109.       CALL DSSTRN (' ENTER THE Y AXIS LABEL', 1)
  110.       CALL DSCURS (ICURS)
  111.       CALL GETLAB (YLAB3D)
  112.       CALL DSBLLN (2)
  113.       CALL DSSTRN (' ENTER THE Z AXIS LABEL', 1)
  114.       CALL DSCURS (ICURS)
  115.       CALL GETLAB (ZLAB3D)
  116.       CALL DSBLLN (2)
  117.       CALL DSSTRN (' ENTER THE SIZE OF THE LABELS (CM)', 1)
  118.       CALL DSCURS (ICURS)
  119.       CALL VALGET (LABSIZ, 0, 'F')
  120.       IF (LABSIZ.NE.0) LABE3D = LABSIZ
  121.       GO TO 100
  122. C
  123. C ***      SELECT THE DATA
  124. 300   CONTINUE
  125.       CALL CHKEND
  126.       CALL DSSTRN (' ENTER THE MINIMUM VALUE OF X', 1)
  127.       CALL DSCURS (ICURS)
  128.       CALL VALGET (XYLIM(1,1), 0, 'F')
  129.       CALL DSSTRN (' ENTER THE MAXIMUM VALUE OF X', 1)
  130.       CALL DSCURS (ICURS)
  131.       CALL VALGET (XYLIM(2,1), 0, 'F')
  132.       CALL DSSTRN (' ENTER THE MINIMUM VALUE OF Y', 1)
  133.       CALL DSCURS (ICURS)
  134.       CALL VALGET (XYLIM(1,2), 0, 'F')
  135.       CALL DSSTRN (' ENTER THE MAXIMUM VALUE OF Y', 1)
  136.       CALL DSCURS (ICURS)
  137.       CALL VALGET (XYLIM(2,2), 0, 'F')
  138.       CALL DSSTRN (' ENTER THE X/Z LENGTH RATIO', 1)
  139.       CALL DSCURS (ICURS)
  140.       CALL VALGET (XYLIM(1,4), 0, 'F')
  141.       CALL DSSTRN (' ENTER THE Y/Z LENGTH RATIO', 1)
  142.       CALL DSCURS (ICURS)
  143.       CALL VALGET (XYLIM(2,4), 0, 'F')
  144.       GO TO 100
  145. C
  146. C ***      DEFINE THE VIEWER PERSPECTIVE
  147. 400   CONTINUE
  148.       CALL CHKEND
  149.       CALL DSSTRN (' ENTER THE DISTANCE OF THE OBSERVER FROM THE', 1)
  150.       CALL DSSTRN ('  CENTER OF THE PICTURE (SAME UNITS AS Z)', 1)
  151.       CALL DSCURS (ICURS)
  152.       CALL VALGET (CAMLOC(1), 0, 'F')
  153.       CALL DSSTRN (
  154.      .    ' ENTER THE ANGLE BETWEEN THE VIEWER AND THE X-AXIS', 1)
  155.       CALL DSCURS (ICURS)
  156.       CALL VALGET (CAMLOC(2), 0, 'F')
  157.       CALL DSSTRN (
  158.      .    ' ENTER THE ANGLE BETWEEN THE VIEWER AND THE X-Z PLANE', 1)
  159.       CALL DSCURS (ICURS)
  160.       CALL VALGET (CAMLOC(3), 0, 'F')
  161.       GO TO 100
  162. C
  163. C ***      CHOOSE THE HIDDEN LINE DRAWING MODE
  164. 500   CONTINUE
  165.       CALL CHKEND
  166. 507   CONTINUE
  167.  
  168.       CALL DSBLLN (2)
  169.       CALL DSSTRN (' SELECT THE DRAWING MODE', 1)
  170.       CALL DSSTRN (' [1] DRAW ALL LINES, HIDDEN OR NOT', 1)
  171.       CALL DSSTRN (
  172.      .    ' [2] SUPPRESS HIDDEN LINES, BUT DRAW TOP AND BOTTOM', 1)
  173.       CALL DSSTRN ('      OF THE SURFACE', 1)
  174.       CALL DSSTRN (
  175.      .    ' [3] SUPPRESS HIDDEN LINES, AS WELL AS ALL LINES SHOWING', 1)
  176.       CALL DSSTRN ('      THE BOTTOM OF THE SURFACE', 1)
  177.       CALL DSCURS (ICURS)
  178.       CALL VALGET (0, MARPLT, 'I')
  179.       GO TO (515, 515, 525) MARPLT
  180.       CALL MENUER (3)
  181.       GO TO 507
  182. C
  183. 515   CONTINUE
  184.       MARPLT = MARPLT - 1
  185. 525   CONTINUE
  186.       GO TO 100
  187. C
  188. C ***      SELECT THE PLOT COLOR
  189. 700   CONTINUE
  190.       CALL CHKEND
  191.       CALL SETFG (FGRP3D, ICURS)
  192.       GO TO 100
  193. C
  194. C ***      SELECT THE PLOT SIZE
  195. 800   CONTINUE
  196.       CALL CHKEND
  197.       CALL MAKSIZ (ICURS, XST3D, XFRC3D, YST3D, YFRC3D)
  198.       XYLIM(1,6) = XST3D*XMAX
  199.       XYLIM(2,6) = YST3D*YMAX
  200.       XYLIM(1,5) = XFRC3D*XMAX
  201.       XYLIM(2,5) = YFRC3D*YMAX
  202.       GO TO 100
  203. C
  204. 899   CONTINUE
  205.       IF (PLTST) THEN
  206.         PLTST = .FALSE.
  207.         CALL PLTFIN
  208.       ENDIF
  209.       GO TO 100
  210. C
  211. C ***      DO THE PLOT
  212. 900   CONTINUE
  213.       CALL CHKEND
  214. C
  215. C ***      SAVE THE PLOT SETTINGS, UNLESS WE ARE WORKING FROM A SAVED FILE
  216.       IF (INCTRL.EQ.0) CALL SAVPLT (1)
  217.       IF (.NOT.PLTST) THEN
  218.         PLTST = .TRUE.
  219.         CALL BGNPLT
  220.       ENDIF
  221.       IF (SETBG) THEN
  222.         SETBG = .FALSE.
  223.         CALL SETBAK (BGRP)
  224.       ENDIF
  225.       CALL GSCOLR (FGRP3D, IERR)
  226. C      DO 940 I = 1, 6
  227. C        WRITE (WTE, 950) XYLIM(1,I), XYLIM(2,I)
  228. C950     FORMAT (1X, 2F10.3)
  229. C940   CONTINUE
  230. C      WRITE (WTE, 960) (CAMLOC(I), I = 1, 3)
  231. C960   FORMAT (' CAMLOC:', 3F8.2)
  232. C      WRITE (WTE, 962) M, N, MARPLT
  233. C962   FORMAT (3I4)
  234.       CALL PURJOY (XXX, M, IZ, M, N, CAMLOC, XYLIM, XLAB3D, YLAB3D,
  235.      .             ZLAB3D, LABE3D, MARPLT)
  236.       IF (INCTRL.EQ.0) GO TO 100
  237. C
  238. 990   CONTINUE
  239.       RETURN
  240.       END
  241.