1! { dg-additional-options "-Ofast" }
2! { dg-additional-options "-mavx" { target avx_runtime } }
3
4subroutine foo(a, x)
5  implicit none
6
7  integer, parameter :: XX=4, YY=26
8  integer, intent(in) :: x
9  real *8, intent(in) :: a(XX,YY)
10  real *8 :: c(XX)
11
12  integer i, k
13
14  c = 0
15
16  do k=x,YY
17     do i=1,2
18        c(i) = max(c(i), a(i,k))
19     end do
20  end do
21
22  PRINT *, "c=", c
23
24  IF (c(1) .gt. 0.0) THEN
25     STOP 1
26  END IF
27
28  IF (c(2) .gt. 0.0) THEN
29     STOP 2
30  END IF
31end subroutine foo
32
33PROGRAM MAIN
34  real *8 a(4, 26)
35
36  a = 0
37  a(3,1) = 100.0
38  a(4,1) = 100.0
39
40  CALL FOO(a, 1)
41END PROGRAM
42