1! { dg-do compile }
2! { dg-require-effective-target vect_double }
3! { dg-additional-options "-msse2" { target { { i?86-*-* x86_64-*-* } && ilp32 } } }
4
5module mqc_m
6integer, parameter, private :: longreal = selected_real_kind(15,90)
7contains
8      subroutine mutual_ind_quad_cir_coil (m, l12)
9      real (kind = longreal), dimension(9), save :: w2gauss, w1gauss
10      real (kind = longreal) :: l12_lower, num, l12
11      real (kind = longreal), dimension(3) :: current, coil
12      w2gauss(1) = 16.0_longreal/81.0_longreal
13      w1gauss(5) = 0.3302393550_longreal
14      do i = 1, 2*m
15          do j = 1, 9
16              do k = 1, 9
17                  num = w1gauss(j) * w2gauss(k) * dot_product(coil,current)
18                  l12_lower = l12_lower + num
19              end do
20          end do
21      end do
22      l12 = l12_lower
23      end subroutine mutual_ind_quad_cir_coil
24end module mqc_m
25
26! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } }
27! { dg-final { cleanup-tree-dump "vect" } }
28