!  *******************  Genauigkeitsparameter  ************************
MODULE param
!beinhaltet den Genauigkeitsparameter
DOUBLE PRECISION, PARAMETER :: eps=1.D-4
END MODULE

MODULE functions    !beinhaltet Testfunktionen und deren Ableitungen
CONTAINS
  FUNCTION f1(x) 
      DOUBLE PRECISION :: f1,x
      f1=x**3-5.D0*x**2+100.D0*x-400.D0
  END FUNCTION f1
  FUNCTION f2(x)
      DOUBLE PRECISION :: f2,x
      f2=EXP(-x)-0.1D0/(1.D0+x)
  END FUNCTION f2
  FUNCTION df1(x)
      DOUBLE PRECISION :: df1,x
      df1=3*x**2-10.D0*x+100.D0
  END FUNCTION df1
  FUNCTION df2(x)
      DOUBLE PRECISION :: df2,x
      df2=-EXP(-x)-0.1D0*LOG(1.D0+x)
  END FUNCTION df2
    !umgewandelte Funktionen fuer das Fixpunktverfahren
FUNCTION gf1(x)
	DOUBLE PRECISION:: gf1,x
    gf1=4.D0+0.05D0*x**2-0.01D0*x**3
END FUNCTION
FUNCTION gf2(x)
	DOUBLE PRECISION gf2,x
    gf2=0.1D0*EXP(x)-1.D0
  END FUNCTION
END MODULE


! ***********************  METHODEN ZUR NULLSTELLENSUCHE  **********************

MODULE methods !beinhaltet die verschiedenen Methoden
CONTAINS



! *************************   BISEKTION   **************************************
! *    a,b ... Intervallgrenzen                                                *
! *    x ... Nullstelle                                                        *
! *    f ... Testfunktion                                                      *
! *    steps ... Anzahl der Schritte bis zur vorgegebenen Genauigkeit          *
! *    ausgabe ... Dateiname des Ausgabefiles                                  *
! ******************************************************************************

SUBROUTINE bisec(a,b,x,f,steps,ausgabe) 
    !macht Inhalte der Module param und functions in der subroutine verfuegbar:
  USE param
  USE functions
  
    !Dummy-Funktionen und -Argumente: 
  INTERFACE
       FUNCTION f(t)
          DOUBLE PRECISION :: f,t
       END FUNCTION
  END INTERFACE
      
  DOUBLE PRECISION :: a, b, x
  INTEGER :: steps, sgnfa, sgnfx   !Anzahl Schritte, Vorzeichen f(a), Vorzeichen f(x)
  CHARACTER(16) :: ausgabe          !definiert ein im Hauptprogramm spezifiziertes Ausgabefile
  
  OPEN (100,FILE=ausgabe, STATUS='UNKNOWN')
  steps=0
  
  WRITE(100,'(A21,F6.3,A5,F6.3)' ) "Intervallgrenzen: a= ", a, ", b= ", b
  WRITE(100,'(A30)') "---------------------------------------------------------------------------------------------------"
  WRITE(100, '(A5,A20,A25)') "steps", "x", "f(x)"    !Bezeichnung der Spalten

    x=(a+b)/2.D0                   !Initialisierung von x wegen Berechnung der logischen Abfrage unten
  
    !Schleife zur iterativen Berechnung der Nullstelle: 
  DO WHILE (ABS(f(x)).GT.eps)      !solange bis der Funktionswert an der Stelle 
                                   !der berechneten Nullstelle kleiner als die vorgebenene Genauigkeit ist
     
	 x=(a+b)/2.D0                  !BISEKTIONSALGORITHMUS
     
     WRITE(100, '(I5,F20.16,E25.16E2)') steps, x, f(x)   !Ausgabe in Datei
     WRITE(*, *) steps, x, f(x)                          !Ausgabe auf Bildschirm

   
     !ueberpruefen, auf welcher Seite die Nullstelle liegt, mangels SGN-Funktion etwas umstaendlich:
    IF (f(a).LT.0.D0) THEN        !falls Funktionswert von a kleiner als 0
      sgnfa=-1                    !Vorzeichenvariable von a wird -1 gesetzt
      ELSE
      sgnfa=1                     !ansonsten +1
    END IF
    
    IF (f(x).LT.0.D0) THEN        !dasselbe fuer x
      sgnfx=-1
      ELSE
      sgnfx=1
    END IF
        
    IF (sgnfa==sgnfx) THEN       !Vergleich der beiden Vorzeichenvariablen
        a=x                      !wenn gleich => linke Intervallgrenze wird durch x ersetzt
      ELSE
        b=x                      !wenn ungleich => rechte Intervallgrenze durch x ersetzen
    END IF
       
    steps=steps+1
  
  END DO
  
  CLOSE(100)
