Fortran-DVM - оглавление Часть 1(1-4) Часть 2 (5-6) Часть 3 (7-12) Часть 4
(Приложения)
создан: апрель, 2001 - последнее обновление 07.10.02 -

Приложение 1. Синтаксис

2.2. Синтаксис директив FDVM

directive-line is     CDVM$ dvm-directive
  or    *DVM$ dvm-directive
dvm-directive is     specification-directive
  or    executable-directive
   
specification-directive is      processors-directive
  or     align-directive
  or     distribute-directive
  or     template-directive
  or     pointer-directive
  or     shadow-directive
  or     dynamic-directive
  or     inherit-directive
  or     remote-group-directive
  or     reduction-group-directive
  or     task-directive
  or     heap-directive
  or     asyncid-directive
   
executable-directive is      realign-directive
  or     redistribute-directive
  or     parallel-directive
  or     remote-access-directive
  or     shadow-group-directive
  or     shadow-start-directive
  or     shadow-wait-directive
  or     reduction-start-directive
  or     reduction-wait-directive
  or     new-value-directive
  or     prefetch-directive
  or     reset-directive
  or     parallel-task-loop-directive
  or     map-directive
  or     task-region-directive
  or     end-task-region-directive
  or     on-directive
  or     end-on-directive
  or     f90-directuive
  or     asynchronous-directive
  or     end-asynchronous-directive
  or     asyncwait-directive

Ограничения:

  1. константа,
  2. переменная, которая является формальным аргументом,
  3. переменная из COMMON блока,
  4. ссылка на встроенную функцию, где каждый аргумент является выражением спецификации,
  5. выражение спецификации, заключенное в скобки.

3. Массивы виртуальных процессоров. Директива PROCESSORS

processors-directive is      PROCESSORS processors-decl-list
processors-decl is      processors-name ( explicit-shape-spec-list )
explicit-shape-spec is      [ lower-bound : ] upper-bound
lower-bound is      int-expr
upper-bound is      int-expr

Ограничения.

4.1. Директивы DISTRIBUTE и REDISTRIBUTE

distribute-directive is      dist-action distributee dist-directive-stuff
  or     dist-action [ dist-directive-stuff ] :: distributee-list
   
dist-action is      DISTRIBUTE
  or     REDISTRIBUTE
   
dist-directive-stuff is      dist-format-list [ dist-onto-clause ]
   
distributee is      array-name
  or     pointer-name
  or     template-name
   
dist-format is      BLOCK
  or     GEN_BLOCK ( block-size-array )
  or     WGT_BLOCK ( block-weight-array , nblock)
  or     *
   
dist-onto-clause is      ONTO dist-target
   
dist-target is      processors-name [(processors-section-subscript-list )]
  or     task-name ( task-index )
   
processors-section-subscript is      [ subscript ] : [ subscript ]
   
subscript is      int-expr
   
nblock is      int-expr
   
block-size-array is      array-name
   
block-weight-array is      array-name

Ограничения:

4.2.2. Динамические массивы в модели FDVM. Директива POINTER

pointer-directive is      type , POINTER ( dimension-list ) :: pointer-name-list
dimension is      :
   
pointer-name is      scalar-int-variable-name
  or     int-array-name
   
heap-directive is      HEAP array-name-list

Ограничения:

4.3.1. Директивы ALIGN и REALIGN

align-directive is      align-action alignee align-directive-stuff
  or     align-action [ align-directive-stuff ] :: alignee-list
   
align-action is      ALIGN
  or     REALIGN
   
align-directive-stuff is      ( align-source-list ) align-with-clause
   
alignee is      array-name
  or     pointer-name
   
align-source is      *
  or     align-dummy
   
align-dummy is      scalar-int-variable
   
align-with-clause is      WITH align-spec
   
align-spec is      align-target ( align-subscript-list )
   
align-target is      array-name
  or     template-name
  or     pointer-name
   
align-subscript is      int-expr
  or     align-dummy-use
  or     *
   
align-dummy-use is      [ primary-expr * ] align-dummy [ add-op primary-expr ]
   
primary-expr is      int-constant
  or     int-variable
  or     ( int-expr )
   
add-op is      +
  or     -

Ограничения:

4.3.2. Директива TEMPLATE

template-directive is      TEMPLATE template-decl-list
   
template-decl is      template-name [ ( explicit-shape-spec-list ) ]

4.4. Директивы DYNAMIC и NEW_VALUE

dynamic-directive is      DYNAMIC alignee-or-distributee-list
   
alignee-or-distributee is      alignee
  or     distributee
new-value-directive is      NEW_VALUE

5.1.2. Распределение витков цикла. Директива PARALLEL

parallel-directive is      PARALLEL ( do-variable-list )
        ON
iteration-align-spec
         [ , new-clause ] [ , reduction-clause]
         [ , shadow-renew-clause] [ , shadow-compute-clause]
         [ , remote-access-clause ] [ , across-clause ]
   
iteration-align-spec is      align-target ( iteration-align-subscript-list )
   
iteration-align-subscript is      int-expr
  or     do-variable-use
  or     *
   
do-variable-use is      [ primary-expr * ] do-variable [ add-op primary-expr ]

5.1.3. Приватные переменные. Спецификация NEW

new-clause is      NEW ( new-variable-list )
   
new-variable is      array-name
  or     scalar-variable-name

Ограничение:

5.1.4. Редукционные операции и переменные. Спецификация REDUCTION

reduction-clause is      REDUCTION
                    ( [ reduction-group-name : ] reduction-op-list )
   
reduction-op is      reduction-op-name ( reduction-variable )
   
  or     reduction-loc-name ( reduction-variable ,
                                               location-variable, int-expr)
   
