Solution

 PROGRAM KwodWatik
  IMPLICIT NONE
  REAL :: a, b, c, root1, root2
  REAL :: B_sq, AC4, Sqrt_Thing
  REAL, PARAMETER :: My_Epsilon = 0.000001
   DO
    PRINT*, "Type in a, b and c (0,0,0 will terminate)"
    READ*, a, b, c
    IF (ABS(a+b+c) < My_Epsilon) EXIT
    B_sq = b**2
    AC4  = 4*a*c
    IF (B_sq > AC4) THEN
     Sqrt_Thing = SQRT(B_sq-ac4)
     root1 = (-b+Sqrt_Thing)/(2*a)
     root2 = (-b-Sqrt_Thing)/(2*a)
     PRINT*,"The real roots are ", root1, root2
    ELSEIF (ABS(B_sq - AC4) < My_Epsilon) THEN
     root1 = (-b)/(2*a)
     PRINT*,"There is one real root which is", root1
    ELSE
     PRINT*,"There are no real roots"
    END IF
   END DO
 END PROGRAM KwodWatik

It is possible to use a lot less variables but the solution is not as clear.