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

finalyze moving

Browse Source
This commit is contained in:
Alexander
2025-03-12 14:28:04 +03:00
committed by Dudarenko
parent de4690513b
commit 189374274e
776 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
tests/inliner/alex.f Normal file
View File

@@ -0,0 +1,27 @@
integer function sum_(a, b)
integer a, b
sum_ = a + b
end
integer function sub_(a, b)
integer a, b
sub_ = a - b
if (1 .eq. 1) then
return
endif
end
subroutine print_(a)
integer a
write(*,*)a
end
program main
implicit none
integer a, b, res
integer sum_, sub_
a = 1
b = a + 1
res = sum_(sum_(a, b), sub_(a,b))
call print_(res)
end

69
tests/inliner/array_sum.f Normal file
View File

@@ -0,0 +1,69 @@
integer function sum_(a, b)
integer a, b
sum_ = a + b
return
entry mul_(a, b)
mul_ = a * b
return
end
integer function array_sum(a, b, n)
integer n
integer a(n), b(n)
integer i
array_sum = 0
do i = 1, n
array_sum = array_sum + a(i) + b(i)
enddo
end
integer function array_sum2(a, b, n)
integer n
integer a(-1:8), b(n)
integer i
array_sum2 = 0
do i = 1, n
array_sum2 = array_sum2 + a(i-2) + b(i)
enddo
end
integer function array_sum3(a, b, n)
integer i, n, sum_
integer a(-1:8), b(n)
array_sum3 = 0
do i = 1, n
array_sum3 = array_sum3 + sum_(a(i-2), b(i))
enddo
end
subroutine print_(a)
integer a
write(*,*)a
end
subroutine print_array(a, n)
integer i, n
integer a(n)
do i = 1, n
write(*,*)a(i)
enddo
end
program main
implicit none
integer sum_, mul_, array_sum, array_sum2, array_sum3
integer i, s
integer array1(10), array2(10)
do i = 1, 10
array1(i) = i
array2(i) = i
enddo
call print_array(array1, 10)
call print_array(array2, 10)
s = array_sum(array1, array2, 10)
call print_(s)
s = array_sum2(array1, array2, 10)
call print_(s)
s = array_sum3(array1, array2, 10)
call print_(s)
end

23
tests/inliner/inlineFunctionWithAllocatable.f90 Normal file
View File

@@ -0,0 +1,23 @@
function allocateUsingFunction()
integer AllocateStatus, DeAllocateStatus
real, dimension(:), allocatable :: arr
real allocateUsingFunction
parameter (nx = 10, nx1 = nx + 1)
allocate(arr(0:nx1), STAT = AllocateStatus)
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
do i = 0, nx1
arr(i) = 1
enddo
allocateUsingFunction = arr(0)
deallocate (arr, STAT = DeAllocateStatus)
RETURN
end function allocateUsingFunction
program allocatablesmoketest
real funcResult
real, dimension(:), allocatable :: rra
funcResult = allocateUsingFunction()
print*, "Result", funcResult
end

43
tests/inliner/sub.f Normal file
View File

@@ -0,0 +1,43 @@
integer function sum_(a, b)
integer a, b
sum_ = a + b
return
entry mul_(a, b)
mul_ = a * b
return
end
integer function sub_(a, b)
integer a, b
sub_ = a - b
if (1 .eq. 1) then
return
endif
end
integer function sub2_(a, b)
integer a, b
integer sum_
sub_ = sum_(a, -b)
end
subroutine print_(a)
integer a
write(*,*)a
end
subroutine test()
integer a, b, res, i
integer sum_, sub_, sub2_, mul_, one
a = 1
b = a + 1
call print_(a)
call print_(b)
res = sum_(sub_(a,b), sub2_(a,b))
call print_(res)
end
program main
implicit none
call test
end

59
tests/inliner/test.f Normal file
View File

@@ -0,0 +1,59 @@
integer function sum_(a, b)
integer a, b
sum_ = a + b
return
entry mul_(a, b)
mul_ = a * b
return
end
integer function sub_(a, b)
integer a, b
integer sum_
sub_ = a - b
if (1 .eq. 1) then
return
endif
sub_ = sum_(a, -b)
end
integer function one()
one = 1
end
integer function array_sum(a, b, n)
integer n
integer a(-1:8), b(N)
integer i
array_sum = 0
do i = 1, n
array_sum = array_sum + a(i-2) + b(i)
enddo
end
subroutine print_(a)
integer a
write(*,*)a
end
program main
implicit none
integer a, b, res, i, s
integer sum_, sub_, mul_, one, array_sum
integer array1(10), array2(10)
do i = 1, 10
array1(i) = i
array2(i) = i
enddo
s = array_sum(array1, array2, 10)
call print_(s)
call print_(array_sum(array1, array2, 10))
a = 1
b = a + 1
res = sum_(sum_(one(), b), mul_(1, sub_(a,b)))
if (1 .eq. one()) call print_(1)
do i = 1, one() * 5
call print_(i + one() * one())
enddo
call print_(res)
end

25
tests/sapfor/PRINT_PAR_REGIONS_ERRORS/entry_err1.f Normal file
View File

@@ -0,0 +1,25 @@
subroutine A(i1)
INTEGER i1
!$SPF PARALLEL_REG reg1
entry reg(i1)
i1 = i1 + 1
!$SPF END PARALLEL_REG
END
PROGRAM PAR_REG_TEST
INTEGER i1
INTEGER summ
summ = 0
do i1 = 1, 20
call A(summ)
call reg(summ)
enddo
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call A(summ)
enddo
write(*,*) 'summ = ', summ
END

30
tests/sapfor/PRINT_PAR_REGIONS_ERRORS/entry_err2.f Normal file
View File

@@ -0,0 +1,30 @@
subroutine C(array, summ, L, idx)
INTEGER summ, array(L), idx
entry reg(array, summ, L, idx)
summ = summ + array(idx)
end
subroutine A(array, summ, L, idx)
INTEGER summ, array(L), idx
!$SPF PARALLEL_REG reg1
call C(array, summ, L, idx)
!$SPF END PARALLEL_REG
END
PROGRAM ENTRY_TEST
PARAMETER(L=20)
INTEGER i1, array(L)
INTEGER summ
do i1 = 1, 20
array(i1) = 2
enddo
summ = 0
do i1 = 1, 20
call A(array, summ, L, i1)
call reg(array, summ, L, i1)
array(i1) = array(i1) + 1
enddo
write(*,*) 'summ = ', summ
END

26
tests/sapfor/PRINT_PAR_REGIONS_ERRORS/etnry_ok1.f Normal file
View File

@@ -0,0 +1,26 @@
subroutine A(i1)
INTEGER i1
entry reg(i1)
!$SPF PARALLEL_REG reg1
i1 = i1 + 1
!$SPF END PARALLEL_REG
END
PROGRAM PAR_REG_TEST
INTEGER i1
INTEGER summ
summ = 0
do i1 = 1, 20
call A(summ)
call reg
enddo
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call A(summ)
enddo
write(*,*) 'summ = ', summ
END

29
tests/sapfor/PRINT_PAR_REGIONS_ERRORS/etnry_ok2.f Normal file
View File

@@ -0,0 +1,29 @@
subroutine C(array, summ, L, idx)
INTEGER summ, array(L), idx
entry reg(array, summ, L, idx)
summ = summ + array(idx)
end
subroutine A(array, summ, L, idx)
INTEGER summ, array(L), idx
!$SPF PARALLEL_REG reg1
call C(array, summ, L, idx)
!$SPF END PARALLEL_REG
END
PROGRAM ENTRY_TEST
PARAMETER(L=20)
INTEGER i1, array(L)
INTEGER summ
do i1 = 1, 20
array(i1) = 2
enddo
summ = 0
do i1 = 1, 20
call A(array, summ, L, i1)
array(i1) = array(i1) + 1
enddo
write(*,*) 'summ = ', summ
END

24
tests/sapfor/PRINT_PAR_REGIONS_ERRORS/goto_err1.f Normal file
View File

@@ -0,0 +1,24 @@
subroutine A(i1)
INTEGER i1
i1 = i1 + 1
END
PROGRAM GOTO_TEST
INTEGER i1
INTEGER summ
summ = 0
!$SPF PARALLEL_REG reg1
do i1 = 1, 20
call A(summ)
10 enddo
!$SPF END PARALLEL_REG
goto 10
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call A(summ)
enddo
write(*,*) 'summ = ', summ
END

13
tests/sapfor/PRINT_PAR_REGIONS_ERRORS/goto_ok1.f Normal file
View File

@@ -0,0 +1,13 @@
PROGRAM GOTO_TEST
INTEGER I, J, SUMM
SUMM = 0
J = 0
DO I = 1, 10
44 SUMM = SUMM + I
GOTO 55
55 J = I
GOTO 44
EXIT
ENDDO
GOTO 55
END

27
tests/sapfor/check_args_decl/arg_decl_test_err1.f Normal file
View File

@@ -0,0 +1,27 @@
subroutine A(i1)
INTEGER i1
i1 = i1 + 1
END
subroutine B(i1)
i1 = i1 + 1
END
PROGRAM PAR_REG_TEST
INTEGER i1
INTEGER summ
summ = 0
do i1 = 1, 20
call A(summ)
enddo
write(*,*) 'summ = ', summ
summ = 0
!$SPF PARALLEL_REG reg2
do i1 = 1, 20
call B(summ)
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
END

25
tests/sapfor/check_args_decl/arg_decl_test_err2.f Normal file
View File

@@ -0,0 +1,25 @@
subroutine A(i1)
i1 = i1 + 1
END
PROGRAM PAR_REG_TEST
INTEGER i1
INTEGER summ
summ = 0
!$SPF PARALLEL_REG reg1
do i1 = 1, 20
call A(summ)
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
summ = 0
!$SPF PARALLEL_REG reg2
do i1 = 1, 20
call A(summ)
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
END

41
tests/sapfor/check_args_decl/arg_decl_test_err3.f Normal file
View File

