Skip to content
Snippets Groups Projects
Commit 4d436f9d authored by Tony Zorman's avatar Tony Zorman
Browse files

fixed gitignore

parent 9d3eed9f
No related branches found
No related tags found
No related merge requests found
......@@ -4,6 +4,9 @@
# Unignore all with extensions
!*.*
# Uningnore directories
!*/
# Unignore Makefiles
!Makefile
!makefile
......
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
„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
„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“
File added
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
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
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
! 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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment