Alexander_KS/SAPFOR
4
2
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

first step of shadow fixing

Browse Source
This commit is contained in:
ALEXks
2025-02-20 19:52:32 +03:00
committed by Dudarenko
parent 68d2f3253c
commit 26fe1d3f61
11 changed files with 240 additions and 217 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
dvm/fdvm/trunk/fdvm/dvm.cpp
View File

@@ -9992,7 +9992,7 @@ void RemoteVariableList(SgSymbol *group, SgExpression *rml, SgStatement *stmt)
} }
InsertNewStatementAfter(D_RmBuf( HeaderRef(el->lhs()->symbol()),GetAddresDVM( header_rf(ar,ibuf,1)),n,ideb),cur_st,cur_st->controlParent()); InsertNewStatementAfter(D_RmBuf( HeaderRef(el->lhs()->symbol()),GetAddresDVM( header_rf(ar,ibuf,1)),n,ideb),cur_st,cur_st->controlParent());
} }
SET_DVM(iaxis); //SET_DVM(iaxis); //11.02.25
} }
if(group) { if(group) {

69
dvm/tools/tester/trunk/test-suite/Correctness/Fortran/TASK/taskst11.fdv
View File

@@ -2,10 +2,11 @@
! rectangular grid is distributed on two blocks ! rectangular grid is distributed on two blocks
! !
! !
PARAMETER (K=8, N1 = 4, ITMAX=20, N2 = K - N1 ) PARAMETER (K=8, N1 = 4, ITMAX=20, N2 = K-N1, ER = 10000)
REAL,ALLOCATABLE :: A(:,:),A1(:,:),A2(:,:) REAL,ALLOCATABLE :: A(:,:),A1(:,:),A2(:,:)
REAL,ALLOCATABLE :: B(:,:),B1(:,:),B2(:,:) REAL,ALLOCATABLE :: B(:,:),B1(:,:),B2(:,:),B_1(:,:),B_2(:,:)
INTEGER LP(2),HP(2) INTEGER LP(2),HP(2), ERRT1, ERRT2
CHARACTER*8:: TNAME='taskst11'
!DVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( )) !DVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( ))
!DVM$ TASK MB( 2 ) !DVM$ TASK MB( 2 )
!DVM$ DISTRIBUTE A(*,BLOCK) ONTO P !DVM$ DISTRIBUTE A(*,BLOCK) ONTO P
@@ -14,7 +15,7 @@
!DVM$ ALIGN B2( I, J ) WITH A2( I, J ) !DVM$ ALIGN B2( I, J ) WITH A2( I, J )
!DVM$ DISTRIBUTE :: A1, A2 !DVM$ DISTRIBUTE :: A1, A2
PRINT *, '===== START OF taskst11 =========' PRINT *, '===START OF taskst11 ====================='
CALL DPT(LP,HP,2) CALL DPT(LP,HP,2)
!DVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) ) !DVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) )
ALLOCATE(A1(N1+1,K)) ALLOCATE(A1(N1+1,K))
@@ -24,7 +25,7 @@
ALLOCATE(A2(N2+1,K)) ALLOCATE(A2(N2+1,K))
!DVM$ REDISTRIBUTE A2( *, BLOCK ) ONTO MB( 2 ) !DVM$ REDISTRIBUTE A2( *, BLOCK ) ONTO MB( 2 )
ALLOCATE(B2(N2+1,K)) ALLOCATE(B2(N2+1,K))
ALLOCATE(A(K,K),B(K,K)) ALLOCATE(A(K,K),B(K,K),B_1(K,K),B_2(K,K))
! Initialization ! Initialization
!DVM$ TASK_REGION MB !DVM$ TASK_REGION MB
!DVM$ ON MB(1) !DVM$ ON MB(1)
@@ -154,31 +155,53 @@
!DVM$ END REGION !DVM$ END REGION
ENDDO ENDDO
!DVM$ GET_ACTUAL (B,B1,B2) !DVM$ GET_ACTUAL (B,B1,B2)
ERRT1 = ER
ERRT2 = ER
! compare 2-task JACOBI with 1-task JACOBI ! compare 2-task JACOBI with 1-task JACOBI
!DVM$ PARALLEL (I,J) ON B1(I,J),REMOTE_ACCESS (B(I,J)) !DVM$ PARALLEL (I,J) ON B1(I,J),REMOTE_ACCESS (B(I,J))
DO I = 2,N1 DO I = 2,N1
DO J = 2, K-1 DO J = 2, K-1
IF(B1(I,J).NE.B(I,J)) THEN B_1(I,J) = B(I,J)
PRINT *, ' taskst11 - ***error B1(',I,',',J,')'
print *, '=== END OF taskst11 =============='
STOP
ENDIF
ENDDO ENDDO
ENDDO ENDDO
!DVM$ PARALLEL (I,J) ON B2(I,J),REMOTE_ACCESS (B(I+(N1-1),J)) !DVM$ PARALLEL (I,J) ON B2(I,J),REMOTE_ACCESS (B(I+(N1-1),J))
DO I = 2,N2 DO I = 2,N2
DO J = 2, K-1 DO J = 2, K-1
IF(B2(I,J).NE.B(I+(N1-1),J)) THEN B_2(I,J) = B(I+(N1-1),J)
PRINT *, ' taskst11 - ***error B2(',I,',',J,')', ENDDO
* 'B(',I+N1-1,',',J,')' ENDDO
print *, '=== END OF taskst11 =============='
STOP !DVM$ TASK_REGION MB
!DVM$ ON MB(1)
!DVM$ PARALLEL (I,J) ON B1(I,J), REDUCTION(MIN(ERRT1))
DO I = 2,N1
DO J = 2, K-1
IF(B1(I,J).NE.B_1(I,J)) THEN
ERRT1 = MIN(ERRT1, I)
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
PRINT *, ' taskst11 - complete' !DVM$ END ON
print *, '=== END OF taskst11 =====================' !DVM$ ON MB(2)
DEALLOCATE (B,B1,B2,A,A1,A2) !DVM$ PARALLEL (I,J) ON B2(I,J), REDUCTION(MIN(ERRT2))
DO I = 2,N2
DO J = 2, K-1
IF(B2(I,J).NE.B_2(I,J)) THEN
ERRT2 = MIN(ERRT2, I)
ENDIF
ENDDO
ENDDO
!DVM$ END ON
!DVM$ END TASK_REGION
!DVM$ GET_ACTUAL(ERRT1,ERRT2)
IF (ERRT1 .EQ. ER .AND. ERRT2 .EQ. ER) THEN
CALL ANSYES(TNAME)
ELSE
CALL ANSNO (TNAME)
ENDIF
DEALLOCATE (B,B_1,B_2,B1,B2,A,A1,A2)
PRINT *, '=== END OF taskst11 ======================'
END END
SUBROUTINE DPT(LP,HP,NT) SUBROUTINE DPT(LP,HP,NT)
@@ -201,3 +224,13 @@
END IF END IF
!DVM$ ENDDEBUG 1 !DVM$ ENDDEBUG 1
END END
C -------------------------------------------------
SUBROUTINE ANSYES(NAME)
CHARACTER*8 NAME
PRINT *, NAME, ' - complete'
END
SUBROUTINE ANSNO (NAME)
CHARACTER*8 NAME
PRINT *, NAME, ' - ***error'
END

