fdvmLDr (1158337), страница 15

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 15)

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(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

Характеристики

Список файлов учебной работы