!**********************************************************************!
!
! File: fpi.f90 (03-Jun-2008)
!
! Fixpunktiteration zur Loesung von
!
!   x = phi(x) = exp(-x/2)
!
! x0.....Startwert
! xacc...Genauigkeit der Naeherungsloesung
!
!**********************************************************************!

module fpi_m

!**********************************************************************!

  implicit none

  private

  integer,parameter,public::double=selected_real_kind(15)

  public::phi

contains

!**********************************************************************!

  function phi(x) result(y)

!**********************************************************************!

    real(kind=double),intent(in)::x
    real(kind=double)::y

    y=exp(-0.5*x)

    return

  end function phi

end module fpi_m

!**********************************************************************!

program fpi

!**********************************************************************!

  use fpi_m

  implicit none

  integer,parameter::itmax=30

  integer::it
  real(kind=double)::x,x0,xacc,xn

  write(unit=*,fmt="(a)",advance="no") "   x0="
  read(unit=*,fmt=*) x0
  write(unit=*,fmt="(a)",advance="no") " xacc="
  read(unit=*,fmt=*) xacc

  x=x0

  iteration: do it=1,itmax

    xn=phi(x)

    write(unit=*,fmt="(a,es14.7,a,es14.7)") &
         " x=",x,"   |xn-x|=",abs(xn-x)

    if(abs(xn-x)<xacc) then
      write(unit=*,fmt="(a,es14.7)") " s=",x
      exit iteration
    end if

    x=xn

  end do iteration

  if(it>itmax) then
    write(unit=*,fmt="(a)") " fpi: itmax ueberschritten"
  end if

end program fpi

!**********************************************************************!