60
dvm/tools/tester/trunk/test-suite/Correctness/Fortran/TASK/taskst12.fdv
View File

@@ -2,10 +2,12 @@
! rectangular grid is distributed on two blocks ! rectangular grid is distributed on two blocks
! !
! !
INTEGER,PARAMETER :: K=8, N1 = 4, ITMAX=20, N2 = K - N1 INTEGER,PARAMETER :: K=8, N1=4, ITMAX=20, N2=K-N1, ER=10000
REAL,ALLOCATABLE :: A(:,:),A1(:,:),A2(:,:) REAL,ALLOCATABLE :: A(:,:),A1(:,:),A2(:,:)
REAL,ALLOCATABLE :: B(:,:),B1(:,:),B2(:,:) REAL,ALLOCATABLE :: B(:,:),B1(:,:),B2(:,:)
INTEGER,DIMENSION(2) :: LP,HP INTEGER,DIMENSION(2) :: LP,HP
INTEGER :: ERRT
CHARACTER*8:: TNAME='taskst12'
CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( )) CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( ))
CDVM$ TASK MB( 2 ) CDVM$ TASK MB( 2 )
CDVM$ DISTRIBUTE A(*,BLOCK) CDVM$ DISTRIBUTE A(*,BLOCK)
@@ -13,7 +15,7 @@ CDVM$ ALIGN B( I, J ) WITH A( I, J )
CDVM$ DISTRIBUTE :: A1, A2 CDVM$ DISTRIBUTE :: A1, A2
CDVM$ ALIGN :: B1,B2 CDVM$ ALIGN :: B1,B2
PRINT *, '======== START OF taskst12 ==========' PRINT *, '===START OF taskst12 ====================='
CALL DPT(LP,HP,2) CALL DPT(LP,HP,2)
CDVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) ) CDVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) )
ALLOCATE(A1(N1+1,K)) ALLOCATE(A1(N1+1,K))
@@ -69,16 +71,8 @@ CDVM$ REALIGN B2( I, J ) WITH A2( I, J )
! exchange bounds ! exchange bounds
!DVM$ GET_ACTUAL (B2(2,:),B1(N1, :)) !DVM$ GET_ACTUAL (B2(2,:),B1(N1, :))
!DVM$ PARALLEL ( J ) ON A1(N1+1, J), A1(N1+1,:) = B2(2, :)
!DVM$* REMOTE_ACCESS (B2( 2, J ) ) A2(1, :) = B1(N1, :)
DO J = 1, K
A1(N1+1, J) = B2(2, J)
ENDDO
!DVM$ PARALLEL ( J ) ON A2( 1, J),
!DVM$* REMOTE_ACCESS (B1( N1, J ) )
DO J = 1, K
A2(1, J) = B1(N1, J)
ENDDO
!DVM$ ACTUAL (A2(1, :),A1(N1+1,:)) !DVM$ ACTUAL (A2(1, :),A1(N1+1,:))
!DVM$ TASK_REGION MB !DVM$ TASK_REGION MB
!DVM$ ON MB( 1 ) !DVM$ ON MB( 1 )
@@ -159,30 +153,26 @@ CDVM$ REALIGN B2( I, J ) WITH A2( I, J )
ENDDO ENDDO
!DVM$ GET_ACTUAL (B,B1,B2) !DVM$ GET_ACTUAL (B,B1,B2)
! compare 2-task JACOBI with 1-task JACOBI ! compare 2-task JACOBI with 1-task JACOBI
!DVM$ PARALLEL (I,J) ON B1(I,J),REMOTE_ACCESS (B(I,J)) A(2:N1,:) = B1(2:N1,:)
DO I = 2,N1 A(N1+1:N1+N2-1,:) = B2(2:N2,:)
ERRT = ER
!DVM$ PARALLEL (I,J) ON B(I,J), REDUCTION(MIN(ERRT))
DO I = 2, K-1
DO J = 2, K-1 DO J = 2, K-1
IF(B1(I,J).NE.B(I,J)) THEN IF(A(I,J) .NE. B(I,J)) THEN
PRINT *, ' taskst12- ***error B1(',I,',',J,')' ERRT = MIN(ERRT,I)
print *, '=== END OF taskst12 =============='
STOP
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
!DVM$ PARALLEL (I,J) ON B2(I,J),REMOTE_ACCESS (B(I+(N1-1),J)) IF (ERRT .EQ. ER) THEN
DO I = 2,N2 CALL ANSYES(TNAME)
DO J = 2, K-1 ELSE
IF(B2(I,J).NE.B(I+(N1-1),J)) THEN CALL ANSNO(TNAME)
PRINT *, ' taskst12 - ***error B2(',I,',',J,')',
* 'B(',I+N1-1,',',J,')'
print *, '=== END OF taskst12 =============='
STOP
ENDIF ENDIF
ENDDO
ENDDO
PRINT *, ' taskst12 - complete'
print *, '=== END OF taskst12 ====================='
DEALLOCATE (B,B1,B2,A,A1,A2) DEALLOCATE (B,B1,B2,A,A1,A2)
PRINT *, '=== END OF taskst12 ====================='
END END
SUBROUTINE DPT(LP,HP,NT) SUBROUTINE DPT(LP,HP,NT)
@@ -205,3 +195,13 @@ CDVM$ REALIGN B2( I, J ) WITH A2( I, J )
END IF END IF
!DVM$ ENDDEBUG 1 !DVM$ ENDDEBUG 1
END END
C -------------------------------------------------
SUBROUTINE ANSYES(NAME)
CHARACTER*8 NAME
PRINT *, NAME, ' - complete'
END
SUBROUTINE ANSNO (NAME)
CHARACTER*8 NAME
PRINT *, NAME, ' - ***error'
END

