TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-08-16 18:38:28 +02:00
Code Issues Projects Releases Wiki Activity

Avoid duplicate storage of constant parameters in AO

Browse Source
This commit is contained in:
Anthony Scemama 2022-07-08 09:15:17 +02:00
parent 1b846de413
commit 06e6221d33
3 changed files with 154 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

274
org/qmckl_ao.org
View File

@ -360,12 +360,19 @@ qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) {
#+begin_src c :exports none
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_*",
QMCKL_NULL_CONTEXT,
"qmckl_get_ao_*",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
if (!(ctx->ao_basis.uninitialized & mask)) {
return qmckl_failwith( context,
QMCKL_ALREADY_SET,
"qmckl_get_ao_*",
NULL);
}
#+end_src
#+NAME:post2
@ -394,6 +401,8 @@ qmckl_exit_code
qmckl_set_ao_basis_type(qmckl_context context,
const char basis_type)
{
int32_t mask = 1;
<<pre2>>
if (basis_type != 'G' && basis_type != 'S') {
@ -403,7 +412,6 @@ qmckl_set_ao_basis_type(qmckl_context context,
NULL);
}
int32_t mask = 1;
ctx->ao_basis.type = basis_type;
<<post2>>
@ -422,6 +430,8 @@ qmckl_exit_code
qmckl_set_ao_basis_shell_num (qmckl_context context,
const int64_t shell_num)
{
int32_t mask = 1 << 1;
<<pre2>>
if (shell_num <= 0) {
@ -440,7 +450,6 @@ qmckl_set_ao_basis_shell_num (qmckl_context context,
"shell_num > prim_num");
}
int32_t mask = 1 << 1;
ctx->ao_basis.shell_num = shell_num;
<<post2>>
@ -459,6 +468,8 @@ qmckl_exit_code
qmckl_set_ao_basis_prim_num (qmckl_context context,
const int64_t prim_num)
{
int32_t mask = 1 << 2;
<<pre2>>
if (prim_num <= 0) {
@ -484,7 +495,6 @@ qmckl_set_ao_basis_prim_num (qmckl_context context,
"prim_num < shell_num");
}
int32_t mask = 1 << 2;
ctx->ao_basis.prim_num = prim_num;
<<post2>>
@ -492,111 +502,6 @@ qmckl_set_ao_basis_prim_num (qmckl_context context,
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_ao_num (qmckl_context context,
const int64_t ao_num);
#+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)
{
<<pre2>>
if (ao_num <= 0) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"ao_num must be positive");
}
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,
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"ao_num < shell_num");
}
int32_t mask = 1 << 12;
ctx->ao_basis.ao_num = ao_num;
<<post2>>
}
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_nucleus_index (qmckl_context context,
const int64_t* 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_set_ao_basis_nucleus_index (qmckl_context context,
const int64_t* nucleus_index,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 4;
const int64_t nucl_num = ctx->nucleus.num;
if (nucl_num <= 0L) {
return qmckl_failwith( context,
QMCKL_FAILURE,
"qmckl_set_ao_basis_nucleus_index",
"nucl_num is not set");
}
if (size_max < nucl_num) {
return qmckl_failwith( context,
QMCKL_FAILURE,
"qmckl_set_ao_basis_nucleus_index",
"input array too small");
}
if (ctx->ao_basis.nucleus_index != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.nucleus_index);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_nucleus_index",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = nucl_num * sizeof(int64_t);
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_nucleus_index",
NULL);
}
memcpy(new_array, nucleus_index, mem_info.size);
ctx->ao_basis.nucleus_index = new_array;
<<post2>>
}
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_nucleus_shell_num (qmckl_context context,
@ -610,10 +515,10 @@ qmckl_set_ao_basis_nucleus_shell_num (qmckl_context context,
const int64_t* nucleus_shell_num,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 3;
<<pre2>>
const int64_t nucl_num = ctx->nucleus.num;
if (nucl_num <= 0L) {
@ -659,6 +564,68 @@ qmckl_set_ao_basis_nucleus_shell_num (qmckl_context context,
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_nucleus_index (qmckl_context context,
const int64_t* 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_set_ao_basis_nucleus_index (qmckl_context context,
const int64_t* nucleus_index,
const int64_t size_max)
{
int32_t mask = 1 << 4;
<<pre2>>
const int64_t nucl_num = ctx->nucleus.num;
if (nucl_num <= 0L) {
return qmckl_failwith( context,
QMCKL_FAILURE,
"qmckl_set_ao_basis_nucleus_index",
"nucl_num is not set");
}
if (size_max < nucl_num) {
return qmckl_failwith( context,
QMCKL_FAILURE,
"qmckl_set_ao_basis_nucleus_index",
"input array too small");
}
if (ctx->ao_basis.nucleus_index != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.nucleus_index);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_nucleus_index",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = nucl_num * sizeof(int64_t);
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_nucleus_index",
NULL);
}
memcpy(new_array, nucleus_index, mem_info.size);
ctx->ao_basis.nucleus_index = new_array;
<<post2>>
}
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_shell_ang_mom (qmckl_context context,
@ -672,10 +639,10 @@ qmckl_set_ao_basis_shell_ang_mom (qmckl_context context,
const int32_t* shell_ang_mom,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 5;
<<pre2>>
const int64_t shell_num = ctx->ao_basis.shell_num;
if (shell_num == 0L) {
@ -735,10 +702,10 @@ qmckl_set_ao_basis_shell_prim_num (qmckl_context context,
const int64_t* shell_prim_num,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 6;
<<pre2>>
const int64_t shell_num = ctx->ao_basis.shell_num;
if (shell_num <= 0L) {
@ -798,10 +765,10 @@ qmckl_set_ao_basis_shell_prim_index (qmckl_context context,
const int64_t* shell_prim_index,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 7;
<<pre2>>
const int64_t shell_num = ctx->ao_basis.shell_num;
if (shell_num <= 0L) {
@ -860,10 +827,10 @@ qmckl_set_ao_basis_shell_factor (qmckl_context context,
const double* shell_factor,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 8;
<<pre2>>
const int64_t shell_num = ctx->ao_basis.shell_num;
if (shell_num <= 0L) {
@ -922,10 +889,10 @@ qmckl_set_ao_basis_exponent (qmckl_context context,
const double* exponent,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 9;
<<pre2>>
const int64_t prim_num = ctx->ao_basis.prim_num;
if (prim_num <= 0L) {
@ -984,10 +951,10 @@ qmckl_set_ao_basis_coefficient (qmckl_context context,
const double* coefficient,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 10;
<<pre2>>
const int64_t prim_num = ctx->ao_basis.prim_num;
if (prim_num <= 0L) {
@ -1046,10 +1013,10 @@ qmckl_set_ao_basis_prim_factor (qmckl_context context,
const double* prim_factor,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 11;
<<pre2>>
const int64_t prim_num = ctx->ao_basis.prim_num;
if (prim_num <= 0L) {
@ -1095,6 +1062,51 @@ qmckl_set_ao_basis_prim_factor (qmckl_context context,
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_ao_num (qmckl_context context,
const int64_t ao_num);
#+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)
{
int32_t mask = 1 << 12;
<<pre2>>
if (ao_num <= 0) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"ao_num must be positive");
}
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,
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"ao_num < shell_num");
}
ctx->ao_basis.ao_num = ao_num;
<<post2>>
}
#+end_src
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_ao_factor (qmckl_context context,
@ -1108,10 +1120,10 @@ qmckl_set_ao_basis_ao_factor (qmckl_context context,
const double* ao_factor,
const int64_t size_max)
{
<<pre2>>
int32_t mask = 1 << 13;
<<pre2>>
const int64_t ao_num = ctx->ao_basis.ao_num;
if (ao_num <= 0L) {
@ -1168,9 +1180,10 @@ qmckl_exit_code
qmckl_set_ao_basis_cartesian (qmckl_context context,
const bool cartesian)
{
int32_t mask = 1;
<<pre2>>
int32_t mask = 1;
ctx->ao_basis.ao_cartesian = cartesian;
<<post2>>
@ -2325,6 +2338,9 @@ rc = qmckl_set_ao_basis_nucleus_index (context, nucleus_index, nucl_num);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
rc = qmckl_set_ao_basis_nucleus_index (context, nucleus_index, nucl_num);
assert(rc == QMCKL_ALREADY_SET);
rc = qmckl_set_ao_basis_nucleus_shell_num (context, nucleus_shell_num, nucl_num);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));

12
org/qmckl_error.org
View File

@ -105,7 +105,8 @@ typedef int32_t qmckl_exit_code;
| ~QMCKL_DEALLOCATION_FAILED~ | 105 | 'De-allocation failed' |
| ~QMCKL_NOT_PROVIDED~ | 106 | 'Not provided' |
| ~QMCKL_OUT_OF_BOUNDS~ | 107 | 'Index out of bounds' |
| ~QMCKL_INVALID_EXIT_CODE~ | 108 | 'Invalid exit code' |
| ~QMCKL_ALREADY_SET~ | 108 | 'Already set' |
| ~QMCKL_INVALID_EXIT_CODE~ | 109 | 'Invalid exit code' |
# We need to force Emacs not to indent the Python code:
# -*- org-src-preserve-indentation: t
@ -164,7 +165,8 @@ return '\n'.join(result)
#define QMCKL_DEALLOCATION_FAILED ((qmckl_exit_code) 105)
#define QMCKL_NOT_PROVIDED ((qmckl_exit_code) 106)
#define QMCKL_OUT_OF_BOUNDS ((qmckl_exit_code) 107)
#define QMCKL_INVALID_EXIT_CODE ((qmckl_exit_code) 108)
#define QMCKL_ALREADY_SET ((qmckl_exit_code) 108)
#define QMCKL_INVALID_EXIT_CODE ((qmckl_exit_code) 109)
#+end_src
#+begin_src f90 :comments org :tangle (eval fh_type) :exports none
@ -196,7 +198,8 @@ return '\n'.join(result)
integer(qmckl_exit_code), parameter :: QMCKL_DEALLOCATION_FAILED = 105
integer(qmckl_exit_code), parameter :: QMCKL_NOT_PROVIDED = 106
integer(qmckl_exit_code), parameter :: QMCKL_OUT_OF_BOUNDS = 107
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_EXIT_CODE = 108
integer(qmckl_exit_code), parameter :: QMCKL_ALREADY_SET = 108
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_EXIT_CODE = 109
#+end_src
:end:
@ -330,6 +333,9 @@ return '\n'.join(result)
case QMCKL_OUT_OF_BOUNDS:
return "Index out of bounds";
case QMCKL_ALREADY_SET:
return "Already set";
case QMCKL_INVALID_EXIT_CODE:
return "Invalid exit code";
#+end_example

7
org/qmckl_trexio.org
View File

@ -428,13 +428,6 @@ qmckl_trexio_read_ao_X(qmckl_context context, trexio_t* const file)
}
/* Reformat data */
rc = qmckl_set_ao_basis_nucleus_index(context, nucleus_index, nucleus_num);
if (rc != QMCKL_SUCCESS) {
qmckl_free(context, nucleus_index);
nucleus_index = NULL;
return rc;
}
for (int i=shell_num-1 ; i>=0 ; --i) {
const int k = tmp_array[i];
if (k < 0 || k >= nucleus_num) {