PROGRAM series1 ! ! Author: Br. David Carlson ! ! Date: December 31, 1999 ! ! Revised: May 2, 2004 ! ! This program prints out partial sums for a series, stopping when no further ! change is found by adding on another term (or when a set number of terms ! have been added -- to prevent an infinite loop). The particular series used ! is 1 + 1/2 + 1/4 + 1/8 + ... IMPLICIT NONE REAL::term, sum, sumold INTEGER::n term = 1.0 sum = 0.0 n = 0 WRITE (*, 20) 20 FORMAT (1X, 'Program to investigate a series') WRITE (*, 50) 50 FORMAT (' ', T5, 'n', T15, 'term', T35, 'partial sum') DO n = n + 1 sumold = sum sum = sum + term WRITE (*, 100) n, term, sum IF ((sum == sumold) .OR. (n == 200)) THEN EXIT END IF term = term * 0.5 END DO 100 FORMAT (' ', T5, I3, T15, E16.8, T35, E16.8) END PROGRAM