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 / BARPLT.FOR next >
Encoding:
Text File  |  1991-04-13  |  6.9 KB  |  272 lines
  1.       SUBROUTINE BARPLT (XXX, M, N, INCTRL, IERR)
  2.       IMPLICIT NONE
  3. C
  4. C ***      DO HISTOGRAMS AND BAR PLOTS
  5.       INTEGER M, N, INCTRL, IERR
  6.       REAL XXX(M,N)
  7. C
  8.       INCLUDE MATLAB$KOM:IOP.KOM
  9.       INCLUDE MATLAB$KOM:MATPLT.KOM
  10.       INCLUDE MATLAB$KOM:BAR.KOM
  11. C
  12.       INTEGER I, J, IANS, KK
  13.       REAL FIMX(8), COUNT(512,8), STEP, X0, Y0, VX0, VX1, VY0, VY1
  14.       CHARACTER*8 ICURS
  15. C
  16.       DATA ICURS / 'BARPlt>>' /
  17. C
  18. C
  19. C ***      SEE WHO CALLED US
  20.       IF (INCTRL.NE.0) GO TO 90
  21. C
  22. C ***      SET UP THE DEFAULTS
  23.       DO 9 I = 1, 8
  24.         FGRPBP(I) = I
  25. 9     CONTINUE
  26.       CALL MINMAX (XXX, M*N, XLOWBP, XHIBP)
  27.       IMXC = 512
  28.       NOBARS = M
  29.       YLOWBP = 0.0
  30.       YHIBP = 1.0
  31.       FBAR = FLOAT(NOBARS)
  32.       DO 1 I = 1, 80
  33.         XLABBP(I) = ' '
  34.         YLABBP(I) = ' '
  35.         LABBP(I) = ' '
  36. 1     CONTINUE
  37.       XLABBP(2) = Z'00'
  38.       YLABBP(2) = Z'00'
  39.       LABBP(2) = Z'00'
  40.       IMXPTS = M
  41.       IMYPTS = N
  42.       XSTBP = 0
  43.       YSTBP = 0
  44.       XFRCBP = 100
  45.       YFRCBP = 95
  46.       CHSZBP = 0
  47.       ISCYBP = 0
  48.       IPLBP1 = 0
  49.       STATBP = .TRUE.
  50.       IXCLBP = 1
  51. C
  52. C ***      Main Menu
  53. 4     CONTINUE
  54.       CALL CHKEND
  55.       CALL DSSTRN (' PLEASE SELECT AN OPTION', 1)
  56.       CALL DSSTRN (' [1]  CHOOSE THE BAR GRAPH TYPE', 1)
  57.       CALL DSSTRN (' [2]  CHOOSE BAR GRAPH AXIS TYPES', 1)
  58.       CALL DSSTRN (' [3]  CHOOSE BAR GRAPH AXIS COLORS', 1)
  59.       CALL DSSTRN (' [4]  CHOOSE THE BAR GRAPH LABELS', 1)
  60.       CALL DSSTRN (' [5]  SET THE BAR GRAPH COLORS', 1)
  61.       CALL DSSTRN (' [6]  SET THE BACKGROUND COLOR', 1)
  62.       CALL DSSTRN (' [7]  SET THE PLOT SIZE', 1)
  63.       CALL DSSTRN (' [8]  DO THE PLOT', 1)
  64.       CALL DSSTRN (' [9]  END THE CURRENT PLOT', 1)
  65.       CALL DSSTRN (' [10] EXIT BARGRAPH', 1)
  66.       CALL DSCURS (ICURS)
  67. C
  68.       CALL VALGET (0, IANS, 'I')
  69.       GO TO  (15, 10, 20, 60, 30, 40, 50, 90, 899, 9999), IANS
  70.       CALL MENUER (10)
  71.       GO TO 4
  72. C
  73. C ***      DEFINE THE BAR GRAPH AXIS TYPES
  74. 10    CONTINUE
  75.       CALL CHKEND
  76.       CALL SETAXS (ICURS, IPLBP1, SYOPBP, ISCYBP, SYLOBP, SYHIBP,
  77.      .             XLOWBP, YLOWBP)
  78.       GO TO 4
  79. C
  80. C ***      DETERMINE WHETHER TO COUNT OCCURRENCES OR
  81. C ***        DO STATISTICAL DISTRIBUTION
  82. 15    CONTINUE
  83.       CALL CHKEND
  84.       CALL DSSTRN (' PLEASE CHOOSE THE DESIRED Y-AXIS TYPE:', 1)
  85.       CALL DSSTRN (' [1] STATISTICAL (MAXIMUM Y VALUE IS 1.0)', 1)
  86.       CALL DSSTRN (' [2] OCCURRENCE COUNT', 1)
  87.       CALL DSCURS (ICURS)
  88.       CALL VALGET (0, IANS, 'I')
  89.       GO TO  (17, 18), IANS
  90. C
  91.       CALL MENUER (2)
  92.       GO TO 15
  93. C
  94. 17    CONTINUE
  95.       STATBP = .TRUE.
  96.       GO TO 4
  97. C
  98. 18    CONTINUE
  99.       STATBP = .FALSE.
  100.       GO TO 4
  101. C
  102. C ***      DO THE PLOT LABELS
  103. 20    CONTINUE
  104.       CALL DSSTRN (' ENTER THE X-AXIS LABEL', 1)
  105.       CALL DSCURS (ICURS)
  106.       CALL GETLAB (XLABBP)
  107.       CALL DSSTRN (' ENTER THE Y-AXIS LABEL', 1)
  108.       CALL DSCURS (ICURS)
  109.       CALL GETLAB (YLABBP)
  110.       CALL DSSTRN (' ENTER THE PLOT LABEL', 1)
  111.       CALL DSCURS (ICURS)
  112.       CALL GETLAB (LABBP)
  113.       GO TO 4
  114. C
  115. C ***      SET THE BAR GRAPH COLORS
  116. 30    CONTINUE
  117.       CALL CHKEND
  118.       KK = IMYPTS
  119.       IF (KK.GT.8) KK = 8
  120.       DO 35 I = 1, KK
  121.         CALL DSSTRN (' FOR BAR GRAPH NUMBER ', 0)
  122.         CALL DSWDI (I, 1)
  123.         CALL SETFG (FGRPBP(I), ICURS)
  124. 35    CONTINUE
  125.       GO TO 4
  126. C
  127. C ***      CHANGE THE BACKGROUND PEN COLOR
  128. 40    CONTINUE
  129.       CALL CHKEND
  130.       CALL CHBACK (ICURS)
  131.       GO TO 4
  132. C
  133. C ***      SET THE PLOT SIZE
  134. 50    CONTINUE
  135.       CALL CHKEND
  136.       CALL MAKSIZ (ICURS, XSTBP, XFRCBP, YSTBP, YFRCBP)
  137.       XSTBP = XSTBP*100.
  138.       YSTBP = YSTBP*100.
  139.       XFRCBP = XFRCBP*100.+XSTBP
  140.       YFRCBP = YFRCBP*100.+YSTBP
  141.       GO TO 4
  142. C
  143. C ***      SET THE AXIS COLORS
  144. 60    CONTINUE
  145.       CALL CHKEND
  146.       CALL SETFG (IXCLBP, IERR)
  147.       GO TO 4
  148. C
  149. C ***      DO THE PLOT
  150. 90    CONTINUE
  151.       CALL CHKEND
  152. C
  153. C ***      SAVE THE PLOT UNLESS THIS IS ALREADY A SAVED PLOT
  154.       IF (INCTRL.EQ.0) CALL SAVPLT (3)
  155. C
  156.       IF ( (XLOWBP.LE.0 .AND.  (IPLBP1.EQ.1 .OR. IPLBP1.EQ.3)) .OR.
  157.      .     (YLOWBP.LE.0 .AND.  (IPLBP1.EQ.2 .OR. IPLBP1.EQ.3)) ) THEN
  158.         CALL DSERR ('ERROR. AXIS LIMITS INCOMPATIBLE WITH LOG PLOT')
  159.         GO TO 4
  160.       ENDIF
  161.       IF (ISCYBP .AND. (SYLOBP.LE.0) .AND. (SYOPBP.EQ.2)) THEN
  162.         CALL DSERR (
  163.      .       'ERROR. SECOND Y-AXIS LIMITS INCOMPATIBLE WITH LOG PLOT')
  164.         GO TO 4
  165.       ENDIF
  166. C
  167.       IF  (XLOWBP.GT.XHIBP) THEN
  168.         CALL DSERR ('INTERNAL ERROR.  XMIN GREATER THAN XMAX')
  169.         CALL DSERR ('CALLED FROM BARPLT.  THIS CAN''T HAPPEN,')
  170.         CALL DSERR ('SO IF IT HAS, YOU''RE SCREWED!  SORRY.')
  171.         GO TO 9999
  172.       ENDIF
  173. C
  174.       IF  (NOBARS.GT.IMXC) THEN
  175.         CALL DSERR ('ERROR.  TOO MANY BINS.  THE MAXIMUM IS 512')
  176.         GO TO 9999
  177.       ENDIF
  178. C
  179.       IF (IMYPTS.GT.8) THEN
  180.         CALL DSERR ('WARNING.  TOO MANY BARGRAPHS SPECIFIED.')
  181.         CALL DSERR ('ONLY THE FIRST 8 ROWS WILL BE GRAPHED')
  182.         IMYPTS = 8
  183.       ENDIF
  184. C
  185.       STEP = (XHIBP - XLOWBP) / FBAR
  186. C
  187.       DO 100 I = 1, 512
  188.       DO 100 J = 1, 8
  189.         COUNT(I, J) = 0.0
  190. 100   CONTINUE
  191. C
  192.       DO 350 KK = 1, IMYPTS
  193.         DO 200 I = 1, IMXPTS
  194.           J = INT ( (XXX(I,KK)-XLOWBP)/STEP) + 1
  195.           IF (J.GT.NOBARS) J = NOBARS
  196.           COUNT(J,KK) = COUNT(J,KK) + 1.0
  197. 200     CONTINUE
  198. C
  199.         IF (STATBP) THEN
  200.           FIMX(KK) = FLOAT(IMXPTS) * STEP
  201.           DO 300 I = 1, NOBARS
  202.             COUNT(I,KK) = COUNT(I,KK) / FIMX(KK)
  203. 300       CONTINUE
  204.         ENDIF
  205. 350   CONTINUE
  206. C
  207.       CALL MINMAX (COUNT, 4096, YLOWBP, YHIBP)
  208.       YLOWBP = 0.0
  209.       YHIBP = YHIBP + 0.1 * YHIBP
  210. C
  211.       IF (.NOT.PLTST) THEN
  212.         PLTST = .TRUE.
  213.         CALL BGNPLT
  214.       ENDIF
  215. C
  216. C ***      SET THE BACKGROUND COLOR
  217.       IF (SETBG) THEN
  218.         SETBG = .FALSE.
  219.         CALL SETBAK (BGRP)
  220.       ENDIF
  221. C
  222. C ***      DEFINE PLOT SIZE
  223. C      WRITE (WTE, 1324) XSTBP, XFRCBP, YSTBP, YFRCBP, CHSZBP
  224. C1324  FORMAT (' MAPSIZE', 5F10.3)
  225.       IF (ISCYBP) THEN
  226.         CALL MAPSZ2 (XSTBP, XFRCBP, YSTBP, YFRCBP, CHSZBP)
  227.       ELSE
  228.         CALL MAPSIZ (XSTBP, XFRCBP, YSTBP, YFRCBP, CHSZBP)
  229.       ENDIF
  230.       CALL GSCOLR (IXCLBP, IERR)
  231. C      WRITE (WTE, 1789) XLOWBP, XHIBP, YLOWBP, YHIBP
  232. C1789  FORMAT (' MAPIT', 4F10.3)
  233.       CALL MAPIT (XLOWBP, XHIBP, YLOWBP, YHIBP, XLABBP, YLABBP, LABBP,
  234.      .            IPLBP1)
  235. C
  236.       DO 500 KK = 1, IMYPTS
  237.         CALL GSCOLR (FGRPBP(KK), IERR)
  238.         X0 = XLOWBP
  239.         Y0 = 0.0
  240.         CALL SCALE (X0, Y0, VX0, VY0)
  241.         CALL GSMOVE (VX0, VY0)
  242. C
  243.         DO 400 I = 1, NOBARS
  244.           X0 = XLOWBP + I * STEP
  245.           Y0 = COUNT(I,KK)
  246.           CALL SCALE (X0, Y0, VX1, VY1)
  247.           CALL GSDRAW (VX0, VY1)
  248.           CALL GSDRAW (VX1, VY1)
  249.           CALL GSDRAW (VX1, VY0)
  250.           VX0 = VX1
  251. 400     CONTINUE
  252. 500   CONTINUE
  253. C
  254. C ***      DO THE SECOND Y AXIS
  255.       IF (ISCYBP) THEN
  256. C        CALL GSCOLR (IXCLBP, IERR)
  257.         CALL GSLTYP (1)
  258.         CALL SYAXIS (SYLOBP, SYHIBP, SYLBBP, SYOPBP)
  259.       ENDIF
  260.       IF (INCTRL.NE.0) GO TO 9999
  261.       GO TO 4
  262. C
  263. 899   IF (PLTST) THEN
  264.         PLTST = .FALSE.
  265.         CALL PLTFIN
  266.       ENDIF
  267.       GO TO 4
  268. C
  269. 9999  CONTINUE
  270.       RETURN
  271.       END
  272.