END SUBROUTINE bisec




! ***************************  NEWTONVERFAHREN  *********************************
! *      xstart ... Anfangswert                                                 *
! *      steps ... Anzahl der zur Berechnung erforderlichen Schritte            *
! *      f ... Testfunktion                                                     *
! *      df ... Ableitung der Testfunktion                                      *
! *      ausgabe ... Dateiname des Ausgabefiles                                 *
! *******************************************************************************

SUBROUTINE newton(xstart,steps,f,df,ausgabe)  
    !macht Genauigkeitsparameter und Testfunktionen in der subroutine verfuegbar:
  USE param
  USE functions
  
  DOUBLE PRECISION :: newton_zero,xstart,alt
  INTEGER :: steps
  CHARACTER(16) :: ausgabe
  
    ! Dummy-Funktionen und -Argumente:
  INTERFACE
     FUNCTION f(t)
         DOUBLE PRECISION :: f,t
     ENDFUNCTION
     FUNCTION df(y)
         DOUBLE PRECISION :: df, y
     ENDFUNCTION
  END INTERFACE
         
  steps=0        
  
  OPEN (100,FILE=ausgabe, STATUS='UNKNOWN')
  WRITE(100,'(A12,F6.3)') "Startwert= ", xstart
  WRITE(100,'(A30)') "----------------------------------------------------------------------------------------------------"
  WRITE(100, '(A5,A20,A25)') "steps", "x", "f(x)"    !Bezeichnung der Spalten
  
    !initialisiert Variable alt fuer logische Abfrage beim ersten Schleifendurchlauf:
  alt=xstart+1
  
  DO WHILE (ABS(xstart-alt).GT.eps)          ! solange der Betrag zwischen zwei aufeinanderfolgend 
                                             !berechneten Nullstellen groeßer als die Genauigkeit ist
    alt=xstart  !bei jedem Durchgang wird der Variable "alt" der Wert der zuvor berechneten Nullstelle zugewiesen
    
    newton_zero=xstart-f(xstart)/df(xstart)  !NEWTON-ALGORITHMUS
  
    WRITE(*,*) steps, xstart, f(xstart)                           !Ausgabe auf Bildschirm
    WRITE(100, '(I5,F20.16,E25.16E2)') steps, xstart, f(xstart)   !Ausgabe in Datei 
    
      ! bei jedem Durchgang wird der Startwert mit dem soeben errechneten Wert ueberschrieben
    xstart=newton_zero
    steps=steps+1
  ENDDO
  
  CLOSE(100)
END SUBROUTINE newton

! ******************************  REGULA FALSI  ****************************************
! *     a,b ... Intervallgrenzen um die Nullstelle                                     *
! *     x ... Nullstelle                                                               *
! *     f ... Testfunktion                                                             *
! *     steps ... Anzahl der benoetigten Iterationen                                   *
! *     ausgabe ... Dateiname des Ausgabefiles                                         *
! **************************************************************************************
 