56
dvm/tools/tester/trunk/test-suite/Correctness/Fortran/TASK/taskst21.f90
View File

@@ -1,8 +1,9 @@
program taskst21 program taskst21
integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1 integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1, er = 10000
real, allocatable :: a( :, :, : ), a1( :, :, : ), a2( :, :, : ) real, allocatable :: a( :, :, : ), a1( :, :, : ), a2( :, :, : )
real, allocatable :: b( :, :, : ), b1( :, :, : ), b2( :, :, : ) real, allocatable :: b( :, :, : ), b1( :, :, : ), b2( :, :, : )
integer lp( 2 ), hp( 2 ) integer lp( 2 ), hp( 2 ), errt
character*8 :: tname = 'taskst21'
!dvm$ processors p( processors_size( 1 ), processors_size( 2 ) ) !dvm$ processors p( processors_size( 1 ), processors_size( 2 ) )
!dvm$ task mb( 2 ) !dvm$ task mb( 2 )
@@ -12,8 +13,7 @@ program taskst21
!dvm$ distribute :: a1, a2 !dvm$ distribute :: a1, a2
!dvm$ align b1( i, j, ii ) with a1( i, j, ii ) !dvm$ align b1( i, j, ii ) with a1( i, j, ii )
!dvm$ align b2( i, j, ii ) with a2( i, j, ii ) !dvm$ align b2( i, j, ii ) with a2( i, j, ii )
print *, '===START OF taskst21 ====================='
print *, '====== START OF taskst21 ========'
call dpt( lp, hp, 2 ) call dpt( lp, hp, 2 )
!dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), : ) !dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), : )
allocate( a1( n1 + 1, k, k ) ) allocate( a1( n1 + 1, k, k ) )
@@ -176,34 +176,25 @@ program taskst21
! compare 2 - task jacobi with 1 - task jacobi ! compare 2 - task jacobi with 1 - task jacobi
!dvm$ get_actual(b,b1,b2) !dvm$ get_actual(b,b1,b2)
!dvm$ parallel ( i, j, ii ) on b1( i, j, ii ), remote_access ( b( i, j, ii ) ) a(2:n1,:,:) = b1(2:n1,:,:)
do i = 2, n1 a(n1+1:n1+n2-1,:,:) = b2(2:n2,:,:)
do j = 2, k - 1 errt = er
!dvm$ parallel ( ii, j, i ) on b( i, j, ii ), reduction(min(errt))
do ii = 2, k - 1 do ii = 2, k - 1
if( b1( i, j, ii ) .ne. b( i, j, ii ) ) then
print *, 'taskst21 - ***error b1( ', i, ', ', j, ', ', ii, ' )'
print *, '=== END OF taskst21 =============='
stop
endif
enddo
enddo
enddo
!dvm$ parallel ( i, j, ii ) on b2( i, j, ii ), remote_access ( b( i + ( n1 - 1 ), j, ii ) )
do i = 2, n2
do j = 2, k - 1 do j = 2, k - 1
do ii = 2, k - 1 do i = 2, k - 1
if( b2( i, j, ii ) .ne. b( i + ( n1 - 1 ), j, ii ) ) then if(a( i, j, ii ) .ne. b( i, j, ii )) errt = min(errt, i)
print *, 'taskst21 - ***error b2( ', i, ', ', j, ', ', ii, ' )', '( ', i + n1 - 1, ', ', j, ', ', ii, ' )' enddo
print *, '=== END OF taskst21 ==============' enddo
stop enddo
if (errt .eq. er) then
call ansyes(tname)
else
call ansno (tname)
endif endif
enddo
enddo
enddo
print *, 'taskst21 - complete'
print *, '=== END OF taskst21 ====================='
deallocate(b,b1,b2,a,a1,a2) deallocate(b,b1,b2,a,a1,a2)
print *, '=== END OF taskst21 ====================='
end end
subroutine dpt( lp, hp, nt ) subroutine dpt( lp, hp, nt )
@@ -227,3 +218,12 @@ subroutine dpt( lp, hp, nt )
!dvm$ enddebug 1 !dvm$ enddebug 1
end end
subroutine ansyes(name)
character*8 name
print *, name, ' - complete'
end
subroutine ansno(name)
character*8 name
print *, name, ' - ***error'
end

