Silverfrost Forums

Welcome to our forums

stats2.for missing

4 Jun 2014 12:51 #14148

The sample file STATS2.FOR (FTN77 User's Guide p17, Getting started) appears to be missing from the distribution: Salford FTN77/Win32 4.03 Personal Ed.

Please post it here (or alternatively e-mail it to me: raoul.abrutat@bigpond.com)

Thank you Raoul

4 Jun 2014 6:35 #14149
      REAL MARKS(100)
      INTEGER NMARKS
C   Read input data.  The data is read in list-directed (free) format.
C   The first value read is a count of the number of marks following.
C   The file containing the input data is MARKS.DAT.
C
      OPEN(UNIT=5,FILE='MARKS.DAT')
      READ(5,*)NMARKS
      READ(5,*)(MARKS(I),I=1,NMARKS)
      CLOSE(5)
C  List the data of the screen
      PRINT *,NMARKS,' values read as follows:'
      WRITE(*,200)(MARKS(I),I=1,NMARKS)
200   FORMAT(8F8.0)
C   Now calculate statistics
      CALL CALC(MARKS,NMARKS,XMEAN,XMED,XSD,XMAX,XMIN)
C   Print results
      PRINT *
      PRINT *,'Maximum:            ',XMAX
      PRINT *,'Minumum:            ',XMIN
      PRINT *,'Mean:               ',XMEAN
      PRINT *,'Median:             ',XMED
      PRINT *,'Standard deviation: ',XSD
      PRINT *
      PRINT *,'Program complete'
      END
c-----------------------------------------------------------------
      SUBROUTINE CALC(VALUES,NVALUES,XMEAN,XMED,XSD,XMAX,XMIN)
      REAL VALUES(*),XMEAN,XMED,XSD,XMAX,XMIN
      INTEGER NVALUES
C
      CALL MEAN(VALUES,NVALUES,XMEAN)
      CALL MEDIAN(VALUES,NVALUES,XMED)
      XSD=STDEV(VALUES,NVALUES)
      CALL MAXMIN(VALUES,NVALUES,XMAX,XMIN)
      END
c-------------------------------------------------------------------
      SUBROUTINE MEAN(VALUES,NVALUES,XMEAN)
      REAL VALUES(*),XMEAN
      INTEGER NVALUES
      X=0.0
      DO 1 I=1,NVALUE
          X=X+VALUES(I)
1     CONTINUE
      XMEAN=X/NVALUES
      END
c--------------------------------------------------------------------
      SUBROUTINE MEDIAN(VALUES,NVALUES,XMED)
      REAL VALUES(*),XMED
      INTEGER NVALUES
      LOGICAL OK
C   Sort values (simple bubble sort)
2     OK=.TRUE.
      DO 1 I=2,NVALUES
      IF(VALUES(I-1).GT.VALUES(I))THEN
         T=VALUES(I)
         VALUES(I)=VALUES(I-1)
         VALUES(I-1)=T
         OK=.FALSE.
      ENDIF
1     CONTINUE
      IF(.NOT.OK)GOTO 2
C   If NVALUES is odd, use middle value. If NVALUES is even, take average
C   of two middle values.
      MID=NVALUES/2
      IF(MID*2.NE.NVALUES)THEN
         XMED=VALUES(MID+1)
      ELSE
         XMED=(VALUES(MID)+VALUES(MID+1))/2.0
      ENDIF
      END
c-----------------------------------------------------------------------
      REAL FUNCTION STDEV(VALUES,NVALUES)
      REAL VALUES(*)
      INTEGER NVALUES
      X=0.
      X2=0.
      DO 1 I=1,NVALUES
         X=X+VALUES(I)
         X2=X2+VALUES(I)*VALUES(I)
1     CONTINUE
      V=NVALUES
      STDEV=SQRT((V*X2-X*X)/(V*(V-1)))
      END
c----------------------------------------------------------------------
      SUBROUTINE MAXMIN(VALUES,NVALUES,XMAX,XMIN)
      REAL VALUES(*)
      XMAX=VALUES(1)
      XMIN=VALUES(1)
      DO77I=2,NVALUES
      XMAX=MAX(XMAX,VALUES(I))
77    XMIN=MIN(XMIN,VALUES(I))
      END
Please login to reply.