c===========================================================
c     bisect: Uses bisection to find approximate root
c     of f(x) on interval [xmin .. xmax].  Return value is 
c     root located to (relative) tolerance 'xtol'.  Return code 
c     'rc' is set to 0 on success, non-zero on failure 
c     and routine succeeds (by definition) as long as initial
c     interval *does* bracket at least one root.  Routine
c     performs tracing of algorithm (on stderr) if input
c     argument 'trace' is .true.
c===========================================================
      real*8 function bisect(f,xmin,xmax,xtol,trace,rc)

         implicit     none

         real*8       drelabs

         real*8       f
         external     f

         real*8       xmin,          xmax,         xtol 
         logical      trace
         integer      rc
c-----------------------------------------------------------
c        Other variables needed for search.
c-----------------------------------------------------------
         integer      mxiter
         parameter  ( mxiter = 50 )

         real*8       xlo,           dx,           sfxmid,        
     &                sgn
         integer      iter
c-----------------------------------------------------------
c        Check that input interval is specified correctly
c        and that it manifestly brackets at least one root: 
c        (i.e. the fcn changes sign).
c-----------------------------------------------------------
         if( xmax .le. xmin  .or.  
     &       f(xmin) * f(xmax) .gt. 0.0d0 ) then
            write(0,*) 'bisect:  Input interval is not '//
     &                 'bracketing'
            rc = 1
c-----------------------------------------------------------
c           Returned value is meaningless in this case,
c           but have to return *some* value.
c-----------------------------------------------------------
            bisect = xmin
            return
         end if
c-----------------------------------------------------------
c        Compute 'sgn' such that sgn * f(xmin) < 0, and 
c        intialize bracketing interval
c-----------------------------------------------------------
         sgn  = 1.0d0
         if( f(xmin) .le. 0.0d0 ) then
            sgn =  1.0d0
         else
            sgn = -1.0d0 
         end if
         xlo  = xmin
         dx   = xmax - xmin
c-----------------------------------------------------------
c        Bisection loop: continue until root found to     
c        specfied tolerance or until maximum number of 
c        iterations taken
c-----------------------------------------------------------
         do iter = 1 , mxiter
            bisect = xlo + 0.5d0 * dx
            if( trace ) then
               write(0,*) xlo, xlo + dx, f(bisect)
            end if
            if( sgn * f(bisect) .lt. 0.0d0 ) then
               xlo = bisect
            end if
            if( drelabs(dx,bisect,1.0d-10) .le. xtol ) go to 900
            dx = 0.5d0 * dx
         end do

900      continue
         rc = 0 
         if( trace ) write(0,*)
         return

      end

c===========================================================
c     drelabs:  Function useful for 'relativizing' quantity
c     being monitored for detection of convergence.  
c===========================================================
      real*8 function drelabs(dx,x,xfloor)
         implicit      none

         real*8        dx,     x,    xfloor

         if( abs(x) .lt. abs(xfloor) ) then
            drelabs = abs(dx)
         else
            drelabs = abs(dx/x)
         end if

         return
      end