71
dvm/tools/tester/trunk/test-suite/Correctness/Fortran/TASK/taskst22.f90
View File

@@ -1,8 +1,10 @@
program taskst22 program taskst22
integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1 integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1, er = 10000
real, allocatable :: a( :, :, : ), a1( :, :, : ), a2( :, :, : ) real, allocatable :: a( :, :, : ), a1( :, :, : ), a2( :, :, : )
real, allocatable :: b( :, :, : ), b1( :, :, : ), b2( :, :, : ) real, allocatable :: b( :, :, : ), b1( :, :, : ), b2( :, :, : )
integer, dimension( 2 ) :: lp, hp integer, dimension( 2 ) :: lp, hp
integer :: errt
character*8 :: tname = 'taskst22'
!dvm$ processors p( processors_size( 1 ), processors_size( 2 ) ) !dvm$ processors p( processors_size( 1 ), processors_size( 2 ) )
!dvm$ task mb( 2 ) !dvm$ task mb( 2 )
@@ -11,8 +13,7 @@ program taskst22
!dvm$ distribute :: a1, a2 !dvm$ distribute :: a1, a2
!dvm$ align :: b1, b2 !dvm$ align :: b1, b2
print *, '===START OF taskst22 ====================='
print *, '====== START OF taskst22 =========='
call dpt( lp, hp, 2 ) call dpt( lp, hp, 2 )
!dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), : ) !dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), : )
allocate( a1( n1 + 1, k, k ) ) allocate( a1( n1 + 1, k, k ) )
@@ -71,19 +72,8 @@ program taskst22
do it = 1, itmax do it = 1, itmax
!exchange bounds !exchange bounds
!dvm$ get_actual(b2( 2, :, : ),b1( n1, :, : )) !dvm$ get_actual(b2( 2, :, : ),b1( n1, :, : ))
!dvm$ parallel ( ii, j ) on a1( n1 + 1, j, ii ), remote_access ( b2( 2, j, ii ) ) a1( n1 + 1, :, : ) = b2( 2, :, : )
do ii = 1, k a2( 1, :, : ) = b1( n1, :, : )
do j = 1, k
a1( n1 + 1, j, ii ) = b2( 2, j, ii )
enddo
enddo
!dvm$ parallel ( ii, j ) on a2( 1, j, ii ), remote_access ( b1( n1, j, ii ) )
do ii = 1, k
do j = 1, k
a2( 1, j, ii ) = b1( n1, j, ii )
enddo
enddo
!dvm$ actual(a1( n1 + 1, :, : ),a2( 1, :, : )) !dvm$ actual(a1( n1 + 1, :, : ),a2( 1, :, : ))
!dvm$ task_region mb !dvm$ task_region mb
!dvm$ on mb( 1 ) !dvm$ on mb( 1 )
@@ -177,36 +167,28 @@ program taskst22
! compare 2 - task jacobi with 1 - task jacobi ! compare 2 - task jacobi with 1 - task jacobi
!dvm$ get_actual(b,b1,b2) !dvm$ get_actual(b,b1,b2)
!dvm$ parallel ( i, j, ii ) on b1( i, j, ii ), remote_access ( b( i, j, ii ) ) a(2:n1,:,:) = b1(2:n1,:,:)
do i = 2, n1 a(n1+1:n1+n2-1,:,:) = b2(2:n2,:,:)
do j = 2, k - 1 errt = er
!dvm$ parallel ( ii, j, i ) on b( i, j, ii ), reduction(min(errt))
do ii = 2, k - 1 do ii = 2, k - 1
if( b1( i, j, ii ) .ne. b( i, j, ii ) ) then
print *, 'taskst22 - ***error b1( ', i, ', ', j, ', ', ii, ' )'
print *, '=== END OF taskst22 =============='
stop
endif
enddo
enddo
enddo
!dvm$ parallel ( i, j, ii ) on b2( i, j, ii ), remote_access ( b( i + ( n1 - 1 ), j, ii ) )
do i = 2, n2
do j = 2, k - 1 do j = 2, k - 1
do ii = 2, k - 1 do i = 2, k - 1
if( b2( i, j, ii ) .ne. b( i + ( n1 - 1 ), j, ii ) ) then if(a( i, j, ii ) .ne. b( i, j, ii )) errt = min(errt, i)
print *, 'taskst22 - ***error b2( ', i, ', ', j, ', ', ii, ' )', '( ', i + n1 - 1, ', ', j, ', ', ii, ' )' enddo
print *, '=== END OF taskst22 ==============' enddo
stop enddo
if (errt .eq. er) then
call ansyes(tname)
else
call ansno (tname)
endif endif
enddo
enddo
enddo
print *, 'taskst22 - complete'
print *, '=== END OF taskst22 ====================='
deallocate(b,b1,b2,a,a1,a2) deallocate(b,b1,b2,a,a1,a2)
print *, '=== END OF taskst22 ====================='
end end
subroutine dpt( lp, hp, nt ) subroutine dpt( lp, hp, nt )
!distributing processors for nt tasks ( nt = 2 ) !distributing processors for nt tasks ( nt = 2 )
integer lp( 2 ), hp( 2 ) integer lp( 2 ), hp( 2 )
@@ -228,3 +210,12 @@ subroutine dpt( lp, hp, nt )
!dvm$ enddebug 1 !dvm$ enddebug 1
end end
subroutine ansyes(name)
character*8 name
print *, name, ' - complete'
end
subroutine ansno(name)
character*8 name
print *, name, ' - ***error'
end

