1! { dg-do compile } 2! { dg-require-effective-target vect_double } 3 4 function trs2a2 (j, k, u, d, m) 5! matrice de transition intermediaire, partant de k sans descendre 6! sous j. R = IjU(I-Ik)DIj, avec Ii = deltajj, j >= i. 7! alternative: trs2a2 = 0 8! trs2a2 (j:k-1, j:k-1) = matmul (utrsft (j:k-1,j:k-1), 9! dtrsft (j:k-1,j:k-1)) 10! 11 real, dimension (1:m,1:m) :: trs2a2 ! resultat 12 real, dimension (1:m,1:m) :: u, d ! matrices utrsft, dtrsft 13 integer, intent (in) :: j, k, m ! niveaux vallee pic 14! 15!##### following line replaced by Prentice to make less system dependent 16! real (kind = kind (1.0d0)) :: dtmp 17 real (kind = selected_real_kind (10,50)) :: dtmp 18! 19 trs2a2 = 0.0 20 do iclw1 = j, k - 1 21 do iclw2 = j, k - 1 22 dtmp = 0.0d0 23 do iclww = j, k - 1 24 dtmp = dtmp + u (iclw1, iclww) * d (iclww, iclw2) 25 enddo 26 trs2a2 (iclw1, iclw2) = dtmp 27 enddo 28 enddo 29 return 30 end function trs2a2 31 32! { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" } } 33