! ---------------------------------------------------
! 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