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 / contur.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  4.8 KB  |  187 lines
  1.       SUBROUTINE CONTUR (XXX, M, N, INCTRL, IOCTRL, IZ)
  2.       IMPLICIT NONE
  3. C
  4. C ***      CONTOUR 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:PLTCP.KOM
  16. C
  17.       INTEGER CHOICE, I, LABSIZ, IERR, MN
  18.       REAL XMAX, YMAX, ZMIN, ZMAX
  19.       CHARACTER*8 ICURS
  20. C
  21. C ***      FUNCTIONS
  22.       REAL GSXLCM, GSYLCM
  23. C
  24.       DATA ICURS / 'Contor>>' /
  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.         XLABCP(I) = Z'20'
  34.         YLABCP(I) = Z'20'
  35.         LABCP(I) = Z'20'
  36. 25    CONTINUE
  37.       LABECP = 0
  38.       XSTCP = 0
  39.       YSTCP = 0
  40.       XFRCCP = 100
  41.       YFRCCP = 100
  42.       FGRPCP = 1
  43.       IOCTRL = 0
  44.       X1CP = 0
  45.       XMXCP = M
  46.       Y1CP = 0
  47.       YMXCP = N
  48.       IOPTCP = 0
  49.       IOP2CP = 0
  50.       ICNNCP = 20
  51.       XMAX = GSXLCM ()
  52.       YMAX = GSYLCM ()
  53.       MN = M*N
  54.       CALL MINMAX (XXX, MN, ZMIN, ZMAX)
  55.       DO 55 I = 1, 20
  56.         CNLCP(I) = ZMIN + (ZMAX-ZMIN)*(FLOAT(I)-1)/20
  57. 55    CONTINUE
  58. C
  59. C ***      DETERMINE THE CHOICES
  60. 100   CONTINUE
  61.       CALL CHKEND
  62.       CALL DSBLLN (2)
  63.       CALL DSSTRN (' PLEASE CHOOSE AN OPTION', 1)
  64.       CALL DSSTRN (' [1]  CHOOSE PLOT LABELS', 1)
  65.       CALL DSSTRN (' [2]  CHOOSE PLOT VALUES', 1)
  66.       CALL DSSTRN (' [3]  CHOOSE NUMBER OF CONTOURS', 1)
  67.       CALL DSSTRN (' [4]  CHOOSE CONTOUR LEVELS', 1)
  68.       CALL DSSTRN (' [5]  SET THE BACKGROUND COLOR', 1)
  69.       CALL DSSTRN (' [6]  CHOOSE PLOT COLOR', 1)
  70.       CALL DSSTRN (' [7]  CHOOSE PLOT SIZE', 1)
  71.       CALL DSSTRN (' [8]  DO THE PLOT', 1)
  72.       CALL DSSTRN (' [9]  END THE CURRENT PLOT', 1)
  73.       CALL DSSTRN (' [10] EXIT CONTOUR PLOTS', 1)
  74.       CALL DSCURS (ICURS)
  75. C
  76.       CALL VALGET (0, CHOICE, 'I')
  77.       GO TO (200, 300, 400, 500, 600, 700, 800, 900, 899, 990), CHOICE
  78.       CALL MENUER (10)
  79.       GO TO 100
  80. C
  81. C ***      SELECT THE LABELS
  82. 200   CONTINUE
  83.       CALL CHKEND
  84.       CALL DSSTRN (' ENTER THE X AXIS LABEL', 1)
  85.       CALL DSCURS (ICURS)
  86.       CALL GETLAB (XLABCP)
  87.       CALL DSSTRN (' ENTER THE Y AXIS LABEL', 1)
  88.       CALL DSCURS (ICURS)
  89.       CALL GETLAB (YLABCP)
  90.       CALL DSSTRN (' ENTER THE PLOT LABEL', 1)
  91.       CALL DSCURS (ICURS)
  92.       CALL GETLAB (LABCP)
  93.       CALL DSSTRN (' ENTER THE SIZE OF THE LABELS (CM)', 1)
  94.       CALL DSCURS (ICURS)
  95.       CALL VALGET (LABSIZ, 0, 'F')
  96.       IF (LABSIZ.NE.0) LABECP = LABSIZ
  97.       GO TO 100
  98. C
  99. C ***      SELECT THE DATA
  100. 300   CONTINUE
  101.       CALL CHKEND
  102.       CALL DSSTRN (' ENTER THE MINIMUM VALUE OF X', 1)
  103.       CALL DSCURS (ICURS)
  104.       CALL VALGET (X1CP, 0, 'F')
  105.       CALL DSSTRN (' ENTER THE MAXIMUM VALUE OF X', 1)
  106.       CALL DSCURS (ICURS)
  107.       CALL VALGET (XMXCP, 0, 'F')
  108.       CALL DSSTRN (' ENTER THE MINIMUM VALUE OF Y', 1)
  109.       CALL DSCURS (ICURS)
  110.       CALL VALGET (Y1CP, 0, 'F')
  111.       CALL DSSTRN (' ENTER THE MAXIMUM VALUE OF Y', 1)
  112.       CALL DSCURS (ICURS)
  113.       CALL VALGET (YMXCP, 0, 'F')
  114.       GO TO 100
  115. C
  116. C ***      DEFINE THE NUMBER OF CONTOURS
  117. 400   CONTINUE
  118.       CALL CHKEND
  119.       CALL DSSTRN (' ENTER THE NUMBER OF CONTOURS TO BE MAPPED', 1)
  120.       CALL DSCURS (ICURS)
  121.       CALL VALGET (0, ICNNCP, 'I')
  122.       IF (ICNNCP.GT.20) ICNNCP = 20
  123.       DO 455 I = 1, ICNNCP
  124.         CNLCP(I) = ZMIN + (ZMAX-ZMIN)*(FLOAT(I)-1)/20
  125. 455   CONTINUE
  126.       GO TO 100
  127. C
  128. C ***      CHOOSE THE CONTOUR LEVELS
  129. 500   CONTINUE
  130.       CALL CHKEND
  131.       GO TO 100
  132. C
  133. C ***      SET THE BACKGROUND COLOR
  134. 600   CONTINUE
  135.       CALL CHKEND
  136.       CALL CHBACK (ICURS)
  137.       GO TO 100
  138. C
  139. C ***      SELECT THE PLOT COLOR
  140. 700   CONTINUE
  141.       CALL CHKEND
  142.       CALL SETFG (FGRPCP, ICURS)
  143.       GO TO 100
  144. C
  145. C ***      SELECT THE PLOT SIZE
  146. 800   CONTINUE
  147.       CALL CHKEND
  148.       CALL MAKSIZ (ICURS, XSTCP, XFRCCP, YSTCP, YFRCCP)
  149.       XSTCP = XSTCP*100.
  150.       YSTCP = YSTCP*100.
  151.       XFRCCP = XFRCCP*100.+XSTCP
  152.       YFRCCP = YFRCCP*100.+YSTCP
  153.       GO TO 100
  154. C
  155. C ***      END THE PLOT
  156. 899   IF (PLTST) THEN
  157.         PLTST = .FALSE.
  158.         CALL PLTFIN
  159.       ENDIF
  160.       GO TO 100
  161. C
  162. C ***      DO THE PLOT
  163. 900   CONTINUE
  164.       CALL CHKEND
  165. C
  166. C ***      SAVE THE PLOT SETTINGS, UNLESS WE ARE WORKING FROM A SAVED FILE
  167.       IF (INCTRL.EQ.0) CALL SAVPLT (4)
  168.       IF  (.NOT.PLTST) THEN
  169.         PLTST = .TRUE.
  170.         CALL BGNPLT
  171.       ENDIF
  172.       IF (SETBG) THEN
  173.         SETBG = .FALSE.
  174.         CALL SETBAK (BGRP)
  175.       ENDIF
  176.       CALL GSCOLR (FGRPCP, IERR)
  177.       CALL MAPSIZ (XSTCP, XFRCCP, YSTCP, YFRCCP, LABECP)
  178.       CALL MAPIT (X1CP, XMXCP, Y1CP, YMXCP, XLABCP, YLABCP, LABCP,
  179.      .            IOPTCP)
  180.       CALL CONTOR (XXX, M, IZ, M, N, X1CP, XMXCP, Y1CP, YMXCP,
  181.      .             ICNNCP, CNLCP)
  182.       IF (INCTRL.EQ.0) GO TO 100
  183. C
  184. 990   CONTINUE
  185.       RETURN
  186.       END
  187.