MATMUL | berechnet das Matrixprodukt zweier Matrizen |
DOT_PRODUCT | berechnet das Skalarprodukt zweier Vektoren |
SUM | bildet Summe aller (angegebenen) Feldelemente |
PRODUCT | bildet Produkt aller (angegebenen) Feldelemente |
MAXVAL | bestimmt maximalen Wert aller (angegebenen) Feldelemente |
MINVAL | bestimmt minimalen Wert aller (angegebenen) Feldelemente |
COUNT | zählt wie oft eine Bedingung im (angegebenen Teil-)Feld erfüllt ist |
ANY | testet Bedingungen in (mehrdimensionalen Teil-)Feldern |
ALL | testet Bedingungen in (mehrdimensionalen Teil-)Feldern |
ALLOCATED | testet, ob ein dynamisches Feld angelegt ist |
SIZE | bestimmt die Größe einer Dimension eines Feldes |
SHAPE | bestimmt die Gestalt eines Feldes |
LBOUND | bestimmt die Untergrenze (einer Dimension) eines Feldes |
UBOUND | bestimmt die Obergrenze (einer Dimension) eines Feldes |
TRANSPOSE | transponiert eine Matrix |
EOSHIFT | verschiebt das Feld und setzt Randwerte |
CSHIFT | cirkuläres Verschieben |
MAXLOC | bestimmt die Positionen des größten Feldelementes |
MINLOC | bestimmt die Positionen des kleinsten Feldelementes |
Außerdem gibt es die Möglichkeit, eine Feldzuweisung zu maskieren, d.h. eine
Zuweisung wird nur dort ausgeführt, wo eine Bedingung erfüllt ist.
Die WHERE-Anweisung: WHERE (maske) wertzuweisung
und den WHERE-Block:
WHERE (maske) [wertzuweisungen] [ELSEWHERE [wertzuweisungen]] END WHEREdie im Verhalten weitgehend der IF-Anweisung entsprechen.
Beispiel zur Verwendung von Feldfunktionen und konstruierten Feldern:
FUNCTION faculty (n) IMPLICIT NONE INTEGER :: k, n, faculty faculty = PRODUCT ( (/ (k, k=2,n) /) ) ! PRODUCT ueber ein konstruiertes, END FUNCTION ! unbenanntes Feld
Als Beispiel soll die vordefinierte Funktion MATMUL mit Hilfe von DOT_PRODUCT für REAL-Matrizen simuliert werden:
FUNCTION matmul (A, B) !------------------------------------------------------------------------------- ! multipliziert zwei Real-Matrizen miteinander !------------------------------------------------------------------------------- IMPLICIT NONE ! sicher ist sicher REAL :: A(:,:), B(:,:) ! Felder uebernommener Gestalt REAL :: matmul(SIZE(A,1),SIZE(B,2)) ! Dimension der resultierenden Matrix INTEGER :: i, j, n, m, k, l ! l x m * m x n -> l x m !------------------------------------------------------------------------------- n = SIZE(A,1) ! Spaltenlaenge der 1. Matrix m = SIZE(A,2) ! Zeilenlaenge der 1. Matrix k = SIZE(B,1) ! Spaltenlaenge der 2. Matrix l = SIZE(B,2) ! Zeilenlaenge der 2. Matrix IF (m /= k) THEN ! passen die Dimensionen ? matmul = 0.0 ! wenn nein: RETURN ! -> Abbruch ENDIF ! DO j = 1, l ! Matrizenmultiplikation: DO i = 1, n ! jede Zeile der 1. Matrix mit matmul(i,j) = DOT_PRODUCT(A(i,:),B(:,j))! jeder Spalte der 2. Matrix ENDDO ! ENDDO ! END FUNCTION matmul !Auch die Funktion DOT_PRODUCT selbst läßt sich mittels Feldfunktionen schreiben:
REAL FUNCTION dot_product (x, y) !------------------------------------------------------------------------------- ! berechnet das Skalarprodukt zweier Real-Vektoren !------------------------------------------------------------------------------- IMPLICIT NONE ! sicher ist sicher REAL, INTENT(IN) :: x(:), y(:) ! Felder mit uebernommener Gestalt !------------------------------------------------------------------------------- IF (SIZE(x) /= SIZE(y)) THEN ! dot_product = 0.0 ! Dimensionen stimmen nicht ueberein RETURN ! beende Berechnung ENDIF ! dot_product = SUM (x*y) ! END FUNCTION dot_product !
Soll eine externe Funktion anstelle einer vordefinierten verwendet werden, dann muß man entweder ein INTERFACE schreiben (im Falle von Feldern mit übernommener Gestalt sowieso notwendig) oder aber die Funktion mit dem EXTERNAL-Attribut definieren. (Beides in der aufrufenden Programmkomponente!)
Beispiel eines rekursiven Unterprogramms mit Feldern: rekursive Sortier-Routinen mit Feldern übernommener Gestalt; Hauptprogramm mit dynamischen Feldern
PROGRAM sortieren IMPLICIT NONE INTEGER, ALLOCATABLE :: feld(:), buffer(:) ! dynamisches Feld INTEGER :: i = 0, zahl, iostat CHARACTER :: mode INTERFACE ! erforderlich, da Feld mit RECURSIVE SUBROUTINE quicksort(array,orientierung)! uebernommener Gestalt UND IMPLICIT NONE ! optionale Parameter INTEGER, DIMENSION(:) :: array LOGICAL, OPTIONAL :: orientierung END SUBROUTINE RECURSIVE SUBROUTINE bublsort(array) IMPLICIT NONE INTEGER, DIMENSION(:) :: array END END INTERFACE ALLOCATE (feld(i)) WRITE (*,'(A)') 'Geben Sie die Zahlen ein (mit <RETURN> getrennt)' eingabe: DO ! benannte Schleife i = i + 1 ! Zaehlvariable DO WRITE (*,'(I3,A)',ADVANCE='NO') i,'. Zahl: ' READ (*,*,IOSTAT=iostat) zahl IF (iostat == 0) THEN ! wenn Zahl eingegeben, dann ALLOCATE (buffer(i-1)) ! Buffer anlegen und schon buffer = feld ! gelesenes Feld zwischen- DEALLOCATE (feld) ! speichern ALLOCATE (feld(i)) ! Feld neu anlegen und altes feld(:i-1) = buffer ! Feld aus Buffer holen DEALLOCATE (buffer) ! Buffer freigeben feld(i) = zahl ! aktuelle Zahl speichern EXIT ! naechste Zahl lesen ELSE if (iostat > 0) THEN ! wenn keine gueltige Zahl CYCLE ! eingelesen, lies wieder ELSE ! ^D (WS) oder ^Z (PC) EXIT eingabe ! wurde eingegeben => ver- ENDIF ! lasse den eingabe-Loop END DO END DO eingabe WRITE (*,*) ! neue Zeile (wegen WRITE (*,'(a)') 'eingegebenes Feld:' ! ADVANCE='NO') WRITE (*,*) feld ! Feld ausgeben DO WRITE (*,'(A)',ADVANCE='NO') 'Quicksort oder Bubblesort (Q/B) - ' READ (*,'(A)',IOSTAT=iostat) mode IF (iostat /= 0) CYCLE SELECT CASE (mode) CASE ('Q') CALL quicksort (feld) EXIT CASE ('B') CALL bublsort (feld) EXIT CASE DEFAULT CYCLE END SELECT END DO WRITE (*,'(A)') 'sortiertes Feld:' WRITE (*,*) feld ! sortiertes Feld ausgeben END PROGRAM RECURSIVE SUBROUTINE bublsort(array) ! Formalparameter !------------------------------------------------------------------------------- ! ! rekursives Unterprogramm BUBLSORT fuer Integer-Zahlen (basiert wie ! BUBBLESORT auf dem Vertauschen von Zahlen ! !------------------------------------------------------------------------------- !-------------------------- Deklarationsteil ----------------------------------- IMPLICIT NONE INTEGER, DIMENSION(:) :: array ! Feld uebernommener Gestalt INTEGER :: min1, n n = SIZE(array, DIM=1) ! bestimme die Groesse der 1. Dim. IF (n > 1) THEN min1 = MINLOC(array, DIM=1) IF (min1 /= 1) CALL swap(array(1),array(min1)) CALL bublsort (array(2:n)) ENDIF CONTAINS SUBROUTINE swap (i,j) ! vertausche zwei Zahlen IMPLICIT NONE INTEGER :: i,j, buffer buffer = i i = j j = buffer END SUBROUTINE END SUBROUTINE bublsort
RECURSIVE SUBROUTINE quicksort(array,orientierung) ! Formalparameter !------------------------------------------------------------------------------- ! ! rekursives Unterprogramm QUICKSORT fuer Integer-Zahlen ! !------------------------------------------------------------------------------- !-------------------------- Deklarationsteil ----------------------------------- IMPLICIT NONE INTEGER, DIMENSION(:) :: array ! Feld uebernommener Gestalt LOGICAL, OPTIONAL :: orientierung ! optionaler Parameter LOGICAL :: steigend INTEGER :: buffer, i, num INTEGER :: n !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! auch bei internen Subroutinen und ohne 'IMPLICIT NONE' musz n deklariert sein, ! da es sonst GLOBAL bekannt ist und der Algorithmus somit nicht funktioniert! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IF (PRESENT(orientierung)) THEN ! ist der optionale Parameter in der steigend = orientierung ! Aktualparameterliste vorhanden? ELSE steigend = .TRUE. ! default-maessig wird aufsteigend ENDIF ! sortiert n = SIZE(array, DIM=1) ! bestimme die Groesse der 1. Dim. num = 1 ! des Feldes "array" buffer = array(1) ! Buffer-Wert = 1. Feldelement DO i = 2, n ! Zaehl-Schleife IF ((( steigend) .AND. (array(i) < buffer)) .OR. & ((.NOT. steigend) .AND. (array(i) > buffer))) THEN array(1:i) = CSHIFT(array(1:i),SHIFT=-1) ! circulaeres shift: alle Werte, num = num + 1 ! die die Bedingung erfuellen, werden ENDIF ! nach vorn gereiht ENDDO IF (num-1 > 1) CALL quicksort(array(1:num-1),steigend) ! sortiere Teilfeld1 IF (n > num+1) CALL quicksort(array(num+1:n),steigend) ! sortiere Teilfeld2 END SUBROUTINE quicksort