PROGRAM Quadratic

!-------------------------------------------------------------------------
!  This program performs the quadratic equation given A, B, and C from
! the equation A x ** 2 + B x + C. This program first calculates the
! discriminte to determine if there are real roots. If not, the program
! should display the imagenary roots.
!
! Programmed by:
!     Matthew S. Norton
!
!----------------------------------------------------------------------------
!
! Variable dictionary
!
! Input
!     A
!     B
!     C
!     Response
!
! Process
!     D
!     Dreal
!     Dimaginary
!     Root1
!     Root2
!
! Output
!     Root1
!     Root2
!
!---------------------------------------------------------------------------

IMPLICIT NONE

REAL :: A, B, C, Dreal, Dimaginary, Root1, Root2, D, roots
CHARACTER :: Response

! Start da do loop
Program: Do

! Prompt user for A, B, and C

      PRINT *, "A x ** 2 + B x + C"
      PRINT *, "Please input the values for A, B, and C"
      READ *, A, B, C


! Calculate Discrimate

D = B ** 2 - ( 4 * A * C )

      IF (D < 0) THEN
         PRINT *, "Roots are imaginary"
         Dimaginary = D
         
         ! Calculate roots
        
         root1 = (-B + SQRT(-Dimaginary)) / (2 * A)
         root2 = (-B - SQRT(-Dimaginary)) / (2 * A)

         ! Print roots
         
         PRINT '(1X, A, 1X, F8.3, A1)', " The first root is: ", root1, "i"
         PRINT *, ""
         PRINT '(1X, A, 1X, F8.3, A1)', " The second root is: ", root2, "i"
         PRINT *, ""
       
       ELSE IF (D == 0) THEN
          PRINT *, "There only one (1) root"
          
          ! Calculate root
         
          Root1 = -B / (2 * A)

          ! Print results

          PRINT '(1X, A, 1X, F8.3)', "The root is: ", Root1
          PRINT *, ""
          
       ELSE
          PRINT *, "There are two (2) real roots"
          Dreal = D
             
          ! Calculate roots
          
          root1 = (-B + SQRT(Dreal) / (2 * A))
          root2 = (-B + SQRT(Dreal) / (2 * A))

          ! Print results

          PRINT '(1X, A, 1X, F8.3)', " The first root is: ", Root1
          PRINT '(1X, A, 1X, F8.3)', " The second root is: ", Root2 
       END IF

! Ask user if they want to run prograrm again
      YorN: DO
         PRINT *, ""
         PRINT *, "Find more roots? (y/n) "
         READ *, Response

         IF (Response == "y" .OR. Response == "Y") THEN
            PRINT *, ""
            EXIT YorN
         ELSE IF (Response == "n" .OR. Response == "N") THEN
            EXIT Program
         ELSE
            CYCLE YorN
         END IF
      END DO  YorN


END DO Program

! Thank user for using program

       PRINT *, ""
       PRINT *, " Thank you for using this program and have a great day!"
       PRINT *, " Program is complete"

END PROGRAM QUADRATIC