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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
|
! Program to test intrinsic functions as actual arguments
!
! Copied from gfortran.fortran-torture/execute/specifics.f90
! Please keep them in sync
!
! It is run here with -ff2c option
!
! { dg-do run }
! { dg-options "-ff2c" }
! Program to test intrinsic functions as actual arguments
subroutine test_c(fn, val, res)
complex fn
complex val, res
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
complex a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_z(fn, val, res)
double complex fn
double complex val, res
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
double complex a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_cabs(fn, val, res)
real fn, res
complex val
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
real a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_cdabs(fn, val, res)
double precision fn, res
double complex val
if (diff(fn(val),res)) call abort
contains
function diff(a,b)
double precision a,b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_r(fn, val, res)
real fn
real val, res
if (diff(fn(val), res)) call abort
contains
function diff(a, b)
real a, b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_d(fn, val, res)
double precision fn
double precision val, res
if (diff(fn(val), res)) call abort
contains
function diff(a, b)
double precision a, b
logical diff
diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine
subroutine test_r2(fn, val1, val2, res)
real fn
real val1, val2, res
if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
real a, b
logical diff
diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine
subroutine test_d2(fn, val1, val2, res)
double precision fn
double precision val1, val2, res
if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
double precision a, b
logical diff
diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine
subroutine test_dprod(fn)
double precision fn
if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) call abort
end subroutine
subroutine test_nint(fn,val,res)
integer fn, res
real val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_idnint(fn,val,res)
integer fn, res
double precision val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_idim(fn,val1,val2,res)
integer fn, res, val1, val2
if (res .ne. fn(val1,val2)) call abort
end subroutine
subroutine test_iabs(fn,val,res)
integer fn, res, val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_len(fn,val,res)
integer fn, res
character(len=*) val
if (res .ne. fn(val)) call abort
end subroutine
subroutine test_index(fn,val1,val2,res)
integer fn, res
character(len=*) val1, val2
if (fn(val1,val2) .ne. res) call abort
end subroutine
program specifics
intrinsic abs
intrinsic aint
intrinsic anint
intrinsic acos
intrinsic acosh
intrinsic asin
intrinsic asinh
intrinsic atan
intrinsic atanh
intrinsic cos
intrinsic sin
intrinsic tan
intrinsic cosh
intrinsic sinh
intrinsic tanh
intrinsic alog
intrinsic alog10
intrinsic exp
intrinsic sign
intrinsic isign
intrinsic amod
intrinsic dabs
intrinsic dint
intrinsic dnint
intrinsic dacos
intrinsic dacosh
intrinsic dasin
intrinsic dasinh
intrinsic datan
intrinsic datanh
intrinsic dcos
intrinsic dsin
intrinsic dtan
intrinsic dcosh
intrinsic dsinh
intrinsic dtanh
intrinsic dlog
intrinsic dlog10
intrinsic dexp
intrinsic dsign
intrinsic dmod
intrinsic conjg
intrinsic ccos
intrinsic cexp
intrinsic clog
intrinsic csin
intrinsic csqrt
intrinsic dconjg
intrinsic cdcos
intrinsic cdexp
intrinsic cdlog
intrinsic cdsin
intrinsic cdsqrt
intrinsic zcos
intrinsic zexp
intrinsic zlog
intrinsic zsin
intrinsic zsqrt
intrinsic cabs
intrinsic cdabs
intrinsic zabs
intrinsic dprod
intrinsic nint
intrinsic idnint
intrinsic dim
intrinsic ddim
intrinsic idim
intrinsic iabs
intrinsic mod
intrinsic len
intrinsic index
intrinsic aimag
intrinsic dimag
call test_r (abs, -1.0, abs(-1.0))
call test_r (aint, 1.7, aint(1.7))
call test_r (anint, 1.7, anint(1.7))
call test_r (acos, 0.5, acos(0.5))
call test_r (acosh, 1.5, acosh(1.5))
call test_r (asin, 0.5, asin(0.5))
call test_r (asinh, 0.5, asinh(0.5))
call test_r (atan, 0.5, atan(0.5))
call test_r (atanh, 0.5, atanh(0.5))
call test_r (cos, 1.0, cos(1.0))
call test_r (sin, 1.0, sin(1.0))
call test_r (tan, 1.0, tan(1.0))
call test_r (cosh, 1.0, cosh(1.0))
call test_r (sinh, 1.0, sinh(1.0))
call test_r (tanh, 1.0, tanh(1.0))
call test_r (alog, 2.0, alog(2.0))
call test_r (alog10, 2.0, alog10(2.0))
call test_r (exp, 1.0, exp(1.0))
call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0))
call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0))
call test_d (dabs, -1d0, abs(-1d0))
call test_d (dint, 1.7d0, 1d0)
call test_d (dnint, 1.7d0, 2d0)
call test_d (dacos, 0.5d0, dacos(0.5d0))
call test_d (dacosh, 1.5d0, dacosh(1.5d0))
call test_d (dasin, 0.5d0, dasin(0.5d0))
call test_d (dasinh, 0.5d0, dasinh(0.5d0))
call test_d (datan, 0.5d0, datan(0.5d0))
call test_d (datanh, 0.5d0, datanh(0.5d0))
call test_d (dcos, 1d0, dcos(1d0))
call test_d (dsin, 1d0, dsin(1d0))
call test_d (dtan, 1d0, dtan(1d0))
call test_d (dcosh, 1d0, dcosh(1d0))
call test_d (dsinh, 1d0, dsinh(1d0))
call test_d (dtanh, 1d0, dtanh(1d0))
call test_d (dlog, 2d0, dlog(2d0))
call test_d (dlog10, 2d0, dlog10(2d0))
call test_d (dexp, 1d0, dexp(1d0))
call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0))
call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0))
call test_dprod (dprod)
call test_c (conjg, (1.2,-4.), conjg((1.2,-4.)))
call test_c (ccos, (1.2,-4.), ccos((1.2,-4.)))
call test_c (cexp, (1.2,-4.), cexp((1.2,-4.)))
call test_c (clog, (1.2,-4.), clog((1.2,-4.)))
call test_c (csin, (1.2,-4.), csin((1.2,-4.)))
call test_c (csqrt, (1.2,-4.), csqrt((1.2,-4.)))
call test_z (dconjg, (1.2d0,-4.d0), dconjg((1.2d0,-4.d0)))
call test_z (cdcos, (1.2d0,-4.d0), cdcos((1.2d0,-4.d0)))
call test_z (zcos, (1.2d0,-4.d0), zcos((1.2d0,-4.d0)))
call test_z (cdexp, (1.2d0,-4.d0), cdexp((1.2d0,-4.d0)))
call test_z (zexp, (1.2d0,-4.d0), zexp((1.2d0,-4.d0)))
call test_z (cdlog, (1.2d0,-4.d0), cdlog((1.2d0,-4.d0)))
call test_z (zlog, (1.2d0,-4.d0), zlog((1.2d0,-4.d0)))
call test_z (cdsin, (1.2d0,-4.d0), cdsin((1.2d0,-4.d0)))
call test_z (zsin, (1.2d0,-4.d0), zsin((1.2d0,-4.d0)))
call test_z (cdsqrt, (1.2d0,-4.d0), cdsqrt((1.2d0,-4.d0)))
call test_z (zsqrt, (1.2d0,-4.d0), zsqrt((1.2d0,-4.d0)))
call test_cabs (cabs, (1.2,-4.), cabs((1.2,-4.)))
call test_cdabs (cdabs, (1.2d0,-4.d0), cdabs((1.2d0,-4.d0)))
call test_cdabs (zabs, (1.2d0,-4.d0), zabs((1.2d0,-4.d0)))
call test_cabs (aimag, (1.2,-4.), aimag((1.2,-4.)))
call test_cdabs (dimag, (1.2d0,-4.d0), dimag((1.2d0,-4.d0)))
call test_nint (nint, -1.2, nint(-1.2))
call test_idnint (idnint, -1.2d0, idnint(-1.2d0))
call test_idim (isign, -42, 17, isign(-42, 17))
call test_idim (idim, -42, 17, idim(-42,17))
call test_idim (idim, 42, 17, idim(42,17))
call test_r2 (dim, 1.2, -4., dim(1.2, -4.))
call test_d2 (ddim, 1.2d0, -4.d0, ddim(1.2d0, -4.d0))
call test_iabs (iabs, -7, iabs(-7))
call test_idim (mod, 5, 2, mod(5,2))
call test_len (len, "foobar", len("foobar"))
call test_index (index, "foobarfoobar", "bar", index("foobarfoobar","bar"))
end program
|
