diff --git a/Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/03_taschenrechner_mit_funktionen.f95 b/Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/03_taschenrechner_mit_funktionen.f95 new file mode 100644 index 0000000000000000000000000000000000000000..2a39df18080a264b65cfd6da82ebe30450cbbd1b --- /dev/null +++ b/Sonderuebung/WiSe24-25/SU05_20204_11_19_Unterprogramme/03_taschenrechner_mit_funktionen.f95 @@ -0,0 +1,165 @@ +! TODO : +! + füge INTENT-Parameter ein + + +program taschenrechner + implicit none + + CHARACTER :: op ! Operator + CHARACTER :: end + integer :: n + + DO + + WRITE(*,*) "Gebe einen Rechenoperator (+,-,*,/) ein!" + WRITE(*,*) "Fuer die Berechnung einer Kreisflaeche schreibe A" + WRITE(*,*) "Fuer Quader Ober- und Unterflaeche Q" + + READ(*,*) op + + 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 == "d") then + write(*,*) "gebe n ein!" + read(*,*) n + write(*,*) dreieckszahl(n) + ELSE + WRITE(*,*) "Operatorfehler" + END IF + + + + ! Austrittsbedingung + WRITE(*,*) "Soll eine weitere Rechnung statt finden? (j/n)" + READ(*,*) end + IF(end == "n") EXIT + + END DO + + + CONTAINS + + !!! Rechnungen des alten Taschenrechners + 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 + + + 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 + + + + !!! neue Rechnungen + function fakultaet(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 + + + function dreieckszahl(n) result(res) + integer :: 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 + + + function binominal(n, k) result(res) + ! direkte berechnung nach definition + integer, intent(in) :: n, k + integer :: res + + if (n > k) then + res = fakultaet(n) / ( fakultaet(k) * fakultaet(n-k) ) + else ! n == k + res = 1 + end if + end function binominal + +end program taschenrechner \ No newline at end of file