diff --git a/TODO.org b/TODO.org deleted file mode 100644 index 561860e..0000000 --- a/TODO.org +++ /dev/null @@ -1,48 +0,0 @@ -#+STARTUP: showeverything - -* Set up CI on Travis -* Write tests - -* malloc/free : Parameters for accelerators? -We should define qmckl_malloc and qmckl_free just to give the -possibility of the HPC implementations to define how they allocate the -memory (on CPU or GPU, using alternatives to malloc/free, etc). -A possibility could be to pass the id of a NUMA domain as a parameter of -qmckl_malloc, where the domain id is something obtained from the -context. - - -* TRANSA, TRANSB -* Performance info -* Benchmark interpolation of basis functions -* Complex numbers -* Adjustable number for derivatives (1,2,3) - -* Put pictures -* Make the Makefile part of the documented code ? -* Put the data-flow graph in the code. - -* Verificarlo TODO -These are installation instructions for -verificarlo which needs to be moved to -an appropriate place at some point. -** Compilation and Testing - -The following steps were required to get -the verificarlo version up and running on -an Ubuntu 20.04 laptop. - -1. Compilers - a. clang - For e.g. clang-7 - b. flang - For e.g. flang-7 : Care needs to be taken - that the flang version - is compatible with the - clang version used. - There are known issues - with using oneAPI due - to flang being incompatible - with oneAPI supplied clang. - c. gcc - For e.g. gcc-7 - -2. Environment varibales - a. VFC_BACKENDS - For e.g. `VFC_BACKENDS="libinterflop_ieee.so"` diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index c18d3fa..153cd4d 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -238,7 +238,10 @@ qmckl_exit_code qmckl_init_ao_basis(qmckl_context context); qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return false; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_init_ao_basis", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -255,29 +258,9 @@ qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) { ** Access functions - #+begin_src c :comments org :tangle (eval h_private_func) :exports none -char qmckl_get_ao_basis_type (const qmckl_context context); -int64_t qmckl_get_ao_basis_shell_num (const qmckl_context context); -int64_t qmckl_get_ao_basis_prim_num (const qmckl_context context); -int64_t qmckl_get_ao_basis_ao_num (const qmckl_context context); -int64_t* qmckl_get_ao_basis_nucleus_index (const qmckl_context context); -int64_t* qmckl_get_ao_basis_nucleus_shell_num(const qmckl_context context); -int32_t* qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context); -int64_t* qmckl_get_ao_basis_shell_prim_num (const qmckl_context context); -int64_t* qmckl_get_ao_basis_shell_prim_index (const qmckl_context context); -double* qmckl_get_ao_basis_shell_factor (const qmckl_context context); -double* qmckl_get_ao_basis_exponent (const qmckl_context context); -double* qmckl_get_ao_basis_coefficient (const qmckl_context context); -double* qmckl_get_ao_basis_prim_factor (const qmckl_context context); -double* qmckl_get_ao_basis_ao_factor (const qmckl_context context); - #+end_src - - When all the data for the AOs have been provided, the following - function returns ~true~. - - #+begin_src c :comments org :tangle (eval h_func) -bool qmckl_ao_basis_provided (const qmckl_context context); - #+end_src + In the following functions, when an array is passed as an argument + the size of the array should be also passed to check that the array + is large enough to accept the data. #+NAME:post #+begin_src c :exports none @@ -286,11 +269,23 @@ if ( (ctx->ao_basis.uninitialized & mask) != 0) { } #+end_src + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_type (const qmckl_context context, + char* const type); + #+end_src + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -char qmckl_get_ao_basis_type (const qmckl_context context) { +qmckl_exit_code +qmckl_get_ao_basis_type (const qmckl_context context, + char* const basis_type) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return (char) 0; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_type", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -299,17 +294,37 @@ char qmckl_get_ao_basis_type (const qmckl_context context) { int32_t mask = 1; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return (char) 0; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_type", + NULL); + } assert (ctx->ao_basis.type != (char) 0); - return ctx->ao_basis.type; + + ,*basis_type = ctx->ao_basis.type; + return QMCKL_SUCCESS; } + #+end_src -int64_t qmckl_get_ao_basis_shell_num (const qmckl_context context) { + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_num (const qmckl_context context, + int64_t* const shell_num); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_num (const qmckl_context context, + int64_t* const shell_num) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return (int64_t) 0; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_shell_factor", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -318,17 +333,35 @@ int64_t qmckl_get_ao_basis_shell_num (const qmckl_context context) { int32_t mask = 1 << 1; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return (int64_t) 0; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_shell_num", + NULL); } assert (ctx->ao_basis.shell_num > (int64_t) 0); - return ctx->ao_basis.shell_num; + ,*shell_num = ctx->ao_basis.shell_num; + return QMCKL_SUCCESS; } + #+end_src -int64_t qmckl_get_ao_basis_prim_num (const qmckl_context context) { + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_prim_num (const qmckl_context context, + int64_t* const prim_num); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_prim_num (const qmckl_context context, + int64_t* const prim_num) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return (int64_t) 0; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_prim_num", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -337,17 +370,38 @@ int64_t qmckl_get_ao_basis_prim_num (const qmckl_context context) { int32_t mask = 1 << 2; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return (int64_t) 0; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_prim_num", + NULL); } assert (ctx->ao_basis.prim_num > (int64_t) 0); - return ctx->ao_basis.prim_num; + + ,*prim_num = ctx->ao_basis.prim_num; + return QMCKL_SUCCESS; } + #+end_src -int64_t* qmckl_get_ao_basis_nucleus_shell_num (const qmckl_context context) { + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_nucleus_shell_num (const qmckl_context context, + int64_t* const nucleus_shell_num, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_nucleus_shell_num (const qmckl_context context, + int64_t* const nucleus_shell_num, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_nucleus_shell_num", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -356,16 +410,51 @@ int64_t* qmckl_get_ao_basis_nucleus_shell_num (const qmckl_context context) { int32_t mask = 1 << 3; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_nucleus_shell_num", + NULL); + } + + if (nucleus_shell_num == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_nucleus_shell_num", + "NULL pointer"); + } + + if (size_max < ctx->nucleus.num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_nucleus_shell_num", + "Array too small. Expected nucl_num"); } assert (ctx->ao_basis.nucleus_shell_num != NULL); - return ctx->ao_basis.nucleus_shell_num ; + memcpy(nucleus_shell_num, ctx->ao_basis.nucleus_shell_num, ctx->nucleus.num * sizeof(int64_t)); + return QMCKL_SUCCESS; } -int64_t* qmckl_get_ao_basis_nucleus_index (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_nucleus_index (const qmckl_context context, + int64_t* const nucleus_index, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_nucleus_index (const qmckl_context context, + int64_t* const nucleus_index, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_nucleus_index", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -374,17 +463,52 @@ int64_t* qmckl_get_ao_basis_nucleus_index (const qmckl_context context) { int32_t mask = 1 << 4; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_nucleus_index", + NULL); + } + + if (nucleus_index == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_nucleus_index", + "NULL pointer"); + } + + if (size_max < ctx->nucleus.num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_nucleus_index", + "Array too small. Expected shell_num"); } assert (ctx->ao_basis.nucleus_index != NULL); - return ctx->ao_basis.nucleus_index ; + memcpy(nucleus_index, ctx->ao_basis.nucleus_index, ctx->nucleus.num * sizeof(int64_t)); + return QMCKL_SUCCESS; } -int32_t* qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context, + int32_t* const shell_ang_mom, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context, + int32_t* const shell_ang_mom, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_shell_ang_mom", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -393,17 +517,52 @@ int32_t* qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context) { int32_t mask = 1 << 5; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_shell_ang_mom", + NULL); + } + + if (shell_ang_mom == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_shell_ang_mom", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.shell_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_shell_ang_mom", + "Array too small. Expected shell_num"); } assert (ctx->ao_basis.shell_ang_mom != NULL); - return ctx->ao_basis.shell_ang_mom; + memcpy(shell_ang_mom, ctx->ao_basis.shell_ang_mom, ctx->ao_basis.shell_num * sizeof(int32_t)); + return QMCKL_SUCCESS; } -int64_t* qmckl_get_ao_basis_shell_prim_num (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_prim_num (const qmckl_context context, + int64_t* const shell_prim_num, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_prim_num (const qmckl_context context, + int64_t* const shell_prim_num, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_shell_prim_num", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -412,17 +571,52 @@ int64_t* qmckl_get_ao_basis_shell_prim_num (const qmckl_context context) { int32_t mask = 1 << 6; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_shell_prim_num", + NULL); + } + + if (shell_prim_num == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_shell_prim_num", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.shell_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_shell_prim_num", + "Array too small. Expected shell_num"); } assert (ctx->ao_basis.shell_prim_num != NULL); - return ctx->ao_basis.shell_prim_num; + memcpy(shell_prim_num, ctx->ao_basis.shell_prim_num, ctx->ao_basis.shell_num * sizeof(int64_t)); + return QMCKL_SUCCESS; } -int64_t* qmckl_get_ao_basis_shell_prim_index (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_prim_index (const qmckl_context context, + int64_t* const shell_prim_index, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_prim_index (const qmckl_context context, + int64_t* const shell_prim_index, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_shell_prim_index", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -431,17 +625,50 @@ int64_t* qmckl_get_ao_basis_shell_prim_index (const qmckl_context context) { int32_t mask = 1 << 7; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_shell_prim_index", + NULL); + } + + if (shell_prim_index == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_shell_prim_index", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.shell_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_shell_prim_index", + "Array too small. Expected shell_num"); } assert (ctx->ao_basis.shell_prim_index != NULL); - return ctx->ao_basis.shell_prim_index; + memcpy(shell_prim_index, ctx->ao_basis.shell_prim_index, ctx->ao_basis.shell_num * sizeof(int64_t)); + return QMCKL_SUCCESS; } + #+end_src + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_factor (const qmckl_context context, + double* const shell_factor, + const int64_t size_max); + #+end_src -double* qmckl_get_ao_basis_shell_factor (const qmckl_context context) { + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_shell_factor (const qmckl_context context, + double* const shell_factor, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_shell_factor", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -450,37 +677,104 @@ double* qmckl_get_ao_basis_shell_factor (const qmckl_context context) { int32_t mask = 1 << 8; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_shell_factor", + NULL); + } + + if (shell_factor == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_shell_factor", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.shell_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_shell_factor", + "Array too small. Expected shell_num"); } assert (ctx->ao_basis.shell_factor != NULL); - return ctx->ao_basis.shell_factor; + memcpy(shell_factor, ctx->ao_basis.shell_factor, ctx->ao_basis.shell_num * sizeof(double)); + return QMCKL_SUCCESS; } -double* qmckl_get_ao_basis_exponent (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_exponent (const qmckl_context context, + double* const exponent, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_exponent (const qmckl_context context, + double* const exponent, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_exponent", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); - int32_t mask = 1 << 9; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_exponent", + NULL); + } + + if (exponent == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_exponent", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.prim_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_exponent", + "Array too small. Expected prim_num"); } assert (ctx->ao_basis.exponent != NULL); - return ctx->ao_basis.exponent; + memcpy(exponent, ctx->ao_basis.exponent, ctx->ao_basis.prim_num * sizeof(double)); + return QMCKL_SUCCESS; } + #+end_src + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_coefficient (const qmckl_context context, + double* const coefficient, + const int64_t size_max); + #+end_src -double* qmckl_get_ao_basis_coefficient (const qmckl_context context) { + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_coefficient (const qmckl_context context, + double* const coefficient, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_coefficient", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -489,17 +783,51 @@ double* qmckl_get_ao_basis_coefficient (const qmckl_context context) { int32_t mask = 1 << 10; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_coefficient", + NULL); } + if (coefficient == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_coefficient", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.prim_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_coefficient", + "Array too small. Expected prim_num"); + } assert (ctx->ao_basis.coefficient != NULL); - return ctx->ao_basis.coefficient; + memcpy(coefficient, ctx->ao_basis.coefficient, ctx->ao_basis.prim_num * sizeof(double)); + return QMCKL_SUCCESS; } -double* qmckl_get_ao_basis_prim_factor (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_prim_factor (const qmckl_context context, + double* const prim_factor, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_prim_factor (const qmckl_context context, + double* const prim_factor, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_prim_factor", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -508,17 +836,50 @@ double* qmckl_get_ao_basis_prim_factor (const qmckl_context context) { int32_t mask = 1 << 11; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_prim_factor", + NULL); + } + + if (prim_factor == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_prim_factor", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.prim_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_prim_factor", + "Array too small. Expected prim_num"); } assert (ctx->ao_basis.prim_factor != NULL); - return ctx->ao_basis.prim_factor; + memcpy(prim_factor, ctx->ao_basis.prim_factor, ctx->ao_basis.prim_num * sizeof(double)); + return QMCKL_SUCCESS; } -int64_t qmckl_get_ao_basis_ao_num (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_get_ao_basis_ao_num (const qmckl_context context, + int64_t* const ao_num); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_ao_num (const qmckl_context context, + int64_t* const ao_num) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return (int64_t) 0; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_ao_num", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -527,17 +888,32 @@ int64_t qmckl_get_ao_basis_ao_num (const qmckl_context context) { int32_t mask = 1 << 12; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return (int64_t) 0; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_ao_num", + NULL); } assert (ctx->ao_basis.ao_num > (int64_t) 0); - return ctx->ao_basis.ao_num; + + *ao_num = ctx->ao_basis.ao_num; + return QMCKL_SUCCESS; } -double* qmckl_get_ao_basis_ao_factor (const qmckl_context context) { + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_ao_factor (const qmckl_context context, + double* const ao_factor, + const int64_t size_max) +{ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return NULL; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_ao_factor", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -546,14 +922,46 @@ double* qmckl_get_ao_basis_ao_factor (const qmckl_context context) { int32_t mask = 1 << 13; if ( (ctx->ao_basis.uninitialized & mask) != 0) { - return NULL; + return qmckl_failwith( context, + QMCKL_NOT_PROVIDED, + "qmckl_get_ao_basis_ao_factor", + NULL); + } + + if (ao_factor == NULL) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_get_ao_basis_ao_factor", + "NULL pointer"); + } + + if (size_max < ctx->ao_basis.ao_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_ao_factor", + "Array too small. Expected ao_num"); } assert (ctx->ao_basis.ao_factor != NULL); - return ctx->ao_basis.ao_factor; + memcpy(ao_factor, ctx->ao_basis.ao_factor, ctx->ao_basis.ao_num * sizeof(double)); + return QMCKL_SUCCESS; } + #+end_src + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code qmckl_get_ao_basis_ao_factor (const qmckl_context context, + double* const ao_factor, + const int64_t size_max); + #+end_src + When all the data for the AOs have been provided, the following + function returns ~true~. + + #+begin_src c :comments org :tangle (eval h_func) +bool qmckl_ao_basis_provided (const qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none bool qmckl_ao_basis_provided(const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { @@ -565,9 +973,6 @@ bool qmckl_ao_basis_provided(const qmckl_context context) { return ctx->ao_basis.provided; } - - - #+end_src ** Initialization functions @@ -596,7 +1001,10 @@ qmckl_exit_code qmckl_set_ao_basis_cartesian (qmckl_context context, con #+NAME:pre2 #+begin_src c :exports none if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_*", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -630,8 +1038,9 @@ qmckl_exit_code qmckl_set_ao_basis_type(qmckl_context context, const char t) { <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_shell_num(qmckl_context context, const int64_t shell_num) { <> @@ -642,7 +1051,7 @@ qmckl_exit_code qmckl_set_ao_basis_shell_num(qmckl_context context, const int64_ "shell_num <= 0"); } - int64_t prim_num = qmckl_get_ao_basis_prim_num(context); + const int64_t prim_num = ctx->ao_basis.prim_num; if (0L < prim_num && prim_num < shell_num) { return qmckl_failwith( context, @@ -656,8 +1065,9 @@ qmckl_exit_code qmckl_set_ao_basis_shell_num(qmckl_context context, const int64_ <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_prim_num(qmckl_context context, const int64_t prim_num) { <> @@ -668,7 +1078,14 @@ qmckl_exit_code qmckl_set_ao_basis_prim_num(qmckl_context context, const int64_ "prim_num must be positive"); } - int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + const int64_t shell_num = ctx->ao_basis.shell_num; + + if (shell_num <= 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_shell_num", + "shell_num is not set"); + } if (prim_num < shell_num) { return qmckl_failwith( context, @@ -682,15 +1099,17 @@ qmckl_exit_code qmckl_set_ao_basis_prim_num(qmckl_context context, const int64_ <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_nucleus_shell_num(qmckl_context context, const int64_t* nucleus_shell_num) { <> int32_t mask = 1 << 3; - const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); - if (shell_num == 0L) { + const int64_t shell_num = ctx->ao_basis.shell_num; + + if (shell_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_nucleus_shell_num", @@ -723,14 +1142,17 @@ qmckl_exit_code qmckl_set_ao_basis_nucleus_shell_num(qmckl_context context, con <> } + #+end_src + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_nucleus_index(qmckl_context context, const int64_t* nucleus_index) { <> int32_t mask = 1 << 4; - const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); - if (shell_num == 0L) { + const int64_t shell_num = ctx->ao_basis.shell_num; + + if (shell_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_nucleus_index", @@ -763,14 +1185,16 @@ qmckl_exit_code qmckl_set_ao_basis_nucleus_index(qmckl_context context, const i <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom(qmckl_context context, const int32_t* shell_ang_mom) { <> int32_t mask = 1 << 5; - const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + const int64_t shell_num = ctx->ao_basis.shell_num; + if (shell_num == 0L) { return qmckl_failwith( context, QMCKL_FAILURE, @@ -805,15 +1229,17 @@ qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom(qmckl_context context, const i <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_shell_prim_num(qmckl_context context, const int64_t* shell_prim_num) { <> int32_t mask = 1 << 6; - const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); - if (shell_num == 0L) { + const int64_t shell_num = ctx->ao_basis.shell_num; + + if (shell_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_shell_prim_num", @@ -847,15 +1273,17 @@ qmckl_exit_code qmckl_set_ao_basis_shell_prim_num(qmckl_context context, const <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_shell_prim_index(qmckl_context context, const int64_t* shell_prim_index) { <> int32_t mask = 1 << 7; - const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); - if (shell_num == 0L) { + const int64_t shell_num = ctx->ao_basis.shell_num; + + if (shell_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_shell_prim_index", @@ -888,15 +1316,17 @@ qmckl_exit_code qmckl_set_ao_basis_shell_prim_index(qmckl_context context, cons <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_shell_factor(qmckl_context context, const double* shell_factor) { <> int32_t mask = 1 << 8; - const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); - if (shell_num == 0L) { + const int64_t shell_num = ctx->ao_basis.shell_num; + + if (shell_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_shell_factor", @@ -930,14 +1360,17 @@ qmckl_exit_code qmckl_set_ao_basis_shell_factor(qmckl_context context, const do <> } + #+end_src + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_exponent(qmckl_context context, const double* exponent) { <> int32_t mask = 1 << 9; - const int64_t prim_num = qmckl_get_ao_basis_prim_num(context); - if (prim_num == 0L) { + const int64_t prim_num = ctx->ao_basis.prim_num; + + if (prim_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_exponent", @@ -970,14 +1403,17 @@ qmckl_exit_code qmckl_set_ao_basis_exponent(qmckl_context context, const double <> } + #+end_src + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const double* coefficient) { <> int32_t mask = 1 << 10; - const int64_t prim_num = qmckl_get_ao_basis_prim_num(context); - if (prim_num == 0L) { + const int64_t prim_num = ctx->ao_basis.prim_num; + + if (prim_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_coefficient", @@ -1010,15 +1446,17 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_prim_factor(qmckl_context context, const double* prim_factor) { <> int32_t mask = 1 << 11; - const int64_t prim_num = qmckl_get_ao_basis_prim_num(context); - if (prim_num == 0L) { + const int64_t prim_num = ctx->ao_basis.prim_num; + + if (prim_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_prim_factor", @@ -1052,8 +1490,9 @@ qmckl_exit_code qmckl_set_ao_basis_prim_factor(qmckl_context context, const dou <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_ao_num(qmckl_context context, const int64_t ao_num) { <> @@ -1064,7 +1503,13 @@ qmckl_exit_code qmckl_set_ao_basis_ao_num(qmckl_context context, const int64_t "ao_num must be positive"); } - int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + const int64_t shell_num = ctx->ao_basis.shell_num; + if (shell_num <= 0L) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_shell_num", + "shell_num is not set"); + } if (ao_num < shell_num) { return qmckl_failwith( context, @@ -1078,15 +1523,17 @@ qmckl_exit_code qmckl_set_ao_basis_ao_num(qmckl_context context, const int64_t <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_ao_factor(qmckl_context context, const double* ao_factor) { <> int32_t mask = 1 << 13; - const int64_t ao_num = qmckl_get_ao_basis_ao_num(context); - if (ao_num == 0L) { + const int64_t ao_num = ctx->ao_basis.ao_num; + + if (ao_num <= 0L) { return qmckl_failwith( context, QMCKL_FAILURE, "qmckl_set_ao_basis_ao_factor", @@ -1120,8 +1567,9 @@ qmckl_exit_code qmckl_set_ao_basis_ao_factor(qmckl_context context, const doubl <> } + #+end_src - + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_cartesian(qmckl_context context, const bool t) { <> @@ -1148,16 +1596,18 @@ qmckl_exit_code qmckl_finalize_basis(qmckl_context context); qmckl_exit_code qmckl_finalize_basis(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_INVALID_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_finalize_basis", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); int64_t nucl_num = 0; - qmckl_exit_code rc = QMCKL_FAILURE; - rc = qmckl_get_nucleus_num(context, &nucl_num); + qmckl_exit_code rc = qmckl_get_nucleus_num(context, &nucl_num); if (rc != QMCKL_SUCCESS) return rc; /* nucleus_prim_index */ @@ -1536,64 +1986,97 @@ double * ao_factor_test ; char typ_test ; -typ_test = qmckl_get_ao_basis_type (context); +rc = qmckl_get_ao_basis_type (context, &typ_test); +assert (rc == QMCKL_SUCCESS); assert(typ == typ_test); -shell_num_test = qmckl_get_ao_basis_shell_num (context); +rc = qmckl_get_ao_basis_shell_num (context, &shell_num_test); +assert (rc == QMCKL_SUCCESS); assert(shell_num == shell_num_test); -prim_num_test = qmckl_get_ao_basis_prim_num (context); +rc = qmckl_get_ao_basis_prim_num (context, &prim_num_test); +assert (rc == QMCKL_SUCCESS); assert(prim_num == prim_num_test); -nucleus_index_test = qmckl_get_ao_basis_nucleus_index (context); +nucleus_index_test = (int64_t*) malloc (nucl_num * sizeof(int64_t)); +rc = qmckl_get_ao_basis_nucleus_index (context, nucleus_index_test, nucl_num); +assert (rc == QMCKL_SUCCESS); for (int64_t i=0 ; i < nucl_num ; ++i) { assert(nucleus_index_test[i] == nucleus_index[i]); } +free(nucleus_index_test); + +nucleus_shell_num_test = (int64_t*) malloc ( nucl_num * sizeof(int64_t)); +rc = qmckl_get_ao_basis_nucleus_shell_num (context, nucleus_shell_num_test, nucl_num); +assert (rc == QMCKL_SUCCESS); -nucleus_shell_num_test = qmckl_get_ao_basis_nucleus_shell_num (context); for (int64_t i=0 ; i < nucl_num ; ++i) { assert(nucleus_shell_num_test[i] == nucleus_shell_num[i]); } -shell_ang_mom_test = qmckl_get_ao_basis_shell_ang_mom (context); +shell_ang_mom_test = (int32_t*) malloc ( shell_num * sizeof(int32_t)); +rc = qmckl_get_ao_basis_shell_ang_mom (context, shell_ang_mom_test, shell_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < shell_num ; ++i) { assert(shell_ang_mom_test[i] == shell_ang_mom[i]); } -shell_factor_test = qmckl_get_ao_basis_shell_factor (context); +shell_factor_test = (double*) malloc ( shell_num * sizeof(double)); +rc = qmckl_get_ao_basis_shell_factor (context, shell_factor_test, shell_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < shell_num ; ++i) { assert(shell_factor_test[i] == shell_factor[i]); } -shell_prim_num_test = qmckl_get_ao_basis_shell_prim_num (context); +shell_prim_num_test = (int64_t*) malloc ( shell_num * sizeof(int64_t)); +rc = qmckl_get_ao_basis_shell_prim_num (context, shell_prim_num_test, shell_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < shell_num ; ++i) { assert(shell_prim_num_test[i] == shell_prim_num[i]); } -shell_prim_index_test = qmckl_get_ao_basis_shell_prim_index (context); +shell_prim_index_test = (int64_t*) malloc ( shell_num * sizeof(int64_t)); +rc = qmckl_get_ao_basis_shell_prim_index (context, shell_prim_index_test, shell_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < shell_num ; ++i) { assert(shell_prim_index_test[i] == shell_prim_index[i]); } -exponent_test = qmckl_get_ao_basis_exponent(context); +exponent_test = (double*) malloc ( prim_num * sizeof(double)); +rc = qmckl_get_ao_basis_exponent(context, exponent_test, prim_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < prim_num ; ++i) { assert(exponent_test[i] == exponent[i]); } -coefficient_test = qmckl_get_ao_basis_coefficient(context); +coefficient_test = (double*) malloc ( prim_num * sizeof(double)); +rc = qmckl_get_ao_basis_coefficient(context, coefficient_test, prim_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < prim_num ; ++i) { assert(coefficient_test[i] == coefficient[i]); } -prim_factor_test = qmckl_get_ao_basis_prim_factor (context); +prim_factor_test = (double*) malloc ( prim_num * sizeof(double)); +rc = qmckl_get_ao_basis_prim_factor (context, prim_factor_test, prim_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < prim_num ; ++i) { assert(prim_factor_test[i] == prim_factor[i]); } -ao_num_test = qmckl_get_ao_basis_ao_num(context); +rc = qmckl_get_ao_basis_ao_num(context, &ao_num_test); assert(ao_num == ao_num_test); -ao_factor_test = qmckl_get_ao_basis_ao_factor (context); +ao_factor_test = (double*) malloc ( ao_num * sizeof(double)); +rc = qmckl_get_ao_basis_ao_factor (context, ao_factor_test, ao_num); +assert (rc == QMCKL_SUCCESS); + for (int64_t i=0 ; i < ao_num ; ++i) { assert(ao_factor_test[i] == ao_factor[i]); } @@ -1745,12 +2228,9 @@ end function qmckl_ao_gaussian_vgl #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) use qmckl - use qmckl_probes_f - implicit none integer(c_int64_t), intent(in), value :: context - logical(C_BOOL) :: vfc_err integer*8 :: n, ldv, j, i double precision :: X(3), R(3), Y(3), r2 @@ -1759,13 +2239,6 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) epsilon = qmckl_get_numprec_epsilon(context) -#ifdef VFC_CI - ! Multplying epsilon by 16 = 2^4 is equivalent to asking 4 significant digits - ! less. This makes sense because we are adding noise with MCA so we can't be - ! as strict on the accuracy target. - epsilon = epsilon * 16 -#endif - X = (/ 1.1 , 2.2 , 3.3 /) R = (/ 0.1 , 1.2 , -2.3 /) Y(:) = X(:) - R(:) @@ -1782,29 +2255,10 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) test_qmckl_ao_gaussian_vgl = & qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "gaussian_vgl_2_1"//C_NULL_CHAR, & - DBLE(VGL(2,1)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "gaussian_vgl_2_2"//C_NULL_CHAR, & - DBLE(VGL(2,2)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "gaussian_vgl_2_3"//C_NULL_CHAR, & - DBLE(VGL(2,3)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "gaussian_vgl_2_4"//C_NULL_CHAR, & - DBLE(VGL(2,4)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "gaussian_vgl_2_5"//C_NULL_CHAR, & - DBLE(VGL(2,5)), DBLE(0), DBLE(epsilon)) - -#ifndef VFC_CI if (test_qmckl_ao_gaussian_vgl /= 0) return -#endif test_qmckl_ao_gaussian_vgl = -1 -#ifndef VFC_CI do i=1,n test_qmckl_ao_gaussian_vgl = -11 if (dabs(1.d0 - VGL(i,1) / (& @@ -1831,7 +2285,6 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) & )) > epsilon ) return end do -#endif test_qmckl_ao_gaussian_vgl = 0 @@ -1858,7 +2311,10 @@ qmckl_exit_code qmckl_get_ao_basis_primitive_vgl(qmckl_context context, double* qmckl_exit_code qmckl_get_ao_basis_primitive_vgl(qmckl_context context, double* const primitive_vgl) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_primitive_vgl", + NULL); } qmckl_exit_code rc; @@ -1887,7 +2343,10 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_provide_get_ao_basis_primitive_vgl", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -2203,7 +2662,10 @@ qmckl_exit_code qmckl_get_ao_basis_shell_vgl(qmckl_context context, double* cons qmckl_exit_code qmckl_get_ao_basis_shell_vgl(qmckl_context context, double* const shell_vgl) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_shell_vgl", + NULL); } qmckl_exit_code rc; @@ -2246,7 +2708,10 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_provide_ao_basis_shell_vgl", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -2255,7 +2720,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) if (!ctx->ao_basis.provided) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, - "qmckl_ao_basis_shell_vgl", + "qmckl_provide_ao_basis_shell_vgl", NULL); } @@ -2774,12 +3239,8 @@ end function qmckl_ao_power_f #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) use qmckl - use qmckl_probes_f - implicit none - logical(C_BOOL) :: vfc_err - integer(qmckl_context), intent(in), value :: context integer*8 :: n, LDP @@ -2790,13 +3251,6 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) epsilon = qmckl_get_numprec_epsilon(context) -#ifdef VFC_CI - ! Multplying epsilon by 16 = 2^4 is equivalent to asking 4 significant digits - ! less. This makes sense because we are adding noise with MCA so we can't be - ! as strict on the accuracy target. - epsilon = epsilon * 16 -#endif - n = 100; LDP = 10; @@ -2808,15 +3262,10 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) end do test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "power_2_2"//C_NULL_CHAR, & - DBLE(P(2,2)), DBLE(0), DBLE(epsilon)) - if (test_qmckl_ao_power /= QMCKL_SUCCESS) return test_qmckl_ao_power = QMCKL_FAILURE -#ifndef VFC_CI do j=1,n do i=1,LMAX(j) if ( X(j)**i == 0.d0 ) then @@ -2826,7 +3275,6 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) end if end do end do -#endif test_qmckl_ao_power = QMCKL_SUCCESS deallocate(X,P,LMAX) @@ -3119,12 +3567,9 @@ end function qmckl_ao_polynomial_vgl_f #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl - use qmckl_probes_f - implicit none integer(c_int64_t), intent(in), value :: context - logical(C_BOOL) :: vfc_err integer :: lmax, d, i integer, allocatable :: L(:,:) @@ -3151,25 +3596,9 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) test_qmckl_ao_polynomial_vgl = & qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "polynomial_vgl_1_2"//C_NULL_CHAR, & - DBLE(VGL(1,2)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "polynomial_vgl_2_2"//C_NULL_CHAR, & - DBLE(VGL(2,2)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "polynomial_vgl_3_2"//C_NULL_CHAR, & - DBLE(VGL(3,2)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "polynomial_vgl_4_2"//C_NULL_CHAR, & - DBLE(VGL(4,2)), DBLE(0), DBLE(epsilon)) - - vfc_err = qmckl_probe_check("ao"//C_NULL_CHAR, "polynomial_vgl_5_2"//C_NULL_CHAR, & - DBLE(VGL(5,2)), DBLE(0), DBLE(epsilon)) - if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return if (n /= d) return -#ifndef VFC_CI do j=1,n test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE do i=1,3 @@ -3220,7 +3649,6 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) end if if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return end do -#endif test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS @@ -3245,7 +3673,10 @@ qmckl_exit_code qmckl_get_ao_vgl(qmckl_context context, double* const ao_vgl); qmckl_exit_code qmckl_get_ao_vgl(qmckl_context context, double* const ao_vgl) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_vgl", + NULL); } qmckl_exit_code rc; @@ -3288,7 +3719,10 @@ qmckl_exit_code qmckl_provide_ao_vgl(qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return QMCKL_NULL_CONTEXT; + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_provide_ao_vgl", + NULL); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -3772,3 +4206,5 @@ assert( fabs(ao_vgl[1][26][224] - (-3.843864637762753e-09)) < 1.e-14 ); # -*- mode: org -*- # vim: syntax=c + +