68
dvm/tools/tester/trunk/test-suite/Correctness/Fortran/TASK/taskst31.f90
View File

@@ -1,8 +1,9 @@
program taskst31 program taskst31
integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1 integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1, er = 10000
real, allocatable :: a( :, :, :, : ), a1( :, :, :, : ), a2( :, :, :, : ) real, allocatable :: a( :, :, :, : ), a1( :, :, :, : ), a2( :, :, :, : )
real, allocatable :: b( :, :, :, : ), b1( :, :, :, : ), b2( :, :, :, : ) real, allocatable :: b( :, :, :, : ), b1( :, :, :, : ), b2( :, :, :, : )
integer lp( 2 ), hp( 2 ) integer lp( 2 ), hp( 2 ), errt
character*8 :: tname = 'taskst31'
!dvm$ processors p( processors_size( 1 ), processors_size( 2 ), processors_size( 3 ) ) !dvm$ processors p( processors_size( 1 ), processors_size( 2 ), processors_size( 3 ) )
!dvm$ task mb( 2 ) !dvm$ task mb( 2 )
@@ -13,8 +14,8 @@ program taskst31
!dvm$ align b1( i, j, ii, jj ) with a1( i, j, ii, jj ) !dvm$ align b1( i, j, ii, jj ) with a1( i, j, ii, jj )
!dvm$ align b2( i, j, ii, jj ) with a2( i, j, ii, jj ) !dvm$ align b2( i, j, ii, jj ) with a2( i, j, ii, jj )
print *, '===START OF taskst31 ====================='
print *, '======= START OF taskst31 ========='
call dpt( lp, hp, 2 ) call dpt( lp, hp, 2 )
!dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), :, : ) !dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), :, : )
allocate( a1( n1 + 1, k, k, k ) ) allocate( a1( n1 + 1, k, k, k ) )
@@ -81,8 +82,8 @@ program taskst31
do it = 1, itmax do it = 1, itmax
!DVM$ get_actual(b2(2,:,:,:))
!exchange bounds !exchange bounds
!dvm$ get_actual(b2(2,:,:,:))
!dvm$ parallel ( jj, ii, j ) on a1( n1 + 1, j, ii, jj ), remote_access ( b2( 2, j, ii, jj ) ) !dvm$ parallel ( jj, ii, j ) on a1( n1 + 1, j, ii, jj ), remote_access ( b2( 2, j, ii, jj ) )
do jj = 1, k do jj = 1, k
do ii = 1, k do ii = 1, k
@@ -212,40 +213,29 @@ program taskst31
enddo enddo
!dvm$ end region !dvm$ end region
enddo enddo
!dvm$ get_actual(b,b1,b2)
! compare 2 - task jacobi with 1 - task jacobi
!dvm$ parallel ( i, j, ii, jj ) on b1( i, j, ii, jj ), remote_access ( b( i, j, ii, jj ) )
do i = 2, n1
do j = 2, k - 1
do ii = 2, k - 1
do jj = 2, k - 1
if( b1( i, j, ii, jj ) .ne. b( i, j, ii, jj ) ) then
print *, 'taskst31 - ***error b1( ', i, ', ', j, ', ', ii, ', ', jj, ' )'
print *, '=== END OF taskst31 =============='
stop
endif
enddo
enddo
enddo
enddo
!dvm$ parallel ( i, j, ii, jj ) on b2( i, j, ii, jj ), remote_access ( b( i + ( n1 - 1 ), j, ii, jj ) ) ! compare 2 - task jacobi with 1 - task jacobi
do i = 2, n2 !dvm$ get_actual(b,b1,b2)
do j = 2, k - 1 a(2:n1,:,:,:) = b1(2:n1,:,:,:)
do ii = 2, k - 1 a(n1+1:n1+n2-1,:,:,:) = b2(2:n2,:,:,:)
errt = er
!dvm$ parallel ( jj, ii, j, i ) on b( i, j, ii, jj ), reduction(min(errt))
do jj = 2, k - 1 do jj = 2, k - 1
if( b2( i, j, ii, jj ) .ne. b( i + ( n1 - 1 ), j, ii, jj ) ) then do ii = 2, k - 1
print *, 'taskst31 - ***error b2( ', i, ', ', j, ', ', ii, ', ', jj, ' )', '( ', i + n1 - 1, ', ', j, ', ', ii, ', ', jj, ' )' do j = 2, k - 1
print *, '=== END OF taskst31 ==============' do i = 2, k - 1
stop if(a( i, j, ii, jj) .ne. b( i, j, ii, jj)) errt = min(errt, i)
enddo
enddo
enddo
enddo
if (errt .eq. er) then
call ansyes(tname)
else
call ansno (tname)
endif endif
enddo
enddo
enddo
enddo
print *, 'taskst31 - complete'
print *, '=== END OF taskst31 ====================='
deallocate(b,b1,b2,a,a1,a2) deallocate(b,b1,b2,a,a1,a2)
print *, '=== END OF taskst31 ====================='
end end
subroutine dpt( lp, hp, nt ) subroutine dpt( lp, hp, nt )
@@ -269,3 +259,13 @@ subroutine dpt( lp, hp, nt )
!dvm$ enddebug 1 !dvm$ enddebug 1
end end
subroutine ansyes(name)
character*8 name
print *, name, ' - complete'
end
subroutine ansno(name)
character*8 name
print *, name, ' - ***error'
end

