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