home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / diglib.lha / Diglib / diglib.zoo / diglib / BARGR2.FOR < prev    next >
Encoding:
Text File  |  1989-06-20  |  5.3 KB  |  178 lines
  1.         SUBROUTINE BARGR2(XLOW,XHIGH,NOBARS,IMXPTS,IMYPTS,X,
  2.      1                 SXLAB,SYLAB,STITLE,TYPE,COLIST)
  3. C
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C       PROJECT NAME: GRAPHICS UTILITY
  7. C       FILE NAME   : BARGR2.FOR
  8. C       ROUTINE NAME: BARGR2
  9. C       ROUTINE TYPE: SUBROUTINE
  10. C       LANGUAGE    : COMPATIBLE FORTRAN
  11. C
  12. C       VERSION     : 1
  13. C
  14. C       ORIGINAL AUTHOR: JOE P GARBARINI JR, (BARGRA.FOR)
  15. C       DATE           : 02-JUL-82
  16. C       EDITED INTO BARGR2: JIM LOCKER
  17. C       DATE           : 19 DEC 1988
  18. C
  19. C       MAINTAINER     : HAL R BRAND L126 X26313 (DIGLIB V2 VERSION)
  20. C
  21. C       REVISION: 0
  22. C         REVISION AUTHOR:
  23. C         REVISION DATE  :
  24. C         REVISION NOTES :
  25. C
  26. C       SUMMARY:
  27. C
  28. C               This routine makes a bar graph (frequency graph)
  29. C               from an array of real data.
  30. C
  31. C       INPUT VARIABLES:
  32. C
  33. C               XLOW  : REAL*4 CONSTANT OR VARIABLE.
  34. C                       THE LOW LIMIT FOR THE X-AXIS.
  35. C                       MUST HAVE XLOW <= X(I) FOR ALL I.
  36. C               XHIGH : REAL*4 CONSTANT OR VARIABLE.
  37. C                       THE HIGH LIMIT FOR THE X-AXIS.
  38. C                       MUST HAVE X(I) <= XHIGH FOR ALL I.
  39. C               NOBARS: INTEGER CONSTANT OR VARIABLE.
  40. C                       THE NUMBER OF BARS TO DRAW.
  41. C                       1 <= *NOBARS* <= 512
  42. C                       SEE LOCAL VARIABLE *IMXC*.
  43. C               IMXPTS: INTEGER CONSTANT OR VARIABLE.
  44. C                       THE X DIMENSION OF ARRAY *X*.
  45. C               IMYPTS: INTEGER CONSTANT OR VARIABLE.
  46. C                       THE Y DIMENSION OF ARRAY *X*, ALSO
  47. C                       THE NUMBER OF INDEPENDENT BAR GRAPHS
  48. C                       TO BE PLACED ON EACH PLOT. (MAX 8)
  49. C               X     : REAL*4 VARIABLE.
  50. C                       THE ARRAY OF REAL DATA TO GRAPH.
  51. C               SXLAB : LOGICAL*1 CONSTANT OR VARIABLE.
  52. C                       THE X-AXIS LABLE.
  53. C               SYLAB : LOGICAL*1 CONSTANT OR VARIABLE.
  54. C                       THE Y-AXIS LABLE.
  55. C               STITLE: LOGICAL*1 CONSTANT OR VARIABLE.
  56. C                       THE TITLE.
  57. C               TYPE  : INTEGER CONSTANT OR VARIABLE.
  58. C                       THE AXIS FLAG.  SEE *DIGLIB* DOCUMENTATION.
  59. C               COLIST: INTEGER CONSTANT OR ARRAY
  60. C                       THE PEN COLORS TO BE EMPLOYED.  ONE PEN COLOR
  61. C                       ENTRY FOR EACH INDEPENDENT BAR GRAPH TO BE MADE.
  62. C
  63. C       OUTPUT VARIABLES: NONE
  64. C
  65. C       INOUT VARIABLES: NONE
  66. C
  67. C       COMMON VARIABLES: NONE
  68. C
  69. C       LOCAL VARIABLES: SEE CODE.
  70. C
  71. C       EXCEPTION HANDLING: NONE
  72. C
  73. C       SIDE EFFECTS: NONE
  74. C
  75. C       PROGRAMMING NOTES:
  76. C
  77. C               This routine does all the calls to DIGLIB necessary
  78. C               to do the plot EXCEPT for a call to DEVSEL.  This
  79. C               way the calling program can choose the device.
  80. C
  81. C               DIGLIB's MAPIT routine uses its own rules for the
  82. C               actual lowest and highest values on the axes.  They
  83. C               always include the users values.  If you wish to move
  84. C               the bar graph away from the left and/or (imaginary) right
  85. C               y axis do the following:
  86. C
  87. C               Let S = (XH - XL) / NOBARS where XH = max X(i)
  88. C               and XL = min X(i).  Now set XLOW = XL - N * S
  89. C               XHIGH = XH + M * S where N,M are chosen at your discretion.
  90. C
  91. C               MAKE SURE THAT XLOW <= X(I) <= XHIGH FOR ALL I.
  92. C
  93. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  94. C
  95.         INTEGER IMXPTS,IMYPTS,NOBARS,TYPE,COLIST(8)
  96.         REAL*4    XLOW,XHIGH
  97.         REAL*4    X
  98.         DIMENSION X(IMXPTS,IMYPTS),FIMX(8)
  99.         LOGICAL SXLAB(20),SYLAB(20),STITLE(20)
  100. C
  101.         INTEGER I,J,IMXC
  102.         REAL*4    COUNT(512,8),STEP,FBAR,YLOW,YHIGH,X0,Y0,VX0,VX1
  103.         REAL*4    VY0,VY1
  104. C
  105.         IMXC   = 512
  106.         YLOW   = 0.0
  107.         YHIGH  = 1.0
  108.         FBAR   = FLOAT(NOBARS)
  109. C
  110.         IF (XLOW .GE. XHIGH) GOTO 9999
  111.         IF (NOBARS .GT. IMXC) GOTO 9999
  112.         IF(IMYPTS .GT. 8) GOTO 9999
  113. C
  114.         STEP   = (XHIGH - XLOW) / FBAR
  115. C
  116.         DO 100 I = 1,NOBARS
  117.         DO 100 J = 1,IMYPTS
  118. C
  119.             COUNT(I,J) = 0.0
  120. C
  121.  100    CONTINUE
  122. C
  123.         DO 350 KK=1,IMYPTS
  124.         DO 200 I = 1,IMXPTS
  125. C
  126.             J      = INT((X(I,KK)-XLOW)/STEP) + 1
  127.             IF (J .GT. NOBARS) J = NOBARS
  128.             COUNT(J,KK) = COUNT(J,KK) + 1.0
  129. C
  130.  200    CONTINUE
  131. C
  132.         FIMX(KK)   = FLOAT(IMXPTS) * STEP
  133. C
  134.         DO 300 I = 1,NOBARS
  135. C
  136.             COUNT(I,KK) = COUNT(I,KK) / FIMX(KK)
  137. C
  138.  300    CONTINUE
  139.  350    CONTINUE
  140. C
  141.         CALL MINMAX(COUNT,NOBARS*IMYPTS,YLOW,YHIGH)
  142.         YLOW   = 0.0
  143.         YHIGH  = YHIGH + 0.1 * YHIGH
  144. C
  145.         CALL BGNPLT
  146.         CALL MAPSIZ(0.0,100.0,0.0,90.0,0.0)
  147.         CALL MAPIT(XLOW,XHIGH,YLOW,YHIGH,SXLAB,SYLAB,STITLE,TYPE)
  148. C
  149.         DO 500 KK=1,IMYPTS
  150.         CALL GSCOLR(COLIST(KK),IERR)
  151.         X0     = XLOW
  152.         Y0     = 0.0
  153.         CALL SCALE(X0,Y0,VX0,VY0)
  154.         CALL GSMOVE(VX0,VY0)
  155. C
  156.         DO 400 I = 1,NOBARS
  157. C
  158.             X0     = XLOW + I * STEP
  159.             Y0     = COUNT(I,KK)
  160.             CALL SCALE(X0,Y0,VX1,VY1)
  161.             CALL GSDRAW(VX0,VY1)
  162.             CALL GSDRAW(VX1,VY1)
  163.             CALL GSDRAW(VX1,VY0)
  164. C
  165.             VX0    = VX1
  166. C
  167.  400    CONTINUE
  168.  500    CONTINUE
  169. C
  170.         CALL ENDPLT
  171. C
  172.  9999   CONTINUE
  173. C
  174. C       BYE
  175. C
  176.         RETURN
  177.         END
  178.