Skip to content

Commit 3ebdf9e

Browse files
committed
Replaced matmul with gemm.
1 parent 1bb1e01 commit 3ebdf9e

File tree

1 file changed

+24
-16
lines changed

1 file changed

+24
-16
lines changed

src/stdlib_linalg_matrix_functions.fypp

Lines changed: 24 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -66,24 +66,32 @@ contains
6666
enddo
6767

6868
! Iteratively compute the Pade approximation.
69-
p = .true.
70-
do k = 2, order_
71-
c = c * (order_ - k + 1) / (k * (2*order_ - k + 1))
72-
X = matmul(A2, X)
73-
do concurrent(i=1:n, j=1:n)
74-
E(i, j) = E(i, j) + c*X(i, j) ! E = E + c*X
75-
enddo
76-
if (p) then
77-
do concurrent(i=1:n, j=1:n)
78-
Q(i, j) = Q(i, j) + c*X(i, j) ! Q = Q + c*X
79-
enddo
80-
else
69+
block
70+
${rt}$ :: X_tmp(n, n)
71+
p = .true.
72+
do k = 2, order_
73+
c = c * (order_ - k + 1) / (k * (2*order_ - k + 1))
74+
X_tmp = X
75+
#:if rt.startswith('complex')
76+
call gemm("N", "N", n, n, n, one_c${rk}$, A2, n, X_tmp, n, zero_c${rk}$, X, n)
77+
#:else
78+
call gemm("N", "N", n, n, n, one_${rk}$, A2, n, X_tmp, n, zero_${rk}$, X, n)
79+
#:endif
8180
do concurrent(i=1:n, j=1:n)
82-
Q(i, j) = Q(i, j) - c*X(i, j) ! Q = Q - c*X
81+
E(i, j) = E(i, j) + c*X(i, j) ! E = E + c*X
8382
enddo
84-
endif
85-
p = .not. p
86-
enddo
83+
if (p) then
84+
do concurrent(i=1:n, j=1:n)
85+
Q(i, j) = Q(i, j) + c*X(i, j) ! Q = Q + c*X
86+
enddo
87+
else
88+
do concurrent(i=1:n, j=1:n)
89+
Q(i, j) = Q(i, j) - c*X(i, j) ! Q = Q - c*X
90+
enddo
91+
endif
92+
p = .not. p
93+
enddo
94+
end block
8795

8896
block
8997
integer(ilp) :: ipiv(n), info

0 commit comments

Comments
 (0)