home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
examples
/
dalib
/
cshift
/
test2.f
< prev
next >
Wrap
Text File
|
1993-03-23
|
2KB
|
88 lines
program shift_test
parameter (n=40)
real a(n,n), b(n,n)
call cmf_random (b)
call test (a,b,n, 1, 1)
call test (a,b,n, 1, -1)
call test (a,b,n, 1, 49)
call test (a,b,n, 1, 51)
call test (a,b,n, 1, -51)
call test (a,b,n, 1, 13)
call test1 (a,b,n, 1, 1)
call test1 (a,b,n, 1, -1)
call test1 (a,b,n, 1, 49)
call test1 (a,b,n, 1, 51)
call test1 (a,b,n, 1, -51)
call test1 (a,b,n, 1, 13)
call test (a,b,n, 2, 1)
call test (a,b,n, 2, -1)
call test (a,b,n, 2, 49)
call test (a,b,n, 2, 51)
call test (a,b,n, 2, -51)
call test (a,b,n, 2, 13)
call test1 (a,b,n, 2, 1)
call test1 (a,b,n, 2, -1)
call test1 (a,b,n, 2, 49)
call test1 (a,b,n, 2, 51)
call test1 (a,b,n, 2, -51)
call test1 (a,b,n, 2, 13)
end
subroutine test (a, b, n, dim, pos)
integer n, dim
real a(n,n), b(n,n)
logical equal (n,n)
integer pos
integer errors
a = b
b = cshift (b, dim, pos)
if (pos .gt. 0) then
do i = 1, pos
a = cshift (a, dim, 1)
end do
end if
if (pos .lt. 0) then
do i = 1, -pos
a = cshift (a, dim, -1)
end do
end if
equal = (b .eq. a)
errors = count (equal)
errors = n*n - errors
print *, errors, ' Errors for one shift in dim', dim,' with pos = ', pos
end
subroutine test1 (a, b, n, dim, pos)
integer n, dim
real a(n,n), b(n,n)
logical equal (n,n)
integer pos
integer errors
a = b
do i = 1, n
a = cshift (a, dim, pos)
end do
equal = (b .eq. a)
errors = count (equal)
errors = n*n - errors
print *, errors, ' Errors for many shift in dim', dim,' with pos = ', pos
end