OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_fraction_exponent.f90] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 303 jeremybenn
!Program to test EXPONENT and FRACTION intrinsic function.
2
 
3
program test_exponent_fraction
4
  real x
5
  integer*4 i
6
  real*8 y
7
  integer*8 j
8
  equivalence (x, i), (y, j)
9
 
10
  x = 3.
11
  call test_4(x)
12
 
13
  x = 0.
14
  call test_4(x)
15
 
16
  i = o'00000000001'
17
  call test_4(x)
18
 
19
  i = o'00010000000'
20
  call test_4(x)
21
 
22
  i = o'17700000000'
23
  call test_4(x)
24
 
25
  i = o'00004000001'
26
  call test_4(x)
27
 
28
  i = o'17737777777'
29
  call test_4(x)
30
 
31
  i = o'10000000000'
32
  call test_4(x)
33
 
34
  i = o'0000010000'
35
  call test_4(x)
36
 
37
  y = 0.5
38
  call test_8(y)
39
 
40
  y = 0.
41
  call test_8(y)
42
 
43
  j = o'00000000001'
44
  call test_8(y)
45
 
46
  y = 0.2938735877D-38
47
  call test_8(y)
48
 
49
  y = -1.469369D-39
50
  call test_8(y)
51
 
52
  y = z'7fe00000'
53
  call test_8(y)
54
 
55
  y = -5.739719D+42
56
  call test_8(y)
57
end
58
 
59
subroutine test_4(x)
60
real*4 x,y
61
integer z
62
y = fraction (x)
63
z = exponent(x)
64
if (z .gt. 0) then
65
  y = (y * 2.) * (2. ** (z - 1))
66
else
67
  y = (y / 2.) * (2. ** (z + 1))
68
end if
69
if (abs (x - y) .gt. spacing (max (abs (x), abs (y)))) call abort()
70
end
71
 
72
subroutine test_8(x)
73
real*8 x, y
74
integer z
75
y = fraction (x)
76
z = exponent(x)
77
if (z .gt. 0) then
78
  y = (y * 2._8) * (2._8 ** (z - 1))
79
else
80
  y = (y / 2._8) * (2._8 ** (z + 1))
81
end if
82
if (abs (x - y) .gt. spacing (max (abs (x), abs(y)))) call abort()
83
end
84
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.