@@ -0,0 +1,41 @@
subroutine A(array, summ, L, idx)
INTEGER summ, array(L)
summ = summ + array(idx)
END
subroutine B(array, summ, L, idx)
INTEGER summ, array(L)
summ = summ + array(idx)
END
PROGRAM PAR_REG_TEST
PARAMETER(L=20)
INTEGER i1, array(L)
INTEGER summ
do i1 = 1, 20
array(i1) = 2
enddo
summ = 0
!$SPF PARALLEL_REG reg1
do i1 = 1, 20
call A(array, summ, L, i1)
array(i1) = array(i1) + 1
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call B(array, summ, L, i1)
array(i1) = array(i1) + 2
enddo
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call A(array, summ, L, i1)
enddo
write(*,*) 'summ = ', summ
END

26
tests/sapfor/check_args_decl/arg_decl_test_ok1.f Normal file
View File

@@ -0,0 +1,26 @@
subroutine A(i1)
INTEGER i1
i1 = i1 + 1
END
subroutine B(i1)
INTEGER i1
i1 = i1 + 1
END
PROGRAM PAR_REG_TEST
INTEGER i1
INTEGER summ
summ = 0
do i1 = 1, 20
call A(summ)
enddo
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call B(summ)
enddo
write(*,*) 'summ = ', summ
END

26
tests/sapfor/check_args_decl/arg_decl_test_ok2.f Normal file
View File

@@ -0,0 +1,26 @@
subroutine A(i1)
INTEGER i1
i1 = i1 + 1
END
PROGRAM PAR_REG_TEST
INTEGER i1
INTEGER summ
summ = 0
!$SPF PARALLEL_REG reg1
do i1 = 1, 20
call A(summ)
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
summ = 0
!$SPF PARALLEL_REG reg2
do i1 = 1, 20
call A(summ)
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
END

41
tests/sapfor/check_args_decl/arg_decl_test_ok3.f Normal file
View File

@@ -0,0 +1,41 @@
subroutine A(array, summ, L, idx)
INTEGER summ, array(L), idx, L
summ = summ + array(idx)
END
subroutine B(array, summ, L, idx)
INTEGER summ, array(L), idx, L
summ = summ + array(idx)
END
PROGRAM PAR_REG_TEST
PARAMETER(L=20)
INTEGER i1, array(L)
INTEGER summ
do i1 = 1, 20
array(i1) = 2
enddo
summ = 0
!$SPF PARALLEL_REG reg1
do i1 = 1, 20
call A(array, summ, L, i1)
array(i1) = array(i1) + 1
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call B(array, summ, L, i1)
array(i1) = array(i1) + 2
enddo
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call A(array, summ, L, i1)
enddo
write(*,*) 'summ = ', summ
END

25
tests/sapfor/check_args_decl/arg_decl_test_wr1.f Normal file
View File

@@ -0,0 +1,25 @@
subroutine A(i1)
INTEGER i1
i1 = i1 + 1
END
subroutine B(i1)
i1 = i1 + 1
END
PROGRAM PAR_REG_TEST
INTEGER i1
INTEGER summ
summ = 0
do i1 = 1, 20
call A(summ)
enddo
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call B(summ)
enddo
write(*,*) 'summ = ', summ
END

41
tests/sapfor/check_args_decl/arg_decl_test_wr3.f Normal file
View File

@@ -0,0 +1,41 @@
subroutine A(array, summ, L, idx)
INTEGER summ, array(L), idx
summ = summ + array(idx)
END
subroutine B(array, summ, L, idx)
INTEGER summ, array(L)
summ = summ + array(idx)
END
PROGRAM PAR_REG_TEST
PARAMETER(L=20)
INTEGER i1, array(L)
INTEGER summ
do i1 = 1, 20
array(i1) = 2
enddo
summ = 0
!$SPF PARALLEL_REG reg1
do i1 = 1, 20
call A(array, summ, L, i1)
array(i1) = array(i1) + 1
enddo
!$SPF END PARALLEL_REG
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call B(array, summ, L, i1)
array(i1) = array(i1) + 2
enddo
write(*,*) 'summ = ', summ
summ = 0
do i1 = 1, 20
call A(array, summ, L, i1)
enddo
write(*,*) 'summ = ', summ
END

134
tests/sapfor/checkpoint/checkpoint.f90 Normal file
View File