reduction-variable is      array-name
  or     scalar-variable-name
   
location-variable is      array-name
   
reduction-op-name is      SUM
  or     PRODUCT
  or     MAX
  or     MIN
  or     AND
  or     OR
  or     EQV
  or     NEQV
reduction-loc-name is      MAXLOC
  or     MINLOC

Ограничения:

6.2.1. Спецификация массива с теневыми гранями

shadow-directive is      SHADOW dist-array ( shadow-edge-list )
  or     SHADOW ( shadow-edge-list ) :: dist-array-list
   
dist-array is      array-name
  or     pointer-name
   
shadow-edge is      width
  or     low-width : high-width
   
width is      int-expr
low-width is      int-expr
high-width is      int-expr

Ограничения:

6.2.2. Синхронная спецификация независимых ссылок типа SHADOW для одного цикла

shadow-renew-clause is      SHADOW_RENEW ( renewee-list )
  or     shadow-start-directive
  or     shadow-wait-directive
   
renewee
is      dist-array-name [ ( shadow-edge-list ) ] [ (CORNER) ]

Ограничения:

6.2.3. Вычисление значений в теневых гранях. Спецификация SHADOW_COMPUTE

shadow-compute-clause is      SHADOW_COMPUTE

6.2.4. Спецификация AСROSS зависимых ссылок типа SHADOW для одного цикла

across-clause is      ACROSS ( dependent-array-list )
   
dependent-array is      dist-array-name ( dependence-list ) [(section-spec-list)]
   
dependence is      flow-dep-length : anti-dep-length
   
flow-dep-length is      int-constant
anti-dep-length is      int-constant
   
section-spec is      SECTION ( section-subscript-list )

Ограничение:

6.2.5. Асинхронная cпецификация независимых ссылок типа SHADOW

shadow-group-directive is     SHADOW_GROUP shadow-group-name ( renewee-list )
   
shadow-start-directive is     SHADOW_START shadow-group-name
   
shadow-wait-directive is     SHADOW_WAIT shadow-group-name

Ограничения.

6.3.1. Директива REMOTE_ACCESS

remote-access-directive is      REMOTE_ACCESS
         ( [ remote-group-name ] regular-reference-list)
   
regular-reference is      dist-array-name [( regular-subscript-list )]
   
regular-subscript is      int-expr
  or     do-variable-use
  or     :
   
remote-access-clause is      remote-access-directive

6.3.3. Асинхронная спецификация удаленных ссылок типа REMOTE

remote-group-directive is      REMOTE_GROUP remote-group-name-list

Ограничение:

prefetch-directive is      PREFETCH remote-group-name
   
reset-directive is      RESET remote-group-name

Ограничения.

6.3.4.2.1. Директива ASYNCID

asyncid-directive is      ASYNCID async-name-list
   

6.3.4.2.2. Директива F90

f90-directive is      F90 copy-statement
   
copy-statement is      array-section = array-section
   
array-section is      array-name [( section-subscript-list )]
   
section-subscript is      subscript
  or     subscript-triplet
   
subscript-triplet is      [ subscript ] : [ subscript ] [ : stride]
   
subscript is      int-expr
   
stride is      int-expr

6.3.4.2.3. Директивы ASYNCHRONOUS и END ASYNCHRONOUS

asynchronous-construct is      asynchronous-directive
           f90-directive
        [ f90-directive ] …
        copy-loop
        [ copy-loop ] …
          end-asynchronous-directive
   
asynchronous-directive is      ASYNCHRONOUS async-name
   
end-asynchronous-directive is      END ASYNCHRONOUS

6.3.4.2.4. Директива ASYNCWAIT

asyncwait-directive is ASYNCWAIT async-name

6.4.2. Асинхронная спецификация удаленных ссылок типа REDUCTION

reduction-group-directive is      REDUCTION_GROUP reduction-group-name-list
   
reduction-start-directive is      REDUCTION_START reduction-group-name
   
reduction-wait-directive is      REDUCTION_WAIT reduction-group-name

Ограничения.

7.1. Описание массива задач

task-directive is      TASK task-list
   
task is      task-name ( max-task )

7.2. Отображение задач на процессоры. Директива MAP

map-directive is    MAP task-name ( task-index )
        ONTO processors-name( processors-section-subscript-list)

7.4. Распределение вычислений. Директива TASK_REGION

block-task-region is      task-region-directive
                    on-block
                    [ on-block ]...
          end-task-region-directive
   
task-region-directive is      TASK_REGION task-name [ , reduction-clause ]
   
end-task-region-directive is      END TASK_REGION
   
on-block is      on-directive
                   block
          end-on-directive
   
on-directive is      ON task-name ( task-index ) [ , new-clause ]
   
end-on-directive is      END ON
   
loop-task-region is      task-region-directive
                    parallel-task-loop
           end-task-region-directive
   
parallel-task-loop is      parallel-task-loop-directive
                          do-loop
   
parallel-task-loop-directive is      PARALLEL ( do-variable )
        ON
task-name ( do-variable ) [ , new-clause ]

9. Процедуры

inherit-directive is      INHERIT dummy-array-name-list

 

Приложение 2. Примеры программ

Семь небольших программ из научной области приводятся для иллюстрации свойств языка Fortran DVM. Они предназначены для решения систем линейных уравнений:

A x = b

где:
A – матрица коэффициентов,
b – вектор свободных членов,
x – вектор неизвестных.

Для решения этой системы используются следующие основные методы.

Прямые методы. Хорошо известный метод исключения Гаусса является наиболее широко используемым алгоритмом этого класса. Основная идея алгоритма заключается в преобразовании матрицы А в верхнетреугольную матрицу и использовании затем обратной подстановки, чтобы привести ее к диагональной форме.

