fdvmLDe (1158336), страница 14

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

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

CDVM$ END ON

CDVM$ END TASK_REGION

2 CONTINUE

PRINT *, 'A1 '

PRINT *, A1

PRINT *, 'A2 '

PRINT *, A2

END

SUBROUTINE DPT( LP, HP, NT )

C processor distribution for NT tasks (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

Example 7. Dynamic tasks (task loop)

PROGRAM MULTIBLOCK

C Model of multi-block task.

C The number of blocks, size of each block,

C external and internal edges

C are defined during program execution.

C Test of following FDVM constructs: dynamic arrays,

C dynamic tasks, asynchronous REMOTE_ACCESS for dynamic

C arrays (formal arguments)

*DVM$ PROCESSORS MBC100( NUMBER_OF_PROCESSORS( ) )

PARAMETER (M = 8, N =8, NTST = 1)

C MXSIZE – dynamic memory size

C MXBL – maximal number of blocks

PARAMETER ( MXS=10000 )

PARAMETER ( MXBL=2 )

C HEAP – dynamic memory

REAL HEAP(MXS)

C PA,PB – arrays of pointers for dynamic arrays

C PA(I),PB(I) – function value on previous and current step

C in I-th block

*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) – sizes of dimensions of I-th block

INTEGER SIZE( 2, MXBL ) , ALLOCATE

C TINB( :,I ) – table of internal edges of I-th block

C TINB( 1,I ) - - the number of edges (from 1 till 4)

C TINB( 2,I ) = J - adjacent block number

C TINB( 3,I ),TINB( 4,I ) - edges of one-dimensional section

C TINB( 5,I ) - dimension number in I-th block (1 or 2)

C TINB( 6,I ) - dimension coordinate in I-th block

C TINB( 7,I ) - dimension number in J-th block (1 or 2)

C TINB( 8,I ) - dimension coordinate in J-th block

INTEGER TINB( 29, MXBL )

C TEXB( :,I ) – table of external edges of I-th block

C TEXB( 1,I ) - (от 1 до 4) edges amount (from 1 to 4)

C TEXB( 2,I ),TEXB( 3,I ) - coordinates of one-dimensional array

C section for 1-th edge

C TEXB( 4,I ) - dimension number (1 or 2)

C TEXB( 5,I ) - coordinate of given dimension

INTEGER TEXB(17,MXBL)

C NBL - the number of blocks

C NTST – the number of steps

INTEGER NBL, NTST

C IDM – pointer to free dynamic memory

INTEGER IDM

COMMON IDM,MXSIZE

C postponed distribution of arrays on each block

*DVM$ DISTRIBUTE :: PA, P1

*DVM$ ALIGN :: PB, P2

C task array

*DVM$ TASK TSA ( MXBL )

C name of group exchange of internal edges

*DVM$ REMOTE_GROUP GRINB

C LP( I ), HP( I ) – edges of processor array section of I-th block

INTEGER LP(MXBL), HP(MXBL)

C TGLOB( :, I ) – table of global coordinates

C in Jacobi algorithm grid for I-th block

C TGLOB( 1, I ) – 1-th dimension coordinate

C TGLOB( 2, I ) – 2-th dimension coordinate

INTEGER TGLOB(2,MXBL)

MXSIZE = MXS

C subdividing M*N block on sub-blocks

CALL DISDOM(NBL,TGLOB,TEXB,TINB,SIZE,M,N,MXBL)

C Dividing processor array on blocks

CALL MPROC(LP,HP,SIZE,NBL)

C Distribution of tasks (blocks) over processors.

C Array distribution over tasks

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 External edge initialization

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 Initialization of blocks

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 Iteration loop

DO 30 IT = 1, NTST

C surpassed pumping of buffers for internal edges

*DVM$ PREFETCH GRINB

C value calculation on internal edges

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 value calculation inside blocks

C each block is a task

*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 end of iterations

C output of array values

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 dynamic array distribution for sequential execution

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 value calculation on internal edges

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 processor distribution over blocks

INTEGER LP(NBL),HP(NBL),SIZE(2,NBL)

C distribution for two blocks 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 external edge initialization

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 block initialization

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 print data for IB block

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 subdividing M*N block on two sub-blocks M*(N2) and 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 producing tables (graphs) of external and internal edges

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

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

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