TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-23 04:44:03 +01:00
Code Issues Projects Releases Wiki Activity

Renamed qmckl_invert to qmckl_adjoint. #41

Browse Source
This commit is contained in:
v1j4y 2021-10-29 08:45:14 +02:00
parent cd0db55f9d
commit 20b8f2822e
1 changed files with 34 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
org/qmckl_blas.org
View File

@ -371,9 +371,9 @@ qmckl_exit_code test_qmckl_dgemm(qmckl_context context);
assert(QMCKL_SUCCESS == test_qmckl_dgemm(context)); assert(QMCKL_SUCCESS == test_qmckl_dgemm(context));
#+end_src #+end_src
** ~qmckl_invert~ ** ~qmckl_adjoint~
Matrix invert. Given a matrix M, returns a matrix M⁻¹ such that: Matrix adjoint. Given a matrix M, returns a matrix M⁻¹ such that:
\[ \[
@ -385,7 +385,7 @@ M · M^{-1} = I
TODO: Add description about the external library dependence. TODO: Add description about the external library dependence.
#+NAME: qmckl_invert_args #+NAME: qmckl_adjoint_args
| qmckl_context | context | in | Global state | | qmckl_context | context | in | Global state |
| int64_t | m | in | Number of rows of the input matrix | | int64_t | m | in | Number of rows of the input matrix |
| int64_t | n | in | Number of columns of the input matrix | | int64_t | n | in | Number of columns of the input matrix |
@ -403,11 +403,11 @@ M · M^{-1} = I
*** C header *** C header
#+CALL: generate_c_header(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") #+CALL: generate_c_header(table=qmckl_adjoint_args,rettyp="qmckl_exit_code",fname="qmckl_adjoint")
#+RESULTS: #+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org #+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_invert ( qmckl_exit_code qmckl_adjoint (
const qmckl_context context, const qmckl_context context,
const int64_t m, const int64_t m,
const int64_t n, const int64_t n,
@ -418,7 +418,7 @@ M · M^{-1} = I
*** Source *** Source
#+begin_src f90 :tangle (eval f) #+begin_src f90 :tangle (eval f)
integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) & integer function qmckl_adjoint_f(context, ma, na, LDA, A, det_l) &
result(info) result(info)
use qmckl use qmckl
implicit none implicit none
@ -435,30 +435,30 @@ integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) &
select case (na) select case (na)
case default case default
!DIR$ forceinline !DIR$ forceinline
print *," TODO: Implement general invert" print *," TODO: Implement general adjoint"
stop 0 stop 0
case (5) case (5)
!DIR$ forceinline !DIR$ forceinline
call invert5(a,LDA,na,det_l) call adjoint5(a,LDA,na,det_l)
case (4) case (4)
!DIR$ forceinline !DIR$ forceinline
call invert4(a,LDA,na,det_l) call adjoint4(a,LDA,na,det_l)
case (3) case (3)
!DIR$ forceinline !DIR$ forceinline
call invert3(a,LDA,na,det_l) call adjoint3(a,LDA,na,det_l)
case (2) case (2)
!DIR$ forceinline !DIR$ forceinline
call invert2(a,LDA,na,det_l) call adjoint2(a,LDA,na,det_l)
case (1) case (1)
!DIR$ forceinline !DIR$ forceinline
call invert1(a,LDA,na,det_l) call adjoint1(a,LDA,na,det_l)
case (0) case (0)
det_l=1.d0 det_l=1.d0
end select end select
end function qmckl_invert_f end function qmckl_adjoint_f
subroutine invert1(a,LDA,na,det_l) subroutine adjoint1(a,LDA,na,det_l)
implicit none implicit none
double precision, intent(inout) :: a (LDA,na) double precision, intent(inout) :: a (LDA,na)
integer*8, intent(in) :: LDA integer*8, intent(in) :: LDA
@ -468,7 +468,7 @@ subroutine invert1(a,LDA,na,det_l)
call cofactor1(a,LDA,na,det_l) call cofactor1(a,LDA,na,det_l)
end end
subroutine invert2(a,LDA,na,det_l) subroutine adjoint2(a,LDA,na,det_l)
implicit none implicit none
double precision, intent(inout) :: a (LDA,na) double precision, intent(inout) :: a (LDA,na)
integer*8, intent(in) :: LDA integer*8, intent(in) :: LDA
@ -489,7 +489,7 @@ subroutine invert2(a,LDA,na,det_l)
a(2,2) = b(2,2) a(2,2) = b(2,2)
end end
subroutine invert3(a,LDA,na,det_l) subroutine adjoint3(a,LDA,na,det_l)
implicit none implicit none
double precision, intent(inout) :: a (LDA,na) double precision, intent(inout) :: a (LDA,na)
integer*8, intent(in) :: LDA integer*8, intent(in) :: LDA
@ -521,7 +521,7 @@ subroutine invert3(a,LDA,na,det_l)
a(3,3) = b(3,3) a(3,3) = b(3,3)
end end
subroutine invert4(a,LDA,na,det_l) subroutine adjoint4(a,LDA,na,det_l)
implicit none implicit none
double precision, intent(inout) :: a (LDA,na) double precision, intent(inout) :: a (LDA,na)
integer*8, intent(in) :: LDA integer*8, intent(in) :: LDA
@ -567,7 +567,7 @@ subroutine invert4(a,LDA,na,det_l)
a(4,4) = b(4,4) a(4,4) = b(4,4)
end end
subroutine invert5(a,LDA,na,det_l) subroutine adjoint5(a,LDA,na,det_l)
implicit none implicit none
double precision, intent(inout) :: a (LDA,na) double precision, intent(inout) :: a (LDA,na)
integer*8, intent(in) :: LDA integer*8, intent(in) :: LDA
@ -932,11 +932,11 @@ end
*** C interface :noexport: *** C interface :noexport:
#+CALL: generate_c_interface(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") #+CALL: generate_c_interface(table=qmckl_adjoint_args,rettyp="qmckl_exit_code",fname="qmckl_adjoint")
#+RESULTS: #+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none #+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_invert & integer(c_int32_t) function qmckl_adjoint &
(context, m, n, lda, A, det_l) & (context, m, n, lda, A, det_l) &
bind(C) result(info) bind(C) result(info)
@ -950,19 +950,19 @@ end
real (c_double ) , intent(inout) :: A(lda,*) real (c_double ) , intent(inout) :: A(lda,*)
real (c_double ) , intent(inout) :: det_l real (c_double ) , intent(inout) :: det_l
integer(c_int32_t), external :: qmckl_invert_f integer(c_int32_t), external :: qmckl_adjoint_f
info = qmckl_invert_f & info = qmckl_adjoint_f &
(context, m, n, lda, A, det_l) (context, m, n, lda, A, det_l)
end function qmckl_invert end function qmckl_adjoint
#+end_src #+end_src
#+CALL: generate_f_interface(table=qmckl_invert_args,rettyp="qmckl_exit_code",fname="qmckl_invert") #+CALL: generate_f_interface(table=qmckl_adjoint_args,rettyp="qmckl_exit_code",fname="qmckl_adjoint")
#+RESULTS: #+RESULTS:
#+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_invert & integer(c_int32_t) function qmckl_adjoint &
(context, m, n, lda, A, det_l) & (context, m, n, lda, A, det_l) &
bind(C) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -976,13 +976,13 @@ end
real (c_double ) , intent(inout) :: A(lda,*) real (c_double ) , intent(inout) :: A(lda,*)
real (c_double ) , intent(inout) :: det_l real (c_double ) , intent(inout) :: det_l
end function qmckl_invert end function qmckl_adjoint
end interface end interface
#+end_src #+end_src
*** Test :noexport: *** Test :noexport:
#+begin_src f90 :tangle (eval f_test) #+begin_src f90 :tangle (eval f_test)
integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C) integer(qmckl_exit_code) function test_qmckl_adjoint(context) bind(C)
use qmckl use qmckl
implicit none implicit none
integer(qmckl_context), intent(in), value :: context integer(qmckl_context), intent(in), value :: context
@ -1026,11 +1026,11 @@ integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C)
C(4,3) = -0.007224426165097149d0 C(4,3) = -0.007224426165097149d0
det_l_ref = 23.6697d0 det_l_ref = 23.6697d0
test_qmckl_invert = qmckl_invert(context, m, k, LDA, A, det_l) test_qmckl_adjoint = qmckl_adjoint(context, m, k, LDA, A, det_l)
if (test_qmckl_invert /= QMCKL_SUCCESS) return if (test_qmckl_adjoint /= QMCKL_SUCCESS) return
test_qmckl_invert = QMCKL_FAILURE test_qmckl_adjoint = QMCKL_FAILURE
x = 0.d0 x = 0.d0
do j=1,m do j=1,m
@ -1040,16 +1040,16 @@ integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C)
end do end do
if (dabs(x) <= 1.d-15 .and. (dabs(det_l_ref - det_l)) <= 1.d-15) then if (dabs(x) <= 1.d-15 .and. (dabs(det_l_ref - det_l)) <= 1.d-15) then
test_qmckl_invert = QMCKL_SUCCESS test_qmckl_adjoint = QMCKL_SUCCESS
endif endif
deallocate(A,C) deallocate(A,C)
end function test_qmckl_invert end function test_qmckl_adjoint
#+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_invert(qmckl_context context); qmckl_exit_code test_qmckl_adjoint(qmckl_context context);
assert(QMCKL_SUCCESS == test_qmckl_invert(context)); assert(QMCKL_SUCCESS == test_qmckl_adjoint(context));
#+end_src #+end_src
* End of files :noexport: * End of files :noexport: