FUNCSP.F95
PROGRAM FUNCSP
!
! Purpose: To demonstrate the use of a FUNCTION subprogram
!
IMPLICIT NONE
REAL:: A,B,C ! Coeffs. of quadratic equation
REAL:: BIGRT ! Biggest root
!
WRITE(*,10)
READ(*,*)A,B,C
WRITE(*,20)A,B,C,BIGRT(A,B,C)
10 FORMAT('Enter the coefficients of Ax**2+Bx+C in order A, B, C'/)
20 FORMAT('The A, B and C coeffs. are: '/3F10.4/'The largest root is ',F12.6)
STOP
END PROGRAM FUNCSP
!
FUNCTION BIGRT(P,Q,R)
!
! Function to find largest root of a quadratic
! If no real roots then function returns value -9.0E35
!
IMPLICIT NONE
REAL, INTENT(IN):: P,Q,R ! Coeffs. of quadratic Px**2+Qx+R=0
REAL:: RT1,RT2,BIGRT ! Individual roots and biggest root resp.
REAL:: TEST,RT ! Working variables
!
TEST=Q*Q-4.0*P*R
IF(TEST.GE.0.0)THEN ! Test for real roots and find biggest
RT=SQRT(TEST)
RT1=(-Q+RT)/2.0/P
RT2=(-Q-RT)/2.0/P
BIGRT=RT1
IF(RT2.GT.RT1)BIGRT=RT2
ELSE
BIGRT=-9.0E35
END IF
RETURN
END FUNCTION BIGRT