Явные итерационные методы. Наиболее известным алгоритмом этого класса является метод релаксации Якоби. Алгоритм выполняет следующие итерационные вычисления

xi,jnew = (xi-1,jold + xi,j-1old + xi+1,jold + xi,j+1old ) / 4

Неявные итерационные методы. К этому классу относится метод последовательной верхней релаксации. Итерационное приближение вычисляется по формуле

xi,jnew = ( w / 4 ) * (xi-1,jnew + xi,j-1new + xi+1,jold + xi,j+1old ) + (1-w) * xi,jold

При использовании "красно-черного" упорядочивания переменных каждый итерационный шаг разделяется на два полушага Якоби. На одном полушаге вычисляются значения "красных" переменных, на другом – "черных" переменных. "Красно-черное" упорядочивание позволяет совместить вычисления и обмены данными.

Пример 1. Алгоритм метода исключения Гаусса

	PROGRAM GAUSS
C	решение системы линейных уравнений  A*x = b
	PARAMETER  ( N = 100 )
	REAL  A( N, N+1 ), X( N )
C	A :  матрица коэффициентов  (N,N+1).
C                      вектор правых частей линейных уравнений хранится 
C         в (N+1)-ом столбце матрицы A
C	X :  вектор неизвестных
C	N :  число линейных уравнений
*DVM$	DISTRIBUTE A (BLOCK,*)  
*DVM$	ALIGN X(I) WITH A(I,N+1)
C
C	Инициализация
C
*DVM$	PARALLEL ( I ) ON  A(I,*)
	DO  100  I = 1, N
	DO  100  J = 1, N+1
	  IF  (( I .EQ. J )  THEN
	      A(I,J) = 2.0
	  ELSE
	    IF ( J .EQ. N+1)  THEN
	      A(I,J) = 0.0
	    ENDIF
	  ENDIF
100	CONTINUE
C
C	Исключение
C
	DO  1  I = 1, N
C	I-ая строка матрицы  A  буферизуется перед 
C	обработкой I-ого уравнения, и ссылки  A(I,K), A(I,I) 
C	заменяются соответствующими ссылками на буфер
*DVM$   PARALLEL ( J ) ON  A(J,*), REMOTE_ACCESS ( A(I,:) )
		   DO  5  J = I+1, N
	   DO  5  K = I+1, N+1
	      A(J,K) = A(J,K) - A(J,I) * A(I,K) / A(I,I)
5	   CONTINUE
1	CONTINUE
C	сначала вычисляется X(N)
	X(N) = A(N,N+1) / A(N,N)
C
C	Нахождение X(N-1),X(N-2),...,X(1) обратной подстановкой
C
	DO  6  J = N-1, 1, -1
C	(J+1)-ый элемент массива X буферизуется перед
C	обработкой J-ого уравнения, и ссылка X(J+1) 
C	заменяется соответствующей ссылкой на буфер
*DVM$	PARALLEL  ( I )  ON  A(I,*),  REMOTE_ACCESS ( X(J+1) )
	   DO  7  I = 1, J
	     A(I,N+1) = A(I,N+1) - A(I,J+1) * X(J+1)
7	   CONTINUE
	   X(J) = A(J,N+1) / A(J,J)
6	CONTINUE
	PRINT *,  X
	END

Пример 2. Алгоритм Якоби

	PROGRAM   JACOB
	PARAMETER  (K=8,  ITMAX=20)
	REAL  A(K,K), B(K,K), EPS, MAXEPS
CDVM$	DISTRIBUTE  A  (BLOCK, BLOCK) 
CDVM$	ALIGN  B(I,J)  WITH  A(I,J)
C	массивы A и B распределяются блоками
	PRINT *,  '**********  TEST_JACOBI   **********'
	MAXEPS = 0.5E - 7
CDVM$	PARALLEL  (J,I)  ON  A(I,J)
C	гнездо из двух параллельных циклов, итерация (i,j) выполняется,
C	на том процессоре, где размещен элемент A(i,j) 
	DO  1  J = 1, K
	DO  1  I = 1, K
	   A(I,J) = 0.
	   IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.K .OR. J.EQ.K) THEN
		B(I,J) = 0.
	   ELSE
		B(I,J)  = 1. + I + J 
	   ENDIF
1	CONTINUE
	DO  2  IT = 1, ITMAX
	EPS = 0.
CDVM$	PARALLEL  (J,I)  ON  A(I,J),  REDUCTION ( MAX( EPS ))
C	переменная EPS используется для вычисления максимального значения
	DO  21  J = 2, K-1
	DO  21  I = 2, K-1
		EPS = MAX ( EPS, ABS( B(I,J) - A(I,J)))
		A(I,J) = B(I,J)
21	CONTINUE
CDVM$	PARALLEL  (J,I)  ON  B(I,J),  SHADOW_RENEW  (A)
C	копирование теневых элементов массива A 
C	с соседних процессоров перед выполнением цикла
	DO  22  J = 2, K-1
	DO  22  I = 2, K-1
		B(I,J) = (A(I-1,J) + A(I,J-1) + A(I+1,J) + A(I,J+1)) / 4
22	CONTINUE
	PRINT *,  'IT = ', IT,  '   EPS = ', EPS
	IF ( EPS . LT . MAXEPS )  GO TO  3
2	CONTINUE
3	OPEN (3,  FILE='JACOBI.DAT',  FORM='FORMATTED')
	WRITE (3,*)  B
	CLOSE (3)
	END