83
dvm/tools/tester/trunk/test-suite/Correctness/Fortran/TASK/taskst32.f90
View File

@@ -1,8 +1,10 @@
program taskst32 program taskst32
integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1 integer, parameter :: k = 8, n1 = 4, itmax = 20, n2 = k - n1, er = 10000
real, allocatable :: a( :, :, :, : ), a1( :, :, :, : ), a2( :, :, :, : ) real, allocatable :: a( :, :, :, : ), a1( :, :, :, : ), a2( :, :, :, : )
real, allocatable :: b( :, :, :, : ), b1( :, :, :, : ), b2( :, :, :, : ) real, allocatable :: b( :, :, :, : ), b1( :, :, :, : ), b2( :, :, :, : )
integer lp( 2 ), hp( 2 ) integer lp( 2 ), hp( 2 )
integer errt
character*8 :: tname = 'taskst32'
!dvm$ processors p( processors_size( 1 ), processors_size( 2 ), processors_size( 3 ) ) !dvm$ processors p( processors_size( 1 ), processors_size( 2 ), processors_size( 3 ) )
!dvm$ task mb( 2 ) !dvm$ task mb( 2 )
@@ -11,8 +13,7 @@ program taskst32
!dvm$ distribute :: a1, a2 !dvm$ distribute :: a1, a2
!dvm$ align :: b1, b2 !dvm$ align :: b1, b2
print *, '===START OF taskst32 ====================='
print *, '======= START OF taskst32 ========='
call dpt( lp, hp, 2 ) call dpt( lp, hp, 2 )
!dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), :, : ) !dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), :, : )
allocate( a1( n1 + 1, k, k, k ) ) allocate( a1( n1 + 1, k, k, k ) )
@@ -80,27 +81,12 @@ program taskst32
!dvm$ end task_region !dvm$ end task_region
do it = 1, itmax do it = 1, itmax
!DVM$ get_actual(b2(2,:,:,:))
!exchange bounds !exchange bounds
!dvm$ parallel ( jj, ii, j ) on a1( n1 + 1, j, ii, jj ), remote_access ( b2( 2, j, ii, jj ) ) !dvm$ get_actual(b2(2,:,:,:))
do jj = 1, k a1( n1 + 1, :, :, : ) = b2( 2, :, :, : )
do ii = 1, k
do j = 1, k
a1( n1 + 1, j, ii, jj ) = b2( 2, j, ii, jj )
enddo
enddo
enddo
!dvm$ actual(a1(n1+1,:,:,:)) !dvm$ actual(a1(n1+1,:,:,:))
!dvm$ get_actual (b1(n1,:,:,:)) !dvm$ get_actual (b1(n1,:,:,:))
!dvm$ parallel ( jj, ii, j ) on a2( 1, j, ii, jj ), remote_access ( b1( n1, j, ii, jj ) ) a2( 1, :, :, : ) = b1( n1, :, :, : )
do jj = 1, k
do ii = 1, k
do j = 1, k
a2( 1, j, ii, jj ) = b1( n1, j, ii, jj )
enddo
enddo
enddo
!dvm$ actual(a2(1,:,:,:)) !dvm$ actual(a2(1,:,:,:))
!dvm$ task_region mb !dvm$ task_region mb
@@ -212,40 +198,28 @@ program taskst32
enddo enddo
!dvm$ end region !dvm$ end region
enddo enddo
!dvm$ get_actual(b,b1,b2)
! compare 2-task jacobi with 1-task jacobi ! compare 2-task jacobi with 1-task jacobi
!dvm$ parallel ( i, j, ii, jj ) on b1( i, j, ii, jj ), remote_access ( b( i, j, ii, jj ) ) !dvm$ get_actual(b,b1,b2)
do i = 2, n1 a(2:n1,:,:,:) = b1(2:n1,:,:,:)
do j = 2, k - 1 a(n1+1:n1+n2-1,:,:,:) = b2(2:n2,:,:,:)
do ii = 2, k - 1 errt = er
!dvm$ parallel ( jj, ii, j, i ) on b( i, j, ii, jj ), reduction(min(errt))
do jj = 2, k - 1 do jj = 2, k - 1
if( b1( i, j, ii, jj ) .ne. b( i, j, ii, jj ) ) then
print *, 'taskst32 - ***error b1( ', i, ', ', j, ', ', ii, ', ', jj, ' )'
print *, '=== END OF taskst32 =============='
stop
endif
enddo
enddo
enddo
enddo
!dvm$ parallel ( i, j, ii, jj ) on b2( i, j, ii, jj ), remote_access ( b( i + ( n1 - 1 ), j, ii, jj ) )
do i = 2, n2
do j = 2, k - 1
do ii = 2, k - 1 do ii = 2, k - 1
do jj = 2, k - 1 do j = 2, k - 1
if( b2( i, j, ii, jj ) .ne. b( i + ( n1 - 1 ), j, ii, jj ) ) then do i = 2, k - 1
print *, 'taskst32 - ***error b2( ', i, ', ', j, ', ', ii, ', ', jj, ' )', '( ', i + n1 - 1, ', ', j, ', ', ii, ', ', jj, ' )' if(a( i, j, ii, jj) .ne. b( i, j, ii, jj)) errt = min(errt, i)
print *, '=== END OF taskst32 ==============' enddo
stop enddo
enddo
enddo
if (errt .eq. er) then
call ansyes(tname)
else
call ansno (tname)
endif endif
enddo
enddo
enddo
enddo
print *, 'taskst32 - complete'
print *, '=== END OF taskst32 ====================='
deallocate(b,b1,b2,a,a1,a2) deallocate(b,b1,b2,a,a1,a2)
print *, '=== END OF taskst32 ====================='
end end
subroutine dpt( lp, hp, nt ) subroutine dpt( lp, hp, nt )
@@ -269,3 +243,12 @@ subroutine dpt( lp, hp, nt )
!dvm$ enddebug 1 !dvm$ enddebug 1
end end
subroutine ansyes(name)
character*8 name
print *, name, ' - complete'
end
subroutine ansno(name)
character*8 name
print *, name, ' - ***error'
end

