PROGRAM quadeq2 ! ! Author: Br. David Carlson ! ! Date: January 3, 2000 ! ! Last revised: February 8, 2006 ! ! This program prompts the user for the 3 coefficients to a quadratic ! equation and prints out the real solution(s) to the quadratic equation. ! A modified form of the quadratic formula (with normalization and ! avoidance of the cancellation problem) is used. ! ! Try it for a = 1.0, b = -1.0E6, c = 1.0. Solutions should be 1.0E6 ! and 1.0E-6 approximately. Compare with quadeq1.f90. IMPLICIT NONE REAL::a REAL::b REAL::c REAL::discriminant REAL::root REAL::largest REAL::x WRITE (*, *) ' Program to find real solutions of a quadratic equation' WRITE (*, *) 'Enter (nonzero) coefficient a: ' READ (*, *) a WRITE (*, *) 'Enter coefficient b: ' READ (*, *) b WRITE (*, *) 'Enter coefficient c: ' READ (*, *) c ! Normalize: largest = MAX(ABS(a), ABS(b), ABS(c)) a = a / largest b = b / largest c = c / largest discriminant = b * b - 4.0 * a * c IF (discriminant < 0) THEN WRITE (*, *) ' No real solutions' ELSE IF (discriminant == 0) THEN WRITE (*, *) ' One real solution: ', -b / (2.0 * a) ELSE root = SQRT(discriminant) IF (-b > 0) THEN x = (-b + root) / (2.0 * a) ELSE x = (-b - root) / (2.0 * a) END IF WRITE (*, *) ' Two real solutions: ', x, ' and ', c / (a * x) END IF END PROGRAM