MODULE yhtalo
CONTAINS
  FUNCTION fun(x) RESULT(fun_arvo)
    IMPLICIT NONE
    REAL, INTENT(IN) :: x
    REAL :: fun_arvo
    fun_arvo = EXP(x) + x - 5
  END FUNCTION fun
END MODULE yhtalo

MODULE nollakohta

  IMPLICIT NONE
  PRIVATE
  REAL, PARAMETER :: toleranssi = 1e3*EPSILON(1.0)
  PUBLIC :: puolitushaku

CONTAINS

  FUNCTION puolitushaku(f, a, b) RESULT(hakupiste)
    IMPLICIT NONE
    INTERFACE
      FUNCTION f(x) RESULT(f_arvo)
        REAL, INTENT(IN) :: x
        REAL :: f_arvo
      END FUNCTION f
    END INTERFACE
    REAL, INTENT(IN) :: a, b  ! Hakuvälin päätepisteet
    REAL :: x1, x2, hakupiste, arvo
    LOGICAL :: merkki

    x1 = a
    x2 = b
    merkki = f(x1) < 0.0
    IF (merkki .EQV. (f(x2) < 0)) THEN
      WRITE (*,*) 'Päätepistearvot samanmerkkiset!'
      hakupiste = -HUGE(hakupiste)
    ELSE
      DO WHILE (ABS(x1 - x2) > toleranssi*ABS(x1))
        hakupiste = 0.5*(x1+x2)
        arvo = f(hakupiste)
        IF ((arvo < 0.0) .EQV. merkki) THEN
          x1 = hakupiste
        ELSE
          x2 = hakupiste
        END IF
      END DO
    END IF
  END FUNCTION puolitushaku

END MODULE nollakohta

PROGRAM ratkaisu
  USE yhtalo, ONLY : fun
  USE nollakohta, ONLY : puolitushaku
  IMPLICIT NONE
  REAL :: x
  x = puolitushaku(fun, 0.0, 5.0)
  IF (ABS(x) < HUGE(x)) THEN
    WRITE (*,*) 'Nollakohta:', x, fun(x)
  END IF
END PROGRAM ratkaisu