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

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

@@ -2,10 +2,11 @@
! 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 :: B(:,:),B1(:,:),B2(:,:)
INTEGER LP(2),HP(2)
REAL,ALLOCATABLE :: B(:,:),B1(:,:),B2(:,:),B_1(:,:),B_2(:,:)
INTEGER LP(2),HP(2), ERRT1, ERRT2
CHARACTER*8:: TNAME='taskst11'
!DVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( ))
!DVM$ TASK MB( 2 )
!DVM$ DISTRIBUTE A(*,BLOCK) ONTO P
@@ -14,7 +15,7 @@
!DVM$ ALIGN B2( I, J ) WITH A2( I, J )
!DVM$ DISTRIBUTE :: A1, A2
PRINT *, '===== START OF taskst11 ========='
PRINT *, '===START OF taskst11 ====================='
CALL DPT(LP,HP,2)
!DVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) )
ALLOCATE(A1(N1+1,K))
@@ -24,7 +25,7 @@
ALLOCATE(A2(N2+1,K))
!DVM$ REDISTRIBUTE A2( *, BLOCK ) ONTO MB( 2 )
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
!DVM$ TASK_REGION MB
!DVM$ ON MB(1)
@@ -153,32 +154,54 @@
ENDDO
!DVM$ END REGION
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
!DVM$ PARALLEL (I,J) ON B1(I,J),REMOTE_ACCESS (B(I,J))
DO I = 2,N1
DO J = 2, K-1
IF(B1(I,J).NE.B(I,J)) THEN
PRINT *, ' taskst11 - ***error B1(',I,',',J,')'
print *, '=== END OF taskst11 =============='
STOP
ENDIF
B_1(I,J) = B(I,J)
ENDDO
ENDDO
!DVM$ PARALLEL (I,J) ON B2(I,J),REMOTE_ACCESS (B(I+(N1-1),J))
DO I = 2,N2
DO J = 2, K-1
IF(B2(I,J).NE.B(I+(N1-1),J)) THEN
PRINT *, ' taskst11 - ***error B2(',I,',',J,')',
* 'B(',I+N1-1,',',J,')'
print *, '=== END OF taskst11 =============='
STOP
B_2(I,J) = B(I+(N1-1),J)
ENDDO
ENDDO
!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
ENDDO
ENDDO
PRINT *, ' taskst11 - complete'
print *, '=== END OF taskst11 ====================='
DEALLOCATE (B,B1,B2,A,A1,A2)
!DVM$ END ON
!DVM$ ON MB(2)
!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
SUBROUTINE DPT(LP,HP,NT)
@@ -201,3 +224,13 @@
END IF
!DVM$ ENDDEBUG 1
END
C -------------------------------------------------
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/taskst12.fdv
View File

