TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-01-03 10:06:09 +01:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into fix-memory-leaks

Browse Source
This commit is contained in:
q-posev 2022-07-11 09:47:24 +02:00
commit b8f0142597
5 changed files with 328 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
org/qmckl_ao.org
View File

@ -367,7 +367,7 @@ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
if (!(ctx->ao_basis.uninitialized & mask)) { if (mask != 0 && !(ctx->ao_basis.uninitialized & mask)) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_ALREADY_SET, QMCKL_ALREADY_SET,
"qmckl_set_ao_*", "qmckl_set_ao_*",
@ -3141,7 +3141,7 @@ qmckl_get_ao_basis_ao_value (qmckl_context context,
qmckl_exit_code rc; qmckl_exit_code rc;
rc = qmckl_provide_ao_value(context); rc = qmckl_provide_ao_basis_ao_value(context);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
@ -3217,7 +3217,7 @@ qmckl_get_ao_basis_ao_value_inplace (qmckl_context context,
ctx->ao_basis.ao_value = ao_value; ctx->ao_basis.ao_value = ao_value;
rc = qmckl_provide_ao_value(context); rc = qmckl_provide_ao_basis_ao_value(context);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
ctx->ao_basis.ao_value = old_array; ctx->ao_basis.ao_value = old_array;
@ -3625,18 +3625,26 @@ end function qmckl_compute_ao_basis_primitive_gaussian_vgl_f
*** Provide :noexport: *** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none #+CALL: write_provider_header( group="ao_basis", data="primitive_vgl" )
qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+RESULTS:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context);
#+end_src
#+CALL: write_provider_pre( group="ao_basis", data="primitive_vgl", dimension="ctx->ao_basis.prim_num * 5 * ctx->point.num")
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context) qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
{ {
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT, QMCKL_INVALID_CONTEXT,
"qmckl_provide_get_ao_basis_primitive_vgl", "qmckl_provide_ao_basis_primitive_vgl",
NULL); NULL);
} }
@ -3646,19 +3654,26 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
if (!ctx->ao_basis.provided) { if (!ctx->ao_basis.provided) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_NOT_PROVIDED, QMCKL_NOT_PROVIDED,
"qmckl_ao_basis_primitive_vgl", "qmckl_provide_ao_basis_primitive_vgl",
NULL); NULL);
} }
/* Compute if necessary */ /* Compute if necessary */
if (ctx->point.date > ctx->ao_basis.primitive_vgl_date) { if (ctx->point.date > ctx->ao_basis.primitive_vgl_date) {
if (ctx->point.alloc_date > ctx->ao_basis.primitive_vgl_date) {
if (ctx->ao_basis.primitive_vgl != NULL) {
rc = qmckl_free(context, ctx->ao_basis.primitive_vgl);
assert (rc == QMCKL_SUCCESS);
ctx->ao_basis.primitive_vgl = NULL;
}
}
/* Allocate array */ /* Allocate array */
if (ctx->ao_basis.primitive_vgl == NULL) { if (ctx->ao_basis.primitive_vgl == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->point.num * mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->point.num * sizeof(double);
sizeof(double);
double* primitive_vgl = (double*) qmckl_malloc(context, mem_info); double* primitive_vgl = (double*) qmckl_malloc(context, mem_info);
if (primitive_vgl == NULL) { if (primitive_vgl == NULL) {
@ -3670,7 +3685,9 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
ctx->ao_basis.primitive_vgl = primitive_vgl; ctx->ao_basis.primitive_vgl = primitive_vgl;
} }
qmckl_exit_code rc; #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
if (ctx->ao_basis.type == 'G') { if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_ao_basis_primitive_gaussian_vgl(context, rc = qmckl_compute_ao_basis_primitive_gaussian_vgl(context,
ctx->ao_basis.prim_num, ctx->ao_basis.prim_num,
@ -3687,16 +3704,22 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
"compute_ao_basis_primitive_vgl", "compute_ao_basis_primitive_vgl",
"Not yet implemented"); "Not yet implemented");
} }
#+end_src
#+CALL: write_provider_post( group="ao_basis", data="shell_vgl" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
} }
ctx->ao_basis.primitive_vgl_date = ctx->date; ctx->ao_basis.shell_vgl_date = ctx->date;
} }
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+end_src #+end_src
*** Test :noexport: *** Test :noexport:
@ -4031,14 +4054,22 @@ end function qmckl_compute_ao_basis_shell_gaussian_vgl_f
*** Provide :noexport: *** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none #+CALL: write_provider_header( group="ao_basis", data="shell_vgl" )
qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+RESULTS:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context);
#+end_src
#+CALL: write_provider_pre( group="ao_basis", data="shell_vgl", dimension="ctx->ao_basis.shell_num * 5 * ctx->point.num")
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
{ {
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT, QMCKL_INVALID_CONTEXT,
@ -4059,6 +4090,14 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
/* Compute if necessary */ /* Compute if necessary */
if (ctx->point.date > ctx->ao_basis.shell_vgl_date) { if (ctx->point.date > ctx->ao_basis.shell_vgl_date) {
if (ctx->point.alloc_date > ctx->ao_basis.shell_vgl_date) {
if (ctx->ao_basis.shell_vgl != NULL) {
rc = qmckl_free(context, ctx->ao_basis.shell_vgl);
assert (rc == QMCKL_SUCCESS);
ctx->ao_basis.shell_vgl = NULL;
}
}
/* Allocate array */ /* Allocate array */
if (ctx->ao_basis.shell_vgl == NULL) { if (ctx->ao_basis.shell_vgl == NULL) {
@ -4075,7 +4114,9 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
ctx->ao_basis.shell_vgl = shell_vgl; ctx->ao_basis.shell_vgl = shell_vgl;
} }
qmckl_exit_code rc; #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
if (ctx->ao_basis.type == 'G') { if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_ao_basis_shell_gaussian_vgl(context, rc = qmckl_compute_ao_basis_shell_gaussian_vgl(context,
ctx->ao_basis.prim_num, ctx->ao_basis.prim_num,
@ -4098,6 +4139,11 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
"compute_ao_basis_shell_vgl", "compute_ao_basis_shell_vgl",
"Not yet implemented"); "Not yet implemented");
} }
#+end_src
#+CALL: write_provider_post( group="ao_basis", data="shell_vgl" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return rc; return rc;
} }
@ -4107,7 +4153,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+end_src #+end_src
*** Test :noexport: *** Test :noexport:
@ -5920,18 +5966,26 @@ qmckl_compute_ao_value_hpc_gaussian (const qmckl_context context,
**** Provide :noexport: **** Provide :noexport:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none #+CALL: write_provider_header( group="ao_basis", data="ao_value" )
qmckl_exit_code qmckl_provide_ao_value(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+RESULTS:
qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_ao_value(qmckl_context context);
#+end_src
#+CALL: write_provider_pre( group="ao_basis", data="ao_value", dimension="ctx->ao_basis.ao_num * ctx->point.num")
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_ao_value(qmckl_context context)
{ {
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT, QMCKL_INVALID_CONTEXT,
"qmckl_provide_ao_value", "qmckl_provide_ao_basis_ao_value",
NULL); NULL);
} }
@ -5941,28 +5995,26 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context)
if (!ctx->ao_basis.provided) { if (!ctx->ao_basis.provided) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_NOT_PROVIDED, QMCKL_NOT_PROVIDED,
"qmckl_ao_value", "qmckl_provide_ao_basis_ao_value",
NULL); NULL);
} }
/* Compute if necessary */ /* Compute if necessary */
if (ctx->point.date > ctx->ao_basis.ao_value_date) { if (ctx->point.date > ctx->ao_basis.ao_value_date) {
qmckl_exit_code rc; if (ctx->point.alloc_date > ctx->ao_basis.ao_value_date) {
if (ctx->ao_basis.ao_value != NULL) {
/* Provide required data */ rc = qmckl_free(context, ctx->ao_basis.ao_value);
#ifndef HAVE_HPC assert (rc == QMCKL_SUCCESS);
rc = qmckl_provide_ao_basis_shell_vgl(context); ctx->ao_basis.ao_value = NULL;
if (rc != QMCKL_SUCCESS) { }
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
} }
#endif
/* Allocate array */ /* Allocate array */
if (ctx->ao_basis.ao_value == NULL) { if (ctx->ao_basis.ao_value == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.ao_num * 5 * ctx->point.num * sizeof(double); mem_info.size = ctx->ao_basis.ao_num * ctx->point.num * sizeof(double);
double* ao_value = (double*) qmckl_malloc(context, mem_info); double* ao_value = (double*) qmckl_malloc(context, mem_info);
if (ao_value == NULL) { if (ao_value == NULL) {
@ -5974,6 +6026,9 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context)
ctx->ao_basis.ao_value = ao_value; ctx->ao_basis.ao_value = ao_value;
} }
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
if (ctx->ao_basis.ao_vgl_date == ctx->point.date) { if (ctx->ao_basis.ao_vgl_date == ctx->point.date) {
// ao_vgl has been computed at this step: Just copy the data. // ao_vgl has been computed at this step: Just copy the data.
@ -6032,6 +6087,12 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context)
ctx->ao_basis.ao_value); ctx->ao_basis.ao_value);
,*/ ,*/
} else { } else {
/* Provide required data */
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
}
rc = qmckl_compute_ao_value_doc(context, rc = qmckl_compute_ao_value_doc(context,
ctx->ao_basis.ao_num, ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num, ctx->ao_basis.shell_num,
@ -6049,6 +6110,12 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context)
ctx->ao_basis.ao_value); ctx->ao_basis.ao_value);
} }
#else #else
/* Provide required data */
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
}
rc = qmckl_compute_ao_value_doc(context, rc = qmckl_compute_ao_value_doc(context,
ctx->ao_basis.ao_num, ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num, ctx->ao_basis.shell_num,
@ -6065,10 +6132,15 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context)
ctx->ao_basis.shell_vgl, ctx->ao_basis.shell_vgl,
ctx->ao_basis.ao_value); ctx->ao_basis.ao_value);
#endif #endif
if (rc != QMCKL_SUCCESS) { }
return rc; #+end_src
}
#+CALL: write_provider_post( group="ao_basis", data="ao_value" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
if (rc != QMCKL_SUCCESS) {
return rc;
} }
ctx->ao_basis.ao_value_date = ctx->date; ctx->ao_basis.ao_value_date = ctx->date;
@ -6076,7 +6148,7 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context)
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+end_src #+end_src
**** Test :noexport: **** Test :noexport:

