PROGRAM ode4 ! ! 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 Taylor's series. The ODE has the form y' = f(x, y) and ! y(a) = s. The specific function used in this program is f(x, y) = 1 + y * y. ! It is well known that y = tan(x) is the solution to this ODE when a = 0 ! and s = 0. 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 = 0. IMPLICIT NONE REAL::x, y, delta, a, b INTEGER::n, k ! Functions used: REAL::f, soln, d1, d2, d3, d4 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 * d1(x, y) + (delta ** 2) * d2(x, y) / 2 & + (delta ** 3) * d3(x, y) / 6 + (delta ** 4) * d4(x, y) / 24 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 y with respect to x. ! Return: This computed value in the function name. REAL FUNCTION d1(x, y) IMPLICIT NONE REAL, INTENT(IN)::x REAL, INTENT(IN)::y d1 = y ** 2 + 1 END FUNCTION ! Given: x a real value ! y a real value ! Task: To calculate the value of the 2nd derivative of y ! with respect to x. ! Return: This computed value in the function name. REAL FUNCTION d2(x, y) IMPLICIT NONE REAL, INTENT(IN)::x REAL, INTENT(IN)::y d2 = 2 * y ** 3 + 2 * y END FUNCTION ! Given: x a real value ! y a real value ! Task: To calculate the value of the 3rd derivative of y ! with respect to x. ! Return: This computed value in the function name. REAL FUNCTION d3(x, y) IMPLICIT NONE REAL, INTENT(IN)::x REAL, INTENT(IN)::y d3 = 6 * y ** 4 + 8 * y ** 2 + 2 END FUNCTION ! Given: x a real value ! y a real value ! Task: To calculate the value of the 4th derivative of y ! with respect to x. ! Return: This computed value in the function name. REAL FUNCTION d4(x, y) IMPLICIT NONE REAL, INTENT(IN)::x REAL, INTENT(IN)::y d4 = 24 * y ** 5 + 40 * y ** 3 + 16 * y END FUNCTION ! Given: x a real value ! Task: To calculate the value of the solution function at x. ! Return: This computed value in the function name. REAL FUNCTION soln(x) IMPLICIT NONE REAL, INTENT(IN)::x soln = TAN(x) END FUNCTION