| 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