1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
! Test the BGE, BGT, BLE and BLT intrinsics.
!
! { dg-do run }
! { dg-options "-ffree-line-length-none" }
interface run_bge
procedure run_bge1
procedure run_bge2
procedure run_bge4
procedure run_bge8
end interface
interface run_bgt
procedure run_bgt1
procedure run_bgt2
procedure run_bgt4
procedure run_bgt8
end interface
interface run_ble
procedure run_ble1
procedure run_ble2
procedure run_ble4
procedure run_ble8
end interface
interface run_blt
procedure run_blt1
procedure run_blt2
procedure run_blt4
procedure run_blt8
end interface
#define CHECK(I,J,RES) \
if (bge(I,J) .neqv. RES) call abort ; \
if (run_bge(I,J) .neqv. RES) call abort ; \
if (bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
if (run_bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
if (ble(J,I) .neqv. RES) call abort ; \
if (run_ble(J,I) .neqv. RES) call abort ; \
if (blt(J,I) .neqv. (RES .and. (I/=J))) call abort ; \
if (run_blt(J,I) .neqv. (RES .and. (I/=J))) call abort
#define T .true.
#define F .false.
CHECK(0_1, 0_1, T)
CHECK(1_1, 0_1, T)
CHECK(0_1, 107_1, F)
CHECK(5_1, huge(0_1) / 2_1, F)
CHECK(5_1, huge(0_1), F)
CHECK(-1_1, 0_1, T)
CHECK(0_1, -19_1, F)
CHECK(huge(0_1), -19_1, F)
CHECK(0_2, 0_2, T)
CHECK(1_2, 0_2, T)
CHECK(0_2, 107_2, F)
CHECK(5_2, huge(0_2) / 2_2, F)
CHECK(5_2, huge(0_2), F)
CHECK(-1_2, 0_2, T)
CHECK(0_2, -19_2, F)
CHECK(huge(0_2), -19_2, F)
CHECK(0_4, 0_4, T)
CHECK(1_4, 0_4, T)
CHECK(0_4, 107_4, F)
CHECK(5_4, huge(0_4) / 2_4, F)
CHECK(5_4, huge(0_4), F)
CHECK(-1_4, 0_4, T)
CHECK(0_4, -19_4, F)
CHECK(huge(0_4), -19_4, F)
CHECK(0_8, 0_8, T)
CHECK(1_8, 0_8, T)
CHECK(0_8, 107_8, F)
CHECK(5_8, huge(0_8) / 2_8, F)
CHECK(5_8, huge(0_8), F)
CHECK(-1_8, 0_8, T)
CHECK(0_8, -19_8, F)
CHECK(huge(0_8), -19_8, F)
contains
pure logical function run_bge1 (i, j) result(res)
integer(kind=1), intent(in) :: i, j
res = bge(i,j)
end function
pure logical function run_bgt1 (i, j) result(res)
integer(kind=1), intent(in) :: i, j
res = bgt(i,j)
end function
pure logical function run_ble1 (i, j) result(res)
integer(kind=1), intent(in) :: i, j
res = ble(i,j)
end function
pure logical function run_blt1 (i, j) result(res)
integer(kind=1), intent(in) :: i, j
res = blt(i,j)
end function
pure logical function run_bge2 (i, j) result(res)
integer(kind=2), intent(in) :: i, j
res = bge(i,j)
end function
pure logical function run_bgt2 (i, j) result(res)
integer(kind=2), intent(in) :: i, j
res = bgt(i,j)
end function
pure logical function run_ble2 (i, j) result(res)
integer(kind=2), intent(in) :: i, j
res = ble(i,j)
end function
pure logical function run_blt2 (i, j) result(res)
integer(kind=2), intent(in) :: i, j
res = blt(i,j)
end function
pure logical function run_bge4 (i, j) result(res)
integer(kind=4), intent(in) :: i, j
res = bge(i,j)
end function
pure logical function run_bgt4 (i, j) result(res)
integer(kind=4), intent(in) :: i, j
res = bgt(i,j)
end function
pure logical function run_ble4 (i, j) result(res)
integer(kind=4), intent(in) :: i, j
res = ble(i,j)
end function
pure logical function run_blt4 (i, j) result(res)
integer(kind=4), intent(in) :: i, j
res = blt(i,j)
end function
pure logical function run_bge8 (i, j) result(res)
integer(kind=8), intent(in) :: i, j
res = bge(i,j)
end function
pure logical function run_bgt8 (i, j) result(res)
integer(kind=8), intent(in) :: i, j
res = bgt(i,j)
end function
pure logical function run_ble8 (i, j) result(res)
integer(kind=8), intent(in) :: i, j
res = ble(i,j)
end function
pure logical function run_blt8 (i, j) result(res)
integer(kind=8), intent(in) :: i, j
res = blt(i,j)
end function
end
|
