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