home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
examples
/
dalib
/
overlap
/
test3.f
< prev
next >
Wrap
Text File
|
1993-04-27
|
2KB
|
83 lines
program overlap_test
parameter (n=30)
real a(n, n, n)
call cmf_random (a)
call test_leftup1 (a,n)
call test_rightdown2 (a,n)
end
subroutine test_leftup1 (a, n)
integer n
real a(n,n,n), b(n[1:0],n[1:0],n[1:0])
real a1(n,n,n)
logical equal (n,n,n)
integer errors
c call print_a (a, n)
b = a
forall (i=1:n,j=1:n,k=1:n)
a1 (k,j,i) = b (k-1,j-1,i-1)
end forall
c call print_a (a1, n)
a = cshift (a, 1, -1)
a = cshift (a, 2, -1)
a = cshift (a, 3, -1)
c call print_a (a, n)
equal = (a1 .eq. a)
errors = count (equal)
errors = n*n*n - errors
print *, errors, ' Errors for left overlapping'
end
subroutine test_rightdown2 (a, n)
integer n
real a(n,n,n), b(n[0:2],n[0:3],n[0:1])
real a1(n,n,n)
logical equal (n,n,n)
integer errors
c call print_a (a, n)
b = a
forall (i=1:n,j=1:n,k=1:n)
a1 (j,i,k) = b (j+2,i+3,k+1)
end forall
c call print_a (a1, n)
a = cshift (a, 1, 2)
a = cshift (a, 2, 3)
a = cshift (a, 3, 1)
c call print_a (a, n)
equal = (a1 .eq. a)
errors = count (equal)
errors = n*n*n - errors
print *, errors, ' Errors for right overlapping'
end
subroutine print_a (a, n)
real a(n,n,n)
integer i, j, k, n
do i = 1, n
do j = 1, n
do k = 1, n
print *, 'a(',i,',',j,',',k,') = ', a(i,j,k)
end do
end do
end do
end