C THIS IS A DEMONSTRATION PROGRAM FOR THE C ROOTFINDING SUBROUTINE 'BISECT'. C EXTERNAL FCN C C INPUT PROBLEM PARAMETERS. 10 PRINT *, ' WHAT ARE A, B, EPSILON?' PRINT *, ' TO STOP, LET EPSILON=0.' READ *, A, B, EPSLON IF(EPSLON .EQ. 0.0) STOP C C CALCULATE ROOT CALL BISECT(FCN, A ,B ,EPSLON, ROOT, IER) C C PRINT ANSWERS. PRINT 1000, A, B, EPSLON PRINT 1001, ROOT, IER GO TO 10 1000 FORMAT(/,' A=',E11.4,5X,'B=',E11.4,5X,'EPSILON=',E9.3) 1001 FORMAT(' ROOT=',E14.7,5X,'IER=',I1) END FUNCTION FCN(X) C FCN = EXP(-X) - X RETURN END SUBROUTINE BISECT(F, A, B, EPS, ROOT, IER) C C THE PROGRAM USES THE BISECTION METHOD TO SOLVE C THE EQUATION C F(X) = 0. C THE SOLUTION IS TO BE IN [A,B] AND IT IS ASSUMED C THAT C F(A)*F(B) .LE. 0. C THE SOLUTION IS RETURNED IN ROOT, AND IT IS TO C BE IN ERROR BY AT MOST EPS. C C IER IS AN ERROR INDICATOR. C IF IER=0 ON COMPLETION OF THE ROUTINE, THEN THE C SOLUTION HAS BEEN COMPUTED SATISFACTORILY. C IF IER=1, THEN F(A)*F(B) WAS GREATER THAN 0, C CONTRARY TO ASSUMPTION. C PARAMETER(ZERO=0.0, ONE=1.0, TWO=2.0) C C INITIALIZE. FA = F(A) FB = F(B) SFA = SIGN(ONE, FA) SFB = SIGN(ONE, FB) IF(SFA*SFB .GT. ZERO) THEN C THE CHOICE OF A AND B IS IN ERROR. IER = 1 RETURN END IF C C CREATE A NEW VALUE OF C, THE MIDPOINT OF [A,B]. 10 C = (A + B)/TWO IF(ABS(B-C) .LE. EPS) THEN C C IS AN ACCEPTABLE SOLUTION OF F(X)=0. 20 ROOT = C IER = 0 RETURN END IF C C THE VALUE OF C WAS NOT SUFFICIENTLY ACCURATE. C BEGIN A NEW ITERATION. FC = F(C) IF(FC .EQ. ZERO) GO TO 20 SFC = SIGN(ONE, FC) IF(SFB*SFC .GT. ZERO) THEN C THE SOLUTION IS IN [A,C]. B = C SFB = SFC ELSE C THE SOLUTION IS IN [C,B]. A = C SFA = SFC END IF GO TO 10 END