SUBROUTINE regf(a,b,x,f,steps,ausgabe) 
    !macht Parameter und Testfunktionen verfuegbar:
  USE param
  USE functions
  
    !Dummy-Funktionen und -Argumente: 
  INTERFACE
      FUNCTION f(t)
          DOUBLE PRECISION :: f,t
      END FUNCTION
  END INTERFACE
      
  DOUBLE PRECISION :: a, b, x
  INTEGER :: steps, sgnfa, sgnfx     !Anzahl der Schritte, Vorzeichen f(a), Vorzeichen f(x)
  
  CHARACTER(16) :: ausgabe            !definiert ein im Hauptprogramm spezifiziertes Ausgabefile
  
  OPEN (100,FILE=ausgabe, STATUS='UNKNOWN')
  steps=0
  
  WRITE(100,'(A21,F6.3,A5,F6.3)' ) "Intervallgrenzen: a= ", a, ", b= ", b
  WRITE(100,'(A30)') "----------------------------------------------------------------------------------------------------"
  WRITE(100, '(A5,A20,A25)') "steps", "x", "f(x)"    !Bezeichnung der Spalten
  
  x=a-f(a)*(a-b)/(f(a)-f(b)) !muss initialisiert werden wegen logischer Abfrage unten
  
    ! Schleife zur iterativen Berechnung der Nullstelle 
  DO WHILE (ABS(f(x)).GT.eps)       !solange bis der Funktionswert an der Stelle 
                                    !der berechneten Nullstelle kleiner als die vorgebenene Genauigkeit ist
     x=a-f(a)*(a-b)/(f(a)-f(b))     !REGULA FALSI ALGORITHMUS
      
     WRITE(100, '(I5,F20.16,E25.16E2)') steps, x, f(x)  !Ausgabe in Datei       
     WRITE(*, *) steps, x, f(x)                         !Ausgabe auf Bildschirm
   
      !erzeugen einer Vorzeichen-Variable (mangels intrinsischer SGN-Funktion):
    IF (f(a).LT.0.D0) THEN         !falls Funktionswert von a kleiner als 0
      	sgnfa=-1                   !=> Vorzeichenvariable von a wird -1 gesetzt
      ELSE
      	sgnfa=1                    !ansonsten +1
    END IF
    
    IF (f(x).LT.0.D0) THEN         !dasselbe fuer x
      	sgnfx=-1
      ELSE
      	sgnfx=1
    END IF
    
      !ueberpruefen, auf welcher Seite der Nullstelle x liegt:  
    IF (sgnfa==sgnfx) THEN         !Vergleich der beiden Vorzeichenvariablen
        a=x                        !wenn gleich => linke Intervallgrenze wird durch x ersetzt
      ELSE
        b=x                        !wenn ungleich => rechte Intervallgrenze durch x ersetzen
    END IF
       
    steps=steps+1
  
  END DO
  
  CLOSE(100)
END SUBROUTINE regf


! *************************   FIXPUNKTVERFAHREN  **************************************
! *     xstart ... Anfangswert                                                        *
! *     f ... Testfunktion (in umgewandelter Form)                                    *
! *     steps ... Anzahl der zur Berechnung benoetigten Schritte                      *
! *     ausgabe ... Name der Ausgabedatei                                             *
! *************************************************************************************

SUBROUTINE fix(xstart,f,steps,ausgabe) 

    !macht Genauigkeitsparameter und Testfunktionen in der Subroutine verfuegbar:
  USE param
  USE functions
  USE hilfs
    
    ! Dummy-Funktionen und -Argumente:
  INTERFACE
    	FUNCTION f(x); DOUBLE PRECISION f,x; END FUNCTION
    END INTERFACE
    
  DOUBLE PRECISION :: xstart,x
  INTEGER :: steps
  Character(16) :: ausgabe
  steps=0

  OPEN (100,FILE=ausgabe, STATUS='UNKNOWN')
  WRITE(100,'(A12,F6.3)') "Startwert= ", xstart
  WRITE(100,'(A30)') "---------------------------------------------------------------------------------------------------"
  WRITE(100, '(A5,A20,A25)') "steps", "x", "f(x)"    !Bezeichnung der Spalten

  DO WHILE (ABS(f(xstart)-xstart).GT.eps)    !solange die absolute Differenz zwischen zwei 
                                             !Berechnungen groeßer als der Genauigkeitsparameter ist
        x=f(xstart)                          !FIXPUNKTALGORITHMUS
      WRITE(100, '(I5,F20.16,E25.16E2)') steps, xstart, x    !Ausgabe in Datei
      WRITE(*, *) steps, xstart, x                           !Ausgabe auf Bildschirm
  
        !Startwert wird mit soeben errechnetem Wert ueberschrieben:
      xstart=x
      
      steps=steps+1
  END DO
  
  CLOSE(100)
  
END SUBROUTINE fix
END MODULE

