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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_fraction_exponent.f90] - Blame information for rev 695

Line No.	Rev	Author	Line
1	695	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