· В каждой ссылке на массив может существовать зависимость по данным только по одному распределенному измерению.
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 |
Ограничения.
· Директива SHADOW_START должна выполняться после директивы SHADOW_GROUP.
· Директива SHADOW_WAIT должна выполняться после директивы SHADOW_START.
· Новые значения в теневых гранях могут использоваться только после выполнения директивы SHADOW_WAIT.
· Директивы асинхронного обновления теневых граней не могут использоваться внутри параллельного цикла.
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 |
Ограничение:
· Идентификатор, определенный этой директивой, может использоваться только в директивах REMOTE_ACCESS, PREFETCH и RESET.
prefetch-directive | is PREFETCH remote-group-name |
reset-directive | is RESET remote-group-name |
Ограничения.
· Повторное выполнение директивы PREFETCH является корректным только в том случае, когда характеристики группы удаленных ссылок (параметры циклов, распределения массивов и значения индексных выражений в удаленных ссылках) не меняются.
· Директиву PREFETCH можно выполнять для нескольких циклов (нескольких директив REMOTE_ACCESS), если между этими циклами не существует зависимости по данным для распределенных массивов, указанных в директивах REMOTE_ACCESS.
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 |
Ограничения.
· До выполнения директивы REDUCTION_START редукционные переменные группы могут использоваться только в редукционных операторах параллельных циклов.
· Директива REDUCTION_START и REDUCTION_WAIT должны выполняться после окончания цикла (циклов), где вычислялись значения редукционных переменных. Между этими операторами могут выполняться только те операторы, в которых не используются значения редукционных переменных.
· Директива REDUCTION_WAIT уничтожает группу редукционных операций.
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 : число линейных уравнений
CDVM$ DISTRIBUTE A ( BLOCK, *)
CDVM$ 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 переменная 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 переменная 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 |
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 Тест следующих конструкций 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
DN(1) = DN
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
|
Из за большого объема этот материал размещен на нескольких страницах:
1 2 3 4 5 6 7 8 9 10 |
