mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-10-02 22:41:09 +02:00
qmckl_sm_splitting_doc kernel works.
This commit is contained in:
parent
8e2674a3b2
commit
656d268187
@ -153,7 +153,7 @@ end subroutine copy_back_inv
|
|||||||
subroutine copy_back_lu(Later_updates, later_upds, lds, nupdates)
|
subroutine copy_back_lu(Later_updates, later_upds, lds, nupdates)
|
||||||
implicit none
|
implicit none
|
||||||
integer*8 , intent(in) :: lds, nupdates
|
integer*8 , intent(in) :: lds, nupdates
|
||||||
real*8 , intent(in) , dimension(nupdates, lds) :: Later_updates
|
real*8 , intent(in) , dimension(lds, nupdates) :: Later_updates
|
||||||
real*8 , intent(out) :: later_upds(nupdates * lds)
|
real*8 , intent(out) :: later_upds(nupdates * lds)
|
||||||
|
|
||||||
integer*8 :: i, j
|
integer*8 :: i, j
|
||||||
@ -161,7 +161,7 @@ subroutine copy_back_lu(Later_updates, later_upds, lds, nupdates)
|
|||||||
! Copy updated inverse back to s_inv
|
! Copy updated inverse back to s_inv
|
||||||
do i = 1, nupdates
|
do i = 1, nupdates
|
||||||
do j = 1, lds
|
do j = 1, lds
|
||||||
later_upds((i - 1) * lds + j) = Later_updates(i, j)
|
later_upds((i - 1) * lds + j) = Later_updates(j, i)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end subroutine copy_back_lu
|
end subroutine copy_back_lu
|
||||||
@ -303,7 +303,7 @@ qmckl_exit_code qmckl_sm_naive (
|
|||||||
double* determinant );
|
double* determinant );
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+CALL: generate_c_header(table=qmckl_sm_naive_args,rettyp=get_value("CRetType"),fname="qmckl_sm_naive_hpc")
|
#+CALL: generate_private_c_header(table=qmckl_sm_naive_args,rettyp=get_value("CRetType"),fname="qmckl_sm_naive_hpc")
|
||||||
|
|
||||||
#+RESULTS:
|
#+RESULTS:
|
||||||
#+begin_src c :tangle (eval h_private_func) :comments org
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
||||||
@ -343,6 +343,7 @@ Common includes and macros used by all the Sherman-Morrison-Woodbury kernels.
|
|||||||
#include "qmckl.h"
|
#include "qmckl.h"
|
||||||
#include "config.h"
|
#include "config.h"
|
||||||
#include "assert.h"
|
#include "assert.h"
|
||||||
|
#include "stdio.h"
|
||||||
|
|
||||||
// Order important because
|
// Order important because
|
||||||
// __GNUC__ also set in ICC, ICX and CLANG
|
// __GNUC__ also set in ICC, ICX and CLANG
|
||||||
@ -835,22 +836,24 @@ integer function qmckl_sm_splitting_core_doc_f( &
|
|||||||
integer*8 , intent(in) :: lds, dim
|
integer*8 , intent(in) :: lds, dim
|
||||||
integer*8 , intent(in) :: nupdates
|
integer*8 , intent(in) :: nupdates
|
||||||
integer*8 , intent(in) :: updates_index(nupdates)
|
integer*8 , intent(in) :: updates_index(nupdates)
|
||||||
real*8 , intent(in) :: upds(nupdates * lds)
|
real*8 , intent(in) :: upds(lds * nupdates)
|
||||||
real*8 , intent(in) :: breakdown
|
real*8 , intent(in) :: breakdown
|
||||||
real*8 , intent(inout) :: s_inv(dim * lds)
|
real*8 , intent(inout) :: s_inv(dim * lds)
|
||||||
real*8 , intent(inout) :: determinant
|
real*8 , intent(inout) :: determinant
|
||||||
integer*8 , intent(inout) :: Later
|
integer*8 , intent(inout) :: Later
|
||||||
integer*8 , intent(inout) :: Later_index(nupdates)
|
integer*8 , intent(inout) :: Later_index(nupdates)
|
||||||
real*8 , intent(inout) :: later_upds(nupdates * lds)
|
real*8 , intent(inout) :: later_upds(lds * nupdates)
|
||||||
|
|
||||||
real*8 , dimension(nupdates, lds) :: Updates
|
real*8 , dimension(lds, nupdates) :: Updates
|
||||||
real*8 , dimension(nupdates, lds) :: Later_updates
|
real*8 , dimension(lds, nupdates) :: Later_updates
|
||||||
real*8 , dimension(dim, lds) :: Inverse
|
real*8 , dimension(dim, lds) :: Inverse
|
||||||
real*8 , dimension(dim) :: C
|
real*8 , dimension(dim) :: C
|
||||||
real*8 , dimension(lds) :: D
|
real*8 , dimension(lds) :: D
|
||||||
real*8 :: denominator, idenominator, update
|
real*8 :: denominator, idenominator, update
|
||||||
integer*8 :: i, j, l, row
|
integer*8 :: i, j, l, row
|
||||||
|
|
||||||
|
write(*,*) "Entering 'qmckl_sm_splittinig_core_doc_f'"
|
||||||
|
|
||||||
info = QMCKL_FAILURE
|
info = QMCKL_FAILURE
|
||||||
|
|
||||||
if (context == QMCKL_NULL_CONTEXT) then
|
if (context == QMCKL_NULL_CONTEXT) then
|
||||||
@ -888,7 +891,7 @@ integer function qmckl_sm_splitting_core_doc_f( &
|
|||||||
Later_updates(i, l) = Updates(i, l) / 2
|
Later_updates(i, l) = Updates(i, l) / 2
|
||||||
C(i) = C(i) / 2
|
C(i) = C(i) / 2
|
||||||
end do
|
end do
|
||||||
Later_index(Later) = updates_index(l)
|
Later_index(Later + 1) = updates_index(l)
|
||||||
Later = Later + 1
|
Later = Later + 1
|
||||||
denominator = 1 + C(row)
|
denominator = 1 + C(row)
|
||||||
end if
|
end if
|
||||||
@ -919,6 +922,8 @@ integer function qmckl_sm_splitting_core_doc_f( &
|
|||||||
|
|
||||||
info = QMCKL_SUCCESS
|
info = QMCKL_SUCCESS
|
||||||
|
|
||||||
|
write(*,*) "Leaving 'qmckl_sm_splittinig_core_doc_f'"
|
||||||
|
|
||||||
end function qmckl_sm_splitting_core_doc_f
|
end function qmckl_sm_splitting_core_doc_f
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@ -931,6 +936,62 @@ for C users and in the module file 'qmckl_f.F90' for Fortran users.
|
|||||||
|
|
||||||
#+CALL: generate_c_interface(table=qmckl_sm_splitting_core_args,rettyp=get_value("CRetType"),fname="qmckl_sm_splitting_core_doc")
|
#+CALL: generate_c_interface(table=qmckl_sm_splitting_core_args,rettyp=get_value("CRetType"),fname="qmckl_sm_splitting_core_doc")
|
||||||
|
|
||||||
|
#+RESULTS:
|
||||||
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||||
|
integer(c_int32_t) function qmckl_sm_splitting_core_doc &
|
||||||
|
(context, &
|
||||||
|
LDS, &
|
||||||
|
Dim, &
|
||||||
|
N_updates, &
|
||||||
|
Updates, &
|
||||||
|
Updates_index, &
|
||||||
|
breakdown, &
|
||||||
|
Slater_inv, &
|
||||||
|
later_updates, &
|
||||||
|
later_index, &
|
||||||
|
later, &
|
||||||
|
determinant) &
|
||||||
|
bind(C) result(info)
|
||||||
|
|
||||||
|
use, intrinsic :: iso_c_binding
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer (c_int64_t) , intent(in) , value :: context
|
||||||
|
integer (c_int64_t) , intent(in) , value :: LDS
|
||||||
|
integer (c_int64_t) , intent(in) , value :: Dim
|
||||||
|
integer (c_int64_t) , intent(in) , value :: N_updates
|
||||||
|
real (c_double ) , intent(in) :: Updates(N_updates*LDS)
|
||||||
|
integer (c_int64_t) , intent(in) :: Updates_index(N_updates)
|
||||||
|
real (c_double ) , intent(in) , value :: breakdown
|
||||||
|
real (c_double ) , intent(inout) :: Slater_inv(Dim*LDS)
|
||||||
|
real (c_double ) , intent(inout) :: later_updates(N_updates*LDS)
|
||||||
|
integer (c_int64_t) , intent(inout) :: later_index(N_updates)
|
||||||
|
integer (c_int64_t) , intent(inout) :: later
|
||||||
|
real (c_double ) , intent(inout) :: determinant
|
||||||
|
|
||||||
|
integer(c_int32_t), external :: qmckl_sm_splitting_core_doc_f
|
||||||
|
|
||||||
|
write(*,*) "Entering 'qmckl_sm_splittinig_core_doc'"
|
||||||
|
|
||||||
|
info = qmckl_sm_splitting_core_doc_f &
|
||||||
|
(context, &
|
||||||
|
LDS, &
|
||||||
|
Dim, &
|
||||||
|
N_updates, &
|
||||||
|
Updates, &
|
||||||
|
Updates_index, &
|
||||||
|
breakdown, &
|
||||||
|
Slater_inv, &
|
||||||
|
later_updates, &
|
||||||
|
later_index, &
|
||||||
|
later, &
|
||||||
|
determinant)
|
||||||
|
|
||||||
|
write(*,*) "Leaving 'qmckl_sm_splittinig_core_doc'"
|
||||||
|
|
||||||
|
end function qmckl_sm_splitting_core_doc
|
||||||
|
#+end_src
|
||||||
|
|
||||||
*** C headers (exposed in qmckl.h)
|
*** C headers (exposed in qmckl.h)
|
||||||
#+CALL: generate_c_header(table=qmckl_sm_splitting_core_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
#+CALL: generate_c_header(table=qmckl_sm_splitting_core_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||||
|
|
||||||
@ -1221,7 +1282,7 @@ qmckl_exit_code qmckl_sm_splitting_core(
|
|||||||
if (LDS == (1+(Dim-1)/SIMD_LENGTH)*SIMD_LENGTH) { // Most cases
|
if (LDS == (1+(Dim-1)/SIMD_LENGTH)*SIMD_LENGTH) { // Most cases
|
||||||
switch (Dim) {
|
switch (Dim) {
|
||||||
<<slagel_splitting_switch-case_generator()>>
|
<<slagel_splitting_switch-case_generator()>>
|
||||||
case default: {
|
default: {
|
||||||
assert(0 == 1 && "TEMPLATE NOT IMPLEMENTED!");
|
assert(0 == 1 && "TEMPLATE NOT IMPLEMENTED!");
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -1243,20 +1304,7 @@ qmckl_exit_code qmckl_sm_splitting_core(
|
|||||||
determinant);
|
determinant);
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
// return qmckl_sm_splitting_core_doc(
|
return qmckl_sm_splitting_core_doc(
|
||||||
// context,
|
|
||||||
// LDS,
|
|
||||||
// Dim,
|
|
||||||
// N_updates,
|
|
||||||
// Updates,
|
|
||||||
// Updates_index,
|
|
||||||
// breakdown,
|
|
||||||
// Slater_inv,
|
|
||||||
// later_updates,
|
|
||||||
// later_index,
|
|
||||||
// later,
|
|
||||||
// determinant);
|
|
||||||
return qmckl_sm_splitting_core_hpc(
|
|
||||||
context,
|
context,
|
||||||
LDS,
|
LDS,
|
||||||
Dim,
|
Dim,
|
||||||
@ -1446,7 +1494,7 @@ integer recursive function qmckl_sm_splitting_doc_f( &
|
|||||||
integer*8 , intent(in) :: lds, dim
|
integer*8 , intent(in) :: lds, dim
|
||||||
integer*8 , intent(in) :: nupdates
|
integer*8 , intent(in) :: nupdates
|
||||||
integer*8 , intent(in) :: updates_index(nupdates)
|
integer*8 , intent(in) :: updates_index(nupdates)
|
||||||
real*8 , intent(in) :: upds(nupdates * lds)
|
real*8 , intent(in) :: upds(lds * nupdates)
|
||||||
real*8 , intent(in) :: breakdown
|
real*8 , intent(in) :: breakdown
|
||||||
real*8 , intent(inout) :: s_inv(dim * lds)
|
real*8 , intent(inout) :: s_inv(dim * lds)
|
||||||
real*8 , intent(inout) :: determinant
|
real*8 , intent(inout) :: determinant
|
||||||
@ -1455,7 +1503,9 @@ integer recursive function qmckl_sm_splitting_doc_f( &
|
|||||||
|
|
||||||
integer*8 :: Later
|
integer*8 :: Later
|
||||||
integer*8 , dimension(nupdates) :: Later_index
|
integer*8 , dimension(nupdates) :: Later_index
|
||||||
real*8 , dimension(nupdates * lds) :: Later_updates
|
real*8 , dimension(lds * nupdates) :: Later_updates
|
||||||
|
|
||||||
|
write(*,*) "Entering 'qmckl_sm_splitting_doc_f'"
|
||||||
|
|
||||||
info = QMCKL_FAILURE
|
info = QMCKL_FAILURE
|
||||||
|
|
||||||
@ -1495,6 +1545,8 @@ integer recursive function qmckl_sm_splitting_doc_f( &
|
|||||||
|
|
||||||
info = QMCKL_SUCCESS
|
info = QMCKL_SUCCESS
|
||||||
|
|
||||||
|
write(*,*) "Leaving 'qmckl_sm_splitting_doc_f'"
|
||||||
|
|
||||||
end function qmckl_sm_splitting_doc_f
|
end function qmckl_sm_splitting_doc_f
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@ -1520,16 +1572,21 @@ integer(c_int32_t) function qmckl_sm_splitting_doc &
|
|||||||
integer (c_int64_t) , intent(in) , value :: LDS
|
integer (c_int64_t) , intent(in) , value :: LDS
|
||||||
integer (c_int64_t) , intent(in) , value :: Dim
|
integer (c_int64_t) , intent(in) , value :: Dim
|
||||||
integer (c_int64_t) , intent(in) , value :: N_updates
|
integer (c_int64_t) , intent(in) , value :: N_updates
|
||||||
real (c_double ) , intent(in) :: Updates(N_updates*LDS)
|
real (c_double ) , intent(in) :: Updates(LDS*N_updates)
|
||||||
integer (c_int64_t) , intent(in) :: Updates_index(N_updates)
|
integer (c_int64_t) , intent(in) :: Updates_index(N_updates)
|
||||||
real (c_double ) , intent(in) , value :: breakdown
|
real (c_double ) , intent(in) , value :: breakdown
|
||||||
real (c_double ) , intent(inout) :: Slater_inv(Dim*LDS)
|
real (c_double ) , intent(inout) :: Slater_inv(Dim*LDS)
|
||||||
real (c_double ) , intent(inout) :: determinant
|
real (c_double ) , intent(inout) :: determinant
|
||||||
|
|
||||||
integer(c_int32_t), external :: qmckl_sm_splitting_doc_f
|
integer(c_int32_t), external :: qmckl_sm_splitting_doc_f
|
||||||
|
|
||||||
|
write(*,*) "Entering 'qmckl_sm_splitting_doc'"
|
||||||
|
|
||||||
info = qmckl_sm_splitting_doc_f &
|
info = qmckl_sm_splitting_doc_f &
|
||||||
(context, LDS, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv, determinant)
|
(context, LDS, Dim, N_updates, Updates, Updates_index, breakdown, Slater_inv, determinant)
|
||||||
|
|
||||||
|
write(*,*) "Leaving 'qmckl_sm_splitting_doc'"
|
||||||
|
|
||||||
end function qmckl_sm_splitting_doc
|
end function qmckl_sm_splitting_doc
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@ -1673,6 +1730,8 @@ qmckl_exit_code qmckl_sm_splitting(
|
|||||||
double* Slater_inv,
|
double* Slater_inv,
|
||||||
double* determinant) {
|
double* determinant) {
|
||||||
|
|
||||||
|
printf("Entering 'qmckl_sm_splitting'\n");
|
||||||
|
|
||||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||||
return qmckl_failwith(
|
return qmckl_failwith(
|
||||||
context,
|
context,
|
||||||
@ -1680,7 +1739,7 @@ qmckl_exit_code qmckl_sm_splitting(
|
|||||||
"qmckl_sm_splitting",
|
"qmckl_sm_splitting",
|
||||||
NULL);
|
NULL);
|
||||||
}
|
}
|
||||||
#ifdef HAS_HPC
|
#ifdef HAVE_HPC
|
||||||
return qmckl_sm_splitting_hpc(
|
return qmckl_sm_splitting_hpc(
|
||||||
context,
|
context,
|
||||||
LDS,
|
LDS,
|
||||||
@ -1702,18 +1761,10 @@ qmckl_exit_code qmckl_sm_splitting(
|
|||||||
breakdown,
|
breakdown,
|
||||||
Slater_inv,
|
Slater_inv,
|
||||||
determinant);
|
determinant);
|
||||||
// return qmckl_sm_splitting_hpc(
|
|
||||||
// context,
|
|
||||||
// LDS,
|
|
||||||
// Dim,
|
|
||||||
// N_updates,
|
|
||||||
// Updates,
|
|
||||||
// Updates_index,
|
|
||||||
// breakdown,
|
|
||||||
// Slater_inv,
|
|
||||||
// determinant);
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
printf("Leaving 'qmckl_sm_splitting'\n");
|
||||||
|
|
||||||
return QMCKL_SUCCESS;
|
return QMCKL_SUCCESS;
|
||||||
}
|
}
|
||||||
#+end_src
|
#+end_src
|
||||||
|
Loading…
Reference in New Issue
Block a user