! ---------------------------------------------------
!   Solve  Ax^2 + Bx + C = 0 given B*B-4*A*C >= 0   
!   Now, we are able to detect the following:
!    (1) unsolvable equation
!    (2) linear equation
!    (3) quadratic equation
!        (a) distinct real roots
!        (b) repeated root
!        (c) no real 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(*,*)

   IF (a == 0.0) THEN              ! could be a linear equation
      IF (b == 0.0) THEN           ! the input becomes c = 0
         IF (c == 0.0) THEN        ! all numbers are roots
            WRITE(*,*)  'All numbers are roots'
         ELSE                      ! unsolvable
            WRITE(*,*)  'Unsolvable equation'
         END IF
      ELSE                         ! linear equation
         WRITE(*,*)  'This is linear equation, root = ', -c/b
      END IF
   ELSE                            ! ok, we have a quadratic equation
      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