34
org/qmckl_jastrow.org
View File

@ -407,7 +407,7 @@ qmckl_exit_code qmckl_init_jastrow(qmckl_context context) {
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); assert (ctx != NULL);
ctx->jastrow.uninitialized = (1 << 5) - 1; ctx->jastrow.uninitialized = (1 << 6) - 1;
/* Default values */ /* Default values */
@ -746,6 +746,14 @@ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
} }
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
if (mask != 0 && !(ctx->jastrow.uninitialized & mask)) {
printf("%d %d\n", mask, ctx->jastrow.uninitialized );
return qmckl_failwith( context,
QMCKL_ALREADY_SET,
"qmckl_set_jastrow_*",
NULL);
}
#+end_src #+end_src
#+NAME:post2 #+NAME:post2
@ -768,6 +776,9 @@ qmckl_set_jastrow_ord_num(qmckl_context context,
const int64_t bord_num, const int64_t bord_num,
const int64_t cord_num) const int64_t cord_num)
{ {
int32_t mask = 1 << 0;
<<pre2>> <<pre2>>
if (aord_num <= 0) { if (aord_num <= 0) {
@ -791,7 +802,6 @@ qmckl_set_jastrow_ord_num(qmckl_context context,
"cord_num <= 0"); "cord_num <= 0");
} }
int32_t mask = 1 << 0;
ctx->jastrow.aord_num = aord_num; ctx->jastrow.aord_num = aord_num;
ctx->jastrow.bord_num = bord_num; ctx->jastrow.bord_num = bord_num;
ctx->jastrow.cord_num = cord_num; ctx->jastrow.cord_num = cord_num;
@ -803,6 +813,8 @@ qmckl_set_jastrow_ord_num(qmckl_context context,
qmckl_exit_code qmckl_exit_code
qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num) qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num)
{ {
int32_t mask = 1 << 1;
<<pre2>> <<pre2>>
if (type_nucl_num <= 0) { if (type_nucl_num <= 0) {
@ -812,7 +824,6 @@ qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_n
"type_nucl_num < 0"); "type_nucl_num < 0");
} }
int32_t mask = 1 << 1;
ctx->jastrow.type_nucl_num = type_nucl_num; ctx->jastrow.type_nucl_num = type_nucl_num;
<<post2>> <<post2>>
@ -824,10 +835,11 @@ qmckl_set_jastrow_type_nucl_vector(qmckl_context context,
int64_t const * type_nucl_vector, int64_t const * type_nucl_vector,
const int64_t nucl_num) const int64_t nucl_num)
{ {
<<pre2>>
int32_t mask = 1 << 2; int32_t mask = 1 << 2;
<<pre2>>
int64_t type_nucl_num; int64_t type_nucl_num;
qmckl_exit_code rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num); qmckl_exit_code rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
@ -879,10 +891,10 @@ qmckl_set_jastrow_aord_vector(qmckl_context context,
double const * aord_vector, double const * aord_vector,
const int64_t size_max) const int64_t size_max)
{ {
<<pre2>>
int32_t mask = 1 << 3; int32_t mask = 1 << 3;
<<pre2>>
int64_t aord_num; int64_t aord_num;
qmckl_exit_code rc = qmckl_get_jastrow_aord_num(context, &aord_num); qmckl_exit_code rc = qmckl_get_jastrow_aord_num(context, &aord_num);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
@ -946,10 +958,10 @@ qmckl_set_jastrow_bord_vector(qmckl_context context,
double const * bord_vector, double const * bord_vector,
const int64_t size_max) const int64_t size_max)
{ {
<<pre2>>
int32_t mask = 1 << 4; int32_t mask = 1 << 4;
<<pre2>>
int64_t bord_num; int64_t bord_num;
qmckl_exit_code rc = qmckl_get_jastrow_bord_num(context, &bord_num); qmckl_exit_code rc = qmckl_get_jastrow_bord_num(context, &bord_num);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
@ -1009,10 +1021,10 @@ qmckl_set_jastrow_cord_vector(qmckl_context context,
double const * cord_vector, double const * cord_vector,
const int64_t size_max) const int64_t size_max)
{ {
<<pre2>>
int32_t mask = 1 << 5; int32_t mask = 1 << 5;
<<pre2>>
qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context); qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
@ -1042,7 +1054,7 @@ qmckl_set_jastrow_cord_vector(qmckl_context context,
rc = qmckl_free(context, ctx->jastrow.cord_vector); rc = qmckl_free(context, ctx->jastrow.cord_vector);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, return qmckl_failwith( context, rc,
"qmckl_set_ord_vector", "qmckl_set_cord_vector",
NULL); NULL);
} }
} }

