PROGRAM looptest ! ! Author: Br. David Carlson ! ! Date: Mar 2, 2004 ! Last revised: Feb 4, 2016 ! ! In computing partial sums for a series and in other applications ! we sometimes want to have a loop count from 1 to a very large number. ! If we use integers, we will eventually hit integer overflow. If ! we use reals, overflow is possible, but a practical problem arises ! earlier: Since we only get about 7 decimal digits of precision with ! ordinary reals, we quickly reach a point where r + 1 equals r, for ! some large real r. Thus we can't use reals to control a counting ! loop beyond this point. ! ! The purpose of this program is to find the point where an integer ! loop control variable fails us as well as the point where a real ! as a loop control variable fails us. The program simply prints its ! answers to these two items. ! ! On our machine we get these results: ! Largest value for a real loop control variable: 16777216. ! Largest value for an integer loop control variable: 2147483647 ! Thus an integer loop control variable can handle larger values! ! ! It is strongly recommended that a real variable NEVER be used as ! a loop control variable. IMPLICIT NONE REAL::n, m INTEGER::j, k ! Test with reals: n = 1.0 DO m = n + 1.0 IF (m == n) THEN ! Adding 1 has no effect at this point. EXIT END IF n = m END DO WRITE (*, 100) n 100 FORMAT(1X, 'Largest value for a real loop control variable:', T60, F18.0) ! Test with integers: j = 1 DO k = j + 1 IF (k < 0) THEN ! We have passed the largest positive integer EXIT ! and wrapped around to a negative integer. END IF j = k END DO WRITE (*, 200) j 200 FORMAT(1X, 'Largest value for an integer loop control variable:', T60, I18) END PROGRAM