PROGRAM Nullstellenbestimmung
 IMPLICIT NONE
 REAL    :: polynom(0:3), nullstelle, abbruch, x0, wert
 INTEGER :: n, i, iostat

 INTERFACE
  REAL FUNCTION funktionswert(f,x)
   IMPLICIT NONE
   REAL :: f(0:), x
  END FUNCTION
  REAL FUNCTION sekante(f,x,eps)
   IMPLICIT NONE
   REAL :: f(0:), x, eps
  END FUNCTION
 END INTERFACE

 DO
  WRITE (*,*)
  WRITE (*,'(A)') '        1      2      3'
  WRITE (*,'(A)') 'a  + a x  + a x  + a x '
  WRITE (*,'(A)') ' 0    1      2      3'
  WRITE (*,*)
  DO
   WRITE (*,'(A)') 'Polynomkoeffizienten (a[0] - a[3]) eingeben:'
   READ (*,*,IOSTAT=iostat) polynom
   INCLUDE 'fehler.txt'
  END DO
! Plausibilitaetskontrolle
  IF (polynom(3) == 0) THEN
   WRITE (*,*) 'Das ist kein Polynom 3. Grades'
   CYCLE
  ELSE IF ((polynom(1)==0) .AND. (polynom(2)==0)) THEN
   WRITE (*,*) 'Triviale Loesung:'
   ! Probleme mit dritter Wurzel aus negativer Zahl
   IF (polynom(0)*polynom(3) > 0) THEN
    WRITE (*,*) -(polynom(0)/polynom(3))**(1./3.)
   ELSE
    WRITE (*,*) (-polynom(0)/polynom(3))**(1./3.)
   ENDIF
   CYCLE
  ENDIF
  DO
   WRITE (*,'(A)',ADVANCE='NO') 'Startwert: '
   READ (*,*,IOSTAT=iostat) x0
   INCLUDE 'fehler.txt'
  END DO
  DO
   WRITE (*,'(A)',ADVANCE='NO') 'Genauigkeit: '
   READ (*,*,IOSTAT=iostat) abbruch
   INCLUDE 'fehler.txt'
  END DO
  nullstelle = sekante (polynom, x0, abbruch)
  wert = funktionswert(polynom,nullstelle)
  IF (wert <= abbruch) THEN
   WRITE (*,*) "Nullstelle:", nullstelle, wert
  ELSE
   WRITE (*,*) "Fehler: Keine Nullstelle gefunden"
  ENDIF
 END DO
END PROGRAM
