TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-01-03 18:16:28 +01:00
Code Issues Projects Releases Wiki Activity

Fixed some bugs, now compiles.

Browse Source
This commit is contained in:
v1j4y 2021-09-15 11:55:45 +02:00
parent 61751c307f
commit cf3550b6b7
1 changed files with 23 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
org/qmckl_blas.org
View File

@ -41,7 +41,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~
@ -86,14 +86,15 @@ integer function qmckl_dgemm_f(context, TransA, TransB, m, n, k, alpha, A, LDA,
use qmckl use qmckl
implicit none implicit none
integer(qmckl_context) , intent(in) :: context integer(qmckl_context) , intent(in) :: context
logical*8 , intent(in) :: TransA, TransN logical*8 , intent(in) :: TransA, TransB
integer*8 , intent(in) :: m, n, k integer*8 , intent(in) :: m, n, k
real*8 , intent(in) :: alpha, beta
integer*8 , intent(in) :: lda integer*8 , intent(in) :: lda
real*8 , intent(in) :: A(lda,*) real*8 , intent(in) :: A(m,n)
integer*8 , intent(in) :: ldb integer*8 , intent(in) :: ldb
real*8 , intent(in) :: B(ldb,*) real*8 , intent(in) :: B(n,k)
integer*8 , intent(in) :: ldc integer*8 , intent(in) :: ldc
real*8 , intent(out) :: C(ldc,*) real*8 , intent(out) :: C(m,n)
integer*8 :: i,j integer*8 :: i,j
@ -158,13 +159,13 @@ end function qmckl_dgemm_f
integer (c_int64_t) , intent(in) , value :: n integer (c_int64_t) , intent(in) , value :: n
integer (c_int64_t) , intent(in) , value :: k integer (c_int64_t) , intent(in) , value :: k
real (c_double ) , intent(in) , value :: alpha real (c_double ) , intent(in) , value :: alpha
real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: lda integer (c_int64_t) , intent(in) , value :: lda
real (c_double ) , intent(in) :: B(ldb,*) real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: ldb integer (c_int64_t) , intent(in) , value :: ldb
real (c_double ) , intent(in) :: B(ldb,*)
real (c_double ) , intent(in) , value :: beta real (c_double ) , intent(in) , value :: beta
real (c_double ) , intent(out) :: C(ldc,*)
integer (c_int64_t) , intent(in) , value :: ldc integer (c_int64_t) , intent(in) , value :: ldc
real (c_double ) , intent(out) :: C(ldc,*)
integer(c_int32_t), external :: qmckl_dgemm_f integer(c_int32_t), external :: qmckl_dgemm_f
info = qmckl_dgemm_f & info = qmckl_dgemm_f &
@ -180,26 +181,26 @@ end function qmckl_dgemm_f
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface interface
integer(c_int32_t) function qmckl_dgemm & integer(c_int32_t) function qmckl_dgemm &
(context, TransA, TransB, m, n, k, alpha, A, lda, B, ldb, beat, C, ldc) & (context, TransA, TransB, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc) &
bind(C) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
implicit none implicit none
integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: context
logical*8 (c_bool) , intent(in) , value :: TransA logical*8 , intent(in) , value :: TransA
logical*8 (c_bool) , intent(in) , value :: TransB logical*8 , intent(in) , value :: TransB
integer (c_int64_t) , intent(in) , value :: m integer (c_int64_t) , intent(in) , value :: m
integer (c_int64_t) , intent(in) , value :: n integer (c_int64_t) , intent(in) , value :: n
integer (c_int64_t) , intent(in) , value :: k integer (c_int64_t) , intent(in) , value :: k
real (c_double ) , intent(in) :: alpha real (c_double ) , intent(in) :: alpha
real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: lda integer (c_int64_t) , intent(in) , value :: lda
real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: ldb
real (c_double ) , intent(in) :: B(ldb,*) real (c_double ) , intent(in) :: B(ldb,*)
integer (c_int64_t) , intent(in) , value :: ldb
real (c_double ) , intent(in) :: beta real (c_double ) , intent(in) :: beta
real (c_double ) , intent(out) :: C(ldb,*) integer (c_int64_t) , intent(in) , value :: ldc
integer (c_int64_t) , intent(in) , value :: ldb real (c_double ) , intent(out) :: C(ldc,*)
end function qmckl_dgemm end function qmckl_dgemm
end interface end interface
@ -214,15 +215,15 @@ integer(qmckl_exit_code) function test_qmckl_dgemm(context) bind(C)
double precision, allocatable :: A(:,:), B(:,:), C(:,:), D(:,:) double precision, allocatable :: A(:,:), B(:,:), C(:,:), D(:,:)
integer*8 :: m, n, k, LDA, LDB, LDC integer*8 :: m, n, k, LDA, LDB, LDC
integer*8 :: i,j integer*8 :: i,j,l
logical*8 :: TransA, TransB logical*8 :: TransA, TransB
double precision :: x double precision :: x, alpha, beta
TransA = .False. TransA = .False.
TransB = .False. TransB = .False.
m = 5 m = 5_8
k = 4 k = 4_8
n = 6 n = 6_8
LDA = m LDA = m
LDB = k LDB = k
LDC = m LDC = m
@ -255,11 +256,12 @@ integer(qmckl_exit_code) function test_qmckl_dgemm(context) bind(C)
do j=1,m do j=1,m
do i=l,n do i=l,n
do l=1,k do l=1,k
D(i,j) += D(i,j) + (A(i,k)*B(k,j)) D(i,j) = D(i,j) + A(i,k)*B(k,j)
end do end do
x = x + (D(i,j) - C(i,j))**2 x = x + (D(i,j) - C(i,j))**2
end do end do
end do end do
print *,"DABS(X)= ",dabs(x)
if (dabs(x) <= 1.d-15) then if (dabs(x) <= 1.d-15) then
test_qmckl_dgemm = QMCKL_SUCCESS test_qmckl_dgemm = QMCKL_SUCCESS