home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 100 / 49 / pcstat3.for < prev    next >
Text File  |  1986-04-06  |  2KB  |  76 lines
  1. $DEBUG
  2.       PROGRAM PCSTAT3
  3. C
  4. C     ********************************************************
  5. C     *                                                      *
  6. C     *     STATISTICAL CODE/TEXT ANALYSIS        v1.0       *
  7. C     *     (C) COPYRIGHT RICHARD NOLEN COLVARD   Apr-86     *
  8. C     *         COMMERCIAL RIGHTS RESERVED                   *
  9. C     *         MICROSOFT (MS FORTRAN V3.3)                  *
  10. C     *                                                      *
  11. C     ********************************************************
  12. C
  13.       INTEGER*2   IERR,J,J1,CR
  14.       INTEGER*4   COUNTS(256),TOTAL
  15.       CHARACTER*1 CARD(128)
  16.       DATA COUNTS /256 * 0/
  17.       DATA IERR /0/, TOTAL/0/, CR/013/
  18. C
  19. C
  20.       WRITE(*,10)
  21.   10  FORMAT(10X,'PC-CODE3  STATISTICAL ANALYSIS    v1.0',//)
  22.   20  FORMAT(10X,'(c) Copyright R. Nolen COLVARD Company 1986')
  23.   22  FORMAT(10X,'    Commercial Rights Reserved')
  24.   24  FORMAT(10X,'(c) Copyright Microsoft Corp 1985')
  25.   26  FORMAT(10X,'    Microsoft FORTRAN V3.3',//)
  26.       WRITE(*,20)
  27.       WRITE(*,22)
  28.       WRITE(*,24)
  29.       WRITE(*,26)
  30. C
  31. C
  32.       WRITE(*,29)
  33.   29  FORMAT(5X,'Please Enter the CODE or TEXT file to analysis')
  34.       WRITE(*,31)
  35.   31  FORMAT(5X,'Enter an Input FILE name:',/)
  36. C
  37. C
  38.       OPEN(5,FILE=' ',FORM='FORMATTED',ACCESS='SEQUENTIAL',
  39.      +       STATUS='OLD')
  40. C
  41. C
  42.   400 FORMAT(5X,/)
  43.       WRITE(*,400)
  44.   75  CONTINUE
  45.   70  FORMAT(128A1)
  46.       DO 76 J=1,128
  47.   76  CARD(J) = CHAR( CR )
  48. C
  49. C
  50.       READ(5,70,END=199) CARD
  51. C
  52.       DO 80 J=1,128
  53.          IJ = ICHAR( CARD(J) ) + 1
  54.          IF (IJ .EQ. 14) GOTO 75
  55.          COUNTS(IJ) = COUNTS(IJ) + 1
  56.          TOTAL = TOTAL + 1
  57.   80  CONTINUE
  58. C
  59.       GOTO 75
  60. C
  61. C
  62.  199  DO 200 J=1,256
  63.          IF (COUNTS(J) .GT. 0) THEN
  64.             J1 = J - 1
  65.             WRITE(*,90) J1, CHAR(J1), COUNTS(J)
  66.          ENDIF
  67.   200 CONTINUE
  68.    90 FORMAT(5X,I4,3X,A1,3X,I5)
  69. C
  70. C
  71.       CLOSE(7)
  72.   900 FORMAT(2X,//,5X,'*** STATITICAL TESTS COMPLETED ***',//)
  73.       WRITE(*,900)
  74.       STOP
  75.       END
  76.