Пример 3. Алгоритм Якоби (асинхронный вариант)

	PROGRAM   JACOB1
	PARAMETER   (K=8,  ITMAX=20)
	REAL   A(K,K), B(K,K), EPS, MAXEPS
CDVM$	DISTRIBUTE  A  (BLOCK, BLOCK) 
CDVM$	ALIGN  B(I,J)  WITH  A(I,J) 
C	массивы A  и B распределяются блоками
CDVM$	REDUCTION_GROUP  REPS 
	PRINT *,  '**********  TEST_JACOBI_ASYNCHR   **********'
CDVM$	SHADOW_GROUP  SA (A)
C	создание группы теневых граней
	MAXEPS = 0.5E - 7
CDVM$	PARALLEL  (J,I)  ON  A(I,J)
C	параллельный цикл для инициализации массивов А и В
	DO  1  J = 1, K
	DO  1  I = 1, K
	   A(I,J) = 0.
	   IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.K .OR. J.EQ.K) THEN
		B(I,J) = 0.
	   ELSE
		B(I,J) = 1. + I + J 
	ENDIF
1	CONTINUE
	DO  2  IT = 1, ITMAX
	EPS = 0.
C	создается группа редукционных операций
C	и начальные значения редукционных переменных запоминаются
CDVM$	PARALLEL  (J,I)  ON  A(I,J),  SHADOW_START  SA,
CDVM$*	REDUCTION_GROUP  ( REPS : MAX( EPS ))
C	изменяется порядок выполнения витков цикла:
C	сначала вычисляются и посылаются граничные элементы массива A,
C	затем вычисляются внутренние элементы массива A
	DO  21  J = 2, K-1
	DO  21  I = 2, K-1
		EPS = MAX ( EPS, ABS( B(I,J) - A(I,J)))
		A(I,J) = B(I,J)
21	CONTINUE
CDVM$	REDUCTION_START   REPS
C	начало редукционной операции над частичными результатами,
C	вычисленными в копиях переменной EPS на каждом процессоре
CDVM$   PARALLEL  (J,I)  ON  B(I,J),  SHADOW_WAIT  SA
C	изменяется порядок выполнения витков цикла:
C	сначала вычисляются внутренние элементы массива B , затем принимаются 
C	от соседних процессоров теневые элементы массиваA,
C	а потом вычисляются граничные элементы массива B
	DO  22  J = 2, K-1
	DO  22  I = 2, K-1
		B(I,J) = (A(I-1,J) + A(I,J-1) + A(I+1,J) + A(I,J+1)) / 4
22	CONTINUE
CDVM$	REDUCTION_WAIT   REPS
C	ожидается результат выполнения редукционной операции
	PRINT *,  'IT = ', IT,  '   EPS = ', EPS
	IF ( EPS . LT . MAXEPS )   GO TO  3
2	CONTINUE
3	OPEN (3,  FILE='JACOBI.DAT',  FORM='FORMATTED')
	WRITE (3,*)  B
	CLOSE (3)
	END

Пример 4. Последовательная верхняя релаксация

        PROGRAM  SOR
	PARAMETER  ( N = 100 )
	REAL   A( N, N ),  EPS,  MAXEPS, W
	INTEGER   ITMAX
*DVM$	DISTRIBUTE  A (BLOCK,BLOCK)
	ITMAX = 20
	MAXEPS = 0.5E - 5
	W = 0.5
*DVM$	PARALLEL  (I,J)  ON  A(I,J)
	DO  1  I = 1, N
	DO  1  J = 1, N
	   IF ( I .EQ.J)   THEN
		A(I,J) = N + 2
	   ELSE
		A(I,J) = -1.0
	   ENDIF 
1	CONTINUE
	DO  2  IT = 1, ITMAX
	EPS = 0.
*DVM$	PARALLEL  (I,J)  ON  A(I,J),  NEW (S),  
*DVM$*	REDUCTION ( MAX( EPS )),  ACROSS  (A(1:1,1:1))
C	переменная S – приватная переменная
C	(ее использование локализовано в пределах одного витка)
C	переменная EPS используется для вычисления максимума 
	DO  21  I = 2, N-1
	DO  21  J = 2, N-1
		S = A(I,J)
		A(I,J) = (W / 4) * (A(I-1,J) + A(I+1,J) + A(I,J-1) +
     *		A(I,J+1)) + ( 1-W ) * A(I,J)
		EPS = MAX ( EPS,  ABS( S - A(I,J)))
21	CONTINUE
	PRINT *,  'IT = ',  IT, '   EPS = ',  EPS
	IF  (EPS  .LT.  MAXEPS )   GO TO  4
2	CONTINUE
4	PRINT *, A
	END

Пример 5. "Красно-черная" последовательная верхняя релаксация

    	PROGRAM  REDBLACK
	PARAMETER  ( N = 100 )
	REAL   A( N, N ),  EPS,  MAXEPS, W
	INTEGER   ITMAX
*DVM$	DISTRIBUTE  A (BLOCK,BLOCK)  
	ITMAX = 20
	MAXEPS = 0.5E - 5
	W = 0.5
*DVM$	PARALLEL  (I,J)  ON  A(I,J)
	DO  1  I = 1, N
	DO  1  J = 1, N
	   IF ( I .EQ.J)   THEN
		A(I,J) = N + 2
	   ELSE
		A(I,J) = -1.0
	   ENDIF 
1	CONTINUE
	DO  2  IT = 1, ITMAX
	EPS = 0.
C	цикл для красных и черных переменных
	DO  3  IRB = 1,2