! ************************** HAUPTPROGRAMM ************************************

  
PROGRAM findroot
    !macht Testfunktionen und Methoden im Hauptprogramm verfuegbar:
  USE functions
  USE methods
  
  IMPLICIT NONE
  DOUBLE PRECISION :: a,b,start,xb    !Anfangswerte fuer Berechnungen, Nullstellenausgabe
  INTEGER :: nb, nn, nf               !Anzahl der Schritte      
  CHARACTER(1) :: auswahl, rpt, fkt_s !Abfragevariablen
  CHARACTER(3) :: a_s, b_s, x_s       !Anfangswertstrings fuer Dateiname
  CHARACTER(16) :: file                !Dateiname des Ausgabefiles, aus Methode und gewaehlter Funktion
      
  111 WRITE(*,*) "Bitte waehlen Sie die Funktion:"
  WRITE(*,*) "1 ... f(x) = x^3 - 5x^2 + 100x - 400"
  WRITE(*,*) "2 ... f(x) = exp(-x) - 0.1/(1+x)"
  READ(*,'(A1)') fkt_s
  
    !Abfrage ob Funktion korrekt eingegeben wurde:
  IF (fkt_s/="1".AND.fkt_s/="2") THEN
      WRITE(*,*) "Sie haben keine gueltige Funktion eingegeben. Bitte versuchen Sie es erneut."
      GOTO 111
  END IF
  
    !Auswahl des Verfahrens
  WRITE(*,*) "Bitte waehlen Sie das gewuenschte Verfahren aus:"
  WRITE(*,*) " b ... Bisektionsverfahren"
  WRITE(*,*) " n ... Newtonverfahren"
  WRITE(*,*) " f ... Fixpunktverfahren"
  WRITE(*,*) " r ... Regula Falsi"
  READ(*,*) auswahl
  

  !*************************************************************************
  !*                AUSWAHL: FUNKTION 1                                 *
  !*************************************************************************
  
  SELECT CASE(fkt_s)
    CASE("1")
    
               !************************************************************
               !*               AUSWAHL DES VERFAHRENS                     *
               !************************************************************
  
               SELECT CASE (auswahl) 
                   
               ! ********************** BISEKTION **************************
               CASE("b")
                   WRITE(*,*) "gewaehlt: Bisektionsverfahren, Funktion ", fkt_s
                   
                     !manuelle Eingabe der Intervallgrenzen fuer Bisektionsverfahren:
                   WRITE(*,*) "Bitte Intervallgrenzen eingeben:"
                   WRITE(*,*) "a = ?"
                   READ(*,*) a
                     !auslesen des Anfangswerts in einen String
                   WRITE(a_s,'(F3.1)') a
                   WRITE(*,*) "b = ?"
                   READ(*,*) b
                     !auslesen des Anfangswerts in einen String
                   WRITE(b_s,'(F3.1)') b
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//a_s//"_"//b_s//".dat"
                 
                     !Aufruf Bisektionsverfahren mit f1: 
                   CALL bisec(a,b,xb,f1,nb,file)
                   WRITE(*,*) nb, xb
               
               !********************** NEWTON *******************************
               CASE("n")
                   WRITE(*,*) "gewaehlt: Newtonverfahren, Funktion ", fkt_s
                   
                     !manuelle Eingabe von Startwert fuer Newtonverfahren:
                   WRITE(*,*)"Bitte Startwert eingeben"
                   READ(*,*) start
                     !auslesen des Anfangswerts in einen String
                   WRITE(x_s,'(F3.1)') start
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//x_s//"____"//".dat"
                   
                     !Aufruf Newton-Verfahren mit f1:
                   CALL newton(start,nn,f1,df1,file)
                   WRITE(*,*) nn, start
                   
               !******************* FIXPUNKT *********************************
               CASE("f")
                   WRITE(*,*) "gewaehlt: Fixpunktverfahren, Funktion ", fkt_s
             
                     !manuelle Eingabe von Startwert fuer Fixpunktverfahren: 
                   WRITE(*,*)"Bitte Startwert eingeben"
                   READ(*,*) start
                     !auslesen des Anfangswerts in einen String
                   WRITE(x_s,'(F3.1)') start
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//x_s//"____"//".dat"
                   
                     !Aufruf Fixpunktverfahren mit f1:
                   CALL fix(start,gf1,nf,file)
                   WRITE(*,*) nf, start
                   
              !****************** REGULA FALSI *******************************
              CASE("r")
                   WRITE(*,*) "gewaehlt: Regula Falsi, Funktion ", fkt_s
                   
                     !manuelle Eingabe der Intervallgrenzen fuer Regula Falsi:
                   WRITE(*,*) "Bitte Intervallgrenzen eingeben:"
                   WRITE(*,*) "a = ?"
                   READ(*,*) a
                     !auslesen des Anfangswerts in einen String
                   WRITE(a_s,'(F3.1)') a
                   WRITE(*,*) "b = ?"
                   READ(*,*) b
                     !auslesen des Anfangswerts in einen String
                   WRITE(b_s,'(F3.1)') b
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//a_s//"_"//b_s//".dat"
                 
                     !Aufruf Regula Falsi mit f1: 
                   CALL bisec(a,b,xb,f1,nb,file)
                   WRITE(*,*) nb, xb
             
              CASE DEFAULT
                 WRITE(*,*) "Sie haben keine gueltige Methode ausgewaehlt. Bitte versuchen Sie es erneut."
                 GOTO 111
                 
              END SELECT      
  
    !*************************************************************************
    !*                AUSWAHL: FUNKTION 2                                 *
    !*************************************************************************
    CASE("2")
  

               !************************************************************
               !*               AUSWAHL DES VERFAHRENS                     *
               !************************************************************
  
               SELECT CASE (auswahl) 
                   
               ! ********************** BISEKTION **************************
               CASE("b")
                   WRITE(*,*) "gewaehlt: Bisektionsverfahren, Funktion ", fkt_s
                   
                     !manuelle Eingabe der Intervallgrenzen fuer Bisektionsverfahren:
                   WRITE(*,*) "Bitte Intervallgrenzen eingeben:"
                   WRITE(*,*) "a = ?"
                   READ(*,*) a
                     !auslesen des Anfangswerts in einen String
                   WRITE(a_s,'(F3.1)') a
                   WRITE(*,*) "b = ?"
                   READ(*,*) b
                     !auslesen des Anfangswerts in einen String
                   WRITE(b_s,'(F3.1)') b
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//a_s//"_"//b_s//".dat"
                 
                     !Aufruf Bisektionsverfahren mit f2: 
                   CALL bisec(a,b,xb,f2,nb,file)
                   WRITE(*,*) nb, xb
               
               !********************** NEWTON *******************************
               CASE("n")
                   WRITE(*,*) "gewaehlt: Newtonverfahren, Funktion ", fkt_s
                   
                     !manuelle Eingabe von Startwert fuer Newtonverfahren:
                   WRITE(*,*)"Bitte Startwert eingeben"
                   READ(*,*) start
                     !auslesen des Anfangswerts in einen String
                   WRITE(x_s,'(F3.1)') start
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//x_s//"____"//".dat"
                   
                     !Aufruf Newton-Verfahren mit f2:
                   CALL newton(start,nn,f2,df2,file)
                   WRITE(*,*) nn, start
                   
               !******************* FIXPUNKT *********************************
               CASE("f")
                   WRITE(*,*) "gewaehlt: Fixpunktverfahren, Funktion ", fkt_s
             
                     !manuelle Eingabe von Startwert fuer Fixpunktverfahren: 
                   WRITE(*,*)"Bitte Startwert eingeben"
                   READ(*,*) start
                     !auslesen des Anfangswerts in einen String
                   WRITE(x_s,'(F3.1)') start
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//x_s//"____"//".dat"
                   
                     !Aufruf Fixpunktverfahren mit f2:
                   CALL fix(start,gf2,nf,file)
                   WRITE(*,*) nf, start
                   
              !****************** REGULA FALSI *******************************
              CASE("r")
                   WRITE(*,*) "gewaehlt: Regula Falsi, Funktion ", fkt_s
                   
                     !manuelle Eingabe der Intervallgrenzen fuer Regula Falsi:
                   WRITE(*,*) "Bitte Intervallgrenzen eingeben:"
                   WRITE(*,*) "a = ?"
                   READ(*,*) a
                     !auslesen des Anfangswerts in einen String
                   WRITE(a_s,'(F3.1)') a
                   WRITE(*,*) "b = ?"
                   READ(*,*) b
                     !auslesen des Anfangswerts in einen String
                   WRITE(b_s,'(F3.1)') b
  					 !erzeugt den Dateinamen aus gewaehlter Methode, Funktion und Anfangswert(en)
				   file="f"//fkt_s//"_"//auswahl//"_"//a_s//"_"//b_s//".dat"
                 
                     !Aufruf Regula Falsi mit f2: 
                   CALL bisec(a,b,xb,f2,nb,file)
                   WRITE(*,*) nb, xb
             
              CASE DEFAULT
                 WRITE(*,*) "Sie haben keine gueltige Methode ausgewaehlt. Bitte versuchen Sie es erneut."
                 GOTO 111
                 
              END SELECT    
  END SELECT
  
    
    !Abfrage zur Wiederholung des Programms  
  WRITE(*,*) "Wollen Sie das Programm noch einmal starten? (Y/N)"
  READ(*,*) rpt
  IF (rpt=="Y".OR.rpt=="y") THEN
    GOTO 111
  END IF
      
END PROGRAM