1! { dg-do run } 2! Check max/minloc. 3! PR fortran/31726 4! 5program 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 110contains 111subroutine 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 117end subroutine check 118end program 119