Skip to main content

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