@@ -2,18 +2,20 @@
! 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 :: B(:,:),B1(:,:),B2(:,:)
INTEGER,DIMENSION(2) :: LP,HP
INTEGER :: ERRT
CHARACTER*8:: TNAME='taskst12'
CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( ))
CDVM$ TASK MB( 2 )
CDVM$ DISTRIBUTE A(*,BLOCK)
CDVM$ ALIGN B( I, J ) WITH A( I, J )
CDVM$ DISTRIBUTE :: A1, A2
CDVM$ ALIGN :: B1,B2
PRINT *, '======== START OF taskst12 =========='
CDVM$ ALIGN :: B1,B2
PRINT *, '===START OF taskst12 ====================='
CALL DPT(LP,HP,2)
CDVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) )
ALLOCATE(A1(N1+1,K))
@@ -69,16 +71,8 @@ CDVM$ REALIGN B2( I, J ) WITH A2( I, J )
! exchange bounds
!DVM$ GET_ACTUAL (B2(2,:),B1(N1, :))
!DVM$ PARALLEL ( J ) ON A1(N1+1, J),
!DVM$* REMOTE_ACCESS (B2( 2, J ) )
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
A1(N1+1,:) = B2(2, :)
A2(1, :) = B1(N1, :)
!DVM$ ACTUAL (A2(1, :),A1(N1+1,:))
!DVM$ TASK_REGION MB
!DVM$ ON MB( 1 )
@@ -157,32 +151,28 @@ CDVM$ REALIGN B2( I, J ) WITH A2( I, J )
ENDDO
!DVM$ END REGION
ENDDO
!DVM$ GET_ACTUAL (B,B1,B2)
!DVM$ GET_ACTUAL (B,B1,B2)
! compare 2-task JACOBI with 1-task JACOBI
!DVM$ PARALLEL (I,J) ON B1(I,J),REMOTE_ACCESS (B(I,J))
DO I = 2,N1
A(2:N1,:) = B1(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
IF(B1(I,J).NE.B(I,J)) THEN
PRINT *, ' taskst12- ***error B1(',I,',',J,')'
print *, '=== END OF taskst12 =============='
STOP
IF(A(I,J) .NE. B(I,J)) THEN
ERRT = MIN(ERRT,I)
ENDIF
ENDDO
ENDDO
!DVM$ PARALLEL (I,J) ON B2(I,J),REMOTE_ACCESS (B(I+(N1-1),J))
DO I = 2,N2
DO J = 2, K-1
IF(B2(I,J).NE.B(I+(N1-1),J)) THEN
PRINT *, ' taskst12 - ***error B2(',I,',',J,')',
* 'B(',I+N1-1,',',J,')'
print *, '=== END OF taskst12 =============='
STOP
ENDIF
ENDDO
ENDDO
PRINT *, ' taskst12 - complete'
print *, '=== END OF taskst12 ====================='
IF (ERRT .EQ. ER) THEN
CALL ANSYES(TNAME)
ELSE
CALL ANSNO(TNAME)
ENDIF
DEALLOCATE (B,B1,B2,A,A1,A2)
PRINT *, '=== END OF taskst12 ====================='
END
SUBROUTINE DPT(LP,HP,NT)
@@ -205,3 +195,13 @@ CDVM$ REALIGN B2( I, J ) WITH A2( I, J )
END IF
!DVM$ ENDDEBUG 1
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
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 :: 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$ task mb( 2 )
@@ -12,8 +13,7 @@ program taskst21
!dvm$ distribute :: a1, a2
!dvm$ align b1( i, j, ii ) with a1( 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 )
!dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), : )
allocate( a1( n1 + 1, k, k ) )
@@ -65,7 +65,7 @@ program taskst21
enddo
!dvm$ end region
!dvm$ end on
!dvm$ end task_region
!dvm$ end task_region
do it = 1, itmax
!exchange bounds
@@ -176,34 +176,25 @@ program taskst21
! compare 2 - task jacobi with 1 - task jacobi
!dvm$ get_actual(b,b1,b2)
!dvm$ parallel ( i, j, ii ) on b1( i, j, ii ), remote_access ( b( i, j, ii ) )
do i = 2, n1
a(2:n1,:,:) = b1(2:n1,:,:)
a(n1+1:n1+n2-1,:,:) = b2(2:n2,:,:)
errt = er
!dvm$ parallel ( ii, j, i ) on b( i, j, ii ), reduction(min(errt))
do ii = 2, k - 1
do j = 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
do i = 2, k - 1
if(a( i, j, ii ) .ne. b( i, j, ii )) errt = min(errt, i)
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 ii = 2, k - 1
if( b2( i, j, ii ) .ne. b( i + ( n1 - 1 ), j, ii ) ) then
print *, 'taskst21 - ***error b2( ', i, ', ', j, ', ', ii, ' )', '( ', i + n1 - 1, ', ', j, ', ', ii, ' )'
print *, '=== END OF taskst21 =============='
stop
endif
enddo
enddo
enddo
print *, 'taskst21 - complete'
print *, '=== END OF taskst21 ====================='
if (errt .eq. er) then
call ansyes(tname)
else
call ansno (tname)
endif
deallocate(b,b1,b2,a,a1,a2)
print *, '=== END OF taskst21 ====================='
end
subroutine dpt( lp, hp, nt )
@@ -227,3 +218,12 @@ subroutine dpt( lp, hp, nt )
!dvm$ enddebug 1
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
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 :: b( :, :, : ), b1( :, :, : ), b2( :, :, : )
integer, dimension( 2 ) :: lp, hp
integer :: errt
character*8 :: tname = 'taskst22'
!dvm$ processors p( processors_size( 1 ), processors_size( 2 ) )
!dvm$ task mb( 2 )
@@ -11,8 +13,7 @@ program taskst22
!dvm$ distribute :: a1, a2
!dvm$ align :: b1, b2
print *, '====== START OF taskst22 =========='
print *, '===START OF taskst22 ====================='
call dpt( lp, hp, 2 )
!dvm$ map mb( 1 ) onto p( lp( 1 ) : hp( 1 ), : )
allocate( a1( n1 + 1, k, k ) )
@@ -71,19 +72,8 @@ program taskst22
do it = 1, itmax
!exchange bounds
!dvm$ get_actual(b2( 2, :, : ),b1( n1, :, : ))
!dvm$ parallel ( ii, j ) on a1( n1 + 1, j, ii ), remote_access ( b2( 2, j, ii ) )
do ii = 1, k
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
a1( n1 + 1, :, : ) = b2( 2, :, : )
a2( 1, :, : ) = b1( n1, :, : )
!dvm$ actual(a1( n1 + 1, :, : ),a2( 1, :, : ))
!dvm$ task_region mb
!dvm$ on mb( 1 )
@@ -177,36 +167,28 @@ program taskst22
! compare 2 - task jacobi with 1 - task jacobi
!dvm$ get_actual(b,b1,b2)
!dvm$ parallel ( i, j, ii ) on b1( i, j, ii ), remote_access ( b( i, j, ii ) )
do i = 2, n1
a(2:n1,:,:) = b1(2:n1,:,:)
a(n1+1:n1+n2-1,:,:) = b2(2:n2,:,:)
errt = er
!dvm$ parallel ( ii, j, i ) on b( i, j, ii ), reduction(min(errt))
do ii = 2, k - 1
do j = 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
do i = 2, k - 1
if(a( i, j, ii ) .ne. b( i, j, ii )) errt = min(errt, i)
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 ii = 2, k - 1
if( b2( i, j, ii ) .ne. b( i + ( n1 - 1 ), j, ii ) ) then
print *, 'taskst22 - ***error b2( ', i, ', ', j, ', ', ii, ' )', '( ', i + n1 - 1, ', ', j, ', ', ii, ' )'
print *, '=== END OF taskst22 =============='
stop
endif
enddo
enddo
enddo
print *, 'taskst22 - complete'
print *, '=== END OF taskst22 ====================='
deallocate(b,b1,b2,a,a1,a2)
if (errt .eq. er) then
call ansyes(tname)
else
call ansno (tname)
endif
deallocate(b,b1,b2,a,a1,a2)
print *, '=== END OF taskst22 ====================='
end
subroutine dpt( lp, hp, nt )
!distributing processors for nt tasks ( nt = 2 )
integer lp( 2 ), hp( 2 )
@@ -228,3 +210,12 @@ subroutine dpt( lp, hp, nt )
!dvm$ enddebug 1
end
subroutine ansyes(name)
character*8 name
print *, name, ' - complete'
end
subroutine ansno(name)
character*8 name
print *, name, ' - ***error'
end

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

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

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

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