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
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
|
! { dg-do run }
!
! PR fortran/112371
! The library used to incorrectly set an extent of zero for the first
! dimension of the resulting array of a reduction function if that array was
! empty.
program p
implicit none
call check_iparity
call check_sum
call check_minloc_int
call check_minloc_char
call check_maxloc_char4
call check_minval_char
call check_maxval_char4
call check_any
call check_count4
call check_findloc_int
call check_findloc_char
contains
subroutine check_iparity
integer :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ integer:: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = iparity(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 111
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 112
i = 2
r = iparity(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 113
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 114
i = 3
r = iparity(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 115
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 116
i = 4
r = iparity(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 117
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 118
i = 1
r = iparity(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 121
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 122
i = 2
r = iparity(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 123
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 124
i = 3
r = iparity(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 125
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 126
i = 4
r = iparity(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 127
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 128
i = 1
r = iparity(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 131
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 132
i = 2
r = iparity(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 133
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 134
i = 3
r = iparity(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 135
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 136
i = 4
r = iparity(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 137
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 138
end subroutine
subroutine check_sum
integer :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ integer:: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = sum(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 211
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 212
i = 2
r = sum(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 213
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 214
i = 3
r = sum(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 215
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 216
i = 4
r = sum(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 217
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 218
i = 1
r = sum(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 221
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 222
i = 2
r = sum(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 223
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 224
i = 3
r = sum(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 225
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 226
i = 4
r = sum(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 227
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 228
i = 1
r = sum(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 231
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 232
i = 2
r = sum(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 233
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 234
i = 3
r = sum(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 235
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 236
i = 4
r = sum(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 237
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 238
end subroutine
subroutine check_minloc_int
integer :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ integer:: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 311
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 312
i = 2
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 313
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 314
i = 3
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 315
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 316
i = 4
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 317
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 318
i = 1
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 321
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 322
i = 2
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 323
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 324
i = 3
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 325
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 326
i = 4
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 327
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 328
i = 1
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 331
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 332
i = 2
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 333
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 334
i = 3
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 335
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 336
i = 4
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 337
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 338
end subroutine
subroutine check_minloc_char
character :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ character:: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 411
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 412
i = 2
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 413
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 414
i = 3
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 415
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 416
i = 4
r = minloc(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 417
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 418
i = 1
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 421
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 422
i = 2
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 423
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 424
i = 3
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 425
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 426
i = 4
r = minloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 427
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 428
i = 1
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 431
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 432
i = 2
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 433
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 434
i = 3
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 435
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 436
i = 4
r = minloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 437
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 438
end subroutine
subroutine check_maxloc_char4
character(kind=4) :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ character(kind=4):: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = maxloc(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 511
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 512
i = 2
r = maxloc(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 513
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 514
i = 3
r = maxloc(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 515
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 516
i = 4
r = maxloc(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 517
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 518
i = 1
r = maxloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 521
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 522
i = 2
r = maxloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 523
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 524
i = 3
r = maxloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 525
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 526
i = 4
r = maxloc(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 527
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 528
i = 1
r = maxloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 531
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 532
i = 2
r = maxloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 533
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 534
i = 3
r = maxloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 535
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 536
i = 4
r = maxloc(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 537
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 538
end subroutine
subroutine check_minval_char
character :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
character, allocatable :: r(:,:,:)
a = reshape((/ character:: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = minval(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 611
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 612
i = 2
r = minval(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 613
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 614
i = 3
r = minval(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 615
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 616
i = 4
r = minval(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 617
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 618
i = 1
r = minval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 621
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 622
i = 2
r = minval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 623
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 624
i = 3
r = minval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 625
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 626
i = 4
r = minval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 627
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 628
i = 1
r = minval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 631
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 632
i = 2
r = minval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 633
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 634
i = 3
r = minval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 635
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 636
i = 4
r = minval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 637
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 638
end subroutine
subroutine check_maxval_char4
character(kind=4) :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
character(kind=4), allocatable :: r(:,:,:)
a = reshape((/ character(kind=4):: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = maxval(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 711
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 712
i = 2
r = maxval(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 713
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 714
i = 3
r = maxval(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 715
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 716
i = 4
r = maxval(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 717
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 718
i = 1
r = maxval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 721
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 722
i = 2
r = maxval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 723
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 724
i = 3
r = maxval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 725
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 726
i = 4
r = maxval(a, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 727
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 728
i = 1
r = maxval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 731
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 732
i = 2
r = maxval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 733
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 734
i = 3
r = maxval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 735
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 736
i = 4
r = maxval(a, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 737
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 738
end subroutine
subroutine check_any
logical :: a(9,3,0,7)
integer :: i
logical, allocatable :: r(:,:,:)
a = reshape((/ logical:: /), shape(a))
i = 1
r = any(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 811
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 812
i = 2
r = any(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 813
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 814
i = 3
r = any(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 815
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 816
i = 4
r = any(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 817
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 818
end subroutine
subroutine check_count4
logical(kind=4) :: a(9,3,0,7)
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ logical(kind=4):: /), shape(a))
i = 1
r = count(a, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 911
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 912
i = 2
r = count(a, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 913
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 914
i = 3
r = count(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 915
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 916
i = 4
r = count(a, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 917
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 918
end subroutine
subroutine check_findloc_int
integer :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ integer:: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = findloc(a, 10, dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1011
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1012
i = 2
r = findloc(a, 10, dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1013
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1014
i = 3
r = findloc(a, 10, dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1015
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1016
i = 4
r = findloc(a, 10, dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1017
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1018
i = 1
r = findloc(a, 10, dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1021
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1022
i = 2
r = findloc(a, 10, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1023
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1024
i = 3
r = findloc(a, 10, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1025
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1026
i = 4
r = findloc(a, 10, dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1027
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1028
i = 1
r = findloc(a, 10, dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1031
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1032
i = 2
r = findloc(a, 10, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1033
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1034
i = 3
r = findloc(a, 10, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1035
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1036
i = 4
r = findloc(a, 10, dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1037
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1038
end subroutine
subroutine check_findloc_char
character :: a(9,3,0,7)
logical :: m1(9,3,0,7)
logical(kind=4) :: m4
integer :: i
integer, allocatable :: r(:,:,:)
a = reshape((/ character:: /), shape(a))
m1 = reshape((/ logical:: /), shape(m1))
m4 = .false.
i = 1
r = findloc(a, "a", dim=i)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1111
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1112
i = 2
r = findloc(a, "a", dim=i)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1113
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1114
i = 3
r = findloc(a, "a", dim=i)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1115
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1116
i = 4
r = findloc(a, "a", dim=i)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1117
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1118
i = 1
r = findloc(a, "a", dim=i, mask=m1)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1121
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1122
i = 2
r = findloc(a, "a", dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1123
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1124
i = 3
r = findloc(a, "a", dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1125
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1126
i = 4
r = findloc(a, "a", dim=i, mask=m1)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1127
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1128
i = 1
r = findloc(a, "a", dim=i, mask=m4)
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1131
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1132
i = 2
r = findloc(a, "a", dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1133
if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1134
i = 3
r = findloc(a, "a", dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1135
if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1136
i = 4
r = findloc(a, "a", dim=i, mask=m4)
if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1137
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1138
end subroutine
end program
|
