next up previous contents
Nächste Seite: Benutzerdefinierte Datentypen Aufwärts: Felder Vorherige Seite: Feldausdrücke   Inhalt

Feldoperationen

Neben der bereits erwähnten Möglichkeit der Verwendung der vordefinierten skalaren Operatoren, die elementweise auf die Felder wirken, gibt es noch spezielle, für Felder definierte Funktionen:
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


Tabelle der Feldfunktionen

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 WHERE
die 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

next up previous contents
Nächste Seite: Benutzerdefinierte Datentypen Aufwärts: Felder Vorherige Seite: Feldausdrücke   Inhalt
Reinfried O. Peter 2001-09-07