1! { dg-do compile }
2! { dg-require-effective-target vect_double }
3! { dg-additional-options "-funroll-loops --param vect-max-peeling-for-alignment=0 -fdump-tree-slp-details" }
4
5      SUBROUTINE MATERIAL_41_INTEGRATION ( STRESS,YLDC,EFPS,                   &
6     &  DTnext,Dxx,Dyy,Dzz,Dxy,Dxz,Dyz,MatID,P1,P3 )
7      REAL(KIND(0D0)), INTENT(INOUT) :: STRESS(6)
8      REAL(KIND(0D0)), INTENT(IN)    :: DTnext
9      REAL(KIND(0D0)), INTENT(IN)    :: Dxx,Dyy,Dzz,Dxy,Dxz,Dyz
10      REAL(KIND(0D0)) :: Einc(6)
11      REAL(KIND(0D0)) :: P1,P3
12
13      Einc(1) = DTnext * Dxx ! (1)
14      Einc(2) = DTnext * Dyy
15      Einc(3) = DTnext * Dzz
16      Einc(4) = DTnext * Dxy
17      Einc(5) = DTnext * Dxz
18      Einc(6) = DTnext * Dyz
19      DO i = 1,6
20        STRESS(i) = STRESS(i) + P3*Einc(i)
21      ENDDO
22      STRESS(1) = STRESS(1) + (DTnext * P1 * (Dxx+Dyy+Dzz)) ! (2)
23      STRESS(2) = STRESS(2) + (DTnext * P1 * (Dxx+Dyy+Dzz))
24      STRESS(3) = 0.0
25      Einc(5) = 0.0  ! (3)
26      Einc(6) = 0.0
27      call foo (Einc)
28      END SUBROUTINE
29
30! We should vectorize (1), (2) and (3)
31! { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 3 "slp1" } }
32