home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / fortran / stats.for < prev    next >
Encoding:
Text File  |  1988-08-11  |  3.6 KB  |  161 lines
  1. C**********************************************************************
  2. C
  3. C  STATS.FOR
  4. C
  5. C        Calculates simple statistics (minimum, maximum, mean, median,
  6. C        variance, and standard deviation) of up to 50 values.
  7. C
  8. C        Reads one value at a time from unit 5.  Echoes values and
  9. C        writes results to unit 6.
  10. C
  11. C        All calculations are done in single precision.
  12. C
  13. C
  14. C***********************************************************************
  15.  
  16.  
  17.  
  18.       DIMENSION DAT(50)
  19.       OPEN(5,FILE=' ')
  20.  
  21.       N=0
  22.       DO 10 I=1,50
  23.       READ(5,99999,END=20) DAT(I)
  24.       N=I
  25.  10   CONTINUE
  26.  
  27. C Too many values.  Write error message and die.
  28.  
  29.       WRITE(6,99998) N
  30.       STOP
  31.   
  32. C Test to see if there's more than one value.  We don't want to divide 
  33. C by zero.
  34.  
  35. 20    IF(N.LE.1) THEN 
  36.  
  37. C Too few values. Print message and die.
  38.  
  39.          WRITE(6,99997) 
  40.  
  41.       ELSE
  42.  
  43. C Echo input values to output.
  44.  
  45.          WRITE(6,99996)
  46.          WRITE(6,99995) (DAT(I),I=1,N)
  47.  
  48. C Calculate mean, standard deviation, and median.
  49.  
  50.          CALL MEAN (DAT,N,DMEAN)
  51.          CALL STDEV (DAT,N,DMEAN,DSTDEV,DSTVAR)
  52.          CALL MEDIAN (DAT,N,DMEDN,DMIN,DMAX)
  53.  
  54.          WRITE(6,99994) N,DMEAN,DMIN,DMAX,DMEDN,DSTVAR,DSTDEV
  55.  
  56.       ENDIF
  57.  
  58.       STOP
  59.  
  60. 99999 FORMAT(E14.6)
  61. 99998 FORMAT('0 ********STAT: TOO MANY VALUES-- ',I5)
  62. 99997 FORMAT('0 ********STAT: TOO FEW VALUES (1 OR LESS) ')
  63. 99996 FORMAT(//,10X,
  64.      +' ******************SAMPLE DATA VALUES*****************'//)
  65. 99995 FORMAT(5(1X,1PE14.6))
  66. 99994 FORMAT(///,10X,
  67.      +' ******************SAMPLE STATISTICS******************',//,
  68.      +15X,'          Sample size = ',I5,/,
  69.      +15X,'          Mean        = ',1PE14.6,/,
  70.      +15X,'          Minimum     = ',E14.6,/,
  71.      +15X,'          Maximum     = ',E14.6,/
  72.      +15X,'          Median      = ',E14.6,/
  73.      +15X,'          Variance    = ',E14.6,/
  74.      +15X,'          St deviation= ',E14.6////)
  75.  
  76.       END
  77.  
  78. C Calculate the mean (XMEAN) of the N values in array X.
  79.  
  80.       SUBROUTINE  MEAN (X,N,XMEAN)
  81.       DIMENSION X(N)
  82.  
  83.       SUM=0.0
  84.       DO 10 I=1,N
  85.          SUM=SUM+X(I)
  86.    10 CONTINUE
  87.  
  88.       XMEAN=SUM/FLOAT(N)
  89.  
  90.       RETURN
  91.       END
  92.  
  93. C Calculate the standard deviation (XSTDEV) and variance (XVAR)
  94. C of the N values in X using the mean (XMEAN).
  95. C This divides by zero when N = 1.
  96.  
  97.       SUBROUTINE STDEV (X,N,XMEAN,XSTDEV,XVAR)
  98.       DIMENSION X(N)
  99.  
  100.       SUMSQ=0.0
  101.       DO 10 I=1,N
  102.          XDIFF=X(I)-XMEAN
  103.          SUMSQ=SUMSQ+XDIFF*XDIFF
  104.    10 CONTINUE
  105.  
  106.       XVAR=SUMSQ/FLOAT(N-1)
  107.       XSTDEV=SQRT(XVAR)
  108.  
  109.       RETURN
  110.       END
  111.  
  112.  
  113. C Calculate the median (XMEDN), minimum (XMIN), and maximum (XMAX) of
  114. C the N values in X.
  115. C MEDIAN sorts the array and then calculates the median value.
  116.  
  117.       SUBROUTINE MEDIAN (X,N,XMEDN,XMIN,XMAX)
  118.       DIMENSION X(N)
  119.  
  120.       CALL SORT (X,N)
  121.  
  122.       IF(MOD(N,2).EQ.0) THEN
  123.          K=N/2
  124.          XMEDN=(X(K)+X(K+1))/2.0
  125.       ELSE
  126.          K=(N+1)/2
  127.          XMEDN=X(K)
  128.       ENDIF
  129.  
  130.       XMIN=X(1)
  131.       XMAX=X(N)
  132.  
  133.       END
  134.  
  135. C Sort the N values in array X.  SORT uses a bubble sort
  136. C that quits when no values were exchanged on the last pass.
  137. C Each pass goes from the first element to where the last
  138. C exchange occurred on the previous pass.
  139.  
  140.       SUBROUTINE SORT (X,N)
  141.       DIMENSION X(N)
  142.  
  143.       IBND=N
  144.   20  IXCH=0
  145.      
  146.       DO 100 J=1,IBND-1 
  147.            IF(X(J).GT.X(J+1))THEN
  148.               TEMP=X(J)
  149.               X(J)=X(J+1)
  150.               X(J+1)=TEMP
  151.               IXCH=J
  152.            ENDIF
  153.  100  CONTINUE
  154.  
  155.       IF (IXCH.EQ.0) RETURN
  156.       IBND=IXCH
  157.       GO TO 20
  158.    
  159.       END
  160.  
  161.