diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index 2e262b7..5fa94d5 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -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; + <> 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; <> @@ -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; + <> 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; <> @@ -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; + <> 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; <> @@ -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) -{ - <> - - 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; - - <> -} - #+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; - - 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; - - <> -} - #+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) { - <> - int32_t mask = 1 << 3; + <> + 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; + + <> + + 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; + + <> +} + #+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) { - <> - int32_t mask = 1 << 5; + <> + 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) { - <> - int32_t mask = 1 << 6; + <> + 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) { - <> - int32_t mask = 1 << 7; + <> + 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) { - <> - int32_t mask = 1 << 8; + <> + 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) { - <> - int32_t mask = 1 << 9; + <> + 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) { - <> - int32_t mask = 1 << 10; + <> + 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) { - <> - int32_t mask = 1 << 11; + <> + 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; + + <> + + 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; + + <> +} + #+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) { - <> - int32_t mask = 1 << 13; + <> + 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; + <> - int32_t mask = 1; ctx->ao_basis.ao_cartesian = cartesian; <> @@ -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)); diff --git a/org/qmckl_error.org b/org/qmckl_error.org index d23fa8e..25721d1 100644 --- a/org/qmckl_error.org +++ b/org/qmckl_error.org @@ -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 diff --git a/org/qmckl_trexio.org b/org/qmckl_trexio.org index 4194215..c664f3a 100644 --- a/org/qmckl_trexio.org +++ b/org/qmckl_trexio.org @@ -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) {