*DVM$	PARALLEL  (I,J)  ON  A(I,J),  NEW (S),  
*DVM$*	REDUCTION ( MAX( EPS )),  SHADOW_RENEW  (A)
C	переменная S – приватная переменная
C	(ее использование локализовано в пределах одного витка)
C	переменная EPS используется для вычисления максимума 
C	Исключение : непрямоугольное итерационное пространство
	DO  21  I = 2, N-1
	DO  21  J = 2 + MOD( I+ IRB, 2 ), N-1, 2
		S = A(I,J)
		A(I,J) = (W / 4) * (A(I-1,J) + A(I+1,J) + A(I,J-1) +
     *		A(I,J+1)) + ( 1-W ) * A(I,J)
		EPS = MAX ( EPS,  ABS( S - A(I,J)))
21	CONTINUE
3	CONTINUE
	PRINT *,  'IT = ',  IT, '   EPS = ',  EPS
	IF  (EPS  .LT.  MAXEPS )    GO TO  4
2	CONTINUE
4	PRINT *, A
	END

Пример 6. Статические задачи (параллельные секции)

	PROGRAM    TASKS
C	прямоугольная сетка разделена на две области
C   K
C N1 A1, B1
C N2 A2, B2
	PARAMETER    (K=100,  N1 = 50,  ITMAX=10, N2 = K – N1 )
CDVM$	PROCESSORS  P(NUMBER_OF_PROCESSORS( ))
	REAL   A1(N1+1,K), A2(N2+1,K), B1(N1+1,K), B2(N2+1,K) 
	INTEGER  LP(2),  HP(2)
CDVM$	TASK  MB( 2 )
CDVM$	ALIGN  B1(I,J)  WITH  A1(I,J) 
CDVM$	ALIGN  B2(I,J)  WITH  A2(I,J) 
CDVM$	DISTRIBUTE  ::  A1, A2 
CDVM$	REMOTE_GROUP  BOUND
	CALL  DPT(LP, HP, 2)
C	Распределение задач (областей) по процессорам.
C	Распределение массивов по задачам
CDVM$	MAP  MB( 1 ) ONTO  P( LP(1) : HP(1) )
CDVM$	REDISTRIBUTE  A1( *, BLOCK )  ONTO  MB( 1 )
CDVM$	MAP  MB( 2 )   ONTO   P( LP(2) : HP(2) )
CDVM$	REDISTRIBUTE  A2(*,BLOCK)  ONTO  MB( 2 )
C	Инициализация
CDVM$	PARALLEL  (J,I)  ON  A1(I,J)
	DO  10   J  =  1, K
	DO  10   I  =  1, N1
	   IF(I.EQ.1 .OR. J.EQ.1 .OR. J.EQ.K) THEN
		A1(I,J) = 0.
		B1(I,J) = 0.
	   ELSE
		B1(I,J)  = 1. + I + J 
		A1(I,J) = B1(I, J)
	   ENDIF
10	CONTINUE
CDVM$	PARALLEL  (J,I)  ON  A2(I,J)
	DO  20   J  =  1, K
	DO  20   I  =  2, N2+1
	   IF(I.EQ.N2+1 .OR. J.EQ.1 .OR. J.EQ.K) THEN
		A2(I,J) = 0.
		B2(I,J) = 0.
	   ELSE
		B2(I,J)  = 1. + ( I + N1 – 1 ) + J 
		A2(I,J) = B2(I,J)
	   ENDIF
20	CONTINUE
	DO  2   IT  =  1, ITMAX
CDVM$	PREFETCH   BOUND
C	обмен границ
CDVM$	PARALLEL    ( J )   ON   A1(N1+1, J),
CDVM$*	REMOTE_ACCESS  (BOUND : B2(2,J) )
	DO  30   J  =  1, K
30	   A1(N1+1, J) = B2(2, J)
CDVM$	PARALLEL  ( J )  ON   A2(1,J),
CDVM$*	REMOTE_ACCESS  (BOUND : B1(N1,J) )
	DO  40   J  =  1, K
40	   A2(1,J) = B1(N1,J)
CDVM$	TASK_REGION  MB
CDVM$	ON   MB( 1 )
CDVM$	PARALLEL  (J,I)  ON  B1(I,J),
CDVM$*	SHADOW_RENEW ( A1 )
	DO  50   J  =  2, K-1
	DO  50   I  =  2, N1
50	   B1(I,J) = (A1(I-1,J) + A1(I,J-1) + A1(I+1,J) + A1(I,J+1)) / 4
CDVM$	PARALLEL  (J,I)  ON  A1(I,J)
	DO  60   J  =  2, K-1
	DO  60   I  =  2, N1
60	   A1(I,J) = B1(I,J)
CDVM$	END ON
CDVM$	ON  MB( 2 )
CDVM$	PARALLEL  (J,I)  ON  B2(I,J),
CDVM$*	SHADOW_RENEW ( A2 )
	DO  70   J  =  2, K-1
	DO  70   I  =  2, N2
70	   B2(I,J) = (A2(I-1,J) + A2(I,J-1) + A2(I+1,J) + A2(I,J+1)) / 4
CDVM$	PARALLEL  (J,I)  ON  A2(I,J)
	DO  80   J  =  2, K-1
	DO  80   I  =  2, N2
80	   A2(I,J) = B2(I,J)
CDVM$	END ON
CDVM$	END  TASK_REGION
2	CONTINUE
	PRINT *, 'A1 '
	PRINT *,  A1
	PRINT *, 'A2 '
	PRINT *, A2
	END

	SUBROUTINE  DPT( LP, HP, NT )
