# Quadratic Equation Solver – Revisited (Again)

### Problem Statement

Given a quadratic equation as follows:

if

**b*b-4*a*c**is non-negative, the roots of the equation can be solved with the following formulae:

Write a program to read in the coefficients

**a**,**b**and**c**, and uses an internal subroutine to solve the equation. Note that a quadratic equation has repeated root if**b*b-4.0*a*c**is equal to zero.### Solution

! --------------------------------------------------------------------

! PROGRAM QuadraticEquation:

! This program calls subroutine Solver() to solve quadratic

! equations.

! --------------------------------------------------------------------

PROGRAM QuadraticEquation

IMPLICIT NONE

INTEGER, PARAMETER :: NO_ROOT = 0 ! possible return types

INTEGER, PARAMETER :: REPEATED_ROOT = 1

INTEGER, PARAMETER :: DISTINCT_ROOT = 2

INTEGER :: SolutionType ! return type variable

REAL :: a, b, c ! coefficients

REAL :: r1, r2 ! roots

READ(*,*) a, b, c ! read in coefficients

CALL Solver(a, b, c, r1, r2, SolutionType) ! solve it

SELECT CASE (SolutionType) ! select a type

CASE (NO_ROOT) ! no root

WRITE(*,*) "The equation has no real root"

CASE (REPEATED_ROOT) ! repeated root

WRITE(*,*) "The equation has a repeated root ", r1

CASE (DISTINCT_ROOT) ! distinct roots

WRITE(*,*) "The equation has two roots ", r1, " and ", r2

END SELECT

CONTAINS

! --------------------------------------------------------------------

! SUBROUTINE Solver():

! This subroutine takes the coefficients of a quadratic equation

! and solve it. It returns three values as follows:

! (1) Type - if the equation has no root, a repeated root, or

! distinct roots, this formal arguments returns NO_ROOT,

! REPEATED_ROOT and DISTINCT_ROOT, respectively.

! Note that these are PARAMETERS declared in the main

! program.

! (2) Root1 and Root2 - if there is no real root, these two formal

! arguments return 0.0. If there is a repeated

! root, Root1 returns the root and Root2 is zero.

! Otherwise, both Root1 and Root2 return the roots.

! --------------------------------------------------------------------

SUBROUTINE Solver(a, b, c, Root1, Root2, Type)

IMPLICIT NONE

REAL, INTENT(IN) :: a, b, c

REAL, INTENT(OUT) :: Root1, Root2

INTEGER, INTENT(OUT) :: Type

REAL :: d ! the discriminant

Root1 = 0.0 ! set the roots to zero

Root2 = 0.0

d = b*b - 4.0*a*c ! compute the discriminant

IF (d < 0.0) THEN ! if the discriminant < 0

Type = NO_ROOT ! no root

ELSE IF (d == 0.0) THEN ! if the discriminant is 0

Type = REPEATED_ROOT ! a repeated root

Root1 = -b/(2.0*a)

ELSE ! otherwise,

Type = DISTINCT_ROOT ! two distinct roots

d = SQRT(d)

Root1 = (-b + d)/(2.0*a)

Root2 = (-b - d)/(2.0*a)

END IF

END SUBROUTINE Solver

END PROGRAM QuadraticEquation

Click **here** to download this program.

### Program Input and Output

- If the input to the program consists of 3.0, 6.0 and 2.0, we have the following output.

3.0 6.0 2.0

The equation has two roots -0.422649741 and -1.57735026 - If the input to the program consists of 1.0, -2.0 and 1.0, we have the following output.

1.0 -2.0 1.0

The equation has a repeated root 1. - If the input to the program consists of 1.0, 1.0 and 1.0, we have the following output.

1.0 1.0 1.0

The equation has no real root

### Discussion

- The main program reads in the coefficients of a quadratic equation and calls subroutine
**Solver()**to find the roots. Because there are three possible cases (*i.e.*, no root, a repeated root and two distinct roots), the main program defines three**PARAMETER**s for these cases:**NO_ROOT**for no real root,**REPEATED_ROOT**for repeated root, and**DISTINCT_ROOT**for distinct roots. Since they are declared in the main program, they are global and can be “seen” by all internal functions and subroutines. - The main program passes the coefficients to
**Solver()**and expects the subroutine to return the roots through**r1**and**r2**and the type of the roots with**SolutionType**. After receiving the type, the main program uses**SELECT CASE**to display the results. - Subroutine
**Solver()**receives the coefficients from**a**,**b**and**c**. If the equation has no root (*resp.*, repeated root or distinct roots),**NO_ROOT**(*resp.*,**REPEATED_ROOT**or**DISTINCT_ROOT**) is stored into formal argument**Type**. - Note that formal arguments
**Root1**and**Root2**are initialized with zero. Therefore, in case they do not receive values in subsequent computations, they still return values. In the subroutine, if the equation has no root, both**Root1**and**Root2**return zero; if the equation has a repeat root,**Root1**contains the root and**Root2**is zero; and if the equation has distinct roots, the roots are stored in**Root1**and**Root2**.