
! -----------------------------------------------------------------------------
! -- First "proper" programme for F90 course.  
!
!    This is a _bad_ programme since each subroutine has an IMPLICIT 
!    interface --- the compiler cannot check that each subroutine is called
!    correctly;  incorrect calls can lead to difficult to spot bugs, memory
!    problems (segmentation faults) and general weirdness.
! -----------------------------------------------------------------------------


PROGRAM quadratic

  IMPLICIT NONE
  REAL    :: a, b, c
  COMPLEX :: root_1, root_2

  ! -- 

  CALL Initialise()

  ! -- Read in (real) coefficients of quadratic ax^2 + bx + c = 0 then
  !    examine them to work out what kind of solution we expect and tell
  !    our customer;  compute roots and output them.

  CALL Get_Coefficients(a, b, c)
  CALL Compute_Roots(a, b, c, root_1, root_2)
  CALL Put_Roots(root_1, root_2)

  ! -- 

  CALL Finalise()

END 


! -----------------------------------------------------------------------------
! -- EXTERNAL PROCEDURES --- IMPLICIT INTERFACES :  NO ARGUMENT-CHECKING...
! -----------------------------------------------------------------------------

! -- 

SUBROUTINE Initialise

  IMPLICIT NONE

END


! -----------------------------------------------------------------------------
! -- 

SUBROUTINE Get_Coefficients(a, b, c)

  IMPLICIT NONE
  REAL, INTENT(INOUT) :: a, b, c

  PRINT *, "Enter coefficients:"
  READ  *, a, b, c
  PRINT *, "Got coefficients:", a, b, c

END


! -----------------------------------------------------------------------------
! -- 

SUBROUTINE Compute_Roots(a, b, c, r_1, r_2)

  IMPLICIT NONE
  REAL, INTENT(IN)     :: a, b, c
  COMPLEX, INTENT(OUT) :: r_1, r_2

    PRINT *, "Computing roots..."

    r_1 = (-b + SQRT(CMPLX(b**2 - 4*a*c))) / (2*a)
    r_2 = (-b - SQRT(CMPLX(b**2 - 4*a*c))) / (2*a)

END


! -----------------------------------------------------------------------------
! -- 

SUBROUTINE Put_Roots(r_1, r_2)

  IMPLICIT NONE
  COMPLEX, INTENT(IN) :: r_1, r_2

    PRINT *, "The roots are..."
    PRINT *, r_1, r_2
END


! -----------------------------------------------------------------------------
! -- 

SUBROUTINE Finalise

  IMPLICIT NONE

END

! -----------------------------------------------------------------------------
! -----------------------------------------------------------------------------