C	распределение процессоров для  NT задач (NT = 2)
	INTEGER  LP(2), HP(2)
	NUMBER_OF_PROCESSORS( ) = 1
	NP = NUMBER_OF_PROCESSORS( )
	NTP = NP/NT
	IF(NP.EQ.1) THEN
	   LP(1) = 1
	   HP(1) = 1
	   LP(2) = 1
	   HP(2) = 1
	ELSE
	   LP(1) = 1
	   HP(1) = NTP
	   LP(2) = NTP+1
	   HP(2) = NP
	END IF
	END

Пример 7. Динамические задачи (цикл задач)

	PROGRAM  MULTIBLOCK
C	Модель многообластной задачи.
C	Количество областей, размер каждой области, внешние и внутренние границы 
C	определяются во время выполнения программы.
C	Тест следующих конструкций FDVM: динамические массивы,
C	динамические задачи, асинхронный REMOTE_ACCESS  для динамических
C	 массивов (формальных параметров)
*DVM$	PROCESSORS  MBC100( NUMBER_OF_PROCESSORS( ) )
	PARAMETER (M = 8, N =8, NTST = 1)
C	MXSIZE – размер динамической памяти
C	MXBLмаксимальное количество областей
	PARAMETER ( MXS=10000 )
	PARAMETER ( MXBL=2 )
C	HEAPдинамическая память
        REAL  HEAP(MXS)
C	PA,PB – массивы указателей для динамических массивов
C	PA(I),PB(I) – значение функции на предыдущем и текущем шаге в I–ой области
*DVM$	REAL, POINTER (:,:) :: PA, PB, P1, P2
*DVM$	DYNAMIC  PA, PB, P1, P2
	INTEGER  PA(MXBL), PB(MXBL), P1, P2
C	SIZE(1:2,I)размеры измерений I–ой области
	INTEGER SIZE(2,MXBL), ALLOCATE
C	TINB( :,I ) – таблица внутренних границ I–ой области
C	TINB( 1,I ) - - количество границ (от 1 до 4)
C	TINB( 2,I ) = J  - номер смежной области
C	TINB( 3,I ) TINB( 4,I ), - границы одномерной секции
C	TINB( 5,I ) - номер измерения в I-ой области (1 или 2)
C	TINB( 6,I ) - координата измерения в I-ой области
C	TINB( 7,I ) - номер измерения в J-ой области
C	TINB( 8,I ) - координата измерения в J-ой области
	INTEGER  TINB( 29, MXBL )
C	TEXB( :,I ) – таблица внешних границ I–ой области
C	TEXB( 1,I ) - количество границ (от 1 до 4)
C	TEXB( 2,I ) TEXB( 3,I ), - координаты одномерной секции массива 
C						для 1-ой границы
C	TEXB( 4,I ) - номер измерения (1 или 2)
C	TEXB( 5,I ) - координата по данному измерению
	INTEGER  TEXB(17,MXBL)
C	NBL -  количество областей
C	NTSTколичество шагов
	INTEGER  NBL, NTST
C	IDM – указатель на свободное место динамической  памяти
	INTEGER  IDM
	COMMON IDM,MXSIZE
C	отложенное распределение  массивов по каждой области
*DVM$	DISTRIBUTE :: PA, P1
*DVM$	ALIGN :: PB, P2
C	массив задач
*DVM$	TASK  TSA ( MXBL )
C	имя группового обмена внутренних границ
*DVM$	REMOTE_GROUP  GRINB
C	LP(I), HP(I) – границы секции массива процессоров I-ой области 
	INTEGER  LP(MXBL), HP(MXBL)
C	TGLOB(:,I) – таблица глобальных координат в сетке алгоритма Якоби
C				для I-ой области
C	TGLOB(1,I) – координата по 1-му измерению
C	TGLOB(2,I) – координата по 2-му измерению
	INTEGER TGLOB(2,MXBL)
	MXSIZE = MXS
C	разделение области M*N на подобласти
	CALL DISDOM(NBL,TGLOB,TEXB,TINB,SIZE,M,N,MXBL)
C	Разделение массива процессоров по областям
	CALL MPROC(LP,HP,SIZE,NBL)
C	Распределение задач (областей) по процессорам.
C	Распределение массивов по задачам
	IDM = 1
	DO  10  IB = 1, NBL
*DVM$	MAP  TSA( IB )  ONTO  MBC100( LP(IB) : HP(IB) )
	PA(IB) = ALLOCATE ( SIZE(1,IB))
	P1 = PA(IB)
*DVM$	REDISTRIBUTE  (*,BLOCK)  ONTO  TSA(IB) :: P1
	PB(IB) = ALLOCATE ( SIZE(1,IB))
	P2 = PB(I)
*DVM$	REALIGN  P2(I,J)  WITH  P1(I,J)
10	CONTINUE
C	Инициализация внешних границ
	DO 20 IB=1,NBL
	LS = 0
	DO 20 IS = 1,TEXB(1,IB)
	CALL INEXB (HEAP(PA(IB)), HEAP(PB(IB)), SIZE(1,IB), SIZE(2,IB),
     *	     TEXB(LS+2,IB), TEXB(LS+3,IB), TEXB(LS+4,IB), TEXB(LS+5,IB) )
	LS = LS+4
20	CONTINUE
C	Инициализация областей
	DO 25 IB = 1,NBL
	CALL INDOM (HEAP(PA(IB)), HEAP(PB(IB)), SIZE(1,IB), SIZE(2,IB),
     *       TGLOB(1,IB), TGLOB(2,IB))
	LS = LS+4
25	CONTINUE
	DO 65  IB = 1,NBL
	CALL PRTB(HEAP(PA(IB)), SIZE(1,IB), SIZE(2,IB ),IB)
65	CONTINUE
C	Цикл итераций
	DO  30  IT = 1, NTST