20
org/qmckl_mo.org
View File

@ -305,6 +305,13 @@ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
} }
qmckl_context_struct* const ctx = (qmckl_context_struct*) context; qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
if (mask != 0 && !(ctx->mo_basis.uninitialized & mask)) {
return qmckl_failwith( context,
QMCKL_ALREADY_SET,
"qmckl_set_mo_*",
NULL);
}
#+end_src #+end_src
#+NAME:post #+NAME:post
@ -320,6 +327,9 @@ return QMCKL_SUCCESS;
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_set_mo_basis_mo_num(qmckl_context context, const int64_t mo_num) { qmckl_exit_code qmckl_set_mo_basis_mo_num(qmckl_context context, const int64_t mo_num) {
int32_t mask = 1 ;
<<pre>> <<pre>>
if (mo_num <= 0) { if (mo_num <= 0) {
@ -329,17 +339,17 @@ qmckl_exit_code qmckl_set_mo_basis_mo_num(qmckl_context context, const int64_t m
"mo_num <= 0"); "mo_num <= 0");
} }
int32_t mask = 1 ;
ctx->mo_basis.mo_num = mo_num; ctx->mo_basis.mo_num = mo_num;
<<post>> <<post>>
} }
qmckl_exit_code qmckl_set_mo_basis_coefficient(qmckl_context context, const double* coefficient) { qmckl_exit_code qmckl_set_mo_basis_coefficient(qmckl_context context, const double* coefficient) {
<<pre>>
int32_t mask = 1 << 1; int32_t mask = 1 << 1;
<<pre>>
if (ctx->mo_basis.coefficient != NULL) { if (ctx->mo_basis.coefficient != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->mo_basis.coefficient); qmckl_exit_code rc = qmckl_free(context, ctx->mo_basis.coefficient);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
@ -447,7 +457,7 @@ qmckl_get_mo_basis_mo_value(qmckl_context context,
qmckl_exit_code rc; qmckl_exit_code rc;
rc = qmckl_provide_ao_value(context); rc = qmckl_provide_ao_basis_ao_value(context);
if (rc != QMCKL_SUCCESS) return rc; if (rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_mo_value(context); rc = qmckl_provide_mo_value(context);
@ -575,7 +585,7 @@ qmckl_exit_code qmckl_provide_mo_value(qmckl_context context)
NULL); NULL);
} }
rc = qmckl_provide_ao_value(context); rc = qmckl_provide_ao_basis_ao_value(context);
if (rc != QMCKL_SUCCESS) { if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, return qmckl_failwith( context,
QMCKL_NOT_PROVIDED, QMCKL_NOT_PROVIDED,

22
org/qmckl_point.org
View File

@ -77,11 +77,13 @@ int main() {
The following data stored in the context: The following data stored in the context:
| Variable | Type | Description | | Variable | Type | Description |
|----------+----------------+-------------------------------------------| |--------------+----------------+-------------------------------------------|
| ~num~ | ~int64_t~ | Total number of points | | ~num~ | ~int64_t~ | Total number of points |
| ~date~ | ~uint64_t~ | Last modification date of the coordinates | | ~alloc_num~ | ~int64_t~ | Numer of allocated number of points |
| ~coord~ | ~qmckl_matrix~ | ~num~ \times 3 matrix | | ~date~ | ~uint64_t~ | Last modification date of the coordinates |
| ~alloc_date~ | ~uint64_t~ | Last modification date of the allocation |
| ~coord~ | ~qmckl_matrix~ | ~num~ \times 3 matrix |
We consider that the matrix is stored 'transposed' and 'normal' We consider that the matrix is stored 'transposed' and 'normal'
corresponds to the 3 \times ~num~ matrix. corresponds to the 3 \times ~num~ matrix.
@ -91,7 +93,9 @@ int main() {
#+begin_src c :comments org :tangle (eval h_private_type) #+begin_src c :comments org :tangle (eval h_private_type)
typedef struct qmckl_point_struct { typedef struct qmckl_point_struct {
int64_t num; int64_t num;
int64_t alloc_num;
uint64_t date; uint64_t date;
uint64_t alloc_date;
qmckl_matrix coord; qmckl_matrix coord;
} qmckl_point_struct; } qmckl_point_struct;
@ -308,7 +312,7 @@ qmckl_set_point (qmckl_context context,
assert (ctx != NULL); assert (ctx != NULL);
qmckl_exit_code rc; qmckl_exit_code rc;
if (ctx->point.num != num) { if (num > ctx->point.alloc_num) {
if (ctx->point.coord.data != NULL) { if (ctx->point.coord.data != NULL) {
rc = qmckl_matrix_free(context, &(ctx->point.coord)); rc = qmckl_matrix_free(context, &(ctx->point.coord));
@ -322,7 +326,6 @@ qmckl_set_point (qmckl_context context,
"qmckl_set_point", "qmckl_set_point",
NULL); NULL);
} }
}; };
ctx->point.num = num; ctx->point.num = num;
@ -350,6 +353,11 @@ qmckl_set_point (qmckl_context context,
rc = qmckl_context_touch(context); rc = qmckl_context_touch(context);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
if (num > ctx->point.alloc_num) {
ctx->point.alloc_num = num;
ctx->point.alloc_date = ctx->point.date;
};
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }

171
tools/lib.org
View File

@ -4,10 +4,10 @@
** Defines the name of the current file ** Defines the name of the current file
#+NAME: filename #+NAME: filename
#+begin_src elisp :tangle no #+begin_src elisp :tangle no
(file-name-nondirectory (substring buffer-file-name 0 -4)) (file-name-nondirectory (substring buffer-file-name 0 -4))
#+end_src #+end_src
** Function to get the value of a property. ** Function to get the value of a property.
#+NAME: get_value #+NAME: get_value
#+begin_src elisp :var key="Type" #+begin_src elisp :var key="Type"
@ -15,7 +15,6 @@
(org-entry-get nil key t)) (org-entry-get nil key t))
#+end_src #+end_src
** Table of function arguments ** Table of function arguments
#+NAME: test #+NAME: test
@ -32,7 +31,7 @@
| ~ldb~ | ~int64_t~ | in | Leading dimension of array ~B~ | | ~ldb~ | ~int64_t~ | in | Leading dimension of array ~B~ |
| ~C~ | ~double[n][ldc]~ | out | Array containing the $m \times n$ matrix $C$ | | ~C~ | ~double[n][ldc]~ | out | Array containing the $m \times n$ matrix $C$ |
| ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ | | ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ |
*** Fortran-C type conversions *** Fortran-C type conversions
@ -124,7 +123,7 @@ for d in parse_table(table):
const = "const " const = "const "
else: else:
const = "" const = ""
results += [ f" {const}{c_type} {name}" ] results += [ f" {const}{c_type} {name}" ]
results=',\n'.join(results) results=',\n'.join(results)
@ -146,10 +145,9 @@ return template
const double* B, const double* B,
const int64_t ldb, const int64_t ldb,
double* const C, double* const C,
const int64_t ldc ); const int64_t ldc );
#+end_src #+end_src
*** Generates a C interface to the Fortran function *** Generates a C interface to the Fortran function
#+NAME: generate_c_interface #+NAME: generate_c_interface
@ -258,4 +256,161 @@ return results
#+END_SRC #+END_SRC
** Creating provide functions
#+NAME: write_provider_header
#+BEGIN_SRC python :var group="GROUP" :var data="DATA" :results drawer :noweb yes :wrap "src c :comments org :tangle (eval h_private_func) :noweb yes :export none"
template = "qmckl_exit_code qmckl_provide_{{ group }}_{{ data }}(qmckl_context context);"
msg = template.replace("{{ group }}", group) \
.replace("{{ data }}", data)
return msg
#+END_SRC
#+RESULTS: write_provider_header
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
qmckl_exit_code qmckl_provide_GROUP_DATA(qmckl_context context);
#+end_src
#+NAME: write_provider_pre
#+BEGIN_SRC python :var group="GROUP" :var data="DATA" :var dimension="DIMENSION" :results drawer :noweb yes :wrap "src c :comments org :tangle (eval c) :noweb yes :export none"
template = """qmckl_exit_code qmckl_provide_{{ group }}_{{ data }}(qmckl_context context)
{
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_{{ group }}_{{ data }}",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!ctx->{{ group }}.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_{{ group }}_{{ data }}",
NULL);
}
/* Compute if necessary */
if (ctx->point.date > ctx->{{ group }}.{{ data }}_date) {
if (ctx->point.alloc_date > ctx->{{ group }}.{{ data }}_date) {
if (ctx->{{ group }}.{{ data }} != NULL) {
rc = qmckl_free(context, ctx->{{ group }}.{{ data }});
assert (rc == QMCKL_SUCCESS);
ctx->{{ group }}.{{ data }} = NULL;
}
}
/* Allocate array */
if (ctx->{{ group }}.{{ data }} == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = {{ dimension }} * sizeof(double);
double* {{ data }} = (double*) qmckl_malloc(context, mem_info);
if ({{ data }} == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_{{ group }}_{{ data }}",
NULL);
}
ctx->{{ group }}.{{ data }} = {{ data }};
}
"""
msg = template.replace("{{ group }}", group) \
.replace("{{ data }}", data) \
.replace("{{ dimension }}", dimension)
return msg
#+END_SRC
#+RESULTS: write_provider_pre
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
qmckl_exit_code qmckl_provide_GROUP_DATA(qmckl_context context)
{
qmckl_exit_code rc;
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_GROUP_DATA",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!ctx->GROUP.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_GROUP_DATA",
NULL);
}
/* Compute if necessary */
if (ctx->point.date > ctx->GROUP.DATA_date) {
if (ctx->point.alloc_date > ctx->GROUP.DATA_date) {
rc = qmckl_free(context, ctx->GROUP.DATA);
assert (rc == QMCKL_SUCCESS);
ctx->GROUP.DATA = NULL;
}
/* Allocate array */
if (ctx->GROUP.DATA == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = DIMENSION * sizeof(double);
double* DATA = (double*) qmckl_malloc(context, mem_info);
if (DATA == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_GROUP_DATA",
NULL);
}
ctx->GROUP.DATA = DATA;
}
#+end_src
#+NAME: write_provider_post
#+BEGIN_SRC python :var group="BASIS" :var data="DATA" :results drawer :noweb yes :wrap "src c :comments org :tangle (eval c) :noweb yes :export none"
template = """ if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->{{ group }}.{{ data }}_date = ctx->date;
}
return QMCKL_SUCCESS;
}
"""
msg = template.replace("{{ group }}", group) \
.replace("{{ data }}", data)
return msg
#+END_SRC
#+RESULTS: write_provider_post
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->BASIS.DATA_date = ctx->date;
}
return QMCKL_SUCCESS;
}
#+end_src