einfuhrung zu interfaces durch Modul ergänzt

quaternionen.f95

+MODULE quaternionen
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: pr = SELECTED_REAL_KIND(P = 15, R=307)
+  INTEGER, PARAMETER :: intsize = SELECTED_INT_KIND(20)
+  
+  TYPE quat    ! Quaternionen, sowas aehnliches wie komplexe Zahlen mit 4 Dimensionen
+    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