home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / histo.for < prev    next >
Encoding:
Text File  |  1986-05-19  |  1.6 KB  |  47 lines
  1.         SUBROUTINE      HISTO(X1,A,W,N )
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     HISTO                                   /
  5. C/      Date-written.   Jan. 16th 1984                          /
  6. C/      File-name.      HISTO.FOR                               /
  7. C/      Remarks.        Subroutine HISTO.FOR page 79.           /
  8. C/                      HISTO tabulates the number of times X1  /
  9. C/                      is within the specified cell limits.    /
  10. C/                                                              /
  11. C////////////////////////////////////////////////////////////////
  12. C
  13.         INTEGER*4       NSET(6,1 )
  14. C
  15.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  16.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  17.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  18. C
  19.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  20.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  21.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  22.      3         NDAY,NYR,JCLR
  23. C
  24. C
  25. C
  26.         IF (N- NHIST ) 11,11,2
  27.     2   WRITE(NPRNT,250 ) N
  28.   250     FORMAT(' Error in histogram',I4,// )
  29.         CALL    EXIT
  30.    11   IF (N ) 2,2,3
  31. C
  32. C       --- Translate X1 by subtracing A if X.LE.A
  33. C
  34.     3   X = X1 - A
  35.         IF (X ) 6,7,7
  36.     6   IC = 1
  37.                         GO TO 8
  38. C
  39. C       --- Determine cell number IC.
  40. C
  41.     7   IC = X / W + 2.0
  42.         IF (IC - NCELS(N ) - 1 ) 8,8,9
  43.     9   IC = NCELS(N ) + 2
  44.     8   JCELS(N,IC ) = JCELS(N,IC ) + 1
  45.         RETURN
  46.         END
  47.