C	упреждающая подкачка буферов для внутренних границ
*DVM$	PREFETCH  GRINB
C	вычисление величин на внутренних границах
	DO  40  IB = 1, NBL
	LS = 0
	DO  40  IS = 1, TINB(1,IB)
	J = TINB(LS+2, IB)
	CALL CMPINB (HEAP(PA(IB)), HEAP(PA(J)),     
     *        SIZE(1,IB), SIZE(2,IB), SIZE(1,J), SIZE(2,J),
     *        TINB(LS+3,IB), TINB(LS+4,IB), TINB(LS+5,IB),
     *        TINB(LS+6,IB), TINB(LS+7,IB), TINB(LS+8,IB) )
	LS = LS+7
40	CONTINUE
C	вычисление величин внутри областей 
C	каждая область – отдельная задача
*DVM$	TASK_REGION   TSA
*DVM$	PARALLEL  ( IB )  ON  TSA( IB )
	DO 50  IB = 1,NBL
	CALL JACOBI(HEAP(PA(IB)), HEAP(PB(IB)), SIZE(1,IB), SIZE(2,IB))
50	CONTINUE
*DVM$	END  TASK_REGION
30	CONTINUE
C	конец итераций
C	вывод значений массивов
	DO 60  IB = 1,NBL
	CALL PRTB(HEAP(PA(IB)), SIZE(1,IB), SIZE(2,IB ),IB)
60	CONTINUE
	END

	INTEGER  FUNCTION ALLOCATE( SIZE )
C	распределение динамического массива при последовательном выполнении
	INTEGER SIZE(2)
	COMMON IDM,MXSIZE
	ALLOCATE = IDM
	IDM = IDM + SIZE(1)*SIZE(2)
	IF(IDM.GT.MXSIZE) THEN
		PRINT *, 'NO MEMORY'
		STOP
	ENDIF
	RETURN
	END

	SUBROUTINE  CMPINB ( AI, AJ, N1, N2, M1, M2, S1, S2, 
     *                                    ID, INDI, JD, INDJ)
C	вычисление величин на внутренних границах
	DIMENSION AI(N1,N2), AJ(M1, M2)
	INTEGER S1, S2
*DVM$	INHERIT  AI, AJ
*DVM$	REMOTE_GROUP  GRINB
	IF ( ID .EQ. 1 )  THEN
	IF ( JD .EQ. 1 )  THEN
*DVM$	PARALLEL  ( K )  ON  AI(INDI,K),
*DVM$*	REMOTE_ACCESS (GRINB : AJ(INDJ,K) )
	DO 10  K = S1,S2
10	  AI(INDI,K) = AJ(INDJ,K)
	ELSE
*DVM$	PARALLEL  ( K )  ON  AI( INDI, K ),
*DVM$*	REMOTE_ACCESS (GRINB : AJ(K,INDJ) )
	DO 20  K = S1, S2
20	AI(INDI,K) = AJ(K,INDJ)
	ENDIF
	ELSE
	IF ( JD .EQ. 1 )  THEN
*DVM$	PARALLEL  ( K )  ON  AI(K,INDI),
*DVM$*	REMOTE_ACCESS (GRINB : AJ(INDJ,K) )
	DO 30  K = S1,S2
30	AI(K, INDI) = AJ(INDJ,K)
	ELSE
*DVM$	PARALLEL  ( K )  ON  AI(K,INDI),
*DVM$*	REMOTE_ACCESS (GRINB : AJ(K,INDJ) )
	DO 40  K = S1, S2
40	AI(K,INDI) = AJ(K,INDJ)
	ENDIF
	ENDIF
	END

	SUBROUTINE  MPROC(LP,HP,SIZE,NBL)
C	распределение процессоров по областям
	INTEGER LP(NBL),HP(NBL),SIZE(2,NBL)
C	распределение для двух областей NBL=2
	NUMBER_OF_PROCESSORS( ) = 1
	NP = NUMBER_OF_PROCESSORS( )
	NPT = NP/NBL
	IF(NP.EQ.1) THEN
		LP(1) = 1
		HP(1) = 1
		LP(2) = 1
		HP(2) = 1
	ELSE
		LP(1) = 1
		HP(1) = NPT
		LP(2) = NPT+1
		HP(2) = NP
	ENDIF
	END

	SUBROUTINE  INEXB(A,B,N1,N2,S1,S2,ID,INDI)
C	инициализация внешних границ
	DIMENSION A(N1,N2),B(N1,N2)
	INTEGER S1,S2
*DVM$	INHERIT A,B
	IF(ID.EQ.1)  THEN
*DVM$	PARALLEL  (K)  ON  A(INDI,K)
	DO 10 K = S1,S2
	A(INDI,K) = 0
	B(INDI,K) = 0
10	CONTINUE
	ELSE
*DVM$	PARALLEL  (K)  ON  A(K,INDI)
	DO 20 K = S1,S2
	A(K,INDI) = 0
	B(K,INDI) = 0
20	CONTINUE	
	ENDIF
	END

	SUBROUTINE  INDOM(A,B,M,N,X1,X2)
C	инициализация областей
	DIMENSION A(M,N), B(M,N)
	INTEGER X1,X2
*DVM$	INHERIT A,B
*DVM$	PARALLEL (I,J) ON A(I,J)
	DO 10 I = 2,M-1
	DO 10 J = 2,N-1
	A(I,J) = I+J+X1+X2-3
	B(I,J) = A(I,J)
10 	CONTINUE
	END

	SUBROUTINE  JACOBI(A,B,N,M)
	DIMENSION A(N,M), B(N,M)
*DVM$	INHERIT  A,B
*DVM$	PARALLEL  (I,J)  ON  B(I,J)
	DO 10 I = 2,N-1
	DO 10 J = 2,M-1
