From e08456bd61275735386382f8ad79eb74d45e324c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 9 Jul 2022 13:11:20 +0200 Subject: [PATCH] Introduced write_provider org functions --- org/qmckl_ao.org | 150 ++++++++++++++++++++++++++++---------- org/qmckl_mo.org | 4 +- org/qmckl_point.org | 22 ++++-- tools/lib.org | 171 +++++++++++++++++++++++++++++++++++++++++--- 4 files changed, 291 insertions(+), 56 deletions(-) diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index e61dfa4..f28ea8b 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -3140,7 +3140,7 @@ qmckl_get_ao_basis_ao_value (qmckl_context context, qmckl_exit_code rc; - rc = qmckl_provide_ao_value(context); + rc = qmckl_provide_ao_basis_ao_value(context); if (rc != QMCKL_SUCCESS) return rc; qmckl_context_struct* const ctx = (qmckl_context_struct*) context; @@ -3216,7 +3216,7 @@ qmckl_get_ao_basis_ao_value_inplace (qmckl_context context, 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; ctx->ao_basis.ao_value = old_array; @@ -3624,18 +3624,26 @@ end function qmckl_compute_ao_basis_primitive_gaussian_vgl_f *** Provide :noexport: - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context); - #+end_src +#+CALL: write_provider_header( group="ao_basis", data="primitive_vgl" ) - #+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 rc; + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return qmckl_failwith( context, QMCKL_INVALID_CONTEXT, - "qmckl_provide_get_ao_basis_primitive_vgl", + "qmckl_provide_ao_basis_primitive_vgl", NULL); } @@ -3645,19 +3653,26 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context) if (!ctx->ao_basis.provided) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, - "qmckl_ao_basis_primitive_vgl", + "qmckl_provide_ao_basis_primitive_vgl", NULL); } /* Compute if necessary */ 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 */ if (ctx->ao_basis.primitive_vgl == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->point.num * - sizeof(double); + mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->point.num * sizeof(double); double* primitive_vgl = (double*) qmckl_malloc(context, mem_info); if (primitive_vgl == NULL) { @@ -3669,7 +3684,9 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context) 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') { rc = qmckl_compute_ao_basis_primitive_gaussian_vgl(context, ctx->ao_basis.prim_num, @@ -3686,16 +3703,22 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context) "compute_ao_basis_primitive_vgl", "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) { return rc; } - ctx->ao_basis.primitive_vgl_date = ctx->date; + ctx->ao_basis.shell_vgl_date = ctx->date; } return QMCKL_SUCCESS; } - #+end_src +#+end_src *** Test :noexport: @@ -4030,14 +4053,22 @@ end function qmckl_compute_ao_basis_shell_gaussian_vgl_f *** Provide :noexport: - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context); - #+end_src +#+CALL: write_provider_header( group="ao_basis", data="shell_vgl" ) - #+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 rc; + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return qmckl_failwith( context, QMCKL_INVALID_CONTEXT, @@ -4058,6 +4089,14 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) /* Compute if necessary */ 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 */ if (ctx->ao_basis.shell_vgl == NULL) { @@ -4074,7 +4113,9 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) 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') { rc = qmckl_compute_ao_basis_shell_gaussian_vgl(context, ctx->ao_basis.prim_num, @@ -4097,6 +4138,11 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) "compute_ao_basis_shell_vgl", "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) { return rc; } @@ -4106,7 +4152,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context) return QMCKL_SUCCESS; } - #+end_src +#+end_src *** Test :noexport: @@ -5919,18 +5965,26 @@ qmckl_compute_ao_value_hpc_gaussian (const qmckl_context context, **** Provide :noexport: - #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none -qmckl_exit_code qmckl_provide_ao_value(qmckl_context context); - #+end_src +#+CALL: write_provider_header( group="ao_basis", data="ao_value" ) - #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none -qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) +#+RESULTS: +#+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) { return qmckl_failwith( context, QMCKL_INVALID_CONTEXT, - "qmckl_provide_ao_value", + "qmckl_provide_ao_basis_ao_value", NULL); } @@ -5940,28 +5994,26 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) if (!ctx->ao_basis.provided) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, - "qmckl_ao_value", + "qmckl_provide_ao_basis_ao_value", NULL); } /* Compute if necessary */ if (ctx->point.date > ctx->ao_basis.ao_value_date) { - qmckl_exit_code rc; - - /* Provide required data */ -#ifndef HAVE_HPC - rc = qmckl_provide_ao_basis_shell_vgl(context); - if (rc != QMCKL_SUCCESS) { - return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL); + if (ctx->point.alloc_date > ctx->ao_basis.ao_value_date) { + if (ctx->ao_basis.ao_value != NULL) { + rc = qmckl_free(context, ctx->ao_basis.ao_value); + assert (rc == QMCKL_SUCCESS); + ctx->ao_basis.ao_value = NULL; + } } -#endif /* Allocate array */ if (ctx->ao_basis.ao_value == NULL) { 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); if (ao_value == NULL) { @@ -5973,6 +6025,9 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) 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) { // ao_vgl has been computed at this step: Just copy the data. @@ -6031,6 +6086,12 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) ctx->ao_basis.ao_value); ,*/ } 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, ctx->ao_basis.ao_num, ctx->ao_basis.shell_num, @@ -6048,6 +6109,12 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) ctx->ao_basis.ao_value); } #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, ctx->ao_basis.ao_num, ctx->ao_basis.shell_num, @@ -6064,10 +6131,15 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) ctx->ao_basis.shell_vgl, ctx->ao_basis.ao_value); #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; @@ -6075,7 +6147,7 @@ qmckl_exit_code qmckl_provide_ao_value(qmckl_context context) return QMCKL_SUCCESS; } - #+end_src +#+end_src **** Test :noexport: diff --git a/org/qmckl_mo.org b/org/qmckl_mo.org index f9ae16e..6d23bf0 100644 --- a/org/qmckl_mo.org +++ b/org/qmckl_mo.org @@ -457,7 +457,7 @@ qmckl_get_mo_basis_mo_value(qmckl_context context, qmckl_exit_code rc; - rc = qmckl_provide_ao_value(context); + rc = qmckl_provide_ao_basis_ao_value(context); if (rc != QMCKL_SUCCESS) return rc; rc = qmckl_provide_mo_value(context); @@ -585,7 +585,7 @@ qmckl_exit_code qmckl_provide_mo_value(qmckl_context context) NULL); } - rc = qmckl_provide_ao_value(context); + rc = qmckl_provide_ao_basis_ao_value(context); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, diff --git a/org/qmckl_point.org b/org/qmckl_point.org index 20fabbf..6344975 100644 --- a/org/qmckl_point.org +++ b/org/qmckl_point.org @@ -77,11 +77,13 @@ int main() { The following data stored in the context: - | Variable | Type | Description | - |----------+----------------+-------------------------------------------| - | ~num~ | ~int64_t~ | Total number of points | - | ~date~ | ~uint64_t~ | Last modification date of the coordinates | - | ~coord~ | ~qmckl_matrix~ | ~num~ \times 3 matrix | + | Variable | Type | Description | + |--------------+----------------+-------------------------------------------| + | ~num~ | ~int64_t~ | Total number of points | + | ~alloc_num~ | ~int64_t~ | Numer of allocated number of points | + | ~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' corresponds to the 3 \times ~num~ matrix. @@ -91,7 +93,9 @@ int main() { #+begin_src c :comments org :tangle (eval h_private_type) typedef struct qmckl_point_struct { int64_t num; + int64_t alloc_num; uint64_t date; + uint64_t alloc_date; qmckl_matrix coord; } qmckl_point_struct; @@ -308,7 +312,7 @@ qmckl_set_point (qmckl_context context, assert (ctx != NULL); qmckl_exit_code rc; - if (ctx->point.num != num) { + if (num > ctx->point.alloc_num) { if (ctx->point.coord.data != NULL) { rc = qmckl_matrix_free(context, &(ctx->point.coord)); @@ -322,7 +326,6 @@ qmckl_set_point (qmckl_context context, "qmckl_set_point", NULL); } - }; ctx->point.num = num; @@ -350,6 +353,11 @@ qmckl_set_point (qmckl_context context, rc = qmckl_context_touch(context); 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; } diff --git a/tools/lib.org b/tools/lib.org index fd198a9..5e3d78d 100644 --- a/tools/lib.org +++ b/tools/lib.org @@ -4,10 +4,10 @@ ** Defines the name of the current file #+NAME: filename - #+begin_src elisp :tangle no + #+begin_src elisp :tangle no (file-name-nondirectory (substring buffer-file-name 0 -4)) #+end_src - + ** Function to get the value of a property. #+NAME: get_value #+begin_src elisp :var key="Type" @@ -15,7 +15,6 @@ (org-entry-get nil key t)) #+end_src - ** Table of function arguments #+NAME: test @@ -32,7 +31,7 @@ | ~ldb~ | ~int64_t~ | in | Leading dimension of array ~B~ | | ~C~ | ~double[n][ldc]~ | out | Array containing the $m \times n$ matrix $C$ | | ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ | - + *** Fortran-C type conversions @@ -124,7 +123,7 @@ for d in parse_table(table): const = "const " else: const = "" - + results += [ f" {const}{c_type} {name}" ] results=',\n'.join(results) @@ -146,10 +145,9 @@ return template const double* B, const int64_t ldb, double* const C, - const int64_t ldc ); + const int64_t ldc ); #+end_src - *** Generates a C interface to the Fortran function #+NAME: generate_c_interface @@ -258,4 +256,161 @@ return results #+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