1! { dg-do run }
2! Test maxloc for strings for different code paths
3
4program main
5  implicit none
6  integer, parameter :: n=4
7  character(len=4), dimension(n,n) :: c
8  integer, dimension(n,n) :: a
9  integer, dimension(2) :: res1, res2
10  real, dimension(n,n) :: r
11  logical, dimension(n,n) :: amask
12  logical(kind=8) :: smask
13  integer :: i,j
14  integer, dimension(n) :: q1, q2
15  character(len=4,kind=4), dimension(n,n) :: c4
16  character(len=4), dimension(n*n) :: e
17  integer, dimension(n*n) :: f
18  logical, dimension(n*n) :: cmask
19
20  call random_number (r)
21  a = int(r*100)
22  do j=1,n
23     do i=1,n
24        write (unit=c(i,j),fmt='(I4.4)') a(i,j)
25        write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
26     end do
27  end do
28  res1 = maxloc(c)
29  res2 = maxloc(a)
30
31  if (any(res1 /= res2)) STOP 1
32  res1 = maxloc(c4)
33  if (any(res1 /= res2)) STOP 2
34
35  amask = a < 50
36  res1 = maxloc(c,mask=amask)
37  res2 = maxloc(a,mask=amask)
38
39 if (any(res1 /= res2)) STOP 3
40
41 amask = .false.
42 res1 = maxloc(c,mask=amask)
43 if (any(res1 /= 0)) STOP 4
44
45 amask(2,3) = .true.
46 res1 = maxloc(c,mask=amask)
47 if (any(res1 /= [2,3])) STOP 5
48
49 res1 = maxloc(c,mask=.false.)
50 if (any(res1 /= 0)) STOP 6
51
52 res2 = maxloc(a)
53 res1 = maxloc(c,mask=.true.)
54 if (any(res1 /= res2)) STOP 7
55
56 q1 = maxloc(c, dim=1)
57 q2 = maxloc(a, dim=1)
58 if (any(q1 /= q2)) STOP 8
59
60 q1 = maxloc(c, dim=2)
61 q2 = maxloc(a, dim=2)
62 if (any(q1 /= q2)) STOP 9
63
64 q1 = maxloc(c, dim=1, mask=amask)
65 q2 = maxloc(a, dim=1, mask=amask)
66 if (any(q1 /= q2)) STOP 10
67
68 q1 = maxloc(c, dim=2, mask=amask)
69 q2 = maxloc(a, dim=2, mask=amask)
70 if (any(q1 /= q2)) STOP 11
71
72  amask = a < 50
73
74 q1 = maxloc(c, dim=1, mask=amask)
75 q2 = maxloc(a, dim=1, mask=amask)
76 if (any(q1 /= q2)) STOP 12
77
78 q1 = maxloc(c, dim=2, mask=amask)
79 q2 = maxloc(a, dim=2, mask=amask)
80 if (any(q1 /= q2)) STOP 13
81
82 e = reshape(c, shape(e))
83 f = reshape(a, shape(f))
84 if (maxloc(e,dim=1) /= maxloc(f,dim=1)) STOP 14
85
86 cmask = .false.
87 if (maxloc(e,dim=1,mask=cmask) /= 0) STOP 15
88
89 cmask = f > 50
90 if ( maxloc(e, dim=1, mask=cmask) /= maxloc (f, dim=1, mask=cmask)) STOP 16
91end program main
92