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