1! { dg-do run }
2! PR97063 - Wrong result for vector (step size is negative) * matrix
3
4program p
5  implicit none
6  integer, parameter :: m = 3, k = 2*m, l = k-1, n = 4
7  integer :: i, j,  m1, m2, ms
8  integer :: ai(k), bi(k,n), ci(n), ci_ref(n), c1, c2
9  real    :: ar(k), br(k,n), cr(n), cr_ref(n)
10
11  ai(:)   = [(i,i=0,k-1)]
12  bi(:,:) = reshape ([(((5*i+j),i=0,k-1),j=0,n-1)],[k,n])
13
14  ! Parameters of subscript triplet
15  m1 = 1; m2 = l; ms =  2
16
17  ! Reference values for cross-checks: integer variant
18  c1 = dot_product (ai(m1:m2: ms), bi(m1:m2: ms,1))
19  c2 = dot_product (ai(m1:m2: ms), bi(m1:m2: ms,2))
20  ci_ref = matmul  (ai(m1:m2: ms), bi(m1:m2: ms,:))
21  ci     = matmul  (ai(m2:m1:-ms), bi(m2:m1:-ms,:))
22
23  if (ci_ref(1) /= c1 .or. ci_ref(2) /= c2) stop 1
24  if (any (ci   /= ci_ref)) stop 2
25
26  ! Real variant
27  ar = real (ai)
28  br = real (bi)
29  cr_ref = matmul  (ar(m1:m2: ms), br(m1:m2: ms,:))
30  cr     = matmul  (ar(m2:m1:-ms), br(m2:m1:-ms,:))
31
32  if (any (cr_ref /= real (ci_ref))) stop 3
33  if (any (cr     /=       cr_ref )) stop 4
34
35  ! Mixed variants
36  cr_ref = matmul  (ar(m1:m2: ms), bi(m1:m2: ms,:))
37  cr     = matmul  (ar(m2:m1:-ms), bi(m2:m1:-ms,:))
38
39  if (any (cr_ref /= real (ci_ref))) stop 5
40  if (any (cr     /=       cr_ref )) stop 6
41
42  cr_ref = matmul  (ai(m1:m2: ms), br(m1:m2: ms,:))
43  cr     = matmul  (ai(m2:m1:-ms), br(m2:m1:-ms,:))
44
45  if (any (cr_ref /= real (ci_ref))) stop 7
46  if (any (cr     /=       cr_ref )) stop 8
47end program
48