Upload New File

Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/02_taschenrechner_mit_modulen.f95

+
+!!! Rechnungen von Übung 03
+module rechnen_einfach
+    implicit none
+    private ! funktion division kann nur im Modul aufgerufen werden
+    public :: calc
+
+ contains
+
+    subroutine calc(op)
+        character, intent(in) :: op 
+        integer :: a, b
+        integer :: res
+
+        WRITE(*,*) "Gebe zwei Zahlen ein!"
+        READ(*,*) a, b
+    
+        SELECT CASE (op)
+        CASE("+")
+            res = a + b
+        CASE("-")
+            res = a - b
+        CASE("*")
+            res = a * b
+        CASE("/")
+            res = division(a, b)
+        CASE DEFAULT
+            WRITE(*,*) "Der Eingegebene Operator ist ungueltig."
+        END SELECT    
+        
+        WRITE(*,*) "Das Ergebnis ist ", res
+    end subroutine calc
+
+    function division(a, b) result(res)
+        integer, intent(in) :: a
+        integer, intent(inout) :: b
+        integer :: res
+    
+        DO ! Hiermit wird Division durch 0 ausgeschlossen, ohne die Rechnung abzubrechen
+            IF (b == 0) THEN
+                WRITE(*,*) "Division durch 0 ist veboten! Gebe die zweite Zahl erneut ein."
+                READ(*,*) b
+            END IF
+        END DO
+            
+        res = a / b     
+    end function division
+    
+end module rechnen_einfach
+
+
+!!! Rechnungen von Übung 04
+module rechnen_flaeche
+    implicit none
+    private
+    public :: quader, circle
+    
+ contains
+
+    subroutine quader
+        INTEGER :: a, b, c, res
+
+        WRITE(*,*) "Gebe die Laenge, Hoehe und Breite eines Quaders an."
+        READ(*,*) a, b, c
+
+        ! Oberfläche
+        res = 2*a*b + 2*b*c + 2*c*a
+        WRITE(*,*) "Die Oberfaeche ist ", res
+
+        ! Volumen
+        res = a * b * c
+        WRITE(*,*) "Das Volumen ist ", res
+
+    end subroutine quader
+
+    subroutine circle
+        REAL :: r, res
+        REAL, PARAMETER :: pi = 3.141592
+    
+        WRITE(*,*) "Welchen Radius hat der Kreis?"
+        READ(*,*) r
+    
+        ! Kreisumfang
+        res = pi * r * 2
+        WRITE(*,*) "Der Umfang des Kreises ist ", res
+
+        ! Kreisvolumen
+        res = pi * r**2
+        WRITE(*,*) "Das Volumen des Kreises ist ", res
+    end subroutine circle
+end module rechnen_flaeche
+
+
+!!! Rechnungen aus Übung 05
+module rechnen_rekursiv
+    implicit none
+    private ! rekursive und iterative funktionen können nur im modul aufgerufen werden
+    public :: fakult, dreieckszahl, binominal ! nur diese subroutinen können im programm aufgerufen werden
+ contains
+
+   !!! Fakultät (rekursiv)
+    subroutine fakult 
+        integer :: n, res
+
+        write(*,*) "Fuer welche Zahl soll die Fakultaet berechnet werden?"
+        do
+            read(*,*) n
+            if (n >= 0) EXIT
+            write(*,*) "n muss >= 0 sein! Erneute Eingabe."
+        end do
+
+        res = fakultaet_iter(n)
+        write(*,*) "Die iterative Rechnung liefert", res
+        
+        res = fakultaet_reku(n)
+        write(*,*) "Die rekursive Rechnung liefert", res
+
+    end subroutine fakult
+
+    ! iterativ
+    function fakultaet_iter(n) result(res)
+        integer, intent(in) :: n
+        integer :: i
+        integer :: res
+
+        if (n == 0) then
+            res = 0
+        else
+            res = 1
+            do i = 1, n
+                res = res * i
+            end do
+        end if
+            
+    end function fakultaet_iter
+
+    ! rekursiv
+    recursive function fakultaet_reku(n) result(res)
+        integer, intent(in) :: n
+        integer :: res
+
+        if (n == 0 .OR. n == 1) then
+            res = 1
+        else
+            res = n * fakultaet_reku(n-1)
+        end if
+        
+    end function fakultaet_reku
+
+
+
+   !!! n-te Dreieckszahl
+    subroutine dreieckszahl
+        integer :: n, res
+
+        write(*,*) "Fuer welche Zahl soll die Dreieckszahl berechnet werden?"
+        do
+            read(*,*) n
+            if (n >= 1) EXIT
+            write(*,*) "n muss >= 1 sein! Erneute Eingabe."
+        end do
+
+        res = dreieckszahl_iter(n)
+        write(*,*) "Die iterative Funktion liefert: ", res
+
+        res = dreieckszahl_recu(n)
+        write(*,*) "Die rekursive Funktion liefert: ", res
+    
+    end subroutine dreieckszahl
+
+    ! iterativ
+    function dreieckszahl_iter(n) result(res)
+        integer, intent(in) :: n
+        integer :: i
+        integer :: res
+
+        res = 0 ! wert der returnvariable kann nicht in variabelendeklaration definiert werden
+        do i = 1, n
+            res = res + i
+        end do
+        
+    end function dreieckszahl_iter
+
+    ! rekursiv
+    recursive function dreieckszahl_recu(n) result(res)
+        integer, intent(in) :: n
+        integer :: res
+    
+        if (n == 1) then
+            res = 1
+        else 
+            res = n + dreieckszahl_recu(n-1)
+        end if
+
+    end function dreieckszahl_recu
+
+
+
+   !!! Binominalkoeffizient
+    subroutine binominal
+        integer :: n, k
+        integer :: res
+
+        write(*,*) "Fuer welche Zahlen (n, k) soll die Fakultaet berechnet werden?"
+        do
+            read(*,*) n, k
+            if (n >= k .AND. k >= 0) EXIT
+            write(*,*) "Es muss n >= k >= 0 gelten! Erneute Eingabe."
+        end do
+    
+        res = binom_iter(n, k)
+        write(*,*) "Die iterative Funktion liefert: ", res
+
+        res = binom_recu(n, k)
+        write(*,*) "Die rekursive Funktion liefert: ", res
+        
+    end subroutine binominal
+
+    ! iterativ
+    function binom_iter(n, k) result(res)
+        ! direkte berechnung nach definition
+        integer, intent(in) :: n, k
+        integer :: res
+    
+        if (n > k) then
+            res = fakultaet_iter(n) / ( fakultaet_iter(k) * fakultaet_iter(n-k) )
+        else ! n == k
+            res = 1
+        end if
+    end function binom_iter
+
+    ! rekursiv
+    recursive function binom_recu(n, k) result(res)
+        integer, intent(in) :: n, k
+        integer :: res
+    
+        if (k > n) then 
+            res = 0
+        else if (n == k .OR. k == 0) then 
+            res = 1
+        else 
+            res = binom_recu(n-1, k-1) + binom_recu(n-1, k) 
+        end if
+
+    end function binom_recu
+end module rechnen_rekursiv
+
+
+
+
+program taschenrechner
+    ! rufe Module im Programm auf
+    use rechnen_einfach
+    use rechnen_flaeche
+    use rechnen_rekursiv
+
+    implicit none
+    
+    CHARACTER :: op ! Operator
+    CHARACTER :: end 
+
+    DO 
+
+        WRITE(*,*) "Gebe einen Rechenoperator (+,-,*,/) ein!"
+        WRITE(*,*) "Fuer die Berechnung einer Kreisflaeche schreibe A"
+        WRITE(*,*) "Fuer Quader Ober- und Unterflaeche Q"
+        WRITE(*,*) "Fuer die Fakultaet f, Dreieckszahl d, Binominalkoeffizient b"
+
+        READ(*,*) op
+        WRITE(*,*) !n Leerzeile im Terminal
+
+        IF (op == "+" .OR. op == "-" .OR. op == "*" .OR. op == "/") THEN
+            CALL calc(op)
+        ELSEIF (op == "A") THEN
+            CALL circle
+        ELSEIF (op == "Q") THEN
+            CALL quader
+        ELSEIF (op == "f") THEN
+            CALL fakult
+        ELSEIF (op == "d") THEN
+            CALL dreieckszahl
+        ELSEIF (op == "b") THEN
+            CALL binominal
+        ELSE
+            WRITE(*,*) "Der eingegebene Operator ist ungueltig!"
+        END IF
+
+
+        ! Austrittsbedingung
+        WRITE(*,*) "Soll eine weitere Rechnung statt finden? (j/n)"
+        READ(*,*) end
+        IF(end == "n") EXIT
+
+        WRITE(*,*) !n Leerzeile im Terminal
+
+    END DO
+
+end program taschenrechner
\ No newline at end of file