18
sapfor/experts/Sapfor_2017/_src/DirectiveProcessing/shadow.cpp
View File

@@ -509,6 +509,22 @@ static vector<PrevNode> getPrev(ShadowNode* curr, const map<string, vector<FuncI
static bool isMoveValid(ShadowNode* moveTo, DIST::Array* array, const set<ShadowNode*>& allShadowNodes) static bool isMoveValid(ShadowNode* moveTo, DIST::Array* array, const set<ShadowNode*>& allShadowNodes)
{ {
if (array->GetLocation().first == DIST::l_MODULE)
{
auto func = moveTo->location.first->funcPointer;
bool checkOk = true;
try {
array->GetNameInLocationS(moveTo->location.first->funcPointer);
}
catch (...) {
checkOk = false;
}
if (!checkOk)
return false;
}
//check added //check added
for (auto& elem : moveTo->newShadows) for (auto& elem : moveTo->newShadows)
if (elem.first == array) if (elem.first == array)
@@ -779,8 +795,6 @@ static void replacingShadowNodes(FuncInfo* currF)
if (currSh.second.size() == 0) if (currSh.second.size() == 0)
continue; continue;
const ShadowElement& currElement = currSh.second[0]; const ShadowElement& currElement = currSh.second[0];
SgSymbol* s = (SgSymbol*)currArray->GetNameInLocationS(currF->funcPointer); SgSymbol* s = (SgSymbol*)currArray->GetNameInLocationS(currF->funcPointer);

4
sapfor/experts/Sapfor_2017/_src/Server/server.cpp
View File

@@ -105,7 +105,7 @@ void Sleep(int millisec) { usleep(millisec * 2000); }
*/ */
#define SERV "[SERVER]" #define SERV "[SERVER]"
static const char* VERSION = "10"; static const char* VERSION = "11";
static FILE* logFile = NULL; static FILE* logFile = NULL;
extern void __bst_create(const char* name); extern void __bst_create(const char* name);
@@ -586,7 +586,7 @@ int main(int argc, char** argv)
javaPort = getPort(serverJAVA); javaPort = getPort(serverJAVA);
__print_log(logFile, "done with port %d", javaPort); __print_log(logFile, "done with port %d", javaPort);
__print(SERV, "SOCKET PORT for SAPFOR %d, SOCKET PORT for Visualizer %d", sapforPort, javaPort); printf("SOCKET PORT for SAPFOR %d, SOCKET PORT for Visualizer %d\n", sapforPort, javaPort);
const int maxSize = 4096; const int maxSize = 4096;
char* buf = new char[maxSize + 1]; char* buf = new char[maxSize + 1];

4
sapfor/experts/Sapfor_2017/_src/Utils/module_utils.cpp
View File

@@ -331,8 +331,10 @@ SgSymbol* getNameInLocation(SgStatement* func, const string& varName, const stri
if (altNames.size() > 0) if (altNames.size() > 0)
return altNames.begin()->second; return altNames.begin()->second;
else else {
__spf_print(1, "%s %s %s\n", func->symbol()->identifier(), varName.c_str(), locName.c_str());
printInternalError(convertFileName(__FILE__).c_str(), __LINE__); printInternalError(convertFileName(__FILE__).c_str(), __LINE__);
}
return NULL; return NULL;
} }

2
sapfor/experts/Sapfor_2017/_src/Utils/version.h
View File

@@ -1,3 +1,3 @@
#pragma once #pragma once
#define VERSION_SPF "2392" #define VERSION_SPF "2393"