fdvmLDe (1158420), страница 13
Текст из файла (страница 13)
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 areas
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 areas
C each area is separate 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 areas
INTEGER LP(NBL),HP(NBL),SIZE(2,NBL)
C distribution for two areas 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 area 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 area
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 area on two sub-areas M*(N2) и M* (N-N2)
DM(1) = M
KDM = 1
DN(1) = N/2
DN(2) = N - N2
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
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
