mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-07-18 08:53:47 +02:00
Renamed qmckl_invert to qmckl_adjoint. #41
This commit is contained in:
v1j4y
parent
cd0db55f9d
commit
20b8f2822e
@ -371,9 +371,9 @@ qmckl_exit_code test_qmckl_dgemm(qmckl_context context);
|
||||
assert(QMCKL_SUCCESS == test_qmckl_dgemm(context));
|
||||
#+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.
|
||||
|
||||
#+NAME: qmckl_invert_args
|
||||
#+NAME: qmckl_adjoint_args
|
||||
| qmckl_context | context | in | Global state |
|
||||
| int64_t | m | in | Number of rows 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
|
||||
|
||||
#+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:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_invert (
|
||||
qmckl_exit_code qmckl_adjoint (
|
||||
const qmckl_context context,
|
||||
const int64_t m,
|
||||
const int64_t n,
|
||||
@ -418,7 +418,7 @@ M · M^{-1} = I
|
||||
|
||||
*** Source
|
||||
#+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)
|
||||
use qmckl
|
||||
implicit none
|
||||
@ -435,30 +435,30 @@ integer function qmckl_invert_f(context, ma, na, LDA, A, det_l) &
|
||||
select case (na)
|
||||
case default
|
||||
!DIR$ forceinline
|
||||
print *," TODO: Implement general invert"
|
||||
print *," TODO: Implement general adjoint"
|
||||
stop 0
|
||||
case (5)
|
||||
!DIR$ forceinline
|
||||
call invert5(a,LDA,na,det_l)
|
||||
call adjoint5(a,LDA,na,det_l)
|
||||
case (4)
|
||||
!DIR$ forceinline
|
||||
call invert4(a,LDA,na,det_l)
|
||||
call adjoint4(a,LDA,na,det_l)
|
||||
|
||||
case (3)
|
||||
!DIR$ forceinline
|
||||
call invert3(a,LDA,na,det_l)
|
||||
call adjoint3(a,LDA,na,det_l)
|
||||
case (2)
|
||||
!DIR$ forceinline
|
||||
call invert2(a,LDA,na,det_l)
|
||||
call adjoint2(a,LDA,na,det_l)
|
||||
case (1)
|
||||
!DIR$ forceinline
|
||||
call invert1(a,LDA,na,det_l)
|
||||
call adjoint1(a,LDA,na,det_l)
|
||||
case (0)
|
||||
det_l=1.d0
|
||||
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
|
||||
double precision, intent(inout) :: a (LDA,na)
|
||||
integer*8, intent(in) :: LDA
|
||||
@ -468,7 +468,7 @@ subroutine invert1(a,LDA,na,det_l)
|
||||
call cofactor1(a,LDA,na,det_l)
|
||||
end
|
||||
|
||||
subroutine invert2(a,LDA,na,det_l)
|
||||
subroutine adjoint2(a,LDA,na,det_l)
|
||||
implicit none
|
||||
double precision, intent(inout) :: a (LDA,na)
|
||||
integer*8, intent(in) :: LDA
|
||||
@ -489,7 +489,7 @@ subroutine invert2(a,LDA,na,det_l)
|
||||
a(2,2) = b(2,2)
|
||||
end
|
||||
|
||||
subroutine invert3(a,LDA,na,det_l)
|
||||
subroutine adjoint3(a,LDA,na,det_l)
|
||||
implicit none
|
||||
double precision, intent(inout) :: a (LDA,na)
|
||||
integer*8, intent(in) :: LDA
|
||||
@ -521,7 +521,7 @@ subroutine invert3(a,LDA,na,det_l)
|
||||
a(3,3) = b(3,3)
|
||||
end
|
||||
|
||||
subroutine invert4(a,LDA,na,det_l)
|
||||
subroutine adjoint4(a,LDA,na,det_l)
|
||||
implicit none
|
||||
double precision, intent(inout) :: a (LDA,na)
|
||||
integer*8, intent(in) :: LDA
|
||||
@ -567,7 +567,7 @@ subroutine invert4(a,LDA,na,det_l)
|
||||
a(4,4) = b(4,4)
|
||||
end
|
||||
|
||||
subroutine invert5(a,LDA,na,det_l)
|
||||
subroutine adjoint5(a,LDA,na,det_l)
|
||||
implicit none
|
||||
double precision, intent(inout) :: a (LDA,na)
|
||||
integer*8, intent(in) :: LDA
|
||||
@ -932,11 +932,11 @@ end
|
||||
|
||||
*** 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:
|
||||
#+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) &
|
||||
bind(C) result(info)
|
||||
|
||||
@ -950,19 +950,19 @@ end
|
||||
real (c_double ) , intent(inout) :: A(lda,*)
|
||||
real (c_double ) , intent(inout) :: det_l
|
||||
|
||||
integer(c_int32_t), external :: qmckl_invert_f
|
||||
info = qmckl_invert_f &
|
||||
integer(c_int32_t), external :: qmckl_adjoint_f
|
||||
info = qmckl_adjoint_f &
|
||||
(context, m, n, lda, A, det_l)
|
||||
|
||||
end function qmckl_invert
|
||||
end function qmckl_adjoint
|
||||
#+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:
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_invert &
|
||||
integer(c_int32_t) function qmckl_adjoint &
|
||||
(context, m, n, lda, A, det_l) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
@ -976,13 +976,13 @@ end
|
||||
real (c_double ) , intent(inout) :: A(lda,*)
|
||||
real (c_double ) , intent(inout) :: det_l
|
||||
|
||||
end function qmckl_invert
|
||||
end function qmckl_adjoint
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
*** Test :noexport:
|
||||
#+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
|
||||
implicit none
|
||||
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
|
||||
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
|
||||
do j=1,m
|
||||
@ -1040,16 +1040,16 @@ integer(qmckl_exit_code) function test_qmckl_invert(context) bind(C)
|
||||
end do
|
||||
|
||||
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
|
||||
|
||||
deallocate(A,C)
|
||||
end function test_qmckl_invert
|
||||
end function test_qmckl_adjoint
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
qmckl_exit_code test_qmckl_invert(qmckl_context context);
|
||||
assert(QMCKL_SUCCESS == test_qmckl_invert(context));
|
||||
qmckl_exit_code test_qmckl_adjoint(qmckl_context context);
|
||||
assert(QMCKL_SUCCESS == test_qmckl_adjoint(context));
|
||||
#+end_src
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
Loading…
Reference in New Issue
Block a user