Quadratic Equation Solver - 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 solve the equation. Note that a quadratic equation has repeated root if b*b-4.0*a*c is equal to zero. This program should distinguish repeated roots from distinct roots.

Solution

! ---------------------------------------------------
!   Solve  Ax^2 + Bx + C = 0 given B*B-4*A*C >= 0
!   Now, we are able to detect complex roots and
!   repeated roots.
! ---------------------------------------------------

PROGRAM  QuadraticEquation
   IMPLICIT  NONE

   REAL  :: a, b, c
   REAL  :: d
   REAL  :: root1, root2

!  read in the coefficients a, b and c

   READ(*,*)  a, b, c
   WRITE(*,*) 'a = ', a
   WRITE(*,*) 'b = ', b
   WRITE(*,*) 'c = ', c
   WRITE(*,*)

!  compute the discriminant d

   d = b*b - 4.0*a*c
   IF (d > 0.0) THEN               ! distinct roots?
      d     = SQRT(d)
      root1 = (-b + d)/(2.0*a)     ! first root
      root2 = (-b - d)/(2.0*a)     ! second root
      WRITE(*,*)  'Roots are ', root1, ' and ', root2
   ELSE
      IF (d == 0.0) THEN           ! repeated roots?
         WRITE(*,*)  'The repeated root is ', -b/(2.0*a)
      ELSE                         ! complex roots
         WRITE(*,*)  'There is no real roots!'
         WRITE(*,*)  'Discriminant = ', d
      END IF
   END IF

END PROGRAM  QuadraticEquation

Program Input and Output

• If the input to the program consists of 1.0, 5.0 and 2.0, we have the following output. Since the discriminant is b*b - 4.0*a*c = 5.0*5.0 - 4.0*1.0*2.0 = 17.0 > 0.0, the THEN part is executed and the real roots are -0.438447237 and -4.561553.

  1.0  5.0  2.0
  
  a = 1.
  b = 5.
  c = 2.
  
  Roots are -0.438447237 and -4.561553
  

• If the input to the program consists of 1.0, -10.0 and 25.0, we have the following output. Since the discriminant is b*b - 4.0*a*c = (-10.0)*(-10.0) - 4.0*1.0*25.0 = 0.0, the ELSE part is executed. Since there is a nested IF-THEN-ELSE-END IF in the ELSE, d = 0.0 is tested and therefore yields a repeated root 5.

  1.0  -10.0  25.0
  
  a = 1.
  b = -10.
  c = 25.
  
  The repeated root is 5.
  

• If the input to the program consists of 1.0, 2.0 and 5.0, we have the following output. Since the discriminant is b*b - 4.0*a*c = 2.0*2.0 - 4.0*1.0*5.0 = -16.0 < 0.0, the ELSE part is executed. Since d < 0.0, the ELSE part of the inner IF-THEN-ELSE-END IF is executed and a message of no real roots is displayed followed by the value of the discriminant.

  1.0  2.0  5.0
  
  a = 1.
  b = 2.
  c = 5.
  
  There is no real roots!
  Discriminant = -16.
  

Discussion

The lower part is not complete yet since we do not know if the equation has a repeated root. Therefore, one more test is required:

Inserting this back to the original yields the following final result:

This is the logic used in the above program.

The following is an equivalent program that uses ELSE-IF construct rather than nested IF:

! ---------------------------------------------------
!   Solve  Ax^2 + Bx + C = 0 given B*B-4*A*C >= 0
!   Now, we are able to detect complex roots and
!   repeated roots.
! ---------------------------------------------------

PROGRAM  QuadraticEquation
   IMPLICIT  NONE

   REAL  :: a, b, c
   REAL  :: d
   REAL  :: root1, root2

!  read in the coefficients a, b and c

   READ(*,*)  a, b, c
   WRITE(*,*) 'a = ', a
   WRITE(*,*) 'b = ', b
   WRITE(*,*) 'c = ', c
   WRITE(*,*)

!  compute the discriminant d

   d = b*b - 4.0*a*c
   IF (d > 0.0) THEN               ! distinct roots?
      d     = SQRT(d)
      root1 = (-b + d)/(2.0*a)     ! first root
      root2 = (-b - d)/(2.0*a)     ! second root
      WRITE(*,*)  'Roots are ', root1, ' and ', root2
   ELSE IF (d == 0.0) THEN         ! repeated roots?
      WRITE(*,*)  'The repeated root is ', -b/(2.0*a)
   ELSE                            ! complex roots
      WRITE(*,*)  'There is no real roots!'
      WRITE(*,*)  'Discriminant = ', d
   END IF

END PROGRAM  QuadraticEquation

Its logic is shown below using the box trick.