SUBROUTINE PLOT (LOC, M, N, INCTRL) IMPLICIT NONE C C AMIGA PLOT ROUTINE FOR MATLAB. COPYRIGHT 1988, 1989 BY JAMES LOCKER. C ALL RIGHTS RESERVED. THIS PROGRAM FILE MAY NOT BE USED IN WHOLE OR IN C PART FOR ANY COMMERCIAL APPLICATION WITHOUT THE PRIOR WRITTEN PERMISSION C OF THE AUTHOR, EXCEPT WHEN SUPPLIED IN COMPILED FORM AS PART OF MATLAB. C THIS FILE MAY BE FREELY REDISTRIBUTED SO LONG AS THIS NOTICE IS INTACT. C C MATLAB WRITTEN BY CLEVE MOLER OF UNIVERSITY OF NEW MEXICO. C PUBLIC DOMAIN VERSION ENHANCED BY JAMES LOCKER, SOFTECH INC. C C DIGLIB WRITTEN BY HAL BRAND. C PORTED TO AMIGA BY DR. CRAIG WUEST OF LLNL C DEBUGGED AND ENHANCED BY JAMES LOCKER, SOFTECH INC. C INTEGER LOC, M, N, INCTRL C INCLUDE MATLAB$KOM:SIZEPARMS.INC C INTEGER I, J, IK, JK, ISRC, ICHOICE, IERR, NDUM REAL XXX(VARSIZE), YYY(VARSIZE), XX CHARACTER*8 ICURS CHARACTER*4 NAME(32) CHARACTER*1 IZ(VARSIZE), ANS, QUOT, NAME2(128) EQUIVALENCE (NAME, NAME2) C C *** NOW WE WANT TO KEEP THE STACKSIZE REASONABLE. SO WE PLACE OUR C PRINCIPAL VARIABLES IN COMMON. THE COMMON IS ONLY USED HERE, C BUT THIS KEEPS THEM OFF THE STACK C COMMON /AREA2/ XXX,YYY,IZ C C *** ESTABLISH A WORKSPACE (SCRATCHPAD...ANY ROUTINE MAY DEFINE C THE DATA IN THIS COMMON TO BE ANY TYPE AT ALL...WHATEVER IS NEEDED C LOCALLY). THIS IS DONE IN COMMON TO KEEP THE STACK SIZE UNDER C CONTROL, GIVEN THE WAY AMIGA ABSOFT FORTRAN STORES VARIABLES C CHARACTER*4 DATA(WORKSIZE) COMMON /AREA/ DATA C C *** ALL COMMONS INCLUDED TO ENSURE THEY STAY DEFINED FOR SUBROUTINES C C *** MATLAB COMMONS INCLUDE MATLAB$KOM:VSTK.KOM INCLUDE MATLAB$KOM:RECU.KOM INCLUDE MATLAB$KOM:IOP.KOM INCLUDE MATLAB$KOM:COM.KOM INCLUDE MATLAB$KOM:ALFS.KOM INCLUDE MATLAB$KOM:SYS.KOM INCLUDE MATLAB$KOM:MATPLT.KOM INCLUDE MATLAB$KOM:PLT3D.KOM INCLUDE MATLAB$KOM:PLTXY.KOM INCLUDE MATLAB$KOM:BAR.KOM INCLUDE MATLAB$KOM:PLTCP.KOM INCLUDE MATLAB$KOM:PLTPP.KOM INCLUDE MATLAB$KOM:SAV.KOM C C *** AMIGA SYSTEM VARIABLES, COMMONS, STRUCTURES EXTERNAL LEN INCLUDE AMIGA$KOM:graph.inc INCLUDE AMIGA$KOM:exec.inc INCLUDE AMIGA$KOM:intuit.inc C C *** DIGLIB COMMONS INCLUDE DIGLIB$KOM:window.inc INCLUDE DIGLIB$KOM:PLTPRM.PRM INCLUDE DIGLIB$KOM:GCCLIP.PRM C ! REMOVE GCCOFF FROM IN PLTSIZ.PRM FIRST C INCLUDE DIGLIB$KOM:GCCOFF.PRM INCLUDE DIGLIB$KOM:GCCPAR.PRM INCLUDE DIGLIB$KOM:GCCPOS.PRM INCLUDE DIGLIB$KOM:PLTCOM.PRM INCLUDE DIGLIB$KOM:PLTSIZ.PRM INCLUDE DIGLIB$KOM:PLTCLP.PRM INCLUDE DIGLIB$KOM:GCDCHR.PRM INCLUDE DIGLIB$KOM:GCDPRM.PRM INCLUDE DIGLIB$KOM:GCDSEL.PRM INCLUDE DIGLIB$KOM:GCLTYP.PRM INCLUDE DIGLIB$KOM:GCVPOS.PRM C DATA ICURS / 'Plot >>' / DATA QUOT / 1H' / C C C *** ESTABLISH DEFAULTS COLOR1 = Z'9B33336D' COLOR2 = Z'9B30306D' COLOR3 = Z'9B33326D' BGRP = 0 SETBG = .FALSE. IF (PLTMAX.EQ.0) THEN PLTCNT = 0 DO 3 I = 1, 10 DO 2 J = 1, XYSIZ ISAV(I,J) = Z'20' 2 CONTINUE IPLTYP(I) = 0 3 CONTINUE ENDIF C C *** IF WE ARE INTERACTIVE, ISSUE STACK WARNING TO PREVENT CRASHES, C *** UNLESS WE STARTED FROM WORKBENCH OR HAVE BEEN HERE BEFORE. IF (.NOT.PLTST .AND. (INCTRL.EQ.0) .AND. . (WBST.EQ.0) .AND. .NOT.BNHERE) THEN CALL DSSTRN (' ENTERING PLOT.', 2) CALL DSERR ( . 'WARNING...HAS THE STACK SIZE BEEN SET TO AT LEAST 100K?') CALL DSCURS (ICURS) READ (WTE, 11) ANS 11 FORMAT (A1) IF (WIO.NE.0) WRITE (WIO, 12) ANS 12 FORMAT (1X, A1) IF (ANS.NE.'Y' .AND. ANS.NE.'y') THEN CALL DSSTRN (' EXITING PLOT FUNCTION', 1) GO TO 9999 ENDIF ENDIF BNHERE = .TRUE. C C *** START THE PLOTS ISRC = 0 DO 70 J = LOC, LOC+N*M-1 XX = STKR(J) XXX(J-LOC+1) = SNGL(XX) XX = STKI(J) YYY(J-LOC+1) = SNGL(XX) 70 CONTINUE C C *** SET THE PLOT SCREEN TITLE w_title = 'Matlab Plots' // CHAR(0) C C *** SELECT THE PLOT DEVICE IF (.NOT.PLTST) CALL DEVSEL (1, NDUM, IERR) C C *** FIND OUT IF THIS IS A BATCH JOB USING SAVED PLOT DEFINITIONS C *** IF SO, EXTRACT THE SAVED FILE NAME AND SHIP IT TO LODFIL IF (INCTRL.EQ.1) THEN DO 45 I = 1, 128 NAME2(I) = Z'20' 45 CONTINUE ISRC = 2 DO 22 IK = 1, 32 IF (BUFFF(1,IK).EQ.QUOT) GO TO 27 22 CONTINUE 27 CONTINUE DO 23 JK = IK+1, 32 IF (BUFFF(1,JK).EQ.QUOT) GO TO 24 NAME(JK-IK) = BUF(JK) 23 CONTINUE 24 CONTINUE GO TO 800 ENDIF C 75 CONTINUE ISRC = 0 CALL CHKEND CALL DSBLLN (2) CALL DSSTRN (' PLEASE SELECT AN OPTION', 1) CALL DSSTRN (' [1] 3-D PLOT', 1) CALL DSSTRN (' [2] X-Y PLOT', 1) CALL DSSTRN (' [3] POLAR PLOT', 1) CALL DSSTRN (' [4] CONTOUR PLOT', 1) CALL DSSTRN (' [5] HISTOGRAM', 1) CALL DSSTRN (' [6] SET BACKGROUND COLOR', 1) CALL DSSTRN (' [7] PLOT BUFFER CONTROL', 1) CALL DSSTRN (' [8] READ PLOT FILE', 1) CALL DSSTRN (' [9] END THE CURRENT PLOT', 1) CALL DSSTRN (' [10] EXIT TO MATLAB', 1) CALL DSCURS (ICURS) C CALL VALGET (0, ICHOICE, 'I') GO TO (100, 200, 300, 500, 600, 400, 700, 800, 899, 900), ICHOICE CALL MENUER (10) GO TO 75 C 100 CONTINUE CALL D3PLOT (XXX, M, N, ISRC, IERR, IZ) GO TO 75 C 200 CONTINUE CALL XYPLT (XXX, M, N, ISRC, IERR) GO TO 75 C 300 CONTINUE CALL POLPLT (XXX, YYY, M, N, ISRC, IERR, IZ) GO TO 75 C 400 CONTINUE CALL CHBACK (ICURS) GO TO 75 C 500 CONTINUE CALL CONTUR (XXX, M, N, ISRC, IERR, IZ) GO TO 75 C 600 CONTINUE CALL BARPLT (XXX, M, N, ISRC, IERR) GO TO 75 C 700 CONTINUE IF (PLTCNT.EQ.0) PLTCNT = PLTMAX CALL PLCTRL (XXX, YYY, M, N, IZ) GO TO 75 C 800 CONTINUE CALL LODFIL (XXX, YYY, M, N, NAME, ISRC, IERR, IZ) GO TO 75 C 899 CONTINUE IF (PLTST) THEN PLTST = .FALSE. CALL PLTFIN ENDIF GO TO 75 C 900 CONTINUE CALL DSSTRN (' EXITING PLOT FUNCTION', 1) GO TO 999 C C C *** FIND THE VARIABLE IN THE STACKS C107 CONTINUE C VARKEP = 0 C DO 345 J = 1, 48 C DO 344 K = 1, 4 C IF (VAR(K).NE.IDSTK(K,J)) GO TO 346 C344 CONTINUE C VARKEP = J C346 CONTINUE C345 CONTINUE C IF (VARKEP.EQ.0) GO TO 90 C M = MSTK(VARKEP) C N = NSTK(VARKEP) C L = LSTK(VARKEP) C WRITE (WTE, 321) M, N, L C321 FORMAT (' FOUND THE VARIABLE. IT IS A ', I3, ' BY ', I3, C . ' MATRIX LOCATED AT ', I4, ' IN STKR') C MN = M*N-1 C DO 444 J = 0, MN C WRITE (WTE, 322) STKR(L+J) C322 FORMAT (' THE VALUES ARE: ', D10.3) C444 CONTINUE C GO TO 91 C C90 WRITE (WTE, 654) C654 FORMAT (' FAILED TO FIND THE VARIABLE') C91 CONTINUE C 999 CONTINUE IF (.NOT.PLTST) CALL RLSDEV C 9999 CONTINUE RETURN END