finalyze moving

This commit is contained in:
2025-03-12 14:28:04 +03:00
parent f840006398
commit 033bbce220
774 changed files with 0 additions and 0 deletions

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

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

View File

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

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