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 / plot.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  7.2 KB  |  256 lines
  1.       SUBROUTINE PLOT (LOC, M, N, INCTRL)
  2.       IMPLICIT NONE
  3. C
  4. C AMIGA PLOT ROUTINE FOR MATLAB.  COPYRIGHT 1988, 1989 BY JAMES LOCKER.
  5. C   ALL RIGHTS RESERVED.  THIS PROGRAM FILE MAY NOT BE USED IN WHOLE OR IN
  6. C   PART FOR ANY COMMERCIAL APPLICATION WITHOUT THE PRIOR WRITTEN PERMISSION
  7. C   OF THE AUTHOR,  EXCEPT WHEN SUPPLIED IN COMPILED FORM AS PART OF MATLAB.
  8. C   THIS FILE MAY BE FREELY REDISTRIBUTED SO LONG AS THIS NOTICE IS INTACT.
  9. C
  10. C MATLAB WRITTEN BY CLEVE MOLER OF UNIVERSITY OF NEW MEXICO.
  11. C   PUBLIC DOMAIN VERSION ENHANCED BY JAMES LOCKER,  SOFTECH INC.
  12. C
  13. C DIGLIB WRITTEN BY HAL BRAND.
  14. C   PORTED TO AMIGA BY DR. CRAIG WUEST OF LLNL
  15. C   DEBUGGED AND ENHANCED BY JAMES LOCKER,  SOFTECH INC.
  16. C
  17.       INTEGER LOC, M, N, INCTRL
  18. C
  19.       INCLUDE MATLAB$KOM:SIZEPARMS.INC
  20. C
  21.       INTEGER I, J, IK, JK, ISRC, ICHOICE, IERR, NDUM
  22.       REAL XXX(VARSIZE), YYY(VARSIZE), XX
  23.       CHARACTER*8 ICURS
  24.       CHARACTER*4 NAME(32)
  25.       CHARACTER*1 IZ(VARSIZE), ANS, QUOT, NAME2(128)
  26.       EQUIVALENCE (NAME, NAME2)
  27. C
  28. C ***      NOW WE WANT TO KEEP THE STACKSIZE REASONABLE.  SO WE PLACE OUR
  29. C          PRINCIPAL VARIABLES IN COMMON.  THE COMMON IS ONLY USED HERE,
  30. C          BUT THIS KEEPS THEM OFF THE STACK
  31. C
  32.       COMMON /AREA2/ XXX,YYY,IZ
  33. C
  34. C ***      ESTABLISH A WORKSPACE (SCRATCHPAD...ANY ROUTINE MAY DEFINE 
  35. C          THE DATA IN THIS COMMON TO BE ANY TYPE AT ALL...WHATEVER IS NEEDED
  36. C          LOCALLY).  THIS IS DONE IN COMMON TO KEEP THE STACK SIZE UNDER
  37. C          CONTROL, GIVEN THE WAY AMIGA ABSOFT FORTRAN STORES VARIABLES
  38. C
  39.       CHARACTER*4 DATA(WORKSIZE)
  40.       COMMON /AREA/ DATA
  41. C
  42. C ***      ALL COMMONS INCLUDED TO ENSURE THEY STAY DEFINED FOR SUBROUTINES
  43. C
  44. C ***      MATLAB COMMONS
  45.       INCLUDE MATLAB$KOM:VSTK.KOM
  46.       INCLUDE MATLAB$KOM:RECU.KOM
  47.       INCLUDE MATLAB$KOM:IOP.KOM
  48.       INCLUDE MATLAB$KOM:COM.KOM
  49.       INCLUDE MATLAB$KOM:ALFS.KOM
  50.       INCLUDE MATLAB$KOM:SYS.KOM
  51.       INCLUDE MATLAB$KOM:MATPLT.KOM
  52.       INCLUDE MATLAB$KOM:PLT3D.KOM
  53.       INCLUDE MATLAB$KOM:PLTXY.KOM
  54.       INCLUDE MATLAB$KOM:BAR.KOM
  55.       INCLUDE MATLAB$KOM:PLTCP.KOM
  56.       INCLUDE MATLAB$KOM:PLTPP.KOM
  57.       INCLUDE MATLAB$KOM:SAV.KOM
  58. C
  59. C ***      AMIGA SYSTEM VARIABLES, COMMONS, STRUCTURES
  60.       EXTERNAL LEN
  61.       INCLUDE AMIGA$KOM:graph.inc
  62.       INCLUDE AMIGA$KOM:exec.inc
  63.       INCLUDE AMIGA$KOM:intuit.inc
  64. C
  65. C ***      DIGLIB COMMONS
  66.       INCLUDE DIGLIB$KOM:window.inc
  67.       INCLUDE DIGLIB$KOM:PLTPRM.PRM
  68.       INCLUDE DIGLIB$KOM:GCCLIP.PRM
  69. C            ! REMOVE GCCOFF FROM IN PLTSIZ.PRM FIRST
  70. C      INCLUDE DIGLIB$KOM:GCCOFF.PRM
  71.       INCLUDE DIGLIB$KOM:GCCPAR.PRM
  72.       INCLUDE DIGLIB$KOM:GCCPOS.PRM
  73.       INCLUDE DIGLIB$KOM:PLTCOM.PRM
  74.       INCLUDE DIGLIB$KOM:PLTSIZ.PRM
  75.       INCLUDE DIGLIB$KOM:PLTCLP.PRM
  76.       INCLUDE DIGLIB$KOM:GCDCHR.PRM
  77.       INCLUDE DIGLIB$KOM:GCDPRM.PRM
  78.       INCLUDE DIGLIB$KOM:GCDSEL.PRM
  79.       INCLUDE DIGLIB$KOM:GCLTYP.PRM
  80.       INCLUDE DIGLIB$KOM:GCVPOS.PRM
  81. C
  82.       DATA ICURS / 'Plot  >>' /
  83.       DATA QUOT / 1H' /
  84. C
  85. C
  86. C ***      ESTABLISH DEFAULTS
  87.       COLOR1 = Z'9B33336D'
  88.       COLOR2 = Z'9B30306D'
  89.       COLOR3 = Z'9B33326D'
  90.       BGRP = 0
  91.       SETBG = .FALSE.
  92.       IF (PLTMAX.EQ.0) THEN
  93.         PLTCNT = 0
  94.         DO 3 I = 1, 10
  95.           DO 2 J = 1, XYSIZ
  96.             ISAV(I,J) = Z'20'
  97. 2         CONTINUE
  98.           IPLTYP(I) = 0
  99. 3       CONTINUE
  100.       ENDIF
  101. C
  102. C ***      IF WE ARE INTERACTIVE, ISSUE STACK WARNING TO PREVENT CRASHES,
  103. C ***        UNLESS WE STARTED FROM WORKBENCH OR HAVE BEEN HERE BEFORE.
  104.       IF (.NOT.PLTST .AND. (INCTRL.EQ.0) .AND.
  105.      .    (WBST.EQ.0) .AND. .NOT.BNHERE) THEN
  106.         CALL DSSTRN (' ENTERING PLOT.', 2)
  107.         CALL DSERR (
  108.      .     'WARNING...HAS THE STACK SIZE BEEN SET TO AT LEAST 100K?')
  109.         CALL DSCURS (ICURS)
  110.         READ (WTE, 11) ANS
  111. 11      FORMAT (A1)
  112.         IF (WIO.NE.0) WRITE (WIO, 12) ANS
  113. 12      FORMAT (1X, A1)
  114.         IF (ANS.NE.'Y' .AND. ANS.NE.'y') THEN
  115.           CALL DSSTRN (' EXITING PLOT FUNCTION', 1)
  116.           GO TO 9999
  117.         ENDIF
  118.       ENDIF
  119.       BNHERE = .TRUE.
  120. C
  121. C ***      START THE PLOTS
  122.       ISRC = 0
  123.       DO 70 J = LOC, LOC+N*M-1
  124.         XX = STKR(J)
  125.         XXX(J-LOC+1) = SNGL(XX)
  126.         XX = STKI(J)
  127.         YYY(J-LOC+1) = SNGL(XX)
  128. 70    CONTINUE
  129. C
  130. C ***      SET THE PLOT SCREEN TITLE
  131.       w_title = 'Matlab Plots' // CHAR(0)
  132. C
  133. C ***      SELECT THE PLOT DEVICE
  134.       IF (.NOT.PLTST) CALL DEVSEL (1, NDUM, IERR)
  135. C
  136. C ***      FIND OUT IF THIS IS A BATCH JOB USING SAVED PLOT DEFINITIONS
  137. C ***        IF SO,  EXTRACT THE SAVED FILE NAME AND SHIP IT TO LODFIL
  138.       IF (INCTRL.EQ.1) THEN
  139.         DO 45 I = 1, 128
  140.           NAME2(I) = Z'20'
  141. 45      CONTINUE
  142.         ISRC = 2
  143.         DO 22 IK = 1, 32
  144.           IF (BUFFF(1,IK).EQ.QUOT) GO TO 27
  145. 22      CONTINUE
  146. 27      CONTINUE
  147.         DO 23 JK = IK+1, 32
  148.           IF (BUFFF(1,JK).EQ.QUOT) GO TO 24
  149.           NAME(JK-IK) = BUF(JK)
  150. 23      CONTINUE
  151. 24      CONTINUE
  152.         GO TO 800
  153.       ENDIF
  154. C
  155. 75    CONTINUE
  156.       ISRC = 0
  157.       CALL CHKEND
  158.       CALL DSBLLN (2)
  159.       CALL DSSTRN (' PLEASE SELECT AN OPTION', 1)
  160.       CALL DSSTRN (' [1]  3-D PLOT', 1)
  161.       CALL DSSTRN (' [2]  X-Y PLOT', 1)
  162.       CALL DSSTRN (' [3]  POLAR  PLOT', 1)
  163.       CALL DSSTRN (' [4]  CONTOUR PLOT', 1)
  164.       CALL DSSTRN (' [5]  HISTOGRAM', 1)
  165.       CALL DSSTRN (' [6]  SET BACKGROUND COLOR', 1)
  166.       CALL DSSTRN (' [7]  PLOT BUFFER CONTROL', 1)
  167.       CALL DSSTRN (' [8]  READ PLOT FILE', 1)
  168.       CALL DSSTRN (' [9]  END THE CURRENT PLOT', 1)
  169.       CALL DSSTRN (' [10] EXIT TO MATLAB', 1)
  170.       CALL DSCURS (ICURS)
  171. C
  172.       CALL VALGET (0, ICHOICE, 'I')
  173.       GO TO (100, 200, 300, 500, 600, 400, 700, 800, 899, 900), ICHOICE
  174.       CALL MENUER (10)
  175.       GO TO 75
  176. C
  177. 100   CONTINUE
  178.       CALL D3PLOT (XXX, M, N, ISRC, IERR, IZ)
  179.       GO TO 75
  180. C
  181. 200   CONTINUE
  182.       CALL XYPLT (XXX, M, N, ISRC, IERR)
  183.       GO TO 75
  184. C
  185. 300   CONTINUE
  186.       CALL POLPLT (XXX, YYY, M, N, ISRC, IERR, IZ)
  187.       GO TO 75
  188. C
  189. 400   CONTINUE
  190.       CALL CHBACK (ICURS)
  191.       GO TO 75
  192. C
  193. 500   CONTINUE
  194.       CALL CONTUR (XXX, M, N, ISRC, IERR, IZ)
  195.       GO TO 75
  196. C
  197. 600   CONTINUE
  198.       CALL BARPLT (XXX, M, N, ISRC, IERR)
  199.       GO TO 75
  200. C
  201. 700   CONTINUE
  202.       IF (PLTCNT.EQ.0) PLTCNT = PLTMAX
  203.       CALL PLCTRL (XXX, YYY, M, N, IZ)
  204.       GO TO 75
  205. C
  206. 800   CONTINUE
  207.       CALL LODFIL (XXX, YYY, M, N, NAME, ISRC, IERR, IZ)
  208.       GO TO 75
  209. C
  210. 899   CONTINUE
  211.       IF (PLTST) THEN
  212.         PLTST = .FALSE.
  213.         CALL PLTFIN
  214.       ENDIF
  215.       GO TO 75
  216. C
  217. 900   CONTINUE
  218.       CALL DSSTRN (' EXITING PLOT FUNCTION', 1)
  219.       GO TO 999
  220. C
  221. C
  222. C ***      FIND THE VARIABLE IN THE STACKS
  223. C107   CONTINUE
  224. C      VARKEP = 0
  225. C      DO 345 J = 1, 48
  226. C        DO 344 K = 1, 4
  227. C          IF (VAR(K).NE.IDSTK(K,J)) GO TO 346
  228. C344     CONTINUE
  229. C        VARKEP = J
  230. C346     CONTINUE
  231. C345   CONTINUE
  232. C      IF (VARKEP.EQ.0) GO TO 90
  233. C      M = MSTK(VARKEP)
  234. C      N = NSTK(VARKEP)
  235. C      L = LSTK(VARKEP)
  236. C      WRITE (WTE, 321) M, N, L
  237. C321   FORMAT (' FOUND THE VARIABLE.  IT IS A ', I3, ' BY ', I3,
  238. C     .                ' MATRIX LOCATED AT ', I4, ' IN STKR')
  239. C      MN = M*N-1
  240. C      DO 444 J = 0, MN
  241. C        WRITE (WTE, 322) STKR(L+J)
  242. C322     FORMAT (' THE VALUES ARE: ', D10.3)
  243. C444   CONTINUE
  244. C      GO TO 91
  245. C
  246. C90    WRITE (WTE, 654)
  247. C654   FORMAT (' FAILED TO FIND THE VARIABLE')
  248. C91    CONTINUE
  249. C
  250. 999   CONTINUE
  251.       IF (.NOT.PLTST) CALL RLSDEV
  252. C
  253. 9999  CONTINUE
  254.       RETURN
  255.       END
  256.