10	B(I,J) = (A(I-1,J)+A(I+1,J)+A(I,J-1)+A(I,J+1))/4
*DVM$	PARALLEL  (I,J)  ON  A(I,J)
	DO 20 I = 2,N-1
	DO 20 J = 2,M-1
20	A(I,J) = B(I,J)
	END

	SUBROUTINE  PRTB(B,N,M,IB)
C	печать данных для области IB
	DIMENSION B(N,M)
*DVM$	INHERIT B
	PRINT *, 'BLOCK', IB
	PRINT *, B
	END

	SUBROUTINE DISDOM (NBL,TGL,TEXB,TINB,SIZE,M,N,MXBL)
	INTEGER TGL(2,MXBL), TEXB(17,MXBL), TINB(29,MXBL), SIZE(2,MXBL)
	INTEGER DM(20), DN(20),KDM,KDN,S,GM,GN
C	разделение области M*N на две подобласти: M*N/2) и M*N-N/2)
	DM(1) = M
	KDM = 1
	DN(1) = N/2
	DN(2) = N - N/2
	KDN = 2
	S = 0
	DO 10 I = 1,KDM
10	S = S + DM(I)
	IF(S.NE.M) THEN
		PRINT *, 'wrong division M'
		STOP
	ENDIF
	DO 15 IB = 1,MXBL
	TEXB(1,IB) = 0
	TINB(1,IB) = 0
15	CONTINUE       
	S = 0
	DO 20 J = 1,KDN
20	S = S + DN(J)
	IF(S.NE.N) THEN
		PRINT *, 'wrong division N'
		STOP
	ENDIF
	DM(1) = DM(1) - 1
	DN(1) = DN(1) - 1
	DM(KDM) = DM(KDM) - 1
	DN(KDN) = DN(KDN) - 1
C	генерация таблиц (графов) внешних и внутренних границ
	IB = 1
	GM = 2
	GN = 2
	DO 30 J = 1,KDN
	DO 40 I = 1,KDM
	IF (I.EQ.1) THEN
		L = TEXB(1,IB)*4
		TEXB(L+2,IB) = 1 
		TEXB(L+3,IB) = DN(J)+2
		TEXB(L+4,IB) = 1  
		TEXB(L+5,IB) = 1 
		TEXB(1,IB) = TEXB(1,IB)+1
	ELSE
		L = TINB(1,IB)*7
		TINB(L+2,IB) = IB-1 
		TINB(L+3,IB) = 1
		TINB(L+4,IB) = DN(J)+2
		TINB(L+5,IB) = 1
		TINB(L+6,IB) = 1
		TINB(L+7,IB) = 1 
		TINB(L+8,IB) = DM(I-1)+1
		TINB(1,IB) = TINB(1,IB)+1
	ENDIF
	IF (I.EQ.KDM) THEN
		L = TEXB(1,IB)*4
		TEXB(L+2,IB) = 1 
		TEXB(L+3,IB) = DN(J)+2
		TEXB(L+4,IB) = 1  
		TEXB(L+5,IB) = DM(I)+2 
		TEXB(1,IB) = TEXB(1,IB)+1
	ELSE
		L = TINB(1,IB)*7
		TINB(2,IB) = IB+1 
		TINB(3,IB) = 1
		TINB(4,IB) = DN(J)+2
		TINB(5,IB) = 1
		TINB(6,IB) = DM(I)+2
		TINB(7,IB) = 1 
		TINB(8,IB) = 2
		TINB(1,IB) = TINB(1,IB)+1
	ENDIF
	IF (J.EQ.1) THEN
		L = TEXB(1,IB)*4
		TEXB(L+2,IB) = 1 
		TEXB(L+3,IB) = DM(I)+2
		TEXB(L+4,IB) = 2  
		TEXB(L+5,IB) = 1 
		TEXB(1,IB) = TEXB(1,IB)+1
	ELSE
		L = TINB(1,IB)*7
		TINB(L+2,IB) = IB-KDM
		TINB(L+3,IB) = 1
		TINB(L+4,IB) = DM(I)+2
		TINB(L+5,IB) = 2
		TINB(L+6,IB) = 1
		TINB(L+7,IB) = 2 
		TINB(L+8,IB) = DN(J-1)+1
		TINB(1,IB) = TINB(1,IB)+1
	ENDIF
	IF (J.EQ.KDN) THEN
		L = TEXB(1,IB)*4
		TEXB(L+2,IB) = 1 
		TEXB(L+3,IB) = DM(I)+2
		TEXB(L+4,IB) = 2  
		TEXB(L+5,IB) = DN(J)+2 
		TEXB(1,IB) = TEXB(1,IB)+1
	ELSE
		L = TINB(1,IB)*7
		TINB(L+2,IB) = IB+KDM 
		TINB(L+3,IB) = 1
		TINB(L+4,IB) = DM(I)+2
		TINB(L+5,IB) = 2
		TINB(L+6,IB) = DN(J)+2
		TINB(L+7,IB) = 2 
		TINB(L+8,IB) = 2
		TINB(1,IB) = TINB(1,IB)+1
	ENDIF
	SIZE(1,IB) = DM(I)+2
	SIZE(2,IB) = DN(J)+2
	TGL(1,IB) = GM
	TGL(2,IB) = GN
	GM = GM+DM(I)
	IB = IB+1
40	CONTINUE
	GM = 2
	GN = GN+DN(J)
30	CONTINUE
	NBL = IB-1
	END

Fortran-DVM - оглавление Часть 1(1-4) Часть 2 (5-6) Часть 3 (7-12) Часть 4
(Приложения)