diff --git a/.gitignore b/.gitignore index c0dd0f0ee4e8dbf63986e2c89ce938924ecbe821..eb85a939600855083764a1e6b46d71fcc655ed21 100644 --- a/.gitignore +++ b/.gitignore @@ -4,6 +4,9 @@ # Unignore all with extensions !*.* +# Uningnore directories +!*/ + # Unignore Makefiles !Makefile !makefile diff --git a/einfuehrungen/einfuehrung_allg.txt b/einfuehrungen/einfuehrung_allg.txt new file mode 100644 index 0000000000000000000000000000000000000000..2abd331dba375038df67642bd6e3b4e9fae32bb3 --- /dev/null +++ b/einfuehrungen/einfuehrung_allg.txt @@ -0,0 +1,64 @@ +Terminal öffnen (Strg + Alt + T) +Wir befinden uns in ~ = /home/s123456/ = Persöhnlicher Ordner + +ls +ls -a + +. = aktueller Ordner +.. = übergeordneter Ordner + +cd Dokumente +ls + +Um Ordnung zu halten, legen wir einen Ordner für die Übung an + +mkdir uebung1 +cd uebung1 + +gedit rundung.f95 + +Jetzt ist das Terminal blockiert. Schließe gedit: + +Strg + C (beendet aktuell laufendes Programm) + +Alternative: + +gedit rundung.f95 & + +in gedit: + +PROGRAM rundung + IMPLICIT NONE + +END PROGRAM rundung + +Speichern (Strg + S) + +im Terminal: + +ls + +in gedit ergänze: + + WRITE(*,*) 'Hallo Welt' + +Speichern (Strg + S) + +Unser 1. Programm ist fertig. Compile it! + +im Terminal (! bietet Autovervollständigung von Befehlen und Dateien mit Tab): + +f95 -o rundung rundung.f95 +ls + +Wir sehen, dass eine neue (ausführbare) Datei erstellt wurde. Führe sie aus: + +./rundung + + +noch nett zu wissen: in gedit kann man die Einrückungsweite von Tabs einstellen + +Diese Anleitung und alle weiteren werden auf +stura.link/progmaterial +hochgeladen. Das ist ein Link zu +https://gitlab.math.tu-dresden.de/wwalter/PROG-material-public diff --git a/einfuehrungen/einfuehrung_mod.txt b/einfuehrungen/einfuehrung_mod.txt new file mode 100644 index 0000000000000000000000000000000000000000..9d0ae843819249aacda66faf2d3a4ad737525f5b --- /dev/null +++ b/einfuehrungen/einfuehrung_mod.txt @@ -0,0 +1,142 @@ +„in Blatt 5 werden Module um weitere Features ergänzt + +Typen: wir wissen: Variablen haben Typen, z.B. INTEGER, REAL, CHARACTER, LOGICAL +neu: wir können eigene Typen deklarieren. Variablen von selbstdefinierten Typen +bestehen aus mehreren Werten, z.B.“ + +MODULE quaternionen + + IMPLICIT NONE + + TYPE quat ! Quaternionen, sowas aehnliches wie komplexe Zahlen mit 4 Dimensionen + REAL :: reell, imag, jmag, kmag + END TYPE + +CONTAINS + +END MODULE + +„um eine Variable von diesem Typ zu deklarieren, nutze TYPE(quaternionen), +z.B. für Modulvariablen +Um ein Objekt von diesem Typ zu erstellen, nutze den Konstruktor mit dem Namen +des Typs und als Argumente die Werte der Bestandteile“ + +MODULE quaternionen + + ... + + TYPE (quat), PARAMETER :: eins = quat(1, 0, 0, 0) + TYPE (quat), PARAMETER :: i = quat(0, 1, 0, 0) + TYPE (quat), PARAMETER :: j = quat(0, 0, 1, 0) + TYPE (quat), PARAMETER :: k = quat(0, 0, 0, 1) + +CONTAINS + +END MODULE + +„Quaternionen sind ein Körper, die man addieren und multiplizieren können möchte + +Um auf Bestandteile von selbstdefinierten Typen zurückzugreifen, nutze %“ + +MODULE quaternionen + ... + +CONTAINS + + FUNCTION add(a, b) + TYPE(quaternionen), INTENT(IN) :: a, b + TYPE(quaternionen) :: add + add%reell = a%reell + b%reell + add%imag = a%imag + b%imag + add%jmag = a%jmag + b%jmag + add%kmag = a%kmag + b%kmag + END FUNCTION + +END MODULE + +„Interfaces +Im Hauptprogramm kann man nun schreiben: q = ADD(eins, i) und erhält (1.0, 1.0, 0.0, 0.0) +aber man möchte eher q = eins + i schreiben. +Dafür kann man ein INTERFACE nutzen, eine Art "zweiter Name", ein Alias:“ + +MODULE quaternionen +... + INTERFACE OPERATOR (+) + MODULE PROCEDURE add + END INTERFACE + +CONTAINS + + FUNCTION add(a, b) + ... + +END MODULE + +„Interfaces können auch aliase für mehrere Funktionen sein, solange deren +Argumenttypen sich unterscheiden. +Z.B. sollte Skalarmultiplikation (also REAL * quat) und Multiplikation von Quaternionen +Dann wird immer die passende Funktion ausgewählt“ + +MODULE quaternionen +... + INTERFACE OPERATOR (*) + MODULE PROCEDURE mul, realmul, intmul + END INTERFACE +... +CONTAINS + FUNCTION mul(a, b) +... ! komplette Variante in quaternionen.f95 zu finden + FUNCTION realmul(skalar, a) +... + FUNCTION intmul(skalar, a) +... +END MODULE + +„wir haben schon Modulvariablen (in diesem Fall Konstanten) gesehen. +Eine häufige sinnvolle Anwendung sind die kind-Konstanten. Diese können +dann einheitlich im ganzen Modul UND im Hauptprogramm nutzen. +Damit umgeht man Probleme mit nicht zusammen passenden Typen.“ + +MODULE quaternionen + IMPLICIT NONE +... + INTEGER, PARAMETER :: pr = SELECTED_REAL_KIND(P = 15, R=307) + INTEGER, PARAMETER :: intsize = SELECTED_INT_KIND(20) + + TYPE quat + REAL (kind = pr) :: reell, imag, jmag, kmag + END TYPE +... +END MODULE + +„Standardmäßig kann ein Nutzer eines Moduls alles aus einem genutzten Modul sehen, d.h. nutzen. +Das ist häufig unangebracht, z.B. sollte ein Benutzer nicht zwischen den verschiedenen Multiplikationen +für Quaternionen unterscheiden können. Unterprogramme, die man zur besseren Strukturierung +komplexer Funktionen schreibt, sollten nicht von außen direkt benutzt werden können, etc. +Deshalb kann (und sollte) man Bestandteile von Modulen standardmäßig "private" (außerhalb des Moduls +unsichtbar) setzen und alles, was außerhalb genutzt werden soll, explizit "public" setzen:“ + +MODULE quaternionen + IMPLICIT NONE + PRIVATE + PUBLIC :: pr, intsize, quat, OPERATOR (+), OPERATOR (*), eins, i, j, k + +... +END MODULE + +„Jetzt kann man bei einem Quaternion immer noch alle Einträge "per Hand" mit q%reell lesen und +schreiben. Das ist bei vielen selbstdefinierten Typen +schlecht, da oft viele Variablenbelegungen ungültig sind (welche wären das bei Intervallen und Trilog) +und der Benutzer eines Moduls nicht +wissen müssen sollte, wie etwas intern implementiert ist (Quaternionen können über eine Polardarstellung +gespeichert werden, für den Benutzer wäre das egal.) Daher sollten in den meisten Fällen die +Bestandteile von selbstdefinierten Typen privat sein:“ + +MODULE quaternionen +... + TYPE quat + PRIVATE + REAL (kind = pr) :: reell, imag, jmag, kmag + END TYPE +... +END MODULE diff --git a/einfuehrungen/einfuehrung_sub_fun.txt b/einfuehrungen/einfuehrung_sub_fun.txt new file mode 100644 index 0000000000000000000000000000000000000000..dc23974bbc76dcabad28ac0222add7875246d9d5 --- /dev/null +++ b/einfuehrungen/einfuehrung_sub_fun.txt @@ -0,0 +1,144 @@ +„in Blatt 4 werden Module, Funktionen und Subroutinen genutzt +Subroutinen: Programmteile, die man wiederverwenden kann + Vorteil: Sachen nicht mehrmals schreiben (Code-Dopplung vermeiden!) + mehr Übersicht, wenn man ignoriert, wie das im Detail passiert und das Hauptprogramm übersichtlich wird +Syntax:“ + +PROGRAM testprog + ! Hauptprogramm + +CONTAINS + + SUBROUTINE ausgabe(myname) + CHARACTER(len = 5), INTENT(IN) :: myname ! INTENT(IN): ist input, kann nicht verändert werden + + WRITE(*,*) "Hallo, mein Name ist ", myname, ". Bitte sprich mit mir." + READ(*,*) ! unnuetze Eingabe + END SUBROUTINE + +END PROGRAM + +„Dann im HP aufrufen:“ +ergänze im obigen Programm: + +PROGRAM testprog + IMPLICIT NONE + + CALL ausgabe("Dummy") + +CONTAINS + ... +END PROGRAM + +„oft: Eingabe mit Überprüfung auf Sinnhaftigkeit +Nach Ausführung des Unterprogramms soll berechneter (eingegebener) Wert im Hauptprogramm genutzt werden. +Option 1 mit subroutine:“ + +PROGRAM + SUBROUTINE anzahleingabe(eingabeaufforderung, benutzereingabe) + CHARACTER(len = *), INTENT(IN) :: eingabeaufforderung ! len = * -> übernommene Länge + INTEGER, INTENT(OUT) :: benutzereingabe ! voriger Wert des Arguments wird ignoriert + + DO + WRITE(*,*) eingabeaufforderung + READ (*,*) benutzereingabe + IF (benutzereingabe > 0) THEN + EXIT + ELSE + WRITE(*,*) "Eingabe fehlerhaft. Bitte nochmal." + END IF + END DO + END SUBROUTINE + +„also: Variable außen wird verändert, wenn sie innen neu gesetzt wird +-> darauf immer aufpassen, kann mit INTENT(IN/OUT/INOUT) gut geprüft werden +Alternative: FUNCTION: "wie in der Mathematik" (aber nur, wenn INTENT(IN) angegeben ist, +andernfalls koennen die Eingabeparameter veraendert werden!): +man gibt Argumente rein, bekommt Ergebnis raus +damit kann man weiterrechnen, z.B. mittelwert = REAL(summe)/n (in Zyklus Programm) +Das Ergebnis nennt man "Rückgabewert"“ + + FUNCTION anzahleingabe(eingabeaufforderung) + CHARACTER(len = *), INTENT(IN) :: eingabeaufforderung ! len = * -> übernommene Länge + INTEGER :: anzahleingabe ! innerhalb der Funktion ist eingabe eine + ! normal nutzbare Variable, bekommt einen Typ + + DO + WRITE(*,*) eingabeaufforderung + READ (*,*) anzahleingabe + IF (anzahleingabe > 0) THEN + EXIT + ELSE + WRITE(*,*) "Eingabe fehlerhaft. Bitte nochmal." + END IF + END DO + END FUNCTION + +„um rekursive Funktionen zu schreiben, muss "namenseingabe" als Funktion zur Verfügung stehen. +Dafür muss die Variable, die den Rückgabewert enthält anders heißen:” + + RECURSIVE FUNCTION add(a, n) RESULT(sum) + ! returns a + n in convoluted method + INTEGER :: a, n, sum + + IF (n == 0) THEN + sum = a + ELSE (n < 0) THEN + sum = add(a - 1, n + 1) ! rekursiver Aufruf, liefert (a - 1) + (n + 1) + ELSE + sum = add(a + 1, n - 1) ! auch rekursiver Aufruf + END IF + END FUNCTION + +„RESULT kann man immer benutzen, wenn man den Funktionsnamen nicht als Variable in der Funktion nutzen möchte + +Um dem Projekt mehr Struktur zu geben, sammelt man Subroutinen, Funktionen, Konstantendeklarationen +in sogenannten Modulen. +Module sind unabhängig von Programmen und können in verschiedenen Programmen wiederverwendet werden. +Z.B. werden wir ein Modul von Prof. Walter für Intervallarithmetik in Kürze sehen” + +MODULE simpleIO + IMPLICIT NONE + + ! VOR dem "CONTAINS" statement werden hier KIND parameter definiert, die von + ! allen Funktionen/Subroutinen verwendet werden koennen (KIND Parameter + ! koennen nicht implizit uebernommen werden) + + INTEGER, PARAMETER :: realkind = SELECTED_REAL_KIND(p = 15, r = 100) + INTEGER, PARAMETER :: intkind = SELECTED_INT_KIND(i = 20) + ! i = 20 bedeutet Zahlen von -10^i bis 10^i können dargestellt werden + +CONTAINS + + FUNCTION anzahleingabe(eingabeaufforderung) + CHARACTER(len = *), INTENT(IN) :: eingabeaufforderung ! len = * -> übernommene Länge + INTEGER, (KIND=intkind) :: anzahleingabe ! innerhalb der Funktion ist anzahleingabe eine + ! normal nutzbare Variable, bekommt einen Typ + + DO + WRITE(*,*) eingabeaufforderung + READ (*,*) anzahleingabe + IF (anzahleingabe > 0) THEN + EXIT + ELSE + WRITE(*,*) "Eingabe fehlerhaft. Bitte nochmal." + END IF + END DO + END FUNCTION + +END MODULE + +„um das zu nutzen, muss es im Hauptprogramm importiert werden mit USE:“ + +PROGRAM testprog + USE simpleIO + IMPLICIT NONE + + INTEGER :: n + + n = anzahleingabe("Hallo, gib eine Zahl ein.") +END PROGRAM + +„beim Kompilieren muss beides kompiliert werden, das Modul allerdings +zuerst: +f95 simpleIO.f95 testprog.f95 -o testprog“ diff --git a/hilfsprogramme/Gleitkommazahlen.pdf b/hilfsprogramme/Gleitkommazahlen.pdf new file mode 100644 index 0000000000000000000000000000000000000000..6a0324a2b49f4c0bf49c8d374c45779767e1db6a Binary files /dev/null and b/hilfsprogramme/Gleitkommazahlen.pdf differ diff --git a/hilfsprogramme/operation_priority.f95 b/hilfsprogramme/operation_priority.f95 new file mode 100644 index 0000000000000000000000000000000000000000..3951f5f0b6f268d960e72d630305c26bd0af60d8 --- /dev/null +++ b/hilfsprogramme/operation_priority.f95 @@ -0,0 +1,71 @@ +module int_type + implicit none + private + + public :: inte, operator(**), operator(-), operator(+), operator(.e.), operator(.p.), operator(.n.) + + type inte + integer :: i + end type inte + + interface operator(**) + module procedure exp2 + end interface + interface operator(+) + module procedure plus + end interface + interface operator(-) + module procedure neg + end interface + interface operator(.e.) + module procedure exp2 + end interface + interface operator(.p.) + module procedure plus + end interface + interface operator(.n.) + module procedure neg + end interface + +contains + + function exp2(e,x) + type(inte), intent(in) :: e,x + type(inte) :: exp2 + exp2%i=e%i**x%i + end function exp2 + + function plus(e,x) + type(inte), intent(in) :: e,x + type(inte) :: plus + plus%i=e%i+x%i + end function plus + + function neg(x) + type(inte) :: neg + type(inte), intent(in) :: x + neg%i = -x%i + end function neg +end module int_type + +program operation_priority + use int_type + implicit none + type(inte) :: a, b + a%i = 2; b%i=0 + write(*,*) "a**a**b ", a**a**b ! rechts nach links wie nächste Zeile + write(*,*) "a**(a**b) ", a**(a**b) ! 2**2**0 = 2**1 = 2 + write(*,*) "(a**a)**b ", (a**a)**b ! (2**2)**0 = 4**0 = 1 + write(*,*) "a.e.a.e.b ", a.e.a.e.b ! eigener Operator: links nach rechts: = 1 + + write(*,*) "a+a**a ", a+a**a ! exp vor + + write(*,*) "a**a+a ", a**a+a ! exp vor + : 2**2+2=4+2=6 + write(*,*) "a.p.a.e.a ", a.p.a.e.a ! eigener Operator: links nach rechts (2+2)**2=16 + write(*,*) "a.e.a.p.a ", a.e.a.p.a ! eigener Operator: links nach rechts 2**2+2=6 + + + write(*,*) "a+a.e.a ", a+a.e.a ! + vor eigener Operator (binär) (2+2)**2=16 + + write(*,*) "-a**a ", -a**a ! exp vor -: -2**2=-4 + write(*,*) ".n.a**a ", .n.a**a ! eigener Operator (unär) vor exp: (-2)**2=4 +end program operation_priority diff --git a/hilfsprogramme/puzzleschreiben.f95 b/hilfsprogramme/puzzleschreiben.f95 new file mode 100644 index 0000000000000000000000000000000000000000..e3dd63ad16bbacb9d440ddd1b095a4066472d17e --- /dev/null +++ b/hilfsprogramme/puzzleschreiben.f95 @@ -0,0 +1,196 @@ +PROGRAM puzzleschreiben + ! Dieses Programm schreibt ein Puzzle in eine Datei. + ! Diese Puzzle können von Programmen für die Aufgabe 17 von Blatt 8 + ! Nummerierung vom SoSe 2016) gelöst werden. + ! Das Programm nimmt drei Argumente: + ! 1) Die Breite des Puzzles + ! 2) Die Höhe des Puzzles + ! 3) Die Beschriftung des Puzzles (wenn es zu wenig Zeichen sind, werden die restlichen mit Leerzeichen aufgefüllt) + ! wenn das Puzzle mehr als 1000 Teile hat und mehr als 1000 Zeichen angegeben werden, werden trotzdem nur 1000 Teile beschriftet. Euren nächsten Roman könnt ihr hier also nicht verewigen. Sorry. (Bei Bedarf ersetze 1000 unten durch einen größeren Wert.) + ! Also eine beispielhafte Nutzung ist + ! f95 puzzleerzeugen.f96 -o pe + ! ./pe 5 3 "Puzzle sindTOLL" + + IMPLICIT NONE + + TYPE teil + ! ein Puzzleteil + ! oben, rechts, unten, links + INTEGER, DIMENSION(4) :: seiten = 0 + CHARACTER :: beschriftung = " " + END TYPE + + INTEGER, PARAMETER :: NORTH = 4, EAST = 1, WEST = 3, SOUTH = 2, unitnr = 30, zufaellig = 30 + INTEGER :: pmEins, spalte, zeile, error + INTEGER :: width = 0, heigth = 0 + INTEGER, DIMENSION(:,:), ALLOCATABLE :: zeilenbuchten, spaltenbuchten + INTEGER, DIMENSION(:), ALLOCATABLE :: buchtenliste + TYPE(teil), DIMENSION(:,:), ALLOCATABLE :: teile + CHARACTER(len=20) :: format + CHARACTER, DIMENSION(:), ALLOCATABLE :: puzzletext + CHARACTER(len=1000) :: text + ! bei einer Zeichenkette wüsste ich nicht wie ich einzelne Zeichen ansprechen könnte + + ! Höhe und Breite einlesen, falls nicht als Argumente gegeben + if (COMMAND_ARGUMENT_COUNT() < 3) then + WRITE(*,*) "Du kannst die Breite, Höhe und Beschriftung des Puzzles& + & einfach hinter den Programmaufruf schreiben. Gib jetzt die Höhe ein:" + READ(*,*, iostat = error) heigth + if (error /= 0 .OR. heigth < 1) then + STOP "Höhenangabe konnte nicht als natürliche Zahl geparst werden." + endif + WRITE(*,*) "Breite:" + READ(*,*, iostat = error) width + if (error /= 0 .OR. width < 1) then + STOP "Breitenangabe konnte nicht als natürliche Zahl geparst werden." + endif + WRITE(*,*) "Text, der auf dem Puzzle steht (wenn Leerzeichen enthalten sind umrahme den Text mit Anführungszeichen):" + READ(*,*, iostat = error) text + else + CALL GETARG(2, text) + READ(UNIT=text, FMT=*, iostat = error) heigth + if (error /= 0 .OR. heigth < 1) THEN + STOP "Höhenangabe konnte nicht als natürliche Zahl geparst werden." + ELSE + WRITE(*,*) "Höhe", heigth + END IF + + CALL GETARG(1, text) + READ(UNIT=text, FMT=*, iostat = error) width + if (error /= 0 .OR. width < 1) THEN + STOP "Breitenangabe konnte nicht als natürliche Zahl geparst werden." + ELSE + WRITE (*,*) "Breite", width + END IF + + CALL GETARG(3, text) + endif + + ALLOCATE(zeilenbuchten(width-1, heigth)) + ALLOCATE(spaltenbuchten(width, heigth-1)) + ALLOCATE(buchtenliste(SIZE(zeilenbuchten) + SIZE(spaltenbuchten))) + ALLOCATE(teile(width, heigth)) + ALLOCATE(puzzletext(width*heigth)) + + ! jedes Zeichen wird einzeln gelesen und in ein Element geschrieben + WRITE(format, "(A,I0,A)") "(", width*heigth, "(A1))" + ! WRITE(*,"(A,I0,A)") "Beschriftung des Puzzles (", width*heigth, " Zeichen inkl. Leerzeichen)" + READ(text,format) teile%beschriftung + + ! rechteckig ausgeben + WRITE(*,*) "Das Puzzle wird mit folgendem Text beschrieben:" + WRITE(format, "(A,I0,A)") "(", width, "A)" + WRITE(*,format) teile%beschriftung + + buchtenliste = permutation(SIZE(buchtenliste)) + ! zwischenspeichern, damit alle Nummern über alle Buchten verteilt werden + ! und es keine getrennte Nummerierung für senkrechte und waagerechte Buchten gibt + zeilenbuchten = reshape(buchtenliste(:SIZE(zeilenbuchten)), SHAPE(zeilenbuchten)) + spaltenbuchten = reshape(buchtenliste(SIZE(zeilenbuchten) + 1:), SHAPE(spaltenbuchten)) + WRITE(format, "(A,I0,A)") "(", width-1, "(I3))" + WRITE(*,*) "Zeilenbuchten" + WRITE(*, format) zeilenbuchten + WRITE(*,*) "Spaltenbuchten" + WRITE(format, "(A,I0,A)") "(", width, "(I3))" + WRITE(*, format) spaltenbuchten + + ! ------------- + ! die Buchten in die Teile schreiben. + ! erst für die waagerechten Buchten, dann die senkrechten + ! ------------- + DO spalte = 1, width-1 + DO zeile = 1, heigth + pmEins = INT(RAND()*2) *2-1 + teile(spalte, zeile)%seiten(EAST) = pmEins*zeilenbuchten(spalte, zeile) + teile(spalte + 1, zeile)%seiten(WEST) = - pmEins*zeilenbuchten(spalte, zeile) + END DO + END DO + DO spalte = 1, width + DO zeile = 1, heigth-1 + pmEins = INT(RAND()*2) *2-1 + teile(spalte, zeile)%seiten(SOUTH) = pmEins*spaltenbuchten(spalte, zeile) + teile(spalte, zeile + 1)%seiten(NORTH) = - pmEins*spaltenbuchten(spalte, zeile) + END DO + END DO + + WRITE(*,*) "Teile vor dem Verdrehen" + CALL putTeile() + + ! drehe Teile zufaellig + ! schreibe Text auf die Teile + WRITE(*,*) + do zeile = 1, width + do spalte = 1, heigth + ! Eckteile werden nicht gedreht: + if (.NOT. ((zeile == 1 .OR. zeile == width) .AND. (spalte == 1 .OR. spalte == heigth))) then + ! zufaellig 0 bis 4 Seiten weit rotiert + teile(zeile, spalte)%seiten = CSHIFT(teile(zeile, spalte)%seiten, INT(RAND()*4)) + end if + ! teile(zeile, spalte)%beschriftung = + END DO + END DO + + WRITE(*,*) "Teile nach dem Verdrehen" + CALL putTeile() + + ! schreibe Teile in zufaelliger Reihenfolge in eine Datei + DO pmEins = 1, 30 ! pmEins und format hier missbraucht + WRITE(format, "(A,I0,A)") "puzzle", pmEins, ".puz" + WRITE(*,*) format + OPEN(UNIT=unitnr, file=format, status="NEW", iostat=error, action="WRITE") + IF (error == 0) EXIT + IF (pmEins == 30) error = 1 ! I know, bad code, make it better + ! otherwise try next file + END DO + + IF (error == 0) THEN + ! Breite und Hoehe in die Datei schreiben + WRITE(unitnr, *) heigth, width + buchtenliste = permutation(SIZE(teile)) + DO pmEins = 1, SIZE(buchtenliste) + ! zeilenweise nummerieren + CALL saveTeil(teile(& + & MOD(buchtenliste(pmEins)-1, width) + 1, & + & (buchtenliste(pmEins)-1)/width + 1 ) ) + END DO + ELSE + WRITE(*,*) "Konnte keine Datei öffnen. Überprüfe, ob es eine der & + & Dateien puzzle1-30.puz noch nicht gibt und ich Schreibrechte habe." + END IF + CLOSE(unitnr) + +CONTAINS + + FUNCTION permutation(groesse) + INTEGER :: groesse, i, index, tauscher, tauschwert + INTEGER, DIMENSION(groesse) :: permutation + INTEGER, DIMENSION(8) :: time + CALL DATE_AND_TIME(VALUES=time) + ! Pseudozufall mithilfe der aktuellen Uhrzeit + tauscher = RAND(SUM(time)) + ! permutation = (i = 1, groesse) + permutation = (/ (i, i = 1, groesse) /) + DO i=1, zufaellig ! so viele Durchgaenge an Vertauschungen + DO index = 1, groesse ! jede Position mal vertauschen + tauscher = 1 + groesse * RAND() + ! WRITE(*,*) tauscher + tauschwert = permutation(tauscher) + permutation(tauscher) = permutation(index) + permutation(index) = tauschwert + END DO + END DO + END FUNCTION + + SUBROUTINE putTeile() + WRITE(format, "(A,I0,A)") "(", width, "(4(I3),1X,A,2X))" + WRITE(*,*) "Teile" + WRITE(*, format) teile + END SUBROUTINE + + SUBROUTINE saveTeil(puzzleteil) + TYPE(teil) :: puzzleteil + WRITE(unitnr, ("(4(I6,1X),A,A,A)")) puzzleteil%seiten, '"', & + & puzzleteil%beschriftung, '"' + END SUBROUTINE + +END PROGRAM diff --git a/hilfsprogramme/quaternionen.f95 b/hilfsprogramme/quaternionen.f95 new file mode 100644 index 0000000000000000000000000000000000000000..d3543954b88a2cc31eb1808d8e450e4fd614765a --- /dev/null +++ b/hilfsprogramme/quaternionen.f95 @@ -0,0 +1,89 @@ +MODULE quaternionen + IMPLICIT NONE + + PRIVATE + PUBLIC :: pr, intsize, quat, OPERATOR (+), OPERATOR (*), eins, i, j, k + + INTEGER, PARAMETER :: pr = SELECTED_REAL_KIND(P = 15, R=307) + INTEGER, PARAMETER :: intsize = SELECTED_INT_KIND(20) + + TYPE quat + PRIVATE + REAL (kind = pr) :: reell, imag, jmag, kmag + END TYPE + + INTERFACE OPERATOR (+) + MODULE PROCEDURE add + END INTERFACE + + INTERFACE OPERATOR (*) + MODULE PROCEDURE mul, realmul, intmul + END INTERFACE + + TYPE (quat), PARAMETER :: eins = quat(1, 0, 0, 0) + TYPE (quat), PARAMETER :: i = quat(0, 1, 0, 0) + TYPE (quat), PARAMETER :: j = quat(0, 0, 1, 0) + TYPE (quat), PARAMETER :: k = quat(0, 0, 0, 1) + +CONTAINS + + FUNCTION add(a, b) + TYPE(quat), INTENT(IN) :: a, b + TYPE(quat) :: add + add%reell = a%reell + b%reell + add%imag = a%imag + b%imag + add%jmag = a%jmag + b%jmag + add%kmag = a%kmag + b%kmag + END FUNCTION + + FUNCTION mul(a, b) + TYPE(quat), INTENT(IN) :: a, b + TYPE(quat) :: mul + mul%reell = a%reell * b%reell & + & - a%imag * b%imag & + & - a%jmag * b%jmag & + & - a%kmag * b%kmag + mul%imag = a%reell * b%imag & + & + a%imag * b%reell & + & + a%jmag * b%kmag & + & - a%kmag * b%jmag + mul%jmag = a%reell * b%jmag & + & - a%imag * b%kmag & + & + a%jmag * b%reell & + & + a%kmag * b%imag + mul%kmag = a%reell * b%kmag & + & + a%imag * b%jmag & + & - a%jmag * b%imag & + & + a%kmag * b%reell + END FUNCTION + + FUNCTION realmul(skalar, a) + REAL (kind = pr), INTENT(IN) :: skalar + TYPE(quat), INTENT(IN) :: a + TYPE(quat) :: realmul + realmul = quat(skalar * a%reell, skalar * a%imag, skalar * a%jmag, skalar * a%kmag) + END FUNCTION + + FUNCTION intmul(skalar, a) + INTEGER (kind = intsize), INTENT(IN) :: skalar + TYPE(quat), INTENT(IN) :: a + TYPE(quat) :: intmul + intmul = quat(skalar * a%reell, skalar * a%imag, skalar * a%jmag, skalar * a%kmag) + END FUNCTION + +END MODULE + +PROGRAM quattest + USE quaternionen + IMPLICIT NONE + + TYPE(quat) :: q + + q = add(eins, i) + WRITE(*,*) q + q = eins + i + WRITE(*,*) q + + q = 3.0_pr*eins + 5_intsize*i ! _pr und _intsize muss angefuegt werden, damit die Typen in realmul und intmul passen + write(*,*) q +END PROGRAM diff --git a/hilfsprogramme/random.f95 b/hilfsprogramme/random.f95 new file mode 100644 index 0000000000000000000000000000000000000000..17959f2f355f8b9652c11257efdb5d9c52e163fa --- /dev/null +++ b/hilfsprogramme/random.f95 @@ -0,0 +1,25 @@ +! benutze random_init um eine neue Peudozufallsfolge für random_number zu erzeugen +module random + implicit none + private + public random_init +contains + subroutine random_init() + integer :: n, unit_nr = 101, stat, clock, i + integer, dimension(:), allocatable :: seed + call random_seed(size=n) + allocate(seed(n)) + open(unit=unit_nr,file="/dev/urandom",status="old",access="stream",action="read", iostat=stat) + if( stat /= 0 ) then + write(*,*) "Warning can't open /dev/urandom, use system time instead" + call system_clock(count=clock) + seed = clock + 41 * (/ (i, i = 1, n) /) + call random_seed(put=seed) + else + read(unit_nr) seed + call random_seed(put=seed) + close(unit_nr) + end if + deallocate(seed) + end subroutine random_init +end module random