1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-08-18 03:11:44 +02:00

Added an example usage of qmckl_sherman_morrison function as a test. #25

This commit is contained in:
vijay gopal chilkuri 2021-07-20 19:34:51 +02:00
parent 6b847d6dd3
commit 04d2ec2d70

View File

@ -25,6 +25,7 @@ int main() {
qmckl_context context; qmckl_context context;
context = qmckl_context_create(); context = qmckl_context_create();
qmckl_exit_code rc;
#+end_src #+end_src
* Sherman-Morrison Helper Functions * Sherman-Morrison Helper Functions
@ -58,7 +59,7 @@ This function is used to set the threshold value that is used in the kernels to
#define THRESHOLD 1e-3 #define THRESHOLD 1e-3
#endif #endif
qmckl_exit_code qmckl_sherman_morrison_threshold ( qmckl_exit_code qmckl_sherman_morrison_threshold_c (
double* const thresh ); double* const thresh );
#+end_src #+end_src
@ -83,11 +84,12 @@ end function qmckl_sherman_morrison_threshold_f
#include "qmckl.h" #include "qmckl.h"
// Sherman-Morrison-Woodbury break-down threshold // Sherman-Morrison-Woodbury break-down threshold
static double qmckl_shreman_morrison_threshold(double* const threshold) { qmckl_exit_code qmckl_sherman_morrison_threshold_c(double* const threshold) {
*threshold = THRESHOLD; *threshold = THRESHOLD;
// #ifdef DEBUG // #ifdef DEBUG
// std::cerr << "Break-down threshold set to: " << threshold << std::endl; // std::cerr << "Break-down threshold set to: " << threshold << std::endl;
// #endif // #endif
return QMCKL_SUCCESS;
} }
#+end_src #+end_src
@ -109,8 +111,8 @@ static double qmckl_shreman_morrison_threshold(double* const threshold) {
real (c_double ) , intent(out) :: thresh real (c_double ) , intent(out) :: thresh
integer(c_int32_t), external :: qmckl_sherman_morrison_threshold_f integer(c_int32_t), external :: qmckl_sherman_morrison_threshold_c
info = qmckl_sherman_morrison_threshold_f & info = qmckl_sherman_morrison_threshold_c &
(thresh) (thresh)
end function qmckl_sherman_morrison_threshold end function qmckl_sherman_morrison_threshold
@ -193,7 +195,7 @@ integer function qmckl_sherman_morrison_f(context, Slater_inv, Dim, N_updates,
use qmckl use qmckl
implicit none implicit none
integer(qmckl_context) , intent(in) :: context integer(qmckl_context) , intent(in) :: context
integer*8 , intent(in) :: Dim, N_updates integer*8 , intent(in), value :: Dim, N_updates
integer*8 , intent(in) :: Updates_index(N_updates) integer*8 , intent(in) :: Updates_index(N_updates)
real*8 , intent(in) :: Updates(N_updates*Dim) real*8 , intent(in) :: Updates(N_updates*Dim)
real*8 , intent(inout) :: Slater_inv(Dim*Dim) real*8 , intent(inout) :: Slater_inv(Dim*Dim)
@ -222,7 +224,7 @@ qmckl_exit_code qmckl_sherman_morrison_c(const qmckl_context context,
double D[Dim]; double D[Dim];
double threshold = 0.0; double threshold = 0.0;
qmckl_sherman_morrison_threshold(&threshold); qmckl_exit_code rc = qmckl_sherman_morrison_threshold_c(&threshold);
unsigned int l = 0; unsigned int l = 0;
// For each update // For each update
@ -237,8 +239,8 @@ qmckl_exit_code qmckl_sherman_morrison_c(const qmckl_context context,
// Denominator // Denominator
double den = 1 + C[Updates_index[l] - 1]; double den = 1 + C[Updates_index[l] - 1];
double const thresh; double thresh = 0.0;
qmckl_sherman_morrison_threshold(&thresh); qmckl_exit_code rc = qmckl_sherman_morrison_threshold_c(&thresh);
if (fabs(den) < thresh) { if (fabs(den) < thresh) {
return QMCKL_FAILURE; return QMCKL_FAILURE;
} }
@ -322,6 +324,18 @@ qmckl_exit_code qmckl_sherman_morrison_c(const qmckl_context context,
[TODO: FMJC] Write tests for the Sherman-Morrison part. [TODO: FMJC] Write tests for the Sherman-Morrison part.
#+begin_src c :tangle (eval c_test)
const uint64_t Dim = 2;
const uint64_t N_updates = 2;
const uint64_t Updates_index[2] = {0, 0};
const double Updates[4] = {0.0, 0.0, 0.0, 0.0};
double Slater_inv[4] = {0.0, 0.0, 0.0, 0.0};
rc = qmckl_sherman_morrison_c(context, Dim, N_updates, Updates, Updates_index, Slater_inv);
assert(rc == QMCKL_SUCCESS);
#+end_src
* End of files * End of files
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test)