From 46c6f22d794d3df2d1d1316c3d08f0f7e0b8bf0d Mon Sep 17 00:00:00 2001
From: dali662d <dana.liebscher@mailbox.tu-dresden.de>
Date: Tue, 19 Nov 2024 14:03:16 +0000
Subject: [PATCH] Upload New File
---
.../02_taschenrechner_mit_modulen.f95 | 298 ++++++++++++++++++
1 file changed, 298 insertions(+)
create mode 100644 Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/02_taschenrechner_mit_modulen.f95
diff --git a/Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/02_taschenrechner_mit_modulen.f95 b/Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/02_taschenrechner_mit_modulen.f95
new file mode 100644
index 0000000..5723909
--- /dev/null
+++ b/Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/02_taschenrechner_mit_modulen.f95
@@ -0,0 +1,298 @@
+
+!!! 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
--
GitLab