mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-12-22 20:36:01 +01:00
Fixed DGEMM
This commit is contained in:
parent
b3e3b0b6dc
commit
1a713455f8
@ -23,7 +23,8 @@ int main() {
|
|||||||
|
|
||||||
** ~qmckl_dgemm~
|
** ~qmckl_dgemm~
|
||||||
|
|
||||||
Matrix multiply l$C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj}$ using Fortran ~matmul~ function.
|
Matrix multiply: $C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj}$ using Fortran ~matmul~ function.
|
||||||
|
|
||||||
TODO: Add description about the external library dependence.
|
TODO: Add description about the external library dependence.
|
||||||
|
|
||||||
#+NAME: qmckl_dgemm_args
|
#+NAME: qmckl_dgemm_args
|
||||||
@ -41,7 +42,7 @@ int main() {
|
|||||||
| double | beta | in | Array containing the $n \times m$ matrix $B$ |
|
| double | beta | in | Array containing the $n \times m$ matrix $B$ |
|
||||||
| double | C[][ldc] | out | Array containing the $n \times m$ matrix $B$ |
|
| double | C[][ldc] | out | Array containing the $n \times m$ matrix $B$ |
|
||||||
| int64_t | ldc | in | Leading dimension of array ~B~ |
|
| int64_t | ldc | in | Leading dimension of array ~B~ |
|
||||||
|
|
||||||
*** Requirements
|
*** Requirements
|
||||||
|
|
||||||
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||||
@ -75,7 +76,7 @@ int main() {
|
|||||||
const int64_t ldb,
|
const int64_t ldb,
|
||||||
const double beta,
|
const double beta,
|
||||||
double* const C,
|
double* const C,
|
||||||
const int64_t ldc );
|
const int64_t ldc );
|
||||||
#+END_src
|
#+END_src
|
||||||
|
|
||||||
|
|
||||||
@ -161,11 +162,23 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA,
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
if (TransA) then
|
if (TransA) then
|
||||||
C = matmul(AT,B)
|
if (alpha == 1.d0 && beta == 0.d0) then
|
||||||
|
C = matmul(AT,B)
|
||||||
|
else
|
||||||
|
C = beta*C + alpha*matmul(AT,B)
|
||||||
|
endif
|
||||||
else if (TransB) then
|
else if (TransB) then
|
||||||
C = matmul(A,BT)
|
if (alpha == 1.d0 && beta == 0.d0) then
|
||||||
|
C = matmul(A,BT)
|
||||||
|
else
|
||||||
|
C = beta*C + alpha*matmul(A,BT)
|
||||||
|
endif
|
||||||
else
|
else
|
||||||
C = matmul(A,B)
|
if (alpha == 1.d0 && beta == 0.d0) then
|
||||||
|
C = matmul(A,B)
|
||||||
|
else
|
||||||
|
C = beta*C + alpha*matmul(A,B)
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
end function qmckl_dgemm_f
|
end function qmckl_dgemm_f
|
||||||
#+end_src
|
#+end_src
|
||||||
@ -251,7 +264,7 @@ integer(qmckl_exit_code) function test_qmckl_dgemm(context) bind(C)
|
|||||||
double precision :: x, alpha, beta
|
double precision :: x, alpha, beta
|
||||||
|
|
||||||
TransA = .False.
|
TransA = .False.
|
||||||
TransB = .False.
|
TransB = .False.
|
||||||
m = 1_8
|
m = 1_8
|
||||||
k = 4_8
|
k = 4_8
|
||||||
n = 6_8
|
n = 6_8
|
||||||
@ -302,7 +315,7 @@ integer(qmckl_exit_code) function test_qmckl_dgemm(context) bind(C)
|
|||||||
deallocate(A,B,C,D)
|
deallocate(A,B,C,D)
|
||||||
end function test_qmckl_dgemm
|
end function test_qmckl_dgemm
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src c :comments link :tangle (eval c_test)
|
#+begin_src c :comments link :tangle (eval c_test)
|
||||||
qmckl_exit_code test_qmckl_dgemm(qmckl_context context);
|
qmckl_exit_code test_qmckl_dgemm(qmckl_context context);
|
||||||
assert(QMCKL_SUCCESS == test_qmckl_dgemm(context));
|
assert(QMCKL_SUCCESS == test_qmckl_dgemm(context));
|
||||||
|
Loading…
Reference in New Issue
Block a user