1 |
694 |
jeremybenn |
! { dg-do run }
|
2 |
|
|
! Check max/minloc.
|
3 |
|
|
! PR fortran/31726
|
4 |
|
|
!
|
5 |
|
|
program test
|
6 |
|
|
implicit none
|
7 |
|
|
integer :: i(1), j(-1:1), res(1)
|
8 |
|
|
logical, volatile :: m(3), m2(3)
|
9 |
|
|
m = (/ .false., .false., .false. /)
|
10 |
|
|
m2 = (/ .false., .true., .false. /)
|
11 |
|
|
call check(1, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
|
12 |
|
|
call check(2, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
|
13 |
|
|
call check(3, 2, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m2))
|
14 |
|
|
call check(4, 0, MAXLOC(i(1:0), DIM=1, MASK=.TRUE.))
|
15 |
|
|
call check(5, 0, MAXLOC(i(1:0), DIM=1, MASK=.FALSE.))
|
16 |
|
|
call check(6, 0, MAXLOC(i(1:0), DIM=1, MASK=m(1:0)))
|
17 |
|
|
call check(7, 0, MAXLOC(i(1:0), DIM=1))
|
18 |
|
|
call check(8, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
|
19 |
|
|
call check(9, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
|
20 |
|
|
call check(10, 0, MINLOC(i(1:0), DIM=1, MASK=.FALSE.))
|
21 |
|
|
call check(11,0, MINLOC(i(1:0), DIM=1, MASK=m(1:0)))
|
22 |
|
|
call check(12,0, MINLOC(i(1:0), DIM=1, MASK=.TRUE.))
|
23 |
|
|
call check(13,0, MINLOC(i(1:0), DIM=1))
|
24 |
|
|
|
25 |
|
|
j = (/ 1, 2, 1 /); call check(14, 2, MAXLOC(j, DIM=1))
|
26 |
|
|
j = (/ 1, 2, 3 /); call check(15, 3, MAXLOC(j, DIM=1))
|
27 |
|
|
j = (/ 3, 2, 1 /); call check(16, 1, MAXLOC(j, DIM=1))
|
28 |
|
|
j = (/ 1, 2, 1 /); call check(17, 1, MINLOC(j, DIM=1))
|
29 |
|
|
j = (/ 1, 2, 3 /); call check(18, 1, MINLOC(j, DIM=1))
|
30 |
|
|
j = (/ 3, 2, 1 /); call check(19, 3, MINLOC(j, DIM=1))
|
31 |
|
|
|
32 |
|
|
j = (/ 1, 2, 1 /); call check(20, 2, MAXLOC(j, DIM=1,mask=.true.))
|
33 |
|
|
j = (/ 1, 2, 3 /); call check(21, 3, MAXLOC(j, DIM=1,mask=.true.))
|
34 |
|
|
j = (/ 3, 2, 1 /); call check(22, 1, MAXLOC(j, DIM=1,mask=.true.))
|
35 |
|
|
j = (/ 1, 2, 1 /); call check(23, 1, MINLOC(j, DIM=1,mask=.true.))
|
36 |
|
|
j = (/ 1, 2, 3 /); call check(24, 1, MINLOC(j, DIM=1,mask=.true.))
|
37 |
|
|
j = (/ 3, 2, 1 /); call check(25, 3, MINLOC(j, DIM=1,mask=.true.))
|
38 |
|
|
|
39 |
|
|
j = (/ 1, 2, 1 /); call check(26, 0, MAXLOC(j, DIM=1,mask=.false.))
|
40 |
|
|
j = (/ 1, 2, 3 /); call check(27, 0, MAXLOC(j, DIM=1,mask=.false.))
|
41 |
|
|
j = (/ 3, 2, 1 /); call check(28, 0, MAXLOC(j, DIM=1,mask=.false.))
|
42 |
|
|
j = (/ 1, 2, 1 /); call check(29, 0, MINLOC(j, DIM=1,mask=.false.))
|
43 |
|
|
j = (/ 1, 2, 3 /); call check(30, 0, MINLOC(j, DIM=1,mask=.false.))
|
44 |
|
|
j = (/ 3, 2, 1 /); call check(31, 0, MINLOC(j, DIM=1,mask=.false.))
|
45 |
|
|
|
46 |
|
|
j = (/ 1, 2, 1 /); call check(32, 0, MAXLOC(j, DIM=1,mask=m))
|
47 |
|
|
j = (/ 1, 2, 3 /); call check(33, 0, MAXLOC(j, DIM=1,mask=m))
|
48 |
|
|
j = (/ 3, 2, 1 /); call check(34, 0, MAXLOC(j, DIM=1,mask=m))
|
49 |
|
|
j = (/ 1, 2, 1 /); call check(35, 0, MINLOC(j, DIM=1,mask=m))
|
50 |
|
|
j = (/ 1, 2, 3 /); call check(36, 0, MINLOC(j, DIM=1,mask=m))
|
51 |
|
|
j = (/ 3, 2, 1 /); call check(37, 0, MINLOC(j, DIM=1,mask=m))
|
52 |
|
|
|
53 |
|
|
j = (/ 1, 2, 1 /); call check(38, 2, MAXLOC(j, DIM=1,mask=m2))
|
54 |
|
|
j = (/ 1, 2, 3 /); call check(39, 2, MAXLOC(j, DIM=1,mask=m2))
|
55 |
|
|
j = (/ 3, 2, 1 /); call check(40, 2, MAXLOC(j, DIM=1,mask=m2))
|
56 |
|
|
j = (/ 1, 2, 1 /); call check(41, 2, MINLOC(j, DIM=1,mask=m2))
|
57 |
|
|
j = (/ 1, 2, 3 /); call check(42, 2, MINLOC(j, DIM=1,mask=m2))
|
58 |
|
|
j = (/ 3, 2, 1 /); call check(43, 2, MINLOC(j, DIM=1,mask=m2))
|
59 |
|
|
|
60 |
|
|
! Check the library minloc and maxloc
|
61 |
|
|
res = MAXLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(44, 0, res(1))
|
62 |
|
|
res = MAXLOC((/ 42, 23, 11 /), MASK=m); call check(45, 0, res(1))
|
63 |
|
|
res = MAXLOC((/ 42, 23, 11 /), MASK=m2); call check(46, 2, res(1))
|
64 |
|
|
res = MAXLOC(i(1:0), MASK=.TRUE.); call check(47, 0, res(1))
|
65 |
|
|
res = MAXLOC(i(1:0), MASK=.FALSE.); call check(48, 0, res(1))
|
66 |
|
|
res = MAXLOC(i(1:0), MASK=m(1:0)); call check(49, 0, res(1))
|
67 |
|
|
res = MAXLOC(i(1:0)); call check(50, 0, res(1))
|
68 |
|
|
res = MINLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(51, 0, res(1))
|
69 |
|
|
res = MINLOC((/ 42, 23, 11 /), MASK=m); call check(52, 0, res(1))
|
70 |
|
|
res = MINLOC(i(1:0), MASK=.FALSE.); call check(53, 0, res(1))
|
71 |
|
|
res = MINLOC(i(1:0), MASK=m(1:0)); call check(54,0, res(1))
|
72 |
|
|
res = MINLOC(i(1:0), MASK=.TRUE.); call check(55,0, res(1))
|
73 |
|
|
res = MINLOC(i(1:0)); call check(56,0, res(1))
|
74 |
|
|
|
75 |
|
|
j = (/ 1, 2, 1 /); res = MAXLOC(j); call check(57, 2, res(1))
|
76 |
|
|
j = (/ 1, 2, 3 /); res = MAXLOC(j); call check(58, 3, res(1))
|
77 |
|
|
j = (/ 3, 2, 1 /); res = MAXLOC(j); call check(59, 1, res(1))
|
78 |
|
|
j = (/ 1, 2, 1 /); res = MINLOC(j); call check(60, 1, res(1))
|
79 |
|
|
j = (/ 1, 2, 3 /); res = MINLOC(j); call check(61, 1, res(1))
|
80 |
|
|
j = (/ 3, 2, 1 /); res = MINLOC(j); call check(62, 3, res(1))
|
81 |
|
|
|
82 |
|
|
j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(63, 2, res(1))
|
83 |
|
|
j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.true.); call check(65, 3, res(1))
|
84 |
|
|
j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(66, 1, res(1))
|
85 |
|
|
j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.true.); call check(67, 1, res(1))
|
86 |
|
|
j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.true.); call check(68, 1, res(1))
|
87 |
|
|
j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.true.); call check(69, 3, res(1))
|
88 |
|
|
|
89 |
|
|
j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(70, 0, res(1))
|
90 |
|
|
j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.false.); call check(71, 0, res(1))
|
91 |
|
|
j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(72, 0, res(1))
|
92 |
|
|
j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.false.); call check(73, 0, res(1))
|
93 |
|
|
j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.false.); call check(74, 0, res(1))
|
94 |
|
|
j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.false.); call check(75, 0, res(1))
|
95 |
|
|
|
96 |
|
|
j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m); call check(76, 0, res(1))
|
97 |
|
|
j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m); call check(77, 0, res(1))
|
98 |
|
|
j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m); call check(78, 0, res(1))
|
99 |
|
|
j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m); call check(79, 0, res(1))
|
100 |
|
|
j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m); call check(80, 0, res(1))
|
101 |
|
|
j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m);call check(81, 0, res(1))
|
102 |
|
|
|
103 |
|
|
j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m2); call check(82, 2, res(1))
|
104 |
|
|
j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m2); call check(83, 2, res(1))
|
105 |
|
|
j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m2); call check(84, 2, res(1))
|
106 |
|
|
j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m2); call check(85, 2, res(1))
|
107 |
|
|
j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m2); call check(86, 2, res(1))
|
108 |
|
|
j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m2); call check(87, 2, res(1))
|
109 |
|
|
|
110 |
|
|
contains
|
111 |
|
|
subroutine check(n, i,j)
|
112 |
|
|
integer, value, intent(in) :: i,j,n
|
113 |
|
|
if(i /= j) then
|
114 |
|
|
call abort()
|
115 |
|
|
! print *, 'ERROR: Test',n,' expected ',i,' received ', j
|
116 |
|
|
end if
|
117 |
|
|
end subroutine check
|
118 |
|
|
end program
|