PROGRAM newton3 ! ! Author: Br. David Carlson ! ! Date: January 4, 2000 ! ! Last Revised: May 2, 2004 ! ! This program uses Newton's method to find a zero of the function ! EXP(x) - 3 * x. An exact formula for the derivative is used, which ! is the best way to carry out Newton's method. Of course, a ! reasonable guess at a zero must be given, such as 0.5 or 1.5. ! Compare to bsectst3.f90. Note that Newton's method is sometimes ! called the Newton-Raphson method. IMPLICIT NONE INTEGER::n, k REAL::x, tol ! Functions used: REAL::f, df tol = 1.0E-5 WRITE (*, *) 'Enter guess at a zero for the function:' READ (*, *) x WRITE (*, *) 'Enter maximum number of iterations:' READ (*, *) n WRITE (*, 50) 50 FORMAT (' ', T5, 'n', T15, 'approx zero') DO k = 1, n x = x - f(x) / df(x) WRITE (*, 100) k, x IF (ABS(f(x)) < tol) THEN WRITE (*, *) 'Function value within tolerance' EXIT END IF END DO 100 FORMAT (' ', T5, I5, T15, E16.7) WRITE (*, *) ' ' WRITE (*, *) 'The approximate value of the zero of the function is ', x WRITE (*, *) 'As a check, function value at this approx zero = ', f(x) END PROGRAM ! Given: x a real value ! Task: To calculate the value of f(x). ! Return: The computed value of f(x) in the function name. REAL FUNCTION f(x) IMPLICIT NONE REAL, INTENT(IN)::x f = EXP(x) - 3 * x END FUNCTION ! Given: x a real value ! Task: To calculate the value of the derivative of f at x. ! Return: This computed value in the function name. REAL FUNCTION df(x) IMPLICIT NONE REAL, INTENT(IN)::x df = EXP(x) - 3 END FUNCTION