Upload New File

Sonderuebung/WiSe23-24/SU04_2023_11_15/03_taschenrechner_mit_funktionen.f95

+program taschenrechner
+    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"
+
+        DO ! Eingabe wird wiederholt, wenn der Operaor ungültig ist
+            READ(*,*) op
+            IF (op == "+" .OR. op == "-" .OR. op == "*" .OR. op == "/" .OR. op == "A" .OR. op == "Q") EXIT
+            WRITE(*,*) "Die Eingabe ist ungueltig. Gebe einen neuen Operator ein."
+        END DO
+
+
+        IF (op == "+" .OR. op == "-" .OR. op == "*" .OR. op == "/") THEN
+            CALL calc(op)
+        ELSEIF (op == "A") THEN
+            CALL circle
+        ELSEIF (op == "Q") THEN
+            CALL quader
+        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 :: 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 :: a, 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
+
+
+
+ !!! Neue Rechnungen
+    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 program taschenrechner
\ No newline at end of file