@@ -0,0 +1,134 @@
program CHECKPOINT
call check
end
module testA
real modA
real fixA
integer, private::locA
end
module testB
use testA, modB=>modA
real, private::locB
integer arrB
end
module testC
use testB, modC=>modB, arrC=>arrB
real fixC
end
module constants
implicit none
real, parameter::pi = 3.1415926536
real, parameter::e = 2.7182818285
contains
subroutine show_consts()
print*, "Pi = ", pi
print*, "e = ", e
end subroutine show_consts
end module constants
module test
use constants, only: pi, p=>pi
end
subroutine check
use test
use testC!, only: modC
!use constants
implicit none
integer n,m,k,l,pn,nl,i,j,ii,jj,nnl
parameter( N = 6,M=8,K=8,L=6, PN = 2,NL=1000)
integer A(N,M,K,L), B(N,M,K,L), C(N,M,K,L), D(N,M,K,L)
integer AA(N,M,K)
integer nloopi,nloopj,nloopii,nloopjj,ttt,ttt1
character*9 tname
write(*,*) modC
write(*,*) p
write(*,*) pi
!$SPF CHECKPOINT(INTERVAL(TIME,10),FILES_COUNT(4),VARLIST(A,B,C),TYPE(ASYNC),EXCEPT(AA,D))
!$SPF CHECKPOINT(INTERVAL(TIME,10),FILES_COUNT(a),VARLIST(A,B,C),TYPE(ASYNC,FLEXIBLE),EXCEPT(AA,D,TEMP))
!$SPF CHECKPOINT(INTERVAL(TIME,10),VARLIST(A,B),EXCEPT(AA,D,pi),VARLIST(C,e,modB,modA))
tname='check'
NNL=NL
call serial4(C,N,M,K,L,NNL)
nloopi=NL
nloopj=NL
nloopii=NL
nloopjj=NL
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
do i=1,N
do j=1,M
do ii=1,K
ttt = ttt
do jj=1,L
ttt = A(i,j,ii,1)+A(i,j,ii,2)
ttt1=AA(i,j,ii)
enddo
ttt=ttt
enddo
enddo
enddo
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
if (B(i,j,ii,jj).ne.(C(i,j,ii,1)+C(i,j,ii,2))) then
nloopi=min(nloopi,i)
nloopj=min(nloopj,j)
nloopii=min(nloopii,ii)
nloopjj=min(nloopjj,jj)
endif
enddo
ttt = ttt
enddo
enddo
enddo
if (nloopi .eq.NL) then
call ansyes(tname)
else
call ansno(tname)
endif
end
subroutine serial4(AR,N,M,K,L,NL)
integer AR(N,M,K,L)
integer NL
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
10 AR(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
end
subroutine ansyes(name)
character*9 name
print *,name,' - complete'
end
subroutine ansno(name)
character*7 name
print *,name,' - ***error'
end

146
tests/sapfor/checkpoint/checkpoint2.f90 Normal file
View File

@@ -0,0 +1,146 @@
module testA
real modA
real fixA
integer, private::locA
end
module testB
use testA, modB=>modA
real, private::locB
integer arrB
end
module testC
use testB, modC=>modB, arrC=>arrB
real fixC
end
module constants
implicit none
real, parameter::pi = 3.1415926536
real, parameter::e = 2.7182818285
contains
subroutine show_consts()
print*, "Pi = ", pi
contains
subroutine show_e()
print*, "e = ", e
end subroutine show_e
end subroutine show_consts
end module constants
module test
use constants, only: pi, p=>pi
contains
subroutine ansno(name)
use testA
character*7 name
!$SPF CHECKPOINT(INTERVAL(TIME,10),FILES_COUNT(4),VARLIST(pi),TYPE(ASYNC),EXCEPT(p))
print *,name,' - ***error'
contains
subroutine run
use testB
!$SPF CHECKPOINT(INTERVAL(TIME,10),FILES_COUNT(4),VARLIST(pi),TYPE(ASYNC),EXCEPT(p))
print *,name,'run'
end
end
end
program CHECKPOINT
use test
call check
contains
subroutine check
use testC!, only: modC
!use constants
implicit none
integer n,m,k,l,pn,nl,i,j,ii,jj,nnl
parameter( N = 6,M=8,K=8,L=6, PN = 2,NL=1000)
integer A(N,M,K,L), B(N,M,K,L), C(N,M,K,L), D(N,M,K,L)
integer AA(N,M,K)
integer nloopi,nloopj,nloopii,nloopjj,ttt,ttt1
character*9 tname
write(*,*) modC
write(*,*) p
write(*,*) pi
!$SPF CHECKPOINT(INTERVAL(TIME,10),FILES_COUNT(4),VARLIST(A,B,C),TYPE(ASYNC),EXCEPT(AA,D))
!$SPF CHECKPOINT(INTERVAL(TIME,10),FILES_COUNT(a),VARLIST(A,B,C),TYPE(ASYNC,FLEXIBLE),EXCEPT(AA,D,TEMP))
!$SPF CHECKPOINT(INTERVAL(TIME,10),VARLIST(A,B),EXCEPT(AA,D,pi),VARLIST(C,e,modB,modA))
tname='check'
NNL=NL
call serial4(C,N,M,K,L,NNL)
nloopi=NL
nloopj=NL
nloopii=NL
nloopjj=NL
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
do i=1,N
do j=1,M
do ii=1,K
ttt = ttt
do jj=1,L
ttt = A(i,j,ii,1)+A(i,j,ii,2)
ttt1=AA(i,j,ii)
enddo
ttt=ttt
enddo
enddo
enddo
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
if (B(i,j,ii,jj).ne.(C(i,j,ii,1)+C(i,j,ii,2))) then
nloopi=min(nloopi,i)
nloopj=min(nloopj,j)
nloopii=min(nloopii,ii)
nloopjj=min(nloopjj,jj)
endif
enddo
ttt = ttt
enddo
enddo
enddo
if (nloopi .eq.NL) then
call ansyes(tname)
else
call ansno(tname)
endif
end
subroutine serial4(AR,N,M,K,L,NL)
integer AR(N,M,K,L)
integer NL
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
10 AR(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
end
subroutine ansyes(name)
character*9 name
print *,name,' - complete'
end
end

402
tests/sapfor/convert_assign_to_loop/anyArguments_fromLittleToBig.f90 Normal file
View File

@@ -0,0 +1,402 @@
program COPY
do i=1,7
call copy11(i)
enddo
do i=1,3
call copy12(i)
enddo
end
subroutine copy11(var)
integer, parameter :: N=16,El=11,Fort=14,Tw=12
integer ierr, var, as, t, k, q
character*9 tname
integer,allocatable :: A1(:),B1(:)
integer,allocatable :: E1(:,:),F1(:,:)
integer,allocatable :: G1(:,:,:),H1(:,:,:)
integer,allocatable :: Z1(:,:,:,:),X1(:,:,:,:)
!$SPF ANALYSIS(PRIVATE(C1, D1))
integer,allocatable :: C1(:),D1(:)
!$SPF ANALYSIS(PRIVATE(Q1, W1))
integer,allocatable :: Q1(:,:),W1(:,:)
!$SPF ANALYSIS(PRIVATE(S1, O1))
integer,allocatable :: S1(:,:,:),O1(:,:,:)
!$SPF ANALYSIS(PRIVATE(P1, L1))
integer,allocatable :: P1(:,:,:,:),L1(:,:,:,:)
tname='copy11 '
allocate (A1(N),B1(N))
allocate (C1(N),D1(N))
allocate (E1(N,N),F1(N,N))
allocate (G1(N,N,N),H1(N,N,N))
allocate (Z1(N,N,N,N),X1(N,N,N,N))
allocate (Q1(N,N),W1(N,N))
allocate (S1(N,N,N),O1(N,N,N))
allocate (P1(N,N,N,N),L1(N,N,N,N))
do i=1,N
A1(i) = 0
enddo
Q1 = 0
S1 = 0
P1 = 0
E1 = 0
G1 = 0
Z1 = 0
do i=1,N
do j=1,N
F1(i,j) = j
W1(i,j) = j
enddo
enddo
do i=1,N
do j=1,N
do k=1,N
H1(i,j,k) = k
O1(i,j,k) = k
enddo
enddo
enddo
do i=1,N
do j=1,N
do k=1,N
do t=1,N
X1(i,j,k,t) = t
L1(i,j,k,t) = t
enddo
enddo
enddo
enddo
do i=1,N
B1(i) = i
enddo
do i=1,N
C1(i) = 0
enddo
do i=1,N
D1(i) = i
enddo
select case (var)
case (1)
! first assignment must not be converted due to SPF
C1=D1
A1=B1
case (2)
C1(10:15)=D1(9:14)
Q1(6:11,8:11) = W1(6:11,10:13)
S1(10:15,10:13,9:13)=O1(8:13,8:11,10:14)
P1(7:12,9:12,10:Fort,10:12)=L1(8:13,9:12,10:14,9:El)
A1(10:15)=B1(9:14)
E1(6:11,8:11)=F1(6:11,10:13)
G1(10:15,10:13,9:13)=H1(8:13,8:11,10:14)
Z1(7:12,9:12,10:Fort,10:12)=X1(8:13,9:9+3,10:14,9:El)
case (3)
C1(:7)=D1(10:)
Q1(:3,:5)=W1(14:,12:)
S1(:8,12:,:6)=O1(9:,:5,11:)
P1(10:,:5,:6,:4)=L1(:7,12:,11:,13:)
A1(:7)=B1(10:)
E1(:3,:5)=F1(14:,12:)
G1(:8,12:,:6)=H1(9:,:5,11:)
Z1(12-2:,:5,:6,:4)=X1(:7,6*2:,11:,13:)
case (4)
C1(:)=D1(:)
Q1(:,:)=W1(:,:)
S1(:,:,:)=O1(:,:,:)
P1(:,:,:,:)=L1(:,:,:,:)
A1(:)=B1(:)
E1(:,:)=F1(:,:)
G1(:,:,:)=H1(:,:,:)
Z1(:,:,:,:)=X1(:,:,:,:)
case (5)
C1(1:8)=D1(:)
Q1(1:4,1:12)=W1(:,:)
S1(1:6,1:5,1:6)=O1(:,:,:)
P1(1:1,1:14,1:15,1:4)=L1(:,:,:,:)
A1(1:8)=B1(:)
E1(1:4,1:12)=F1(:,:)
G1(1:6,1:5,1:6)=H1(:,:,:)
Z1(1:1,1:14,1:15,1:4)=X1(:,:,:,:)
case (6)
P1(10:,:5,:6,:4)=L1(:7,12:,11:,13:)+L1(:7,12:,11:,13:)
Q1(1:4,1:5) = W1(3:6,10:14) - Q1(3:6,6:10)
S1 = O1 * S1
Z1(12-2:,:5,:6,:4)=X1(:7,6*2:,11:,13:)+X1(:7,6*2:,11:,13:)
E1(1:4,1:5) = F1(3:6,10:14) - E1(3:6,6:10)
G1 = H1 * G1
case (7)
Q1(:3:3,:5:3)=W1(14::3,12::3)
S1(:8:2,11::2,:6:2)=O1(9::2,:6:2,11::2)
P1(10::3,:5:2,:6:2,:4:2)=L1(:7:3,Tw::2,11::2,13::2)
E1(:3:3,:5:3)=F1(14::3,12::3)
G1(:8:2,11::2,:6:2)=H1(9::2,:6:2,11::2)
Z1(10::3,:5:2,:6:2,:4:2)=X1(:7:3,Tw::2,11::2,13::2)
endselect
ierr = 0
do i=1,N
ierr = ierr + abs(A1(i) - C1(i))
enddo
if (ierr .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (B1,A1)
as = 0
do i=1,N
enddo
do j=1,N
as = as + abs(E1(i,j) - Q1(i,j))
enddo
if (as .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (F1,E1)
as = 0
do i=1,N
do j=1,N
do k=1,N
as = as + abs(G1(i,j,k) - S1(i,j,k))
enddo
enddo
enddo
if (as .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (H1,G1)
as = 0
do i=1,N
do j=1,N
do k=1,N
do q=1,N
as = as + abs(Z1(i,j,k,q) - P1(i,j,k,q))
enddo
enddo
enddo
enddo
if (as .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (X1,Z1)
end
!-------------------------------------------------
subroutine copy12(var)
integer, parameter :: N=16,El=11,Fort=14,Tw=12
integer ierr, var, as, t, k, q, z
character*9 tname
integer,allocatable :: A1(:),B1(:)
integer,allocatable :: E1(:,:),F1(:,:)
integer,allocatable :: G1(:,:,:),H1(:,:,:)
integer,allocatable :: Z1(:,:,:,:),X1(:,:,:,:)
!$SPF ANALYSIS(PRIVATE(C1, D1))
integer,allocatable :: C1(:),D1(:)
!$SPF ANALYSIS(PRIVATE(Q1, W1))
integer,allocatable :: Q1(:,:),W1(:,:)
!$SPF ANALYSIS(PRIVATE(S1, O1))
integer,allocatable :: S1(:,:,:),O1(:,:,:)
!$SPF ANALYSIS(PRIVATE(P1, L1))
integer,allocatable :: P1(:,:,:,:),L1(:,:,:,:)
tname='copy12 '
allocate (A1(N),B1(N))
allocate (C1(N),D1(N))
allocate (E1(N,N),F1(N,N))
allocate (G1(N,N,N),H1(N,N,N))
allocate (Z1(N,N,N,N),X1(N,N,N,N))
allocate (Q1(N,N),W1(N,N))
allocate (S1(N,N,N),O1(N,N,N))
allocate (P1(N,N,N,N),L1(N,N,N,N))
do i=1,N
A1(i) = 0
enddo
Q1 = 0
S1 = 0
P1 = 0
E1 = 0
G1 = 0
Z1 = 0
do i=1,N
do j=1,N
F1(i,j) = j
W1(i,j) = j
enddo
enddo
do i=1,N
do j=1,N
do k=1,N
H1(i,j,k) = k
O1(i,j,k) = k
enddo
enddo
enddo
do i=1,N
do j=1,N
do k=1,N
do t=1,N
X1(i,j,k,t) = t
L1(i,j,k,t) = t
enddo
enddo
enddo
enddo
do i=1,N
B1(i) = i
enddo
do i=1,N
C1(i) = 0
enddo
do i=1,N
D1(i) = i
enddo
select case (var)
case (1)
Q1(2,:) = C1(:)
E1(2,:) = A1(:)
ierr = 0
do i=1,N
do j=1,N
ierr = ierr + abs(E1(i,j) - Q1(i,j))
enddo
enddo
if (ierr .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (A1,E1)
W1(:,5) = D1(:)
F1(:,5) = B1(:)
ierr = 0
do i=1,N
do j=1,N
ierr = ierr + abs(F1(i,j) - W1(i,j))
enddo
enddo
if (ierr .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (B1,F1)
case (2)
S1(:,:,3) = W1(:,:)
G1(:,:,3) = F1(:,:)
ierr = 0
do i=1,N
do j=1,N
do k=1,N
ierr = ierr + abs(G1(i,j,k) - S1(i,j,k))
enddo
enddo
enddo
if (ierr .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (F1,G1)
O1(2,:,4) = C1(:)
H1(2,:,4) = A1(:)
ierr = 0
do i=1,N
do j=1,N
do k=1,N
ierr = ierr + abs(H1(i,j,k) - O1(i,j,k))
enddo
enddo
enddo
if (ierr .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (A1,H1)
case (3)
P1(10,:,:,:) = S1(:,:,:)
Z1(10,:,:,:) = G1(:,:,:)
ierr = 0
do i=1,N
do j=1,N
do k=1,N
do z=1,N
ierr = ierr + abs(Z1(i,j,k,z) - P1(i,j,k,z))
enddo
enddo
enddo
enddo
if (ierr .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (G1,Z1)
L1(11,:,:,15) = W1(:,:)
X1(11,:,:,15) = F1(:,:)
ierr = 0
do i=1,N
do j=1,N
do k=1,N
do z=1,N
ierr = ierr + abs(X1(i,j,k,z) - L1(i,j,k,z))
enddo
enddo
enddo
enddo
if (ierr .eq. 0) then
call ansyes(tname, var)
else
call ansno(tname, var)
endif
deallocate (F1,X1)
endselect
end
!-------------------------------------------------
subroutine ansyes(name,var)
character*9 name
integer var
print *,name,var,' complete'
end
subroutine ansno(name,var)
character*9 name
integer var
print *,name,var,' ***error'
end

10
tests/sapfor/convert_assign_to_loop/assign_with_sections.f Normal file
View File

@@ -0,0 +1,10 @@
PROGRAM ASSIGN_WITH_SECTIONS
REAL A (10), B (9), C(3)
A(3:6) = B(4:7)
A(1:5) = B(4:8)
A(2:4) = C
C = B(6:8)
END

9
tests/sapfor/convert_assign_to_loop/simple_assign.f Normal file
View File

@@ -0,0 +1,9 @@
PROGRAM SIMPLE_ASSIGN
REAL A (10), B (10), C(10)
A = B
C = A
B = A
END

9
tests/sapfor/convert_assign_to_loop/two_dimensional_assign.f Normal file
View File

@@ -0,0 +1,9 @@
PROGRAM TWO_DIMENSIONAL_ASSIGN
REAL A (100, 100), B (100, 90), C(10, 3)
A(2:10, 3:30) = B(34:42, 43:70)
B(10:20, 34:37) = C
B(3:47, 2:10) = A(45:99, 2:10)
END

10
tests/sapfor/convert_expr_to_loop/expr_with_sections.f Normal file
View File

@@ -0,0 +1,10 @@
PROGRAM EXPR_WITH_SECTIONS
REAL A (10), B (9), C(3)
A(3:6) = B(4:7) + B(3:6)
A(1:5) = 2 * B(4:8)
A(2:4) = C + B(1:3)
C = B(6:8) * A(1:3)
END

9
tests/sapfor/convert_expr_to_loop/simple_expr.f Normal file
View File

@@ -0,0 +1,9 @@
PROGRAM SIMPLE_EXPR
REAL A (10), B (10), C(10)
A = B + C
C = A + B
B = A + A
END

9
tests/sapfor/convert_expr_to_loop/two_dimensional_expr.f Normal file
View File

@@ -0,0 +1,9 @@
PROGRAM TWO_DIMENSIONAL_EXPR
REAL A (100, 100), B (100, 90), C(10, 3)
A(2:10, 3:30) = B(34:42, 43:70) + B(34:42, 43:70)
B(10:20, 34:37) = C + A(20:30, 1:3)
B(3:47, 2:10) = A(45:99, 2:10) * B(1:45, 8:16)
END

10
tests/sapfor/convert_sum_to_loop/simple_sum.f Normal file
View File

@@ -0,0 +1,10 @@
PROGRAM SIMPLE_SUM
REAL A (10), B (24), C(2)
REAL S
S = SUM(A)
S = SUM(B)
S = SUM(C)
END

11
tests/sapfor/convert_sum_to_loop/sum_with_sections.f Normal file
View File

@@ -0,0 +1,11 @@
PROGRAM SUM_WITH_SECTIONS
REAL A (10), B (9), C(3)
REAL S
S = SUM(B(4:7))
S = SUM(A(3:6))
S = SUM(A(1:5))
S = SUM(A(2:4))
END

11
tests/sapfor/convert_sum_to_loop/two_dimensional_sum.f Normal file
View File

@@ -0,0 +1,11 @@
PROGRAM TWO_DIMENSIONAL_SUM
REAL A (100, 100), B (100, 90), C(10, 3)
REAL S
S = SUM(A(2:10, 3:30))
S = SUM(B(10:20, 34:37))
S = SUM(C)
S = SUM(A(45:99, 2:10))
END

10
tests/sapfor/convert_where_to_loop/simple_where.f Normal file
View File

@@ -0,0 +1,10 @@
PROGRAM SIMPLE_WHERE
REAL A (10), B (10), C(10)
REAL S
WHERE (A > 0) A = 3
WHERE (C <= 56) C = 15
WHERE (B /= 0) B = S / 2
END

9
tests/sapfor/convert_where_to_loop/two_dimensional_where.f Normal file
View File

@@ -0,0 +1,9 @@
PROGRAM TWO_DIMENSIONAL_WHERE
REAL A (100, 100), B (100, 90), C(10, 3)
WHERE (B(10:20, 10:20) > 0) B(10:20, 10:20) = 0
WHERE (A(10:90, 50:90) > 0) B = 2
WHERE (A(10:90, 50:90) > 0) A(40:50, 20:70) = 5
END

9
tests/sapfor/convert_where_to_loop/where_with_sections.f Normal file
View File

@@ -0,0 +1,9 @@
PROGRAM WHERE_WITH_SECTIONS
REAL A (10), B (9), C(3)
WHERE (A(3:6) > 0) A(3:6) = 0
WHERE (A(1:5) > 6) B = 9
WHERE (A < 7) B = 10
END

21
tests/sapfor/create_nested_loops/program.expected.f90 Normal file
View File

@@ -0,0 +1,21 @@
program basiccreatenestedloops
parameter (nx = 10,ny = 10)
integer a(nx,ny),b(nx,ny)
integer i,j,inv
print *, "TEST START"
do j = 1,ny
do i = 1,nx
a(i,j) = 1
b(i,j) = 2
enddo
enddo
do j = 1,ny
do i = 1,nx
inv = nx * ny
a(i,j) = 1 + b(i,j) * inv
enddo
enddo
print *, "Result",a(1,1),a(nx,1)
print *, "TEST END"
end

23
tests/sapfor/create_nested_loops/program.f90 Normal file
View File

@@ -0,0 +1,23 @@
program BasicCreateNestedLoops
parameter (nx = 10, ny = 10)
integer a(nx, ny), b(nx, ny)
integer i, j, inv
print *, "TEST START"
do j = 1, ny
do i = 1, nx
a(i, j) = 1
b(i, j) = 2
enddo
enddo
do j = 1, ny
inv = nx * ny
do i = 1, nx
a(i, j) = 1 + b(i, j) * inv
enddo
enddo
print*, "Result", a(1, 1), a(nx, 1)
print *, "TEST END"
end

8
tests/sapfor/create_nested_loops/test.bat Normal file
View File

@@ -0,0 +1,8 @@
setlocal
rmdir /s /q sapfor_out
SET PARSER_EXEC=..\..\..\_bin\x64\Debug\Parser.exe
SET SAPFOR_EXEC=..\..\..\_bin\x64\Debug\Sapfor.exe
%PARSER_EXEC% program.f90
if not exist "sapfor_out" mkdir sapfor_out
%SAPFOR_EXEC% -pass 3 -F sapfor_out -print
FC /w program.expected.f90 sapfor_out/program.f90

26
tests/sapfor/create_nested_loops/test.sh Normal file
View File

@@ -0,0 +1,26 @@
#!/usr/bin/env bash
../../clean.sh
source ../../env.sh
../../../_bin/$PARSER_EXEC program.f90
gfortran program.f90 -o program.exe
./program.exe > program.out.txt
mkdir sapfor_out
../../../_bin/$SAPFOR_EXEC -pass 3 -F sapfor_out -print
gfortran sapfor_out/program.f90 -o sapfor_out/program.exe
sapfor_out/program.exe > sapfor_out/program.out.txt
diff program.out.txt sapfor_out/program.out.txt > diff.txt
if [ -s diff.txt ]; then
(>&2 echo "ERROR: Sapfor result program behavior differs from original program")
echo "ERROR: Sapfor result program behavior differs from original program" > FAILURE
else
echo "Sapfor result program behavior is same as original program"
echo "Checking sources"
diff -b program.expected.f90 sapfor_out/program.f90 > diff.txt
if [ -s diff.txt ]; then
(>&2 echo "ERROR: Sapfor result program code differs from original program")
echo "ERROR: Sapfor result program code differs from original program" > FAILURE
else
echo "SUCCESS: Sapfor result as expected (sources and compiled)"
echo "SUCCESS: Sapfor result as expected (sources and compiled)" > SUCCESS
fi
fi

208
tests/sapfor/fission_and_private_exp/fission_priv_exp.f90 Normal file
View File

@@ -0,0 +1,208 @@
program SRSA4
call srsa43
end
subroutine srsa43
parameter( N = 6,M=8,K=8,L=6, PN = 2,NL=1000)
integer A(N,M,K,L), B(N,M,K,L), C(N,M,K,L), D(N,M,K,L)
integer AA(N,M,K)
integer nloopi,nloopj,nloopii,nloopjj,ttt,ttt1
character*9 tname
tname='srsa43'
!$SPF TRANSFORM (FISSION (NNL))
NNL=NL
call serial4(C,N,M,K,L,NNL)
nloopi=NL
nloopj=NL
!$SPF TRANSFORM (PRIVATES_EXPANSION (nloopii,NL))
nloopii=NL
nloopjj=NL
!$SPF TRANSFORM (FISSION (i, j, ii, jj))
!$SPF TRANSFORM (FISSION (i, j, ii))
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (FISSION (i, j, ii, jj), FISSION (i, j, ii))
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (PRIVATES_EXPANSION (i))
!$SPF TRANSFORM (PRIVATES_EXPANSION)
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (FISSION (i, j, ii, jj))
!$SPF TRANSFORM (PRIVATES_EXPANSION)
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (FISSION (i, j, ii, jj), PRIVATES_EXPANSION)
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (PRIVATES_EXPANSION (i), PRIVATES_EXPANSION)
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (PRIVATES_EXPANSION)
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (FISSION (i, j, ii))
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
!$SPF TRANSFORM (FISSION (i, j, jj))
do i=1,N
do j=1,M
do ii=1,K
ttt = ttt
do jj=1,L
ttt = A(i,j,ii,1)+A(i,j,ii,2)
ttt1=AA(i,j,ii)
enddo
ttt=ttt
enddo
enddo
enddo
!$SPF TRANSFORM (FISSION (i, j, ii))
do i=1,N
do j=1,M
do ii=1,K
ttt = ttt
do jj=1,L
ttt = A(i,j,ii,1)+A(i,j,ii,2)
ttt1=AA(i,j,ii)
enddo
ttt=ttt
enddo
enddo
enddo
!$SPF TRANSFORM (PRIVATES_EXPANSION (i, j))
do i=1,N
do j=1,M
do ii=1,K
ttt = ttt
do jj=1,L
ttt = A(i,j,ii,1)+A(i,j,ii,2)
ttt1=AA(i,j,ii)
enddo
enddo
ttt=ttt
enddo
enddo
!$SPF TRANSFORM (FISSION (i, j, ii, jj, kk))
!$SPF TRANSFORM (PRIVATES_EXPANSION (i, j, ii, jj))
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
if (B(i,j,ii,jj).ne.(C(i,j,ii,1)+C(i,j,ii,2))) then
nloopi=min(nloopi,i)
nloopj=min(nloopj,j)
nloopii=min(nloopii,ii)
nloopjj=min(nloopjj,jj)
endif
enddo
ttt = ttt
enddo
enddo
enddo
if (nloopi .eq.NL) then
call ansyes(tname)
else
call ansno(tname)
endif
end
subroutine serial4(AR,N,M,K,L,NL)
integer AR(N,M,K,L)
integer NL
do i=1,N
do j=1,M
do ii=1,K
do jj=1,L
10 AR(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
end
subroutine ansyes(name)
character*9 name
print *,name,' - complete'
end
subroutine ansno(name)
character*7 name
print *,name,' - ***error'
end

39
tests/sapfor/loops_combiner/test_1.for Normal file
View File

@@ -0,0 +1,39 @@
program loops_combiner_test
implicit none
parameter (l = 16,m = 6)
real :: a(l),b(l),c(l)
do it1 = 1,m
do k1 = 1,l
do p1 = 1, l + m
a(k1) = it1 + k1 + p1
enddo
enddo
do k1_2 = 1,l
do p1_2 = 1, l + m
b(k1_2) = it1 + k1_2 - p1_2
enddo
enddo
enddo
do it2 = 1,m
do k2 = 1,l
c(k2) = k2 - it2
enddo
enddo
do it3 = 1,m
do k3 = 1,l
do p3 = 1, l + m
a(k3) = it3 + k3 * p3
enddo
enddo
do k3_2 = 1,l
do p3_2 = 1, l + m
b(k3_2) = it3 + k3_2 / p3_2
enddo
enddo
enddo
end

29
tests/sapfor/loops_combiner/test_2.for Normal file
View File

@@ -0,0 +1,29 @@
program loops_combiner_test
implicit none
parameter (l = 16,m = 6)
real :: a(l),b(l),c(l)
! should be combined:
do it1 = 1,m
do k1 = 1,l
a(k1) = it1 + k1
enddo
enddo
do it2 = 1,m
c(it2) = it2
enddo
! should be combined:
do it3 = 1,l
c(it3) = it3
enddo
do it4 = 1,l
do k4 = 1,m
a(k4) = it4 + k4
enddo
enddo
end

31
tests/sapfor/loops_combiner/test_3.for Normal file
View File

@@ -0,0 +1,31 @@
program loops_combiner_test
implicit none
parameter (l = 16,m = 6)
real :: a(l),b(l),c(l)
! shouldn't be combined because of print:
do it1 = 1,l
a(it1) = it1
print *, 'test print'
enddo
do it2 = 1,l
b(it2) = it2
enddo
! shouldn't be combined because of goto:
do it3 = 1,l - 1
c(it3) = it3
enddo
do it4 = 1,l - 1
do k4 = 1,l
a(k4) = k4 + it4
go to 100
enddo
enddo
100 a(0) = 0
end

40
tests/sapfor/loops_combiner/test_4.for Normal file
View File

@@ -0,0 +1,40 @@
program loops_combiner_test
implicit none
parameter (l = 16,m = 6)
real :: a(l),b(l),c(l)
! should be combined by it1-it2 dimension only:
do it1 = 1,m
do k1 = 1,l
a(k1) = it1 + k1
enddo
enddo
do it2 = 1,m
do k2 = 1,l - 1
a(k2) = it2 * k2
enddo
enddo
! should be combined by it1-it2, k1-k2 dimensions only:
do it1 = 1,m - 1
do k1 = 1,l
do p1 = 1,l,2
do j1 = 1, l
a(k1) = j1 * p1 - it1
enddo
enddo
enddo
enddo
do it2 = 1,m - 1
do k2 = 1,l
do p2 = 1,l
a(k2) = it2 + k2 * p2
enddo
enddo
enddo
end

88
tests/sapfor/loops_combiner/test_5.for Normal file
View File

@@ -0,0 +1,88 @@
program loops_combiner_test
implicit none
integer :: t1, t2
integer :: i, j, i1, j1, k
real :: mas(10, 20)
! должны быть объединены с разворотом первого гнезда:
do i = 1, 10
do j = 1, 20, 1
mas(i, j) = i + j
enddo
enddo
do i = 10, 1, -1
do j = 20, 1, -1
mas(i, j) = mas(i, j) + i * j
enddo
enddo
! для разделения циклов:
k = 0
! переменная i1 должна быть инициализирована перед объединённым циклом
! переменная j1 - после, т.к. используется в первом цикле:
do i = 1, 10
do j = 1, 20
j1 = i + j
mas(i, j) = j1
enddo
enddo
do i1 = 1, 10
do j1 = 1, 20
mas(i1, j1) = mas(i1, j1) + i1 * j1
enddo
enddo
! для разделения циклов:
k = 0
! переменная i во втором цикле наследует значение от первого,
! должны быть заменена на соответствующее выражение:
do i = 1, 10
do j = 1, 20
mas(i, j) = i + j
enddo
enddo
do i1 = 1, 10
do j1 = 1, 20
mas(i1, j1) = mas(i1, j1) + i1 * j1 - i
enddo
enddo
! для разделения циклов:
k = 0
! переменная i во втором цикле наследует значение от первого,
! должны быть переименована и проинициализирована:
do i = 1, 10
do j = 1, 20
mas(i, j) = i + j
enddo
enddo
do i1 = 1, 10
do j1 = 1, 20
k = k + i
i = j1 / i1
enddo
enddo
! для разделения циклов:
k = 0
! циклы нельзя объединить из-за неприватной для обоих переменной t2:
t2 = 0
do i = 1, 10
do j = 1, 20, 1
t2 = t2 + i * j
enddo
enddo
do i = 1, 10
do j = 1, 20
t1 = i + j - t2
enddo
enddo
end

23
tests/sapfor/merge_regions/array_read_before_write.in Normal file
View File

@@ -0,0 +1,23 @@
program jac2d
parameter (l = 8000,itmax = 100)
real a(l,l),eps,maxeps,b(l,l)
double precision startt,endt,dvtime
b(1,1) = 2.0
do j = 1,l
do i = 1,l
a(i,j) = i*j+b(1,1)
enddo
enddo
b(1,1) = 3.0
a(1,1) = 10
eps = 15
do j = 1,l
do i = 1,l
b(i,j) = 0. + a(i,j) + eps
enddo
enddo
maxeps = eps
end

36
tests/sapfor/merge_regions/array_read_before_write.out Normal file
View File

@@ -0,0 +1,36 @@
PROGRAM JAC2D
PARAMETER (L = 8000,ITMAX = 100)
!DVM$ ALIGN A(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ ALIGN B(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ DYNAMIC A,B
REAL :: A(L,L),EPS,MAXEPS,B(L,L)
DOUBLE PRECISION :: STARTT,ENDT,DVTIME
!DVM$ TEMPLATE,COMMON:: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: DVMH_TEMP0
!DVM$ DYNAMIC DVMH_TEMP0
B(1,1) = 2.0
!DVM$ ACTUAL (B)
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON A(I,J), REMOTE_ACCESS (B(1,1)),PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
A(I,J) = I * J + B(1,1)
ENDDO
ENDDO
!DVM$ END REGION
B(1,1) = 3.0
!DVM$ ACTUAL (B)
A(1,1) = 10
!DVM$ ACTUAL (A)
EPS = 15
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON B(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
B(I,J) = 0. + A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
MAXEPS = EPS
END

21
tests/sapfor/merge_regions/read_before_read.in Normal file
View File

@@ -0,0 +1,21 @@
program jac2d
parameter (l = 8000,itmax = 100)
real a(l,l),eps,maxeps,b(l,l)
double precision startt,endt,dvtime
b(1,1) = 2.0
do j = 1,l
do i = 1,l
a(i,j) = i*j+eps
enddo
enddo
a(1,1) = 10+eps
do j = 1,l
do i = 1,l
b(i,j) = 0. + a(i,j) + eps
enddo
enddo
maxeps = eps
end

32
tests/sapfor/merge_regions/read_before_read.out Normal file
View File

@@ -0,0 +1,32 @@
PROGRAM JAC2D
PARAMETER (L = 8000,ITMAX = 100)
!DVM$ ALIGN A(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ ALIGN B(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ DYNAMIC A,B
REAL :: A(L,L),EPS,MAXEPS,B(L,L)
DOUBLE PRECISION :: STARTT,ENDT,DVTIME
!DVM$ TEMPLATE,COMMON:: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: DVMH_TEMP0
!DVM$ DYNAMIC DVMH_TEMP0
B(1,1) = 2.0
!DVM$ ACTUAL (B)
A(1,1) = 10 + EPS
!DVM$ ACTUAL (A)
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON A(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
A(I,J) = I * J + EPS
ENDDO
ENDDO
!DVM$ PARALLEL (J,I) ON B(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
B(I,J) = 0. + A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
MAXEPS = EPS
END

23
tests/sapfor/merge_regions/read_in_loop_header.in Normal file
View File

@@ -0,0 +1,23 @@
program jac2d
parameter (l = 8000,itmax = 100)
real a(l,l),eps,maxeps,b(l,l)
double precision startt,endt,dvtime
b(1,1) = 2.0
do j = 1,l+eps
do i = 1,l
a(i,j) = i*j
enddo
enddo
b(1,1) = 3.0
a(1,1) = 10
eps = 15
do j = 1,l
do i = 1,l
b(i,j) = 0. + a(i,j) + eps
enddo
enddo
maxeps = eps
end

36
tests/sapfor/merge_regions/read_in_loop_header.out Normal file
View File

@@ -0,0 +1,36 @@
PROGRAM JAC2D
PARAMETER (L = 8000,ITMAX = 100)
!DVM$ ALIGN A(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ ALIGN B(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ DYNAMIC A,B
REAL :: A(L,L),EPS,MAXEPS,B(L,L)
DOUBLE PRECISION :: STARTT,ENDT,DVTIME
!DVM$ TEMPLATE,COMMON:: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: DVMH_TEMP0
!DVM$ DYNAMIC DVMH_TEMP0
B(1,1) = 2.0
!DVM$ ACTUAL (B)
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON A(I,J), PRIVATE (J,I)
DO J = 1,L + EPS
DO I = 1,L
A(I,J) = I * J
ENDDO
ENDDO
!DVM$ END REGION
B(1,1) = 3.0
!DVM$ ACTUAL (B)
A(1,1) = 10
!DVM$ ACTUAL (A)
EPS = 15
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON B(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
B(I,J) = 0. + A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
MAXEPS = EPS
END

28
tests/sapfor/merge_regions/var_modified_in_fun.in Normal file
View File

@@ -0,0 +1,28 @@
program jac2d
parameter (l = 8000,itmax = 100)
real a(l,l),eps,maxeps,b(l,l)
double precision startt,endt,dvtime
b(1,1) = 2.0
do j = 1,l
do i = 1,l
a(i,j) = i*a(i,j)+eps
enddo
enddo
b(1,1) = 10 + func(b,eps)
do j = 1,l
do i = 1,l
b(i,j) = 0. + a(i,j) + eps
enddo
enddo
maxeps = eps
end
function func(a,b) result(j)
real :: a(l,l) ! input
real :: b ! input
real :: j ! output
b = a(1,1)*5+b
end function func

57
tests/sapfor/merge_regions/var_modified_in_fun.out Normal file
View File

@@ -0,0 +1,57 @@
! *** generated by SAPFOR with version 1473 and build date: Dec 24 2019 21:52:22
PROGRAM JAC2D
PARAMETER (L = 8000,ITMAX = 100)
!DVM$ ALIGN A(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ ALIGN B(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ DYNAMIC A,B
REAL :: A(L,L),EPS,MAXEPS,B(L,L)
DOUBLE PRECISION :: STARTT,ENDT,DVTIME
!DVM$ TEMPLATE,COMMON:: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: DVMH_TEMP0
!DVM$ DYNAMIC DVMH_TEMP0
B(1,1) = 2.0
!DVM$ ACTUAL (B)
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON A(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
A(I,J) = I * A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
!DVM$ GET_ACTUAL (B)
B(1,1) = 10 + FUNC (B,EPS)
!DVM$ ACTUAL (B)
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON B(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
B(I,J) = 0. + A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
MAXEPS = EPS
END
FUNCTION FUNC (A, B) RESULT(J)
!DVM$ INHERIT A
!DVM$ DYNAMIC A
! input
!DVM$ TEMPLATE, COMMON :: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE DVMH_TEMP0(BLOCK,BLOCK)
!DVM$ DYNAMIC DVMH_TEMP0
REAL :: A(L,L)
! input
REAL :: B
! output
REAL :: J
!DVM$ GET_ACTUAL (A)
!DVM$ REMOTE_ACCESS (A(1,1))
B = A(1,1) * 5 + B
END

24
tests/sapfor/merge_regions/var_read_before_write.in Normal file
View File

@@ -0,0 +1,24 @@
program jac2d
parameter (l = 8000,itmax = 100)
real a(l,l),eps,maxeps,b(l,l)
double precision startt,endt,dvtime
b(1,1) = 2.0
do j = 1,l
do i = 1,l
a(i,j) = i*j+eps
enddo
enddo
b(1,1) = 3.0
a(1,1) = 10
eps = 15
do j = 1,l
do i = 1,l
b(i,j) = 0. + a(i,j) + eps
enddo
enddo
maxeps = eps
end

36
tests/sapfor/merge_regions/var_read_before_write.out Normal file
View File

@@ -0,0 +1,36 @@
PROGRAM JAC2D
PARAMETER (L = 8000,ITMAX = 100)
!DVM$ ALIGN A(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ ALIGN B(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ DYNAMIC A,B
REAL :: A(L,L),EPS,MAXEPS,B(L,L)
DOUBLE PRECISION :: STARTT,ENDT,DVTIME
!DVM$ TEMPLATE,COMMON:: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: DVMH_TEMP0
!DVM$ DYNAMIC DVMH_TEMP0
B(1,1) = 2.0
!DVM$ ACTUAL (B)
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON A(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
A(I,J) = I * J + EPS
ENDDO
ENDDO
!DVM$ END REGION
B(1,1) = 3.0
!DVM$ ACTUAL (B)
A(1,1) = 10
!DVM$ ACTUAL (A)
EPS = 15
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON B(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
B(I,J) = 0. + A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
MAXEPS = EPS
END

23
tests/sapfor/merge_regions/write_before_read.in Normal file
View File

@@ -0,0 +1,23 @@
program jac2d
parameter (l = 8000,itmax = 100)
real a(l,l),eps,maxeps,b(l,l)
double precision startt,endt,dvtime
b(1,1) = 2.0
do j = 1,l+eps
do i = 1,l
a(i,j) = i*j
enddo
enddo
b(1,1) = 3.0+a(1,1)
a(1,1) = 10
eps = 15
do j = 1,l
do i = 1,l
b(i,j) = 0. + a(i,j) + eps
enddo
enddo
maxeps = eps
end

38
tests/sapfor/merge_regions/write_before_read.out Normal file
View File

@@ -0,0 +1,38 @@
PROGRAM JAC2D
PARAMETER (L = 8000,ITMAX = 100)
!DVM$ ALIGN A(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ ALIGN B(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ DYNAMIC A,B
REAL :: A(L,L),EPS,MAXEPS,B(L,L)
DOUBLE PRECISION :: STARTT,ENDT,DVTIME
!DVM$ TEMPLATE,COMMON:: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: DVMH_TEMP0
!DVM$ DYNAMIC DVMH_TEMP0
B(1,1) = 2.0
!DVM$ ACTUAL (B)
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON A(I,J), PRIVATE (J,I)
DO J = 1,L + EPS
DO I = 1,L
A(I,J) = I * J
ENDDO
ENDDO
!DVM$ END REGION
!DVM$ GET_ACTUAL (A)
!DVM$ REMOTE_ACCESS (A(1,1))
B(1,1) = 3.0 + A(1,1)
!DVM$ ACTUAL (B)
A(1,1) = 10
!DVM$ ACTUAL (A)
EPS = 15
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON B(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
B(I,J) = 0. + A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
MAXEPS = EPS
END

23
tests/sapfor/merge_regions/write_before_write.in Normal file
View File

@@ -0,0 +1,23 @@
program jac2d
parameter (l = 8000,itmax = 100)
real a(l,l),eps,maxeps,b(l,l)
double precision startt,endt,dvtime
b(1,1) = 2.0
do j = 1,l
do i = 1,l
a(i,j) = i*j
enddo
enddo
b(1,1) = 3.0
a(1,1) = 10
eps = 15
do j = 1,l
do i = 1,l
b(i,j) = 0. + a(i,j) + eps
enddo
enddo
maxeps = eps
end

34
tests/sapfor/merge_regions/write_before_write.out Normal file
View File

@@ -0,0 +1,34 @@
PROGRAM JAC2D
PARAMETER (L = 8000,ITMAX = 100)
!DVM$ ALIGN A(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ ALIGN B(IEX1,IEX2) WITH DVMH_TEMP0(IEX1,IEX2)
!DVM$ DYNAMIC A,B
REAL :: A(L,L),EPS,MAXEPS,B(L,L)
DOUBLE PRECISION :: STARTT,ENDT,DVTIME
!DVM$ TEMPLATE,COMMON:: DVMH_TEMP0(1:8000,1:8000)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: DVMH_TEMP0
!DVM$ DYNAMIC DVMH_TEMP0
B(1,1) = 2.0
!DVM$ ACTUAL (B)
B(1,1) = 3.0
!DVM$ ACTUAL (B)
A(1,1) = 10
!DVM$ ACTUAL (A)
EPS = 15
!DVM$ REGION
!DVM$ PARALLEL (J,I) ON A(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
A(I,J) = I * J
ENDDO
ENDDO
!DVM$ PARALLEL (J,I) ON B(I,J), PRIVATE (J,I)
DO J = 1,L
DO I = 1,L
B(I,J) = 0. + A(I,J) + EPS
ENDDO
ENDDO
!DVM$ END REGION
MAXEPS = EPS
END

1513
tests/sapfor/parameter/magnit_3d.for Normal file
View File

File diff suppressed because it is too large Load Diff

610
tests/sapfor/parameter/mycom.for Normal file
View File

@@ -0,0 +1,610 @@
! ----------------------------------------------------------------------
! My common library. Modified 03/09/2017.
! ----------------------------------------------------------------------
! Modified DEGREE function:
! ----------------------------------------------------------------------
FUNCTION DEGREE (A, B)
!
IMPLICIT REAL*8 (A-H,O-Z)
IMPLICIT INTEGER*4 (I-N)
!
IF (A .GE. 1D-15) THEN
DEGREE = A** B
ELSE
DEGREE = 0D0
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Modified SQRT function:
! ----------------------------------------------------------------------
FUNCTION DSQRTM (A)
!
IMPLICIT REAL*8 (A-H,O-Z)
IMPLICIT INTEGER*4 (I-N)
!
IF (A .GE. 1D-15) THEN
DSQRTM = DSQRT (A)
ELSE
DSQRTM = 0D0
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Modified exponent function:
! ----------------------------------------------------------------------
FUNCTION DEXPM (X)
!
IMPLICIT REAL*8 (A-H,O-Z)
IMPLICIT INTEGER*4 (I-N)
!
IF (X .LE. (-(308D0))) THEN
DEXPM = 0D0
ELSE
DEXPM = DEXP (X)
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Modified sin:
! ----------------------------------------------------------------------
REAL*8 FUNCTION DSINM (X)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
Y = DSIN (X)
!
IF (DABS (Y) .GT. 1D-15) THEN
DSINM = Y
ELSE
DSINM = 0D0
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Modified cosin:
! ----------------------------------------------------------------------
REAL*8 FUNCTION DCOSM (X)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
Y = DCOS (X)
!
IF (DABS (Y) .GT. 1D-15) THEN
DCOSM = Y
ELSE
DCOSM = 0D0
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Output function DZERO:
! ----------------------------------------------------------------------
FUNCTION DZERO (A)
!
IMPLICIT REAL*8 (A-H,O-Z)
IMPLICIT INTEGER*4 (I-N)
!
B = DABS (A)
!
IF (B .GE. 1D-99) THEN
DZERO = A
ELSE
DZERO = 0D0
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Output function DZERO2:
! ----------------------------------------------------------------------
FUNCTION DZERO2 (A, EPS)
!
IMPLICIT REAL*8 (A-H,O-Z)
IMPLICIT INTEGER*4 (I-N)
!
B = DABS (A)
!
IF (B .GE. EPS) THEN
DZERO2 = A
ELSE
DZERO2 = 0D0
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Angle of point (x,y), angle in [0,2pi)
! ----------------------------------------------------------------------
FUNCTION DANGLE (X, Y)
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
C_PI = 4D0 * DATAN (1D0)
!
IF (X .EQ. 0D0) THEN
IF (Y .EQ. 0D0) THEN
!- x = 0, y = 0
A = 0D0
ELSE IF (Y .GT. 0D0) THEN
!- x = 0, y > 0
A = .5D0 * C_PI
ELSE
!- x = 0, y < 0
A = 1.5D0 * C_PI
ENDIF
ELSE IF (Y .EQ. 0D0) THEN
IF (X .GT. 0D0) THEN
!- x > 0, y = 0
A = 0D0
ELSE
!- x < 0, y = 0
A = C_PI
ENDIF
!- x <> 0, y <> 0
ELSE
AX = DABS (X)
AY = DABS (Y)
!- |x| = |y|
IF (AX .EQ. AY) THEN
IF (X .GT. 0D0) THEN
IF (Y .GT. 0D0) THEN
!- x > 0, y > 0
A = 0.25D0 * C_PI
ELSE
!- x > 0, y < 0
A = 1.75D0 * C_PI
ENDIF
ELSE
IF (Y .GT. 0D0) THEN
!- x < 0, y > 0
A = 0.75D0 * C_PI
ELSE
!- x < 0, y < 0
A = 1.25D0 * C_PI
ENDIF
ENDIF
ELSE
IF (AX .GT. AY) THEN
!- |x| > |y|
A = DATAN (AY / AX)
ELSE
!- |x| < |y|
A = .5D0 * C_PI - DATAN (AX / AY)
ENDIF
IF (X .LT. 0D0) THEN
IF (Y .LT. 0D0) THEN
!- x < 0, y < 0
A = C_PI + A
ELSE
!- x < 0, y > 0
A = C_PI - A
ENDIF
ELSE
IF (Y .LT. 0D0) THEN
!- x > 0, y < 0
A = 2D0 * C_PI - A
ENDIF
ENDIF
ENDIF
ENDIF
!
DANGLE = A
!
RETURN
END
! ----------------------------------------------------------------------
! My Entier:
! ----------------------------------------------------------------------
INTEGER*4 FUNCTION MYROUND (X)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
I = IDINT (X)
Z = X - 1D0 * I
!
IF (Z .LE. 0.5D0) THEN
MYROUND = I
ELSE
MYROUND = I + 1
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! f(x) is set by three points: (x1,f1), (x2,f2), (x3,f3)
!
! P2(x) = f2 + c1*(x-x2) + c2*(x-x2)*(x-x2) - approximation
! ----------------------------------------------------------------------
FUNCTION FP2 (X1, X2, X3, F1, F2, F3, X)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
DX12 = X1 - X2
DX32 = X3 - X2
!
DFDX12 = (F1 - F2) / DX12
DFDX32 = (F3 - F2) / DX32
!
C2 = (DFDX32 - DFDX12) / (DX32 - DX12)
C1 = DFDX12 - C2 * DX12
!
FP2 = F2 + C1 * (X - X2) + C2 * (X - X2) * (X - X2)
!
RETURN
END
! ----------------------------------------------------------------------
! P2'(x) = c1 + 2*c2*(x-x2)
! ----------------------------------------------------------------------
FUNCTION FP2P1 (X1, X2, X3, F1, F2, F3, X)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
DX12 = X1 - X2
DX32 = X3 - X2
!
DFDX12 = (F1 - F2) / DX12
DFDX32 = (F3 - F2) / DX32
!
C2 = (DFDX32 - DFDX12) / (DX32 - DX12)
C1 = DFDX12 - C2 * DX12
!
FP2P1 = C1 + 2D0 * C2 * (X - X2)
!
RETURN
END
! ----------------------------------------------------------------------
! In integer range:
! ----------------------------------------------------------------------
INTEGER*4 FUNCTION IN_RANGE_I (I1, I2, I)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
IF (I1 .LE. I .AND. I .LE. I2) THEN
IN_RANGE_I = 0
ELSE
IN_RANGE_I = 1
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! In real range:
! ----------------------------------------------------------------------
INTEGER*4 FUNCTION IN_RANGE_D (A, B, X)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
IF (A .LE. X .AND. X .LE. B) THEN
IN_RANGE_D = 0
ELSE
IF (X .LT. A) THEN
IN_RANGE_D = 1
ELSE
IN_RANGE_D = 2
ENDIF
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Compare of edges & faces:
! ----------------------------------------------------------------------
FUNCTION ICMP2 (I1, I2, I3, I4)
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
IF (I1 .LE. I2) THEN
K1 = I1
K2 = I2
ELSE
K1 = I2
K2 = I1
ENDIF
!
IF (I3 .LE. I4) THEN
K3 = I3
K4 = I4
ELSE
K3 = I4
K4 = I3
ENDIF
!
IF (K1 .EQ. K3 .AND. K2 .EQ. K4) THEN
ICMP2 = 1
ELSE
ICMP2 = 0
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Section procedure:
! ----------------------------------------------------------------------
SUBROUTINE SECT1D (NP, MP, IB, IE, I1, I2)
!
IMPLICIT REAL*8 (A-H,O-Z)
IMPLICIT INTEGER*4 (I-N)
!
IF (NP .EQ. 1) THEN
I1 = IB
I2 = IE
ELSE
NC = IE - IB + 1
NI = NC / NP
MI = NC - NI * NP
!
IF (MP + 1 .LE. MI) THEN
I1 = IB + MP * (NI + 1)
I2 = I1 + NI
ELSE
I1 = IB + MI * (NI + 1) + (MP - MI) * NI
I2 = I1 + NI - 1
ENDIF
ENDIF
!
RETURN
END
! ----------------------------------------------------------------------
! Length of string.
! ----------------------------------------------------------------------
INTEGER FUNCTION LENSTR (S)
CHARACTER*(*) :: S
L = LEN (S)
1 IF (S(L:L) .EQ. ' ') THEN
L = L - 1
IF (L .GT. 0) GOTO 1
ENDIF
LENSTR = L
RETURN
END
! ----------------------------------------------------------------------
! Read string:
! ----------------------------------------------------------------------
SUBROUTINE READSTR (ICH, STR, IER)
!
CHARACTER*(*) :: STR
!
IER = (-(1))
!
N = MIN0 (1024,LEN (STR))
!
IF (N .LT. 1) GOTO 10
!
IER = (-(2))
!
DO I = 1,N
STR(I:I) = ' '
ENDDO
!
K = 0
!
DO WHILE (.NOT.(EOF (ICH)) .AND. K .EQ. 0)
READ (UNIT = ICH,FMT = '(1024(a1))',END = 5,ERR = 10) (STR(I:I)
&, I = 1,1024)
5 IF (STR(1:1) .NE. '#') K = 1
ENDDO
!
IER = 0
!
10 RETURN
END
! ----------------------------------------------------------------------
! Tecplot 2D, integer*4
! ----------------------------------------------------------------------
SUBROUTINE TPL2D_REC_I (ICH, FNAME, TNAME, VNAME, N1, N2, X1, X2,
&X3)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
CHARACTER*(*) :: FNAME,TNAME,VNAME
!
REAL*8 :: X1(N1),X2(N2)
INTEGER*4 :: X3(N1,N2)
!
OPEN (UNIT = ICH,FILE = FNAME)
!
WRITE (UNIT = ICH,FMT = *) TNAME
WRITE (UNIT = ICH,FMT = *) VNAME
WRITE (UNIT = ICH,FMT = *) 'ZONE T="BIG" I=',N1,' J=',N2,' F=POINT
&'
!
DO J = 1,N2
V2 = X2(J)
DO I = 1,N1
V1 = X1(I)
V3 = 1D0 * X3(I,J)
WRITE (UNIT = ICH,FMT = '(3(1x,1pe15.8))') V1,V2,V3
ENDDO
ENDDO
!
CLOSE (UNIT = ICH)
!
RETURN
END
! ----------------------------------------------------------------------
! Tecplot 2D, real*8
! ----------------------------------------------------------------------
SUBROUTINE TPL2D_REC_D (ICH, FNAME, TNAME, VNAME, N1, N2, X1, X2,
&X3)
!
IMPLICIT INTEGER*4 (I-N)
IMPLICIT REAL*8 (A-H,O-Z)
!
CHARACTER*(*) :: FNAME,TNAME,VNAME
!
REAL*8 :: X1(N1),X2(N2)
REAL*8 :: X3(N1,N2)
!
OPEN (UNIT = ICH,FILE = FNAME)
!
WRITE (UNIT = ICH,FMT = *) TNAME
WRITE (UNIT = ICH,FMT = *) VNAME
WRITE (UNIT = ICH,FMT = *) 'ZONE T="BIG" I=',N1,' J=',N2,' F=POINT
&'
!
DO J = 1,N2
V2 = X2(J)
DO I = 1,N1
V1 = X1(I)
V3 = X3(I,J)
WRITE (UNIT = ICH,FMT = '(3(1x,1pe15.8))') V1,V2,V3
ENDDO
ENDDO
!
CLOSE (UNIT = ICH)
!
RETURN
END

50
tests/sapfor/parameter/parameter.f90 Normal file
View File

@@ -0,0 +1,50 @@
program PARAMTER
call check
end
module constants
implicit none
real, parameter::pi = 3.1415926536
real, parameter::e = 2.7182818285
contains
subroutine show_consts()
print*, "Pi = ", pi
contains
subroutine show_e()
print*, "e = ", e
end subroutine show_e
end subroutine show_consts
end module constants
subroutine check
implicit none
use constants!, only: pi, p=>pi
common /global/ key
real key
integer n,m,k,l,pn,nl,i,j,ii,jj,nnl
parameter(N=6,M=8,K=8,L=6,PN=2,NL=1000)
integer A(N,M,K,L)
character*9 tname
tname='check'
NNL=NL
!$SPF ANALYSIS(PARAMETER(N=N))
!$SPF ANALYSIS(PARAMETER(N=6))
!$SPF ANALYSIS(PARAMETER(N=6,M=8))
!$SPF ANALYSIS(PARAMETER(N=M-2))
!$SPF ANALYSIS(PARAMETER(A(i,j,ii,jj)=M-2, i=1))
do i=1,N
!$SPF ANALYSIS(PARAMETER(M=8))
do j=1,M
do ii=1,K
do jj=1,L
!$SPF ANALYSIS(PARAMETER(NL=9*111+1))
!$SPF ANALYSIS(PARAMETER(A(i,j,ii,jj)=M-2, i=1))
!$SPF ANALYSIS(PARAMETER(A=(M-2)*key))
A(i,j,ii,jj) = NL+i+j+ii+jj
enddo
enddo
enddo
enddo
end

50
tests/sapfor/private_removing/test.f Normal file
View File

@@ -0,0 +1,50 @@
program test
double precision :: y(10, 10), x(10, 10), a
integer :: n, m
n=10
m=15
! y can be removed
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
do j = 1, m
y(1, j) = j * i
y(2, j) = j / i
enddo
do jj = 1, m
x(1, jj) = y(1, jj)
x(2, jj) = y(2, jj)
! correct result:
! x(1, jj) = jj * i
! x(2, jj) = jj / i
enddo
do j = 1, m
y(2, j) = j * 100
y(3, j) = j / 200
enddo
do jj = 2, m - 1
x(1, jj) = y(2, jj - 1)
x(2, jj) = y(3, jj + 1)
! correct result:
! x(1, jj) = (jj - 1) * 100
! x(2, jj) = (jj + 1) / 200
enddo
enddo
! y can be removed
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
do j = 1, m
y(j, i) = j * i
enddo
do jj = 1, m
x(jj, i) = y(jj, i)
! correct result:
! x(jj, i) = jj * i
enddo
enddo
end

75
tests/sapfor/private_removing/test_cannot_remove.f Normal file
View File

@@ -0,0 +1,75 @@
program test_cannot_remove
double precision :: y(10, 10), x(10, 10), a
integer :: n, m
n=10
m=15
! y cannot be removed - it is uninitialized
! (cannot find reaching definition)
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
y(1, i) = 100
x(i, i) = y(2, i)
enddo
! y cannot be removed - more than one reaching definition
! reaches the statement
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
if (i .eq. 1) then
y(1, i) = 100
else
y(1, i) = 200
endif
x(i, i) = y(1, i)
enddo
! y cannot be removed - y doesn't match any fixed dimensions mask
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
do j = 1, m
y(1, i) = j * i
enddo
do j = 1, m
x(j, i) = y(j, i)
enddo
enddo
! y cannot be removed - y doesn't match any fixed dimensions mask
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
do j = 1, m
y(1, i - 1) = j * i
enddo
do j = 1, m
x(j, i) = y(1, i)
enddo
enddo
! y cannot be removed - y doesn't match any fixed dimensions mask
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
do j = 1, m
y(i, 1) = j * i
enddo
do j = 1, m
x(j, i) = y(1, i)
enddo
enddo
! y cannot be removed - y depends on non-invariant var 'a'
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
do j = 1, m
a = 2 * i
y(j, i) = j * i + a
enddo
do j = 1, m
x(j, i) = y(j, i)
enddo
enddo
end

45
tests/sapfor/private_removing/test_cascade.f Normal file
View File

@@ -0,0 +1,45 @@
program test_cascade
double precision :: y(10, 10), x(10, 10)
integer :: n, m
n=10
m=15
! y can be removed in 3 steps:
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
do j = 1, m
y(1, j) = 2
enddo
do j = 1, m
y(1, j) = y(1, j) * 10
enddo
do j = 1, m
x(j, i) = y(1, j)
! correct result:
! x(j, i) = 2 * 10
enddo
do j = 1, m
y(2, j) = y(1, i) * 20
enddo
do j = 1, m
x(j, i) = y(2, j)
! correct result:
! x(j, i) = 2 * 10 * 20
enddo
enddo
! y can be removed is 2 steps:
!$SPF ANALYSIS(PRIVATE(y))
do i = 1, n
y(1, i) = 2
do j = 1, m
y(1, i) = y(1, i) * 10
x(j, i) = y(1, i)
! correct result:
! x(j, i) = 2 * 10
enddo
enddo
end

12
tests/sapfor/shrink/error.f Normal file
View File

@@ -0,0 +1,12 @@
PROGRAM TEST
INTEGER I, K, N
DOUBLE PRECISION A(20, 20), TMP_BR1(7, 14)
N = 5
!$SPF TRANSFORM(SHRINK(TMP_BR1 (1, 0)))
DO I = 1,N
DO K = 1,N
TMP_BR1(K,I) = I + 7
A(K,I) = TMP_BR1(K,I) + 12
ENDDO
ENDDO
END

16
tests/sapfor/shrink/error2.f Normal file
View File

@@ -0,0 +1,16 @@
PROGRAM TEST
INTEGER I, K, N, C(20)
DOUBLE PRECISION A(20, 20), TMP_BR1(7, 14)
N = 5
I = 1
!$SPF TRANSFORM(SHRINK(TMP_BR1 (1, 0), A(0, 0, 2), N, C, A(i,1),
!$SPF&K))
!$SPF ANALYSIS(PRIVATE(TMP_BR1,
!$SPF&A))
DO I = 1,N
DO K = 1,N
TMP_BR1(K,I) = I + 7
A(K,I) = TMP_BR1(K,I) + 12
ENDDO
ENDDO
END

16
tests/sapfor/shrink/error3.f Normal file
View File

@@ -0,0 +1,16 @@
PROGRAM TEST
INTEGER I, K, N, C(20)
DOUBLE PRECISION A(20, 20), TMP_BR1(7, 14)
N = 5
I = 1
!$SPF TRANSFORM(SHRINK(TMP_BR1 (1, 0), A(0, 0), C(1), A(0,1),
!$SPF&c))
!$SPF ANALYSIS(PRIVATE(TMP_BR1,
!$SPF&A, C))
DO I = 1,N
DO K = 1,N
TMP_BR1(K,I) = I + 7
A(K,I) = TMP_BR1(K,I) + 12
ENDDO
ENDDO
END

13
tests/sapfor/shrink/shrink.f Normal file
View File

@@ -0,0 +1,13 @@
PROGRAM TEST
INTEGER I, K, N
DOUBLE PRECISION A(20, 20), TMP_BR1(7, 14)
N = 5
!$SPF TRANSFORM(SHRINK(TMP_BR1 (1, 0)))
!$SPF ANALYSIS(PRIVATE(TMP_BR1))
DO I = 1,N
DO K = 1,N
TMP_BR1(K,I) = I + 7
A(K,I) = TMP_BR1(K,I) + 12
ENDDO
ENDDO
END

13
tests/sapfor/shrink/shrink2.f Normal file
View File

@@ -0,0 +1,13 @@
PROGRAM TEST
INTEGER I, K, N
DOUBLE PRECISION A(20, 20), TMP_BR1(7, 14)
N = 5
!$SPF TRANSFORM(SHRINK(TMP_BR1 (1, 0), A(0, 1)))
!$SPF ANALYSIS(PRIVATE(TMP_BR1, A))
DO I = 1,N
DO K = 1,N
TMP_BR1(K,I) = I + 7
A(K,I) = TMP_BR1(K,I) + 12
ENDDO
ENDDO
END

16
tests/sapfor/shrink/shrink3.f Normal file
View File

@@ -0,0 +1,16 @@
PROGRAM TEST
INTEGER I, K, N, C(20)
DOUBLE PRECISION A(20, 20), TMP_BR1(7, 14)
N = 5
I = 1
!$SPF TRANSFORM(SHRINK(TMP_BR1 (1, 0), A(0, 0), C(1), A(0,1),
!$SPF&c(0)))
!$SPF ANALYSIS(PRIVATE(TMP_BR1,
!$SPF&A, C))
DO I = 1,N
DO K = 1,N
TMP_BR1(K,I) = I + 7
A(K,I) = TMP_BR1(K,I) + 12
ENDDO
ENDDO
END