PROGRAM ode1 ! ! Author: Br. David Carlson ! ! Date: January 4, 2000 ! ! Last Revised: May 2, 2004 ! ! This program finds an approximate solution to an ordinary differential ! equation via Euler's method. The ODE has the form y' = f(x, y) and ! y(a) = s. The specific function f used in this program is f(x, y) = y. ! It is well known that y = exp(x) is the solution to this ODE when a = 0 ! and s = 1. The program prints the value of the approximate and exact ! solution functions at several evenly spaced points from a to b. ! Suggestion: Try the interval from 0 to 1, 20 subintervals, and s = 1. IMPLICIT NONE REAL::x, y, delta, a, b INTEGER::n, k ! Functions used: REAL::f, soln WRITE (*, *) 'Program to solve the ODE y'' = f(x, y) and y(a) = s.' WRITE (*, *) 'Enter left endpoint a:' READ (*, *) a WRITE (*, *) 'Enter right endpoint b:' READ (*, *) b WRITE (*, *) 'Enter number of subintervals n:' READ (*, *) n WRITE (*, *) 'Enter starting value s for y(a):' READ (*, *) y WRITE (*, 50) 50 FORMAT (' ', T5, 'x value', T20, 'approx y value', T40, & 'y value from known solution') x = a delta = (b - a) / n WRITE (*, 100) x, y, soln(x) DO k = 1, n y = y + delta * f(x, y) x = x + delta WRITE (*, 100) x, y, soln(x) END DO 100 FORMAT (' ', T5, F10.4, T20, E16.8, T40, E16.8) END PROGRAM ! Given: x a real value ! y a real value ! Task: To calculate the value of f(x, y). ! Return: The computed value of f(x, y) in the function name. REAL FUNCTION f(x, y) IMPLICIT NONE REAL, INTENT(IN)::x REAL, INTENT(IN)::y f = y END FUNCTION ! Given: x a real value ! y a real value ! Task: To calculate the value of soln(x, y), where this is the known ! solution to the ODE. ! Return: The computed value of soln(x, y) in the function name. REAL FUNCTION soln(x) IMPLICIT NONE REAL, INTENT(IN)::x soln = EXP(x) END FUNCTION