Chapter 2 - Programming and Software - Problems - Page 47: 2.4

PROGRAM Rootfind IMPLICIT NONE INTEGER::ier REAL::a, b, c, r1, i1, r2, i2 DATA a,b,c/1.,5.,2./ CALL Roots(a, b, c, ier, r1, i1, r2, i2) IF (ier .EQ. 0) THEN PRINT *, r1,i1," i" PRINT *, r2,i2," i" ELSE PRINT *, "No roots" END IF END SUBROUTINE Roots(a, b, c, ier, r1, i1, r2, i2) IMPLICIT NONE INTEGER::ier REAL::a, b, c, d, r1, i1, r2, i2 r1=0. r2=0. i1=0. i2=0. IF (a .EQ. 0.) THEN IF (b <> 0) THEN r1 = -c/b ELSE ier = 1 END IF ELSE d = b**2 - 4.*a*c IF (d >= 0) THEN r1 = (-b + SQRT(d))/(2*a) r2 = (-b - SQRT(d))/(2*a) ELSE r1 = -b/(2*a) r2 = r1 i1 = SQRT(ABS(d))/(2*a) i2 = -i1 END IF END IF END

PROGRAM Rootfind IMPLICIT NONE INTEGER::ier REAL::a, b, c, r1, i1, r2, i2 DATA a,b,c/1.,5.,2./ CALL Roots(a, b, c, ier, r1, i1, r2, i2) IF (ier .EQ. 0) THEN PRINT *, r1,i1," i" PRINT *, r2,i2," i" ELSE PRINT *, "No roots" END IF END SUBROUTINE Roots(a, b, c, ier, r1, i1, r2, i2) IMPLICIT NONE INTEGER::ier REAL::a, b, c, d, r1, i1, r2, i2 r1=0. r2=0. i1=0. i2=0. IF (a .EQ. 0.) THEN IF (b <> 0) THEN r1 = -c/b ELSE ier = 1 END IF ELSE d = b**2 - 4.*a*c IF (d >= 0) THEN r1 = (-b + SQRT(d))/(2*a) r2 = (-b - SQRT(d))/(2*a) ELSE r1 = -b/(2*a) r2 = r1 i1 = SQRT(ABS(d))/(2*a) i2 = -i1 END IF END IF END