URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Only display areas with differences |
Details |
Blame |
View Log
Rev 154 |
Rev 816 |
!Program to test SPACING intrinsic function.
|
!Program to test SPACING intrinsic function.
|
|
|
program test_spacing
|
program test_spacing
|
call test_real4(3.0)
|
call test_real4(3.0)
|
call test_real4(33.0)
|
call test_real4(33.0)
|
call test_real4(-3.)
|
call test_real4(-3.)
|
call test_real4(0.0)
|
call test_real4(0.0)
|
call test_real8(0.0_8)
|
call test_real8(0.0_8)
|
call test_real8(3.0_8)
|
call test_real8(3.0_8)
|
call test_real8(33.0_8)
|
call test_real8(33.0_8)
|
call test_real8(-33._8)
|
call test_real8(-33._8)
|
end
|
end
|
subroutine test_real4(orig)
|
subroutine test_real4(orig)
|
real x,y,t,orig
|
real x,y,t,orig
|
integer p
|
integer p
|
x = orig
|
x = orig
|
p = 24
|
p = 24
|
y = 2.0 ** (exponent (x) - p)
|
y = 2.0 ** (exponent (x) - p)
|
t = tiny(x)
|
t = tiny(x)
|
x = spacing(x)
|
x = spacing(x)
|
if ((abs (x - y) .gt. abs(x * 1e-6)) &
|
if ((abs (x - y) .gt. abs(x * 1e-6)) &
|
.and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
|
.and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
|
end
|
end
|
|
|
subroutine test_real8(orig)
|
subroutine test_real8(orig)
|
real*8 x,y,t,orig
|
real*8 x,y,t,orig
|
integer p
|
integer p
|
x = orig
|
x = orig
|
p = 53
|
p = 53
|
y = 2.0 ** (exponent (x) - p)
|
y = 2.0 ** (exponent (x) - p)
|
t = tiny (x)
|
t = tiny (x)
|
x = spacing(x)
|
x = spacing(x)
|
if ((abs (x - y) .gt. abs(x * 1e-6)) &
|
if ((abs (x - y) .gt. abs(x * 1e-6)) &
|
.and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
|
.and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
|
end
|
end
|
|
|
© copyright 1999-2024
OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.