1! { dg-do run }
2! Various tests with findloc.
3program main
4  implicit none
5  real, dimension(2,2) :: a, b
6  integer, dimension(2,3) :: c
7  logical, dimension(2,2) :: lo
8  integer, dimension(:), allocatable :: e
9  a = reshape([1.,2.,3.,4.], shape(a))
10  b = reshape([1.,2.,1.,2.], shape(b))
11
12  lo = .true.
13
14  if (any(findloc(a, 5.) /= [0,0])) stop 1
15  if (any(findloc(a, 5., back=.true.) /= [0,0])) stop 2
16  if (any(findloc(a, 2.) /= [2,1])) stop 2
17  if (any(findloc(a, 2. ,back=.true.) /= [2,1])) stop 3
18
19  if (any(findloc(a,3.,mask=lo) /= [1,2])) stop 4
20  if (any(findloc(a,3,mask=.true.) /= [1,2])) stop 5
21  lo(1,2) = .false.
22  if (any(findloc(a,3.,mask=lo) /= [0,0])) stop 6
23  if (any(findloc(b,2.) /= [2,1])) stop 7
24  if (any(findloc(b,2.,back=.true.) /= [2,2])) stop 8
25  if (any(findloc(b,1.,mask=lo,back=.true.) /= [1,1])) stop 9
26  if (any(findloc(b,1.,mask=.false.) /= [0,0])) stop 10
27
28  c = reshape([1,2,2,2,-9,6], shape(c))
29  if (any(findloc(c,value=2,dim=1) /= [2,1,0])) stop 11
30  if (any(findloc(c,value=2,dim=2) /= [2,1])) stop 12
31end program main
32