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

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

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

• Cпецкомментарий directive-line подчиняется правилам написания комментария в фиксированной форме.
• Директивы спецификации должны находиться в разделе спецификаций.
• Исполняемые директивы должны находиться среди исполняемых операторов.
• Любое выражение, входящее в директиву спецификации, должно быть выражением спецификации.
• Выражение спецификации – это выражение, в котором каждое первичное должно быть одной из следующих форм:

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

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

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

• Разрешается использовать несколько массивов виртуальных процессоров разной формы при следующем условии: количество процессоров в каждом массиве должно быть равно значению встроенной функции NUMBER_OF_PROCESSORS ( ).
• Массивы данных с атрибутами COMMON и SAVE могут быть отображены на локальные массивы виртуальных процессоров при следующем условии: при каждом вызове процедуры локальный массив процессоров имеет одно и то же определение.

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

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

• Длина списка dist-format-list должна быть равна количеству измерений массива. Т.е. для каждого измерения должен быть задан формат распределения.
• Количество распределенных измерений массива (формат задан не *) должно быть равно количеству измерений массива процессоров в dist-target.
• Массив block-size-array в спецификации GEN_BLOCK , должен быть одномерным целочисленным массивом, размер которого равен размеру соответствующего измерения массива процессоров, а сумма значений его элементов равна размеру распределяемого измерения.
• Массив block-weight-array в спецификации WGT_BLOCK, должен быть одномерным массивом типа DOUBLE PRECISION.
• В одном списке dist-format-list не может быть указан формат GEN_BLOCK и формат WGT_BLOCK.
• Директива REDISTRIBUTE может применяться только к массивам со спецификацией DYNAMIC.
• Отсутствие dist-directive-stuff допустимо только в директиве DISTRIBUTE. В этом случае распределяемый массив может использоваться только после выполнения директивы REDISTRIBUTE.

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

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

• Переменной с атрибутом POINTER может быть присвоено только значение функции ALLOCATE или значение другой переменной с атрибутом POINTER.
• Количество измерений в левой и правой части оператора присваивания переменной с атрибутом POINTER должны совпадать.

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

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

• Длина списка align-source-list должна быть равна количеству измерений выравниваемого массива.
• Длина списка align-subscript-list должна быть равна количеству измерений базового массива align-target.
• Директива REALIGN может применяться только к массивам со спецификацией DYNAMIC.
• Отсутствие align-directive-stuff допустимо только в директиве ALIGN. В этом случае распределяемый массив может использоваться только после выполнения директивы REALIGN.

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

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

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

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

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

• NEW-переменные не могут быть распределенными массивами.

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

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

• Редукционными переменными не могут быть распределенные массивы.
• Редукционные переменные вычисляются и используются только в операторах определенного вида - редукционных операторах.

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

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

• Размер левой теневой грани (low-width) и размер правой теневой грани (high-width) должны быть целыми константными выражениями, значения которых больше или равны 0.
• Задание размера теневых граней как width эквивалентно заданию width : width.
• По умолчанию, распределенный массив имеет теневые грани шириной 1 с обеих сторон каждого распределенного измерения.

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

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

• Размер теневых граней, заполняемых значениями, не должен превышать максимального размера, описанного в директиве SHADOW.
• Если размеры теневых граней не указаны, то используются максимальные размеры.

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

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

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

• В каждой ссылке на массив может существовать зависимость по данным только по одному распределенному измерению.

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

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

• Директива SHADOW_START должна выполняться после директивы SHADOW_GROUP.
• Директива SHADOW_WAIT должна выполняться после директивы SHADOW_START.
• Новые значения в теневых гранях могут использоваться только после выполнения директивы SHADOW_WAIT.
• Директивы асинхронного обновления теневых граней не могут использоваться внутри параллельного цикла.

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

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

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

• Идентификатор, определенный этой директивой, может использоваться только в директивах REMOTE_ACCESS , PREFETCH и RESET.

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

• Повторное выполнение директивы PREFETCH является корректным только в том случае, когда характеристики группы удаленных ссылок (параметры циклов, распределения массивов и значения индексных выражений в удаленных ссылках) не меняются.
• Директиву PREFETCH можно выполнять для нескольких циклов (нескольких директив REMOTE_ACCESS), если между этими циклами не существует зависимости по данным для распределенных массивов, указанных в директивах REMOTE_ACCESS.

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

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

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

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

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

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

• До выполнения директивы REDUCTION_START редукционные переменные группы могут использоваться только в редукционных операторах параллельных циклов.
• Директива REDUCTION_START и REDUCTION_WAIT должны выполняться после окончания цикла (циклов), где вычислялись значения редукционных переменных. Между этими операторами могут выполняться только те операторы, в которых не используются значения редукционных переменных.
• Директива REDUCTION_WAIT уничтожает группу редукционных операций.

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

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

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

9. Процедуры

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

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

A x = b

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

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

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

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

x_i,j^new = (x_i-1,j^old + x_i,j-1^old + x_i+1,j^old + x_i,j+1^old ) / 4

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

x_i,j^new = ( w / 4 ) * (x_i-1,j^new + x_i,j-1^new + x_i+1,j^old + x_i,j+1^old ) + (1-w) * x_i,j^old

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

Пример 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	прямоугольная сетка разделена на две области

	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