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