From 6dfa8692b3527488c509a4d970f840b711ec6dcf Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 25 Nov 2020 18:39:31 +0100 Subject: [PATCH 01/65] Update CSS --- src/README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/README.org b/src/README.org index abe0663..c0206ee 100644 --- a/src/README.org +++ b/src/README.org @@ -1,7 +1,7 @@ #+TITLE: QMCkl source code documentation #+EXPORT_FILE_NAME: index.html -#+SETUPFILE: https://fniessen.github.io/org-html-themes/setup/theme-readtheorg.setup +#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup * Introduction From d2bab284acc89fab9bf1341ed58a1552534663a5 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 3 Dec 2020 18:57:15 +0100 Subject: [PATCH 02/65] Tilde --- src/README.org | 2 +- src/qmckl_ao.org | 118 ++++++++++++++++++++--------------------- src/qmckl_context.org | 92 ++++++++++++++++---------------- src/qmckl_distance.org | 48 ++++++++--------- src/qmckl_memory.org | 4 +- 5 files changed, 132 insertions(+), 132 deletions(-) diff --git a/src/README.org b/src/README.org index c0206ee..1fea984 100644 --- a/src/README.org +++ b/src/README.org @@ -1,7 +1,7 @@ #+TITLE: QMCkl source code documentation #+EXPORT_FILE_NAME: index.html -#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup +#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/setup/theme-readtheorg.setup * Introduction diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index f9095ab..0ff0878 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -41,30 +41,30 @@ MunitResult test_qmckl_ao() { && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \end{eqnarray*} -**** =qmckl_ao_power= +**** ~qmckl_ao_power~ - Computes all the powers of the =n= input data up to the given + Computes all the powers of the ~n~ input data up to the given maximum value given in input for each of the $n$ points: \[ P_{ij} = X_j^i \] ***** Arguments - | =context= | input | Global state | - | =n= | input | Number of values | - | =X(n)= | input | Array containing the input values | - | =LMAX(n)= | input | Array containing the maximum power for each value | - | =P(LDP,n)= | output | Array containing all the powers of =X= | - | =LDP= | input | Leading dimension of array =P= | + | ~context~ | input | Global state | + | ~n~ | input | Number of values | + | ~X(n)~ | input | Array containing the input values | + | ~LMAX(n)~ | input | Array containing the maximum power for each value | + | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | + | ~LDP~ | input | Leading dimension of array ~P~ | ***** Requirements - - =context= is not 0 - - =n= > 0 - - =X= is allocated with at least $n \times 8$ bytes - - =LMAX= is allocated with at least $n \times 4$ bytes - - =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - - =LDP= >= $\max_i$ =LMAX[i]= + - ~context~ is not 0 + - ~n~ > 0 + - ~X~ is allocated with at least $n \times 8$ bytes + - ~LMAX~ is allocated with at least $n \times 4$ bytes + - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - ~LDP~ >= $\max_i$ ~LMAX[i]~ ***** Header #+BEGIN_SRC C :tangle qmckl.h @@ -193,48 +193,48 @@ munit_assert_int(0, ==, test_qmckl_ao_power(context)); #+END_SRC -**** =qmckl_ao_polynomial_vgl= +**** ~qmckl_ao_polynomial_vgl~ Computes the values, gradients and Laplacians at a given point of - all polynomials with an angular momentum up to =lmax=. + all polynomials with an angular momentum up to ~lmax~. ***** Arguments - | =context= | input | Global state | - | =X(3)= | input | Array containing the coordinates of the points | - | =R(3)= | input | Array containing the x,y,z coordinates of the center | - | =lmax= | input | Maximum angular momentum | - | =n= | output | Number of computed polynomials | - | =L(ldl,n)= | output | Contains a,b,c for all =n= results | - | =ldl= | input | Leading dimension of =L= | - | =VGL(ldv,n)= | output | Value, gradients and Laplacian of the polynomials | - | =ldv= | input | Leading dimension of array =VGL= | + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~lmax~ | input | Maximum angular momentum | + | ~n~ | output | Number of computed polynomials | + | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | + | ~ldl~ | input | Leading dimension of ~L~ | + | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | + | ~ldv~ | input | Leading dimension of array ~VGL~ | ***** Requirements - - =context= is not 0 - - =n= > 0 - - =lmax= >= 0 - - =ldl= >= 3 - - =ldv= >= 5 - - =X= is allocated with at least $3 \times 8$ bytes - - =R= is allocated with at least $3 \times 8$ bytes - - =n= >= =(lmax+1)(lmax+2)(lmax+3)/6= - - =L= is allocated with at least $3 \times n \times 4$ bytes - - =VGL= is allocated with at least $5 \times n \times 8$ bytes - - On output, =n= should be equal to =(lmax+1)(lmax+2)(lmax+3)/6= + - ~context~ is not 0 + - ~n~ > 0 + - ~lmax~ >= 0 + - ~ldl~ >= 3 + - ~ldv~ >= 5 + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ + - ~L~ is allocated with at least $3 \times n \times 4$ bytes + - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes + - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ - On output, the powers are given in the following order (l=a+b+c): - - Increase values of =l= - - Within a given value of =l=, alphabetical order of the + - Increase values of ~l~ + - Within a given value of ~l~, alphabetical order of the string made by a*"x" + b*"y" + c*"z" (in Python notation). For example, with a=0, b=2 and c=1 the string is "yyz" ***** Error codes | -1 | Null context | - | -2 | Inconsistent =ldl= | - | -3 | Inconsistent =ldv= | - | -4 | Inconsistent =lmax= | + | -2 | Inconsistent ~ldl~ | + | -3 | Inconsistent ~ldv~ | + | -4 | Inconsistent ~lmax~ | ***** Header #+BEGIN_SRC C :tangle qmckl.h @@ -512,14 +512,13 @@ end function test_qmckl_ao_polynomial_vgl int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); #+END_SRC - #+END_SRC *** Gaussian basis functions -**** =qmckl_ao_gaussian_vgl= +**** ~qmckl_ao_gaussian_vgl~ Computes the values, gradients and Laplacians at a given point of - =n= Gaussian functions centered at the same point: + ~n~ Gaussian functions centered at the same point: \[ v_i = exp(-a_i |X-R|^2) \] \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] @@ -529,24 +528,24 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); ***** Arguments - | =context= | input | Global state | - | =X(3)= | input | Array containing the coordinates of the points | - | =R(3)= | input | Array containing the x,y,z coordinates of the center | - | =n= | input | Number of computed gaussians | - | =A(n)= | input | Exponents of the Gaussians | - | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians | - | =ldv= | input | Leading dimension of array =VGL= | + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~n~ | input | Number of computed gaussians | + | ~A(n)~ | input | Exponents of the Gaussians | + | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | + | ~ldv~ | input | Leading dimension of array ~VGL~ | ***** Requirements - - =context= is not 0 - - =n= > 0 - - =ldv= >= 5 - - =A(i)= > 0 for all =i= - - =X= is allocated with at least $3 \times 8$ bytes - - =R= is allocated with at least $3 \times 8$ bytes - - =A= is allocated with at least $n \times 8$ bytes - - =VGL= is allocated with at least $n \times 5 \times 8$ bytes + - ~context~ is not 0 + - ~n~ > 0 + - ~ldv~ >= 5 + - ~A(i)~ > 0 for all ~i~ + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~A~ is allocated with at least $n \times 8$ bytes + - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes ***** Header #+BEGIN_SRC C :tangle qmckl.h @@ -740,3 +739,4 @@ munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); # -*- mode: org -*- # vim: syntax=c + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 6ca4894..dad24a6 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -24,8 +24,8 @@ MunitResult test_qmckl_context() { is stored in the following data structure, which can't be seen outside of the library. To simplify compatibility with other languages, the pointer to the internal data structure is converted - into a 64-bit signed integer, defined in the =qmckl_context= type. - A value of 0 for the context is equivalent to a =NULL= pointer. + into a 64-bit signed integer, defined in the ~qmckl_context~ type. + A value of 0 for the context is equivalent to a ~NULL~ pointer. # The following code block should be kept to insert comments into # the qmckl.h file @@ -89,10 +89,10 @@ qmckl_context new_context; #+END_SRC -**** =qmckl_context_check= +**** ~qmckl_context_check~ Checks if the domain pointed by the pointer is a valid context. - Returns the input =qmckl_context= if the context is valid, 0 + Returns the input ~qmckl_context~ if the context is valid, 0 otherwise. #+BEGIN_SRC C :comments org :tangle qmckl.h @@ -113,11 +113,11 @@ qmckl_context qmckl_context_check(const qmckl_context context) { } #+END_SRC -**** =qmckl_context_create= +**** ~qmckl_context_create~ - To create a new context, use =qmckl_context_create()=. - - On success, returns a pointer to a context using the =qmckl_context= type - - Returns 0 upon failure to allocate the internal data structure + To create a new context, use ~qmckl_context_create()~. + - On success, returns a pointer to a context using the ~qmckl_context~ type + - Returns ~0~ upon failure to allocate the internal data structure #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_create(); @@ -159,11 +159,11 @@ munit_assert_int64( context, !=, (qmckl_context) 0); munit_assert_int64( qmckl_context_check(context), ==, context); #+END_SRC -**** =qmckl_context_copy= +**** ~qmckl_context_copy~ This function makes a shallow copy of the current context. - Copying the 0-valued context returns 0 - - On success, returns a pointer to the new context using the =qmckl_context= type + - On success, returns a pointer to the new context using the ~qmckl_context~ type - Returns 0 upon failure to allocate the internal data structure for the new context @@ -218,7 +218,7 @@ munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); #+END_SRC -**** =qmckl_context_previous= +**** ~qmckl_context_previous~ Returns the previous context - On success, returns the ancestor of the current context @@ -261,7 +261,7 @@ munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); #+END_SRC -**** =qmckl_context_destroy= +**** ~qmckl_context_destroy~ Destroys the current context, leaving the ancestors untouched. - Succeeds if the current context is properly destroyed @@ -351,20 +351,20 @@ COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0] #+END_EXAMPLE -**** =qmckl_context_update_ao_basis= +**** ~qmckl_context_update_ao_basis~ Updates the data describing the AO basis set into the context. - | =type= | Gaussian or Slater | - | =shell_num= | Number of shells | - | =prim_num= | Total number of primitives | - | =SHELL_CENTER(shell_num)= | Id of the nucleus on which the shell is centered | - | =SHELL_ANG_MOM(shell_num)= | Id of the nucleus on which the shell is centered | - | =SHELL_FACTOR(shell_num)= | Normalization factor for the shell | - | =SHELL_PRIM_NUM(shell_num)= | Number of primitives in the shell | - | =SHELL_PRIM_INDEX(shell_num)= | Address of the first primitive of the shelll in the =EXPONENT= array | - | =EXPONENT(prim_num)= | Array of exponents | - | =COEFFICIENT(prim_num)= | Array of coefficients | + | ~type~ | Gaussian or Slater | + | ~shell_num~ | Number of shells | + | ~prim_num~ | Total number of primitives | + | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | + | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | + | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | + | ~EXPONENT(prim_num)~ | Array of exponents | + | ~COEFFICIENT(prim_num)~ | Array of coefficients | #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code @@ -515,20 +515,20 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type ***** TODO Test -**** =qmckl_context_set_ao_basis= +**** ~qmckl_context_set_ao_basis~ Sets the data describing the AO basis set into the context. - | =type= | Gaussian or Slater | - | =shell_num= | Number of shells | - | =prim_num= | Total number of primitives | - | =SHELL_CENTER(shell_num)= | Id of the nucleus on which the shell is centered | - | =SHELL_ANG_MOM(shell_num)= | Id of the nucleus on which the shell is centered | - | =SHELL_FACTOR(shell_num)= | Normalization factor for the shell | - | =SHELL_PRIM_NUM(shell_num)= | Number of primitives in the shell | - | =SHELL_PRIM_INDEX(shell_num)= | Address of the first primitive of the shelll in the =EXPONENT= array | - | =EXPONENT(prim_num)= | Array of exponents | - | =COEFFICIENT(prim_num)= | Array of coefficients | + | ~type~ | Gaussian or Slater | + | ~shell_num~ | Number of shells | + | ~prim_num~ | Total number of primitives | + | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | + | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | + | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | + | ~EXPONENT(prim_num)~ | Array of exponents | + | ~COEFFICIENT(prim_num)~ | Array of coefficients | #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context @@ -592,15 +592,15 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ *** Precision The following functions set and get the expected required - precision and range. =precision= should be an integer between 2 - and 53, and =range= should be an integer between 2 and 11. + precision and range. ~precision~ should be an integer between 2 + and 53, and ~range~ should be an integer between 2 and 11. The setter functions functions return a new context as a 64-bit integer. The getter functions return the value, as a 32-bit - integer. The update functions return =QMCKL_SUCCESS= or - =QMCKL_FAILURE=. + integer. The update functions return ~QMCKL_SUCCESS~ or + ~QMCKL_FAILURE~. -**** =qmckl_context_update_precision= +**** ~qmckl_context_update_precision~ Modifies the parameter for the numerical precision in a given context. #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); @@ -633,7 +633,7 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons #+END_SRC ***** TODO Tests :noexport: -**** =qmckl_context_update_range= +**** ~qmckl_context_update_range~ Modifies the parameter for the numerical range in a given context. #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); @@ -666,7 +666,7 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in #+END_SRC ***** TODO Tests :noexport: -**** =qmckl_context_set_precision= +**** ~qmckl_context_set_precision~ Returns a copy of the context with a different precision parameter. #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); @@ -696,7 +696,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int #+END_SRC ***** TODO Tests :noexport: -**** =qmckl_context_set_range= +**** ~qmckl_context_set_range~ Returns a copy of the context with a different precision parameter. #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); @@ -727,7 +727,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran ***** TODO Tests :noexport: -**** =qmckl_context_get_precision= +**** ~qmckl_context_get_precision~ Returns the value of the numerical precision in the context #+BEGIN_SRC C :comments org :tangle qmckl.h int32_t qmckl_context_get_precision(const qmckl_context context); @@ -752,7 +752,7 @@ int qmckl_context_get_precision(const qmckl_context context) { #+END_SRC ***** TODO Tests :noexport: -**** =qmckl_context_get_range= +**** ~qmckl_context_get_range~ Returns the value of the numerical range in the context #+BEGIN_SRC C :comments org :tangle qmckl.h int32_t qmckl_context_get_range(const qmckl_context context); @@ -778,8 +778,8 @@ int qmckl_context_get_range(const qmckl_context context) { ***** TODO Tests :noexport: -**** =qmckl_context_get_epsilon= - Returns $\epsilon = 2^{1-n}$ where =n= is the precision +**** ~qmckl_context_get_epsilon~ + Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision #+BEGIN_SRC C :comments org :tangle qmckl.h double qmckl_context_get_epsilon(const qmckl_context context); #+END_SRC diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 5eac91d..57e5531 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -20,7 +20,7 @@ MunitResult test_qmckl_distance() { *** Squared distance -**** =qmckl_distance_sq= +**** ~qmckl_distance_sq~ Computes the matrix of the squared distances between all pairs of points in two sets, one point within each set: @@ -30,35 +30,35 @@ MunitResult test_qmckl_distance() { ***** Arguments - | =context= | input | Global state | - | =transa= | input | Array =A= is =N=: Normal, =T=: Transposed | - | =transb= | input | Array =B= is =N=: Normal, =T=: Transposed | - | =m= | input | Number of points in the first set | - | =n= | input | Number of points in the second set | - | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | - | =lda= | input | Leading dimension of array =A= | - | =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ | - | =ldb= | input | Leading dimension of array =B= | - | =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ | - | =ldc= | input | Leading dimension of array =C= | + | ~context~ | input | Global state | + | ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed | + | ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed | + | ~m~ | input | Number of points in the first set | + | ~n~ | input | Number of points in the second set | + | ~A(lda,3)~ | input | Array containing the $m \times 3$ matrix $A$ | + | ~lda~ | input | Leading dimension of array ~A~ | + | ~B(ldb,3)~ | input | Array containing the $n \times 3$ matrix $B$ | + | ~ldb~ | input | Leading dimension of array ~B~ | + | ~C(ldc,n)~ | output | Array containing the $m \times n$ matrix $C$ | + | ~ldc~ | input | Leading dimension of array ~C~ | ***** Requirements - - =context= is not 0 - - =m= > 0 - - =n= > 0 - - =lda= >= 3 if =transa= is =N= - - =lda= >= m if =transa= is =T= - - =ldb= >= 3 if =transb= is =N= - - =ldb= >= n if =transb= is =T= - - =ldc= >= m if =transa= is = - - =A= is allocated with at least $3 \times m \times 8$ bytes - - =B= is allocated with at least $3 \times n \times 8$ bytes - - =C= is allocated with at least $m \times n \times 8$ bytes + - ~context~ is not 0 + - ~m~ > 0 + - ~n~ > 0 + - ~lda~ >= 3 if ~transa~ is ~N~ + - ~lda~ >= m if ~transa~ is ~T~ + - ~ldb~ >= 3 if ~transb~ is ~N~ + - ~ldb~ >= n if ~transb~ is ~T~ + - ~ldc~ >= m + - ~A~ is allocated with at least $3 \times m \times 8$ bytes + - ~B~ is allocated with at least $3 \times n \times 8$ bytes + - ~C~ is allocated with at least $m \times n \times 8$ bytes ***** Performance - This function might be more efficient when =A= and =B= are + This function might be more efficient when ~A~ and ~B~ are transposed. #+BEGIN_SRC C :comments org :tangle qmckl.h diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 7e3ca79..e74913b 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -18,7 +18,7 @@ MunitResult test_qmckl_memory() { #+END_SRC -*** =qmckl_malloc= +*** ~qmckl_malloc~ Memory allocation function, letting the library choose how the memory will be allocated, and a pointer is returned to the user. @@ -61,7 +61,7 @@ munit_assert_int(a[1], ==, 2); munit_assert_int(a[2], ==, 3); #+END_SRC -*** =qmckl_free= +*** ~qmckl_free~ #+BEGIN_SRC C :tangle qmckl.h void qmckl_free(void *ptr); From 913b50099b681be0d3ca2c410d5917ef46268971 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 3 Dec 2020 18:59:25 +0100 Subject: [PATCH 03/65] HTML --- src/README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/README.org b/src/README.org index 1fea984..c0206ee 100644 --- a/src/README.org +++ b/src/README.org @@ -1,7 +1,7 @@ #+TITLE: QMCkl source code documentation #+EXPORT_FILE_NAME: index.html -#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/setup/theme-readtheorg.setup +#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup * Introduction From 680a0880b4163b53513f6fa29f0f9cfc02e18398 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 24 Dec 2020 17:41:28 +0100 Subject: [PATCH 04/65] Added file names as properties --- src/README.org | 1 + src/qmckl_ao.org | 47 ++++++++++-------- src/qmckl_context.org | 111 ++++++++++++++++++++++-------------------- 3 files changed, 87 insertions(+), 72 deletions(-) diff --git a/src/README.org b/src/README.org index c0206ee..a27768a 100644 --- a/src/README.org +++ b/src/README.org @@ -1,5 +1,6 @@ #+TITLE: QMCkl source code documentation #+EXPORT_FILE_NAME: index.html +#+PROPERTY: comments org #+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 0ff0878..50bcfec 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -1,4 +1,11 @@ ** Atomic Orbitals + :PROPERTIES: + :f: qmckl_ao.f90 + :c_test: test_qmckl_ao.c + :fh: qmckl_f.f90 + :h: qmckl.h + :f_test: test_qmckl_ao_f.f90 + :END: This files contains all the routines for the computation of the @@ -10,7 +17,7 @@ - a Fortran test file : =test_qmckl_ao_f.f90= *** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_ao() { @@ -67,7 +74,7 @@ MunitResult test_qmckl_ao() { - ~LDP~ >= $\max_i$ ~LMAX[i]~ ***** Header - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_ao_power(const qmckl_context context, const int64_t n, const double *X, const int32_t *LMAX, @@ -75,7 +82,7 @@ qmckl_exit_code qmckl_ao_power(const qmckl_context context, #+END_SRC ***** Source - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) implicit none integer*8 , intent(in) :: context @@ -110,7 +117,7 @@ end function qmckl_ao_power_f #+END_SRC ***** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -127,7 +134,7 @@ integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & end function qmckl_ao_power #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C) use, intrinsic :: iso_c_binding @@ -142,7 +149,7 @@ end function qmckl_ao_power #+END_SRC ***** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f_test" t) integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) use qmckl implicit none @@ -187,7 +194,7 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) end function test_qmckl_ao_power #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) int test_qmckl_ao_power(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_power(context)); #+END_SRC @@ -237,7 +244,7 @@ munit_assert_int(0, ==, test_qmckl_ao_power(context)); | -4 | Inconsistent ~lmax~ | ***** Header - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, const double *X, const double *R, const int32_t lmax, const int64_t *n, @@ -246,7 +253,7 @@ qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, #+END_SRC ***** Source - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -376,7 +383,7 @@ end function qmckl_ao_polynomial_vgl_f #+END_SRC ***** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -396,7 +403,7 @@ end function qmckl_ao_polynomial_vgl #+END_SRC ***** Fortran interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) @@ -413,7 +420,7 @@ end function qmckl_ao_polynomial_vgl end interface #+END_SRC ***** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f_test" t) integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl implicit none @@ -508,7 +515,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) end function test_qmckl_ao_polynomial_vgl #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); #+END_SRC @@ -548,7 +555,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes ***** Header - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_ao_gaussian_vgl(const qmckl_context context, const double *X, const double *R, const int64_t *n, const int64_t *A, @@ -556,7 +563,7 @@ qmckl_exit_code qmckl_ao_gaussian_vgl(const qmckl_context context, #+END_SRC ***** Source - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -619,7 +626,7 @@ end function qmckl_ao_gaussian_vgl_f #+END_SRC ***** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -636,7 +643,7 @@ integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) end function qmckl_ao_gaussian_vgl #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) @@ -650,7 +657,7 @@ end function qmckl_ao_gaussian_vgl end interface #+END_SRC ***** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "f_test" t) integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) use qmckl implicit none @@ -717,7 +724,7 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) end function test_qmckl_ao_gaussian_vgl #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) int test_qmckl_ao_gaussian_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); #+END_SRC @@ -728,7 +735,7 @@ munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); *** End of files :noexport: ***** Test - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return MUNIT_OK; diff --git a/src/qmckl_context.org b/src/qmckl_context.org index dad24a6..ee249ff 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,4 +1,11 @@ ** Context + :PROPERTIES: + :c: qmckl_context.c + :c_test: test_qmckl_context.c + :fh: qmckl_f.f90 + :h: qmckl.h + :END: + This file is written in C because it is more natural to express the context in C than in Fortran. @@ -8,11 +15,11 @@ - a test file : =test_qmckl_context.c= *** Headers :noexport: - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) #include "qmckl.h" #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_context() { @@ -30,7 +37,7 @@ MunitResult test_qmckl_context() { # The following code block should be kept to insert comments into # the qmckl.h file - #+BEGIN_SRC C :comments org :tangle qmckl.h :export none + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) :export none #+END_SRC **** Basis set data structure @@ -38,7 +45,7 @@ MunitResult test_qmckl_context() { Data structure for the info related to the atomic orbitals basis set. - #+BEGIN_SRC C :comments org :tangle qmckl_context.c + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "c" t) typedef struct qmckl_ao_basis_struct { int64_t shell_num; @@ -59,7 +66,7 @@ typedef struct qmckl_ao_basis_struct { The tag is used internally to check if the memory domain pointed by a pointer is a valid context. - #+BEGIN_SRC C :comments org :tangle qmckl_context.c + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "c" t) typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; @@ -83,7 +90,7 @@ typedef struct qmckl_context_struct { #+END_SRC **** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) qmckl_context context; qmckl_context new_context; #+END_SRC @@ -95,12 +102,12 @@ qmckl_context new_context; Returns the input ~qmckl_context~ if the context is valid, 0 otherwise. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_check(const qmckl_context context) ; #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_check(const qmckl_context context) { if (context == (qmckl_context) 0) return (qmckl_context) 0; @@ -119,12 +126,12 @@ qmckl_context qmckl_context_check(const qmckl_context context) { - On success, returns a pointer to a context using the ~qmckl_context~ type - Returns ~0~ upon failure to allocate the internal data structure - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_create(); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_create() { qmckl_context_struct* context = @@ -144,7 +151,7 @@ qmckl_context qmckl_context_create() { #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding @@ -153,7 +160,7 @@ qmckl_context qmckl_context_create() { #+END_SRC ***** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) context = qmckl_context_create(); munit_assert_int64( context, !=, (qmckl_context) 0); munit_assert_int64( qmckl_context_check(context), ==, context); @@ -167,12 +174,12 @@ munit_assert_int64( qmckl_context_check(context), ==, context); - Returns 0 upon failure to allocate the internal data structure for the new context - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_copy(const qmckl_context context); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_copy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -201,7 +208,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding @@ -211,7 +218,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { #+END_SRC ***** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) new_context = qmckl_context_copy(context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int64(new_context, !=, context); @@ -225,12 +232,12 @@ munit_assert_int64(qmckl_context_check(new_context), ==, new_context); - Returns 0 for the initial context - Returns 0 for the 0-valued context - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_previous(const qmckl_context context); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -244,7 +251,7 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_previous(context) bind(C) use, intrinsic :: iso_c_binding @@ -254,7 +261,7 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { #+END_SRC ***** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous(new_context), ==, context); munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); @@ -269,12 +276,12 @@ munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context - Fails if the 0-valued context is given in argument - Fails if the the pointer is not a valid context - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_destroy(qmckl_context context); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -290,7 +297,7 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_destroy(context) bind(C) use, intrinsic :: iso_c_binding @@ -300,7 +307,7 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { #+END_SRC ***** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); @@ -366,7 +373,7 @@ COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, | ~EXPONENT(prim_num)~ | Array of exponents | | ~COEFFICIENT(prim_num)~ | Array of coefficients | - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_ao_basis(qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -377,7 +384,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_update_ao_basis(qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -492,7 +499,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_update_ao_basis(context, & typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & @@ -530,7 +537,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type | ~EXPONENT(prim_num)~ | Array of exponents | | ~COEFFICIENT(prim_num)~ | Array of coefficients | - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_ao_basis(const qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -541,7 +548,7 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_set_ao_basis(const qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -566,7 +573,7 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_set_ao_basis(context, & typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & @@ -602,12 +609,12 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ **** ~qmckl_context_update_precision~ Modifies the parameter for the numerical precision in a given context. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { if (precision < 2) return QMCKL_FAILURE; @@ -622,7 +629,7 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -635,12 +642,12 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons ***** TODO Tests :noexport: **** ~qmckl_context_update_range~ Modifies the parameter for the numerical range in a given context. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { if (range < 2) return QMCKL_FAILURE; @@ -655,7 +662,7 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -668,12 +675,12 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in ***** TODO Tests :noexport: **** ~qmckl_context_set_precision~ Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -685,7 +692,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -698,12 +705,12 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int ***** TODO Tests :noexport: **** ~qmckl_context_set_range~ Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -715,7 +722,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -729,12 +736,12 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran **** ~qmckl_context_get_precision~ Returns the value of the numerical precision in the context - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) int32_t qmckl_context_get_precision(const qmckl_context context); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) int qmckl_context_get_precision(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->precision; @@ -742,7 +749,7 @@ int qmckl_context_get_precision(const qmckl_context context) { #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) use, intrinsic :: iso_c_binding @@ -754,12 +761,12 @@ int qmckl_context_get_precision(const qmckl_context context) { ***** TODO Tests :noexport: **** ~qmckl_context_get_range~ Returns the value of the numerical range in the context - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) int32_t qmckl_context_get_range(const qmckl_context context); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) int qmckl_context_get_range(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->range; @@ -767,7 +774,7 @@ int qmckl_context_get_range(const qmckl_context context) { #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_get_range(context) bind(C) use, intrinsic :: iso_c_binding @@ -780,12 +787,12 @@ int qmckl_context_get_range(const qmckl_context context) { **** ~qmckl_context_get_epsilon~ Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) double qmckl_context_get_epsilon(const qmckl_context context); #+END_SRC ***** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) double qmckl_context_get_epsilon(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return pow(2.0,(double) 1-ctx->precision); @@ -793,7 +800,7 @@ double qmckl_context_get_epsilon(const qmckl_context context) { #+END_SRC ***** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface real (c_double) function qmckl_context_get_epsilon(context) bind(C) use, intrinsic :: iso_c_binding @@ -809,7 +816,7 @@ double qmckl_context_get_epsilon(const qmckl_context context) { *** End of files :noexport: ***** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) return MUNIT_OK; } #+END_SRC From 6f2adf292115c06fd30167a4ecbe6e7b7319a011 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Feb 2021 01:39:42 +0100 Subject: [PATCH 05/65] qmckl_memory --- src/qmckl_ao.org | 6 ++++-- src/qmckl_memory.org | 32 +++++++++++++++++++++----------- 2 files changed, 25 insertions(+), 13 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 50bcfec..b0f9671 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -30,6 +30,7 @@ MunitResult test_qmckl_ao() { \[ P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c \] + \begin{eqnarray*} \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ @@ -38,6 +39,8 @@ MunitResult test_qmckl_ao() { \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ \end{eqnarray*} + + \begin{eqnarray*} \left( \frac{\partial }{\partial x^2} + \frac{\partial }{\partial y^2} + @@ -527,7 +530,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); Computes the values, gradients and Laplacians at a given point of ~n~ Gaussian functions centered at the same point: - \[ v_i = exp(-a_i |X-R|^2) \] + \[ v_i = \exp(-a_i |X-R|^2) \] \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] @@ -740,7 +743,6 @@ munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); return QMCKL_FAILURE; return MUNIT_OK; } - #+END_SRC diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index e74913b..02a4cec 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -10,6 +10,7 @@ *** Headers :noexport: #+BEGIN_SRC C :tangle qmckl_memory.c #include "qmckl.h" +#include #+END_SRC #+BEGIN_SRC C :tangle test_qmckl_memory.c @@ -22,6 +23,8 @@ MunitResult test_qmckl_memory() { Memory allocation function, letting the library choose how the memory will be allocated, and a pointer is returned to the user. + The context is passed to let the library store data related to the + allocation inside the context. #+BEGIN_SRC C :tangle qmckl.h void* qmckl_malloc(const qmckl_context ctx, const size_t size); @@ -40,19 +43,20 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size); **** Source #+BEGIN_SRC C :tangle qmckl_memory.c void* qmckl_malloc(const qmckl_context ctx, const size_t size) { - if (ctx == (qmckl_context) 0) { - /* Avoids unused parameter error */ - return malloc( (size_t) size ); - } - return malloc( (size_t) size ); + if (ctx == (qmckl_context) 0) {}; /* Avoid unused argument warning */ + void * result = malloc( (size_t) size ); + assert (result != NULL) ; + return result; } #+END_SRC **** Test :noexport: #+BEGIN_SRC C :tangle test_qmckl_memory.c -int *a; +int *a = NULL; +munit_assert(a == NULL); a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); +munit_assert(a != NULL); a[0] = 1; a[1] = 2; a[2] = 3; @@ -64,27 +68,33 @@ munit_assert_int(a[2], ==, 3); *** ~qmckl_free~ #+BEGIN_SRC C :tangle qmckl.h -void qmckl_free(void *ptr); +void* qmckl_free(void *ptr); #+END_SRC #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface - subroutine qmckl_free (ptr) bind(C) + type (c_ptr) function qmckl_free (ptr) bind(C) use, intrinsic :: iso_c_binding type (c_ptr), intent(in), value :: ptr - end subroutine qmckl_free + end function qmckl_free end interface #+END_SRC **** Source #+BEGIN_SRC C :tangle qmckl_memory.c -void qmckl_free(void *ptr) { +void* qmckl_free(void *ptr) { + assert (ptr != NULL); free(ptr); + return NULL; } + #+END_SRC **** Test :noexport: #+BEGIN_SRC C :tangle test_qmckl_memory.c -qmckl_free(a); +munit_assert(a != NULL); +a = qmckl_free(a); +munit_assert(a == NULL); + #+END_SRC *** End of files :noexport: From 56f5d9d56d91ce0242fd2b19d94e29439163583a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 5 Mar 2021 03:45:30 +0100 Subject: [PATCH 06/65] Error handling --- TODO.org | 3 + src/Makefile | 4 +- src/README.org | 1 - src/merge_org.sh | 4 +- src/qmckl.org | 62 +++------ src/qmckl_context.org | 299 ++++++++++++++++++++++++++-------------- src/qmckl_error.org | 193 ++++++++++++++++++++++++++ src/qmckl_memory.org | 22 +-- src/qmckl_precision.org | 21 +++ src/test_qmckl.org | 2 +- 10 files changed, 451 insertions(+), 160 deletions(-) create mode 100644 src/qmckl_error.org create mode 100644 src/qmckl_precision.org diff --git a/TODO.org b/TODO.org index 1fad144..b565b64 100644 --- a/TODO.org +++ b/TODO.org @@ -16,3 +16,6 @@ context. * 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. diff --git a/src/Makefile b/src/Makefile index 7f78a9b..f067945 100644 --- a/src/Makefile +++ b/src/Makefile @@ -60,7 +60,7 @@ clean: rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod Makefile.generated: Makefile create_makefile.sh $(ORG_SOURCE_FILES) - ./merge_org.sh - ./create_makefile.sh $(MERGED_ORG) + ./merge_org.sh + ./create_makefile.sh $(MERGED_ORG) rm $(MERGED_ORG) diff --git a/src/README.org b/src/README.org index a27768a..67c0101 100644 --- a/src/README.org +++ b/src/README.org @@ -205,4 +205,3 @@ rm ${nb}.md * Documentation - diff --git a/src/merge_org.sh b/src/merge_org.sh index b4b2101..41f8a41 100755 --- a/src/merge_org.sh +++ b/src/merge_org.sh @@ -2,8 +2,10 @@ for i in README.org \ qmckl.org \ - qmckl_memory.org \ qmckl_context.org \ + qmckl_error.org \ + qmckl_precision.org \ + qmckl_memory.org \ qmckl_distance.org \ qmckl_ao.org \ qmckl_footer.org \ diff --git a/src/qmckl.org b/src/qmckl.org index ce5a3ce..985f848 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -1,18 +1,30 @@ + ** =qmckl.h= header file - This file produces the =qmckl.h= header file, which is to be included - when qmckl functions are used. + The =qmckl.h= header file has to be included in <<>> codes when + QMCkl functions are used: + #+BEGIN_SRC C :tangle none + #include "qmckl.h" + #+END_SRC f90 - We also create here the =qmckl_f.f90= which is the Fortran interface file. + + In <<>> programs, the =qmckl_f.f90= interface file should be + included in the source code using the library, and the Fortran codes + should use the ~qmckl~ module as + #+BEGIN_SRC f90 :tangle none + use qmckl + #+END_SRC f90 *** Top of header files :noexport: - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :tangle qmckl.h :noweb yes #ifndef QMCKL_H #define QMCKL_H #include #include -#include + +<> + #+END_SRC #+BEGIN_SRC f90 :tangle qmckl_f.f90 @@ -22,43 +34,3 @@ module qmckl The bottoms of the files are located in the [[qmckl_footer.org]] file. -*** Constants - -**** Success/failure - - These are the codes returned by the functions to indicate success - or failure. All such functions should have as a return type =qmckl_exit_code=. - - #+BEGIN_SRC C :comments org :tangle qmckl.h -#define QMCKL_SUCCESS 0 -#define QMCKL_FAILURE 1 - -typedef int32_t qmckl_exit_code; -typedef int64_t qmckl_context ; - - #+END_SRC - - #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 -integer, parameter :: QMCKL_SUCCESS = 0 -integer, parameter :: QMCKL_FAILURE = 0 - #+END_SRC - -**** Precision-related constants - - Controlling numerical precision enables optimizations. Here, the - default parameters determining the target numerical precision and - range are defined. - - #+BEGIN_SRC C :comments org :tangle qmckl.h -#define QMCKL_DEFAULT_PRECISION 53 -#define QMCKL_DEFAULT_RANGE 11 - #+END_SRC - - #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 -integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 -integer, parameter :: QMCKL_DEFAULT_RANGE = 11 - #+END_SRC - - - # -*- mode: org -*- - # vim: syntax=c diff --git a/src/qmckl_context.org b/src/qmckl_context.org index ee249ff..fc8f0da 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -6,7 +6,6 @@ :h: qmckl.h :END: - This file is written in C because it is more natural to express the context in C than in Fortran. @@ -17,6 +16,9 @@ *** Headers :noexport: #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) #include "qmckl.h" +#include +#include +#include #+END_SRC #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) @@ -25,54 +27,71 @@ MunitResult test_qmckl_context() { #+END_SRC -*** Context +*** Context - The context variable is a handle for the state of the library, and + The <<>> variable is a handle for the state of the library, and is stored in the following data structure, which can't be seen outside of the library. To simplify compatibility with other languages, the pointer to the internal data structure is converted into a 64-bit signed integer, defined in the ~qmckl_context~ type. - A value of 0 for the context is equivalent to a ~NULL~ pointer. + A value of ~0~ for the context is equivalent to a ~NULL~ pointer. - # The following code block should be kept to insert comments into - # the qmckl.h file + #+BEGIN_SRC C :comments org :tangle qmckl.h +typedef int64_t qmckl_context ; + #+END_SRC - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) :export none - #+END_SRC +**** Data for error handling + We define here the the data structure containing the strings + necessary for error handling. + + #+BEGIN_SRC C :comments org :tangle qmckl.h +#define QMCKL_MAX_FUN_LEN 256 +#define QMCKL_MAX_MSG_LEN 1024 + +typedef struct qmckl_error_struct { + + qmckl_exit_code exit_code; + char function[QMCKL_MAX_FUN_LEN]; + char message [QMCKL_MAX_MSG_LEN]; + +} qmckl_error_struct; + #+END_SRC + + **** Basis set data structure Data structure for the info related to the atomic orbitals basis set. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "c" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) typedef struct qmckl_ao_basis_struct { - int64_t shell_num; - int64_t prim_num; - int64_t * shell_center; - int32_t * shell_ang_mom; - double * shell_factor; - double * exponent ; - double * coefficient ; + int64_t shell_num; + int64_t prim_num; + int64_t * shell_center; + int32_t * shell_ang_mom; + double * shell_factor; + double * exponent ; + double * coefficient ; int64_t * shell_prim_num; - char type; + char type; } qmckl_ao_basis_struct; #+END_SRC -**** Source - - The tag is used internally to check if the memory domain pointed - by a pointer is a valid context. +***** Source - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "c" t) + The tag is used internally to check if the memory domain pointed + by a pointer is a valid context. + + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; /* Molecular system */ - // struct qmckl_nucleus_struct * nucleus; + // struct qmckl_nucleus_struct * nucleus; // struct qmckl_electron_struct * electron; struct qmckl_ao_basis_struct * ao_basis; // struct qmckl_mo_struct * mo; @@ -83,17 +102,92 @@ typedef struct qmckl_context_struct { int32_t precision; int32_t range; + /* Error handling */ + struct qmckl_error_struct * error; + } qmckl_context_struct; #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF + #+END_SRC + +**** ~qmckl_context_update_error~ + + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +qmckl_exit_code +qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); #+END_SRC -**** Test :noexport: - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) +***** Source + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +qmckl_exit_code +qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +{ + assert (context != 0); + assert (function != NULL); + assert (message != NULL); + assert (exit_code > 0); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + if (ctx == NULL) return QMCKL_FAILURE; + + if (ctx->error != NULL) { + free(ctx->error); + ctx->error = NULL; + } + + qmckl_error_struct* error = (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); + error->exit_code = exit_code; + strcpy(error->function, function); + strcpy(error->message, message); + + ctx->error = error; + + return QMCKL_SUCCESS; +} + #+END_SRC + +***** TODO Test + +**** ~qmckl_context_set_error~ + + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +qmckl_context +qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); + #+END_SRC + +***** Source + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +qmckl_context +qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +{ + assert (context != 0); + assert (function != NULL); + assert (message != NULL); + assert (exit_code > 0); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + + qmckl_context new_context = qmckl_context_copy(context); + if (new_context == 0) return context; + + if (qmckl_context_update_error(new_context, exit_code, + function, message) != QMCKL_SUCCESS) { + return context; + } + + return new_context; +} + #+END_SRC + +***** TODO Test + +***** Test :noexport: + + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) qmckl_context context; qmckl_context new_context; - #+END_SRC + #+END_SRC **** ~qmckl_context_check~ @@ -102,7 +196,7 @@ qmckl_context new_context; Returns the input ~qmckl_context~ if the context is valid, 0 otherwise. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_check(const qmckl_context context) ; #+END_SRC @@ -126,7 +220,7 @@ qmckl_context qmckl_context_check(const qmckl_context context) { - On success, returns a pointer to a context using the ~qmckl_context~ type - Returns ~0~ upon failure to allocate the internal data structure - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_create(); #+END_SRC @@ -145,6 +239,7 @@ qmckl_context qmckl_context_create() { context->precision = QMCKL_DEFAULT_PRECISION; context->range = QMCKL_DEFAULT_RANGE; context->tag = VALID_TAG; + context->error = NULL; return (qmckl_context) context; } @@ -174,7 +269,7 @@ munit_assert_int64( qmckl_context_check(context), ==, context); - Returns 0 upon failure to allocate the internal data structure for the new context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_copy(const qmckl_context context); #+END_SRC @@ -190,7 +285,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { qmckl_context_struct* old_context = (qmckl_context_struct*) checked_context; - qmckl_context_struct* new_context = + qmckl_context_struct* new_context = (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); if (new_context == NULL) { return (qmckl_context) 0; @@ -201,6 +296,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { new_context->precision = old_context->precision; new_context->range = old_context->range; new_context->tag = VALID_TAG; + new_context->error = old_context->error; return (qmckl_context) new_context; } @@ -232,7 +328,7 @@ munit_assert_int64(qmckl_context_check(new_context), ==, new_context); - Returns 0 for the initial context - Returns 0 for the 0-valued context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_previous(const qmckl_context context); #+END_SRC @@ -276,7 +372,7 @@ munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context - Fails if the 0-valued context is given in argument - Fails if the the pointer is not a valid context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_destroy(qmckl_context context); #+END_SRC @@ -291,8 +387,7 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { if (ctx == NULL) return QMCKL_FAILURE; ctx->tag = INVALID_TAG; - qmckl_free(ctx); - return QMCKL_SUCCESS; + return qmckl_free(context,ctx); } #+END_SRC @@ -316,16 +411,16 @@ munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); #+END_SRC -*** Basis set +**** Basis set - For H_2 with the following basis set, + For H_2 with the following basis set, - #+BEGIN_EXAMPLE + #+BEGIN_EXAMPLE HYDROGEN S 5 1 3.387000E+01 6.068000E-03 2 5.095000E+00 4.530800E-02 -3 1.159000E+00 2.028220E-01 +3 1.159000E+00 2.028220E-01 4 3.258000E-01 5.039030E-01 5 1.027000E-01 3.834210E-01 S 1 @@ -338,11 +433,11 @@ P 1 1 3.880000E-01 1.000000E+00 D 1 1 1.057000E+00 1.0000000 - #+END_EXAMPLE + #+END_EXAMPLE - we have: + we have: - #+BEGIN_EXAMPLE + #+BEGIN_EXAMPLE type = 'G' shell_num = 12 prim_num = 20 @@ -356,7 +451,7 @@ EXPONENT = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0] - #+END_EXAMPLE + #+END_EXAMPLE **** ~qmckl_context_update_ao_basis~ @@ -373,10 +468,10 @@ COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, | ~EXPONENT(prim_num)~ | Array of exponents | | ~COEFFICIENT(prim_num)~ | Array of coefficients | - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_ao_basis(qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, + const int64_t shell_num , const int64_t prim_num, const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, @@ -387,7 +482,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_update_ao_basis(qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, + const int64_t shell_num , const int64_t prim_num, const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, @@ -402,84 +497,84 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type if (shell_num <= 0) return QMCKL_FAILURE; if (prim_num <= 0) return QMCKL_FAILURE; if (prim_num < shell_num) return QMCKL_FAILURE; - + for (i=0 ; ishell_center = (int64_t*) malloc (shell_num * sizeof(int64_t)); if (basis->shell_center == NULL) { - free(basis); + qmckl_free(context, basis); return QMCKL_FAILURE; } - + basis->shell_ang_mom = (int32_t*) malloc (shell_num * sizeof(int32_t)); if (basis->shell_ang_mom == NULL) { - free(basis->shell_center); - free(basis); + qmckl_free(context, basis->shell_center); + qmckl_free(context, basis); return QMCKL_FAILURE; } - + basis->shell_prim_num= (int64_t*) malloc (shell_num * sizeof(int64_t)); if (basis->shell_prim_num == NULL) { - free(basis->shell_ang_mom); - free(basis->shell_center); - free(basis); + qmckl_free(context, basis->shell_ang_mom); + qmckl_free(context, basis->shell_center); + qmckl_free(context, basis); return QMCKL_FAILURE; } - + basis->shell_factor = (double *) malloc (shell_num * sizeof(double )); if (basis->shell_factor == NULL) { - free(basis->shell_prim_num); - free(basis->shell_ang_mom); - free(basis->shell_center); - free(basis); + qmckl_free(context, basis->shell_prim_num); + qmckl_free(context, basis->shell_ang_mom); + qmckl_free(context, basis->shell_center); + qmckl_free(context, basis); return QMCKL_FAILURE; } basis->exponent = (double *) malloc (prim_num * sizeof(double )); if (basis->exponent == NULL) { - free(basis->shell_factor); - free(basis->shell_prim_num); - free(basis->shell_ang_mom); - free(basis->shell_center); - free(basis); + qmckl_free(context, basis->shell_factor); + qmckl_free(context, basis->shell_prim_num); + qmckl_free(context, basis->shell_ang_mom); + qmckl_free(context, basis->shell_center); + qmckl_free(context, basis); return QMCKL_FAILURE; } basis->coefficient = (double *) malloc (prim_num * sizeof(double )); if (basis->coefficient == NULL) { - free(basis->exponent); - free(basis->shell_factor); - free(basis->shell_prim_num); - free(basis->shell_ang_mom); - free(basis->shell_center); - free(basis); + qmckl_free(context, basis->exponent); + qmckl_free(context, basis->shell_factor); + qmckl_free(context, basis->shell_prim_num); + qmckl_free(context, basis->shell_ang_mom); + qmckl_free(context, basis->shell_center); + qmckl_free(context, basis); return QMCKL_FAILURE; } - + /* Assign data */ basis->type = type; basis->shell_num = shell_num; - basis->prim_num = prim_num; + basis->prim_num = prim_num; for (i=0 ; ishell_center [i] = SHELL_CENTER [i]; @@ -497,7 +592,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_SUCCESS; } #+END_SRC - + ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface @@ -537,10 +632,10 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type | ~EXPONENT(prim_num)~ | Array of exponents | | ~COEFFICIENT(prim_num)~ | Array of coefficients | - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_ao_basis(const qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, + const int64_t shell_num , const int64_t prim_num, const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, @@ -551,7 +646,7 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_set_ao_basis(const qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, + const int64_t shell_num , const int64_t prim_num, const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, @@ -561,8 +656,8 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; - if (qmckl_context_update_ao_basis(context, type, shell_num, prim_num, - SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, + if (qmckl_context_update_ao_basis(new_context, type, shell_num, prim_num, + SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, COEFFICIENT ) == QMCKL_FAILURE) @@ -571,7 +666,7 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ return new_context; } #+END_SRC - + ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface @@ -596,20 +691,20 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ ***** TODO Test -*** Precision +**** Precision - The following functions set and get the expected required - precision and range. ~precision~ should be an integer between 2 - and 53, and ~range~ should be an integer between 2 and 11. + The following functions set and get the expected required + precision and range. ~precision~ should be an integer between 2 + and 53, and ~range~ should be an integer between 2 and 11. - The setter functions functions return a new context as a 64-bit - integer. The getter functions return the value, as a 32-bit - integer. The update functions return ~QMCKL_SUCCESS~ or - ~QMCKL_FAILURE~. + The setter functions functions return a new context as a 64-bit + integer. The getter functions return the value, as a 32-bit + integer. The update functions return ~QMCKL_SUCCESS~ or + ~QMCKL_FAILURE~. **** ~qmckl_context_update_precision~ Modifies the parameter for the numerical precision in a given context. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC @@ -642,7 +737,7 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons ***** TODO Tests :noexport: **** ~qmckl_context_update_range~ Modifies the parameter for the numerical range in a given context. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); #+END_SRC @@ -675,7 +770,7 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in ***** TODO Tests :noexport: **** ~qmckl_context_set_precision~ Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC @@ -685,7 +780,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; - if (qmckl_context_update_precision(context, precision) == QMCKL_FAILURE) return 0; + if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0; return new_context; } @@ -705,7 +800,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int ***** TODO Tests :noexport: **** ~qmckl_context_set_range~ Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC @@ -715,7 +810,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; - if (qmckl_context_update_range(context, range) == QMCKL_FAILURE) return 0; + if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0; return new_context; } @@ -736,7 +831,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran **** ~qmckl_context_get_precision~ Returns the value of the numerical precision in the context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) int32_t qmckl_context_get_precision(const qmckl_context context); #+END_SRC @@ -761,7 +856,7 @@ int qmckl_context_get_precision(const qmckl_context context) { ***** TODO Tests :noexport: **** ~qmckl_context_get_range~ Returns the value of the numerical range in the context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) int32_t qmckl_context_get_range(const qmckl_context context); #+END_SRC @@ -787,7 +882,7 @@ int qmckl_context_get_range(const qmckl_context context) { **** ~qmckl_context_get_epsilon~ Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) double qmckl_context_get_epsilon(const qmckl_context context); #+END_SRC @@ -811,7 +906,7 @@ double qmckl_context_get_epsilon(const qmckl_context context) { ***** TODO Tests :noexport: - + *** End of files :noexport: @@ -821,7 +916,7 @@ return MUNIT_OK; } #+END_SRC - + # -*- mode: org -*- # vim: syntax=c diff --git a/src/qmckl_error.org b/src/qmckl_error.org new file mode 100644 index 0000000..dda5996 --- /dev/null +++ b/src/qmckl_error.org @@ -0,0 +1,193 @@ +# This file is part of the qmckl.h file +** Error handling + :PROPERTIES: + :c: qmckl_error.c + :c_test: test_qmckl_error.c + :fh: qmckl_f.f90 + :h: qmckl.h + :END: + + This file is written in C because it is more natural to express the + error handling in C than in Fortran. + + 2 files are produced: + - a source file : =qmckl_error.c= + - a test file : =test_qmckl_error.c= + +*** Headers :noexport: + #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +#include "qmckl.h" +#include +#include +#include +#include + #+END_SRC + + #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) +#include "qmckl.h" +#include "munit.h" +MunitResult test_qmckl_error() { + #+END_SRC + +*** Error handling + + The library should never make the calling programs abort, nor + perform any input/output operations. This decision has to be taken + by the developer of the code calling the library. + + All the functions return with an <<>>, defined as + #+NAME: type-exit-code + #+BEGIN_SRC C :comments org :tangle qmckl.h +typedef int32_t qmckl_exit_code; + #+END_SRC + + The exit code returns the completion status of the function to the + calling program. When a function call completed successfully, the + ~QMCKL_SUCCESS~ exit code is returned. If one of the functions of + the library fails to complete the requested task, an appropriate + error code is returned to the program. + + Here is the complete list of exit codes. + + #+NAME: table-exit-codes + | ~QMCKL_SUCCESS~ | 0 | + | ~QMCKL_INVALID_ARG_1~ | 1 | + | ~QMCKL_INVALID_ARG_2~ | 2 | + | ~QMCKL_INVALID_ARG_3~ | 3 | + | ~QMCKL_INVALID_ARG_4~ | 4 | + | ~QMCKL_INVALID_ARG_5~ | 5 | + | ~QMCKL_INVALID_ARG_6~ | 6 | + | ~QMCKL_INVALID_ARG_7~ | 7 | + | ~QMCKL_INVALID_ARG_8~ | 8 | + | ~QMCKL_INVALID_ARG_9~ | 9 | + | ~QMCKL_INVALID_ARG_10~ | 10 | + | ~QMCKL_NULL_CONTEXT~ | 101 | + | ~QMCKL_FAILURE~ | 102 | + | ~QMCKL_ERRNO~ | 103 | + | ~QMCKL_INVALID_EXIT_CODE~ | 104 | + + # We need to force Emacs not to indent the Python code: + # -*- org-src-preserve-indentation: t + #+BEGIN_SRC python :var table=table-exit-codes :results drawer :exports result +""" This script generates the C and Fortran constants for the error + codes from the org-mode table. +""" + +result = [ "#+BEGIN_SRC C :comments org :tangle qmckl.h" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f"#define {text:30s} {code:d}" ] +result += [ "#+END_SRC" ] + +result += [ "" ] + +result += [ "#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f" integer, parameter :: {text:30s} = {code:d}" ] +result += [ "#+END_SRC" ] + +return '\n'.join(result) + + #+END_SRC + + #+RESULTS: + :results: + #+BEGIN_SRC C :comments org :tangle qmckl.h + #define QMCKL_SUCCESS 0 + #define QMCKL_INVALID_ARG_1 1 + #define QMCKL_INVALID_ARG_2 2 + #define QMCKL_INVALID_ARG_3 3 + #define QMCKL_INVALID_ARG_4 4 + #define QMCKL_INVALID_ARG_5 5 + #define QMCKL_INVALID_ARG_6 6 + #define QMCKL_INVALID_ARG_7 7 + #define QMCKL_INVALID_ARG_8 8 + #define QMCKL_INVALID_ARG_9 9 + #define QMCKL_INVALID_ARG_10 10 + #define QMCKL_NULL_CONTEXT 101 + #define QMCKL_FAILURE 102 + #define QMCKL_ERRNO 103 + #define QMCKL_INVALID_EXIT_CODE 104 + #+END_SRC + + #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 + integer, parameter :: QMCKL_SUCCESS = 0 + integer, parameter :: QMCKL_INVALID_ARG_1 = 1 + integer, parameter :: QMCKL_INVALID_ARG_2 = 2 + integer, parameter :: QMCKL_INVALID_ARG_3 = 3 + integer, parameter :: QMCKL_INVALID_ARG_4 = 4 + integer, parameter :: QMCKL_INVALID_ARG_5 = 5 + integer, parameter :: QMCKL_INVALID_ARG_6 = 6 + integer, parameter :: QMCKL_INVALID_ARG_7 = 7 + integer, parameter :: QMCKL_INVALID_ARG_8 = 8 + integer, parameter :: QMCKL_INVALID_ARG_9 = 9 + integer, parameter :: QMCKL_INVALID_ARG_10 = 10 + integer, parameter :: QMCKL_NULL_CONTEXT = 101 + integer, parameter :: QMCKL_FAILURE = 102 + integer, parameter :: QMCKL_ERRNO = 103 + integer, parameter :: QMCKL_INVALID_EXIT_CODE = 104 + #+END_SRC + :end: + + To make a function fail, the <<<~qmckl_failwith~>>> function should be + called, such that information about the failure is stored in + the context. The desired exit code is given as an argument, as + well as the name of the function and an error message. The return + code of the function is the desired return code. + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_exit_code qmckl_failwith(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function, + const char* message) ; + #+END_SRC + + #+BEGIN_SRC C :comments org :tangle qmckl_error.c +qmckl_exit_code qmckl_failwith(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function, + const char* message) { + if (context == 0) return QMCKL_NULL_CONTEXT; + assert (exit_code > 0); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + assert (function != NULL); + assert (message != NULL); + assert (strlen(function) < QMCKL_MAX_FUN_LEN); + assert (strlen(message) < QMCKL_MAX_MSG_LEN); + + context = qmckl_context_set_error(context, exit_code, function, message); + return exit_code; +} + + #+END_SRC + + For example, this function can be used as + #+BEGIN_SRC C :tangle no +if (x < 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_function", + "Expected x >= 0"); + } + #+END_SRC + + + # To decode the error messages, the <<<~qmckl_strerror~>>> converts an + # error code into a string. + +*** End of files :noexport: + +***** Test + #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) +return MUNIT_OK; +} + #+END_SRC + + + + # -*- mode: org -*- + # vim: syntax=c + + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 02a4cec..d861c13 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -67,33 +67,39 @@ munit_assert_int(a[2], ==, 3); *** ~qmckl_free~ + The context is passed, in case some important information has been + stored related to memory allocation and needs to be updated. + #+BEGIN_SRC C :tangle qmckl.h -void* qmckl_free(void *ptr); +qmckl_exit_code qmckl_free(qmckl_context context, void *ptr); #+END_SRC #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface - type (c_ptr) function qmckl_free (ptr) bind(C) + integer (c_int32_t) function qmckl_free (context, ptr) bind(C) use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context type (c_ptr), intent(in), value :: ptr end function qmckl_free end interface #+END_SRC + **** Source #+BEGIN_SRC C :tangle qmckl_memory.c -void* qmckl_free(void *ptr) { - assert (ptr != NULL); +qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { + if (context == 0) return QMCKL_INVALID_ARG_1; + if (ptr == NULL) return QMCKL_INVALID_ARG_2; free(ptr); - return NULL; + return QMCKL_SUCCESS; } - #+END_SRC **** Test :noexport: #+BEGIN_SRC C :tangle test_qmckl_memory.c munit_assert(a != NULL); -a = qmckl_free(a); -munit_assert(a == NULL); +qmckl_exit_code rc; +rc = qmckl_free( (qmckl_context) 1, a); +munit_assert(rc == QMCKL_SUCCESS); #+END_SRC diff --git a/src/qmckl_precision.org b/src/qmckl_precision.org new file mode 100644 index 0000000..60c8fd0 --- /dev/null +++ b/src/qmckl_precision.org @@ -0,0 +1,21 @@ +# This file is part of the qmckl.h file + +*** Multi-precision related constants + + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. + + #+BEGIN_SRC C :comments org :tangle qmckl.h +#define QMCKL_DEFAULT_PRECISION 53 +#define QMCKL_DEFAULT_RANGE 11 + #+END_SRC + + #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 + integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 + integer, parameter :: QMCKL_DEFAULT_RANGE = 11 + #+END_SRC + + + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/test_qmckl.org b/src/test_qmckl.org index 1489768..cc0f169 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -63,7 +63,7 @@ echo "#+END_SRC" { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, #+END_SRC - #+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c + #+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c #include "qmckl.h" #include "munit.h" <> From fd4a50ddee805c624c4a651bb30189ff5da54734 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 12:40:41 +0100 Subject: [PATCH 07/65] Update README.org --- src/README.org | 189 +++++++++++++++++++++++++++------------------ tools/init.el | 80 +++++++++++++++++++ tools/nb_to_org.sh | 11 +++ 3 files changed, 204 insertions(+), 76 deletions(-) create mode 100644 tools/init.el create mode 100755 tools/nb_to_org.sh diff --git a/src/README.org b/src/README.org index 67c0101..0b47577 100644 --- a/src/README.org +++ b/src/README.org @@ -4,110 +4,140 @@ #+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup + bibliography:../docs/references.bib + * Introduction - The ultimate goal of QMCkl is to provide a high-performance + The ultimate goal of the QMCkl library is to provide a high-performance implementation of the main kernels of QMC. In this particular - repository, we focus on the definition of the API and the tests, and + implementation of the library, we focus on the definition of the API and the tests, and on a /pedagogical/ presentation of the algorithms. We expect the HPC experts to use this repository as a reference for re-writing optimized libraries. - Literate programming is particularly adapted in this context. - Source files are written in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, to provide useful - comments and LaTex formulas close to the code. There exists multiple - possibilities to convert org-mode files into different formats such - as HTML or pdf. For a tutorial on literate programming with - org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. + +** Literate programming + + In a traditional source code, most of the lines of source files of a program + are code, scripts, Makefiles, and only a few lines are comments explaining + parts of the code that are non-trivial to understand. The documentation of + the prorgam is usually written in a separate directory, and is often outdated + compared to the code. - The code is extracted from the org files using Emacs as a - command-line tool in the =Makefile=, and then the produced files are - compiled. + Literate programming cite:knuth_1992 is a different approach to programming, + where the program is considered as a publishable-quality document. Most of + the lines of the source files are text, mathematical formulas, tables, + figures, /etc/, and the lines of code are just the translation in a computer + language of the ideas and algorithms expressed in the text. More importantly, + the "document" is structured like a text document with sections, subsections, + a bibliography, a table of contents /etc/, and the place where pieces of code + appear are the places where they should belong for the reader to understand + the logic of the program, not the places where the compiler expects to find + them. Both the publishable-quality document and the binary executable are + produced from the same source files. -** Language used + Literate programming is particularly well adapted in this context, as the + central part of this project is the documentation of an API. The + implementation of the algorithms is just an expression of the algorithms in a + language that can be compiled, so that the correctness of the algorithms can + be tested. - Fortran is one of the most common languages used by the community, - and is simple enough to make the algorithms readable. Hence we - propose in this pedagogical implementation of QMCkl to use Fortran - to express the algorithms. For specific internal functions where - the C language is more natural, C is used. + We have chosen to write the source files in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, + cite:schulte_2012 as any text editor can be used to edit org-mode files. To + produce the documentation, there exists multiple possibilities to convert + org-mode files into different formats such as HTML or PDF. The source code is + easily extracted from the org-mode files invoking the Emacs text editor from + the command-line in the =Makefile=, and then the produced files are compiled. + Moreover, within the Emacs text editor the source code blocks can be executed + interactively, in the same spirit as Jupyter notebooks. cite:Kluyver_2016 - As Fortran modules generate compiler-dependent files, the use of - modules is restricted to the internal use of the library, otherwise - the compliance with C is violated. - - The external dependencies should be kept as small as possible, so - external libraries should be used /only/ if their used is strongly - justified. ** Source code editing + For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. + Any text editor can be used to edit org-mode files. For a better user experience Emacs is recommended. For users hating Emacs, it is good to know that Emacs can behave like Vim when switched into ``Evil'' mode. There also exists [[https://www.spacemacs.org][Spacemacs]] which helps the transition for Vim users. - For users with a preference for Jupyter notebooks, the following - script can convert jupyter notebooks to org-mode files: + In the =tools/init.el= file, we provide a minimal Emacs configuration + file for vim users. This file should be copied into =.emacs.d/init.el=. - #+BEGIN_SRC sh tangle: nb_to_org.sh -#!/bin/bash -# $ nb_to_org.sh notebook.ipynb -# produces the org-mode file notebook.org + For users with a preference for Jupyter notebooks, we also provide the + =tools/nb_to_org.sh= script can convert jupyter notebooks into org-mode + files. -set -e + Note that pandoc can be used to convert multiple markdown formats into + org-mode. -nb=$(basename $1 .ipynb) -jupyter nbconvert --to markdown ${nb}.ipynb --output ${nb}.md -pandoc ${nb}.md -o ${nb}.org -rm ${nb}.md - #+END_SRC - And pandoc can convert multiple markdown formats into org-mode. +** Choice of the programming language -** Writing in Fortran + Most of the codes of the TREX CoE are written in Fortran with some scripts in + Bash and Python. Outside of the CoE, Fortran is also important (Casino, Amolqc), + and other important languages used by the community are C and C++ (QMCPack, + QWalk), and Julia is gaining in popularity. cite:poole_2020 The library we + design should be compatible with all of these languages. The QMCkl API has to + be compatible with the C language since libraries with a C-compatible API can be + used in every other language. + + High-performance versions of the QMCkl, with the same API, will be rewritten by + the experts in HPC. These optimized libraries will be tuned for specific + architectures, among which we can cite x86 based processors, and GPU + accelerators. Nowadays, the most efficient software tools to take advantage of + low-level features of the processor (intrinsics) and of GPUs are for C++ + developers. It is highly probable that the optimized implementations will be + written in C++, and this is agreement with our choice to make the API + C-compatible. + + Fortran is one of the most common languages used by the community, and is simple + enough to make the algorithms readable both by experts in QMC, and experts in + HPC. Hence we propose in this pedagogical implementation of QMCkl to use Fortran + to express the QMC algorithms. As the main languages of the library is C, this + implies that the exposed C functions call the Fortran routine. However, for + internal functions related to system programming, the C language is more natural + than Fortran. + + The <<>> source files should provide a C interface using the + ~iso_c_binding~ module. The name of the Fortran source files should end with + =_f.f90= to be properly handled by the =Makefile=. The names of the functions + defined in Fortran should be the same as those exposed in the API suffixed by + =_f=. Fortran interfaces should also be written in the =qmckl_f.f90= file. - The Fortran source files should provide a C interface using - =iso_c_binding=. The name of the Fortran source files should end - with =_f.f90= to be properly handled by the Makefile. The names of - the functions defined in fortran should be the same as those - exposed in the API suffixed by =_f=. Fortran interface files - should also be written in the =qmckl_f.f90= file. - For more guidelines on using Fortran to generate a C interface, see [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]]. -** Coding style - # TODO: decide on a coding style - To improve readability, we maintain a consistent coding style in - the library. +# Coding style +# # TODO: decide on a coding style - - For C source files, we will use __(decide on a coding style)__ - - For Fortran source files, we will use __(decide on a coding - style)__ +# To improve readability, we maintain a consistent coding style in +# the library. - Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. +# - For C source files, we will use __(decide on a coding style)__ +# - For Fortran source files, we will use __(decide on a coding +# style)__ + +# Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. ** Design of the library - The proposed API should allow the library to: - - deal with memory transfers between CPU and accelerators - - use different levels of floating-point precision - - We chose a multi-layered design with low-level and high-level + The proposed API should allow the library to: deal with memory transfers + between CPU and accelerators, and to use different levels of floating-point + precision. We chose a multi-layered design with low-level and high-level functions (see below). *** Naming conventions - Use =qmckl_= as a prefix for all exported functions and variables. - All exported header files should have a filename with the prefix - =qmckl_=. + To avoid namespace collisions, we use =qmckl_= as a prefix for all exported + functions and variables. All exported header files should have a file name + prefixed with =qmckl_=. If the name of the org-mode file is =xxx.org=, the name of the produced C files should be =xxx.c= and =xxx.h= and the name of the - produced Fortran files should be =xxx.f90= + produced Fortran file should be =xxx.f90=. Arrays are in uppercase and scalars are in lowercase. @@ -116,23 +146,30 @@ rm ${nb}.md *** Application programming interface - The application programming interface (API) is designed to be - compatible with the C programming language (not C++), to ensure - that the library will be easily usable in /any/ language. This - implies that only the following data types are allowed in the API: + In the C language, the number of bits used by the integer types can change + from one architecture to another one. To circumvent this problem, we choose to + use the integer types defined in ~~ where the number of bits used for + the integers are fixed. - - 32-bit and 64-bit floats and arrays (=real= and =double=) - - 32-bit and 64-bit integers and arrays (=int32_t= and =int64_t=) - - Pointers should be represented as 64-bit integers (even on - 32-bit architectures) - - ASCII strings are represented as a pointers to a character - arrays and terminated by a zero character (C convention). - - Complex numbers can be represented by an array of 2 floats. + To ensure that the library will be easily usable in /any/ other language + than C, we restrict the data types in the interfaces to the following: + - 32-bit and 64-bit integers, scalars and and arrays (~int32_t~ and ~int64_t~) + - 32-bit and 64-bit floats, scalars and and arrays (~float~ and ~double~) + - Pointers are always casted into 64-bit integers, even on legacy 32-bit architectures + - ASCII strings are represented as a pointers to character arrays + and terminated by a ~'\0'~ character (C convention). + - Complex numbers can be represented by an array of 2 floats. + - Boolean variables are stored as integers, ~1~ for ~true~ and ~0~ for ~false~ + - Floating point variables should be by default + - ~double~ unless explicitly mentioned + - integers used for counting should always be ~int64_t~ + + To facilitate the use in other languages than C, we will provide some + bindings in other languages in other repositories. # TODO : Link to repositories for bindings - To facilitate the use in other languages than C, we provide some - bindings in other languages in other repositories. + # To facilitate the use in other languages than C, we provide some + # bindings in other languages in other repositories. *** Global state diff --git a/tools/init.el b/tools/init.el new file mode 100644 index 0000000..a5f9301 --- /dev/null +++ b/tools/init.el @@ -0,0 +1,80 @@ +(package-initialize) +(add-to-list 'package-archives + '("gnu" . "https://elpa.gnu.org/packages/")) +(add-to-list 'package-archives + '("melpa-stable" . "https://stable.melpa.org/packages/")) +(add-to-list 'package-archives + '("melpa" . "https://melpa.org/packages/")) +(setq package-archive-priorities '(("melpa-stable" . 100) + ("melpa" . 50) + ("gnu" . 10))) + +(require 'cl) +(let* ((required-packages + '(htmlize + evil + org-evil + org-bullets + )) + (missing-packages (remove-if #'package-installed-p required-packages))) + (when missing-packages + (message "Missing packages: %s" missing-packages) + (package-refresh-contents) + (dolist (pkg missing-packages) + (package-install pkg) + (message "Package %s has been installed" pkg)))) + +(setq backup-directory-alist + `(("." . ,(concat user-emacs-directory "backups")))) +(setq backup-by-copying t) + +(require 'org) +(setq org-format-latex-options (plist-put org-format-latex-options :scale 1.6)) + +(setq org-hide-leading-stars t) +(setq org-alphabetical-lists t) +(setq org-src-fontify-natively t) +(setq org-src-tab-acts-natively t) +(setq org-src-preserve-indentation t) +(setq org-hide-emphasis-markers nil) +(setq org-pretty-entities nil) +(setq org-confirm-babel-evaluate nil) ;; Do not ask for confirmation all the time!! + +(org-babel-do-load-languages + 'org-babel-load-languages + '( + (emacs-lisp . t) + (shell . t) + (python . t) + (C . t) + (org . t) + (makefile . t) + )) + +(add-hook 'org-babel-after-execute-hook 'org-display-inline-images) +'(indent-tabs-mode nil) + +(require 'evil) +(setq evil-want-C-i-jump nil) +(evil-mode 1) +(global-font-lock-mode t) +(global-superword-mode 1) + +(setq line-number-mode 1) +(setq column-number-mode 1) + +(evil-select-search-module 'evil-search-module 'evil-search) + +(global-set-key (kbd "C-+") 'text-scale-increase) +(global-set-key (kbd "C--") 'text-scale-decrease) + + +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(ansi-color-faces-vector + [default default default italic underline success warning error]) + '(custom-enabled-themes (quote (leuven))) +) diff --git a/tools/nb_to_org.sh b/tools/nb_to_org.sh new file mode 100755 index 0000000..ab80ebe --- /dev/null +++ b/tools/nb_to_org.sh @@ -0,0 +1,11 @@ +#!/bin/bash +# $ nb_to_org.sh notebook.ipynb +# produces the org-mode file notebook.org + +set -e + +nb=$(basename $1 .ipynb) +jupyter nbconvert --to markdown ${nb}.ipynb --output ${nb}.md +pandoc ${nb}.md -o ${nb}.org +rm ${nb}.md + From 88f1f82230f0caf9383a57ad3ad8d34bae83625d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 14:46:01 +0100 Subject: [PATCH 08/65] Updated doc generation --- src/Makefile | 4 ---- src/README.org | 21 ++++++++++----------- src/create_doc.sh | 42 +++++++++++++++++++++++++++++++++++------- src/create_makefile.sh | 2 ++ src/merge_org.sh | 4 +++- 5 files changed, 50 insertions(+), 23 deletions(-) diff --git a/src/Makefile b/src/Makefile index f067945..7ec36ea 100644 --- a/src/Makefile +++ b/src/Makefile @@ -51,16 +51,12 @@ test: Makefile.generated doc: $(ORG_SOURCE_FILES) - ./merge_org.sh ./create_doc.sh $(MERGED_ORG) - rm $(MERGED_ORG) clean: rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod Makefile.generated: Makefile create_makefile.sh $(ORG_SOURCE_FILES) - ./merge_org.sh ./create_makefile.sh $(MERGED_ORG) - rm $(MERGED_ORG) diff --git a/src/README.org b/src/README.org index 0b47577..0bed5e0 100644 --- a/src/README.org +++ b/src/README.org @@ -4,9 +4,9 @@ #+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup - bibliography:../docs/references.bib * Introduction + The ultimate goal of the QMCkl library is to provide a high-performance implementation of the main kernels of QMC. In this particular @@ -24,7 +24,7 @@ the prorgam is usually written in a separate directory, and is often outdated compared to the code. - Literate programming cite:knuth_1992 is a different approach to programming, + Literate programming is a different approach to programming, where the program is considered as a publishable-quality document. Most of the lines of the source files are text, mathematical formulas, tables, figures, /etc/, and the lines of code are just the translation in a computer @@ -43,13 +43,13 @@ be tested. We have chosen to write the source files in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, - cite:schulte_2012 as any text editor can be used to edit org-mode files. To + as any text editor can be used to edit org-mode files. To produce the documentation, there exists multiple possibilities to convert org-mode files into different formats such as HTML or PDF. The source code is easily extracted from the org-mode files invoking the Emacs text editor from the command-line in the =Makefile=, and then the produced files are compiled. Moreover, within the Emacs text editor the source code blocks can be executed - interactively, in the same spirit as Jupyter notebooks. cite:Kluyver_2016 + interactively, in the same spirit as Jupyter notebooks. ** Source code editing @@ -59,8 +59,7 @@ Any text editor can be used to edit org-mode files. For a better user experience Emacs is recommended. For users hating Emacs, it is good to know that Emacs can behave like Vim when switched into - ``Evil'' mode. There also exists [[https://www.spacemacs.org][Spacemacs]] which helps the - transition for Vim users. + ``Evil'' mode. In the =tools/init.el= file, we provide a minimal Emacs configuration file for vim users. This file should be copied into =.emacs.d/init.el=. @@ -78,10 +77,10 @@ Most of the codes of the TREX CoE are written in Fortran with some scripts in Bash and Python. Outside of the CoE, Fortran is also important (Casino, Amolqc), and other important languages used by the community are C and C++ (QMCPack, - QWalk), and Julia is gaining in popularity. cite:poole_2020 The library we - design should be compatible with all of these languages. The QMCkl API has to - be compatible with the C language since libraries with a C-compatible API can be - used in every other language. + QWalk), and Julia is gaining in popularity. The library we design should be + compatible with all of these languages. The QMCkl API has to be compatible + with the C language since libraries with a C-compatible API can be used in + every other language. High-performance versions of the QMCkl, with the same API, will be rewritten by the experts in HPC. These optimized libraries will be tuned for specific @@ -100,7 +99,7 @@ internal functions related to system programming, the C language is more natural than Fortran. - The <<>> source files should provide a C interface using the + The Fortran source files should provide a C interface using the ~iso_c_binding~ module. The name of the Fortran source files should end with =_f.f90= to be properly handled by the =Makefile=. The names of the functions defined in Fortran should be the same as those exposed in the API suffixed by diff --git a/src/create_doc.sh b/src/create_doc.sh index 39327c8..c5b092b 100755 --- a/src/create_doc.sh +++ b/src/create_doc.sh @@ -1,13 +1,41 @@ -#!/bin/bash -INPUT=$1 +#!/bin/bash -if [[ -f ../docs/htmlize.el ]] +INPUT=$1 +SRC=$PWD + + +# Install htmlize if needed +[[ -f ../docs/htmlize.el ]] || ( + cd ../docs/ + git clone https://github.com/hniksic/emacs-htmlize + cp emacs-htmlize/htmlize.el . + rm -rf emacs-htmlize + cd - +) + +[[ -f ../docs/htmlize.el ]] || exit 1 + + +# Switch to TMPDIR for easy cleanup +TMPDIR=$(mktemp -d) +./merge_org.sh $TMPDIR/$INPUT +cd $TMPDIR + + +# Create documentation +emacs --batch \ + --load ${SRC}/../docs/htmlize.el \ + --load ${SRC}/../toold/init.el \ + $INPUT -f org-html-export-to-html + +if [[ $? -eq 0 ]] then - emacs --batch --load ../docs/htmlize.el --load ../docs/config.el $INPUT -f org-html-export-to-html + rm -rf $TMPDIR + exit 0 else - emacs --batch --load ../docs/config.el $INPUT -f org-html-export-to-html + mv index.html ${SRC}/../docs/ + rm -rf $TMPDIR + exit 2 fi -mv index.html ../docs - diff --git a/src/create_makefile.sh b/src/create_makefile.sh index ee8168f..20a1ec7 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -1,6 +1,8 @@ #!/bin/bash INPUT=$1 +./merge_org.sh $INPUT + OUTPUT=Makefile.generated # Tangle org files diff --git a/src/merge_org.sh b/src/merge_org.sh index 41f8a41..61d182f 100755 --- a/src/merge_org.sh +++ b/src/merge_org.sh @@ -1,5 +1,7 @@ #!/bin/bash +OUTPUT=$1 + for i in README.org \ qmckl.org \ qmckl_context.org \ @@ -11,5 +13,5 @@ for i in README.org \ qmckl_footer.org \ test_qmckl.org do - cat $i >> merged_qmckl.org + cat $i >> $1 done From d7a922b24ec9931f9d4eeb193d19d691a91295c2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 14:47:11 +0100 Subject: [PATCH 09/65] Added rename script --- docs/.gitignore | 2 ++ tools/rename.py | 44 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+) create mode 100755 tools/rename.py diff --git a/docs/.gitignore b/docs/.gitignore index e69de29..9d9cd60 100644 --- a/docs/.gitignore +++ b/docs/.gitignore @@ -0,0 +1,2 @@ +htmlize.el +index.html diff --git a/tools/rename.py b/tools/rename.py new file mode 100755 index 0000000..51bb421 --- /dev/null +++ b/tools/rename.py @@ -0,0 +1,44 @@ +#!/usr/bin/env python + +""" +Changes the name of a function into all the org files. +This script should be run in the src directory. +""" + +import sys +import os + + +def help(): + print("Syntax : {0} OLD_FUNC_NAME NEW_FUNC_NAME".format(sys.argv[0])) + + + +def replace_in_file(filename, old_func_name, new_func_name): + with open(filename,'r') as f: + text = f.read() + + new_text = text.replace(old_func_name, new_func_name) + + with open(filename,'w') as f: + f.write(new_text) + + +def main(): + if len(sys.argv) != 3: + help() + sys.exit(-1) + old_func_name = sys.argv[1] + new_func_name = sys.argv[2] + + for filename in os.listdir(os.getcwd()): + if filename.endswith(".org"): + replace_in_file(filename, old_func_name, new_func_name) + + print("Done. run git diff to check what has been changed.") + + + + +if __name__ == "__main__": + main() From f03cff153ebdc1d61d251f61bde6463001f50c92 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 18:19:13 +0100 Subject: [PATCH 10/65] Fixed makefile --- src/Makefile | 11 ++++---- src/README.org | 23 +++++++++------- src/create_doc.sh | 41 ---------------------------- src/merge_org.sh | 17 ------------ src/table_of_contents | 9 +++++++ tools/create_doc.sh | 45 +++++++++++++++++++++++++++++++ {src => tools}/create_makefile.sh | 7 ++--- tools/merge_org.sh | 8 ++++++ 8 files changed, 85 insertions(+), 76 deletions(-) delete mode 100755 src/create_doc.sh delete mode 100755 src/merge_org.sh create mode 100644 src/table_of_contents create mode 100755 tools/create_doc.sh rename {src => tools}/create_makefile.sh (95%) create mode 100755 tools/merge_org.sh diff --git a/src/Makefile b/src/Makefile index 7ec36ea..d343eea 100644 --- a/src/Makefile +++ b/src/Makefile @@ -34,9 +34,10 @@ LIBS=-lm endif -export CC CFLAGS FC FFLAGS LIBS +QMCKL_ROOT=$(PWD)/.. + +export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT -MERGED_ORG=merged_qmckl.org ORG_SOURCE_FILES=$(wildcard *.org) OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) @@ -51,12 +52,12 @@ test: Makefile.generated doc: $(ORG_SOURCE_FILES) - ./create_doc.sh $(MERGED_ORG) + $(QMCKL_ROOT)/tools/create_doc.sh clean: rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod -Makefile.generated: Makefile create_makefile.sh $(ORG_SOURCE_FILES) - ./create_makefile.sh $(MERGED_ORG) +Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) + $(QMCKL_ROOT)/tools/create_makefile.sh diff --git a/src/README.org b/src/README.org index 0bed5e0..a2c2c9e 100644 --- a/src/README.org +++ b/src/README.org @@ -6,7 +6,7 @@ * Introduction - + The ultimate goal of the QMCkl library is to provide a high-performance implementation of the main kernels of QMC. In this particular @@ -15,9 +15,9 @@ HPC experts to use this repository as a reference for re-writing optimized libraries. - + ** Literate programming - + In a traditional source code, most of the lines of source files of a program are code, scripts, Makefiles, and only a few lines are comments explaining parts of the code that are non-trivial to understand. The documentation of @@ -49,7 +49,7 @@ easily extracted from the org-mode files invoking the Emacs text editor from the command-line in the =Makefile=, and then the produced files are compiled. Moreover, within the Emacs text editor the source code blocks can be executed - interactively, in the same spirit as Jupyter notebooks. + interactively, in the same spirit as Jupyter notebooks. ** Source code editing @@ -59,7 +59,7 @@ Any text editor can be used to edit org-mode files. For a better user experience Emacs is recommended. For users hating Emacs, it is good to know that Emacs can behave like Vim when switched into - ``Evil'' mode. + ``Evil'' mode. In the =tools/init.el= file, we provide a minimal Emacs configuration file for vim users. This file should be copied into =.emacs.d/init.el=. @@ -137,9 +137,9 @@ If the name of the org-mode file is =xxx.org=, the name of the produced C files should be =xxx.c= and =xxx.h= and the name of the produced Fortran file should be =xxx.f90=. - + Arrays are in uppercase and scalars are in lowercase. - + In the names of the variables and functions, only the singular form is allowed. @@ -224,7 +224,7 @@ variable. ** Algorithms - + Reducing the scaling of an algorithm usually implies also reducing its arithmetic complexity (number of flops per byte). Therefore, for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) @@ -233,11 +233,14 @@ implemented adapted to different problem sizes. ** Rules for the API - + - =stdint= should be used for integers (=int32_t=, =int64_t=) - integers used for counting should always be =int64_t= - - floats should be by default =double=, unless explicitly mentioned + - floats should be by default =double=, unless explicitly mentioned - pointers are converted to =int64_t= to increase portability * Documentation + # The .org files will be appended here in the order specified in the + # table_of_contents file + diff --git a/src/create_doc.sh b/src/create_doc.sh deleted file mode 100755 index c5b092b..0000000 --- a/src/create_doc.sh +++ /dev/null @@ -1,41 +0,0 @@ -#!/bin/bash - -INPUT=$1 -SRC=$PWD - - -# Install htmlize if needed -[[ -f ../docs/htmlize.el ]] || ( - cd ../docs/ - git clone https://github.com/hniksic/emacs-htmlize - cp emacs-htmlize/htmlize.el . - rm -rf emacs-htmlize - cd - -) - -[[ -f ../docs/htmlize.el ]] || exit 1 - - -# Switch to TMPDIR for easy cleanup -TMPDIR=$(mktemp -d) -./merge_org.sh $TMPDIR/$INPUT -cd $TMPDIR - - -# Create documentation -emacs --batch \ - --load ${SRC}/../docs/htmlize.el \ - --load ${SRC}/../toold/init.el \ - $INPUT -f org-html-export-to-html - -if [[ $? -eq 0 ]] -then - rm -rf $TMPDIR - exit 0 -else - mv index.html ${SRC}/../docs/ - rm -rf $TMPDIR - exit 2 -fi - - diff --git a/src/merge_org.sh b/src/merge_org.sh deleted file mode 100755 index 61d182f..0000000 --- a/src/merge_org.sh +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/bash - -OUTPUT=$1 - -for i in README.org \ - qmckl.org \ - qmckl_context.org \ - qmckl_error.org \ - qmckl_precision.org \ - qmckl_memory.org \ - qmckl_distance.org \ - qmckl_ao.org \ - qmckl_footer.org \ - test_qmckl.org -do - cat $i >> $1 -done diff --git a/src/table_of_contents b/src/table_of_contents new file mode 100644 index 0000000..2fbbb05 --- /dev/null +++ b/src/table_of_contents @@ -0,0 +1,9 @@ +qmckl.org +qmckl_context.org +qmckl_error.org +qmckl_precision.org +qmckl_memory.org +qmckl_distance.org +qmckl_ao.org +test_qmckl.org +qmckl_footer.org diff --git a/tools/create_doc.sh b/tools/create_doc.sh new file mode 100755 index 0000000..a71845d --- /dev/null +++ b/tools/create_doc.sh @@ -0,0 +1,45 @@ +#!/bin/bash + +INPUT=merged.org +if [[ -z $QMCKL_ROOT ]] +then + print "QMCKL_ROOT is not defined" + exit 1 +fi + + +# Install htmlize if needed +[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || ( + cd ${QMCKL_ROOT}/docs/ + git clone https://github.com/hniksic/emacs-htmlize + cp emacs-htmlize/htmlize.el . + rm -rf emacs-htmlize + cd - +) + +[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || exit 1 + + +# Switch to TMPDIR for easy cleanup +TMPDIR=$(mktemp -d) +${QMCKL_ROOT}/tools/merge_org.sh $TMPDIR/$INPUT +cd $TMPDIR + + +# Create documentation +emacs --batch \ + --load ${QMCKL_ROOT}/docs/htmlize.el \ + --load ${QMCKL_ROOT}/tools/init.el \ + $INPUT -f org-html-export-to-html + +if [[ $? -eq 0 ]] +then + rm -rf $TMPDIR + exit 0 +else + mv index.html ${QMCKL_ROOT}/docs/ + rm -rf $TMPDIR + exit 2 +fi + + diff --git a/src/create_makefile.sh b/tools/create_makefile.sh similarity index 95% rename from src/create_makefile.sh rename to tools/create_makefile.sh index 20a1ec7..3e81c7d 100755 --- a/src/create_makefile.sh +++ b/tools/create_makefile.sh @@ -1,17 +1,18 @@ #!/bin/bash -INPUT=$1 -./merge_org.sh $INPUT +MERGED=merged.org +${QMCKL_ROOT}/tools/merge_org.sh $MERGED OUTPUT=Makefile.generated # Tangle org files emacs \ - $INPUT \ + $MERGED \ --batch \ -f org-babel-tangle \ --kill +rm $MERGED # Create the list of *.o files to be created diff --git a/tools/merge_org.sh b/tools/merge_org.sh new file mode 100755 index 0000000..97b749a --- /dev/null +++ b/tools/merge_org.sh @@ -0,0 +1,8 @@ +#!/bin/bash + +OUTPUT=$1 + +for i in README.org $(cat $QMCKL_ROOT/src/table_of_contents) +do + cat $i >> $1 +done From f26785b8294db7c796a5b1dc7f2dcefe5e297bf2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 19:36:46 +0100 Subject: [PATCH 11/65] Fixing makefile --- src/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile b/src/Makefile index d343eea..5631cd6 100644 --- a/src/Makefile +++ b/src/Makefile @@ -34,7 +34,7 @@ LIBS=-lm endif -QMCKL_ROOT=$(PWD)/.. +QMCKL_ROOT=$(CURDIR)/.. export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT From 0f15844bf33c92f5baceed4a2a15a2da39f77dec Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 19:40:01 +0100 Subject: [PATCH 12/65] Fixing doc generation --- tools/create_doc.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/tools/create_doc.sh b/tools/create_doc.sh index a71845d..aba0b93 100755 --- a/tools/create_doc.sh +++ b/tools/create_doc.sh @@ -29,6 +29,7 @@ cd $TMPDIR # Create documentation emacs --batch \ --load ${QMCKL_ROOT}/docs/htmlize.el \ + --load ${QMCKL_ROOT}/docs/config.el \ --load ${QMCKL_ROOT}/tools/init.el \ $INPUT -f org-html-export-to-html From dca597a3ab5437359f32241cc25386a14f6c5dfd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 19:46:27 +0100 Subject: [PATCH 13/65] Fixed doc creation --- docs/config.el | 27 +++++++++++++++++++++++++++ tools/create_doc.sh | 1 - tools/init.el | 2 +- 3 files changed, 28 insertions(+), 2 deletions(-) diff --git a/docs/config.el b/docs/config.el index 093ee8c..0a7f879 100755 --- a/docs/config.el +++ b/docs/config.el @@ -2,9 +2,36 @@ ;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting (package-initialize) +(add-to-list 'package-archives + '("gnu" . "https://elpa.gnu.org/packages/")) +(add-to-list 'package-archives + '("melpa-stable" . "https://stable.melpa.org/packages/")) +(add-to-list 'package-archives + '("melpa" . "https://melpa.org/packages/")) +(setq package-archive-priorities '(("melpa-stable" . 100) + ("melpa" . 50) + ("gnu" . 10))) + + (require 'htmlize) (require 'font-lock) (require 'subr-x) ;; for `when-let' +(setq org-confirm-babel-evaluate nil) +(global-font-lock-mode t) + +(org-babel-do-load-languages + 'org-babel-load-languages + '( + (emacs-lisp . t) + (shell . t) + (python . t) + (C . t) + (org . t) + (makefile . t) + )) + + + (unless (boundp 'maximal-integer) (defconst maximal-integer (lsh -1 -1) diff --git a/tools/create_doc.sh b/tools/create_doc.sh index aba0b93..38b34fa 100755 --- a/tools/create_doc.sh +++ b/tools/create_doc.sh @@ -30,7 +30,6 @@ cd $TMPDIR emacs --batch \ --load ${QMCKL_ROOT}/docs/htmlize.el \ --load ${QMCKL_ROOT}/docs/config.el \ - --load ${QMCKL_ROOT}/tools/init.el \ $INPUT -f org-html-export-to-html if [[ $? -eq 0 ]] diff --git a/tools/init.el b/tools/init.el index a5f9301..bc33d5e 100644 --- a/tools/init.el +++ b/tools/init.el @@ -46,7 +46,7 @@ (emacs-lisp . t) (shell . t) (python . t) - (C . t) + (C . t) (org . t) (makefile . t) )) From 09a862aa2b551c52e71bb2c6289a24c57ea204ce Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 19:49:55 +0100 Subject: [PATCH 14/65] Fixed website --- tools/create_doc.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/create_doc.sh b/tools/create_doc.sh index 38b34fa..104fb57 100755 --- a/tools/create_doc.sh +++ b/tools/create_doc.sh @@ -34,10 +34,10 @@ emacs --batch \ if [[ $? -eq 0 ]] then + mv index.html ${QMCKL_ROOT}/docs/ rm -rf $TMPDIR exit 0 else - mv index.html ${QMCKL_ROOT}/docs/ rm -rf $TMPDIR exit 2 fi From 479a0681995f21620aa31c52245c1acc0e3f085e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 19:56:36 +0100 Subject: [PATCH 15/65] testing workflow --- .github/workflows/gh-pages.yml | 2 +- tools/create_doc.sh | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 7cbcafa..1658ce6 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -24,7 +24,7 @@ jobs: run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el docs/ - name: make - run: make -C src/ doc + run: make -C src/ doc && ls docs/ - name: Deploy uses: peaceiris/actions-gh-pages@v3 diff --git a/tools/create_doc.sh b/tools/create_doc.sh index 104fb57..ecb5d7b 100755 --- a/tools/create_doc.sh +++ b/tools/create_doc.sh @@ -1,5 +1,7 @@ #!/bin/bash +set -x + INPUT=merged.org if [[ -z $QMCKL_ROOT ]] then From 02163ce52c698c111f09ddb54686ab7899175a86 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 20:05:36 +0100 Subject: [PATCH 16/65] Fixing website --- src/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile b/src/Makefile index 5631cd6..8d9ff83 100644 --- a/src/Makefile +++ b/src/Makefile @@ -34,7 +34,7 @@ LIBS=-lm endif -QMCKL_ROOT=$(CURDIR)/.. +QMCKL_ROOT=$(shell dirname $(CURDIR)) export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT From e318c6e56e0cea63da6ad6be7e0d175be5ebb32b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 20:14:26 +0100 Subject: [PATCH 17/65] Debug web site --- .github/workflows/gh-pages.yml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 1658ce6..8db5c03 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -24,7 +24,13 @@ jobs: run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el docs/ - name: make - run: make -C src/ doc && ls docs/ + run: make -C src/ doc && ls -sh ./docs/ + + - name: pwd + run: pwd + + - name: ls + run: ls -sh ./docs - name: Deploy uses: peaceiris/actions-gh-pages@v3 From cb1562de19f0e2c137368c9197be84a0040f24a2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 23:21:10 +0100 Subject: [PATCH 18/65] Debug github --- .github/workflows/gh-pages.yml | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 8db5c03..6b77119 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -32,9 +32,18 @@ jobs: - name: ls run: ls -sh ./docs - - name: Deploy - uses: peaceiris/actions-gh-pages@v3 - with: - github_token: ${{ secrets.GITHUB_TOKEN }} - publish_dir: ./docs +# - name: Deploy +# uses: peaceiris/actions-gh-pages@v3 +# with: +# github_token: ${{ secrets.GITHUB_TOKEN }} +# publish_dir: ./docs + + - name: Deploy + uses: JamesIves/github-pages-deploy-action@4.1.0 + with: + branch: gh-pages + folder: ./docs + +# github_token: ${{ secrets.GITHUB_TOKEN }} +# publish_dir: ./docs From a948aa6c4b58a2f202583278e1ce1d8f2fb97eab Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 23:26:35 +0100 Subject: [PATCH 19/65] Debug github --- .github/workflows/gh-pages.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 6b77119..4b2f1cf 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -42,7 +42,7 @@ jobs: uses: JamesIves/github-pages-deploy-action@4.1.0 with: branch: gh-pages - folder: ./docs + folder: ./ # github_token: ${{ secrets.GITHUB_TOKEN }} # publish_dir: ./docs From 5f2da3e9fad2ed958edf7b0651a35f6d203bf135 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 6 Mar 2021 23:27:48 +0100 Subject: [PATCH 20/65] Fixed website --- .github/workflows/gh-pages.yml | 2 +- docs/.gitignore | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) delete mode 100644 docs/.gitignore diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 4b2f1cf..6b77119 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -42,7 +42,7 @@ jobs: uses: JamesIves/github-pages-deploy-action@4.1.0 with: branch: gh-pages - folder: ./ + folder: ./docs # github_token: ${{ secrets.GITHUB_TOKEN }} # publish_dir: ./docs diff --git a/docs/.gitignore b/docs/.gitignore deleted file mode 100644 index 9d9cd60..0000000 --- a/docs/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -htmlize.el -index.html From 8153b84c7be24c73c3bbc77deed9aaf67c8ad07e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 7 Mar 2021 00:58:17 +0100 Subject: [PATCH 21/65] Working on configure.org --- .gitignore | 11 ++++ .gitmodules | 3 + configure.org | 137 +++++++++++++++++++++++++++++++++++++++++++ docs/org-html-themes | 1 + src/qmckl.org | 2 + 5 files changed, 154 insertions(+) create mode 100644 .gitignore create mode 100644 configure.org create mode 160000 docs/org-html-themes diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c7cf3cf --- /dev/null +++ b/.gitignore @@ -0,0 +1,11 @@ +docs/index.html +docs/htmlize.el +autom4te.cache/ +config.log +config.status +src/auto/ +src/ltximg/ +src/qmckl.mod +*.swp + + diff --git a/.gitmodules b/.gitmodules index 8ad4907..6d6dce9 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,6 @@ [submodule "munit"] path = munit url = https://github.com/nemequ/munit/ +[submodule "docs/org-html-themes"] + path = docs/org-html-themes + url = https://github.com/fniessen/org-html-themes.git diff --git a/configure.org b/configure.org new file mode 100644 index 0000000..010d101 --- /dev/null +++ b/configure.org @@ -0,0 +1,137 @@ +#+TITLE: QMCkl configuration + +This files contains al the information to generate the files required +by Autotools to build the =configure= script for the library. + +* Scripts analyzing source code + +** Version of the library + + #+NAME: version + #+BEGIN_SRC sh +echo 1.0 + #+END_SRC + + #+RESULTS: version + : 1.0 + + #+NAME: issues + #+BEGIN_SRC sh +echo "https://github.com/TREX-CoE/qmckl/issues" + #+END_SRC + + #+RESULTS: issues + : https://github.com/TREX-CoE/qmckl/issues + + #+NAME: website + #+BEGIN_SRC sh +echo "https://trex-coe.github.io/qmckl/index.html" + #+END_SRC + + #+RESULTS: website + : https://trex-coe.github.io/qmckl/index.html + + + #+NAME: revision + #+BEGIN_SRC sh +git log --oneline | head -1 + #+END_SRC + + #+RESULTS: revision + : 5f2da3e Fixed website + +** C Header files + + #+NAME: headers + #+BEGIN_SRC sh :tangle no +#grep --regexp="\#include\\s+<.*>" --no-filename src/*.org \ +grep --regexp="\#include\\s*<.*>" --no-filename src/*.org \ + | sort \ + | uniq \ + | cut -d '<' -f 2 \ + | cut -d '>' -f 1 \ + | tr '\n' ' ' + #+END_SRC + + #+RESULTS: headers + : assert.h errno.h math.h stdint.h stdlib.h string.h + + +* configure.ac + +** Initialization + + #+BEGIN_SRC sh :noweb yes :tangle configure.ac +# This file was generated from the org-mode file configure.org + +VERSION=[<>] +AC_SUBST([VERSION]) + +AC_REVISION([<>]) +AC_INIT([QMCkl],[<>], + [<>], [], + [<>]) + #+END_SRC + +** Source files + #+BEGIN_SRC sh :noweb yes :tangle configure.ac +AC_CONFIG_SRCDIR([src/README.org]) + #+END_SRC + +** C Compiler + + #+BEGIN_SRC sh :noweb yes :tangle configure.ac +AC_LANG_PUSH([C]) +AC_PROG_CC + +AC_CHECK_HEADERS([<>]) + #+END_SRC + +** Fortran Compiler + + #+BEGIN_SRC sh :noweb yes :tangle configure.ac +AC_PROG_FC([ifort gfortran flang],[Fortran]) +AC_PROG_FC_C_O +AC_FC_SRCEXT([f90]) +AC_FC_FREEFORM + #+END_SRC + +** External libraries + + #+BEGIN_SRC sh :tangle configure.ac +AC_CHECK_HEADER([munit/munit.h], [echo found], [echo not found] ) + +AC_CHECK_LIB([pthread], [pthread_create]) + +AC_SEARCH_LIBS([dgemm], [blas mkl], + [], + AC_MSG_ERROR([Unable to find a BLAS library]) + ]) + #+END_SRC + +** Makefile + + #+BEGIN_SRC sh :tangle configure.ac +AC_CONFIG_FILES(Makefile) + #+END_SRC + +** Library + + #+BEGIN_SRC sh :tangle configure.ac + + #+END_SRC + +** Documentation + + #+BEGIN_SRC sh :noweb yes :tangle configure.ac +AC_CHECK_PROGS([HAS_EMACS],[emacs],[]) + #+END_SRC + +** Finalization + + #+BEGIN_SRC sh :tangle configure.ac +AC_OUTPUT + #+END_SRC + +* Makefile.am + diff --git a/docs/org-html-themes b/docs/org-html-themes new file mode 160000 index 0000000..f7224a4 --- /dev/null +++ b/docs/org-html-themes @@ -0,0 +1 @@ +Subproject commit f7224a489462abc2c2174edbf7d4e82c0e276183 diff --git a/src/qmckl.org b/src/qmckl.org index 985f848..22cd3aa 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -3,6 +3,7 @@ The =qmckl.h= header file has to be included in <<>> codes when QMCkl functions are used: + #+BEGIN_SRC C :tangle none #include "qmckl.h" #+END_SRC f90 @@ -11,6 +12,7 @@ In <<>> programs, the =qmckl_f.f90= interface file should be included in the source code using the library, and the Fortran codes should use the ~qmckl~ module as + #+BEGIN_SRC f90 :tangle none use qmckl #+END_SRC f90 From 342c33767762934c17c3e02d971ea4a481525ae1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 9 Mar 2021 01:16:23 +0100 Subject: [PATCH 22/65] Separated org-mode files --- docs/theme.setup | 7 + src/Makefile | 107 ++- src/README.org | 2 +- src/qmckl.org | 45 +- src/qmckl_ao.org | 391 +++++------ src/qmckl_context.org | 805 ++++++++++++----------- src/qmckl_distance.org | 133 ++-- src/qmckl_error.org | 253 +++---- src/qmckl_footer.org | 10 - src/qmckl_memory.org | 140 ++-- src/qmckl_precision.org | 69 +- src/table_of_contents | 16 +- src/test_qmckl.org | 39 +- tools/Building.org | 406 ++++++++++++ tools/build_qmckl_h.sh | 164 +++++ docs/config.el => tools/config_tangle.el | 14 + tools/create_makefile.sh | 83 +-- tools/init.el | 18 +- tools/tangle.sh | 37 ++ 19 files changed, 1720 insertions(+), 1019 deletions(-) create mode 100644 docs/theme.setup create mode 100644 tools/Building.org create mode 100755 tools/build_qmckl_h.sh rename docs/config.el => tools/config_tangle.el (88%) create mode 100755 tools/tangle.sh diff --git a/docs/theme.setup b/docs/theme.setup new file mode 100644 index 0000000..c56aee9 --- /dev/null +++ b/docs/theme.setup @@ -0,0 +1,7 @@ +# -*- mode: org; -*- + +#+HTML_LINK_HOME: index.html +#+OPTIONS: H:4 num:t toc:t \n:nil @:t ::t |:t ^:t -:t f:t *:t <:t +#+SETUPFILE: ../docs/org-html-themes/org/theme-readtheorg.setup + + diff --git a/src/Makefile b/src/Makefile index 8d9ff83..90ee33a 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,37 +1,9 @@ -COMPILER=GNU -#COMPILER=INTEL -#COMPILER=LLVM +# Header :noexport: -ifeq ($(COMPILER),GNU) -CC=gcc -g -CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -FC=gfortran -g -FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan +# This file was created by tools/Building.org -LIBS=-lgfortran -lm -endif - -ifeq ($(COMPILER),INTEL) -CC=icc -xHost -CFLAGS=-fPIC -g -O2 - -FC=ifort -xHost -FFLAGS=-fPIC -g -O2 - -LIBS=-lm -lifcore -lirc -endif - -#TODO -ifeq ($(COMPILER),LLVM) -CC=clang -CFLAGS=-fPIC -g -O2 - -FC=flang -FFLAGS=fPIC -g -O2 - -LIBS=-lm -endif +# Variables QMCKL_ROOT=$(shell dirname $(CURDIR)) @@ -40,6 +12,70 @@ export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT ORG_SOURCE_FILES=$(wildcard *.org) OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) +INCLUDE=-I$(QMCKL_ROOT)/include/ + +# Compiler options + +# GNU, Intel and LLVM compilers are supported. Choose here: + + +COMPILER=GNU +#COMPILER=INTEL +#COMPILER=LLVM + +# GNU + + +ifeq ($(COMPILER),GNU) +#---------------------------------------------------------- +CC=gcc -g +CFLAGS=-fPIC $(INCLUDE) \ + -fexceptions -Wall -Werror -Wpedantic -Wextra -fmax-errors=3 + +FC=gfortran -g +FFLAGS=-fPIC $(INCLUDE) \ + -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising \ + -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation \ + -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ + -ffpe-trap=zero,overflow,underflow + +LIBS=-lgfortran -lm +#---------------------------------------------------------- +endif + +# Intel + + +ifeq ($(COMPILER),INTEL) +#---------------------------------------------------------- +CC=icc -xHost +CFLAGS=-fPIC -g -O2 $(INCLUDE) + +FC=ifort -xHost +FFLAGS=-fPIC -g -O2 $(INCLUDE) + +LIBS=-lm -lifcore -lirc +#---------------------------------------------------------- +CC=icc -xHost +endif + +# LLVM + + +ifeq ($(COMPILER),LLVM) +#---------------------------------------------------------- +CC=clang +CFLAGS=-fPIC -g -O2 $(INCLUDE) + +FC=flang +FFLAGS=fPIC -g -O2 $(INCLUDE) + +LIBS=-lm +#---------------------------------------------------------- +endif + +# Rules + .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files @@ -50,14 +86,13 @@ libqmckl.so: Makefile.generated test: Makefile.generated $(MAKE) -f Makefile.generated test - doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_doc.sh - clean: - rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod + $(RM) qmckl.h test_qmckl_* test_qmckl.c test_qmckl \ + qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ + Makefile.generated libqmckl.so *.html *.mod Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) - $(QMCKL_ROOT)/tools/create_makefile.sh - + $(QMCKL_ROOT)/tools/create_makefile.sh diff --git a/src/README.org b/src/README.org index a2c2c9e..d09949d 100644 --- a/src/README.org +++ b/src/README.org @@ -1,8 +1,8 @@ #+TITLE: QMCkl source code documentation #+EXPORT_FILE_NAME: index.html #+PROPERTY: comments org +#+SETUPFILE: ../docs/theme.setup -#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup * Introduction diff --git a/src/qmckl.org b/src/qmckl.org index 22cd3aa..b9a736f 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -1,38 +1,19 @@ +#+TITLE: Header files +#+SETUPFILE: ../docs/theme.setup -** =qmckl.h= header file +The =qmckl.h= header file has to be included in <<>> codes when +QMCkl functions are used: - The =qmckl.h= header file has to be included in <<>> codes when - QMCkl functions are used: - - #+BEGIN_SRC C :tangle none - #include "qmckl.h" - #+END_SRC f90 +#+begin_src c :tangle none +#include "qmckl.h" +#+end_src f90 - In <<>> programs, the =qmckl_f.f90= interface file should be - included in the source code using the library, and the Fortran codes - should use the ~qmckl~ module as +In <<>> programs, the =qmckl_f.f90= interface file should be +included in the source code using the library, and the Fortran codes +should use the ~qmckl~ module as - #+BEGIN_SRC f90 :tangle none - use qmckl - #+END_SRC f90 +#+begin_src f90 :tangle none +use qmckl +#+end_src f90 -*** Top of header files :noexport: - - #+BEGIN_SRC C :tangle qmckl.h :noweb yes -#ifndef QMCKL_H -#define QMCKL_H -#include -#include - -<> - - #+END_SRC - - #+BEGIN_SRC f90 :tangle qmckl_f.f90 -module qmckl - use, intrinsic :: iso_c_binding - #+END_SRC - - The bottoms of the files are located in the [[qmckl_footer.org]] file. - diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index b0f9671..5430b06 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -1,91 +1,89 @@ -** Atomic Orbitals - :PROPERTIES: - :f: qmckl_ao.f90 - :c_test: test_qmckl_ao.c - :fh: qmckl_f.f90 - :h: qmckl.h - :f_test: test_qmckl_ao_f.f90 - :END: +#+TITLE: Atomic Orbitals +#+SETUPFILE: ../docs/theme.setup + + The routines for the computation of the values, gradients and + Laplacian of atomic basis functions are defined here. + +* Headers :noexport: + + #+NAME: filename + #+begin_src elisp tangle: no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src - This files contains all the routines for the computation of the - values, gradients and Laplacian of the atomic basis functions. - - 3 files are produced: - - a source file : =qmckl_ao.f90= - - a C test file : =test_qmckl_ao.c= - - a Fortran test file : =test_qmckl_ao_f.f90= - -*** Test :noexport: - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) + #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" -MunitResult test_qmckl_ao() { +MunitResult test_<>() { qmckl_context context; context = qmckl_context_create(); - #+END_SRC + #+end_src -*** Polynomials +* Polynomials - \[ - P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c - \] + \[ + P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c + \] - \begin{eqnarray*} - \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ - \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ - \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ - \end{eqnarray*} + \begin{eqnarray*} + \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ + \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ + \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ + \end{eqnarray*} - \begin{eqnarray*} - \left( \frac{\partial }{\partial x^2} + - \frac{\partial }{\partial y^2} + - \frac{\partial }{\partial z^2} \right) P_l - \left(\mathbf{r},\mathbf{R}_i \right) & = & - a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ - && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ - && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} - \end{eqnarray*} + \begin{eqnarray*} + \left( \frac{\partial }{\partial x^2} + + \frac{\partial }{\partial y^2} + + \frac{\partial }{\partial z^2} \right) P_l + \left(\mathbf{r},\mathbf{R}_i \right) & = & + a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ + && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ + && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} + \end{eqnarray*} -**** ~qmckl_ao_power~ +** <<<~qmckl_ao_power~>>> - Computes all the powers of the ~n~ input data up to the given - maximum value given in input for each of the $n$ points: + Computes all the powers of the ~n~ input data up to the given + maximum value given in input for each of the $n$ points: - \[ P_{ij} = X_j^i \] + \[ P_{ij} = X_j^i \] -***** Arguments +*** Arguments - | ~context~ | input | Global state | - | ~n~ | input | Number of values | - | ~X(n)~ | input | Array containing the input values | - | ~LMAX(n)~ | input | Array containing the maximum power for each value | - | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | - | ~LDP~ | input | Leading dimension of array ~P~ | + | ~context~ | input | Global state | + | ~n~ | input | Number of values | + | ~X(n)~ | input | Array containing the input values | + | ~LMAX(n)~ | input | Array containing the maximum power for each value | + | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | + | ~LDP~ | input | Leading dimension of array ~P~ | -***** Requirements +*** Requirements - - ~context~ is not 0 - - ~n~ > 0 - - ~X~ is allocated with at least $n \times 8$ bytes - - ~LMAX~ is allocated with at least $n \times 4$ bytes - - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - - ~LDP~ >= $\max_i$ ~LMAX[i]~ + - ~context~ is not 0 + - ~n~ > 0 + - ~X~ is allocated with at least $n \times 8$ bytes + - ~LMAX~ is allocated with at least $n \times 4$ bytes + - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - ~LDP~ >= $\max_i$ ~LMAX[i]~ -***** Header - #+BEGIN_SRC C :tangle (org-entry-get nil "h" t) -qmckl_exit_code qmckl_ao_power(const qmckl_context context, - const int64_t n, - const double *X, const int32_t *LMAX, - const double *P, const int64_t LDP); - #+END_SRC +*** Header + #+begin_src c :tangle (eval h) +qmckl_exit_code +qmckl_ao_power(const qmckl_context context, + const int64_t n, + const double *X, + const int32_t *LMAX, + const double *P, + const int64_t LDP); + #+end_src -***** Source - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) +*** Source + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) implicit none integer*8 , intent(in) :: context @@ -117,10 +115,10 @@ integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) end do end function qmckl_ao_power_f - #+END_SRC + #+end_src -***** C interface :noexport: - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) +*** C interface :noexport: + #+begin_src f90 :tangle (eval f) integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -135,9 +133,9 @@ integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & integer, external :: qmckl_ao_power_f info = qmckl_ao_power_f(context, n, X, LMAX, P, ldp) end function qmckl_ao_power - #+END_SRC + #+end_src - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) + #+begin_src f90 :tangle (eval fh) interface integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C) use, intrinsic :: iso_c_binding @@ -149,10 +147,10 @@ end function qmckl_ao_power real (c_double) , intent(out) :: P(ldp,n) end function qmckl_ao_power end interface - #+END_SRC + #+end_src -***** Test :noexport: - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f_test" t) +*** Test :noexport: + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) use qmckl implicit none @@ -195,68 +193,72 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) test_qmckl_ao_power = 0 deallocate(X,P,LMAX) end function test_qmckl_ao_power - #+END_SRC + #+end_src - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) + #+begin_src c :tangle (eval c_test) int test_qmckl_ao_power(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_power(context)); - #+END_SRC + #+end_src - -**** ~qmckl_ao_polynomial_vgl~ +** <<<~qmckl_ao_polynomial_vgl~>>> - Computes the values, gradients and Laplacians at a given point of - all polynomials with an angular momentum up to ~lmax~. + Computes the values, gradients and Laplacians at a given point of + all polynomials with an angular momentum up to ~lmax~. + +*** Arguments -***** Arguments - - | ~context~ | input | Global state | - | ~X(3)~ | input | Array containing the coordinates of the points | - | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~lmax~ | input | Maximum angular momentum | - | ~n~ | output | Number of computed polynomials | - | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | - | ~ldl~ | input | Leading dimension of ~L~ | - | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | - | ~ldv~ | input | Leading dimension of array ~VGL~ | + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~lmax~ | input | Maximum angular momentum | + | ~n~ | output | Number of computed polynomials | + | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | + | ~ldl~ | input | Leading dimension of ~L~ | + | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | + | ~ldv~ | input | Leading dimension of array ~VGL~ | -***** Requirements +*** Requirements - - ~context~ is not 0 - - ~n~ > 0 - - ~lmax~ >= 0 - - ~ldl~ >= 3 - - ~ldv~ >= 5 - - ~X~ is allocated with at least $3 \times 8$ bytes - - ~R~ is allocated with at least $3 \times 8$ bytes - - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ - - ~L~ is allocated with at least $3 \times n \times 4$ bytes - - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes - - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ - - On output, the powers are given in the following order (l=a+b+c): - - Increase values of ~l~ - - Within a given value of ~l~, alphabetical order of the - string made by a*"x" + b*"y" + c*"z" (in Python notation). - For example, with a=0, b=2 and c=1 the string is "yyz" + - ~context~ is not 0 + - ~n~ > 0 + - ~lmax~ >= 0 + - ~ldl~ >= 3 + - ~ldv~ >= 5 + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ + - ~L~ is allocated with at least $3 \times n \times 4$ bytes + - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes + - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ + - On output, the powers are given in the following order (l=a+b+c): + - Increase values of ~l~ + - Within a given value of ~l~, alphabetical order of the + string made by a*"x" + b*"y" + c*"z" (in Python notation). + For example, with a=0, b=2 and c=1 the string is "yyz" -***** Error codes +*** Error codes - | -1 | Null context | - | -2 | Inconsistent ~ldl~ | - | -3 | Inconsistent ~ldv~ | - | -4 | Inconsistent ~lmax~ | + | -1 | Null context | + | -2 | Inconsistent ~ldl~ | + | -3 | Inconsistent ~ldv~ | + | -4 | Inconsistent ~lmax~ | -***** Header - #+BEGIN_SRC C :tangle (org-entry-get nil "h" t) -qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, - const double *X, const double *R, - const int32_t lmax, const int64_t *n, - const int32_t *L, const int64_t ldl, - const double *VGL, const int64_t ldv); - #+END_SRC +*** Header + #+begin_src c :tangle (eval h) +qmckl_exit_code +qmckl_ao_polynomial_vgl(const qmckl_context context, + const double *X, + const double *R, + const int32_t lmax, + const int64_t *n, + const int32_t *L, + const int64_t ldl, + const double *VGL, + const int64_t ldv); + #+end_src -***** Source - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) +*** Source + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -383,10 +385,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, info = 0 end function qmckl_ao_polynomial_vgl_f - #+END_SRC + #+end_src -***** C interface :noexport: - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) +*** C interface :noexport: + #+begin_src f90 :tangle (eval f) integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -403,10 +405,10 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l integer, external :: qmckl_ao_polynomial_vgl_f info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) end function qmckl_ao_polynomial_vgl - #+END_SRC + #+end_src -***** Fortran interface :noexport: - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface :noexport: + #+begin_src f90 :tangle (eval fh) interface integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) @@ -421,9 +423,9 @@ end function qmckl_ao_polynomial_vgl real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) end function qmckl_ao_polynomial_vgl end interface - #+END_SRC -***** Test :noexport: - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f_test" t) + #+end_src +*** Test :noexport: + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl implicit none @@ -516,57 +518,61 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) deallocate(L,VGL) end function test_qmckl_ao_polynomial_vgl - #+END_SRC + #+end_src - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) + #+begin_src c :tangle (eval c_test) int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - #+END_SRC + #+end_src -*** Gaussian basis functions +* Gaussian basis functions -**** ~qmckl_ao_gaussian_vgl~ +** <<<~qmckl_ao_gaussian_vgl~>>> - Computes the values, gradients and Laplacians at a given point of - ~n~ Gaussian functions centered at the same point: + Computes the values, gradients and Laplacians at a given point of + ~n~ Gaussian functions centered at the same point: - \[ v_i = \exp(-a_i |X-R|^2) \] - \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] - \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] - \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] - \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] + \[ v_i = \exp(-a_i |X-R|^2) \] + \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] + \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] + \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] + \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] -***** Arguments +*** Arguments - | ~context~ | input | Global state | - | ~X(3)~ | input | Array containing the coordinates of the points | - | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~n~ | input | Number of computed gaussians | - | ~A(n)~ | input | Exponents of the Gaussians | - | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | - | ~ldv~ | input | Leading dimension of array ~VGL~ | + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~n~ | input | Number of computed gaussians | + | ~A(n)~ | input | Exponents of the Gaussians | + | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | + | ~ldv~ | input | Leading dimension of array ~VGL~ | -***** Requirements +*** Requirements - - ~context~ is not 0 - - ~n~ > 0 - - ~ldv~ >= 5 - - ~A(i)~ > 0 for all ~i~ - - ~X~ is allocated with at least $3 \times 8$ bytes - - ~R~ is allocated with at least $3 \times 8$ bytes - - ~A~ is allocated with at least $n \times 8$ bytes - - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes + - ~context~ is not 0 + - ~n~ > 0 + - ~ldv~ >= 5 + - ~A(i)~ > 0 for all ~i~ + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~A~ is allocated with at least $n \times 8$ bytes + - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes -***** Header - #+BEGIN_SRC C :tangle (org-entry-get nil "h" t) -qmckl_exit_code qmckl_ao_gaussian_vgl(const qmckl_context context, - const double *X, const double *R, - const int64_t *n, const int64_t *A, - const double *VGL, const int64_t ldv); - #+END_SRC +*** Header + #+begin_src c :tangle (eval h) +qmckl_exit_code +qmckl_ao_gaussian_vgl(const qmckl_context context, + const double *X, + const double *R, + const int64_t *n, + const int64_t *A, + const double *VGL, + const int64_t ldv); + #+end_src -***** Source - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) +*** Source + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -626,10 +632,10 @@ integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(i end do end function qmckl_ao_gaussian_vgl_f - #+END_SRC + #+end_src -***** C interface :noexport: - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f" t) +*** C interface :noexport: + #+begin_src f90 :tangle (eval f) integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -644,9 +650,9 @@ integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) integer, external :: qmckl_ao_gaussian_vgl_f info = qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) end function qmckl_ao_gaussian_vgl - #+END_SRC + #+end_src - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) + #+begin_src f90 :tangle (eval fh) interface integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) @@ -658,9 +664,9 @@ end function qmckl_ao_gaussian_vgl real (c_double) , intent(out) :: VGL(ldv,5) end function qmckl_ao_gaussian_vgl end interface - #+END_SRC -***** Test :noexport: - #+BEGIN_SRC f90 :tangle (org-entry-get nil "f_test" t) + #+end_src +*** Test :noexport: + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) use qmckl implicit none @@ -725,27 +731,26 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) deallocate(VGL) end function test_qmckl_ao_gaussian_vgl - #+END_SRC + #+end_src - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) -int test_qmckl_ao_gaussian_vgl(qmckl_context context); + #+begin_src c :tangle (eval c_test) :exports none +int test_qmckl_ao_gaussian_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); - #+END_SRC + #+end_src - -*** TODO Slater basis functions +* TODO Slater basis functions -*** End of files :noexport: +* End of files :noexport: -***** Test - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) +*** Test + #+begin_src c :tangle (eval c_test) if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return MUNIT_OK; } - #+END_SRC + #+end_src - # -*- mode: org -*- - # vim: syntax=c +# -*- mode: org -*- +# vim: syntax=c diff --git a/src/qmckl_context.org b/src/qmckl_context.org index fc8f0da..6edfe2c 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,101 +1,78 @@ -** Context - :PROPERTIES: - :c: qmckl_context.c - :c_test: test_qmckl_context.c - :fh: qmckl_f.f90 - :h: qmckl.h - :END: +#+TITLE: Context +#+SETUPFILE: ../docs/theme.setup - This file is written in C because it is more natural to express the - context in C than in Fortran. + This file is written in C because it is more natural to express the + context in C than in Fortran. - 2 files are produced: - - a source file : =qmckl_context.c= - - a test file : =test_qmckl_context.c= + The context variable is a handle for the state of the library, + and is stored in a data structure, which can't be seen outside of + the library. To simplify compatibility with other languages, the + pointer to the internal data structure is converted into a 64-bit + signed integer, defined in the ~qmckl_context~ type. A value of ~0~ + for the context is equivalent to a ~NULL~ pointer. -*** Headers :noexport: - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) -#include "qmckl.h" -#include -#include -#include - #+END_SRC + #+begin_src c :comments org :tangle (eval h) +typedef int64_t qmckl_context ; + #+end_src - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) +* Headers :noexport: + + #+NAME: filename + #+begin_src elisp tangle: no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src + + + #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" -MunitResult test_qmckl_context() { - #+END_SRC +MunitResult test_<>() { + #+end_src -*** Context + #+begin_src c :tangle (eval h_private) +#ifndef __QMCKL_CONTEXT__ +#define __QMCKL_CONTEXT__ - The <<>> variable is a handle for the state of the library, and - is stored in the following data structure, which can't be seen - outside of the library. To simplify compatibility with other - languages, the pointer to the internal data structure is converted - into a 64-bit signed integer, defined in the ~qmckl_context~ type. - A value of ~0~ for the context is equivalent to a ~NULL~ pointer. +#include +#include "qmckl_error.h" - #+BEGIN_SRC C :comments org :tangle qmckl.h -typedef int64_t qmckl_context ; - #+END_SRC + #+end_src -**** Data for error handling + #+begin_src c :tangle (eval c) +#include +#include +#include +#include +#include - We define here the the data structure containing the strings - necessary for error handling. - - #+BEGIN_SRC C :comments org :tangle qmckl.h -#define QMCKL_MAX_FUN_LEN 256 -#define QMCKL_MAX_MSG_LEN 1024 +#include "qmckl_error.h" +#include "qmckl_context_private.h" +#include "qmckl_context.h" +#include "qmckl_memory.h" +#include "qmckl_precision.h" -typedef struct qmckl_error_struct { + #+end_src - qmckl_exit_code exit_code; - char function[QMCKL_MAX_FUN_LEN]; - char message [QMCKL_MAX_MSG_LEN]; -} qmckl_error_struct; - #+END_SRC +* Context handling - -**** Basis set data structure + The tag is used internally to check if the memory domain pointed + by a pointer is a valid <<>>. - Data structure for the info related to the atomic orbitals - basis set. + #+begin_src c :comments org :tangle (eval h_private) :noweb yes +<> +<> - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) -typedef struct qmckl_ao_basis_struct { - - int64_t shell_num; - int64_t prim_num; - int64_t * shell_center; - int32_t * shell_ang_mom; - double * shell_factor; - double * exponent ; - double * coefficient ; - int64_t * shell_prim_num; - char type; - -} qmckl_ao_basis_struct; - #+END_SRC - -***** Source - - The tag is used internally to check if the memory domain pointed - by a pointer is a valid context. - - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; /* Molecular system */ - // struct qmckl_nucleus_struct * nucleus; - // struct qmckl_electron_struct * electron; - struct qmckl_ao_basis_struct * ao_basis; - // struct qmckl_mo_struct * mo; - // struct qmckl_determinant_struct * det; + // qmckl_nucleus_struct * nucleus; + // qmckl_electron_struct * electron; + qmckl_ao_basis_struct * ao_basis; + // qmckl_mo_struct * mo; + // qmckl_determinant_struct * det; /* Numerical precision */ uint32_t tag; @@ -103,105 +80,26 @@ typedef struct qmckl_context_struct { int32_t range; /* Error handling */ - struct qmckl_error_struct * error; + qmckl_error_struct * error; } qmckl_context_struct; #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF - #+END_SRC + #+end_src -**** ~qmckl_context_update_error~ +** ~qmckl_context_check~ - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) -qmckl_exit_code -qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); - #+END_SRC + Checks if the domain pointed by the pointer is a valid context. + Returns the input ~qmckl_context~ if the context is valid, 0 + otherwise. -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) -qmckl_exit_code -qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) -{ - assert (context != 0); - assert (function != NULL); - assert (message != NULL); - assert (exit_code > 0); - assert (exit_code < QMCKL_INVALID_EXIT_CODE); - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; - - if (ctx->error != NULL) { - free(ctx->error); - ctx->error = NULL; - } - - qmckl_error_struct* error = (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); - error->exit_code = exit_code; - strcpy(error->function, function); - strcpy(error->message, message); - - ctx->error = error; - - return QMCKL_SUCCESS; -} - #+END_SRC - -***** TODO Test - -**** ~qmckl_context_set_error~ - - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) -qmckl_context -qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); - #+END_SRC - -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) -qmckl_context -qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) -{ - assert (context != 0); - assert (function != NULL); - assert (message != NULL); - assert (exit_code > 0); - assert (exit_code < QMCKL_INVALID_EXIT_CODE); - - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return context; - - if (qmckl_context_update_error(new_context, exit_code, - function, message) != QMCKL_SUCCESS) { - return context; - } - - return new_context; -} - #+END_SRC - -***** TODO Test - -***** Test :noexport: - - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) -qmckl_context context; -qmckl_context new_context; - #+END_SRC - - -**** ~qmckl_context_check~ - - Checks if the domain pointed by the pointer is a valid context. - Returns the input ~qmckl_context~ if the context is valid, 0 - otherwise. - - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+begin_src c :comments org :tangle (eval h) qmckl_context qmckl_context_check(const qmckl_context context) ; - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_check(const qmckl_context context) { if (context == (qmckl_context) 0) return (qmckl_context) 0; @@ -212,20 +110,20 @@ qmckl_context qmckl_context_check(const qmckl_context context) { return context; } - #+END_SRC + #+end_src -**** ~qmckl_context_create~ +** ~qmckl_context_create~ - To create a new context, use ~qmckl_context_create()~. - - On success, returns a pointer to a context using the ~qmckl_context~ type - - Returns ~0~ upon failure to allocate the internal data structure + To create a new context, use ~qmckl_context_create()~. + - On success, returns a pointer to a context using the ~qmckl_context~ type + - Returns ~0~ upon failure to allocate the internal data structure - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+begin_src c :comments org :tangle (eval h) qmckl_context qmckl_context_create(); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_create() { qmckl_context_struct* context = @@ -243,38 +141,38 @@ qmckl_context qmckl_context_create() { return (qmckl_context) context; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int64_t) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding end function qmckl_context_create end interface - #+END_SRC + #+end_src -***** Test :noexport: - #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) -context = qmckl_context_create(); +*** Test :noexport: + #+begin_src c :comments link :tangle (eval c_test) +qmckl_context context = qmckl_context_create(); munit_assert_int64( context, !=, (qmckl_context) 0); munit_assert_int64( qmckl_context_check(context), ==, context); - #+END_SRC + #+end_src -**** ~qmckl_context_copy~ +** ~qmckl_context_copy~ - This function makes a shallow copy of the current context. - - Copying the 0-valued context returns 0 - - On success, returns a pointer to the new context using the ~qmckl_context~ type - - Returns 0 upon failure to allocate the internal data structure - for the new context + This function makes a shallow copy of the current context. + - Copying the 0-valued context returns 0 + - On success, returns a pointer to the new context using the ~qmckl_context~ type + - Returns 0 upon failure to allocate the internal data structure + for the new context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+begin_src c :comments org :tangle (eval h) qmckl_context qmckl_context_copy(const qmckl_context context); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_copy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -301,39 +199,39 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { return (qmckl_context) new_context; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int64_t) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_copy end interface - #+END_SRC + #+end_src -***** Test :noexport: - #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) -new_context = qmckl_context_copy(context); +*** Test :noexport: + #+begin_src c :comments link :tangle (eval c_test) +qmckl_context new_context = qmckl_context_copy(context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); - #+END_SRC + #+end_src -**** ~qmckl_context_previous~ +** ~qmckl_context_previous~ - Returns the previous context - - On success, returns the ancestor of the current context - - Returns 0 for the initial context - - Returns 0 for the 0-valued context + Returns the previous context + - On success, returns the ancestor of the current context + - Returns 0 for the initial context + - Returns 0 for the 0-valued context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+begin_src c :comments org :tangle (eval h) qmckl_context qmckl_context_previous(const qmckl_context context); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -344,40 +242,40 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; return qmckl_context_check((qmckl_context) ctx->prev); } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int64_t) function qmckl_context_previous(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_previous end interface - #+END_SRC + #+end_src -***** Test :noexport: - #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) +*** Test :noexport: + #+begin_src c :comments link :tangle (eval c_test) munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous(new_context), ==, context); munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); - #+END_SRC + #+end_src -**** ~qmckl_context_destroy~ +** ~qmckl_context_destroy~ - Destroys the current context, leaving the ancestors untouched. - - Succeeds if the current context is properly destroyed - - Fails otherwise - - Fails if the 0-valued context is given in argument - - Fails if the the pointer is not a valid context + Destroys the current context, leaving the ancestors untouched. + - Succeeds if the current context is properly destroyed + - Fails otherwise + - Fails if the 0-valued context is given in argument + - Fails if the the pointer is not a valid context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+begin_src c :comments org :tangle (eval h) qmckl_exit_code qmckl_context_destroy(qmckl_context context); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -389,33 +287,170 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { ctx->tag = INVALID_TAG; return qmckl_free(context,ctx); } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int32_t) function qmckl_context_destroy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_destroy end interface - #+END_SRC + #+end_src -***** Test :noexport: - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) +*** Test :noexport: + #+begin_src c :tangle (eval c_test) munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); munit_assert_int64(qmckl_context_check(new_context), !=, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); - #+END_SRC + #+end_src -**** Basis set +* Error handling +** Data structure + + #+NAME: qmckl_error_struct + #+begin_src c :comments org +#define QMCKL_MAX_FUN_LEN 256 +#define QMCKL_MAX_MSG_LEN 1024 - For H_2 with the following basis set, +typedef struct qmckl_error_struct { - #+BEGIN_EXAMPLE + qmckl_exit_code exit_code; + char function[QMCKL_MAX_FUN_LEN]; + char message [QMCKL_MAX_MSG_LEN]; + +} qmckl_error_struct; + #+end_src + +** ~qmckl_context_update_error~ + + #+begin_src c :comments org :tangle (eval h) +qmckl_exit_code +qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); + #+end_src + +*** Source + #+begin_src c :tangle (eval c) +qmckl_exit_code +qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +{ + assert (context != 0); + assert (function != NULL); + assert (message != NULL); + assert (exit_code > 0); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + if (ctx == NULL) return QMCKL_FAILURE; + + if (ctx->error != NULL) { + free(ctx->error); + ctx->error = NULL; + } + + qmckl_error_struct* error = (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); + error->exit_code = exit_code; + strcpy(error->function, function); + strcpy(error->message, message); + + ctx->error = error; + + return QMCKL_SUCCESS; +} + #+end_src + +*** TODO Test + +** ~qmckl_context_set_error~ + + #+begin_src c :comments org :tangle (eval h) +qmckl_context +qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); + #+end_src + +*** Source + #+begin_src c :tangle (eval c) +qmckl_context +qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +{ + assert (context != 0); + assert (function != NULL); + assert (message != NULL); + assert (exit_code > 0); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + + qmckl_context new_context = qmckl_context_copy(context); + if (new_context == 0) return context; + + if (qmckl_context_update_error(new_context, exit_code, + function, message) != QMCKL_SUCCESS) { + return context; + } + + return new_context; +} + #+end_src + +*** TODO Test + +*** Test :noexport: + +** ~qmckl_failwith~ + + To make a function fail, the <<<~qmckl_failwith~>>> function should be + called, such that information about the failure is stored in + the context. The desired exit code is given as an argument, as + well as the name of the function and an error message. The return + code of the function is the desired return code. + + #+begin_src c :comments org :tangle (eval h) +qmckl_exit_code qmckl_failwith(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function, + const char* message) ; + #+end_src + + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_failwith(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function, + const char* message) { + + if (context == 0) return QMCKL_NULL_CONTEXT; + assert (exit_code > 0); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + assert (function != NULL); + assert (message != NULL); + assert (strlen(function) < QMCKL_MAX_FUN_LEN); + assert (strlen(message) < QMCKL_MAX_MSG_LEN); + + context = qmckl_context_set_error(context, exit_code, function, message); + return exit_code; +} + + #+end_src + + For example, this function can be used as + #+begin_src c :tangle no +if (x < 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_function", + "Expected x >= 0"); + } + #+end_src + + # To decode the error messages, ~qmckl_strerror~ converts an + # error code into a string. +* Basis set + + For H_2 with the following basis set, + + #+BEGIN_EXAMPLE HYDROGEN S 5 1 3.387000E+01 6.068000E-03 @@ -433,11 +468,11 @@ P 1 1 3.880000E-01 1.000000E+00 D 1 1 1.057000E+00 1.0000000 - #+END_EXAMPLE + #+END_EXAMPLE - we have: + we have: - #+BEGIN_EXAMPLE + #+BEGIN_EXAMPLE type = 'G' shell_num = 12 prim_num = 20 @@ -451,24 +486,43 @@ EXPONENT = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0] - #+END_EXAMPLE + #+END_EXAMPLE -**** ~qmckl_context_update_ao_basis~ +** Data structure - Updates the data describing the AO basis set into the context. + #+NAME: qmckl_ao_basis_struct + #+begin_src c :comments org :tangle no +typedef struct qmckl_ao_basis_struct { - | ~type~ | Gaussian or Slater | - | ~shell_num~ | Number of shells | - | ~prim_num~ | Total number of primitives | - | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | - | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | - | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | - | ~EXPONENT(prim_num)~ | Array of exponents | - | ~COEFFICIENT(prim_num)~ | Array of coefficients | + int64_t shell_num; + int64_t prim_num; + int64_t * shell_center; + int32_t * shell_ang_mom; + double * shell_factor; + double * exponent ; + double * coefficient ; + int64_t * shell_prim_num; + char type; - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +} qmckl_ao_basis_struct; + #+end_src + +** ~qmckl_context_update_ao_basis~ + + Updates the data describing the AO basis set into the context. + + | ~type~ | Gaussian or Slater | + | ~shell_num~ | Number of shells | + | ~prim_num~ | Total number of primitives | + | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | + | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | + | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | + | ~EXPONENT(prim_num)~ | Array of exponents | + | ~COEFFICIENT(prim_num)~ | Array of coefficients | + + #+begin_src c :comments org :tangle (eval h) qmckl_exit_code qmckl_context_update_ao_basis(qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -476,10 +530,10 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, const double * EXPONENT , const double * COEFFICIENT); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_context_update_ao_basis(qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -591,10 +645,10 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type ctx->ao_basis = basis; return QMCKL_SUCCESS; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int32_t) function qmckl_context_update_ao_basis(context, & typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & @@ -613,26 +667,26 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type double precision , intent(in) :: COEFFICIENT(prim_num) end function qmckl_context_update_ao_basis end interface - #+END_SRC + #+end_src -***** TODO Test +*** TODO Test -**** ~qmckl_context_set_ao_basis~ +** ~qmckl_context_set_ao_basis~ - Sets the data describing the AO basis set into the context. + Sets the data describing the AO basis set into the context. - | ~type~ | Gaussian or Slater | - | ~shell_num~ | Number of shells | - | ~prim_num~ | Total number of primitives | - | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | - | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | - | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | - | ~EXPONENT(prim_num)~ | Array of exponents | - | ~COEFFICIENT(prim_num)~ | Array of coefficients | + | ~type~ | Gaussian or Slater | + | ~shell_num~ | Number of shells | + | ~prim_num~ | Total number of primitives | + | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | + | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | + | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | + | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | + | ~EXPONENT(prim_num)~ | Array of exponents | + | ~COEFFICIENT(prim_num)~ | Array of coefficients | - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) + #+begin_src c :comments org :tangle (eval h) qmckl_context qmckl_context_set_ao_basis(const qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -640,10 +694,10 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, const double * EXPONENT , const double * COEFFICIENT); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_set_ao_basis(const qmckl_context context , const char type, const int64_t shell_num , const int64_t prim_num, @@ -665,10 +719,10 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ return new_context; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int64_t) function qmckl_context_set_ao_basis(context, & typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & @@ -687,29 +741,29 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ double precision , intent(in) :: COEFFICIENT(prim_num) end function qmckl_context_set_ao_basis end interface - #+END_SRC + #+end_src -***** TODO Test +*** TODO Test -**** Precision +* Precision - The following functions set and get the expected required - precision and range. ~precision~ should be an integer between 2 - and 53, and ~range~ should be an integer between 2 and 11. + The following functions set and get the expected required + precision and range. ~precision~ should be an integer between 2 + and 53, and ~range~ should be an integer between 2 and 11. - The setter functions functions return a new context as a 64-bit - integer. The getter functions return the value, as a 32-bit - integer. The update functions return ~QMCKL_SUCCESS~ or - ~QMCKL_FAILURE~. + The setter functions functions return a new context as a 64-bit + integer. The getter functions return the value, as a 32-bit + integer. The update functions return ~QMCKL_SUCCESS~ or + ~QMCKL_FAILURE~. -**** ~qmckl_context_update_precision~ - Modifies the parameter for the numerical precision in a given context. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +** ~qmckl_context_update_precision~ + Modifies the parameter for the numerical precision in a given context. + #+begin_src c :comments org :tangle (eval h) qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { if (precision < 2) return QMCKL_FAILURE; @@ -721,10 +775,10 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons ctx->precision = precision; return QMCKL_SUCCESS; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -732,17 +786,17 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons integer (c_int32_t), intent(in), value :: precision end function qmckl_context_update_precision end interface - #+END_SRC + #+end_src -***** TODO Tests :noexport: -**** ~qmckl_context_update_range~ - Modifies the parameter for the numerical range in a given context. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +*** TODO Tests :noexport: +** ~qmckl_context_update_range~ + Modifies the parameter for the numerical range in a given context. + #+begin_src c :comments org :tangle (eval h) qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { if (range < 2) return QMCKL_FAILURE; @@ -754,10 +808,10 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in ctx->range = range; return QMCKL_SUCCESS; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -765,17 +819,17 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in integer (c_int32_t), intent(in), value :: range end function qmckl_context_update_range end interface - #+END_SRC + #+end_src -***** TODO Tests :noexport: -**** ~qmckl_context_set_precision~ - Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +*** TODO Tests :noexport: +** ~qmckl_context_set_precision~ + Returns a copy of the context with a different precision parameter. + #+begin_src c :comments org :tangle (eval h) qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -784,10 +838,10 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int return new_context; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -795,17 +849,17 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int integer (c_int32_t), intent(in), value :: precision end function qmckl_context_set_precision end interface - #+END_SRC + #+end_src -***** TODO Tests :noexport: -**** ~qmckl_context_set_range~ - Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +*** TODO Tests :noexport: +** ~qmckl_context_set_range~ + Returns a copy of the context with a different precision parameter. + #+begin_src c :comments org :tangle (eval h) qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -814,10 +868,10 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran return new_context; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -825,98 +879,101 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran integer (c_int32_t), intent(in), value :: range end function qmckl_context_set_range end interface - #+END_SRC + #+end_src -***** TODO Tests :noexport: +*** TODO Tests :noexport: -**** ~qmckl_context_get_precision~ - Returns the value of the numerical precision in the context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +** ~qmckl_context_get_precision~ + Returns the value of the numerical precision in the context + #+begin_src c :comments org :tangle (eval h) int32_t qmckl_context_get_precision(const qmckl_context context); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) int qmckl_context_get_precision(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->precision; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_precision end interface - #+END_SRC + #+end_src -***** TODO Tests :noexport: -**** ~qmckl_context_get_range~ - Returns the value of the numerical range in the context - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +*** TODO Tests :noexport: +** ~qmckl_context_get_range~ + Returns the value of the numerical range in the context + #+begin_src c :comments org :tangle (eval h) int32_t qmckl_context_get_range(const qmckl_context context); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) int qmckl_context_get_range(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->range; } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface integer (c_int32_t) function qmckl_context_get_range(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_range end interface - #+END_SRC + #+end_src -***** TODO Tests :noexport: +*** TODO Tests :noexport: -**** ~qmckl_context_get_epsilon~ - Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision - #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) +** ~qmckl_context_get_epsilon~ + Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision + #+begin_src c :comments org :tangle (eval h) double qmckl_context_get_epsilon(const qmckl_context context); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) +*** Source + #+begin_src c :tangle (eval c) double qmckl_context_get_epsilon(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return pow(2.0,(double) 1-ctx->precision); } - #+END_SRC + #+end_src -***** Fortran interface - #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) +*** Fortran interface + #+begin_src f90 :tangle (eval fh) interface real (c_double) function qmckl_context_get_epsilon(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_epsilon end interface - #+END_SRC + #+end_src -***** TODO Tests :noexport: +*** TODO Tests :noexport: +* End of files :noexport: + #+begin_src c :comments link :tangle (eval h_private) -*** End of files :noexport: - -***** Test - #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) +#endif + #+end_src + +*** Test + #+begin_src c :comments link :tangle (eval c_test) return MUNIT_OK; } - #+END_SRC + #+end_src - # -*- mode: org -*- - # vim: syntax=c +# -*- mode: org -*- +# vim: syntax=c diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 57e5531..e797393 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -1,77 +1,78 @@ -** Computation of distances +#+TITLE: Distances +#+SETUPFILE: ../docs/theme.setup - Function for the computation of distances between particles. +Functions for the computation of distances between particles. - 3 files are produced: - - a source file : =qmckl_distance.f90= - - a C test file : =test_qmckl_distance.c= - - a Fortran test file : =test_qmckl_distance_f.f90= +* Headers :noexport: -**** Headers :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + #+NAME: filename + #+begin_src elisp tangle: no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src + + #+begin_src c :comments link :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" -MunitResult test_qmckl_distance() { +MunitResult test_<>() { qmckl_context context; context = qmckl_context_create(); - #+END_SRC + #+end_src +* Squared distance -*** Squared distance +** ~qmckl_distance_sq~ -**** ~qmckl_distance_sq~ + Computes the matrix of the squared distances between all pairs of + points in two sets, one point within each set: + \[ + C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 + \] - Computes the matrix of the squared distances between all pairs of - points in two sets, one point within each set: - \[ - C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 - \] +*** Arguments -***** Arguments + | ~context~ | input | Global state | + | ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed | + | ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed | + | ~m~ | input | Number of points in the first set | + | ~n~ | input | Number of points in the second set | + | ~A(lda,3)~ | input | Array containing the $m \times 3$ matrix $A$ | + | ~lda~ | input | Leading dimension of array ~A~ | + | ~B(ldb,3)~ | input | Array containing the $n \times 3$ matrix $B$ | + | ~ldb~ | input | Leading dimension of array ~B~ | + | ~C(ldc,n)~ | output | Array containing the $m \times n$ matrix $C$ | + | ~ldc~ | input | Leading dimension of array ~C~ | - | ~context~ | input | Global state | - | ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed | - | ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed | - | ~m~ | input | Number of points in the first set | - | ~n~ | input | Number of points in the second set | - | ~A(lda,3)~ | input | Array containing the $m \times 3$ matrix $A$ | - | ~lda~ | input | Leading dimension of array ~A~ | - | ~B(ldb,3)~ | input | Array containing the $n \times 3$ matrix $B$ | - | ~ldb~ | input | Leading dimension of array ~B~ | - | ~C(ldc,n)~ | output | Array containing the $m \times n$ matrix $C$ | - | ~ldc~ | input | Leading dimension of array ~C~ | +*** Requirements -***** Requirements + - ~context~ is not 0 + - ~m~ > 0 + - ~n~ > 0 + - ~lda~ >= 3 if ~transa~ is ~N~ + - ~lda~ >= m if ~transa~ is ~T~ + - ~ldb~ >= 3 if ~transb~ is ~N~ + - ~ldb~ >= n if ~transb~ is ~T~ + - ~ldc~ >= m + - ~A~ is allocated with at least $3 \times m \times 8$ bytes + - ~B~ is allocated with at least $3 \times n \times 8$ bytes + - ~C~ is allocated with at least $m \times n \times 8$ bytes - - ~context~ is not 0 - - ~m~ > 0 - - ~n~ > 0 - - ~lda~ >= 3 if ~transa~ is ~N~ - - ~lda~ >= m if ~transa~ is ~T~ - - ~ldb~ >= 3 if ~transb~ is ~N~ - - ~ldb~ >= n if ~transb~ is ~T~ - - ~ldc~ >= m - - ~A~ is allocated with at least $3 \times m \times 8$ bytes - - ~B~ is allocated with at least $3 \times n \times 8$ bytes - - ~C~ is allocated with at least $m \times n \times 8$ bytes +*** Performance -***** Performance + This function might be more efficient when ~A~ and ~B~ are + transposed. - This function might be more efficient when ~A~ and ~B~ are - transposed. - - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+begin_src c :comments org :tangle (eval h) qmckl_exit_code qmckl_distance_sq(const qmckl_context context, const char transa, const char transb, const int64_t m, const int64_t n, const double *A, const int64_t lda, const double *B, const int64_t ldb, const double *C, const int64_t ldc); - #+END_SRC + #+end_src -***** Source - #+BEGIN_SRC f90 :tangle qmckl_distance.f90 +*** Source + #+begin_src f90 :tangle (eval f) integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) implicit none integer*8 , intent(in) :: context @@ -196,10 +197,10 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L end select end function qmckl_distance_sq_f - #+END_SRC - -***** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_distance.f90 + #+end_src + +*** C interface :noexport: + #+begin_src f90 :tangle (eval f) integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -217,9 +218,9 @@ integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, integer, external :: qmckl_distance_sq_f info = qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) end function qmckl_distance_sq - #+END_SRC + #+end_src - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+begin_src f90 :tangle (eval fh) interface integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) @@ -236,10 +237,10 @@ end function qmckl_distance_sq real (c_double) , intent(out) :: C(ldc,n) end function qmckl_distance_sq end interface - #+END_SRC + #+end_src -***** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_distance_f.f90 +*** Test :noexport: + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) use qmckl implicit none @@ -335,22 +336,22 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) deallocate(A,B,C) end function test_qmckl_distance_sq - #+END_SRC + #+end_src - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + #+begin_src c :comments link :tangle (eval c_test) int test_qmckl_distance_sq(qmckl_context context); munit_assert_int(0, ==, test_qmckl_distance_sq(context)); - #+END_SRC -*** End of files :noexport: + #+end_src +* End of files :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + #+begin_src c :comments link :tangle (eval c_test) if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return MUNIT_OK; } - #+END_SRC + #+end_src - # -*- mode: org -*- - # vim: syntax=c +# -*- mode: org -*- +# vim: syntax=c diff --git a/src/qmckl_error.org b/src/qmckl_error.org index dda5996..b1338e3 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -1,193 +1,138 @@ -# This file is part of the qmckl.h file -** Error handling - :PROPERTIES: - :c: qmckl_error.c - :c_test: test_qmckl_error.c - :fh: qmckl_f.f90 - :h: qmckl.h - :END: +#+TITLE: Error handling +#+SETUPFILE: ../docs/theme.setup - This file is written in C because it is more natural to express the - error handling in C than in Fortran. + This file is written in C because it is more natural to express the + error handling in C than in Fortran. - 2 files are produced: - - a source file : =qmckl_error.c= - - a test file : =test_qmckl_error.c= +** Headers :noexport: -*** Headers :noexport: - #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) -#include "qmckl.h" -#include -#include -#include -#include - #+END_SRC + #+NAME: filename + #+begin_src elisp tangle: no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src - #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) + #+begin_src c :tangle (eval c) +#include +#include "qmckl_error.h" + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" -MunitResult test_qmckl_error() { - #+END_SRC +MunitResult test_<>() { + #+end_src -*** Error handling +** Error handling - The library should never make the calling programs abort, nor - perform any input/output operations. This decision has to be taken - by the developer of the code calling the library. + The library should never make the calling programs abort, nor + perform any input/output operations. This decision has to be taken + by the developer of the code calling the library. - All the functions return with an <<>>, defined as - #+NAME: type-exit-code - #+BEGIN_SRC C :comments org :tangle qmckl.h + All the functions return with an <<>>, defined as + #+NAME: type-exit-code + #+begin_src c :comments org :tangle (eval h) typedef int32_t qmckl_exit_code; - #+END_SRC + #+end_src - The exit code returns the completion status of the function to the - calling program. When a function call completed successfully, the - ~QMCKL_SUCCESS~ exit code is returned. If one of the functions of - the library fails to complete the requested task, an appropriate - error code is returned to the program. + The exit code returns the completion status of the function to the + calling program. When a function call completed successfully, the + ~QMCKL_SUCCESS~ exit code is returned. If one of the functions of + the library fails to complete the requested task, an appropriate + error code is returned to the program. - Here is the complete list of exit codes. + Here is the complete list of exit codes. - #+NAME: table-exit-codes - | ~QMCKL_SUCCESS~ | 0 | - | ~QMCKL_INVALID_ARG_1~ | 1 | - | ~QMCKL_INVALID_ARG_2~ | 2 | - | ~QMCKL_INVALID_ARG_3~ | 3 | - | ~QMCKL_INVALID_ARG_4~ | 4 | - | ~QMCKL_INVALID_ARG_5~ | 5 | - | ~QMCKL_INVALID_ARG_6~ | 6 | - | ~QMCKL_INVALID_ARG_7~ | 7 | - | ~QMCKL_INVALID_ARG_8~ | 8 | - | ~QMCKL_INVALID_ARG_9~ | 9 | - | ~QMCKL_INVALID_ARG_10~ | 10 | - | ~QMCKL_NULL_CONTEXT~ | 101 | - | ~QMCKL_FAILURE~ | 102 | - | ~QMCKL_ERRNO~ | 103 | - | ~QMCKL_INVALID_EXIT_CODE~ | 104 | + #+NAME: table-exit-codes + | ~QMCKL_SUCCESS~ | 0 | + | ~QMCKL_INVALID_ARG_1~ | 1 | + | ~QMCKL_INVALID_ARG_2~ | 2 | + | ~QMCKL_INVALID_ARG_3~ | 3 | + | ~QMCKL_INVALID_ARG_4~ | 4 | + | ~QMCKL_INVALID_ARG_5~ | 5 | + | ~QMCKL_INVALID_ARG_6~ | 6 | + | ~QMCKL_INVALID_ARG_7~ | 7 | + | ~QMCKL_INVALID_ARG_8~ | 8 | + | ~QMCKL_INVALID_ARG_9~ | 9 | + | ~QMCKL_INVALID_ARG_10~ | 10 | + | ~QMCKL_NULL_CONTEXT~ | 101 | + | ~QMCKL_FAILURE~ | 102 | + | ~QMCKL_ERRNO~ | 103 | + | ~QMCKL_INVALID_EXIT_CODE~ | 104 | - # We need to force Emacs not to indent the Python code: - # -*- org-src-preserve-indentation: t - #+BEGIN_SRC python :var table=table-exit-codes :results drawer :exports result + # We need to force Emacs not to indent the Python code: + # -*- org-src-preserve-indentation: t + #+begin_src python :var table=table-exit-codes :results drawer :exports result """ This script generates the C and Fortran constants for the error codes from the org-mode table. """ -result = [ "#+BEGIN_SRC C :comments org :tangle qmckl.h" ] +result = [ "#+begin_src c :comments org :tangle (eval h)" ] for (text, code) in table: text=text.replace("~","") result += [ f"#define {text:30s} {code:d}" ] -result += [ "#+END_SRC" ] +result += [ "#+end_src" ] result += [ "" ] -result += [ "#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90" ] +result += [ "#+begin_src f90 :comments org :tangle (eval fh)" ] for (text, code) in table: text=text.replace("~","") result += [ f" integer, parameter :: {text:30s} = {code:d}" ] -result += [ "#+END_SRC" ] +result += [ "#+end_src" ] return '\n'.join(result) - #+END_SRC + #+end_src - #+RESULTS: - :results: - #+BEGIN_SRC C :comments org :tangle qmckl.h - #define QMCKL_SUCCESS 0 - #define QMCKL_INVALID_ARG_1 1 - #define QMCKL_INVALID_ARG_2 2 - #define QMCKL_INVALID_ARG_3 3 - #define QMCKL_INVALID_ARG_4 4 - #define QMCKL_INVALID_ARG_5 5 - #define QMCKL_INVALID_ARG_6 6 - #define QMCKL_INVALID_ARG_7 7 - #define QMCKL_INVALID_ARG_8 8 - #define QMCKL_INVALID_ARG_9 9 - #define QMCKL_INVALID_ARG_10 10 - #define QMCKL_NULL_CONTEXT 101 - #define QMCKL_FAILURE 102 - #define QMCKL_ERRNO 103 - #define QMCKL_INVALID_EXIT_CODE 104 - #+END_SRC + #+RESULTS: + :results: + #+begin_src c :comments org :tangle (eval h) + #define QMCKL_SUCCESS 0 + #define QMCKL_INVALID_ARG_1 1 + #define QMCKL_INVALID_ARG_2 2 + #define QMCKL_INVALID_ARG_3 3 + #define QMCKL_INVALID_ARG_4 4 + #define QMCKL_INVALID_ARG_5 5 + #define QMCKL_INVALID_ARG_6 6 + #define QMCKL_INVALID_ARG_7 7 + #define QMCKL_INVALID_ARG_8 8 + #define QMCKL_INVALID_ARG_9 9 + #define QMCKL_INVALID_ARG_10 10 + #define QMCKL_NULL_CONTEXT 101 + #define QMCKL_FAILURE 102 + #define QMCKL_ERRNO 103 + #define QMCKL_INVALID_EXIT_CODE 104 + #+end_src - #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 - integer, parameter :: QMCKL_SUCCESS = 0 - integer, parameter :: QMCKL_INVALID_ARG_1 = 1 - integer, parameter :: QMCKL_INVALID_ARG_2 = 2 - integer, parameter :: QMCKL_INVALID_ARG_3 = 3 - integer, parameter :: QMCKL_INVALID_ARG_4 = 4 - integer, parameter :: QMCKL_INVALID_ARG_5 = 5 - integer, parameter :: QMCKL_INVALID_ARG_6 = 6 - integer, parameter :: QMCKL_INVALID_ARG_7 = 7 - integer, parameter :: QMCKL_INVALID_ARG_8 = 8 - integer, parameter :: QMCKL_INVALID_ARG_9 = 9 - integer, parameter :: QMCKL_INVALID_ARG_10 = 10 - integer, parameter :: QMCKL_NULL_CONTEXT = 101 - integer, parameter :: QMCKL_FAILURE = 102 - integer, parameter :: QMCKL_ERRNO = 103 - integer, parameter :: QMCKL_INVALID_EXIT_CODE = 104 - #+END_SRC - :end: + #+begin_src f90 :comments org :tangle (eval fh) + integer, parameter :: QMCKL_SUCCESS = 0 + integer, parameter :: QMCKL_INVALID_ARG_1 = 1 + integer, parameter :: QMCKL_INVALID_ARG_2 = 2 + integer, parameter :: QMCKL_INVALID_ARG_3 = 3 + integer, parameter :: QMCKL_INVALID_ARG_4 = 4 + integer, parameter :: QMCKL_INVALID_ARG_5 = 5 + integer, parameter :: QMCKL_INVALID_ARG_6 = 6 + integer, parameter :: QMCKL_INVALID_ARG_7 = 7 + integer, parameter :: QMCKL_INVALID_ARG_8 = 8 + integer, parameter :: QMCKL_INVALID_ARG_9 = 9 + integer, parameter :: QMCKL_INVALID_ARG_10 = 10 + integer, parameter :: QMCKL_NULL_CONTEXT = 101 + integer, parameter :: QMCKL_FAILURE = 102 + integer, parameter :: QMCKL_ERRNO = 103 + integer, parameter :: QMCKL_INVALID_EXIT_CODE = 104 + #+end_src + :end: - To make a function fail, the <<<~qmckl_failwith~>>> function should be - called, such that information about the failure is stored in - the context. The desired exit code is given as an argument, as - well as the name of the function and an error message. The return - code of the function is the desired return code. - - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_exit_code qmckl_failwith(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function, - const char* message) ; - #+END_SRC - - #+BEGIN_SRC C :comments org :tangle qmckl_error.c -qmckl_exit_code qmckl_failwith(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function, - const char* message) { - if (context == 0) return QMCKL_NULL_CONTEXT; - assert (exit_code > 0); - assert (exit_code < QMCKL_INVALID_EXIT_CODE); - assert (function != NULL); - assert (message != NULL); - assert (strlen(function) < QMCKL_MAX_FUN_LEN); - assert (strlen(message) < QMCKL_MAX_MSG_LEN); - - context = qmckl_context_set_error(context, exit_code, function, message); - return exit_code; -} - - #+END_SRC - - For example, this function can be used as - #+BEGIN_SRC C :tangle no -if (x < 0) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_function", - "Expected x >= 0"); - } - #+END_SRC +** End of files :noexport: - # To decode the error messages, the <<<~qmckl_strerror~>>> converts an - # error code into a string. - -*** End of files :noexport: - -***** Test - #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) +*** Test + #+begin_src c :comments link :tangle (eval c_test) return MUNIT_OK; } - #+END_SRC + #+end_src + +# -*- mode: org -*- +# vim: syntax=c - - # -*- mode: org -*- - # vim: syntax=c - - # -*- mode: org -*- - # vim: syntax=c diff --git a/src/qmckl_footer.org b/src/qmckl_footer.org index 5ed01c7..ad448d6 100644 --- a/src/qmckl_footer.org +++ b/src/qmckl_footer.org @@ -3,16 +3,6 @@ [[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] [[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. -* End of header files :noexport: - -#+BEGIN_SRC C :tangle qmckl.h -#endif -#+END_SRC - -#+BEGIN_SRC f90 :tangle qmckl_f.f90 -end module qmckl -#+END_SRC - # -*- mode: org -*- diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index d861c13..47d6962 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -1,36 +1,45 @@ -** Memory management +#+TITLE: Memory management +#+SETUPFILE: ../docs/theme.setup - We override the allocation functions to enable the possibility of - optimized libraries to fine-tune the memory allocation. +We override the allocation functions to enable the possibility of +optimized libraries to fine-tune the memory allocation. - 2 files are produced: - - a source file : =qmckl_memory.c= - - a test file : =test_qmckl_memory.c= -*** Headers :noexport: - #+BEGIN_SRC C :tangle qmckl_memory.c -#include "qmckl.h" -#include - #+END_SRC +* Headers :noexport: - #+BEGIN_SRC C :tangle test_qmckl_memory.c + #+NAME: filename + #+begin_src elisp tangle: no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src + + #+begin_src c :tangle (eval c) +#include +#include +#include "qmckl_error.h" +#include "qmckl_context.h" +#include "qmckl_memory.h" + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" -MunitResult test_qmckl_memory() { - #+END_SRC +MunitResult test_<>() { + #+end_src -*** ~qmckl_malloc~ +* ~qmckl_malloc~ - Memory allocation function, letting the library choose how the - memory will be allocated, and a pointer is returned to the user. - The context is passed to let the library store data related to the - allocation inside the context. + Memory allocation function, letting the library choose how the + memory will be allocated, and a pointer is returned to the user. + The context is passed to let the library store data related to the + allocation inside the context. If the allocation failed, the ~NULL~ + pointer is returned. - #+BEGIN_SRC C :tangle qmckl.h -void* qmckl_malloc(const qmckl_context ctx, const size_t size); - #+END_SRC + #+begin_src c :tangle (eval h) +void* qmckl_malloc(qmckl_context ctx, + const size_t size); + #+end_src - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+begin_src f90 :tangle (eval fh) interface type (c_ptr) function qmckl_malloc (context, size) bind(C) use, intrinsic :: iso_c_binding @@ -38,43 +47,46 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size); integer (c_int64_t), intent(in), value :: size end function qmckl_malloc end interface - #+END_SRC + #+end_src + +** Source + + #+begin_src c :tangle (eval c) +void* qmckl_malloc(qmckl_context ctx, const size_t size) { -**** Source - #+BEGIN_SRC C :tangle qmckl_memory.c -void* qmckl_malloc(const qmckl_context ctx, const size_t size) { if (ctx == (qmckl_context) 0) {}; /* Avoid unused argument warning */ void * result = malloc( (size_t) size ); - assert (result != NULL) ; return result; + } - #+END_SRC + #+end_src -**** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_memory.c -int *a = NULL; -munit_assert(a == NULL); -a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); -munit_assert(a != NULL); -a[0] = 1; -a[1] = 2; -a[2] = 3; -munit_assert_int(a[0], ==, 1); -munit_assert_int(a[1], ==, 2); -munit_assert_int(a[2], ==, 3); - #+END_SRC +** Test :noexport: + #+begin_src c :tangle (eval c_test) + int *a = NULL; + munit_assert(a == NULL); + a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); + munit_assert(a != NULL); + a[0] = 1; + a[1] = 2; + a[2] = 3; + munit_assert_int(a[0], ==, 1); + munit_assert_int(a[1], ==, 2); + munit_assert_int(a[2], ==, 3); + #+end_src -*** ~qmckl_free~ +* ~qmckl_free~ - The context is passed, in case some important information has been - stored related to memory allocation and needs to be updated. + The context is passed, in case some important information has been + stored related to memory allocation and needs to be updated. - #+BEGIN_SRC C :tangle qmckl.h -qmckl_exit_code qmckl_free(qmckl_context context, void *ptr); - #+END_SRC + #+begin_src c :tangle (eval h) +qmckl_exit_code qmckl_free(qmckl_context context, + void *ptr); + #+end_src - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+begin_src f90 :tangle (eval fh) interface integer (c_int32_t) function qmckl_free (context, ptr) bind(C) use, intrinsic :: iso_c_binding @@ -82,36 +94,38 @@ qmckl_exit_code qmckl_free(qmckl_context context, void *ptr); type (c_ptr), intent(in), value :: ptr end function qmckl_free end interface - #+END_SRC + #+end_src -**** Source - #+BEGIN_SRC C :tangle qmckl_memory.c +** Source + #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { + if (context == 0) return QMCKL_INVALID_ARG_1; if (ptr == NULL) return QMCKL_INVALID_ARG_2; free(ptr); return QMCKL_SUCCESS; -} - #+END_SRC -**** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_memory.c +} + #+end_src + +** Test :noexport: + #+begin_src c :tangle (eval c_test) munit_assert(a != NULL); qmckl_exit_code rc; rc = qmckl_free( (qmckl_context) 1, a); munit_assert(rc == QMCKL_SUCCESS); - #+END_SRC + #+end_src -*** End of files :noexport: +* End of files :noexport: -**** Test - #+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c +** Test + #+begin_src c :comments org :tangle (eval c_test) return MUNIT_OK; } - #+END_SRC + #+end_src - # -*- mode: org -*- - # vim: syntax=c +# -*- mode: org -*- +# vim: syntax=c diff --git a/src/qmckl_precision.org b/src/qmckl_precision.org index 60c8fd0..ca24c0a 100644 --- a/src/qmckl_precision.org +++ b/src/qmckl_precision.org @@ -1,21 +1,58 @@ -# This file is part of the qmckl.h file +#+TITLE: Multi-precision +#+SETUPFILE: ../docs/theme.setup -*** Multi-precision related constants +#+NAME: filename +#+begin_src elisp tangle: no +(file-name-nondirectory (substring buffer-file-name 0 -4)) +#+end_src - Controlling numerical precision enables optimizations. Here, the - default parameters determining the target numerical precision and - range are defined. + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. - #+BEGIN_SRC C :comments org :tangle qmckl.h -#define QMCKL_DEFAULT_PRECISION 53 -#define QMCKL_DEFAULT_RANGE 11 - #+END_SRC + #+NAME: table-precision + | ~QMCKL_DEFAULT_PRECISION~ | 53 | + | ~QMCKL_DEFAULT_RANGE~ | 11 | - #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 - integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 - integer, parameter :: QMCKL_DEFAULT_RANGE = 11 - #+END_SRC - + # We need to force Emacs not to indent the Python code: + # -*- org-src-preserve-indentation: t - # -*- mode: org -*- - # vim: syntax=c +#+begin_src python :var table=table-precision :results drawer :exports result +""" This script generates the C and Fortran constants for the error + codes from the org-mode table. +""" + +result = [ "#+begin_src c :comments org :tangle (eval h)" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f"#define {text:30s} {code:d}" ] +result += [ "#+end_src" ] + +result += [ "" ] + +result += [ "#+begin_src f90 :comments org :tangle (eval fh)" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f" integer, parameter :: {text:30s} = {code:d}" ] +result += [ "#+end_src" ] + +return '\n'.join(result) + +#+end_src + +#+RESULTS: +:results: +#+begin_src c :comments org :tangle (eval h) +#define QMCKL_DEFAULT_PRECISION 53 +#define QMCKL_DEFAULT_RANGE 11 +#+end_src + +#+begin_src f90 :comments org :tangle (eval fh) + integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 + integer, parameter :: QMCKL_DEFAULT_RANGE = 11 +#+end_src +:end: + + +# -*- mode: org -*- +# vim: syntax=c diff --git a/src/table_of_contents b/src/table_of_contents index 2fbbb05..7929b05 100644 --- a/src/table_of_contents +++ b/src/table_of_contents @@ -1,9 +1,9 @@ -qmckl.org -qmckl_context.org -qmckl_error.org -qmckl_precision.org -qmckl_memory.org -qmckl_distance.org -qmckl_ao.org +qmckl.org +qmckl_error.org +qmckl_context.org +qmckl_precision.org +qmckl_memory.org +qmckl_distance.org +qmckl_ao.org test_qmckl.org -qmckl_footer.org +qmckl_footer.org diff --git a/src/test_qmckl.org b/src/test_qmckl.org index cc0f169..5633963 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -1,19 +1,22 @@ +#+TITLE: Testing +#+SETUPFILE: ../docs/theme.setup + * QMCkl test :noexport: This file is the main program of the unit tests. The tests rely on the $\mu$unit framework, which is provided as a git submodule. - First, we use a script to find the list of all the produced test files: + First, we use a script to find the list of all the generated test files: #+NAME: test-files - #+BEGIN_SRC sh :exports none :results value -grep BEGIN_SRC *.org | \ + #+begin_src sh :exports none :results value +grep begin_src *.org | \ grep test_qmckl_ | \ rev | \ cut -d ' ' -f 1 | \ rev | \ sort | \ uniq - #+END_SRC + #+end_src #+RESULTS: test-files | test_qmckl_ao.c | @@ -22,48 +25,48 @@ grep BEGIN_SRC *.org | \ | test_qmckl_memory.c | We generate the function headers - #+BEGIN_SRC sh :var files=test-files :exports output :results raw + #+begin_src sh :var files=test-files :exports output :results raw echo "#+NAME: headers" -echo "#+BEGIN_SRC C :tangle no" +echo "#+begin_src c :tangle no" for file in $files do routine=${file%.c} echo "MunitResult ${routine}();" done -echo "#+END_SRC" - #+END_SRC +echo "#+end_src" + #+end_src #+RESULTS: #+NAME: headers - #+BEGIN_SRC C :tangle no + #+begin_src c :tangle no MunitResult test_qmckl_ao(); MunitResult test_qmckl_context(); MunitResult test_qmckl_distance(); MunitResult test_qmckl_memory(); - #+END_SRC + #+end_src and the required function calls: - #+BEGIN_SRC sh :var files=test-files :exports output :results raw + #+begin_src sh :var files=test-files :exports output :results raw echo "#+NAME: calls" -echo "#+BEGIN_SRC C :tangle no" +echo "#+begin_src c :tangle no" for file in $files do routine=${file%.c} echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," done -echo "#+END_SRC" - #+END_SRC +echo "#+end_src" + #+end_src #+RESULTS: #+NAME: calls - #+BEGIN_SRC C :tangle no + #+begin_src c :tangle no { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - #+END_SRC + #+end_src - #+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c + #+begin_src c :comments link :noweb yes :tangle test_qmckl.c #include "qmckl.h" #include "munit.h" <> @@ -82,4 +85,4 @@ int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); } - #+END_SRC + #+end_src diff --git a/tools/Building.org b/tools/Building.org new file mode 100644 index 0000000..12a6ab6 --- /dev/null +++ b/tools/Building.org @@ -0,0 +1,406 @@ +#+TITLE: Building tools + +This file contains all the tools needed to build the QMCkl library. + +* Helper functions + #+NAME: header + #+begin_src sh :tangle no :exports none :output none +echo "This file was created by tools/Building.org" + #+end_src + + #+NAME: check-src + #+begin_src bash +if [[ $(basename $PWD) != "src" ]] ; then + echo "This script needs to be run in the src directory" + exit -1 +fi + #+end_src + + #+NAME: url-issues + : https://github.com/trex-coe/qmckl/issues + + #+NAME: url-web + : https://trex-coe.github.io/qmckl + + #+NAME: license + #+begin_example +BSD 3-Clause License + +Copyright (c) 2020, TREX Center of Excellence +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + #+end_example + +* Makefile + :PROPERTIES: + :header-args: :tangle ../src/Makefile :noweb yes :comments org + :END: + + This is the main Makefile invoked by the ~make~ command. + The Makefile compiling the library is =Makefile.generated=, and is + generated by the script detailed in the next section. +** Header :noexport: + + #+begin_src makefile +# <> + #+end_src + +** Variables + + #+begin_src makefile +QMCKL_ROOT=$(shell dirname $(CURDIR)) + +export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT + +ORG_SOURCE_FILES=$(wildcard *.org) +OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) +INCLUDE=-I$(QMCKL_ROOT)/include/ + #+end_src + +** Compiler options + + GNU, Intel and LLVM compilers are supported. Choose here: + + #+begin_src makefile +COMPILER=GNU +#COMPILER=INTEL +#COMPILER=LLVM + #+end_src + +*** GNU + + #+begin_src makefile +ifeq ($(COMPILER),GNU) +#---------------------------------------------------------- +CC=gcc -g +CFLAGS=-fPIC $(INCLUDE) \ + -fexceptions -Wall -Werror -Wpedantic -Wextra -fmax-errors=3 + +FC=gfortran -g +FFLAGS=-fPIC $(INCLUDE) \ + -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising \ + -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation \ + -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ + -ffpe-trap=zero,overflow,underflow + +LIBS=-lgfortran -lm +#---------------------------------------------------------- +endif + #+end_src + +*** Intel + + #+begin_src makefile +ifeq ($(COMPILER),INTEL) +#---------------------------------------------------------- +CC=icc -xHost +CFLAGS=-fPIC -g -O2 $(INCLUDE) + +FC=ifort -xHost +FFLAGS=-fPIC -g -O2 $(INCLUDE) + +LIBS=-lm -lifcore -lirc +#---------------------------------------------------------- +CC=icc -xHost +endif + #+end_src + +*** LLVM + + #+begin_src makefile +ifeq ($(COMPILER),LLVM) +#---------------------------------------------------------- +CC=clang +CFLAGS=-fPIC -g -O2 $(INCLUDE) + +FC=flang +FFLAGS=fPIC -g -O2 $(INCLUDE) + +LIBS=-lm +#---------------------------------------------------------- +endif + #+end_src + +** Rules + + The source files are created during the generation of the file ~Makefile.generated~. + + #+begin_src makefile +.PHONY: clean +.SECONDARY: # Needed to keep the produced C and Fortran files + +libqmckl.so: Makefile.generated + $(MAKE) -f Makefile.generated + +test: Makefile.generated + $(MAKE) -f Makefile.generated test + +doc: $(ORG_SOURCE_FILES) + $(QMCKL_ROOT)/tools/create_doc.sh + +clean: + $(RM) qmckl.h test_qmckl_* test_qmckl.c test_qmckl \ + qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ + Makefile.generated libqmckl.so *.html *.mod + +Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) + $(QMCKL_ROOT)/tools/create_makefile.sh + #+end_src + +* Script to tangle the org-mode files + :PROPERTIES: + :header-args: :tangle tangle.sh :noweb yes :shebang #!/bin/bash :comments org + :END: + + #+begin_src bash +# <> + +<> + #+end_src + + This file needs to be run from the QMCKL =src= directory. + + It tangles all the files in the directory. It uses the + =config_tangle.el= file, which contains information required to + compute the current file names using for example ~(eval c)~ to get + the name of the produced C file. + + The file is not tangled if the last modification date of the org + file is less recent than one of the tangled files. + #+begin_src bash +function tangle() +{ + if [[ -f ${1%.org}.c && $1 -ot ${1%.org}.c ]] + then return + elif [[ -f ${1%.org}.f90 && $1 -ot ${1%.org}.f90 ]] + then return + fi + emacs --batch $1 --load=../tools/config_tangle.el -f org-babel-tangle +} + + +for i in $@ +do + echo "--- $i ----" + tangle $i +done + #+end_src + +* Script to generate auto-generated Makefile + :PROPERTIES: + :header-args: :tangle create_makefile.sh :noweb yes :shebang #!/bin/bash :comments org + :END: + + This script generates the Makefile that compiles the library. + The ~OUTPUT~ variable contains the name of the generated Makefile,typically + =Makefile.generated=. + + #+begin_src bash +# <> + +<> + +OUTPUT=Makefile.generated + #+end_src + + We start by tangling all the org-mode files. + + #+begin_src bash +${QMCKL_ROOT}/tools/tangle.sh *.org + #+end_src + + Then we create the list of ~*.o~ files to be created, for library + functions: + + #+begin_src bash +OBJECTS="" +for i in $(ls qmckl_*.c) ; do + FILE=${i%.c} + OBJECTS="${OBJECTS} ${FILE}.o" +done >> $OUTPUT + +for i in $(ls qmckl_*_f.f90) ; do + FILE=${i%.f90} + OBJECTS="${OBJECTS} ${FILE}.o" +done >> $OUTPUT + #+end_src + + for tests in C: + + #+begin_src bash +TESTS="" +for i in $(ls test_qmckl_*.c) ; do + FILE=${i%.c}.o + TESTS="${TESTS} ${FILE}" +done >> $OUTPUT + #+end_src + + and for tests in Fortran: + + #+begin_src bash +TESTS_F="" +for i in $(ls test_qmckl_*_f.f90) ; do + FILE=${i%.f90}.o + TESTS_F="${TESTS_F} ${FILE}" +done >> $OUTPUT + #+end_src + + Finally, we append the rules to the Makefile + + #+begin_src bash +cat << EOF > ${OUTPUT} +CC=$CC +CFLAGS=$CFLAGS -I../munit/ + +FC=$FC +FFLAGS=$FFLAGS +OBJECT_FILES=$OBJECTS +TESTS=$TESTS +TESTS_F=$TESTS_F + +LIBS=$LIBS + +libqmckl.so: \$(OBJECT_FILES) + \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so + +%.o: %.c + \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o + + +qmckl_f.o: ../include/qmckl_f.f90 + \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o + +%.o: %.f90 qmckl_f.o + \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o + + +test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) + \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ + ../munit/munit.c \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl + +test: test_qmckl + ./test_qmckl + +.PHONY: test +EOF + + #+end_src + +* Script to build the final qmckl.h file + :PROPERTIES: + :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments org + :END: + + #+begin_src bash :noweb yes +# <> + + #+end_src + + #+NAME: qmckl-header + #+begin_src text :noweb yes +------------------------------------------ + QMCkl - Quantum Monte Carlo kernel library + ------------------------------------------ + + Documentation : <> + Issues : <> + + <> + + + #+end_src + + All the produced header files are concatenated in the =qmckl.h= + file, located in the include directory. The =*_private.h= files + are excluded. + + Put =.h= files in the correct order: + + #+begin_src bash +HEADERS="" +for i in $(cat table_of_contents) +do + HEADERS+="${i%.org}.h " +done + #+end_src + + Generate C header file + + #+begin_src bash +OUTPUT="../include/qmckl.h" + +cat << EOF > ${OUTPUT} +/* + ,* <> + ,*/ + +#ifndef __QMCKL_H__ +#define __QMCKL_H__ + +#include +#include +EOF + +for i in ${HEADERS} +do + if [[ -f $i ]] ; then + cat $i >> ${OUTPUT} + fi +done + +cat << EOF >> ${OUTPUT} +#endif +EOF + #+end_src + + Generate Fortran interface file from all =qmckl_*_fh.f90= files + + #+begin_src bash +HEADERS="qmckl_*_fh.f90" + +OUTPUT="../include/qmckl_f.f90" +cat << EOF > ${OUTPUT} +! +! <> +! +module qmckl + use, intrinsic :: iso_c_binding +EOF + +for i in ${HEADERS} +do + cat $i >> ${OUTPUT} +done + +cat << EOF >> ${OUTPUT} +end module qmckl +EOF + #+end_src + +* Script to build the documentation +* Script to build the documentation diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh new file mode 100755 index 0000000..941959f --- /dev/null +++ b/tools/build_qmckl_h.sh @@ -0,0 +1,164 @@ +#!/bin/bash +# Script to build the final qmckl.h file +# :PROPERTIES: +# :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments both +# :END: + + +# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:1]] +# This file was created by tools/Building.org +# Script to build the final qmckl.h file:1 ends here + + + +# All the produced header files are concatenated in the =qmckl.h= +# file, located in the include directory. The =*_private.h= files +# are excluded. + +# Put =.h= files in the correct order: + + +# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:3]] +HEADERS="" +for i in $(cat table_of_contents) +do + HEADERS+="${i%.org}.h " +done +# Script to build the final qmckl.h file:3 ends here + + + +# Generate C header file + + +# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:4]] +OUTPUT="../include/qmckl.h" + +cat << EOF > ${OUTPUT} +/* + * ------------------------------------------ + * QMCkl - Quantum Monte Carlo kernel library + * ------------------------------------------ + * + * Documentation : https://trex-coe.github.io/qmckl + * Issues : https://github.com/trex-coe/qmckl/issues + * + * BSD 3-Clause License + * + * Copyright (c) 2020, TREX Center of Excellence + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, this + * list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * 3. Neither the name of the copyright holder nor the names of its + * contributors may be used to endorse or promote products derived from + * this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * + * + * + */ + +#ifndef __QMCKL_H__ +#define __QMCKL_H__ + +#include +#include +EOF + +for i in ${HEADERS} +do + if [[ -f $i ]] ; then + cat $i >> ${OUTPUT} + fi +done + +cat << EOF >> ${OUTPUT} +#endif +EOF +# Script to build the final qmckl.h file:4 ends here + + + +# Generate Fortran interface file from all =qmckl_*_fh.f90= files + + +# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:5]] +HEADERS="qmckl_*_fh.f90" + +OUTPUT="../include/qmckl_f.f90" +cat << EOF > ${OUTPUT} +! +! ------------------------------------------ +! QMCkl - Quantum Monte Carlo kernel library +! ------------------------------------------ +! +! Documentation : https://trex-coe.github.io/qmckl +! Issues : https://github.com/trex-coe/qmckl/issues +! +! BSD 3-Clause License +! +! Copyright (c) 2020, TREX Center of Excellence +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this +! list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its +! contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! +! +! +! +module qmckl + use, intrinsic :: iso_c_binding +EOF + +for i in ${HEADERS} +do + cat $i >> ${OUTPUT} +done + +cat << EOF >> ${OUTPUT} +end module qmckl +EOF +# Script to build the final qmckl.h file:5 ends here diff --git a/docs/config.el b/tools/config_tangle.el similarity index 88% rename from docs/config.el rename to tools/config_tangle.el index 0a7f879..fc39218 100755 --- a/docs/config.el +++ b/tools/config_tangle.el @@ -96,3 +96,17 @@ with class 'color and highest min-color value." (or val 'unspecified))) (advice-add 'face-attribute :override #'my-face-attribute) + + +;; The following is required to compute the file names +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + + diff --git a/tools/create_makefile.sh b/tools/create_makefile.sh index 3e81c7d..d7bd2f5 100755 --- a/tools/create_makefile.sh +++ b/tools/create_makefile.sh @@ -1,21 +1,32 @@ #!/bin/bash +# Script to generate auto-generated Makefile +# :PROPERTIES: +# :header-args: :tangle create_makefile.sh :noweb yes :shebang #!/bin/bash :comments org +# :END: + +# This script generates the Makefile that compiles the library. +# The ~OUTPUT~ variable contains the name of the generated Makefile,typically +# =Makefile.generated=. + + +# This file was created by tools/Building.org + -MERGED=merged.org -${QMCKL_ROOT}/tools/merge_org.sh $MERGED OUTPUT=Makefile.generated -# Tangle org files -emacs \ - $MERGED \ - --batch \ - -f org-babel-tangle \ - --kill - -rm $MERGED -# Create the list of *.o files to be created +# We start by tangling all the org-mode files. + + +${QMCKL_ROOT}/tools/tangle.sh *.org + + + +# Then we create the list of ~*.o~ files to be created, for library +# functions: + OBJECTS="" for i in $(ls qmckl_*.c) ; do @@ -23,27 +34,39 @@ for i in $(ls qmckl_*.c) ; do OBJECTS="${OBJECTS} ${FILE}.o" done >> $OUTPUT -for i in $(ls qmckl_*.f90) ; do +for i in $(ls qmckl_*_f.f90) ; do FILE=${i%.f90} OBJECTS="${OBJECTS} ${FILE}.o" done >> $OUTPUT + + +# for tests in C: + + TESTS="" for i in $(ls test_qmckl_*.c) ; do FILE=${i%.c}.o TESTS="${TESTS} ${FILE}" done >> $OUTPUT + + +# and for tests in Fortran: + + TESTS_F="" -for i in $(ls test_qmckl_*.f90) ; do +for i in $(ls test_qmckl_*_f.f90) ; do FILE=${i%.f90}.o TESTS_F="${TESTS_F} ${FILE}" done >> $OUTPUT -# Write the Makefile -cat << EOF > $OUTPUT +# Finally, we append the rules to the Makefile + + +cat << EOF > ${OUTPUT} CC=$CC CFLAGS=$CFLAGS -I../munit/ @@ -57,13 +80,18 @@ LIBS=$LIBS libqmckl.so: \$(OBJECT_FILES) \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so - + %.o: %.c \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o + +qmckl_f.o: ../include/qmckl_f.f90 + \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o + %.o: %.f90 qmckl_f.o \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o + test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ ../munit/munit.c \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl @@ -73,26 +101,3 @@ test: test_qmckl .PHONY: test EOF - -for i in $(ls qmckl_*.c) ; do - FILE=${i%.c} - echo "${FILE}.o: ${FILE}.c " *.h -done >> $OUTPUT - -for i in $(ls qmckl_*.f90) ; do - FILE=${i%.f90} - echo "${FILE}.o: ${FILE}.f90" -done >> $OUTPUT - -for i in $(ls test_qmckl_*.c) ; do - FILE=${i%.c} - echo "${FILE}.o: ${FILE}.c qmckl.h" -done >> $OUTPUT - - -for i in $(ls test_qmckl*.f90) ; do - FILE=${i%.f90} - echo "${FILE}.o: ${FILE}.f90" -done >> $OUTPUT - - diff --git a/tools/init.el b/tools/init.el index bc33d5e..fae4d20 100644 --- a/tools/init.el +++ b/tools/init.el @@ -28,17 +28,17 @@ `(("." . ,(concat user-emacs-directory "backups")))) (setq backup-by-copying t) -(require 'org) +(require 'org) (setq org-format-latex-options (plist-put org-format-latex-options :scale 1.6)) (setq org-hide-leading-stars t) (setq org-alphabetical-lists t) -(setq org-src-fontify-natively t) -(setq org-src-tab-acts-natively t) +(setq org-src-fontify-natively t) +(setq org-src-tab-acts-natively t) (setq org-src-preserve-indentation t) -(setq org-hide-emphasis-markers nil) +(setq org-hide-emphasis-markers nil) (setq org-pretty-entities nil) -(setq org-confirm-babel-evaluate nil) ;; Do not ask for confirmation all the time!! +(setq org-confirm-babel-evaluate nil) ;; Do not ask for confirmation all the time!! (org-babel-do-load-languages 'org-babel-load-languages @@ -51,14 +51,14 @@ (makefile . t) )) -(add-hook 'org-babel-after-execute-hook 'org-display-inline-images) -'(indent-tabs-mode nil) +(add-hook 'org-babel-after-execute-hook 'org-display-inline-images) +'(indent-tabs-mode nil) (require 'evil) (setq evil-want-C-i-jump nil) (evil-mode 1) (global-font-lock-mode t) -(global-superword-mode 1) +(global-superword-mode 1) (setq line-number-mode 1) (setq column-number-mode 1) @@ -72,7 +72,7 @@ (custom-set-variables ;; custom-set-variables was added by Custom. ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. + ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. '(ansi-color-faces-vector [default default default italic underline success warning error]) diff --git a/tools/tangle.sh b/tools/tangle.sh new file mode 100755 index 0000000..0250ec4 --- /dev/null +++ b/tools/tangle.sh @@ -0,0 +1,37 @@ +#!/bin/bash +# Script to tangle the org-mode files +# :PROPERTIES: +# :header-args: :tangle tangle.sh :noweb yes :shebang #!/bin/bash :comments org +# :END: + + +# This file was created by tools/Building.org + + + +# This file needs to be run from the QMCKL =src= directory. + +# It tangles all the files in the directory. It uses the +# =config_tangle.el= file, which contains information required to +# compute the current file names using for example ~(eval c)~ to get +# the name of the produced C file. + +# The file is not tangled if the last modification date of the org +# file is less recent than one of the tangled files. + +function tangle() +{ + if [[ -f ${1%.org}.c && $1 -ot ${1%.org}.c ]] + then return + elif [[ -f ${1%.org}.f90 && $1 -ot ${1%.org}.f90 ]] + then return + fi + emacs --batch $1 --load=../tools/config_tangle.el -f org-babel-tangle +} + + +for i in $@ +do + echo "--- $i ----" + tangle $i +done From 4bf71426e407bf54730b95a486b1a87bbbe81c6a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 10 Mar 2021 12:58:38 +0100 Subject: [PATCH 23/65] Rewrote context --- docs/qmckl.css | 972 +++++++++++++++++++++++++++++ docs/theme.setup | 12 +- src/Makefile | 20 +- src/README.org | 286 ++------- src/qmckl.org | 250 +++++++- src/qmckl_context.org | 1306 ++++++++++++++++++++++++++------------- src/qmckl_error.org | 57 +- src/qmckl_footer.org | 8 - src/qmckl_memory.org | 73 ++- src/qmckl_precision.org | 58 -- src/table_of_contents | 2 - tools/Building.org | 18 +- tools/build_doc.sh | 57 ++ tools/build_qmckl_h.sh | 10 +- tools/config_doc.el | 85 +++ tools/config_tangle.el | 74 +-- tools/create_doc.sh | 47 -- 17 files changed, 2422 insertions(+), 913 deletions(-) create mode 100644 docs/qmckl.css delete mode 100644 src/qmckl_footer.org delete mode 100644 src/qmckl_precision.org create mode 100755 tools/build_doc.sh create mode 100755 tools/config_doc.el delete mode 100755 tools/create_doc.sh diff --git a/docs/qmckl.css b/docs/qmckl.css new file mode 100644 index 0000000..cfc7a63 --- /dev/null +++ b/docs/qmckl.css @@ -0,0 +1,972 @@ +/* Adapted from worg.css */ + +@import url(https://fonts.googleapis.com/css?family=Droid+Sans|Droid+Sans+Mono|Droid+Serif); + +@media all +{ + html { + margin: 0; + font: .9em/1.6em "Droid Serif", Cambria, Georgia, "DejaVu Serif", serif; + background-image: url(/img/org-mode-unicorn-logo-worg.png); + background-attachment: fixed; + background-position: right bottom; + background-repeat: no-repeat; + background-color: white; + } + + body { + font-size: 14pt; + line-height: 22pt; + color: black; + margin-top: 0; + } + + body #content { + padding-top: 2em; + margin: auto; + max-width: 70%; + background-color: white; + } + + body #support { + position: fixed; + top:0; + display:block; + font-size: 12pt; + right:0pt; + text-align: right; + padding: .2em 1em; + background: #EEE; + border-radius: 10px; + } + + body .title { + margin-left: 0px; + font-size: 22pt; + } + + #org-div-home-and-up{ + position: fixed; + right: 0.5em; + margin-top: 70px; + font-family:sans-serif; + } + + /* TOC inspired by http://jashkenas.github.com/coffee-script */ + #table-of-contents { + margin-top: 105px; + font-size: 10pt; + font-family:sans-serif; + position: fixed; + right: 0em; + top: 0em; + background: white; + line-height: 12pt; + text-align: right; + box-shadow: 0 0 1em #777777; + -webkit-box-shadow: 0 0 1em #777777; + -moz-box-shadow: 0 0 1em #777777; + -webkit-border-bottom-left-radius: 5px; + -moz-border-radius-bottomleft: 5px; + /* ensure doesn't flow off the screen when expanded */ + max-height: 80%; + overflow: auto; } + #table-of-contents h2 { + font-size: 13pt; + max-width: 9em; + border: 0; + font-weight: normal; + padding-left: 0.5em; + padding-right: 0.5em; + padding-top: 0.05em; + padding-bottom: 0.05em; } + #table-of-contents #text-table-of-contents { + display: none; + text-align: left; } + #table-of-contents:hover #text-table-of-contents { + display: block; + padding: 0.5em; + margin-top: -1.5em; } + + #license { + background-color: #eeeeee; + } + + h1 { + font-size:2.1em; + padding:0 0 30px 0; + margin-top: 10px; + margin-bottom: 10px; + margin-right: 7%; + color: grey; + } + + h2 { + font-family:sans-serif; + font-size:1.45em; + padding:10px 0 10px 0; + color: black; + border-bottom: 1px solid #ddd; + padding-top: 1.5em; + } + + .outline-text-2 { + margin-left: 0.1em + } + + h3 { + font-family:sans-serif; + font-size:1.3em; + color: grey; + margin-left: 0.6em; + padding-top: 1.5em; + } + + /* #A34D32;*/ + + + .outline-text-3 { + margin-left: 0.9em; + } + + h4 { + font-family:sans-serif; + font-size:1.2em; + margin-left: 1.2em; + color: #A5573E; + padding-top: 1.5em; + } + + .outline-text-4 { + margin-left: 1.45em; + } + + a {text-decoration: none; font-weight: 400;} + a:visited {text-decoration: none; font-weight: 400;} + a:hover {text-decoration: underline;} + + .todo { + color: #CA0000; + } + + .done { + color: #006666; + } + + .timestamp-kwd { + color: #444; + } + + .tag { + background-color: #ffff; + color: #ffff; + } + + li { + margin: .4em; + } + + table { + border: 1; + border-color: grey; + } + + thead { + border: 0; + } + + tbody { + border: 0; + } + + tr { + border: 0; + } + + td { + border-left: 0px; + border-right: 0px; + border-top: 0px; + border-bottom: 0px; + } + + th { + border-left: 0px; + border-right: 0px; + border-top: 1px solid grey; + border-bottom: 1px solid grey; + } + + code { + font-size: 100%; + color: black; + padding: 0px 0.2em; + } + + img { + border: 0; + } + + .share img { + opacity: .4; + -moz-opacity: .4; + filter: alpha(opacity=40); + } + + .share img:hover { + opacity: 1; + -moz-opacity: 1; + filter: alpha(opacity=100); + } + + pre { + font-family: Droid Sans Mono, Monaco, Consolas, "Lucida Console", monospace; + color: black; + font-size: 90%; + padding: 0.5em; + overflow: auto; + border: none; + background-color: #f2f2f2; + border-radius: 5px; + } + + .org-info-box { + clear:both; + margin-left:auto; + margin-right:auto; + padding:0.7em; + } + .org-info-box img { + float:left; + margin:0em 0.5em 0em 0em; + } + .org-info-box p { + margin:0em; + padding:0em; + } + + + .builtin { + /* font-lock-builtin-face */ + color: #f4a460; + } + .comment { + /* font-lock-comment-face */ + color: #737373; + } + .comment-delimiter { + /* font-lock-comment-delimiter-face */ + color: #666666; + } + .constant { + /* font-lock-constant-face */ + color: #db7093; + } + .doc { + /* font-lock-doc-face */ + color: #b3b3b3; + } + .function-name { + /* font-lock-function-name-face */ + color: #5f9ea0; + } + .headline { + /* headline-face */ + color: #ffffff; + background-color: #000000; + font-weight: bold; + } + .keyword { + /* font-lock-keyword-face */ + color: #4682b4; + } + .negation-char { + } + .regexp-grouping-backslash { + } + .regexp-grouping-construct { + } + .string { + /* font-lock-string-face */ + color: #ccc79a; + } + .todo-comment { + /* todo-comment-face */ + color: #ffffff; + background-color: #000000; + font-weight: bold; + } + .variable-name { + /* font-lock-variable-name-face */ + color: #ff6a6a; + } + .warning { + /* font-lock-warning-face */ + color: #ffffff; + background-color: #cd5c5c; + font-weight: bold; + } + .important { + /* font-lock-warning-face */ + background-color: #e3e3f7; + } + .exercise { + /* font-lock-warning-face */ + background-color: #e3f7e3; + } + .note { + /* font-lock-warning-face */ + background-color: #f7f7d9; + } + pre.a { + color: inherit; + background-color: inherit; + font: inherit; + text-decoration: inherit; + } + pre.a:hover { + text-decoration: underline; + } + + /* Styles for org-info.js */ + + .org-info-js_info-navigation + { + border-style:none; + } + + #org-info-js_console-label + { + font-size:10px; + font-weight:bold; + white-space:nowrap; + } + + .org-info-js_search-highlight + { + background-color:#ffff00; + color:#000000; + font-weight:bold; + } + + #org-info-js-window + { + border-bottom:1px solid black; + padding-bottom:10px; + margin-bottom:10px; + } + + + + .org-info-search-highlight + { + background-color:#adefef; /* same color as emacs default */ + color:#000000; + font-weight:bold; + } + + .org-bbdb-company { + /* bbdb-company */ + font-style: italic; + } + .org-bbdb-field-name { + } + .org-bbdb-field-value { + } + .org-bbdb-name { + /* bbdb-name */ + text-decoration: underline; + } + .org-bold { + /* bold */ + font-weight: bold; + } + .org-bold-italic { + /* bold-italic */ + font-weight: bold; + font-style: italic; + } + .org-border { + /* border */ + background-color: #000000; + } + .org-buffer-menu-buffer { + /* buffer-menu-buffer */ + font-weight: bold; + } + .org-builtin { + /* font-lock-builtin-face */ + color: #da70d6; + } + .org-button { + /* button */ + text-decoration: underline; + } + .org-c-nonbreakable-space { + /* c-nonbreakable-space-face */ + background-color: #ff0000; + font-weight: bold; + } + .org-calendar-today { + /* calendar-today */ + text-decoration: underline; + } + .org-comment { + /* font-lock-comment-face */ + color: #b22222; + } + .org-comment-delimiter { + /* font-lock-comment-delimiter-face */ + color: #b22222; + } + .org-constant { + /* font-lock-constant-face */ + color: #5f9ea0; + } + .org-cursor { + /* cursor */ + background-color: #000000; + } + .org-default { + /* default */ + color: #000000; + background-color: #ffffff; + } + .org-diary { + /* diary */ + color: #ff0000; + } + .org-doc { + /* font-lock-doc-face */ + color: #bc8f8f; + } + .org-escape-glyph { + /* escape-glyph */ + color: #a52a2a; + } + .org-file-name-shadow { + /* file-name-shadow */ + color: #7f7f7f; + } + .org-fixed-pitch { + } + .org-fringe { + /* fringe */ + background-color: #f2f2f2; + } + .org-function-name { + /* font-lock-function-name-face */ + color: #0000ff; + } + .org-header-line { + /* header-line */ + color: #333333; + background-color: #e5e5e5; + } + .org-help-argument-name { + /* help-argument-name */ + font-style: italic; + } + .org-highlight { + /* highlight */ + background-color: #b4eeb4; + } + .org-holiday { + /* holiday */ + background-color: #ffc0cb; + } + .org-info-header-node { + /* info-header-node */ + color: #a52a2a; + font-weight: bold; + font-style: italic; + } + .org-info-header-xref { + /* info-header-xref */ + color: #0000ff; + text-decoration: underline; + } + .org-info-menu-header { + /* info-menu-header */ + font-weight: bold; + } + .org-info-menu-star { + /* info-menu-star */ + color: #ff0000; + } + .org-info-node { + /* info-node */ + color: #a52a2a; + font-weight: bold; + font-style: italic; + } + .org-info-title-1 { + /* info-title-1 */ + font-size: 172%; + font-weight: bold; + } + .org-info-title-2 { + /* info-title-2 */ + font-size: 144%; + font-weight: bold; + } + .org-info-title-3 { + /* info-title-3 */ + font-size: 120%; + font-weight: bold; + } + .org-info-title-4 { + /* info-title-4 */ + font-weight: bold; + } + .org-info-xref { + /* info-xref */ + color: #0000ff; + text-decoration: underline; + } + .org-isearch { + /* isearch */ + color: #b0e2ff; + background-color: #cd00cd; + } + .org-italic { + /* italic */ + font-style: italic; + } + .org-keyword { + /* font-lock-keyword-face */ + color: #a020f0; + } + .org-lazy-highlight { + /* lazy-highlight */ + background-color: #afeeee; + } + .org-link { + /* link */ + color: #0000ff; + text-decoration: underline; + } + .org-link-visited { + /* link-visited */ + color: #8b008b; + text-decoration: underline; + } + .org-match { + /* match */ + background-color: #ffff00; + } + .org-menu { + } + .org-message-cited-text { + /* message-cited-text */ + color: #ff0000; + } + .org-message-header-cc { + /* message-header-cc */ + color: #191970; + } + .org-message-header-name { + /* message-header-name */ + color: #6495ed; + } + .org-message-header-newsgroups { + /* message-header-newsgroups */ + color: #00008b; + font-weight: bold; + font-style: italic; + } + .org-message-header-other { + /* message-header-other */ + color: #4682b4; + } + .org-message-header-subject { + /* message-header-subject */ + color: #000080; + font-weight: bold; + } + .org-message-header-to { + /* message-header-to */ + color: #191970; + font-weight: bold; + } + .org-message-header-xheader { + /* message-header-xheader */ + color: #0000ff; + } + .org-message-mml { + /* message-mml */ + color: #228b22; + } + .org-message-separator { + /* message-separator */ + color: #a52a2a; + } + .org-minibuffer-prompt { + /* minibuffer-prompt */ + color: #0000cd; + } + .org-mm-uu-extract { + /* mm-uu-extract */ + color: #006400; + background-color: #ffffe0; + } + .org-mode-line { + /* mode-line */ + color: #000000; + background-color: #bfbfbf; + } + .org-mode-line-buffer-id { + /* mode-line-buffer-id */ + font-weight: bold; + } + .org-mode-line-highlight { + } + .org-mode-line-inactive { + /* mode-line-inactive */ + color: #333333; + background-color: #e5e5e5; + } + .org-mouse { + /* mouse */ + background-color: #000000; + } + .org-negation-char { + } + .org-next-error { + /* next-error */ + background-color: #eedc82; + } + .org-nobreak-space { + /* nobreak-space */ + color: #a52a2a; + text-decoration: underline; + } + .org-org-agenda-date { + /* org-agenda-date */ + color: #0000ff; + } + .org-org-agenda-date-weekend { + /* org-agenda-date-weekend */ + color: #0000ff; + font-weight: bold; + } + .org-org-agenda-restriction-lock { + /* org-agenda-restriction-lock */ + background-color: #ffff00; + } + .org-org-agenda-structure { + /* org-agenda-structure */ + color: #0000ff; + } + .org-org-archived { + /* org-archived */ + color: #7f7f7f; + } + .org-org-code { + /* org-code */ + color: #7f7f7f; + } + .org-org-column { + /* org-column */ + background-color: #e5e5e5; + } + .org-org-column-title { + /* org-column-title */ + background-color: #e5e5e5; + font-weight: bold; + text-decoration: underline; + } + .org-org-date { + /* org-date */ + color: #a020f0; + text-decoration: underline; + } + .org-org-done { + /* org-done */ + color: #228b22; + font-weight: bold; + } + .org-org-drawer { + /* org-drawer */ + color: #0000ff; + } + .org-org-ellipsis { + /* org-ellipsis */ + color: #b8860b; + text-decoration: underline; + } + .org-org-formula { + /* org-formula */ + color: #b22222; + } + .org-org-headline-done { + /* org-headline-done */ + color: #bc8f8f; + } + .org-org-hide { + /* org-hide */ + color: #e5e5e5; + } + .org-org-latex-and-export-specials { + /* org-latex-and-export-specials */ + color: #8b4513; + } + .org-org-level-1 { + /* org-level-1 */ + color: #0000ff; + } + .org-org-level-2 { + /* org-level-2 */ + color: #b8860b; + } + .org-org-level-3 { + /* org-level-3 */ + color: #a020f0; + } + .org-org-level-4 { + /* org-level-4 */ + color: #b22222; + } + .org-org-level-5 { + /* org-level-5 */ + color: #228b22; + } + .org-org-level-6 { + /* org-level-6 */ + color: #5f9ea0; + } + .org-org-level-7 { + /* org-level-7 */ + color: #da70d6; + } + .org-org-level-8 { + /* org-level-8 */ + color: #bc8f8f; + } + .org-org-link { + /* org-link */ + color: #a020f0; + text-decoration: underline; + } + .org-org-property-value { + } + .org-org-scheduled-previously { + /* org-scheduled-previously */ + color: #b22222; + } + .org-org-scheduled-today { + /* org-scheduled-today */ + color: #006400; + } + .org-org-sexp-date { + /* org-sexp-date */ + color: #a020f0; + } + .org-org-special-keyword { + /* org-special-keyword */ + color: #bc8f8f; + } + .org-org-table { + /* org-table */ + color: #0000ff; + } + .org-org-tag { + /* org-tag */ + font-weight: bold; + } + .org-org-target { + /* org-target */ + text-decoration: underline; + } + .org-org-time-grid { + /* org-time-grid */ + color: #b8860b; + } + .org-org-todo { + /* org-todo */ + color: #ff0000; + } + .org-org-upcoming-deadline { + /* org-upcoming-deadline */ + color: #b22222; + } + .org-org-verbatim { + /* org-verbatim */ + color: #7f7f7f; + text-decoration: underline; + } + .org-org-warning { + /* org-warning */ + color: #ff0000; + font-weight: bold; + } + .org-outline-1 { + /* outline-1 */ + color: #0000ff; + } + .org-outline-2 { + /* outline-2 */ + color: #b8860b; + } + .org-outline-3 { + /* outline-3 */ + color: #a020f0; + } + .org-outline-4 { + /* outline-4 */ + color: #b22222; + } + .org-outline-5 { + /* outline-5 */ + color: #228b22; + } + .org-outline-6 { + /* outline-6 */ + color: #5f9ea0; + } + .org-outline-7 { + /* outline-7 */ + color: #da70d6; + } + .org-outline-8 { + /* outline-8 */ + color: #bc8f8f; + } + .outline-text-1, .outline-text-2, .outline-text-3, .outline-text-4, .outline-text-5, .outline-text-6 { + /* Add more spacing between section. Padding, so that folding with org-info.js works as expected. */ + + } + + .org-preprocessor { + /* font-lock-preprocessor-face */ + color: #da70d6; + } + .org-query-replace { + /* query-replace */ + color: #b0e2ff; + background-color: #cd00cd; + } + .org-regexp-grouping-backslash { + /* font-lock-regexp-grouping-backslash */ + font-weight: bold; + } + .org-regexp-grouping-construct { + /* font-lock-regexp-grouping-construct */ + font-weight: bold; + } + .org-region { + /* region */ + background-color: #eedc82; + } + .org-rmail-highlight { + } + .org-scroll-bar { + /* scroll-bar */ + background-color: #bfbfbf; + } + .org-secondary-selection { + /* secondary-selection */ + background-color: #ffff00; + } + .org-shadow { + /* shadow */ + color: #7f7f7f; + } + .org-show-paren-match { + /* show-paren-match */ + background-color: #40e0d0; + } + .org-show-paren-mismatch { + /* show-paren-mismatch */ + color: #ffffff; + background-color: #a020f0; + } + .org-string { + /* font-lock-string-face */ + color: #bc8f8f; + } + .org-texinfo-heading { + /* texinfo-heading */ + color: #0000ff; + } + .org-tool-bar { + /* tool-bar */ + color: #000000; + background-color: #bfbfbf; + } + .org-tooltip { + /* tooltip */ + color: #000000; + background-color: #ffffe0; + } + .org-trailing-whitespace { + /* trailing-whitespace */ + background-color: #ff0000; + } + .org-type { + /* font-lock-type-face */ + color: #228b22; + } + .org-underline { + /* underline */ + text-decoration: underline; + } + .org-variable-name { + /* font-lock-variable-name-face */ + color: #b8860b; + } + .org-variable-pitch { + } + .org-vertical-border { + } + .org-warning { + /* font-lock-warning-face */ + color: #ff0000; + font-weight: bold; + } + .rss_box {} + .rss_title, rss_title a {} + .rss_items {} + .rss_item a:link, .rss_item a:visited, .rss_item a:active {} + .rss_item a:hover {} + .rss_date {} + + pre.src { + position: static; + overflow: visible; + padding-top: 1.2em; + } + + label.org-src-name { + font-size: 80%; + font-style: italic; + } + + #show_source {margin: 0; padding: 0;} + + #postamble { + font-size: 75%; + min-width: 700px; + max-width: 80%; + line-height: 14pt; + margin-left: 20px; + margin-top: 10px; + padding: .2em; + background-color: #ffffff; + z-index: -1000; + } + + +} /* END OF @media all */ + +@media screen +{ + #table-of-contents { + position: fixed; + margin-top: 105px; + float: right; + border: 1px solid #red; + max-width: 50%; + overflow: auto; + } +} /* END OF @media screen */ diff --git a/docs/theme.setup b/docs/theme.setup index c56aee9..da0d396 100644 --- a/docs/theme.setup +++ b/docs/theme.setup @@ -1,7 +1,15 @@ # -*- mode: org; -*- #+HTML_LINK_HOME: index.html -#+OPTIONS: H:4 num:t toc:t \n:nil @:t ::t |:t ^:t -:t f:t *:t <:t -#+SETUPFILE: ../docs/org-html-themes/org/theme-readtheorg.setup +#+OPTIONS: H:4 num:t toc:t \n:nil @:t ::t |:t ^:t -:t f:t *:t <:t d:(HIDE) + +# SETUPFILE: ../docs/org-html-themes/org/theme-readtheorg.setup + +#+INFOJS_OPT: toc:t mouse:underline path:org-info.js +#+HTML_HEAD: + +#+STARTUP: align fold nodlcheck hidestars oddeven lognotestate +#+AUTHOR: TREX CoE +#+LANGUAGE: en diff --git a/src/Makefile b/src/Makefile index 90ee33a..042c095 100644 --- a/src/Makefile +++ b/src/Makefile @@ -3,6 +3,11 @@ # This file was created by tools/Building.org +# Dependencies + + +LIBS=-lpthread + # Variables @@ -39,7 +44,7 @@ FFLAGS=-fPIC $(INCLUDE) \ -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ -ffpe-trap=zero,overflow,underflow -LIBS=-lgfortran -lm +LIBS+=-lgfortran -lm #---------------------------------------------------------- endif @@ -54,7 +59,7 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=ifort -xHost FFLAGS=-fPIC -g -O2 $(INCLUDE) -LIBS=-lm -lifcore -lirc +LIBS+=-lm -lifcore -lirc #---------------------------------------------------------- CC=icc -xHost endif @@ -70,12 +75,14 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=flang FFLAGS=fPIC -g -O2 $(INCLUDE) -LIBS=-lm +LIBS+=-lm #---------------------------------------------------------- endif # Rules +# The source files are created during the generation of the file ~Makefile.generated~. + .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files @@ -83,14 +90,17 @@ endif libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated -test: Makefile.generated +../include/qmckl.h: libqmckl.so + ../tools/build_qmckl_h.sh + +test: Makefile.generated ../include/qmckl.h $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_doc.sh clean: - $(RM) qmckl.h test_qmckl_* test_qmckl.c test_qmckl \ + $(RM) test_qmckl_* test_qmckl.c test_qmckl \ qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ Makefile.generated libqmckl.so *.html *.mod diff --git a/src/README.org b/src/README.org index d09949d..86e2908 100644 --- a/src/README.org +++ b/src/README.org @@ -1,246 +1,68 @@ #+TITLE: QMCkl source code documentation -#+EXPORT_FILE_NAME: index.html #+PROPERTY: comments org #+SETUPFILE: ../docs/theme.setup +------------------ -* Introduction + #+begin_comment + The .org files is included here in the order specified in the + table_of_contents file. + #+end_comment + + #+NAME: toc + #+begin_src sh :exports none +grep TITLE $(cat table_of_contents) | tr ':' ' ' + #+end_src + + #+RESULTS: toc + | qmckl.org | #+TITLE | Header | files | + | qmckl_error.org | #+TITLE | Error | handling | + | qmckl_context.org | #+TITLE | Context | | + | qmckl_precision.org | #+TITLE | Multi-precision | | + | qmckl_memory.org | #+TITLE | Memory | management | + | qmckl_distance.org | #+TITLE | Distances | | + | qmckl_ao.org | #+TITLE | Atomic | Orbitals | + | test_qmckl.org | #+TITLE | Testing | | + + #+begin_src python :var data=toc :exports results :results raw +result = [] +for row in data: + filename = row[0].split('.')[0] + ".html" + title = ' '.join(row[2:]).strip() + result += [ f" - [[./{filename}][{title}]]" ] +return '\n'.join(result) + #+end_src + + #+RESULTS: + - [[./qmckl.html][Introduction]] + - [[./qmckl_error.html][Error handling]] + - [[./qmckl_context.html][Context]] + - [[./qmckl_precision.html][Multi-precision]] + - [[./qmckl_memory.html][Memory management]] + - [[./qmckl_distance.html][Distances]] + - [[./qmckl_ao.html][Atomic Orbitals]] + - [[./test_qmckl.html][Testing]] + + +-------------------------------- The ultimate goal of the QMCkl library is to provide a high-performance implementation of the main kernels of QMC. In this particular - implementation of the library, we focus on the definition of the API and the tests, and - on a /pedagogical/ presentation of the algorithms. We expect the - HPC experts to use this repository as a reference for re-writing - optimized libraries. + implementation of the library, we focus on the definition of the API + and the tests, and on a /pedagogical/ presentation of the + algorithms. We expect the HPC experts to use this repository as a + reference for re-writing optimized libraries. + The source code of the library is available at + https://github.com/trex-coe/qmckl + and bug reports should be submitted at + https://github.com/trex-coe/qmckl/issues. -** Literate programming +------------------ - In a traditional source code, most of the lines of source files of a program - are code, scripts, Makefiles, and only a few lines are comments explaining - parts of the code that are non-trivial to understand. The documentation of - the prorgam is usually written in a separate directory, and is often outdated - compared to the code. - - Literate programming is a different approach to programming, - where the program is considered as a publishable-quality document. Most of - the lines of the source files are text, mathematical formulas, tables, - figures, /etc/, and the lines of code are just the translation in a computer - language of the ideas and algorithms expressed in the text. More importantly, - the "document" is structured like a text document with sections, subsections, - a bibliography, a table of contents /etc/, and the place where pieces of code - appear are the places where they should belong for the reader to understand - the logic of the program, not the places where the compiler expects to find - them. Both the publishable-quality document and the binary executable are - produced from the same source files. - - Literate programming is particularly well adapted in this context, as the - central part of this project is the documentation of an API. The - implementation of the algorithms is just an expression of the algorithms in a - language that can be compiled, so that the correctness of the algorithms can - be tested. - - We have chosen to write the source files in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, - as any text editor can be used to edit org-mode files. To - produce the documentation, there exists multiple possibilities to convert - org-mode files into different formats such as HTML or PDF. The source code is - easily extracted from the org-mode files invoking the Emacs text editor from - the command-line in the =Makefile=, and then the produced files are compiled. - Moreover, within the Emacs text editor the source code blocks can be executed - interactively, in the same spirit as Jupyter notebooks. - - -** Source code editing - - For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. - - Any text editor can be used to edit org-mode files. For a better - user experience Emacs is recommended. For users hating Emacs, it - is good to know that Emacs can behave like Vim when switched into - ``Evil'' mode. - - In the =tools/init.el= file, we provide a minimal Emacs configuration - file for vim users. This file should be copied into =.emacs.d/init.el=. - - For users with a preference for Jupyter notebooks, we also provide the - =tools/nb_to_org.sh= script can convert jupyter notebooks into org-mode - files. - - Note that pandoc can be used to convert multiple markdown formats into - org-mode. - - -** Choice of the programming language - - Most of the codes of the TREX CoE are written in Fortran with some scripts in - Bash and Python. Outside of the CoE, Fortran is also important (Casino, Amolqc), - and other important languages used by the community are C and C++ (QMCPack, - QWalk), and Julia is gaining in popularity. The library we design should be - compatible with all of these languages. The QMCkl API has to be compatible - with the C language since libraries with a C-compatible API can be used in - every other language. - - High-performance versions of the QMCkl, with the same API, will be rewritten by - the experts in HPC. These optimized libraries will be tuned for specific - architectures, among which we can cite x86 based processors, and GPU - accelerators. Nowadays, the most efficient software tools to take advantage of - low-level features of the processor (intrinsics) and of GPUs are for C++ - developers. It is highly probable that the optimized implementations will be - written in C++, and this is agreement with our choice to make the API - C-compatible. - - Fortran is one of the most common languages used by the community, and is simple - enough to make the algorithms readable both by experts in QMC, and experts in - HPC. Hence we propose in this pedagogical implementation of QMCkl to use Fortran - to express the QMC algorithms. As the main languages of the library is C, this - implies that the exposed C functions call the Fortran routine. However, for - internal functions related to system programming, the C language is more natural - than Fortran. - - The Fortran source files should provide a C interface using the - ~iso_c_binding~ module. The name of the Fortran source files should end with - =_f.f90= to be properly handled by the =Makefile=. The names of the functions - defined in Fortran should be the same as those exposed in the API suffixed by - =_f=. Fortran interfaces should also be written in the =qmckl_f.f90= file. - - For more guidelines on using Fortran to generate a C interface, see - [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]]. - - -# Coding style -# # TODO: decide on a coding style - -# To improve readability, we maintain a consistent coding style in -# the library. - -# - For C source files, we will use __(decide on a coding style)__ -# - For Fortran source files, we will use __(decide on a coding -# style)__ - -# Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. - -** Design of the library - - The proposed API should allow the library to: deal with memory transfers - between CPU and accelerators, and to use different levels of floating-point - precision. We chose a multi-layered design with low-level and high-level - functions (see below). - -*** Naming conventions - - To avoid namespace collisions, we use =qmckl_= as a prefix for all exported - functions and variables. All exported header files should have a file name - prefixed with =qmckl_=. - - If the name of the org-mode file is =xxx.org=, the name of the - produced C files should be =xxx.c= and =xxx.h= and the name of the - produced Fortran file should be =xxx.f90=. - - Arrays are in uppercase and scalars are in lowercase. - - In the names of the variables and functions, only the singular - form is allowed. - -*** Application programming interface - - In the C language, the number of bits used by the integer types can change - from one architecture to another one. To circumvent this problem, we choose to - use the integer types defined in ~~ where the number of bits used for - the integers are fixed. - - To ensure that the library will be easily usable in /any/ other language - than C, we restrict the data types in the interfaces to the following: - - 32-bit and 64-bit integers, scalars and and arrays (~int32_t~ and ~int64_t~) - - 32-bit and 64-bit floats, scalars and and arrays (~float~ and ~double~) - - Pointers are always casted into 64-bit integers, even on legacy 32-bit architectures - - ASCII strings are represented as a pointers to character arrays - and terminated by a ~'\0'~ character (C convention). - - Complex numbers can be represented by an array of 2 floats. - - Boolean variables are stored as integers, ~1~ for ~true~ and ~0~ for ~false~ - - Floating point variables should be by default - - ~double~ unless explicitly mentioned - - integers used for counting should always be ~int64_t~ - - To facilitate the use in other languages than C, we will provide some - bindings in other languages in other repositories. - - # TODO : Link to repositories for bindings - # To facilitate the use in other languages than C, we provide some - # bindings in other languages in other repositories. - -*** Global state - - Global variables should be avoided in the library, because it is - possible that one single program needs to use multiple instances - of the library. To solve this problem we propose to use a pointer - to a =context= variable, built by the library with the - =qmckl_context_create= function. The =context= contains the global - state of the library, and is used as the first argument of many - QMCkl functions. - - The internal structure of the context is not specified, to give a - maximum of freedom to the different implementations. Modifying - the state is done by setters and getters, prefixed by - =qmckl_context_set_= an =qmckl_context_get_=. When a context - variable is modified by a setter, a copy of the old data structure - is made and updated, and the pointer to the new data structure is - returned, such that the old contexts can still be accessed. It is - also possible to modify the state in an impure fashion, using the - =qmckl_context_update_= functions. The context and its old - versions can be destroyed with =qmckl_context_destroy=. - -*** Low-level functions - - Low-level functions are very simple functions which are leaves of - the function call tree (they don't call any other QMCkl function). - - These functions are /pure/, and unaware of the QMCkl - =context=. They are not allowed to allocate/deallocate memory, and - if they need temporary memory it should be provided in input. - -*** High-level functions - - High-level functions are at the top of the function call tree. - They are able to choose which lower-level function to call - depending on the required precision, and do the corresponding type - conversions. These functions are also responsible for allocating - temporary storage, to simplify the use of accelerators. - - The high-level functions should be pure, unless the introduction - of non-purity is justified. All the side effects should be made in - the =context= variable. - - # TODO : We need an identifier for impure functions - -*** Numerical precision - - The number of bits of precision required for a function should be - given as an input of low-level computational functions. This input - will be used to define the values of the different thresholds that - might be used to avoid computing unnecessary noise. High-level - functions will use the precision specified in the =context= - variable. - -** Algorithms - - Reducing the scaling of an algorithm usually implies also reducing - its arithmetic complexity (number of flops per byte). Therefore, - for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) - algorithms are better adapted than linear scaling algorithms. As - QMCkl is a general purpose library, multiple algorithms should be - implemented adapted to different problem sizes. - -** Rules for the API - - - =stdint= should be used for integers (=int32_t=, =int64_t=) - - integers used for counting should always be =int64_t= - - floats should be by default =double=, unless explicitly mentioned - - pointers are converted to =int64_t= to increase portability - -* Documentation - - # The .org files will be appended here in the order specified in the - # table_of_contents file + [[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] [[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. +# -*- mode: org -*- + diff --git a/src/qmckl.org b/src/qmckl.org index b9a736f..ff58ace 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -1,19 +1,253 @@ -#+TITLE: Header files +#+TITLE: Introduction +#+PROPERTY: comments org #+SETUPFILE: ../docs/theme.setup +# -*- mode: org -*- + +* Using QMCkl -The =qmckl.h= header file has to be included in <<>> codes when +The =qmckl.h= header file has to be included in C codes when QMCkl functions are used: -#+begin_src c :tangle none +#+begin_src c :tangle no #include "qmckl.h" -#+end_src f90 +#+end_src - -In <<>> programs, the =qmckl_f.f90= interface file should be +In Fortran programs, the =qmckl_f.f90= interface file should be included in the source code using the library, and the Fortran codes should use the ~qmckl~ module as -#+begin_src f90 :tangle none +#+begin_src f90 :tangle no use qmckl -#+end_src f90 +#+end_src + +Both files are located in the =include/= directory. + +* Developing in QMCkl + +** Literate programming + + In a traditional source code, most of the lines of source files of a program + are code, scripts, Makefiles, and only a few lines are comments explaining + parts of the code that are non-trivial to understand. The documentation of + the prorgam is usually written in a separate directory, and is often outdated + compared to the code. + + Literate programming is a different approach to programming, + where the program is considered as a publishable-quality document. Most of + the lines of the source files are text, mathematical formulas, tables, + figures, /etc/, and the lines of code are just the translation in a computer + language of the ideas and algorithms expressed in the text. More importantly, + the "document" is structured like a text document with sections, subsections, + a bibliography, a table of contents /etc/, and the place where pieces of code + appear are the places where they should belong for the reader to understand + the logic of the program, not the places where the compiler expects to find + them. Both the publishable-quality document and the binary executable are + produced from the same source files. + + Literate programming is particularly well adapted in this context, as the + central part of this project is the documentation of an API. The + implementation of the algorithms is just an expression of the algorithms in a + language that can be compiled, so that the correctness of the algorithms can + be tested. + + We have chosen to write the source files in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, + as any text editor can be used to edit org-mode files. To + produce the documentation, there exists multiple possibilities to convert + org-mode files into different formats such as HTML or PDF. The source code is + easily extracted from the org-mode files invoking the Emacs text editor from + the command-line in the =Makefile=, and then the produced files are compiled. + Moreover, within the Emacs text editor the source code blocks can be executed + interactively, in the same spirit as Jupyter notebooks. + + +** Source code editing + + For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. + + Any text editor can be used to edit org-mode files. For a better + user experience Emacs is recommended. For users hating Emacs, it + is good to know that Emacs can behave like Vim when switched into + ``Evil'' mode. + + In the =tools/init.el= file, we provide a minimal Emacs configuration + file for vim users. This file should be copied into =.emacs.d/init.el=. + + For users with a preference for Jupyter notebooks, we also provide the + =tools/nb_to_org.sh= script can convert jupyter notebooks into org-mode + files. + + Note that pandoc can be used to convert multiple markdown formats into + org-mode. + + +** Choice of the programming language + + Most of the codes of the [[https://trex-coe.eu][TREX CoE]] are written in Fortran with some scripts in + Bash and Python. Outside of the CoE, Fortran is also important (Casino, Amolqc), + and other important languages used by the community are C and C++ (QMCPack, + QWalk), and Julia is gaining in popularity. The library we design should be + compatible with all of these languages. The QMCkl API has to be compatible + with the C language since libraries with a C-compatible API can be used in + every other language. + + High-performance versions of the QMCkl, with the same API, will be rewritten by + the experts in HPC. These optimized libraries will be tuned for specific + architectures, among which we can cite x86 based processors, and GPU + accelerators. Nowadays, the most efficient software tools to take advantage of + low-level features of the processor (intrinsics) and of GPUs are for C++ + developers. It is highly probable that the optimized implementations will be + written in C++, and this is agreement with our choice to make the API + C-compatible. + + Fortran is one of the most common languages used by the community, and is simple + enough to make the algorithms readable both by experts in QMC, and experts in + HPC. Hence we propose in this pedagogical implementation of QMCkl to use Fortran + to express the QMC algorithms. As the main languages of the library is C, this + implies that the exposed C functions call the Fortran routine. However, for + internal functions related to system programming, the C language is more natural + than Fortran. + + The Fortran source files should provide a C interface using the + ~iso_c_binding~ module. The name of the Fortran source files should end with + =_f.f90= to be properly handled by the =Makefile=. The names of the functions + defined in Fortran should be the same as those exposed in the API suffixed by + =_f=. Fortran interfaces should also be written in the =qmckl_f.f90= file. + + For more guidelines on using Fortran to generate a C interface, see + [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]]. + + + # Coding style + # # TODO: decide on a coding style + + # To improve readability, we maintain a consistent coding style in + # the library. + + # - For C source files, we will use __(decide on a coding style)__ + # - For Fortran source files, we will use __(decide on a coding + # style)__ + + # Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. + +** Design of the library + + The proposed API should allow the library to: deal with memory transfers + between CPU and accelerators, and to use different levels of floating-point + precision. We chose a multi-layered design with low-level and high-level + functions (see below). + +** Naming conventions + + To avoid namespace collisions, we use =qmckl_= as a prefix for all exported + functions and variables. All exported header files should have a file name + prefixed with =qmckl_=. + + If the name of the org-mode file is =xxx.org=, the name of the + produced C files should be =xxx.c= and =xxx.h= and the name of the + produced Fortran file should be =xxx.f90=. + + Arrays are in uppercase and scalars are in lowercase. + + In the names of the variables and functions, only the singular + form is allowed. + +** Application programming interface + + In the C language, the number of bits used by the integer types can change + from one architecture to another one. To circumvent this problem, we choose to + use the integer types defined in ~~ where the number of bits used for + the integers are fixed. + + To ensure that the library will be easily usable in /any/ other language + than C, we restrict the data types in the interfaces to the following: + - 32-bit and 64-bit integers, scalars and and arrays (~int32_t~ and ~int64_t~) + - 32-bit and 64-bit floats, scalars and and arrays (~float~ and ~double~) + - Pointers are always casted into 64-bit integers, even on legacy 32-bit architectures + - ASCII strings are represented as a pointers to character arrays + and terminated by a ~'\0'~ character (C convention). + - Complex numbers can be represented by an array of 2 floats. + - Boolean variables are stored as integers, ~1~ for ~true~ and ~0~ for ~false~ + - Floating point variables should be by default + - ~double~ unless explicitly mentioned + - integers used for counting should always be ~int64_t~ + + To facilitate the use in other languages than C, we will provide some + bindings in other languages in other repositories. + + # TODO : Link to repositories for bindings + # To facilitate the use in other languages than C, we provide some + # bindings in other languages in other repositories. + +** Global state + + Global variables should be avoided in the library, because it is + possible that one single program needs to use multiple instances + of the library. To solve this problem we propose to use a pointer + to a [[./qmckl_context.html][=context=]] variable, built by the library with the + =qmckl_context_create= function. The <<<=context=>>> contains the global + state of the library, and is used as the first argument of many + QMCkl functions. + + The internal structure of the context is not specified, to give a + maximum of freedom to the different implementations. Modifying + the state is done by setters and getters, prefixed by + =qmckl_context_set_= an =qmckl_context_get_=. When a context + variable is modified by a setter, a copy of the old data structure + is made and updated, and the pointer to the new data structure is + returned, such that the old contexts can still be accessed. It is + also possible to modify the state in an impure fashion, using the + =qmckl_context_update_= functions. The context and its old + versions can be destroyed with =qmckl_context_destroy=. + +** Low-level functions + + Low-level functions are very simple functions which are leaves of + the function call tree (they don't call any other QMCkl function). + + These functions are /pure/, and unaware of the QMCkl + =context=. They are not allowed to allocate/deallocate memory, and + if they need temporary memory it should be provided in input. + +** High-level functions + + High-level functions are at the top of the function call tree. + They are able to choose which lower-level function to call + depending on the required precision, and do the corresponding type + conversions. These functions are also responsible for allocating + temporary storage, to simplify the use of accelerators. + + The high-level functions should be pure, unless the introduction + of non-purity is justified. All the side effects should be made in + the =context= variable. + + # TODO : We need an identifier for impure functions + +** Numerical precision + + The number of bits of precision required for a function should be + given as an input of low-level computational functions. This input + will be used to define the values of the different thresholds that + might be used to avoid computing unnecessary noise. High-level + functions will use the precision specified in the =context= + variable. + +** Algorithms + + Reducing the scaling of an algorithm usually implies also reducing + its arithmetic complexity (number of flops per byte). Therefore, + for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) + algorithms are better adapted than linear scaling algorithms. As + QMCkl is a general purpose library, multiple algorithms should be + implemented adapted to different problem sizes. + +** Rules for the API + + - =stdint= should be used for integers (=int32_t=, =int64_t=) + - integers used for counting should always be =int64_t= + - floats should be by default =double=, unless explicitly mentioned + - pointers are converted to =int64_t= to increase portability + + + + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 6edfe2c..8a68835 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,20 +1,24 @@ #+TITLE: Context #+SETUPFILE: ../docs/theme.setup - This file is written in C because it is more natural to express the - context in C than in Fortran. The context variable is a handle for the state of the library, - and is stored in a data structure, which can't be seen outside of + and is stored in a data structure which can't be seen outside of the library. To simplify compatibility with other languages, the pointer to the internal data structure is converted into a 64-bit - signed integer, defined in the ~qmckl_context~ type. A value of ~0~ - for the context is equivalent to a ~NULL~ pointer. + signed integer, defined in the ~qmckl_context~ type. + A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a + ~NULL~ pointer. #+begin_src c :comments org :tangle (eval h) typedef int64_t qmckl_context ; +#define QMCKL_NULL_CONTEXT (qmckl_context) 0 #+end_src + #+begin_src f90 :comments org :tangle (eval fh) :exports none + integer*8, parameter :: QMCKL_NULL_CONTEXT = 0 + #+end_src + * Headers :noexport: #+NAME: filename @@ -34,6 +38,7 @@ MunitResult test_<>() { #define __QMCKL_CONTEXT__ #include +#include #include "qmckl_error.h" #+end_src @@ -46,191 +51,352 @@ MunitResult test_<>() { #include #include "qmckl_error.h" -#include "qmckl_context_private.h" #include "qmckl_context.h" +#include "qmckl_context_private.h" #include "qmckl_memory.h" -#include "qmckl_precision.h" #+end_src - * Context handling - The tag is used internally to check if the memory domain pointed - by a pointer is a valid <<>>. + The context appears as an immutable data structure: modifying a + context returns a new context with the modifications. Therefore, it + is necessary to store a pointer to the old version of context so + that it can be freed when necessary. + Note that we also provide a possibility to mutate the context, but + this should be done with caution, only when it is justified. - #+begin_src c :comments org :tangle (eval h_private) :noweb yes -<> -<> + By convention, in this file ~context~ is a ~qmckl_context~ variable + and ~ctx~ is a ~qmckl_context_struct*~ pointer. +** Data structure + + The main data structure contains pointers to other data structures, + containing the data specific to each given domain, such that the + modified contexts don't need to duplicate the data but only the + pointers. + + #+NAME: qmckl_context_struct + #+begin_src c :comments org :tangle none :noweb yes typedef struct qmckl_context_struct { + /* Pointer to the previous context, before modification */ struct qmckl_context_struct * prev; /* Molecular system */ - // qmckl_nucleus_struct * nucleus; - // qmckl_electron_struct * electron; - qmckl_ao_basis_struct * ao_basis; - // qmckl_mo_struct * mo; - // qmckl_determinant_struct * det; + qmckl_ao_basis_struct * ao_basis; + + /* To be implemented: + qmckl_nucleus_struct * nucleus; + qmckl_electron_struct * electron; + qmckl_mo_struct * mo; + qmckl_determinant_struct * det; + ,*/ /* Numerical precision */ - uint32_t tag; - int32_t precision; - int32_t range; + qmckl_precision_struct * fp; /* Error handling */ - qmckl_error_struct * error; + qmckl_error_struct * error; + + /* Memory allocation */ + qmckl_memory_struct * alloc; + + /* Thread lock */ + pthread_mutex_t mutex; + + /* Validity checking */ + uint32_t tag; } qmckl_context_struct; + #+end_src + + #+begin_src c :comments org :tangle (eval h_private) :noweb yes :exports none +<> + +<> + +<> + +<> + +<> + #+end_src + + A tag is used internally to check if the memory domain pointed + by a pointer is a valid context. This allows to check that even if + the pointer associated with a context is non-null, we can still + verify that it points to the expected data structure. + + #+begin_src c :comments org :tangle (eval h_private) :noweb yes #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF - #+end_src + #+end_src -** ~qmckl_context_check~ + The ~qmckl_context_check~ function checks if the domain pointed by + the pointer is a valid context. It returns the input ~qmckl_context~ + if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise. - Checks if the domain pointed by the pointer is a valid context. - Returns the input ~qmckl_context~ if the context is valid, 0 - otherwise. - - #+begin_src c :comments org :tangle (eval h) + #+begin_src c :comments org :tangle (eval h) :noexport qmckl_context qmckl_context_check(const qmckl_context context) ; #+end_src -*** Source - #+begin_src c :tangle (eval c) + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_check(const qmckl_context context) { - if (context == (qmckl_context) 0) return (qmckl_context) 0; + if (context == QMCKL_NULL_CONTEXT) + return QMCKL_NULL_CONTEXT; - const qmckl_context_struct * ctx = (qmckl_context_struct*) context; + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx->tag != VALID_TAG) return (qmckl_context) 0; + if (ctx->tag != VALID_TAG) + return QMCKL_NULL_CONTEXT; return context; } - #+end_src + #+end_src -** ~qmckl_context_create~ +** Creation + + To create a new context, ~qmckl_context_create()~ should be used. + - Upon success, it returns a pointer to a new context with the ~qmckl_context~ type + - It returns ~QMCKL_NULL_CONTEXT~ upon failure to allocate the internal data structure - To create a new context, use ~qmckl_context_create()~. - - On success, returns a pointer to a context using the ~qmckl_context~ type - - Returns ~0~ upon failure to allocate the internal data structure - - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context qmckl_context_create(); - #+end_src + #+end_src -*** Source - #+begin_src c :tangle (eval c) + # Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_create() { - qmckl_context_struct* context = - (qmckl_context_struct*) qmckl_malloc ((qmckl_context) 0, sizeof(qmckl_context_struct)); - if (context == NULL) { - return (qmckl_context) 0; + qmckl_context_struct* ctx = + (qmckl_context_struct*) qmckl_malloc (QMCKL_NULL_CONTEXT, sizeof(qmckl_context_struct)); + + if (ctx == NULL) { + return QMCKL_NULL_CONTEXT; } - context->prev = NULL; - context->ao_basis = NULL; - context->precision = QMCKL_DEFAULT_PRECISION; - context->range = QMCKL_DEFAULT_RANGE; - context->tag = VALID_TAG; - context->error = NULL; + /* Set all pointers to NULL */ + memset(ctx, 0, sizeof(qmckl_context_struct)); - return (qmckl_context) context; + /* Initialize lock */ + pthread_mutexattr_t attr; + int rc; + + rc = pthread_mutexattr_init(&attr); + assert (rc == 0); + + (void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK); + + rc = pthread_mutex_init ( &(ctx->mutex), &attr); + assert (rc == 0); + + (void)pthread_mutexattr_destroy(&attr); + + /* Initialize data */ + ctx->tag = VALID_TAG; + + const qmckl_context context = (qmckl_context) ctx; + assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); + + return context; } - #+end_src + #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none interface integer (c_int64_t) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding end function qmckl_context_create end interface - #+end_src + #+end_src + + # Test + #+begin_src c :comments link :tangle (eval c_test) :exports none +munit_assert_int64( qmckl_context_check(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64( qmckl_context_check(0x12345), ==, QMCKL_NULL_CONTEXT); -*** Test :noexport: - #+begin_src c :comments link :tangle (eval c_test) qmckl_context context = qmckl_context_create(); -munit_assert_int64( context, !=, (qmckl_context) 0); -munit_assert_int64( qmckl_context_check(context), ==, context); - #+end_src +munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT ); +munit_assert_int64( qmckl_context_check(context), ==, context ); + #+end_src -** ~qmckl_context_copy~ +** Locking - This function makes a shallow copy of the current context. - - Copying the 0-valued context returns 0 - - On success, returns a pointer to the new context using the ~qmckl_context~ type - - Returns 0 upon failure to allocate the internal data structure - for the new context + For thread safety, the context may be locked/unlocked. The lock is + initialized with the ~PTHREAD_MUTEX_ERRORCHECK~, so it is a bit + slower than a usual mutex but safer. - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +void qmckl_lock (qmckl_context context); +void qmckl_unlock(qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +void qmckl_lock(qmckl_context context) { + if (context == QMCKL_NULL_CONTEXT) + return ; + qmckl_context_struct *ctx = (qmckl_context_struct*) context; + int rc = pthread_mutex_lock( &(ctx->mutex) ); + assert (rc == 0); +} + +void qmckl_unlock(qmckl_context context) { + qmckl_context_struct *ctx = (qmckl_context_struct*) context; + int rc = pthread_mutex_unlock( &(ctx->mutex) ); + assert (rc == 0); +} + #+end_src + +** Copy + + ~qmckl_context_copy~ makes a shallow copy of a context. It returns + ~QMCKL_NULL_CONTEXT~ upon failure. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context qmckl_context_copy(const qmckl_context context); - #+end_src + #+end_src -*** Source - #+begin_src c :tangle (eval c) + # Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_copy(const qmckl_context context) { + qmckl_lock(context); + const qmckl_context checked_context = qmckl_context_check(context); - if (checked_context == (qmckl_context) 0) { - return (qmckl_context) 0; + if (checked_context == QMCKL_NULL_CONTEXT) { + qmckl_unlock(context); + return QMCKL_NULL_CONTEXT; } - qmckl_context_struct* old_context = (qmckl_context_struct*) checked_context; + + qmckl_context_struct* old_ctx = + (qmckl_context_struct*) checked_context; - qmckl_context_struct* new_context = + qmckl_context_struct* new_ctx = (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); - if (new_context == NULL) { - return (qmckl_context) 0; + + if (new_ctx == NULL) { + qmckl_unlock(context); + return QMCKL_NULL_CONTEXT; } - new_context->prev = old_context; - new_context->ao_basis = old_context->ao_basis; - new_context->precision = old_context->precision; - new_context->range = old_context->range; - new_context->tag = VALID_TAG; - new_context->error = old_context->error; + /* Copy the old context on the new one */ + memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct)); - return (qmckl_context) new_context; + qmckl_unlock(context); + + new_ctx->prev = old_ctx; + + return (qmckl_context) new_ctx; } - #+end_src + #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none interface integer (c_int64_t) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_copy end interface - #+end_src + #+end_src -*** Test :noexport: - #+begin_src c :comments link :tangle (eval c_test) + # Test + #+begin_src c :comments link :tangle (eval c_test) :exports none qmckl_context new_context = qmckl_context_copy(context); -munit_assert_int64(new_context, !=, (qmckl_context) 0); + +munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); + #+end_src + +** Destroy + + The context is destroyed with ~qmckl_context_destroy~, leaving the ancestors untouched. + It frees the context, and returns the previous context. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_context qmckl_context_destroy(qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_context qmckl_context_destroy(const qmckl_context context) { + + qmckl_lock(context); + + const qmckl_context checked_context = qmckl_context_check(context); + if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_NULL_CONTEXT; + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + assert (ctx != NULL); /* Shouldn't be true because the context is valid */ + + const qmckl_context prev_context = (qmckl_context) ctx->prev; + memset(ctx, 0, sizeof(qmckl_context_struct)); + ctx->tag = INVALID_TAG; + + const qmckl_exit_code rc = qmckl_free(context,ctx); + assert (rc == QMCKL_SUCCESS); + + if (prev_context == QMCKL_NULL_CONTEXT) { + /* This is the first context, free all memory. */ + while (ctx->alloc != NULL) { + free(ctx->alloc->pointer); + ctx->alloc = ctx->alloc->prev; + } + int rc = pthread_mutex_destroy( &(ctx->mutex) ); + assert (rc == 0); + } + + qmckl_unlock(context); + + return prev_context; +} #+end_src -** ~qmckl_context_previous~ + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int64_t) function qmckl_context_destroy(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_destroy + end interface + #+end_src - Returns the previous context - - On success, returns the ancestor of the current context - - Returns 0 for the initial context - - Returns 0 for the 0-valued context + # Test + #+begin_src c :tangle (eval c_test) :exports none +munit_assert_int64(qmckl_context_check(new_context), ==, new_context); +munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_destroy(new_context), ==, context); +munit_assert_int64(qmckl_context_check(new_context), !=, new_context); +munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_destroy(context), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); + #+end_src - #+begin_src c :comments org :tangle (eval h) +** Access to the previous context + + ~qmckl_context_previous~ returns the previous context. It returns + ~QMCKL_NULL_CONTEXT~ for the initial context and for the ~NULL~ context. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context qmckl_context_previous(const qmckl_context context); - #+end_src + #+end_src -*** Source + # Source #+begin_src c :tangle (eval c) qmckl_context qmckl_context_previous(const qmckl_context context) { @@ -244,8 +410,8 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { } #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none interface integer (c_int64_t) function qmckl_context_previous(context) bind(C) use, intrinsic :: iso_c_binding @@ -254,67 +420,154 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { end interface #+end_src -*** Test :noexport: - #+begin_src c :comments link :tangle (eval c_test) -munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); + # Test + #+begin_src c :comments link :tangle (eval c_test) :exports none +munit_assert_int64(qmckl_context_previous(new_context), !=, QMCKL_NULL_CONTEXT); munit_assert_int64(qmckl_context_previous(new_context), ==, context); -munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); -munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); +munit_assert_int64(qmckl_context_previous(context), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); #+end_src -** ~qmckl_context_destroy~ +* Memory allocation handling + +** Data structure - Destroys the current context, leaving the ancestors untouched. - - Succeeds if the current context is properly destroyed - - Fails otherwise - - Fails if the 0-valued context is given in argument - - Fails if the the pointer is not a valid context - - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code qmckl_context_destroy(qmckl_context context); + Pointers to all allocated memory domains are stored in the context, + in a linked list. The size is also stored, to enable the + computation of the amount of currently used memory by the library. + + #+NAME: qmckl_memory_struct + #+begin_src c :comments org :tangle no +typedef struct qmckl_memory_struct { + struct qmckl_memory_struct * prev ; + void * pointer ; + size_t size ; +} qmckl_memory_struct; #+end_src -*** Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { +** Append memory - const qmckl_context checked_context = qmckl_context_check(context); - if (checked_context == (qmckl_context) 0) return QMCKL_FAILURE; + The following function, called in [[./qmckl_memory.html][=qmckl_memory.c=]], appends a new + pair (pointer, size) to the data structure. + It is forbidden to pass the ~NULL~ pointer, or a zero size. + If the context is ~QMCKL_NULL_CONTEXT~, the function returns + immediately with ~QMCKL_SUCCESS~. - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; + # Header + #+begin_src c :comments org :tangle (eval h_private) :exports none +qmckl_exit_code qmckl_context_append_memory(qmckl_context context, + void* pointer, + const size_t size); + #+end_src + + # Source + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_context_append_memory(qmckl_context context, + void* pointer, + const size_t size) { + assert (pointer != NULL); + assert (size > 0L); + + qmckl_lock(context); + + if ( qmckl_context_check(context) == QMCKL_NULL_CONTEXT ) { + qmckl_unlock(context); + return QMCKL_SUCCESS; + } + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + + qmckl_memory_struct* alloc = (qmckl_memory_struct*) + malloc(sizeof(qmckl_memory_struct)); + + if (alloc == NULL) { + qmckl_unlock(context); + return QMCKL_ALLOCATION_FAILED; + } + + alloc->prev = ctx->alloc; + alloc->pointer = pointer; + alloc->size = size; + + ctx->alloc = alloc; + + qmckl_unlock(context); + + return QMCKL_SUCCESS; - ctx->tag = INVALID_TAG; - return qmckl_free(context,ctx); } - #+end_src + #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_destroy(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_destroy - end interface - #+end_src +** Remove memory + + The following function, called in [[./qmckl_memory.html][=qmckl_memory.c=]], removes a + pointer from the data structure. + It is forbidden to pass the ~NULL~ pointer. + If the context is ~QMCKL_NULL_CONTEXT~, the function returns + immediately with ~QMCKL_SUCCESS~. -*** Test :noexport: - #+begin_src c :tangle (eval c_test) -munit_assert_int64(qmckl_context_check(new_context), ==, new_context); -munit_assert_int64(new_context, !=, (qmckl_context) 0); -munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); -munit_assert_int64(qmckl_context_check(new_context), !=, new_context); -munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); -munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); - #+end_src + # Header + #+begin_src c :comments org :tangle (eval h_private) :exports none +qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, + const void* pointer); + #+end_src + # Source + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, + const void* pointer) { + assert (pointer != NULL); + + qmckl_lock(context); + + if ( qmckl_context_check(context) == QMCKL_NULL_CONTEXT ) { + qmckl_unlock(context); + return QMCKL_SUCCESS; + } + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + + qmckl_memory_struct* alloc; + qmckl_memory_struct* next; + + if (ctx->alloc->pointer == pointer) { + + alloc = ctx->alloc->prev; + free(ctx->alloc); + ctx->alloc = alloc; + + } else { + + next = ctx->alloc; + alloc = next->prev; + + while (alloc != NULL) { + if (alloc->pointer == pointer) { + next->prev = alloc->prev; + free(alloc); + alloc = NULL; + } else { + next = alloc; + alloc = alloc->prev; + } + } + } + + qmckl_unlock(context); + + return QMCKL_SUCCESS; +} + #+end_src + + #+RESULTS: + * Error handling + ** Data structure #+NAME: qmckl_error_struct - #+begin_src c :comments org -#define QMCKL_MAX_FUN_LEN 256 + #+begin_src c :comments org :tangle no +#define QMCKL_MAX_FUN_LEN 256 #define QMCKL_MAX_MSG_LEN 1024 typedef struct qmckl_error_struct { @@ -326,68 +579,110 @@ typedef struct qmckl_error_struct { } qmckl_error_struct; #+end_src -** ~qmckl_context_update_error~ +** Updating errors + + The error is updated in the context using + ~qmckl_context_update_error~, although it is recommended to use + ~qmckl_context_set_error~ for the immutable variant. + When the error is set in the context, it is mandatory to specify + from which function the error is triggered, and a message + explaining the error. The exit code can't be ~QMCKL_SUCCESS~. - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_exit_code -qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); +qmckl_context_update_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message); #+end_src -*** Source - #+begin_src c :tangle (eval c) + # Source + #+begin_src c :tangle (eval c) qmckl_exit_code -qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +qmckl_context_update_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message) { - assert (context != 0); - assert (function != NULL); + /* Passing a function name and a message is mandatory. */ + assert (function_name != NULL); assert (message != NULL); - assert (exit_code > 0); + + /* Exit codes are assumed valid. */ + assert (exit_code >= 0); + assert (exit_code != QMCKL_SUCCESS); assert (exit_code < QMCKL_INVALID_EXIT_CODE); + qmckl_lock(context); + + /* The context is assumed to exist. */ + assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT); + qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; + assert (ctx != NULL); /* Impossible because the context is valid. */ if (ctx->error != NULL) { free(ctx->error); ctx->error = NULL; } - qmckl_error_struct* error = (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); + qmckl_error_struct* error = + (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); error->exit_code = exit_code; - strcpy(error->function, function); + strcpy(error->function, function_name); strcpy(error->message, message); ctx->error = error; + qmckl_unlock(context); + return QMCKL_SUCCESS; } #+end_src -*** TODO Test + The ~qmckl_context_set_error~ function returns a new context with + the error domain updated. -** ~qmckl_context_set_error~ - - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context -qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); +qmckl_context_set_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message); #+end_src -*** Source + # Source #+begin_src c :tangle (eval c) qmckl_context -qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +qmckl_context_set_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message) { - assert (context != 0); - assert (function != NULL); + /* Passing a function name and a message is mandatory. */ + assert (function_name != NULL); assert (message != NULL); - assert (exit_code > 0); + + /* Exit codes are assumed valid. */ + assert (exit_code >= 0); + assert (exit_code != QMCKL_SUCCESS); assert (exit_code < QMCKL_INVALID_EXIT_CODE); - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return context; + /* The context is assumed to be valid */ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_NULL_CONTEXT; - if (qmckl_context_update_error(new_context, exit_code, - function, message) != QMCKL_SUCCESS) { + qmckl_context new_context = qmckl_context_copy(context); + + /* Should be impossible because the context is valid */ + assert (new_context != QMCKL_NULL_CONTEXT); + + if (qmckl_context_update_error(new_context, + exit_code, + function_name, + message) != QMCKL_SUCCESS) { return context; } @@ -395,19 +690,14 @@ qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, } #+end_src -*** TODO Test -*** Test :noexport: - -** ~qmckl_failwith~ - - To make a function fail, the <<<~qmckl_failwith~>>> function should be + To make a function fail, the ~qmckl_failwith~ function should be called, such that information about the failure is stored in the context. The desired exit code is given as an argument, as well as the name of the function and an error message. The return code of the function is the desired return code. - #+begin_src c :comments org :tangle (eval h) + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_exit_code qmckl_failwith(qmckl_context context, const qmckl_exit_code exit_code, const char* function, @@ -420,15 +710,21 @@ qmckl_exit_code qmckl_failwith(qmckl_context context, const char* function, const char* message) { - if (context == 0) return QMCKL_NULL_CONTEXT; assert (exit_code > 0); assert (exit_code < QMCKL_INVALID_EXIT_CODE); assert (function != NULL); assert (message != NULL); assert (strlen(function) < QMCKL_MAX_FUN_LEN); assert (strlen(message) < QMCKL_MAX_MSG_LEN); + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_NULL_CONTEXT; - context = qmckl_context_set_error(context, exit_code, function, message); + const qmckl_exit_code rc = + qmckl_context_update_error(context, exit_code, function, message); + + assert (rc == QMCKL_SUCCESS); + return exit_code; } @@ -446,7 +742,375 @@ if (x < 0) { # To decode the error messages, ~qmckl_strerror~ converts an # error code into a string. -* Basis set + +* Control of the numerical precision + + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. + + #+NAME: table-precision + | ~QMCKL_DEFAULT_PRECISION~ | 53 | + | ~QMCKL_DEFAULT_RANGE~ | 11 | + + # We need to force Emacs not to indent the Python code: + # -*- org-src-preserve-indentation: t + +#+begin_src python :var table=table-precision :results drawer :exports result +""" This script generates the C and Fortran constants for the error + codes from the org-mode table. +""" + +result = [ "#+begin_src c :comments org :tangle (eval h)" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f"#define {text:30s} {code:d}" ] +result += [ "#+end_src" ] + +result += [ "" ] + +result += [ "#+begin_src f90 :comments org :tangle (eval fh) :exports none" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f" integer, parameter :: {text:30s} = {code:d}" ] +result += [ "#+end_src" ] + +return '\n'.join(result) + +#+end_src + +#+RESULTS: +:results: +#+begin_src c :comments org :tangle (eval h) +#define QMCKL_DEFAULT_PRECISION 53 +#define QMCKL_DEFAULT_RANGE 11 +#+end_src + +#+begin_src f90 :comments org :tangle (eval fh) :exports none + integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 + integer, parameter :: QMCKL_DEFAULT_RANGE = 11 +#+end_src +:end: + + #+NAME: qmckl_precision_struct + #+begin_src c :comments org :tangle no +typedef struct qmckl_precision_struct { + int precision; + int range; +} qmckl_precision_struct; + #+end_src + + The following functions set and get the required precision and + range. ~precision~ is an integer between 2 and 53, and ~range~ is an + integer between 2 and 11. + + The setter functions functions return a new context as a 64-bit + integer. The getter functions return the value, as a 32-bit + integer. The update functions return ~QMCKL_SUCCESS~ or + ~QMCKL_FAILURE~. + +** Precision + ~qmckl_context_update_precision~ modifies the parameter for the + numerical precision in a context. If the context doesn't have any + precision set yet, the default values are used. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_INVALID_CONTEXT; + +if (precision < 2) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_context_update_precision", + "precision < 2"); + } + +if (precision > 53) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_context_update_precision", + "precision > 53"); + } + +qmckl_context_struct* ctx = (qmckl_context_struct*) context; + +/* This should be always true */ +assert (ctx != NULL); + +qmckl_lock(context); + +if (ctx->fp == NULL) { + + ctx->fp = (qmckl_precision_struct*) + qmckl_malloc(context, sizeof(qmckl_precision_struct)); + + if (ctx->fp == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "qmckl_context_update_precision", + "ctx->fp"); + } + + ctx->fp->precision = QMCKL_DEFAULT_PRECISION; + ctx->fp->range = QMCKL_DEFAULT_RANGE; + } + +ctx->fp->precision = precision; + +qmckl_unlock(context); + +return QMCKL_SUCCESS; +} + #+end_src + + # Fortran interface + + #+begin_src f90 :tangle (eval fh) + interface + integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: precision + end function qmckl_context_update_precision + end interface + #+end_src + + ~qmckl_context_set_precision~ returns a copy of the context with a + different precision parameter. + + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { + qmckl_context new_context = qmckl_context_copy(context); + if (new_context == 0) return 0; + + if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0; + + return new_context; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: precision + end function qmckl_context_set_precision + end interface + #+end_src + + ~qmckl_context_get_precision~ returns the value of the numerical precision in the context. + + #+begin_src c :comments org :tangle (eval h) :exports none +int32_t qmckl_context_get_precision(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +int qmckl_context_get_precision(const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith(context, + QMCKL_INVALID_CONTEXT, + "qmckl_context_get_precision", + ""); + } + + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + if (ctx->fp != NULL) + return ctx->fp->precision; + else + return QMCKL_DEFAULT_PRECISION; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) + interface + integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_precision + end interface + #+end_src + +** Range + + ~qmckl_context_update_range~ modifies the parameter for the numerical range in a given context. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_INVALID_CONTEXT; + + if (range < 2) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_context_update_range", + "range < 2"); + } + + if (range > 11) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_context_update_range", + "range > 11"); + } + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + + /* This should be always true */ + assert (ctx != NULL); + + qmckl_lock(context); + + if (ctx->fp == NULL) { + + ctx->fp = (qmckl_precision_struct*) + qmckl_malloc(context, sizeof(qmckl_precision_struct)); + + if (ctx->fp == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "qmckl_context_update_range", + "ctx->fp"); + } + + ctx->fp->precision = QMCKL_DEFAULT_PRECISION; + ctx->fp->range = QMCKL_DEFAULT_RANGE; + } + + ctx->fp->range = range; + + qmckl_unlock(context); + + return QMCKL_SUCCESS; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) + interface + integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: range + end function qmckl_context_update_range + end interface + #+end_src + + ~qmckl_context_set_range~ returns a copy of the context with a different precision parameter. + + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); + #+end_src + + # Source + + #+begin_src c :tangle (eval c) +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { + qmckl_context new_context = qmckl_context_copy(context); + if (new_context == 0) return 0; + + if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0; + + return new_context; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: range + end function qmckl_context_set_range + end interface + #+end_src + + ~qmckl_context_get_range~ returns the value of the numerical range in the context. + + #+begin_src c :comments org :tangle (eval h) :exports none +int32_t qmckl_context_get_range(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +int qmckl_context_get_range(const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith(context, + QMCKL_INVALID_CONTEXT, + "qmckl_context_get_range", + ""); + } + + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + if (ctx->fp != NULL) + return ctx->fp->range; + else + return QMCKL_DEFAULT_RANGE; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int32_t) function qmckl_context_get_range(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_range + end interface + #+end_src + +** Helper functions + + ~qmckl_context_get_epsilon~ returns $\epsilon = 2^{1-n}$ where ~n~ is the precision. + + #+begin_src c :comments org :tangle (eval h) :exports none +double qmckl_context_get_epsilon(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +double qmckl_context_get_epsilon(const qmckl_context context) { + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + return 1. / (double) (1 << (1 - ctx->fp->precision)); +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + real (c_double) function qmckl_context_get_epsilon(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_epsilon + end interface + #+end_src + + +* TODO Basis set For H_2 with the following basis set, @@ -524,12 +1188,17 @@ typedef struct qmckl_ao_basis_struct { #+begin_src c :comments org :tangle (eval h) qmckl_exit_code -qmckl_context_update_ao_basis(qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, - const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, - const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, +qmckl_context_update_ao_basis(qmckl_context context , + const char type , + const int64_t shell_num , + const int64_t prim_num , + const int64_t * SHELL_CENTER , + const int32_t * SHELL_ANG_MOM , + const double * SHELL_FACTOR , + const int64_t * SHELL_PRIM_NUM , const int64_t * SHELL_PRIM_INDEX, - const double * EXPONENT , const double * COEFFICIENT); + const double * EXPONENT , + const double * COEFFICIENT); #+end_src *** Source @@ -566,26 +1235,27 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; - qmckl_ao_basis_struct* basis = (qmckl_ao_basis_struct*) malloc (sizeof(qmckl_ao_basis_struct)); - if (basis == NULL) return QMCKL_FAILURE; + qmckl_ao_basis_struct* basis = + (qmckl_ao_basis_struct*) qmckl_malloc (context, sizeof(qmckl_ao_basis_struct)); + if (basis == NULL) return QMCKL_ALLOCATION_FAILED; /* Memory allocations */ - basis->shell_center = (int64_t*) malloc (shell_num * sizeof(int64_t)); + basis->shell_center = (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_center == NULL) { qmckl_free(context, basis); return QMCKL_FAILURE; } - basis->shell_ang_mom = (int32_t*) malloc (shell_num * sizeof(int32_t)); + basis->shell_ang_mom = (int32_t*) qmckl_malloc (context, shell_num * sizeof(int32_t)); if (basis->shell_ang_mom == NULL) { qmckl_free(context, basis->shell_center); qmckl_free(context, basis); return QMCKL_FAILURE; } - basis->shell_prim_num= (int64_t*) malloc (shell_num * sizeof(int64_t)); + basis->shell_prim_num= (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_prim_num == NULL) { qmckl_free(context, basis->shell_ang_mom); qmckl_free(context, basis->shell_center); @@ -593,7 +1263,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->shell_factor = (double *) malloc (shell_num * sizeof(double )); + basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double )); if (basis->shell_factor == NULL) { qmckl_free(context, basis->shell_prim_num); qmckl_free(context, basis->shell_ang_mom); @@ -602,7 +1272,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->exponent = (double *) malloc (prim_num * sizeof(double )); + basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double )); if (basis->exponent == NULL) { qmckl_free(context, basis->shell_factor); qmckl_free(context, basis->shell_prim_num); @@ -612,7 +1282,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->coefficient = (double *) malloc (prim_num * sizeof(double )); + basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double )); if (basis->coefficient == NULL) { qmckl_free(context, basis->exponent); qmckl_free(context, basis->shell_factor); @@ -745,235 +1415,45 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ *** TODO Test -* Precision - - The following functions set and get the expected required - precision and range. ~precision~ should be an integer between 2 - and 53, and ~range~ should be an integer between 2 and 11. - - The setter functions functions return a new context as a 64-bit - integer. The getter functions return the value, as a 32-bit - integer. The update functions return ~QMCKL_SUCCESS~ or - ~QMCKL_FAILURE~. - -** ~qmckl_context_update_precision~ - Modifies the parameter for the numerical precision in a given context. - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { - - if (precision < 2) return QMCKL_FAILURE; - if (precision > 53) return QMCKL_FAILURE; - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; - - ctx->precision = precision; - return QMCKL_SUCCESS; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: precision - end function qmckl_context_update_precision - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_update_range~ - Modifies the parameter for the numerical range in a given context. - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { - - if (range < 2) return QMCKL_FAILURE; - if (range > 11) return QMCKL_FAILURE; - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; - - ctx->range = range; - return QMCKL_SUCCESS; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: range - end function qmckl_context_update_range - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_set_precision~ - Returns a copy of the context with a different precision parameter. - #+begin_src c :comments org :tangle (eval h) -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return 0; - - if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0; - - return new_context; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: precision - end function qmckl_context_set_precision - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_set_range~ - Returns a copy of the context with a different precision parameter. - #+begin_src c :comments org :tangle (eval h) -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return 0; - - if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0; - - return new_context; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: range - end function qmckl_context_set_range - end interface - #+end_src - -*** TODO Tests :noexport: - -** ~qmckl_context_get_precision~ - Returns the value of the numerical precision in the context - #+begin_src c :comments org :tangle (eval h) -int32_t qmckl_context_get_precision(const qmckl_context context); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -int qmckl_context_get_precision(const qmckl_context context) { - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return ctx->precision; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_precision - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_get_range~ - Returns the value of the numerical range in the context - #+begin_src c :comments org :tangle (eval h) -int32_t qmckl_context_get_range(const qmckl_context context); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -int qmckl_context_get_range(const qmckl_context context) { - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return ctx->range; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_get_range(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_range - end interface - #+end_src - -*** TODO Tests :noexport: - -** ~qmckl_context_get_epsilon~ - Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision - #+begin_src c :comments org :tangle (eval h) -double qmckl_context_get_epsilon(const qmckl_context context); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -double qmckl_context_get_epsilon(const qmckl_context context) { - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return pow(2.0,(double) 1-ctx->precision); -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - real (c_double) function qmckl_context_get_epsilon(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_epsilon - end interface - #+end_src - -*** TODO Tests :noexport: - * End of files :noexport: #+begin_src c :comments link :tangle (eval h_private) #endif #+end_src - + *** Test #+begin_src c :comments link :tangle (eval c_test) return MUNIT_OK; } #+end_src +*** Compute file names + #+begin_src emacs-lisp +; The following is required to compute the file names +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + +; Minted +(require 'ox-latex) +(setq org-latex-listings 'minted) +(add-to-list 'org-latex-packages-alist '("" "listings")) +(add-to-list 'org-latex-packages-alist '("" "color")) + + #+end_src + + #+RESULTS: + | | color | + | | listings | # -*- mode: org -*- # vim: syntax=c + diff --git a/src/qmckl_error.org b/src/qmckl_error.org index b1338e3..3a7981a 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -1,10 +1,7 @@ #+TITLE: Error handling #+SETUPFILE: ../docs/theme.setup - This file is written in C because it is more natural to express the - error handling in C than in Fortran. - -** Headers :noexport: +* Headers :noexport: #+NAME: filename #+begin_src elisp tangle: no @@ -22,7 +19,10 @@ MunitResult test_<>() { #+end_src -** Error handling +* +:PROPERTIES: +:UNNUMBERED: t +:END: The library should never make the calling programs abort, nor perform any input/output operations. This decision has to be taken @@ -35,8 +35,8 @@ typedef int32_t qmckl_exit_code; #+end_src The exit code returns the completion status of the function to the - calling program. When a function call completed successfully, the - ~QMCKL_SUCCESS~ exit code is returned. If one of the functions of + calling program. When a function call completed successfully, + ~QMCKL_SUCCESS~ is returned. If one of the functions of the library fails to complete the requested task, an appropriate error code is returned to the program. @@ -54,19 +54,21 @@ typedef int32_t qmckl_exit_code; | ~QMCKL_INVALID_ARG_8~ | 8 | | ~QMCKL_INVALID_ARG_9~ | 9 | | ~QMCKL_INVALID_ARG_10~ | 10 | - | ~QMCKL_NULL_CONTEXT~ | 101 | - | ~QMCKL_FAILURE~ | 102 | - | ~QMCKL_ERRNO~ | 103 | - | ~QMCKL_INVALID_EXIT_CODE~ | 104 | + | ~QMCKL_FAILURE~ | 101 | + | ~QMCKL_ERRNO~ | 102 | + | ~QMCKL_INVALID_CONTEXT~ | 103 | + | ~QMCKL_ALLOCATION_FAILED~ | 104 | + | ~QMCKL_INVALID_EXIT_CODE~ | 105 | # We need to force Emacs not to indent the Python code: # -*- org-src-preserve-indentation: t - #+begin_src python :var table=table-exit-codes :results drawer :exports result + + #+begin_src python :var table=table-exit-codes :results drawer :exports none """ This script generates the C and Fortran constants for the error codes from the org-mode table. """ -result = [ "#+begin_src c :comments org :tangle (eval h)" ] +result = [ "#+begin_src c :comments org :tangle (eval h) :exports none" ] for (text, code) in table: text=text.replace("~","") result += [ f"#define {text:30s} {code:d}" ] @@ -74,7 +76,7 @@ result += [ "#+end_src" ] result += [ "" ] -result += [ "#+begin_src f90 :comments org :tangle (eval fh)" ] +result += [ "#+begin_src f90 :comments org :tangle (eval fh) :exports none" ] for (text, code) in table: text=text.replace("~","") result += [ f" integer, parameter :: {text:30s} = {code:d}" ] @@ -86,7 +88,7 @@ return '\n'.join(result) #+RESULTS: :results: - #+begin_src c :comments org :tangle (eval h) + #+begin_src c :comments org :tangle (eval h) :exports none #define QMCKL_SUCCESS 0 #define QMCKL_INVALID_ARG_1 1 #define QMCKL_INVALID_ARG_2 2 @@ -98,13 +100,14 @@ return '\n'.join(result) #define QMCKL_INVALID_ARG_8 8 #define QMCKL_INVALID_ARG_9 9 #define QMCKL_INVALID_ARG_10 10 - #define QMCKL_NULL_CONTEXT 101 - #define QMCKL_FAILURE 102 - #define QMCKL_ERRNO 103 - #define QMCKL_INVALID_EXIT_CODE 104 + #define QMCKL_FAILURE 101 + #define QMCKL_ERRNO 102 + #define QMCKL_INVALID_CONTEXT 103 + #define QMCKL_ALLOCATION_FAILED 104 + #define QMCKL_INVALID_EXIT_CODE 105 #+end_src - #+begin_src f90 :comments org :tangle (eval fh) + #+begin_src f90 :comments org :tangle (eval fh) :exports none integer, parameter :: QMCKL_SUCCESS = 0 integer, parameter :: QMCKL_INVALID_ARG_1 = 1 integer, parameter :: QMCKL_INVALID_ARG_2 = 2 @@ -116,17 +119,17 @@ return '\n'.join(result) integer, parameter :: QMCKL_INVALID_ARG_8 = 8 integer, parameter :: QMCKL_INVALID_ARG_9 = 9 integer, parameter :: QMCKL_INVALID_ARG_10 = 10 - integer, parameter :: QMCKL_NULL_CONTEXT = 101 - integer, parameter :: QMCKL_FAILURE = 102 - integer, parameter :: QMCKL_ERRNO = 103 - integer, parameter :: QMCKL_INVALID_EXIT_CODE = 104 + integer, parameter :: QMCKL_FAILURE = 101 + integer, parameter :: QMCKL_ERRNO = 102 + integer, parameter :: QMCKL_INVALID_CONTEXT = 103 + integer, parameter :: QMCKL_ALLOCATION_FAILED = 104 + integer, parameter :: QMCKL_INVALID_EXIT_CODE = 105 #+end_src :end: - -** End of files :noexport: +* End of files :noexport: -*** Test +** Test #+begin_src c :comments link :tangle (eval c_test) return MUNIT_OK; } diff --git a/src/qmckl_footer.org b/src/qmckl_footer.org deleted file mode 100644 index ad448d6..0000000 --- a/src/qmckl_footer.org +++ /dev/null @@ -1,8 +0,0 @@ -* Acknowledgments - - [[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] - [[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. - - -# -*- mode: org -*- - diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 47d6962..f70d4b6 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -15,8 +15,11 @@ optimized libraries to fine-tune the memory allocation. #+begin_src c :tangle (eval c) #include #include +#include + #include "qmckl_error.h" #include "qmckl_context.h" +#include "qmckl_context_private.h" #include "qmckl_memory.h" #+end_src @@ -26,20 +29,39 @@ optimized libraries to fine-tune the memory allocation. MunitResult test_<>() { #+end_src -* ~qmckl_malloc~ +* + Memory allocation inside the library should be done with + ~qmckl_malloc~. It lets the library choose how the memory will be + allocated, and a pointer is returned to the user. The context is + passed to let the library store data related to the allocation + inside the context. In this particular implementation of the library, + we store a list of allocated pointers so that all the memory can be + properly freed when the library is de-initialized. + If the allocation failed, the ~NULL~ pointer is returned. - Memory allocation function, letting the library choose how the - memory will be allocated, and a pointer is returned to the user. - The context is passed to let the library store data related to the - allocation inside the context. If the allocation failed, the ~NULL~ - pointer is returned. - - #+begin_src c :tangle (eval h) -void* qmckl_malloc(qmckl_context ctx, + # Header + #+begin_src c :tangle (eval h) :noexport +void* qmckl_malloc(qmckl_context context, const size_t size); #+end_src + + # Source + #+begin_src c :tangle (eval c) +void* qmckl_malloc(qmckl_context context, const size_t size) { - #+begin_src f90 :tangle (eval fh) + void * pointer = malloc( (size_t) size ); + + if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { + qmckl_exit_code rc; + rc = qmckl_context_append_memory(context, pointer, size); + assert (rc == QMCKL_SUCCESS); + } + + return pointer; +} + #+end_src + # Fortran interface + #+begin_src f90 :tangle (eval fh) :noexport interface type (c_ptr) function qmckl_malloc (context, size) bind(C) use, intrinsic :: iso_c_binding @@ -49,24 +71,11 @@ void* qmckl_malloc(qmckl_context ctx, end interface #+end_src -** Source - - #+begin_src c :tangle (eval c) -void* qmckl_malloc(qmckl_context ctx, const size_t size) { - - if (ctx == (qmckl_context) 0) {}; /* Avoid unused argument warning */ - void * result = malloc( (size_t) size ); - return result; - -} - - #+end_src - ** Test :noexport: #+begin_src c :tangle (eval c_test) int *a = NULL; munit_assert(a == NULL); - a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); + a = (int*) qmckl_malloc( QMCKL_NULL_CONTEXT, 3*sizeof(int)); munit_assert(a != NULL); a[0] = 1; a[1] = 2; @@ -99,12 +108,22 @@ qmckl_exit_code qmckl_free(qmckl_context context, ** Source #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { + if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { - if (context == 0) return QMCKL_INVALID_ARG_1; - if (ptr == NULL) return QMCKL_INVALID_ARG_2; + if (ptr == NULL) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_free", + "NULL pointer"); + } + + qmckl_exit_code rc; + rc = qmckl_context_remove_memory(context, ptr); + + assert (rc == QMCKL_SUCCESS); + } free(ptr); return QMCKL_SUCCESS; - } #+end_src diff --git a/src/qmckl_precision.org b/src/qmckl_precision.org deleted file mode 100644 index ca24c0a..0000000 --- a/src/qmckl_precision.org +++ /dev/null @@ -1,58 +0,0 @@ -#+TITLE: Multi-precision -#+SETUPFILE: ../docs/theme.setup - -#+NAME: filename -#+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) -#+end_src - - Controlling numerical precision enables optimizations. Here, the - default parameters determining the target numerical precision and - range are defined. - - #+NAME: table-precision - | ~QMCKL_DEFAULT_PRECISION~ | 53 | - | ~QMCKL_DEFAULT_RANGE~ | 11 | - - # We need to force Emacs not to indent the Python code: - # -*- org-src-preserve-indentation: t - -#+begin_src python :var table=table-precision :results drawer :exports result -""" This script generates the C and Fortran constants for the error - codes from the org-mode table. -""" - -result = [ "#+begin_src c :comments org :tangle (eval h)" ] -for (text, code) in table: - text=text.replace("~","") - result += [ f"#define {text:30s} {code:d}" ] -result += [ "#+end_src" ] - -result += [ "" ] - -result += [ "#+begin_src f90 :comments org :tangle (eval fh)" ] -for (text, code) in table: - text=text.replace("~","") - result += [ f" integer, parameter :: {text:30s} = {code:d}" ] -result += [ "#+end_src" ] - -return '\n'.join(result) - -#+end_src - -#+RESULTS: -:results: -#+begin_src c :comments org :tangle (eval h) -#define QMCKL_DEFAULT_PRECISION 53 -#define QMCKL_DEFAULT_RANGE 11 -#+end_src - -#+begin_src f90 :comments org :tangle (eval fh) - integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 - integer, parameter :: QMCKL_DEFAULT_RANGE = 11 -#+end_src -:end: - - -# -*- mode: org -*- -# vim: syntax=c diff --git a/src/table_of_contents b/src/table_of_contents index 7929b05..a6a9011 100644 --- a/src/table_of_contents +++ b/src/table_of_contents @@ -1,9 +1,7 @@ qmckl.org qmckl_error.org qmckl_context.org -qmckl_precision.org qmckl_memory.org qmckl_distance.org qmckl_ao.org test_qmckl.org -qmckl_footer.org diff --git a/tools/Building.org b/tools/Building.org index 12a6ab6..be6e8ab 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -69,7 +69,12 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #+begin_src makefile # <> #+end_src +** Dependencies + #+begin_src makefile +LIBS=-lpthread + #+end_src + ** Variables #+begin_src makefile @@ -108,7 +113,7 @@ FFLAGS=-fPIC $(INCLUDE) \ -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ -ffpe-trap=zero,overflow,underflow -LIBS=-lgfortran -lm +LIBS+=-lgfortran -lm #---------------------------------------------------------- endif #+end_src @@ -124,7 +129,7 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=ifort -xHost FFLAGS=-fPIC -g -O2 $(INCLUDE) -LIBS=-lm -lifcore -lirc +LIBS+=-lm -lifcore -lirc #---------------------------------------------------------- CC=icc -xHost endif @@ -141,7 +146,7 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=flang FFLAGS=fPIC -g -O2 $(INCLUDE) -LIBS=-lm +LIBS+=-lm #---------------------------------------------------------- endif #+end_src @@ -157,14 +162,17 @@ endif libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated -test: Makefile.generated +../include/qmckl.h: libqmckl.so + ../tools/build_qmckl_h.sh + +test: Makefile.generated ../include/qmckl.h $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_doc.sh clean: - $(RM) qmckl.h test_qmckl_* test_qmckl.c test_qmckl \ + $(RM) test_qmckl_* test_qmckl.c test_qmckl \ qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ Makefile.generated libqmckl.so *.html *.mod diff --git a/tools/build_doc.sh b/tools/build_doc.sh new file mode 100755 index 0000000..11b06ac --- /dev/null +++ b/tools/build_doc.sh @@ -0,0 +1,57 @@ +#!/bin/bash + +if [[ -z $QMCKL_ROOT ]] +then + print "QMCKL_ROOT is not defined" + exit 1 +fi + + +# Install htmlize if needed +[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || ( + cd ${QMCKL_ROOT}/docs/ + git clone https://github.com/hniksic/emacs-htmlize + cp emacs-htmlize/htmlize.el . + rm -rf emacs-htmlize + cd - +) + +[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || exit 1 + + +# Create documentation +cd ${QMCKL_ROOT}/src + +function extract_doc() +{ + HTML=${1%.org}.html + if [[ -f ${QMCKL_ROOT}/docs/$HTML && $1 -ot ${QMCKL_ROOT}/docs/$HTML ]] + then return + fi + emacs --batch \ + --load ${QMCKL_ROOT}/docs/htmlize.el \ + --load ${QMCKL_ROOT}/tools/config_doc.el \ + $i \ + --load ${QMCKL_ROOT}/tools/config_tangle.el \ + -f org-html-export-to-html || break + mv $HTML ${QMCKL_ROOT}/docs +} + +for i in *.org +do +echo +echo "======= $i =======" + extract_doc $i +done + +if [[ $? -eq 0 ]] +then + cd ${QMCKL_ROOT}/docs + rm -f index.html + ln README.html index.html + exit 0 +else + exit 2 +fi + + diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh index 941959f..03396f3 100755 --- a/tools/build_qmckl_h.sh +++ b/tools/build_qmckl_h.sh @@ -1,13 +1,11 @@ #!/bin/bash # Script to build the final qmckl.h file # :PROPERTIES: -# :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments both +# :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments org # :END: -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:1]] # This file was created by tools/Building.org -# Script to build the final qmckl.h file:1 ends here @@ -18,20 +16,17 @@ # Put =.h= files in the correct order: -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:3]] HEADERS="" for i in $(cat table_of_contents) do HEADERS+="${i%.org}.h " done -# Script to build the final qmckl.h file:3 ends here # Generate C header file -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:4]] OUTPUT="../include/qmckl.h" cat << EOF > ${OUTPUT} @@ -95,14 +90,12 @@ done cat << EOF >> ${OUTPUT} #endif EOF -# Script to build the final qmckl.h file:4 ends here # Generate Fortran interface file from all =qmckl_*_fh.f90= files -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:5]] HEADERS="qmckl_*_fh.f90" OUTPUT="../include/qmckl_f.f90" @@ -161,4 +154,3 @@ done cat << EOF >> ${OUTPUT} end module qmckl EOF -# Script to build the final qmckl.h file:5 ends here diff --git a/tools/config_doc.el b/tools/config_doc.el new file mode 100755 index 0000000..9501d64 --- /dev/null +++ b/tools/config_doc.el @@ -0,0 +1,85 @@ +;; Thanks to Tobias's answer on Emacs Stack Exchange: +;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting + + +(package-initialize) + +(require 'htmlize) +(require 'font-lock) +(setq org-confirm-babel-evaluate nil) +(global-font-lock-mode t) +(setq org-src-fontify-natively t) + +;(require 'ox-latex) +;(setq org-latex-listings t) +;(add-to-list 'org-latex-packages-alist '("" "listings")) +;(add-to-list 'org-latex-packages-alist '("" "color")) + + +(require 'subr-x) ;; for `when-let' +(unless (boundp 'maximal-integer) + (defconst maximal-integer (lsh -1 -1) + "Maximal integer value representable natively in emacs lisp.")) + +(defun face-spec-default (spec) + "Get list containing at most the default entry of face SPEC. +Return nil if SPEC has no default entry." + (let* ((first (car-safe spec)) + (display (car-safe first))) + (when (eq display 'default) + (list (car-safe spec))))) + +(defun face-spec-min-color (display-atts) + "Get min-color entry of DISPLAY-ATTS pair from face spec." + (let* ((display (car-safe display-atts))) + (or (car-safe (cdr (assoc 'min-colors display))) + maximal-integer))) + +(defun face-spec-highest-color (spec) + "Search face SPEC for highest color. +That means the DISPLAY entry of SPEC +with class 'color and highest min-color value." + (let ((color-list (cl-remove-if-not + (lambda (display-atts) + (when-let ((display (car-safe display-atts)) + (class (and (listp display) + (assoc 'class display))) + (background (assoc 'background display))) + (and (member 'light (cdr background)) + (member 'color (cdr class))))) + spec))) + (cl-reduce (lambda (display-atts1 display-atts2) + (if (> (face-spec-min-color display-atts1) + (face-spec-min-color display-atts2)) + display-atts1 + display-atts2)) + (cdr color-list) + :initial-value (car color-list)))) + +(defun face-spec-t (spec) + "Search face SPEC for fall back." + (cl-find-if (lambda (display-atts) + (eq (car-safe display-atts) t)) + spec)) + +(defun my-face-attribute (face attribute &optional frame inherit) + "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'." + (let* ((face-spec (face-user-default-spec face)) + (display-attr (or (face-spec-highest-color face-spec) + (face-spec-t face-spec))) + (attr (cdr display-attr)) + (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr)))))) + ;; (message "attribute: %S" attribute) ;; for debugging + (when (and (null (eq attribute :inherit)) + (null val)) + (let ((inherited-face (my-face-attribute face :inherit))) + (when (and inherited-face + (null (eq inherited-face 'unspecified))) + (setq val (my-face-attribute inherited-face attribute))))) + ;;(message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging + (or val 'unspecified))) + +(advice-add 'face-attribute :override #'my-face-attribute) + + + diff --git a/tools/config_tangle.el b/tools/config_tangle.el index fc39218..53ca152 100755 --- a/tools/config_tangle.el +++ b/tools/config_tangle.el @@ -1,6 +1,7 @@ ;; Thanks to Tobias's answer on Emacs Stack Exchange: ;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting + (package-initialize) (add-to-list 'package-archives '("gnu" . "https://elpa.gnu.org/packages/")) @@ -15,9 +16,9 @@ (require 'htmlize) (require 'font-lock) -(require 'subr-x) ;; for `when-let' (setq org-confirm-babel-evaluate nil) (global-font-lock-mode t) +(setq org-src-fontify-natively t) (org-babel-do-load-languages 'org-babel-load-languages @@ -25,80 +26,14 @@ (emacs-lisp . t) (shell . t) (python . t) + (fortran . t) (C . t) (org . t) (makefile . t) )) - - -(unless (boundp 'maximal-integer) - (defconst maximal-integer (lsh -1 -1) - "Maximal integer value representable natively in emacs lisp.")) - -(defun face-spec-default (spec) - "Get list containing at most the default entry of face SPEC. -Return nil if SPEC has no default entry." - (let* ((first (car-safe spec)) - (display (car-safe first))) - (when (eq display 'default) - (list (car-safe spec))))) - -(defun face-spec-min-color (display-atts) - "Get min-color entry of DISPLAY-ATTS pair from face spec." - (let* ((display (car-safe display-atts))) - (or (car-safe (cdr (assoc 'min-colors display))) - maximal-integer))) - -(defun face-spec-highest-color (spec) - "Search face SPEC for highest color. -That means the DISPLAY entry of SPEC -with class 'color and highest min-color value." - (let ((color-list (cl-remove-if-not - (lambda (display-atts) - (when-let ((display (car-safe display-atts)) - (class (and (listp display) - (assoc 'class display))) - (background (assoc 'background display))) - (and (member 'light (cdr background)) - (member 'color (cdr class))))) - spec))) - (cl-reduce (lambda (display-atts1 display-atts2) - (if (> (face-spec-min-color display-atts1) - (face-spec-min-color display-atts2)) - display-atts1 - display-atts2)) - (cdr color-list) - :initial-value (car color-list)))) - -(defun face-spec-t (spec) - "Search face SPEC for fall back." - (cl-find-if (lambda (display-atts) - (eq (car-safe display-atts) t)) - spec)) - -(defun my-face-attribute (face attribute &optional frame inherit) - "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'." - (let* ((face-spec (face-user-default-spec face)) - (display-attr (or (face-spec-highest-color face-spec) - (face-spec-t face-spec))) - (attr (cdr display-attr)) - (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr)))))) - ;; (message "attribute: %S" attribute) ;; for debugging - (when (and (null (eq attribute :inherit)) - (null val)) - (let ((inherited-face (my-face-attribute face :inherit))) - (when (and inherited-face - (null (eq inherited-face 'unspecified))) - (setq val (my-face-attribute inherited-face attribute))))) - ;; (message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging - (or val 'unspecified))) - -(advice-add 'face-attribute :override #'my-face-attribute) - - -;; The following is required to compute the file names +; The following is required to compute the file names (setq pwd (file-name-directory buffer-file-name)) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq f (concat pwd name "_f.f90")) @@ -109,4 +44,3 @@ with class 'color and highest min-color value." (setq c_test (concat pwd "test_" name ".c")) (setq f_test (concat pwd "test_" name "_f.f90")) - diff --git a/tools/create_doc.sh b/tools/create_doc.sh deleted file mode 100755 index ecb5d7b..0000000 --- a/tools/create_doc.sh +++ /dev/null @@ -1,47 +0,0 @@ -#!/bin/bash - -set -x - -INPUT=merged.org -if [[ -z $QMCKL_ROOT ]] -then - print "QMCKL_ROOT is not defined" - exit 1 -fi - - -# Install htmlize if needed -[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || ( - cd ${QMCKL_ROOT}/docs/ - git clone https://github.com/hniksic/emacs-htmlize - cp emacs-htmlize/htmlize.el . - rm -rf emacs-htmlize - cd - -) - -[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || exit 1 - - -# Switch to TMPDIR for easy cleanup -TMPDIR=$(mktemp -d) -${QMCKL_ROOT}/tools/merge_org.sh $TMPDIR/$INPUT -cd $TMPDIR - - -# Create documentation -emacs --batch \ - --load ${QMCKL_ROOT}/docs/htmlize.el \ - --load ${QMCKL_ROOT}/docs/config.el \ - $INPUT -f org-html-export-to-html - -if [[ $? -eq 0 ]] -then - mv index.html ${QMCKL_ROOT}/docs/ - rm -rf $TMPDIR - exit 0 -else - rm -rf $TMPDIR - exit 2 -fi - - From 1af0bf053f057018b553534a78239c2037feb1c0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 18 Mar 2021 18:02:06 +0100 Subject: [PATCH 24/65] Memory checking --- src/qmckl.org | 11 +- src/qmckl_ao.org | 491 ++++++++++++++++++++++----------------- src/qmckl_context.org | 126 +++++++--- src/qmckl_error.org | 4 + src/test_qmckl.org | 66 +++--- tools/Building.org | 85 +++---- tools/create_makefile.sh | 13 +- 7 files changed, 470 insertions(+), 326 deletions(-) diff --git a/src/qmckl.org b/src/qmckl.org index ff58ace..3a568c7 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -116,8 +116,15 @@ Both files are located in the =include/= directory. For more guidelines on using Fortran to generate a C interface, see [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]]. +** Coding rules + + The authors should follow the recommendations of the + [[https://wiki.sei.cmu.edu/confluence/display/c/SEI+CERT+C+Coding+Standard][SEI+CERT+C+Coding+Standard]]. + + - Store a new value in pointers immediately after the memory is + freed + - Free dynamically allocated memory when no longer needed - # Coding style # # TODO: decide on a coding style # To improve readability, we maintain a consistent coding style in @@ -129,6 +136,7 @@ Both files are located in the =include/= directory. # Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. + ** Design of the library The proposed API should allow the library to: deal with memory transfers @@ -251,3 +259,4 @@ Both files are located in the =include/= directory. + diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 5430b06..f997913 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -1,8 +1,36 @@ #+TITLE: Atomic Orbitals #+SETUPFILE: ../docs/theme.setup - The routines for the computation of the values, gradients and - Laplacian of atomic basis functions are defined here. +The atomic basis set is defined as a list of shells. Each shell $s$ is +centered on a nucleus $A$, possesses a given angular momentum $l$ and a +radial function $R_s$. The radial function is a linear combination of +\emph{primitive} functions that can be of type Slater ($p=1$) or +Gaussian ($p=2$): + +\[ + R_s(\mathbf{r}) = \mathcal{N}_s |\mathbf{r}-\mathbf{R}_A|^{n_s} + \sum_{k=1}^{N_{\text{prim}}} a_{ks} + \exp \left( - \gamma_{ks} | \mathbf{r}-\mathbf{R}_A | ^p \right). | +\] + +In the case of Gaussian functions, $n_s$ is always zero. +The normalization factor $\mathcal{N}_s$ ensures that all the functions +of the shell are normalized to unity. As this normalization requires +the ability to compute overlap integrals, it should be written in the +file to ensure that the file is self-contained and does not require +the client program to have the ability to compute such integrals. + +Atomic orbitals (AOs) are defined as + +\[ +\chi_i (\mathbf{r}) = P_{\eta(i)}(\mathbf{r})\, R_{\theta(i)} (\mathbf{r}) +\] + +where $\theta(i)$ returns the shell on which the AO is expanded, +and $\eta(i)$ denotes which angular function is chosen. + +In this section we describe the kernels used to compute the values, +gradients and Laplacian of the atomic basis functions. * Headers :noexport: @@ -20,59 +48,33 @@ MunitResult test_<>() { context = qmckl_context_create(); #+end_src -* Polynomials +* Polynomial part - \[ - P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c - \] - - \begin{eqnarray*} - \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ - \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ - \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ - \end{eqnarray*} - - - \begin{eqnarray*} - \left( \frac{\partial }{\partial x^2} + - \frac{\partial }{\partial y^2} + - \frac{\partial }{\partial z^2} \right) P_l - \left(\mathbf{r},\mathbf{R}_i \right) & = & - a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ - && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ - && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} - \end{eqnarray*} - -** <<<~qmckl_ao_power~>>> - - Computes all the powers of the ~n~ input data up to the given - maximum value given in input for each of the $n$ points: +** Powers of $x-X_i$ - \[ P_{ij} = X_j^i \] + The ~qmckl_ao_power~ function computes all the powers of the ~n~ + input data up to the given maximum value given in input for each of + the $n$ points: + + \[ P_{ik} = X_i^k \] -*** Arguments - - | ~context~ | input | Global state | - | ~n~ | input | Number of values | - | ~X(n)~ | input | Array containing the input values | - | ~LMAX(n)~ | input | Array containing the maximum power for each value | - | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | - | ~LDP~ | input | Leading dimension of array ~P~ | + | ~context~ | input | Global state | + | ~n~ | input | Number of values | + | ~X(n)~ | input | Array containing the input values | + | ~LMAX(n)~ | input | Array containing the maximum power for each value | + | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | + | ~LDP~ | input | Leading dimension of array ~P~ | -*** Requirements + Requirements: - - ~context~ is not 0 - - ~n~ > 0 - - ~X~ is allocated with at least $n \times 8$ bytes - - ~LMAX~ is allocated with at least $n \times 4$ bytes - - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - - ~LDP~ >= $\max_i$ ~LMAX[i]~ + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~n~ > 0 + - ~X~ is allocated with at least $n \times 8$ bytes + - ~LMAX~ is allocated with at least $n \times 4$ bytes + - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - ~LDP~ >= $\max_i$ ~LMAX[i]~ -*** Header - #+begin_src c :tangle (eval h) + #+begin_src c :tangle (eval h) qmckl_exit_code qmckl_ao_power(const qmckl_context context, const int64_t n, @@ -80,11 +82,11 @@ qmckl_ao_power(const qmckl_context context, const int32_t *LMAX, const double *P, const int64_t LDP); - #+end_src - -*** Source - #+begin_src f90 :tangle (eval f) + #+end_src + + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) + use qmckl implicit none integer*8 , intent(in) :: context integer*8 , intent(in) :: n @@ -93,32 +95,42 @@ integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) real*8 , intent(out) :: P(ldp,n) integer*8 , intent(in) :: ldp - integer*8 :: i,j + integer*8 :: i,k - info = 0 + info = QMCKL_SUCCESS - if (context == 0_8) then - info = -1 + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT return endif - - if (LDP < MAXVAL(LMAX)) then - info = -2 + + if (n <= ldp) then + info = QMCKL_INVALID_ARG_2 return endif - - do j=1,n - P(1,j) = X(j) - do i=2,LMAX(j) - P(i,j) = P(i-1,j) * X(j) - end do + + k = MAXVAL(LMAX) + if (LDP < k) then + info = QMCKL_INVALID_ARG_6 + return + endif + + if (k <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + do i=1,n + P(1,i) = X(i) + do k=2,LMAX(i) + P(k,i) = P(k-1,i) * X(i) + end do end do end function qmckl_ao_power_f - #+end_src + #+end_src -*** C interface :noexport: - #+begin_src f90 :tangle (eval f) + #+begin_src f90 :tangle (eval f) :exports none integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -129,13 +141,13 @@ integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & integer (c_int32_t) , intent(in) :: LMAX(n) real (c_double) , intent(out) :: P(ldp,n) integer (c_int64_t) , intent(in) , value :: ldp - + integer, external :: qmckl_ao_power_f info = qmckl_ao_power_f(context, n, X, LMAX, P, ldp) end function qmckl_ao_power - #+end_src + #+end_src - #+begin_src f90 :tangle (eval fh) + #+begin_src f90 :tangle (eval fh) :exports none interface integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C) use, intrinsic :: iso_c_binding @@ -147,16 +159,16 @@ end function qmckl_ao_power real (c_double) , intent(out) :: P(ldp,n) end function qmckl_ao_power end interface - #+end_src - -*** Test :noexport: - #+begin_src f90 :tangle (eval f_test) + #+end_src + + # Test + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) use qmckl implicit none integer(c_int64_t), intent(in), value :: context - + integer*8 :: n, LDP integer, allocatable :: LMAX(:) double precision, allocatable :: X(:), P(:,:) @@ -167,19 +179,19 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) n = 100; LDP = 10; - + allocate(X(n), P(LDP,n), LMAX(n)) - + do j=1,n X(j) = -5.d0 + 0.1d0 * dble(j) LMAX(j) = 1 + int(mod(j, 5),4) end do - + test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP) if (test_qmckl_ao_power /= 0) return - + test_qmckl_ao_power = -1 - + do j=1,n do i=1,LMAX(j) if ( X(j)**i == 0.d0 ) then @@ -193,58 +205,79 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) test_qmckl_ao_power = 0 deallocate(X,P,LMAX) end function test_qmckl_ao_power - #+end_src + #+end_src - #+begin_src c :tangle (eval c_test) + #+begin_src c :tangle (eval c_test) :exports none int test_qmckl_ao_power(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_power(context)); - #+end_src + #+end_src + +** Value, Gradient and Laplacian of a polynomial + + A polynomial is centered on a nucleus $\mathbf{R}_i$ -** <<<~qmckl_ao_polynomial_vgl~>>> - - Computes the values, gradients and Laplacians at a given point of - all polynomials with an angular momentum up to ~lmax~. - -*** Arguments + \[ + P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c + \] - | ~context~ | input | Global state | - | ~X(3)~ | input | Array containing the coordinates of the points | - | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~lmax~ | input | Maximum angular momentum | - | ~n~ | output | Number of computed polynomials | - | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | - | ~ldl~ | input | Leading dimension of ~L~ | - | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | - | ~ldv~ | input | Leading dimension of array ~VGL~ | + The gradients with respect to electron coordinates are + + \begin{eqnarray*} + \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ + \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ + \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ + \end{eqnarray*} + + and the Laplacian is -*** Requirements + \begin{eqnarray*} + \left( \frac{\partial }{\partial x^2} + + \frac{\partial }{\partial y^2} + + \frac{\partial }{\partial z^2} \right) P_l + \left(\mathbf{r},\mathbf{R}_i \right) & = & + a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ + && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ + && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1}. + \end{eqnarray*} - - ~context~ is not 0 - - ~n~ > 0 - - ~lmax~ >= 0 - - ~ldl~ >= 3 - - ~ldv~ >= 5 - - ~X~ is allocated with at least $3 \times 8$ bytes - - ~R~ is allocated with at least $3 \times 8$ bytes - - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ - - ~L~ is allocated with at least $3 \times n \times 4$ bytes - - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes - - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ - - On output, the powers are given in the following order (l=a+b+c): - - Increase values of ~l~ - - Within a given value of ~l~, alphabetical order of the - string made by a*"x" + b*"y" + c*"z" (in Python notation). - For example, with a=0, b=2 and c=1 the string is "yyz" - -*** Error codes + ~qmckl_ao_polynomial_vgl~ computes the values, gradients and + Laplacians at a given point in space, of all polynomials with an + angular momentum up to ~lmax~. - | -1 | Null context | - | -2 | Inconsistent ~ldl~ | - | -3 | Inconsistent ~ldv~ | - | -4 | Inconsistent ~lmax~ | + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~lmax~ | input | Maximum angular momentum | + | ~n~ | output | Number of computed polynomials | + | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | + | ~ldl~ | input | Leading dimension of ~L~ | + | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | + | ~ldv~ | input | Leading dimension of array ~VGL~ | + + Requirements: -*** Header - #+begin_src c :tangle (eval h) + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~n~ > 0 + - ~lmax~ >= 0 + - ~ldl~ >= 3 + - ~ldv~ >= 5 + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ + - ~L~ is allocated with at least $3 \times n \times 4$ bytes + - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes + - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ + - On output, the powers are given in the following order (l=a+b+c): + - Increasing values of ~l~ + - Within a given value of ~l~, alphabetical order of the + string made by a*"x" + b*"y" + c*"z" (in Python notation). + For example, with a=0, b=2 and c=1 the string is "yyz" + + # Header + #+begin_src c :tangle (eval h) qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, const double *X, @@ -255,11 +288,12 @@ qmckl_ao_polynomial_vgl(const qmckl_context context, const int64_t ldl, const double *VGL, const int64_t ldv); - #+end_src - -*** Source - #+begin_src f90 :tangle (eval f) + #+end_src + + # Source + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) + use qmckl implicit none integer*8 , intent(in) :: context real*8 , intent(in) :: X(3), R(3) @@ -278,69 +312,74 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, integer, external :: qmckl_ao_power_f double precision :: xy, yz, xz double precision :: da, db, dc, dd - + info = 0 - - if (context == 0_8) then - info = -1 + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT return endif - - if (ldl < 3) then - info = -2 - return - endif - - if (ldv < 5) then - info = -3 - return - endif - + if (lmax <= 0) then - info = -4 + info = QMCKL_INVALID_ARG_4 return endif - - + + if (n <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + if (ldl < 3) then + info = QMCKL_INVALID_ARG_7 + return + endif + + if (ldv < 5) then + info = QMCKL_INVALID_ARG_9 + return + endif + + do i=1,3 Y(i) = X(i) - R(i) end do lmax_array(1:3) = lmax if (lmax == 0) then - VGL(1,1) = 1.d0 - vgL(2:5,1) = 0.d0 - l(1:3,1) = 0 - n=1 + VGL(1,1) = 1.d0 + vgL(2:5,1) = 0.d0 + l(1:3,1) = 0 + n=1 else if (lmax > 0) then - pows(-2:0,1:3) = 1.d0 - do i=1,lmax + pows(-2:0,1:3) = 1.d0 + do i=1,lmax pows(i,1) = pows(i-1,1) * Y(1) pows(i,2) = pows(i-1,2) * Y(2) pows(i,3) = pows(i-1,3) * Y(3) - end do + end do - VGL(1:5,1:4) = 0.d0 - l(1:3,1:4) = 0 + VGL(1:5,1:4) = 0.d0 + l (1:3,1:4) = 0 - VGL(1,1) = 1.d0 - vgl(1:5,2:4) = 0.d0 + VGL(1 ,1 ) = 1.d0 + vgl(1:5,2:4) = 0.d0 - l(1,2) = 1 - vgl(1,2) = pows(1,1) - vgL(2,2) = 1.d0 + l (1,2) = 1 + vgl(1,2) = pows(1,1) + vgL(2,2) = 1.d0 - l(2,3) = 1 - vgl(1,3) = pows(1,2) - vgL(3,3) = 1.d0 + l (2,3) = 1 + vgl(1,3) = pows(1,2) + vgL(3,3) = 1.d0 - l(3,4) = 1 - vgl(1,4) = pows(1,3) - vgL(4,4) = 1.d0 + l (3,4) = 1 + vgl(1,4) = pows(1,3) + vgL(4,4) = 1.d0 - n=4 + n=4 endif - + ! l>=2 dd = 2.d0 do d=2,lmax @@ -355,21 +394,21 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, l(1,n) = a l(2,n) = b l(3,n) = c - + xy = pows(a,1) * pows(b,2) yz = pows(b,2) * pows(c,3) xz = pows(a,1) * pows(c,3) - + vgl(1,n) = xy * pows(c,3) - + xy = dc * xy xz = db * xz yz = da * yz - + vgl(2,n) = pows(a-1,1) * yz vgl(3,n) = pows(b-1,2) * xz vgl(4,n) = pows(c-1,3) * xy - + vgl(5,n) = & (da-1.d0) * pows(a-2,1) * yz + & (db-1.d0) * pows(b-2,2) * xz + & @@ -382,13 +421,13 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, dd = dd + 1.d0 end do - info = 0 + info = QMCKL_SUCCESS end function qmckl_ao_polynomial_vgl_f - #+end_src + #+end_src -*** C interface :noexport: - #+begin_src f90 :tangle (eval f) + + #+begin_src f90 :tangle (eval f) :exports none integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -405,10 +444,9 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l integer, external :: qmckl_ao_polynomial_vgl_f info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) end function qmckl_ao_polynomial_vgl - #+end_src + #+end_src -*** Fortran interface :noexport: - #+begin_src f90 :tangle (eval fh) + #+begin_src f90 :tangle (eval fh) :exports none interface integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) @@ -423,15 +461,15 @@ end function qmckl_ao_polynomial_vgl real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) end function qmckl_ao_polynomial_vgl end interface - #+end_src -*** Test :noexport: - #+begin_src f90 :tangle (eval f_test) + #+end_src + + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl implicit none integer(c_int64_t), intent(in), value :: context - + integer :: lmax, d, i integer, allocatable :: L(:,:) integer*8 :: n, ldl, ldv, j @@ -450,7 +488,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) n = 0; ldl = 3; ldv = 100; - + d = (lmax+1)*(lmax+2)*(lmax+3)/6 allocate (L(ldl,d), VGL(ldv,d)) @@ -499,7 +537,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) L(3,j) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-1) & )) > epsilon ) return end if - + test_qmckl_ao_polynomial_vgl = -16 w = 0.d0 if (L(1,j) > 1) then @@ -515,22 +553,21 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) end do test_qmckl_ao_polynomial_vgl = 0 - + deallocate(L,VGL) end function test_qmckl_ao_polynomial_vgl - #+end_src + #+end_src - #+begin_src c :tangle (eval c_test) + #+begin_src c :tangle (eval c_test) int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - #+end_src + #+end_src * Gaussian basis functions - -** <<<~qmckl_ao_gaussian_vgl~>>> - - Computes the values, gradients and Laplacians at a given point of - ~n~ Gaussian functions centered at the same point: + + ~qmckl_ao_gaussian_vgl~ computes the values, gradients and + Laplacians at a given point of ~n~ Gaussian functions centered at + the same point: \[ v_i = \exp(-a_i |X-R|^2) \] \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] @@ -538,8 +575,6 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] -*** Arguments - | ~context~ | input | Global state | | ~X(3)~ | input | Array containing the coordinates of the points | | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | @@ -548,7 +583,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | | ~ldv~ | input | Leading dimension of array ~VGL~ | -*** Requirements + Requirements : - ~context~ is not 0 - ~n~ > 0 @@ -559,7 +594,6 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - ~A~ is allocated with at least $n \times 8$ bytes - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes -*** Header #+begin_src c :tangle (eval h) qmckl_exit_code qmckl_ao_gaussian_vgl(const qmckl_context context, @@ -571,9 +605,9 @@ qmckl_ao_gaussian_vgl(const qmckl_context context, const int64_t ldv); #+end_src -*** Source #+begin_src f90 :tangle (eval f) integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) + use qmckl implicit none integer*8 , intent(in) :: context real*8 , intent(in) :: X(3), R(3) @@ -585,20 +619,20 @@ integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(i integer*8 :: i,j real*8 :: Y(3), r2, t, u, v - info = 0 + info = QMCKL_SUCCESS - if (context == 0_8) then - info = -1 + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT return endif if (n <= 0) then - info = -2 + info = QMCKL_INVALID_ARG_4 return endif if (ldv < n) then - info = -3 + info = QMCKL_INVALID_ARG_7 return endif @@ -634,8 +668,7 @@ integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(i end function qmckl_ao_gaussian_vgl_f #+end_src -*** C interface :noexport: - #+begin_src f90 :tangle (eval f) + #+begin_src f90 :tangle (eval f) :exports none integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -652,7 +685,7 @@ integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) end function qmckl_ao_gaussian_vgl #+end_src - #+begin_src f90 :tangle (eval fh) + #+begin_src f90 :tangle (eval fh) :exports none interface integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) @@ -665,8 +698,9 @@ end function qmckl_ao_gaussian_vgl end function qmckl_ao_gaussian_vgl end interface #+end_src -*** Test :noexport: - #+begin_src f90 :tangle (eval f_test) + + # Test + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) use qmckl implicit none @@ -731,12 +765,12 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) deallocate(VGL) end function test_qmckl_ao_gaussian_vgl - #+end_src + #+end_src - #+begin_src c :tangle (eval c_test) :exports none + #+begin_src c :tangle (eval c_test) :exports none int test_qmckl_ao_gaussian_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); - #+end_src + #+end_src * TODO Slater basis functions @@ -749,8 +783,35 @@ munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); return MUNIT_OK; } #+end_src - + +**✸ Compute file names + #+begin_src emacs-lisp +; The following is required to compute the file names + +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + +; Minted +(require 'ox-latex) +(setq org-latex-listings 'minted) +(add-to-list 'org-latex-packages-alist '("" "listings")) +(add-to-list 'org-latex-packages-alist '("" "color")) + + #+end_src + + #+RESULTS: + | | color | + | | listings | + # -*- mode: org -*- # vim: syntax=c + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 8a68835..3630a85 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -55,6 +55,7 @@ MunitResult test_<>() { #include "qmckl_context_private.h" #include "qmckl_memory.h" +#include #+end_src * Context handling @@ -103,6 +104,7 @@ typedef struct qmckl_context_struct { qmckl_memory_struct * alloc; /* Thread lock */ + int lock_count; pthread_mutex_t mutex; /* Validity checking */ @@ -150,8 +152,10 @@ qmckl_context qmckl_context_check(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx->tag != VALID_TAG) - return QMCKL_NULL_CONTEXT; + /* Try to access memory */ + if (ctx->tag != VALID_TAG) { + return QMCKL_NULL_CONTEXT; + } return context; } @@ -183,18 +187,7 @@ qmckl_context qmckl_context_create() { memset(ctx, 0, sizeof(qmckl_context_struct)); /* Initialize lock */ - pthread_mutexattr_t attr; - int rc; - - rc = pthread_mutexattr_init(&attr); - assert (rc == 0); - - (void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK); - - rc = pthread_mutex_init ( &(ctx->mutex), &attr); - assert (rc == 0); - - (void)pthread_mutexattr_destroy(&attr); + init_lock(&(ctx->mutex)); /* Initialize data */ ctx->tag = VALID_TAG; @@ -218,7 +211,6 @@ qmckl_context qmckl_context_create() { # Test #+begin_src c :comments link :tangle (eval c_test) :exports none munit_assert_int64( qmckl_context_check(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); -munit_assert_int64( qmckl_context_check(0x12345), ==, QMCKL_NULL_CONTEXT); qmckl_context context = qmckl_context_create(); munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT ); @@ -228,29 +220,60 @@ munit_assert_int64( qmckl_context_check(context), ==, context ); ** Locking For thread safety, the context may be locked/unlocked. The lock is - initialized with the ~PTHREAD_MUTEX_ERRORCHECK~, so it is a bit - slower than a usual mutex but safer. + initialized with the ~PTHREAD_MUTEX_RECURSIVE~ attribute, and the + number of times the thread has locked it is saved in the + ~lock_count~ attribute. # Header #+begin_src c :comments org :tangle (eval h) :exports none void qmckl_lock (qmckl_context context); void qmckl_unlock(qmckl_context context); + +void init_lock(pthread_mutex_t* mutex); #+end_src # Source #+begin_src c :tangle (eval c) +void init_lock(pthread_mutex_t* mutex) { + pthread_mutexattr_t attr; + int rc; + + rc = pthread_mutexattr_init(&attr); + assert (rc == 0); + + (void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + + rc = pthread_mutex_init ( mutex, &attr); + assert (rc == 0); + + (void)pthread_mutexattr_destroy(&attr); +} + void qmckl_lock(qmckl_context context) { if (context == QMCKL_NULL_CONTEXT) return ; qmckl_context_struct *ctx = (qmckl_context_struct*) context; + errno = 0; int rc = pthread_mutex_lock( &(ctx->mutex) ); + if (rc != 0) { + fprintf(stderr, "qmckl_lock:%s\n", strerror(rc) ); + fflush(stderr); + } assert (rc == 0); + ctx->lock_count++; + printf(" lock : %d\n", ctx->lock_count); } void qmckl_unlock(qmckl_context context) { qmckl_context_struct *ctx = (qmckl_context_struct*) context; int rc = pthread_mutex_unlock( &(ctx->mutex) ); + if (rc != 0) { + fprintf(stderr, "qmckl_unlock:%s\n", strerror(rc) ); + fflush(stderr); + } assert (rc == 0); + ctx->lock_count--; + printf("unlock : %d\n", ctx->lock_count); } #+end_src @@ -292,7 +315,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { /* Copy the old context on the new one */ memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct)); - qmckl_unlock(context); + qmckl_unlock( (qmckl_context) old_ctx ); new_ctx->prev = old_ctx; @@ -334,32 +357,42 @@ qmckl_context qmckl_context_destroy(qmckl_context context); #+begin_src c :tangle (eval c) qmckl_context qmckl_context_destroy(const qmckl_context context) { - qmckl_lock(context); - const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_NULL_CONTEXT; + qmckl_lock(context); + qmckl_context_struct* ctx = (qmckl_context_struct*) context; assert (ctx != NULL); /* Shouldn't be true because the context is valid */ - const qmckl_context prev_context = (qmckl_context) ctx->prev; - memset(ctx, 0, sizeof(qmckl_context_struct)); - ctx->tag = INVALID_TAG; + qmckl_unlock(context); + const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) ); + if (rc_destroy != 0) { + fprintf(stderr, "qmckl_context_destroy: %s %d\n", strerror(rc_destroy), ctx->lock_count); + abort(); + } + + const qmckl_context prev_context = (qmckl_context) ctx->prev; + if (prev_context == QMCKL_NULL_CONTEXT) { + /* This is the first context, free all memory. */ + struct qmckl_memory_struct* old = NULL; + while (ctx->alloc != NULL) { + old = ctx->alloc; + ctx->alloc = ctx->alloc->prev; + free(old->pointer); + old->pointer = NULL; + free(old); + old = NULL; + } + } + + ctx->tag = INVALID_TAG; const qmckl_exit_code rc = qmckl_free(context,ctx); assert (rc == QMCKL_SUCCESS); - if (prev_context == QMCKL_NULL_CONTEXT) { - /* This is the first context, free all memory. */ - while (ctx->alloc != NULL) { - free(ctx->alloc->pointer); - ctx->alloc = ctx->alloc->prev; - } - int rc = pthread_mutex_destroy( &(ctx->mutex) ); - assert (rc == 0); - } - - qmckl_unlock(context); + //memset(ctx, 0, sizeof(qmckl_context_struct)); + return prev_context; } @@ -1094,8 +1127,8 @@ double qmckl_context_get_epsilon(const qmckl_context context); # Source #+begin_src c :tangle (eval c) double qmckl_context_get_epsilon(const qmckl_context context) { - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return 1. / (double) (1 << (1 - ctx->fp->precision)); + const int precision = qmckl_context_get_precision(context); + return 1. / (double) (1L << (precision-1)); } #+end_src @@ -1245,51 +1278,72 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type basis->shell_center = (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_center == NULL) { qmckl_free(context, basis); + basis = NULL; return QMCKL_FAILURE; } basis->shell_ang_mom = (int32_t*) qmckl_malloc (context, shell_num * sizeof(int32_t)); if (basis->shell_ang_mom == NULL) { qmckl_free(context, basis->shell_center); + basis->shell_center = NULL; qmckl_free(context, basis); + basis = NULL; return QMCKL_FAILURE; } basis->shell_prim_num= (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_prim_num == NULL) { qmckl_free(context, basis->shell_ang_mom); + basis->shell_ang_mom = NULL; qmckl_free(context, basis->shell_center); + basis->shell_center = NULL; qmckl_free(context, basis); + basis = NULL; return QMCKL_FAILURE; } basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double )); if (basis->shell_factor == NULL) { qmckl_free(context, basis->shell_prim_num); + basis->shell_prim_num = NULL; qmckl_free(context, basis->shell_ang_mom); + basis->shell_ang_mom = NULL; qmckl_free(context, basis->shell_center); + basis->shell_center = NULL; qmckl_free(context, basis); + basis = NULL; return QMCKL_FAILURE; } basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double )); if (basis->exponent == NULL) { qmckl_free(context, basis->shell_factor); + basis->shell_factor = NULL; qmckl_free(context, basis->shell_prim_num); + basis->shell_prim_num = NULL; qmckl_free(context, basis->shell_ang_mom); + basis->shell_ang_mom = NULL; qmckl_free(context, basis->shell_center); + basis->shell_center = NULL; qmckl_free(context, basis); + basis = NULL; return QMCKL_FAILURE; } basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double )); if (basis->coefficient == NULL) { qmckl_free(context, basis->exponent); + basis->exponent = NULL; qmckl_free(context, basis->shell_factor); + basis->shell_factor = NULL; qmckl_free(context, basis->shell_prim_num); + basis->shell_prim_num = NULL; qmckl_free(context, basis->shell_ang_mom); + basis->shell_ang_mom = NULL; qmckl_free(context, basis->shell_center); + basis->shell_center = NULL; qmckl_free(context, basis); + basis = NULL; return QMCKL_FAILURE; } diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 3a7981a..5ee37b5 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -19,6 +19,10 @@ MunitResult test_<>() { #+end_src + #+begin_src c :comments org :tangle (eval h) +#include +#include + #+end_src * :PROPERTIES: :UNNUMBERED: t diff --git a/src/test_qmckl.org b/src/test_qmckl.org index 5633963..fe8e3a4 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -8,70 +8,81 @@ First, we use a script to find the list of all the generated test files: #+NAME: test-files - #+begin_src sh :exports none :results value -grep begin_src *.org | \ - grep test_qmckl_ | \ - rev | \ - cut -d ' ' -f 1 | \ - rev | \ - sort | \ - uniq + #+begin_src sh :exports none +FILES=$(cat table_of_contents) +grep begin_src $FILES \ + | grep c_test \ + | cut -d '.' -f 1 \ + | uniq #+end_src #+RESULTS: test-files - | test_qmckl_ao.c | - | test_qmckl_context.c | - | test_qmckl_distance.c | - | test_qmckl_memory.c | + | qmckl_error | + | qmckl_context | + | qmckl_memory | + | qmckl_distance | + | qmckl_ao | We generate the function headers - #+begin_src sh :var files=test-files :exports output :results raw + #+begin_src sh :var files=test-files :exports output :results drawer echo "#+NAME: headers" echo "#+begin_src c :tangle no" for file in $files do - routine=${file%.c} + routine=test_${file%.c} echo "MunitResult ${routine}();" done echo "#+end_src" #+end_src #+RESULTS: + :results: #+NAME: headers #+begin_src c :tangle no -MunitResult test_qmckl_ao(); -MunitResult test_qmckl_context(); -MunitResult test_qmckl_distance(); -MunitResult test_qmckl_memory(); + MunitResult test_qmckl_error(); + MunitResult test_qmckl_context(); + MunitResult test_qmckl_memory(); + MunitResult test_qmckl_distance(); + MunitResult test_qmckl_ao(); #+end_src - + :end: + and the required function calls: - #+begin_src sh :var files=test-files :exports output :results raw + #+begin_src sh :var files=test-files :exports output :results drawer echo "#+NAME: calls" echo "#+begin_src c :tangle no" for file in $files do - routine=${file%.c} + routine=test_${file%.c} echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," done echo "#+end_src" #+end_src #+RESULTS: + :results: #+NAME: calls #+begin_src c :tangle no - { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, #+end_src + :end: + + We include the =mcheck.h= header to enable the debugging of + allocations with ~mtrace~. Memory allocations will be traced in the + file specified by the ~MALLOC_TRACE~ environment variable. #+begin_src c :comments link :noweb yes :tangle test_qmckl.c #include "qmckl.h" #include "munit.h" +#include "mcheck.h" <> int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { + mtrace(); static MunitTest test_suite_tests[] = { <> @@ -83,6 +94,9 @@ int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE }; - return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); + + int result = munit_suite_main(&test_suite, (void*) "µnit", argc, argv); + muntrace(); + return result; } #+end_src diff --git a/tools/Building.org b/tools/Building.org index be6e8ab..8443b82 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -18,10 +18,10 @@ fi #+NAME: url-issues : https://github.com/trex-coe/qmckl/issues - + #+NAME: url-web : https://trex-coe.github.io/qmckl - + #+NAME: license #+begin_example BSD 3-Clause License @@ -66,18 +66,18 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. generated by the script detailed in the next section. ** Header :noexport: - #+begin_src makefile + #+begin_src makefile # <> #+end_src ** Dependencies - #+begin_src makefile + #+begin_src makefile LIBS=-lpthread #+end_src - + ** Variables - #+begin_src makefile + #+begin_src makefile QMCKL_ROOT=$(shell dirname $(CURDIR)) export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT @@ -88,10 +88,10 @@ INCLUDE=-I$(QMCKL_ROOT)/include/ #+end_src ** Compiler options - + GNU, Intel and LLVM compilers are supported. Choose here: - #+begin_src makefile + #+begin_src makefile COMPILER=GNU #COMPILER=INTEL #COMPILER=LLVM @@ -99,7 +99,7 @@ COMPILER=GNU *** GNU - #+begin_src makefile + #+begin_src makefile ifeq ($(COMPILER),GNU) #---------------------------------------------------------- CC=gcc -g @@ -111,15 +111,15 @@ FFLAGS=-fPIC $(INCLUDE) \ -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising \ -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation \ -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ - -ffpe-trap=zero,overflow,underflow + -ffpe-trap=zero,overflow,underflow -LIBS+=-lgfortran -lm +LIBS+=-lgfortran -lm #---------------------------------------------------------- endif #+end_src *** Intel - + #+begin_src makefile ifeq ($(COMPILER),INTEL) #---------------------------------------------------------- @@ -136,7 +136,7 @@ endif #+end_src *** LLVM - + #+begin_src makefile ifeq ($(COMPILER),LLVM) #---------------------------------------------------------- @@ -150,7 +150,7 @@ LIBS+=-lm #---------------------------------------------------------- endif #+end_src - + ** Rules The source files are created during the generation of the file ~Makefile.generated~. @@ -159,7 +159,7 @@ endif .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files -libqmckl.so: Makefile.generated +libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated ../include/qmckl.h: libqmckl.so @@ -169,7 +169,7 @@ test: Makefile.generated ../include/qmckl.h $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) - $(QMCKL_ROOT)/tools/create_doc.sh + $(QMCKL_ROOT)/tools/create_doc.sh clean: $(RM) test_qmckl_* test_qmckl.c test_qmckl \ @@ -177,7 +177,7 @@ clean: Makefile.generated libqmckl.so *.html *.mod Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) - $(QMCKL_ROOT)/tools/create_makefile.sh + $(QMCKL_ROOT)/tools/create_makefile.sh #+end_src * Script to tangle the org-mode files @@ -227,8 +227,8 @@ done This script generates the Makefile that compiles the library. The ~OUTPUT~ variable contains the name of the generated Makefile,typically =Makefile.generated=. - - #+begin_src bash + + #+begin_src bash # <> <> @@ -238,21 +238,21 @@ OUTPUT=Makefile.generated We start by tangling all the org-mode files. - #+begin_src bash + #+begin_src bash ${QMCKL_ROOT}/tools/tangle.sh *.org #+end_src Then we create the list of ~*.o~ files to be created, for library functions: - #+begin_src bash -OBJECTS="" + #+begin_src bash +OBJECTS="qmckl_f.o" for i in $(ls qmckl_*.c) ; do FILE=${i%.c} OBJECTS="${OBJECTS} ${FILE}.o" done >> $OUTPUT -for i in $(ls qmckl_*_f.f90) ; do +for i in $(ls qmckl*_f.f90) ; do FILE=${i%.f90} OBJECTS="${OBJECTS} ${FILE}.o" done >> $OUTPUT @@ -260,7 +260,7 @@ done >> $OUTPUT for tests in C: - #+begin_src bash + #+begin_src bash TESTS="" for i in $(ls test_qmckl_*.c) ; do FILE=${i%.c}.o @@ -269,8 +269,8 @@ done >> $OUTPUT #+end_src and for tests in Fortran: - - #+begin_src bash + + #+begin_src bash TESTS_F="" for i in $(ls test_qmckl_*_f.f90) ; do FILE=${i%.f90}.o @@ -280,10 +280,10 @@ done >> $OUTPUT Finally, we append the rules to the Makefile - #+begin_src bash + #+begin_src bash cat << EOF > ${OUTPUT} CC=$CC -CFLAGS=$CFLAGS -I../munit/ +CFLAGS=$CFLAGS -I../munit/ FC=$FC FFLAGS=$FFLAGS @@ -295,17 +295,18 @@ LIBS=$LIBS libqmckl.so: \$(OBJECT_FILES) \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so - -%.o: %.c + +%.o: %.c \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o - -qmckl_f.o: ../include/qmckl_f.f90 - \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o - %.o: %.f90 qmckl_f.o \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o +../include/qmckl.h ../include/qmckl_f.f90: + ../tools/build_qmckl_h.sh + +qmckl_f.o: ../include/qmckl_f.f90 + \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ @@ -317,8 +318,8 @@ test: test_qmckl .PHONY: test EOF - #+end_src - + #+end_src + * Script to build the final qmckl.h file :PROPERTIES: :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments org @@ -339,7 +340,7 @@ EOF Issues : <> <> - + #+end_src @@ -349,7 +350,7 @@ EOF Put =.h= files in the correct order: - #+begin_src bash + #+begin_src bash HEADERS="" for i in $(cat table_of_contents) do @@ -358,8 +359,8 @@ done #+end_src Generate C header file - - #+begin_src bash + + #+begin_src bash OUTPUT="../include/qmckl.h" cat << EOF > ${OUTPUT} @@ -387,8 +388,8 @@ EOF #+end_src Generate Fortran interface file from all =qmckl_*_fh.f90= files - - #+begin_src bash + + #+begin_src bash HEADERS="qmckl_*_fh.f90" OUTPUT="../include/qmckl_f.f90" diff --git a/tools/create_makefile.sh b/tools/create_makefile.sh index d7bd2f5..e134089 100755 --- a/tools/create_makefile.sh +++ b/tools/create_makefile.sh @@ -28,13 +28,13 @@ ${QMCKL_ROOT}/tools/tangle.sh *.org # functions: -OBJECTS="" +OBJECTS="qmckl_f.o" for i in $(ls qmckl_*.c) ; do FILE=${i%.c} OBJECTS="${OBJECTS} ${FILE}.o" done >> $OUTPUT -for i in $(ls qmckl_*_f.f90) ; do +for i in $(ls qmckl*_f.f90) ; do FILE=${i%.f90} OBJECTS="${OBJECTS} ${FILE}.o" done >> $OUTPUT @@ -84,13 +84,14 @@ libqmckl.so: \$(OBJECT_FILES) %.o: %.c \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o - -qmckl_f.o: ../include/qmckl_f.f90 - \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o - %.o: %.f90 qmckl_f.o \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o +../include/qmckl.h ../include/qmckl_f.f90: + ../tools/build_qmckl_h.sh + +qmckl_f.o: ../include/qmckl_f.f90 + \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ From d10c84acbb53ead52de193b84229ceb866505b33 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 18 Mar 2021 19:12:39 +0100 Subject: [PATCH 25/65] Fixed context --- src/qmckl_context.org | 118 +++++++++++++++++++++++++----------------- src/qmckl_error.org | 39 +++++++------- 2 files changed, 92 insertions(+), 65 deletions(-) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 3630a85..94d6f23 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -195,6 +195,20 @@ qmckl_context qmckl_context_create() { const qmckl_context context = (qmckl_context) ctx; assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); + /* + qmckl_memory_struct* alloc = (qmckl_memory_struct*) + malloc(sizeof(qmckl_memory_struct)); + + if (alloc == NULL) { + qmckl_unlock(context); + return QMCKL_NULL_CONTEXT; + } + + memset(alloc,0,sizeof(qmckl_memory_struct)); + + ctx->alloc = alloc; + */ + return context; } #+end_src @@ -261,7 +275,9 @@ void qmckl_lock(qmckl_context context) { } assert (rc == 0); ctx->lock_count++; +/* printf(" lock : %d\n", ctx->lock_count); +*/ } void qmckl_unlock(qmckl_context context) { @@ -273,7 +289,9 @@ void qmckl_unlock(qmckl_context context) { } assert (rc == 0); ctx->lock_count--; +/* printf("unlock : %d\n", ctx->lock_count); +*/ } #+end_src @@ -315,10 +333,11 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { /* Copy the old context on the new one */ memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct)); - qmckl_unlock( (qmckl_context) old_ctx ); - new_ctx->prev = old_ctx; + qmckl_unlock( (qmckl_context) new_ctx ); + qmckl_unlock( (qmckl_context) old_ctx ); + return (qmckl_context) new_ctx; } @@ -367,28 +386,34 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) { qmckl_unlock(context); - const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) ); - if (rc_destroy != 0) { - fprintf(stderr, "qmckl_context_destroy: %s %d\n", strerror(rc_destroy), ctx->lock_count); - abort(); - } - const qmckl_context prev_context = (qmckl_context) ctx->prev; if (prev_context == QMCKL_NULL_CONTEXT) { /* This is the first context, free all memory. */ - struct qmckl_memory_struct* old = NULL; + struct qmckl_memory_struct* new = NULL; while (ctx->alloc != NULL) { - old = ctx->alloc; - ctx->alloc = ctx->alloc->prev; - free(old->pointer); - old->pointer = NULL; - free(old); - old = NULL; + new = ctx->alloc->next; + free(ctx->alloc->pointer); + ctx->alloc->pointer = NULL; + free(ctx->alloc); + ctx->alloc = new; } } + qmckl_exit_code rc; + rc = qmckl_context_remove_memory(context,ctx); +/* + assert (rc == QMCKL_SUCCESS); + */ + ctx->tag = INVALID_TAG; - const qmckl_exit_code rc = qmckl_free(context,ctx); + + const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) ); + if (rc_destroy != 0) { + fprintf(stderr, "qmckl_context_destroy: %s (count = %d)\n", strerror(rc_destroy), ctx->lock_count); + abort(); + } + + rc = qmckl_free(context,ctx); assert (rc == QMCKL_SUCCESS); //memset(ctx, 0, sizeof(qmckl_context_struct)); @@ -472,7 +497,7 @@ munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CO #+NAME: qmckl_memory_struct #+begin_src c :comments org :tangle no typedef struct qmckl_memory_struct { - struct qmckl_memory_struct * prev ; + struct qmckl_memory_struct * next ; void * pointer ; size_t size ; } qmckl_memory_struct; @@ -510,19 +535,27 @@ qmckl_exit_code qmckl_context_append_memory(qmckl_context context, qmckl_context_struct* ctx = (qmckl_context_struct*) context; - qmckl_memory_struct* alloc = (qmckl_memory_struct*) + qmckl_memory_struct* new_alloc = (qmckl_memory_struct*) malloc(sizeof(qmckl_memory_struct)); - if (alloc == NULL) { + if (new_alloc == NULL) { qmckl_unlock(context); return QMCKL_ALLOCATION_FAILED; } - alloc->prev = ctx->alloc; - alloc->pointer = pointer; - alloc->size = size; + new_alloc->next = NULL; + new_alloc->pointer = pointer; + new_alloc->size = size; - ctx->alloc = alloc; + qmckl_memory_struct* alloc = ctx->alloc; + if (alloc == NULL) { + ctx->alloc = new_alloc; + } else { + while (alloc != NULL) { + alloc = alloc->next; + } + alloc->next = new_alloc; + } qmckl_unlock(context); @@ -560,35 +593,26 @@ qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, qmckl_context_struct* ctx = (qmckl_context_struct*) context; - qmckl_memory_struct* alloc; - qmckl_memory_struct* next; + qmckl_memory_struct* alloc = ctx->alloc; + qmckl_memory_struct* prev = ctx->alloc; - if (ctx->alloc->pointer == pointer) { - - alloc = ctx->alloc->prev; - free(ctx->alloc); - ctx->alloc = alloc; - - } else { - - next = ctx->alloc; - alloc = next->prev; - - while (alloc != NULL) { - if (alloc->pointer == pointer) { - next->prev = alloc->prev; - free(alloc); - alloc = NULL; - } else { - next = alloc; - alloc = alloc->prev; - } - } + while ( (alloc != NULL) && (alloc->pointer != pointer) ) { + prev = alloc; + alloc = alloc->next; } + + if (alloc != NULL) { + prev->next = alloc->next; + free(alloc); + } qmckl_unlock(context); - return QMCKL_SUCCESS; + if (alloc != NULL) { + return QMCKL_SUCCESS; + } else { + return QMCKL_DEALLOCATION_FAILED; + } } #+end_src diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 5ee37b5..7373f9f 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -47,22 +47,23 @@ typedef int32_t qmckl_exit_code; Here is the complete list of exit codes. #+NAME: table-exit-codes - | ~QMCKL_SUCCESS~ | 0 | - | ~QMCKL_INVALID_ARG_1~ | 1 | - | ~QMCKL_INVALID_ARG_2~ | 2 | - | ~QMCKL_INVALID_ARG_3~ | 3 | - | ~QMCKL_INVALID_ARG_4~ | 4 | - | ~QMCKL_INVALID_ARG_5~ | 5 | - | ~QMCKL_INVALID_ARG_6~ | 6 | - | ~QMCKL_INVALID_ARG_7~ | 7 | - | ~QMCKL_INVALID_ARG_8~ | 8 | - | ~QMCKL_INVALID_ARG_9~ | 9 | - | ~QMCKL_INVALID_ARG_10~ | 10 | - | ~QMCKL_FAILURE~ | 101 | - | ~QMCKL_ERRNO~ | 102 | - | ~QMCKL_INVALID_CONTEXT~ | 103 | - | ~QMCKL_ALLOCATION_FAILED~ | 104 | - | ~QMCKL_INVALID_EXIT_CODE~ | 105 | + | ~QMCKL_SUCCESS~ | 0 | + | ~QMCKL_INVALID_ARG_1~ | 1 | + | ~QMCKL_INVALID_ARG_2~ | 2 | + | ~QMCKL_INVALID_ARG_3~ | 3 | + | ~QMCKL_INVALID_ARG_4~ | 4 | + | ~QMCKL_INVALID_ARG_5~ | 5 | + | ~QMCKL_INVALID_ARG_6~ | 6 | + | ~QMCKL_INVALID_ARG_7~ | 7 | + | ~QMCKL_INVALID_ARG_8~ | 8 | + | ~QMCKL_INVALID_ARG_9~ | 9 | + | ~QMCKL_INVALID_ARG_10~ | 10 | + | ~QMCKL_FAILURE~ | 101 | + | ~QMCKL_ERRNO~ | 102 | + | ~QMCKL_INVALID_CONTEXT~ | 103 | + | ~QMCKL_ALLOCATION_FAILED~ | 104 | + | ~QMCKL_DEALLOCATION_FAILED~ | 105 | + | ~QMCKL_INVALID_EXIT_CODE~ | 106 | # We need to force Emacs not to indent the Python code: # -*- org-src-preserve-indentation: t @@ -108,7 +109,8 @@ return '\n'.join(result) #define QMCKL_ERRNO 102 #define QMCKL_INVALID_CONTEXT 103 #define QMCKL_ALLOCATION_FAILED 104 - #define QMCKL_INVALID_EXIT_CODE 105 + #define QMCKL_DEALLOCATION_FAILED 105 + #define QMCKL_INVALID_EXIT_CODE 106 #+end_src #+begin_src f90 :comments org :tangle (eval fh) :exports none @@ -127,7 +129,8 @@ return '\n'.join(result) integer, parameter :: QMCKL_ERRNO = 102 integer, parameter :: QMCKL_INVALID_CONTEXT = 103 integer, parameter :: QMCKL_ALLOCATION_FAILED = 104 - integer, parameter :: QMCKL_INVALID_EXIT_CODE = 105 + integer, parameter :: QMCKL_DEALLOCATION_FAILED = 105 + integer, parameter :: QMCKL_INVALID_EXIT_CODE = 106 #+end_src :end: From 676d5867bdad6ff386dacae195402c4d313865e9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 18 Mar 2021 23:55:50 +0100 Subject: [PATCH 26/65] Fixed qmckl_memory --- src/qmckl_context.org | 87 +++++++++++++++++++++---------------------- src/qmckl_memory.org | 46 +++++++++++++---------- src/test_qmckl.org | 6 +-- 3 files changed, 71 insertions(+), 68 deletions(-) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 94d6f23..01c0945 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -9,7 +9,7 @@ signed integer, defined in the ~qmckl_context~ type. A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a ~NULL~ pointer. - + #+begin_src c :comments org :tangle (eval h) typedef int64_t qmckl_context ; #define QMCKL_NULL_CONTEXT (qmckl_context) 0 @@ -231,6 +231,46 @@ munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT ); munit_assert_int64( qmckl_context_check(context), ==, context ); #+end_src +** Access to the previous context + + ~qmckl_context_previous~ returns the previous context. It returns + ~QMCKL_NULL_CONTEXT~ for the initial context and for the ~NULL~ context. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_context qmckl_context_previous(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_context qmckl_context_previous(const qmckl_context context) { + + const qmckl_context checked_context = qmckl_context_check(context); + if (checked_context == (qmckl_context) 0) { + return (qmckl_context) 0; + } + + const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; + return qmckl_context_check((qmckl_context) ctx->prev); +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int64_t) function qmckl_context_previous(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_previous + end interface + #+end_src + + # Test + #+begin_src c :comments link :tangle (eval c_test) :exports none +munit_assert_int64(qmckl_context_previous(context), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); + #+end_src + ** Locking For thread safety, the context may be locked/unlocked. The lock is @@ -356,10 +396,10 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { # Test #+begin_src c :comments link :tangle (eval c_test) :exports none qmckl_context new_context = qmckl_context_copy(context); - munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); +munit_assert_int64(qmckl_context_previous(new_context), ==, context); #+end_src ** Destroy @@ -436,7 +476,6 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) { # Test #+begin_src c :tangle (eval c_test) :exports none munit_assert_int64(qmckl_context_check(new_context), ==, new_context); -munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); munit_assert_int64(qmckl_context_destroy(new_context), ==, context); munit_assert_int64(qmckl_context_check(new_context), !=, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_CONTEXT); @@ -444,48 +483,6 @@ munit_assert_int64(qmckl_context_destroy(context), ==, QMCKL_NULL_CONTEXT); munit_assert_int64(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); #+end_src -** Access to the previous context - - ~qmckl_context_previous~ returns the previous context. It returns - ~QMCKL_NULL_CONTEXT~ for the initial context and for the ~NULL~ context. - - # Header - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_context qmckl_context_previous(const qmckl_context context); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_previous(const qmckl_context context) { - - const qmckl_context checked_context = qmckl_context_check(context); - if (checked_context == (qmckl_context) 0) { - return (qmckl_context) 0; - } - - const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; - return qmckl_context_check((qmckl_context) ctx->prev); -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer (c_int64_t) function qmckl_context_previous(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_previous - end interface - #+end_src - - # Test - #+begin_src c :comments link :tangle (eval c_test) :exports none -munit_assert_int64(qmckl_context_previous(new_context), !=, QMCKL_NULL_CONTEXT); -munit_assert_int64(qmckl_context_previous(new_context), ==, context); -munit_assert_int64(qmckl_context_previous(context), ==, QMCKL_NULL_CONTEXT); -munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); - #+end_src - * Memory allocation handling ** Data structure diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index f70d4b6..6d17694 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -30,6 +30,10 @@ MunitResult test_<>() { #+end_src * +:PROPERTIES: +:UNNUMBERED: t +:END: + Memory allocation inside the library should be done with ~qmckl_malloc~. It lets the library choose how the memory will be allocated, and a pointer is returned to the user. The context is @@ -60,6 +64,7 @@ void* qmckl_malloc(qmckl_context context, const size_t size) { return pointer; } #+end_src + # Fortran interface #+begin_src f90 :tangle (eval fh) :noexport interface @@ -71,24 +76,21 @@ void* qmckl_malloc(qmckl_context context, const size_t size) { end interface #+end_src -** Test :noexport: + # Test :noexport: #+begin_src c :tangle (eval c_test) - int *a = NULL; - munit_assert(a == NULL); - a = (int*) qmckl_malloc( QMCKL_NULL_CONTEXT, 3*sizeof(int)); - munit_assert(a != NULL); - a[0] = 1; - a[1] = 2; - a[2] = 3; - munit_assert_int(a[0], ==, 1); - munit_assert_int(a[1], ==, 2); - munit_assert_int(a[2], ==, 3); +qmckl_context context = qmckl_context_create(); + +int *a = (int*) qmckl_malloc(context, 3*sizeof(int)); +munit_assert(a != NULL); + +a[0] = 1; munit_assert_int(a[0], ==, 1); +a[1] = 2; munit_assert_int(a[1], ==, 2); +a[2] = 3; munit_assert_int(a[2], ==, 3); #+end_src -* ~qmckl_free~ - - The context is passed, in case some important information has been - stored related to memory allocation and needs to be updated. + When freeing the memory with ~qmckl_free~, the context is passed, in + case some important information has been stored related to memory + allocation and needs to be updated. #+begin_src c :tangle (eval h) qmckl_exit_code qmckl_free(qmckl_context context, @@ -105,7 +107,7 @@ qmckl_exit_code qmckl_free(qmckl_context context, end interface #+end_src -** Source + # Source #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { @@ -127,11 +129,15 @@ qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { } #+end_src -** Test :noexport: - #+begin_src c :tangle (eval c_test) -munit_assert(a != NULL); + # Test + #+begin_src c :tangle (eval c_test) :exports none qmckl_exit_code rc; -rc = qmckl_free( (qmckl_context) 1, a); + +munit_assert(a != NULL); +rc = qmckl_free(context, a); +munit_assert(rc == QMCKL_SUCCESS); + +rc = qmckl_context_destroy(context); munit_assert(rc == QMCKL_SUCCESS); #+end_src diff --git a/src/test_qmckl.org b/src/test_qmckl.org index fe8e3a4..cc72999 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -65,9 +65,9 @@ echo "#+end_src" #+begin_src c :tangle no { (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, +// { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, +// { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, +// { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, #+end_src :end: From 8c7a1df382482a53311d36c121b6f97b6b415809 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 00:10:35 +0100 Subject: [PATCH 27/65] All tests fixed --- src/qmckl_ao.org | 24 ++++++++++--------- src/qmckl_distance.org | 54 +++++++++++++++++++++++++----------------- 2 files changed, 45 insertions(+), 33 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index f997913..93d9b92 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -485,7 +485,6 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) Y(:) = X(:) - R(:) lmax = 4; - n = 0; ldl = 3; ldv = 100; @@ -495,23 +494,26 @@ 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) - if (test_qmckl_ao_polynomial_vgl /= 0) return - test_qmckl_ao_polynomial_vgl = -1 + if (test_qmckl_ao_polynomial_vgl /= QMCKL_INVALID_ARG_5) return - if (n /= d) return + n=d + test_qmckl_ao_polynomial_vgl = & + qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) + + if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return do j=1,n - test_qmckl_ao_polynomial_vgl = -11 + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE do i=1,3 if (L(i,j) < 0) return end do - test_qmckl_ao_polynomial_vgl = -12 + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE if (dabs(1.d0 - VGL(1,j) / (& Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) & )) > epsilon ) return - test_qmckl_ao_polynomial_vgl = -13 + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE if (L(1,j) < 1) then if (VGL(2,j) /= 0.d0) return else @@ -520,7 +522,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) )) > epsilon ) return end if - test_qmckl_ao_polynomial_vgl = -14 + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE if (L(2,j) < 1) then if (VGL(3,j) /= 0.d0) return else @@ -529,7 +531,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) )) > epsilon ) return end if - test_qmckl_ao_polynomial_vgl = -15 + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE if (L(3,j) < 1) then if (VGL(4,j) /= 0.d0) return else @@ -538,7 +540,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) )) > epsilon ) return end if - test_qmckl_ao_polynomial_vgl = -16 + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE w = 0.d0 if (L(1,j) > 1) then w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j) @@ -552,7 +554,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return end do - test_qmckl_ao_polynomial_vgl = 0 + test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS deallocate(L,VGL) end function test_qmckl_ao_polynomial_vgl diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index e797393..b239621 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -21,19 +21,16 @@ MunitResult test_<>() { * Squared distance -** ~qmckl_distance_sq~ + ~qmckl_distance_sq~ computes the matrix of the squared distances + between all pairs of points in two sets, one point within each set: - Computes the matrix of the squared distances between all pairs of - points in two sets, one point within each set: \[ C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 \] -*** Arguments - | ~context~ | input | Global state | - | ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed | - | ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed | + | ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed | + | ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed | | ~m~ | input | Number of points in the first set | | ~n~ | input | Number of points in the second set | | ~A(lda,3)~ | input | Array containing the $m \times 3$ matrix $A$ | @@ -74,6 +71,7 @@ qmckl_exit_code qmckl_distance_sq(const qmckl_context context, *** Source #+begin_src f90 :tangle (eval f) integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) + use qmckl implicit none integer*8 , intent(in) :: context character , intent(in) :: transa, transb @@ -91,18 +89,18 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L info = 0 - if (context == 0_8) then - info = -1 + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT return endif if (m <= 0_8) then - info = -2 + info = QMCKL_INVALID_ARG_4 return endif if (n <= 0_8) then - info = -3 + info = QMCKL_INVALID_ARG_5 return endif @@ -123,27 +121,27 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L endif if (transab < 0) then - info = -4 + info = QMCKL_INVALID_ARG_1 return endif if (iand(transab,1) == 0 .and. LDA < 3) then - info = -5 + info = QMCKL_INVALID_ARG_7 return endif if (iand(transab,1) == 1 .and. LDA < m) then - info = -6 + info = QMCKL_INVALID_ARG_7 return endif if (iand(transab,2) == 0 .and. LDA < 3) then - info = -6 + info = QMCKL_INVALID_ARG_7 return endif if (iand(transab,2) == 2 .and. LDA < m) then - info = -7 + info = QMCKL_INVALID_ARG_7 return endif @@ -270,13 +268,19 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) end do end do - test_qmckl_distance_sq = qmckl_distance_sq(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC) + test_qmckl_distance_sq = & + qmckl_distance_sq(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq == 0) return - test_qmckl_distance_sq = qmckl_distance_sq(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC) + test_qmckl_distance_sq = & + qmckl_distance_sq(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq == 0) return - test_qmckl_distance_sq = qmckl_distance_sq(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC) + test_qmckl_distance_sq = & + qmckl_distance_sq(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq /= 0) return test_qmckl_distance_sq = -1 @@ -290,7 +294,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) end do end do - test_qmckl_distance_sq = qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC) + test_qmckl_distance_sq = & + qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq /= 0) return test_qmckl_distance_sq = -1 @@ -304,7 +310,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) end do end do - test_qmckl_distance_sq = qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC) + test_qmckl_distance_sq = & + qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq /= 0) return test_qmckl_distance_sq = -1 @@ -318,7 +326,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) end do end do - test_qmckl_distance_sq = qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC) + test_qmckl_distance_sq = & + qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq /= 0) return test_qmckl_distance_sq = -1 From 14c216a51a87865be744d467a46ae6b2a26412cb Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 00:16:18 +0100 Subject: [PATCH 28/65] FIxed tests --- src/qmckl_ao.org | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 93d9b92..40e2823 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -325,11 +325,6 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, return endif - if (n <= 0) then - info = QMCKL_INVALID_ARG_5 - return - endif - if (ldl < 3) then info = QMCKL_INVALID_ARG_7 return @@ -492,16 +487,11 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) allocate (L(ldl,d), VGL(ldv,d)) - test_qmckl_ao_polynomial_vgl = & - qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) - - if (test_qmckl_ao_polynomial_vgl /= QMCKL_INVALID_ARG_5) return - - n=d test_qmckl_ao_polynomial_vgl = & qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return + if (n /= d) return do j=1,n test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE From 87ad36e342996f0a19429e5cb78933b7d5e472ae Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 13:47:50 +0100 Subject: [PATCH 29/65] Fixing CI --- src/Makefile | 14 ++++++------ src/test_qmckl.org | 6 ++--- tools/Building.org | 47 ++++++++++++++++++++-------------------- tools/build_qmckl_h.sh | 4 ++-- tools/config_tangle.el | 1 - tools/create_makefile.sh | 27 ++++++++++------------- tools/tangle.sh | 22 +++++++++++-------- 7 files changed, 59 insertions(+), 62 deletions(-) diff --git a/src/Makefile b/src/Makefile index 042c095..8b52a4b 100644 --- a/src/Makefile +++ b/src/Makefile @@ -20,7 +20,7 @@ OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE INCLUDE=-I$(QMCKL_ROOT)/include/ # Compiler options - + # GNU, Intel and LLVM compilers are supported. Choose here: @@ -42,14 +42,14 @@ FFLAGS=-fPIC $(INCLUDE) \ -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising \ -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation \ -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ - -ffpe-trap=zero,overflow,underflow + -ffpe-trap=zero,overflow,underflow -LIBS+=-lgfortran -lm +LIBS+=-lgfortran -lm #---------------------------------------------------------- endif # Intel - + ifeq ($(COMPILER),INTEL) #---------------------------------------------------------- @@ -65,7 +65,7 @@ CC=icc -xHost endif # LLVM - + ifeq ($(COMPILER),LLVM) #---------------------------------------------------------- @@ -87,7 +87,7 @@ endif .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files -libqmckl.so: Makefile.generated +libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated ../include/qmckl.h: libqmckl.so @@ -97,7 +97,7 @@ test: Makefile.generated ../include/qmckl.h $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) - $(QMCKL_ROOT)/tools/create_doc.sh + $(QMCKL_ROOT)/tools/build_doc.sh clean: $(RM) test_qmckl_* test_qmckl.c test_qmckl \ diff --git a/src/test_qmckl.org b/src/test_qmckl.org index cc72999..fe8e3a4 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -65,9 +65,9 @@ echo "#+end_src" #+begin_src c :tangle no { (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, -// { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, -// { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, -// { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, #+end_src :end: diff --git a/tools/Building.org b/tools/Building.org index 8443b82..200ef08 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -10,9 +10,9 @@ echo "This file was created by tools/Building.org" #+NAME: check-src #+begin_src bash -if [[ $(basename $PWD) != "src" ]] ; then - echo "This script needs to be run in the src directory" - exit -1 +if [[ $(basename ${PWD}) != "src" ]] ; then + echo "This script needs to be run in the src directory" + exit -1 fi #+end_src @@ -200,22 +200,26 @@ Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURC The file is not tangled if the last modification date of the org file is less recent than one of the tangled files. + #+begin_src bash function tangle() { - if [[ -f ${1%.org}.c && $1 -ot ${1%.org}.c ]] - then return - elif [[ -f ${1%.org}.f90 && $1 -ot ${1%.org}.f90 ]] - then return - fi - emacs --batch $1 --load=../tools/config_tangle.el -f org-babel-tangle -} + local org_file=$1 + local c_file=${org_file%.org}.c + local f_file=${org_file%.org}.f90 + if [[ ${org_file} -ot ${c_file} ]] ; then + return + elif [[ ${org_file} -ot ${f_file} ]] ; then + return + fi + emacs --batch ${org_file} --load=../tools/config_tangle.el -f org-babel-tangle +} for i in $@ do - echo "--- $i ----" - tangle $i + echo "--- ${i} ----" + tangle ${i} done #+end_src @@ -247,14 +251,9 @@ ${QMCKL_ROOT}/tools/tangle.sh *.org #+begin_src bash OBJECTS="qmckl_f.o" -for i in $(ls qmckl_*.c) ; do - FILE=${i%.c} - OBJECTS="${OBJECTS} ${FILE}.o" -done >> $OUTPUT - -for i in $(ls qmckl*_f.f90) ; do - FILE=${i%.f90} - OBJECTS="${OBJECTS} ${FILE}.o" +for i in $(ls qmckl_*.c qmckl_*f.f90) ; do + FILE=${i%.*} + OBJECTS+=" ${FILE}.o" done >> $OUTPUT #+end_src @@ -263,8 +262,8 @@ done >> $OUTPUT #+begin_src bash TESTS="" for i in $(ls test_qmckl_*.c) ; do - FILE=${i%.c}.o - TESTS="${TESTS} ${FILE}" + FILE=${i%.c} + TESTS+=" ${FILE}.o" done >> $OUTPUT #+end_src @@ -273,8 +272,8 @@ done >> $OUTPUT #+begin_src bash TESTS_F="" for i in $(ls test_qmckl_*_f.f90) ; do - FILE=${i%.f90}.o - TESTS_F="${TESTS_F} ${FILE}" + FILE=${i%.f90} + TESTS_F+=" ${FILE}.o" done >> $OUTPUT #+end_src diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh index 03396f3..78f2665 100755 --- a/tools/build_qmckl_h.sh +++ b/tools/build_qmckl_h.sh @@ -69,7 +69,7 @@ cat << EOF > ${OUTPUT} * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * - * + * * */ @@ -139,7 +139,7 @@ cat << EOF > ${OUTPUT} ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ! -! +! ! ! module qmckl diff --git a/tools/config_tangle.el b/tools/config_tangle.el index 53ca152..73b613d 100755 --- a/tools/config_tangle.el +++ b/tools/config_tangle.el @@ -14,7 +14,6 @@ ("gnu" . 10))) -(require 'htmlize) (require 'font-lock) (setq org-confirm-babel-evaluate nil) (global-font-lock-mode t) diff --git a/tools/create_makefile.sh b/tools/create_makefile.sh index e134089..209857c 100755 --- a/tools/create_makefile.sh +++ b/tools/create_makefile.sh @@ -7,7 +7,7 @@ # This script generates the Makefile that compiles the library. # The ~OUTPUT~ variable contains the name of the generated Makefile,typically # =Makefile.generated=. - + # This file was created by tools/Building.org @@ -29,14 +29,9 @@ ${QMCKL_ROOT}/tools/tangle.sh *.org OBJECTS="qmckl_f.o" -for i in $(ls qmckl_*.c) ; do - FILE=${i%.c} - OBJECTS="${OBJECTS} ${FILE}.o" -done >> $OUTPUT - -for i in $(ls qmckl*_f.f90) ; do - FILE=${i%.f90} - OBJECTS="${OBJECTS} ${FILE}.o" +for i in $(ls qmckl_*.c qmckl_*f.f90) ; do + FILE=${i%.*} + OBJECTS+=" ${FILE}.o" done >> $OUTPUT @@ -46,8 +41,8 @@ done >> $OUTPUT TESTS="" for i in $(ls test_qmckl_*.c) ; do - FILE=${i%.c}.o - TESTS="${TESTS} ${FILE}" + FILE=${i%.c} + TESTS+=" ${FILE}.o" done >> $OUTPUT @@ -57,8 +52,8 @@ done >> $OUTPUT TESTS_F="" for i in $(ls test_qmckl_*_f.f90) ; do - FILE=${i%.f90}.o - TESTS_F="${TESTS_F} ${FILE}" + FILE=${i%.f90} + TESTS_F+=" ${FILE}.o" done >> $OUTPUT @@ -68,7 +63,7 @@ done >> $OUTPUT cat << EOF > ${OUTPUT} CC=$CC -CFLAGS=$CFLAGS -I../munit/ +CFLAGS=$CFLAGS -I../munit/ FC=$FC FFLAGS=$FFLAGS @@ -80,8 +75,8 @@ LIBS=$LIBS libqmckl.so: \$(OBJECT_FILES) \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so - -%.o: %.c + +%.o: %.c \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o %.o: %.f90 qmckl_f.o diff --git a/tools/tangle.sh b/tools/tangle.sh index 0250ec4..1615465 100755 --- a/tools/tangle.sh +++ b/tools/tangle.sh @@ -19,19 +19,23 @@ # The file is not tangled if the last modification date of the org # file is less recent than one of the tangled files. + function tangle() { - if [[ -f ${1%.org}.c && $1 -ot ${1%.org}.c ]] - then return - elif [[ -f ${1%.org}.f90 && $1 -ot ${1%.org}.f90 ]] - then return - fi - emacs --batch $1 --load=../tools/config_tangle.el -f org-babel-tangle -} + local org_file=$1 + local c_file=${org_file%.org}.c + local f_file=${org_file%.org}.f90 + if [[ ${org_file} -ot ${c_file} ]] ; then + return + elif [[ ${org_file} -ot ${f_file} ]] ; then + return + fi + emacs --batch ${org_file} --load=../tools/config_tangle.el -f org-babel-tangle +} for i in $@ do - echo "--- $i ----" - tangle $i + echo "--- ${i} ----" + tangle ${i} done From c5bc3a29d5e9c9492ebac45c906a03f3a016c653 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 13:51:00 +0100 Subject: [PATCH 30/65] Added include directory --- include/.gitignore | 1 + 1 file changed, 1 insertion(+) create mode 100644 include/.gitignore diff --git a/include/.gitignore b/include/.gitignore new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/include/.gitignore @@ -0,0 +1 @@ + From 5c81cf1dee561b02325947a9911adcf74b30e71a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 18:17:01 +0100 Subject: [PATCH 31/65] Added qmckl_string_of_error --- src/qmckl_error.org | 137 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 117 insertions(+), 20 deletions(-) diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 7373f9f..08284d5 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -47,34 +47,36 @@ typedef int32_t qmckl_exit_code; Here is the complete list of exit codes. #+NAME: table-exit-codes - | ~QMCKL_SUCCESS~ | 0 | - | ~QMCKL_INVALID_ARG_1~ | 1 | - | ~QMCKL_INVALID_ARG_2~ | 2 | - | ~QMCKL_INVALID_ARG_3~ | 3 | - | ~QMCKL_INVALID_ARG_4~ | 4 | - | ~QMCKL_INVALID_ARG_5~ | 5 | - | ~QMCKL_INVALID_ARG_6~ | 6 | - | ~QMCKL_INVALID_ARG_7~ | 7 | - | ~QMCKL_INVALID_ARG_8~ | 8 | - | ~QMCKL_INVALID_ARG_9~ | 9 | - | ~QMCKL_INVALID_ARG_10~ | 10 | - | ~QMCKL_FAILURE~ | 101 | - | ~QMCKL_ERRNO~ | 102 | - | ~QMCKL_INVALID_CONTEXT~ | 103 | - | ~QMCKL_ALLOCATION_FAILED~ | 104 | - | ~QMCKL_DEALLOCATION_FAILED~ | 105 | - | ~QMCKL_INVALID_EXIT_CODE~ | 106 | + | Macro | Code | Description | + |-----------------------------+------+------------------------| + | ~QMCKL_SUCCESS~ | 0 | 'Success' | + | ~QMCKL_INVALID_ARG_1~ | 1 | 'Invalid argument 1' | + | ~QMCKL_INVALID_ARG_2~ | 2 | 'Invalid argument 2' | + | ~QMCKL_INVALID_ARG_3~ | 3 | 'Invalid argument 3' | + | ~QMCKL_INVALID_ARG_4~ | 4 | 'Invalid argument 4' | + | ~QMCKL_INVALID_ARG_5~ | 5 | 'Invalid argument 5' | + | ~QMCKL_INVALID_ARG_6~ | 6 | 'Invalid argument 6' | + | ~QMCKL_INVALID_ARG_7~ | 7 | 'Invalid argument 7' | + | ~QMCKL_INVALID_ARG_8~ | 8 | 'Invalid argument 8' | + | ~QMCKL_INVALID_ARG_9~ | 9 | 'Invalid argument 9' | + | ~QMCKL_INVALID_ARG_10~ | 10 | 'Invalid argument 10' | + | ~QMCKL_FAILURE~ | 101 | 'Failure' | + | ~QMCKL_ERRNO~ | 102 | strerror(errno) | + | ~QMCKL_INVALID_CONTEXT~ | 103 | 'Invalid context' | + | ~QMCKL_ALLOCATION_FAILED~ | 104 | 'Allocation failed' | + | ~QMCKL_DEALLOCATION_FAILED~ | 105 | 'De-allocation failed' | + | ~QMCKL_INVALID_EXIT_CODE~ | 106 | 'Invalid exit code' | # We need to force Emacs not to indent the Python code: # -*- org-src-preserve-indentation: t - + #+begin_src python :var table=table-exit-codes :results drawer :exports none """ This script generates the C and Fortran constants for the error codes from the org-mode table. """ result = [ "#+begin_src c :comments org :tangle (eval h) :exports none" ] -for (text, code) in table: +for (text, code,_) in table: text=text.replace("~","") result += [ f"#define {text:30s} {code:d}" ] result += [ "#+end_src" ] @@ -82,7 +84,7 @@ result += [ "#+end_src" ] result += [ "" ] result += [ "#+begin_src f90 :comments org :tangle (eval fh) :exports none" ] -for (text, code) in table: +for (text, code,_) in table: text=text.replace("~","") result += [ f" integer, parameter :: {text:30s} = {code:d}" ] result += [ "#+end_src" ] @@ -134,6 +136,101 @@ return '\n'.join(result) #+end_src :end: + The ~qmckl_strerror~ converts an exit code into a string. The + string is assumed to be large enough to contain the error message + (typically 128 characters). + + #+begin_src c :comments org :tangle (eval h) :exports none +#define QMCKL_ERROR_MAX_STRING_LENGTH 128 + +void qmckl_string_of_error(qmckl_exit_code error, char string[QMCKL_ERROR_MAX_STRING_LENGTH]); + #+end_src + + The text strings are extracted from the previous table. + + #+NAME:cases + #+begin_src python :var table=table-exit-codes :exports none +""" This script extracts the text associated with the error codes + from the table. +""" + +result = [] +for (text, code, message) in table: + text = text.replace("~","") + message = message.replace("'",'"') + result += [ f"""case {text}: + message = {message}; + break;""" ] +return '\n'.join(result) + + #+end_src + + #+RESULTS: cases + #+begin_example + case QMCKL_SUCCESS: + message = "Success"; + break; + case QMCKL_INVALID_ARG_1: + message = "Invalid argument 1"; + break; + case QMCKL_INVALID_ARG_2: + message = "Invalid argument 2"; + break; + case QMCKL_INVALID_ARG_3: + message = "Invalid argument 3"; + break; + case QMCKL_INVALID_ARG_4: + message = "Invalid argument 4"; + break; + case QMCKL_INVALID_ARG_5: + message = "Invalid argument 5"; + break; + case QMCKL_INVALID_ARG_6: + message = "Invalid argument 6"; + break; + case QMCKL_INVALID_ARG_7: + message = "Invalid argument 7"; + break; + case QMCKL_INVALID_ARG_8: + message = "Invalid argument 8"; + break; + case QMCKL_INVALID_ARG_9: + message = "Invalid argument 9"; + break; + case QMCKL_INVALID_ARG_10: + message = "Invalid argument 10"; + break; + case QMCKL_FAILURE: + message = "Failure"; + break; + case QMCKL_ERRNO: + message = strerror(errno); + break; + case QMCKL_INVALID_CONTEXT: + message = "Invalid context"; + break; + case QMCKL_ALLOCATION_FAILED: + message = "Allocation failed"; + break; + case QMCKL_DEALLOCATION_FAILED: + message = "De-allocation failed"; + break; + case QMCKL_INVALID_EXIT_CODE: + message = "Invalid exit code"; + break; + #+end_example + + + #+begin_src c :comments org :tangle (eval c) :noweb yes +void qmckl_string_of_error(qmckl_exit_code error, char string[QMCKL_ERROR_MAX_STRING_LENGTH]) { + char* message; + switch (error) { + <> + } + strncpy(string,message,QMCKL_ERROR_MAX_STRING_LENGTH); +} + #+end_src + * End of files :noexport: ** Test From ce480af7752bc2eba8099a34efc66bb4b0f7a6d9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 18:26:29 +0100 Subject: [PATCH 32/65] Added Fortran interface for qmckl_string_of_error --- src/qmckl_error.org | 81 +++++++++++---------------------------------- 1 file changed, 19 insertions(+), 62 deletions(-) diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 08284d5..87451e3 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -32,7 +32,7 @@ MunitResult test_<>() { perform any input/output operations. This decision has to be taken by the developer of the code calling the library. - All the functions return with an <<>>, defined as + All the functions return with an exit code, defined as #+NAME: type-exit-code #+begin_src c :comments org :tangle (eval h) typedef int32_t qmckl_exit_code; @@ -140,10 +140,11 @@ return '\n'.join(result) string is assumed to be large enough to contain the error message (typically 128 characters). - #+begin_src c :comments org :tangle (eval h) :exports none -#define QMCKL_ERROR_MAX_STRING_LENGTH 128 + #+NAME: MAX_STRING_LENGTH + : 128 -void qmckl_string_of_error(qmckl_exit_code error, char string[QMCKL_ERROR_MAX_STRING_LENGTH]); + #+begin_src c :comments org :tangle (eval h) :exports none :noweb yes +void qmckl_string_of_error(qmckl_exit_code error, char string[<>]); #+end_src The text strings are extracted from the previous table. @@ -165,72 +166,28 @@ return '\n'.join(result) #+end_src - #+RESULTS: cases - #+begin_example - case QMCKL_SUCCESS: - message = "Success"; - break; - case QMCKL_INVALID_ARG_1: - message = "Invalid argument 1"; - break; - case QMCKL_INVALID_ARG_2: - message = "Invalid argument 2"; - break; - case QMCKL_INVALID_ARG_3: - message = "Invalid argument 3"; - break; - case QMCKL_INVALID_ARG_4: - message = "Invalid argument 4"; - break; - case QMCKL_INVALID_ARG_5: - message = "Invalid argument 5"; - break; - case QMCKL_INVALID_ARG_6: - message = "Invalid argument 6"; - break; - case QMCKL_INVALID_ARG_7: - message = "Invalid argument 7"; - break; - case QMCKL_INVALID_ARG_8: - message = "Invalid argument 8"; - break; - case QMCKL_INVALID_ARG_9: - message = "Invalid argument 9"; - break; - case QMCKL_INVALID_ARG_10: - message = "Invalid argument 10"; - break; - case QMCKL_FAILURE: - message = "Failure"; - break; - case QMCKL_ERRNO: - message = strerror(errno); - break; - case QMCKL_INVALID_CONTEXT: - message = "Invalid context"; - break; - case QMCKL_ALLOCATION_FAILED: - message = "Allocation failed"; - break; - case QMCKL_DEALLOCATION_FAILED: - message = "De-allocation failed"; - break; - case QMCKL_INVALID_EXIT_CODE: - message = "Invalid exit code"; - break; - #+end_example - - + # Source #+begin_src c :comments org :tangle (eval c) :noweb yes -void qmckl_string_of_error(qmckl_exit_code error, char string[QMCKL_ERROR_MAX_STRING_LENGTH]) { +void qmckl_string_of_error(qmckl_exit_code error, char string[<>]) { char* message; switch (error) { <> } - strncpy(string,message,QMCKL_ERROR_MAX_STRING_LENGTH); + strncpy(string,message,<>); } #+end_src + # Fortran interface + #+begin_src f90 :tangle (eval fh) :noexport :noweb yes + interface + type (c_ptr) function qmckl_string_of_error (error, string) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int32_t), intent(in), value :: error + character*(<>), intent(out) :: string + end function qmckl_string_of_error + end interface + #+end_src + * End of files :noexport: ** Test From 135c27c2ef671accc2759c0976b4ad0913960028 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 19:02:43 +0100 Subject: [PATCH 33/65] Fixed fortran interface --- src/qmckl_error.org | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 87451e3..35d9ee6 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -23,6 +23,7 @@ MunitResult test_<>() { #include #include #+end_src + * :PROPERTIES: :UNNUMBERED: t @@ -183,7 +184,7 @@ void qmckl_string_of_error(qmckl_exit_code error, char string[<>), intent(out) :: string + character*(<>), intent(out) :: string end function qmckl_string_of_error end interface #+end_src From 170fc770f55fe6a9e56b694889dfa936e11bd8cb Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 19:05:02 +0100 Subject: [PATCH 34/65] Fixed fortran interface --- src/qmckl_error.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 35d9ee6..595814f 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -184,7 +184,7 @@ void qmckl_string_of_error(qmckl_exit_code error, char string[<>), intent(out) :: string + character*(<>), intent(out) :: string end function qmckl_string_of_error end interface #+end_src From 885f7b000e3a8c034ef5cba1a7913992aee9308a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 19:11:06 +0100 Subject: [PATCH 35/65] Fixed Fortran interface --- src/qmckl_error.org | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 595814f..403e22f 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -181,11 +181,11 @@ void qmckl_string_of_error(qmckl_exit_code error, char string[<>), intent(out) :: string - end function qmckl_string_of_error + integer (c_int32_t), intent(in), value :: error + character, intent(out) :: string(<>) + end subroutine qmckl_string_of_error end interface #+end_src From b1f1843e01814447b2335343e5f14b52d9f028f8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 19 Mar 2021 23:16:30 +0100 Subject: [PATCH 36/65] Fixed bug in polynomials --- src/qmckl_ao.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 40e2823..6659eef 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -320,7 +320,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, return endif - if (lmax <= 0) then + if (lmax < 0) then info = QMCKL_INVALID_ARG_4 return endif From be44127dba5288df3c4c5e4ae07b043a71a0c5a2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 20 Mar 2021 16:56:22 +0100 Subject: [PATCH 37/65] Included auto-generation of Fortran in distances --- src/Makefile | 8 +- src/qmckl_context.org | 98 ++++++++---------- src/qmckl_distance.org | 183 +++++++++++++++++++------------- src/qmckl_memory.org | 5 +- tools/Building.org | 6 +- tools/lib.org | 230 +++++++++++++++++++++++++++++++++++++++++ 6 files changed, 399 insertions(+), 131 deletions(-) create mode 100644 tools/lib.org diff --git a/src/Makefile b/src/Makefile index 8b52a4b..d504ec9 100644 --- a/src/Makefile +++ b/src/Makefile @@ -87,17 +87,17 @@ endif .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files -libqmckl.so: Makefile.generated +libqmckl.so: ../include/qmckl.h $(MAKE) -f Makefile.generated -../include/qmckl.h: libqmckl.so +../include/qmckl.h: Makefile.generated ../tools/build_qmckl_h.sh -test: Makefile.generated ../include/qmckl.h +test: libqmckl.so $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) - $(QMCKL_ROOT)/tools/build_doc.sh + $(QMCKL_ROOT)/tools/create_doc.sh clean: $(RM) test_qmckl_* test_qmckl.c test_qmckl \ diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 01c0945..6aec0c7 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -195,20 +195,6 @@ qmckl_context qmckl_context_create() { const qmckl_context context = (qmckl_context) ctx; assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); - /* - qmckl_memory_struct* alloc = (qmckl_memory_struct*) - malloc(sizeof(qmckl_memory_struct)); - - if (alloc == NULL) { - qmckl_unlock(context); - return QMCKL_NULL_CONTEXT; - } - - memset(alloc,0,sizeof(qmckl_memory_struct)); - - ctx->alloc = alloc; - */ - return context; } #+end_src @@ -880,48 +866,48 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; -if (precision < 2) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_context_update_precision", - "precision < 2"); - } - -if (precision > 53) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_context_update_precision", - "precision > 53"); - } - -qmckl_context_struct* ctx = (qmckl_context_struct*) context; - -/* This should be always true */ -assert (ctx != NULL); - -qmckl_lock(context); - -if (ctx->fp == NULL) { - - ctx->fp = (qmckl_precision_struct*) - qmckl_malloc(context, sizeof(qmckl_precision_struct)); - - if (ctx->fp == NULL) { + if (precision < 2) { return qmckl_failwith(context, - QMCKL_ALLOCATION_FAILED, - "qmckl_context_update_precision", - "ctx->fp"); + QMCKL_INVALID_ARG_2, + "qmckl_context_update_precision", + "precision < 2"); } - ctx->fp->precision = QMCKL_DEFAULT_PRECISION; - ctx->fp->range = QMCKL_DEFAULT_RANGE; - } + if (precision > 53) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_context_update_precision", + "precision > 53"); + } -ctx->fp->precision = precision; + qmckl_context_struct* ctx = (qmckl_context_struct*) context; -qmckl_unlock(context); + /* This should be always true */ + assert (ctx != NULL); -return QMCKL_SUCCESS; + qmckl_lock(context); + + if (ctx->fp == NULL) { + + ctx->fp = (qmckl_precision_struct*) + qmckl_malloc(context, sizeof(qmckl_precision_struct)); + + if (ctx->fp == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "qmckl_context_update_precision", + "ctx->fp"); + } + + ctx->fp->precision = QMCKL_DEFAULT_PRECISION; + ctx->fp->range = QMCKL_DEFAULT_RANGE; + } + + ctx->fp->precision = precision; + + qmckl_unlock(context); + + return QMCKL_SUCCESS; } #+end_src @@ -1296,6 +1282,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type /* Memory allocations */ + assert (basis->shell_center == NULL); basis->shell_center = (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_center == NULL) { qmckl_free(context, basis); @@ -1303,6 +1290,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } + assert (basis->shell_ang_mom == NULL); basis->shell_ang_mom = (int32_t*) qmckl_malloc (context, shell_num * sizeof(int32_t)); if (basis->shell_ang_mom == NULL) { qmckl_free(context, basis->shell_center); @@ -1312,6 +1300,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } + assert (basis->shell_prim_num == NULL); basis->shell_prim_num= (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_prim_num == NULL) { qmckl_free(context, basis->shell_ang_mom); @@ -1323,7 +1312,8 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double )); + assert (basis->shell_factor == NULL); + basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double)); if (basis->shell_factor == NULL) { qmckl_free(context, basis->shell_prim_num); basis->shell_prim_num = NULL; @@ -1336,7 +1326,8 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double )); + assert (basis->exponent == NULL); + basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double)); if (basis->exponent == NULL) { qmckl_free(context, basis->shell_factor); basis->shell_factor = NULL; @@ -1351,7 +1342,8 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double )); + assert (basis->coefficient == NULL); + basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double)); if (basis->coefficient == NULL) { qmckl_free(context, basis->exponent); basis->exponent = NULL; diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index b239621..b7e264b 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -1,4 +1,4 @@ -#+TITLE: Distances +#+TITLE: Inter-particle distances #+SETUPFILE: ../docs/theme.setup Functions for the computation of distances between particles. @@ -10,6 +10,11 @@ Functions for the computation of distances between particles. (file-name-nondirectory (substring buffer-file-name 0 -4)) #+end_src + #+begin_src elisp :noexport :results none +(org-babel-lob-ingest "../tools/lib.org") + #+end_src + + #+begin_src c :comments link :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" @@ -21,51 +26,65 @@ MunitResult test_<>() { * Squared distance - ~qmckl_distance_sq~ computes the matrix of the squared distances +** ~qmckl_distance_sq~ + :PROPERTIES: + :Name: qmckl_distance_sq + :CRetType: qmckl_exit_code + :FRetType: integer + :END: + + ~qmckl_distance_sq~ computes the matrix of the squared distances between all pairs of points in two sets, one point within each set: \[ C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 \] - | ~context~ | input | Global state | - | ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed | - | ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed | - | ~m~ | input | Number of points in the first set | - | ~n~ | input | Number of points in the second set | - | ~A(lda,3)~ | input | Array containing the $m \times 3$ matrix $A$ | - | ~lda~ | input | Leading dimension of array ~A~ | - | ~B(ldb,3)~ | input | Array containing the $n \times 3$ matrix $B$ | - | ~ldb~ | input | Leading dimension of array ~B~ | - | ~C(ldc,n)~ | output | Array containing the $m \times n$ matrix $C$ | - | ~ldc~ | input | Leading dimension of array ~C~ | + #+NAME: qmckl_distance_sq_args + | qmckl_context | context | in | Global state | + | char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed | + | char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed | + | int64_t | m | in | Number of points in the first set | + | int64_t | n | in | Number of points in the second set | + | double | A[3][lda] | in | Array containing the $m \times 3$ matrix $A$ | + | int64_t | lda | in | Leading dimension of array ~A~ | + | double | B[3][ldb] | in | Array containing the $n \times 3$ matrix $B$ | + | int64_t | ldb | in | Leading dimension of array ~B~ | + | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | + | int64_t | ldc | in | Leading dimension of array ~C~ | *** Requirements - - ~context~ is not 0 - - ~m~ > 0 - - ~n~ > 0 - - ~lda~ >= 3 if ~transa~ is ~N~ - - ~lda~ >= m if ~transa~ is ~T~ - - ~ldb~ >= 3 if ~transb~ is ~N~ - - ~ldb~ >= n if ~transb~ is ~T~ - - ~ldc~ >= m + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~m > 0~ + - ~n > 0~ + - ~lda >= 3~ if ~transa == 'N'~ + - ~lda >= m~ if ~transa == 'T'~ + - ~ldb >= 3~ if ~transb == 'N'~ + - ~ldb >= n~ if ~transb == 'T'~ + - ~ldc >= m~ - ~A~ is allocated with at least $3 \times m \times 8$ bytes - ~B~ is allocated with at least $3 \times n \times 8$ bytes - ~C~ is allocated with at least $m \times n \times 8$ bytes + +*** C header -*** Performance + #+CALL: generate_c_header(table=qmckl_distance_sq_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - This function might be more efficient when ~A~ and ~B~ are - transposed. - - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code qmckl_distance_sq(const qmckl_context context, - const char transa, const char transb, - const int64_t m, const int64_t n, - const double *A, const int64_t lda, - const double *B, const int64_t ldb, - const double *C, const int64_t ldc); + #+RESULTS: + #+begin_src c :tangle (eval h) :comments org + qmckl_exit_code qmckl_distance_sq ( + const qmckl_context context, + const char transa, + const char transb, + const int64_t m, + const int64_t n, + const double* A, + const int64_t lda, + const double* B, + const int64_t ldb, + double* C, + const int64_t ldc ); #+end_src *** Source @@ -147,7 +166,7 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L select case (transab) - + case(0) do j=1,n @@ -193,49 +212,73 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L end do end select - + end function qmckl_distance_sq_f #+end_src +*** Performance + + This function might be more efficient when ~A~ and ~B~ are + transposed. + *** C interface :noexport: - #+begin_src f90 :tangle (eval f) -integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & - bind(C) result(info) - use, intrinsic :: iso_c_binding - implicit none - integer (c_int64_t) , intent(in) , value :: context - character (c_char) , intent(in) , value :: transa, transb - integer (c_int64_t) , intent(in) , value :: m, n - integer (c_int64_t) , intent(in) , value :: lda - real (c_double) , intent(in) :: A(lda,3) - integer (c_int64_t) , intent(in) , value :: ldb - real (c_double) , intent(in) :: B(ldb,3) - integer (c_int64_t) , intent(in) , value :: ldc - real (c_double) , intent(out) :: C(ldc,n) - integer, external :: qmckl_distance_sq_f - info = qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) -end function qmckl_distance_sq - #+end_src + #+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - #+begin_src f90 :tangle (eval fh) - interface - integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & - bind(C) + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_distance_sq & + (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & + bind(C) result(info) + + use, intrinsic :: iso_c_binding + implicit none + + integer (c_int64_t) , intent(in) :: context + character , intent(in) :: transa + character , intent(in) :: transb + integer (c_int64_t) , intent(in) :: m + integer (c_int64_t) , intent(in) :: n + real (c_double ) , intent(in) :: A(lda,3) + integer (c_int64_t) , intent(in) :: lda + real (c_double ) , intent(in) :: B(ldb,3) + integer (c_int64_t) , intent(in) :: ldb + real (c_double ) , intent(out) :: C(ldc,n) + integer (c_int64_t) , intent(in) :: ldc + + integer(c_int32_t), external :: qmckl_distance_sq_f + info = qmckl_distance_sq_f & + (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) + + end function qmckl_distance_sq + #+end_src + + #+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src f90 :tangle (eval fh) :comments org :exports none + interface + integer(c_int32_t) function qmckl_distance_sq & + (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & + bind(C) use, intrinsic :: iso_c_binding implicit none - integer (c_int64_t) , intent(in) , value :: context - character (c_char) , intent(in) , value :: transa, transb - integer (c_int64_t) , intent(in) , value :: m, n - integer (c_int64_t) , intent(in) , value :: lda - integer (c_int64_t) , intent(in) , value :: ldb - integer (c_int64_t) , intent(in) , value :: ldc - real (c_double) , intent(in) :: A(lda,3) - real (c_double) , intent(in) :: B(ldb,3) - real (c_double) , intent(out) :: C(ldc,n) + + integer (c_int64_t) , intent(in) :: context + character , intent(in) :: transa + character , intent(in) :: transb + integer (c_int64_t) , intent(in) :: m + integer (c_int64_t) , intent(in) :: n + real (c_double ) , intent(in) :: A(lda,3) + integer (c_int64_t) , intent(in) :: lda + real (c_double ) , intent(in) :: B(ldb,3) + integer (c_int64_t) , intent(in) :: ldb + real (c_double ) , intent(out) :: C(ldc,n) + integer (c_int64_t) , intent(in) :: ldc + end function qmckl_distance_sq - end interface - #+end_src + end interface + #+end_src *** Test :noexport: #+begin_src f90 :tangle (eval f_test) @@ -293,7 +336,7 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return end do end do - + test_qmckl_distance_sq = & qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC) @@ -341,9 +384,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return end do end do - + test_qmckl_distance_sq = 0 - + deallocate(A,B,C) end function test_qmckl_distance_sq #+end_src diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 6d17694..3f3a4e3 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -49,11 +49,14 @@ void* qmckl_malloc(qmckl_context context, const size_t size); #+end_src + In this implementation, we use ~calloc~ because it initializes the + memory block to zero, so structs will have ~NULL~-initialized pointers. + # Source #+begin_src c :tangle (eval c) void* qmckl_malloc(qmckl_context context, const size_t size) { - void * pointer = malloc( (size_t) size ); + void * pointer = calloc(size, (size_t) 1); if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { qmckl_exit_code rc; diff --git a/tools/Building.org b/tools/Building.org index 200ef08..62514e6 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -159,13 +159,13 @@ endif .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files -libqmckl.so: Makefile.generated +libqmckl.so: ../include/qmckl.h $(MAKE) -f Makefile.generated -../include/qmckl.h: libqmckl.so +../include/qmckl.h: Makefile.generated ../tools/build_qmckl_h.sh -test: Makefile.generated ../include/qmckl.h +test: libqmckl.so $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) diff --git a/tools/lib.org b/tools/lib.org new file mode 100644 index 0000000..c59eaae --- /dev/null +++ b/tools/lib.org @@ -0,0 +1,230 @@ +# -*- mode: org -*- + +* Function to get the value of a property. +#+NAME: get_value +#+begin_src elisp :var key="Type" +(setq x (org-property-values key)) +(pop x) +#+end_src + +#+RESULTS: get_value + +* Table of function arguments + + #+NAME: test + | qmckl_context | context | in | Global state | + | char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed | + | char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed | + | int64_t | m | in | Number of points in the first set | + | int64_t | n | in | Number of points in the second set | + | double | A[3][lda] | in | Array containing the $m \times 3$ matrix $A$ | + | int64_t | lda | in | Leading dimension of array ~A~ | + | double | B[3][ldb] | in | Array containing the $n \times 3$ matrix $B$ | + | int64_t | ldb | in | Leading dimension of array ~B~ | + | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | + | int64_t | ldc | in | Leading dimension of array ~C~ | + + +** Fortran-C type conversions + + #+NAME:f_of_c + #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" +f_of_c_d = { '' : '' + , 'qmckl_context' : 'integer (c_int64_t)' + , 'int32_t' : 'integer (c_int32_t)' + , 'int64_t' : 'integer (c_int64_t)' + , 'float' : 'real (c_float )' + , 'double' : 'real (c_double )' + , 'char' : 'character' + } + #+END_SRC + + #+NAME:c_of_f + #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" +ctypeid_d = { '' : '' + , 'integer' : 'integer(c_int32_t)' + , 'integer*8' : 'integer(c_int64_t)' + , 'real' : 'real(c_float)' + , 'real*8' : 'real(c_double)' + , 'character' : 'character(c_char)' + } + #+END_SRC + +** Parse the table + + #+NAME: parse_table + #+BEGIN_SRC python :results none :noweb yes :exports none +def parse_table(table): + result = [] + + for line in table: + d = { "c_type" : line[0], + "inout" : line[2].lower(), + "name" : line[1], + "comment" : line[3] } + + # Handle inout + if d["inout"] in ["input", "in"]: + d["inout"] == "in" + elif d["inout"] in ["output", "out"]: + d["inout"] == "out" + elif d["inout"] in ["input/output", "inout"]: + d["inout"] == "inout" + + # Find dimensions + dims = d["name"].split('[') + d["rank"] = len(dims) - 1 + if d["rank"] == 0: + d["dims"] = [] + else: + d["name"] = d["name"].split('[')[0].strip() + d["dims"] = [ x.replace(']','').strip() for x in dims[1:] ] + + result.append(d) + + return result + #+END_SRC + +** Generates a C header + + #+NAME: generate_c_header + #+BEGIN_SRC python :var table=[] :var rettyp=[] :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h) :comments org" +<> + +results = [] +for d in parse_table(table): + name = d["name"] + c_type = d["c_type"] + + # Add star for arrays + if d["rank"] > 0: + c_type += "*" + + # Only inputs are const + if d["inout"] == "in": + const = "const" + else: + const = " " + + results += [ f" {const} {c_type} {name}" ] + +results=',\n'.join(results) +template = f"""{rettyp} {fname} ( +{results} ); """ +return template + + #+END_SRC + + #+RESULTS: generate_c_header + #+begin_src c :tangle (eval h) :comments org + [] [] ( + ); + #+end_src + +** Generates a C interface to the Fortran function + + #+NAME: generate_c_interface + #+BEGIN_SRC python :var table=[] :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" +<> +<> +<> +d = parse_table(table) + +args = ", ".join([ x["name"] for x in d ]) + +rettyp_c = ctypeid_d[rettyp.lower()] + +results = [ f"{rettyp_c} function {fname} &" +, f" ({args}) &" +, " bind(C) result(info)" +, "" +, " use, intrinsic :: iso_c_binding" +, " implicit none" +, "" +] + +for d in parse_table(table): + f_type = f_of_c_d[d["c_type"]] + inout = "intent("+d["inout"]+")" + name = d["name"] + + # Input scalars are passed by value + if d["rank"] == 0 and inout == "in": + value = ", value" + else: + value = " " + + # Append dimensions to the name + if d["rank"] == 0: + dims = "" + else: + d["dims"].reverse() + dims = "(" + ",".join(d["dims"]) + ")" + + results += [ f" {f_type:20}, {inout:12}{value} :: {name}{dims}" ] + +results += [ "" +, f" {rettyp_c}, external :: {fname}_f" +, f" info = {fname}_f &" +, f" ({args})" +, "" +, f"end function {fname}" +] +results='\n'.join(results) +return results + #+END_SRC + + +** Generates a Fortran interface to the C function + + #+NAME: generate_f_interface + #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh) :comments org :exports none" +<> +<> +<> +d = parse_table(table) + +args = ", ".join([ x["name"] for x in d ]) + +rettyp_c = ctypeid_d[rettyp.lower()] + +results = [ f"interface" +, f" {rettyp_c} function {fname} &" +, f" ({args}) &" +, " bind(C)" +, " use, intrinsic :: iso_c_binding" +, " implicit none" +, "" +] + +for d in parse_table(table): + f_type = f_of_c_d[d["c_type"]] + inout = "intent("+d["inout"]+")" + name = d["name"] + + # Input scalars are passed by value + if d["rank"] == 0 and inout == "in": + value = ", value" + else: + value = " " + + # Append dimensions to the name + if d["rank"] == 0: + dims = "" + else: + d["dims"].reverse() + dims = "(" + ",".join(d["dims"]) + ")" + + results += [ f" {f_type:20}, {inout:12}{value} :: {name}{dims}" ] + +results += [ "" +, f" end function {fname}" +, f"end interface" +] +results='\n'.join(results) +return results + #+END_SRC + + #+RESULTS: generate_c_interface + #+begin_src f90 :tangle (eval f) :comments org :exports none + #+end_src From 27b9fdab229fb29bc16f8262bf32cce66b6f63bd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 20 Mar 2021 16:58:48 +0100 Subject: [PATCH 38/65] Fixed Makefile --- src/Makefile | 2 +- tools/Building.org | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Makefile b/src/Makefile index d504ec9..77e48c6 100644 --- a/src/Makefile +++ b/src/Makefile @@ -97,7 +97,7 @@ test: libqmckl.so $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) - $(QMCKL_ROOT)/tools/create_doc.sh + $(QMCKL_ROOT)/tools/build_doc.sh clean: $(RM) test_qmckl_* test_qmckl.c test_qmckl \ diff --git a/tools/Building.org b/tools/Building.org index 62514e6..6f1794a 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -169,7 +169,7 @@ test: libqmckl.so $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) - $(QMCKL_ROOT)/tools/create_doc.sh + $(QMCKL_ROOT)/tools/build_doc.sh clean: $(RM) test_qmckl_* test_qmckl.c test_qmckl \ From 271c4cfe84f529976f0b2395d3da660f816386c8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 23 Mar 2021 22:23:49 +0100 Subject: [PATCH 39/65] Nicer bash script --- tools/Building.org | 130 ++++++++++++++++++++++++++++++++- tools/build_doc.sh | 161 ++++++++++++++++++++++++++++++----------- tools/config_tangle.el | 1 + 3 files changed, 248 insertions(+), 44 deletions(-) diff --git a/tools/Building.org b/tools/Building.org index 6f1794a..32ccf3f 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -411,4 +411,132 @@ EOF #+end_src * Script to build the documentation -* Script to build the documentation + :PROPERTIES: + :header-args:bash: :tangle build_doc.sh :noweb yes :shebang #!/bin/bash :comments org + :END: + + First define readonly global variables. + + #+begin_src bash :noweb yes +readonly DOCS=${QMCKL_ROOT}/docs/ +readonly SRC=${QMCKL_ROOT}/src/ +readonly HTMLIZE=${DOCS}/htmlize.el +readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el +readonly CONFIG_TANGLE=${QMCKL_ROOT}/tools/config_tangle.el + #+end_src + + Check that all the defined global variables correspond to files. + + #+begin_src bash :noweb yes +function check_preconditions() +{ + if [[ -z ${QMCKL_ROOT} ]] + then + print "QMCKL_ROOT is not defined" + exit 1 + fi + + for dir in ${DOCS} ${SRC} + do + if [[ ! -d ${dir} ]] + then + print "${dir} not found" + exit 2 + fi + done + + for file in ${CONFIG_DOC} ${CONFIG_TANGLE} + do + if [[ ! -f ${file} ]] + then + print "${file} not found" + exit 3 + fi + done +} + #+end_src + + ~install_htmlize~ installs the htmlize Emacs plugin if the + =htmlize.el= file is not present. + + #+begin_src bash :noweb yes +function install_htmlize() +{ + local url="https://github.com/hniksic/emacs-htmlize" + local repo="emacs-htmlize" + + [[ -f ${HTMLIZE} ]] || ( + cd ${DOCS} + git clone ${url} \ + && cp ${repo}/htmlize.el ${HTMLIZE} \ + && rm -rf ${repo} + cd - + ) + + # Assert htmlize is installed + [[ -f ${HTMLIZE} ]] \ + || exit 1 +} + #+end_src + + Extract documentation from an org-mode file. + + #+begin_src bash :noweb yes +function extract_doc() +{ + local org=$1 + local local_html=${SRC}/${org%.org}.html + local html=${DOCS}/${org%.org}.html + + if [[ -f ${html} && ${org} -ot ${html} ]] + then + return + fi + emacs --batch \ + --load ${HTMLIZE} \ + --load ${CONFIG_DOC} \ + ${org} \ + --load ${CONFIG_TANGLE} \ + -f org-html-export-to-html + mv ${local_html} ${DOCS} + +} + #+end_src + + The main function of the script. + + #+begin_src bash :noweb yes +function main() { + + [[ check_preconditions ]] \ + || exit 1 + + # Install htmlize if needed + [[ install_htmlize ]] \ + || exit 2 + + # Create documentation + cd ${SRC} \ + || exit 3 + + for i in *.org + do + echo + echo "======= ${i} =======" + extract_doc ${i} + done + + if [[ $? -eq 0 ]] + then + cd ${DOCS} + rm -f index.html + ln README.html index.html + exit 0 + else + exit 3 + fi +} +main + #+end_src + + diff --git a/tools/build_doc.sh b/tools/build_doc.sh index 11b06ac..6eede96 100755 --- a/tools/build_doc.sh +++ b/tools/build_doc.sh @@ -1,57 +1,132 @@ -#!/bin/bash +#!/bin/bash +# Script to build the documentation +# :PROPERTIES: +# :header-args:bash: :tangle build_doc.sh :noweb yes :shebang #!/bin/bash :comments org +# :END: -if [[ -z $QMCKL_ROOT ]] -then - print "QMCKL_ROOT is not defined" - exit 1 -fi +# First define readonly global variables. + + +readonly DOCS=${QMCKL_ROOT}/docs/ +readonly SRC=${QMCKL_ROOT}/src/ +readonly HTMLIZE=${DOCS}/htmlize.el +readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el +readonly CONFIG_TANGLE=${QMCKL_ROOT}/tools/config_tangle.el -# Install htmlize if needed -[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || ( - cd ${QMCKL_ROOT}/docs/ - git clone https://github.com/hniksic/emacs-htmlize - cp emacs-htmlize/htmlize.el . - rm -rf emacs-htmlize - cd - -) -[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || exit 1 +# Check that all the defined global variables correspond to files. -# Create documentation -cd ${QMCKL_ROOT}/src +function check_preconditions() +{ + if [[ -z ${QMCKL_ROOT} ]] + then + print "QMCKL_ROOT is not defined" + exit 1 + fi + + for dir in ${DOCS} ${SRC} + do + if [[ ! -d ${dir} ]] + then + print "${dir} not found" + exit 2 + fi + done + + for file in ${CONFIG_DOC} ${CONFIG_TANGLE} + do + if [[ ! -f ${file} ]] + then + print "${file} not found" + exit 3 + fi + done +} + + + +# ~install_htmlize~ installs the htmlize Emacs plugin if the +# =htmlize.el= file is not present. + + +function install_htmlize() +{ + local url="https://github.com/hniksic/emacs-htmlize" + local repo="emacs-htmlize" + + [[ -f ${HTMLIZE} ]] || ( + cd ${DOCS} + git clone ${url} \ + && cp ${repo}/htmlize.el ${HTMLIZE} \ + && rm -rf ${repo} + cd - + ) + + # Assert htmlize is installed + [[ -f ${HTMLIZE} ]] \ + || exit 1 +} + + + +# Extract documentation from an org-mode file. + function extract_doc() { - HTML=${1%.org}.html - if [[ -f ${QMCKL_ROOT}/docs/$HTML && $1 -ot ${QMCKL_ROOT}/docs/$HTML ]] - then return + local org=$1 + local local_html=${SRC}/${org%.org}.html + local html=${DOCS}/${org%.org}.html + + if [[ -f ${html} && ${org} -ot ${html} ]] + then + return fi - emacs --batch \ - --load ${QMCKL_ROOT}/docs/htmlize.el \ - --load ${QMCKL_ROOT}/tools/config_doc.el \ - $i \ - --load ${QMCKL_ROOT}/tools/config_tangle.el \ - -f org-html-export-to-html || break - mv $HTML ${QMCKL_ROOT}/docs + emacs --batch \ + --load ${HTMLIZE} \ + --load ${CONFIG_DOC} \ + ${org} \ + --load ${CONFIG_TANGLE} \ + -f org-html-export-to-html + mv ${local_html} ${DOCS} + } -for i in *.org -do -echo -echo "======= $i =======" - extract_doc $i -done - -if [[ $? -eq 0 ]] -then - cd ${QMCKL_ROOT}/docs - rm -f index.html - ln README.html index.html - exit 0 -else - exit 2 -fi +# The main function of the script. + + +function main() { + + [[ check_preconditions ]] \ + || exit 1 + + # Install htmlize if needed + [[ install_htmlize ]] \ + || exit 2 + + # Create documentation + cd ${SRC} \ + || exit 3 + + for i in *.org + do + echo + echo "======= ${i} =======" + extract_doc ${i} + done + + if [[ $? -eq 0 ]] + then + cd ${DOCS} + rm -f index.html + ln README.html index.html + exit 0 + else + exit 3 + fi +} +main diff --git a/tools/config_tangle.el b/tools/config_tangle.el index 73b613d..6f1eed1 100755 --- a/tools/config_tangle.el +++ b/tools/config_tangle.el @@ -42,4 +42,5 @@ (setq h_private (concat name "_private.h")) (setq c_test (concat pwd "test_" name ".c")) (setq f_test (concat pwd "test_" name "_f.f90")) +(org-babel-lob-ingest "../tools/lib.org") From a295cfe22e821f25601c4e200d4d26c767c996ee Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 29 Mar 2021 01:17:33 +0200 Subject: [PATCH 40/65] Compliant with CERT standard --- src/qmckl_ao.org | 4 ++-- src/qmckl_context.org | 17 ++++------------- src/qmckl_error.org | 6 ++---- src/test_qmckl.org | 17 +++++++++-------- 4 files changed, 17 insertions(+), 27 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 6659eef..e26b2d1 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -10,7 +10,7 @@ Gaussian ($p=2$): \[ R_s(\mathbf{r}) = \mathcal{N}_s |\mathbf{r}-\mathbf{R}_A|^{n_s} \sum_{k=1}^{N_{\text{prim}}} a_{ks} - \exp \left( - \gamma_{ks} | \mathbf{r}-\mathbf{R}_A | ^p \right). | + \exp \left( - \gamma_{ks} | \mathbf{r}-\mathbf{R}_A | ^p \right). \] In the case of Gaussian functions, $n_s$ is always zero. @@ -570,7 +570,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); | ~context~ | input | Global state | | ~X(3)~ | input | Array containing the coordinates of the points | | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~n~ | input | Number of computed gaussians | + | ~n~ | input | Number of computed Gaussians | | ~A(n)~ | input | Exponents of the Gaussians | | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | | ~ldv~ | input | Leading dimension of array ~VGL~ | diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 6aec0c7..65bfb48 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -427,9 +427,7 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) { qmckl_exit_code rc; rc = qmckl_context_remove_memory(context,ctx); -/* assert (rc == QMCKL_SUCCESS); - */ ctx->tag = INVALID_TAG; @@ -442,9 +440,6 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) { rc = qmckl_free(context,ctx); assert (rc == QMCKL_SUCCESS); - //memset(ctx, 0, sizeof(qmckl_context_struct)); - - return prev_context; } #+end_src @@ -534,7 +529,7 @@ qmckl_exit_code qmckl_context_append_memory(qmckl_context context, if (alloc == NULL) { ctx->alloc = new_alloc; } else { - while (alloc != NULL) { + while (alloc->next != NULL) { alloc = alloc->next; } alloc->next = new_alloc; @@ -670,8 +665,8 @@ qmckl_context_update_error(qmckl_context context, qmckl_error_struct* error = (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); error->exit_code = exit_code; - strcpy(error->function, function_name); - strcpy(error->message, message); + strncpy(error->function, function_name, QMCKL_MAX_FUN_LEN); + strncpy(error->message, message, QMCKL_MAX_MSG_LEN); ctx->error = error; @@ -797,8 +792,7 @@ if (x < 0) { # -*- org-src-preserve-indentation: t #+begin_src python :var table=table-precision :results drawer :exports result -""" This script generates the C and Fortran constants for the error - codes from the org-mode table. +""" This script generates the C and Fortran constants from the org-mode table. """ result = [ "#+begin_src c :comments org :tangle (eval h)" ] @@ -898,8 +892,6 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons "qmckl_context_update_precision", "ctx->fp"); } - - ctx->fp->precision = QMCKL_DEFAULT_PRECISION; ctx->fp->range = QMCKL_DEFAULT_RANGE; } @@ -1037,7 +1029,6 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in } ctx->fp->precision = QMCKL_DEFAULT_PRECISION; - ctx->fp->range = QMCKL_DEFAULT_RANGE; } ctx->fp->range = range; diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 403e22f..1c9f3de 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -151,7 +151,7 @@ void qmckl_string_of_error(qmckl_exit_code error, char string[<>); break;""" ] return '\n'.join(result) @@ -170,11 +170,9 @@ return '\n'.join(result) # Source #+begin_src c :comments org :tangle (eval c) :noweb yes void qmckl_string_of_error(qmckl_exit_code error, char string[<>]) { - char* message; switch (error) { <> } - strncpy(string,message,<>); } #+end_src diff --git a/src/test_qmckl.org b/src/test_qmckl.org index fe8e3a4..7d4606c 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -54,7 +54,7 @@ echo "#+begin_src c :tangle no" for file in $files do routine=test_${file%.c} - echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," + echo " { (const char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," done echo "#+end_src" #+end_src @@ -63,11 +63,11 @@ echo "#+end_src" :results: #+NAME: calls #+begin_src c :tangle no - { (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (const char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (const char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (const char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (const char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (const char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, #+end_src :end: @@ -91,12 +91,13 @@ int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { static const MunitSuite test_suite = { - (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE + (const char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE }; - int result = munit_suite_main(&test_suite, (void*) "µnit", argc, argv); + int result = munit_suite_main(&test_suite, (const void*) "µnit", argc, argv); muntrace(); return result; } #+end_src + From 293f0a008e663c0cf6d828d252e4ced7afc2ecc6 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 29 Mar 2021 01:22:54 +0200 Subject: [PATCH 41/65] Fixed const in munit --- src/test_qmckl.org | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/test_qmckl.org b/src/test_qmckl.org index 7d4606c..a7125e7 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -54,7 +54,7 @@ echo "#+begin_src c :tangle no" for file in $files do routine=test_${file%.c} - echo " { (const char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," + echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," done echo "#+end_src" #+end_src @@ -63,11 +63,11 @@ echo "#+end_src" :results: #+NAME: calls #+begin_src c :tangle no - { (const char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (const char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (const char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (const char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (const char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, #+end_src :end: @@ -91,11 +91,11 @@ int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { static const MunitSuite test_suite = { - (const char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE + (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE }; - int result = munit_suite_main(&test_suite, (const void*) "µnit", argc, argv); + int result = munit_suite_main(&test_suite, (void*) "µnit", argc, argv); muntrace(); return result; } From 09c8f9700f78c3938a5fc17f9ee2bac4256cc74d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 29 Mar 2021 01:39:12 +0200 Subject: [PATCH 42/65] Fixed const in munit and tests --- src/qmckl_context.org | 6 +----- src/qmckl_error.org | 14 ++++++++++---- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 65bfb48..e195336 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -586,11 +586,7 @@ qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, qmckl_unlock(context); - if (alloc != NULL) { - return QMCKL_SUCCESS; - } else { - return QMCKL_DEALLOCATION_FAILED; - } + return QMCKL_SUCCESS; } #+end_src diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 1c9f3de..4f52854 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -145,7 +145,8 @@ return '\n'.join(result) : 128 #+begin_src c :comments org :tangle (eval h) :exports none :noweb yes -void qmckl_string_of_error(qmckl_exit_code error, char string[<>]); +const char* qmckl_string_of_error(const qmckl_exit_code error); +void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<>]); #+end_src The text strings are extracted from the previous table. @@ -161,7 +162,7 @@ for (text, code, message) in table: text = text.replace("~","") message = message.replace("'",'"') result += [ f"""case {text}: - strncpy(string,{message},<>); + return {message}; break;""" ] return '\n'.join(result) @@ -169,17 +170,22 @@ return '\n'.join(result) # Source #+begin_src c :comments org :tangle (eval c) :noweb yes -void qmckl_string_of_error(qmckl_exit_code error, char string[<>]) { +const char* qmckl_string_of_error(const qmckl_exit_code error) { switch (error) { <> } + return "Unknown error"; +} + +void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<>]) { + strncpy(result, qmckl_string_of_error(error), <>); } #+end_src # Fortran interface #+begin_src f90 :tangle (eval fh) :noexport :noweb yes interface - subroutine qmckl_string_of_error (error, string) bind(C) + subroutine qmckl_string_of_error (error, string) bind(C, name='qmckl_string_of_error_f') use, intrinsic :: iso_c_binding integer (c_int32_t), intent(in), value :: error character, intent(out) :: string(<>) From fac7e9d74f49eb44037951e39ee4385f74b94b2a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 30 Mar 2021 14:51:23 +0200 Subject: [PATCH 43/65] Easier context --- src/qmckl.org | 71 ++- src/qmckl_ao.org | 809 ------------------------ src/qmckl_context.org | 1350 ++++------------------------------------ src/qmckl_distance.org | 20 +- src/qmckl_error.org | 253 ++++++-- src/qmckl_memory.org | 34 +- src/qmckl_numprec.org | 328 ++++++++++ src/table_of_contents | 2 - tools/Building.org | 15 +- tools/build_qmckl_h.sh | 15 +- tools/config_tangle.el | 9 +- tools/lib.org | 51 +- 12 files changed, 794 insertions(+), 2163 deletions(-) delete mode 100644 src/qmckl_ao.org create mode 100644 src/qmckl_numprec.org diff --git a/src/qmckl.org b/src/qmckl.org index 3a568c7..a871b73 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -59,7 +59,6 @@ Both files are located in the =include/= directory. Moreover, within the Emacs text editor the source code blocks can be executed interactively, in the same spirit as Jupyter notebooks. - ** Source code editing For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. @@ -79,7 +78,6 @@ Both files are located in the =include/= directory. Note that pandoc can be used to convert multiple markdown formats into org-mode. - ** Choice of the programming language Most of the codes of the [[https://trex-coe.eu][TREX CoE]] are written in Fortran with some scripts in @@ -111,31 +109,21 @@ Both files are located in the =include/= directory. ~iso_c_binding~ module. The name of the Fortran source files should end with =_f.f90= to be properly handled by the =Makefile=. The names of the functions defined in Fortran should be the same as those exposed in the API suffixed by - =_f=. Fortran interfaces should also be written in the =qmckl_f.f90= file. + =_f=. For more guidelines on using Fortran to generate a C interface, see [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]]. ** Coding rules + + The authors should follow the recommendations of the C99 + [[https://wiki.sei.cmu.edu/confluence/display/c/SEI+CERT+C+Coding+Standard][SEI+CERT C Coding Standard]]. - The authors should follow the recommendations of the - [[https://wiki.sei.cmu.edu/confluence/display/c/SEI+CERT+C+Coding+Standard][SEI+CERT+C+Coding+Standard]]. - - - Store a new value in pointers immediately after the memory is - freed - - Free dynamically allocated memory when no longer needed - - # # TODO: decide on a coding style - - # To improve readability, we maintain a consistent coding style in - # the library. - - # - For C source files, we will use __(decide on a coding style)__ - # - For Fortran source files, we will use __(decide on a coding - # style)__ - - # Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. + Compliance can be checked with =cppcheck= as: + #+begin_src bash +cppcheck --addon=cert --enable=all *.c &> cppcheck.out + #+end_src ** Design of the library @@ -199,14 +187,43 @@ Both files are located in the =include/= directory. The internal structure of the context is not specified, to give a maximum of freedom to the different implementations. Modifying the state is done by setters and getters, prefixed by - =qmckl_context_set_= an =qmckl_context_get_=. When a context - variable is modified by a setter, a copy of the old data structure - is made and updated, and the pointer to the new data structure is - returned, such that the old contexts can still be accessed. It is - also possible to modify the state in an impure fashion, using the - =qmckl_context_update_= functions. The context and its old - versions can be destroyed with =qmckl_context_destroy=. + =qmckl_set_= an =qmckl_get_=. +** Headers + + A single =qmckl.h= header to be distributed by the library + is built by concatenating some of the produced header files. + To facilitate building the =qmckl.h= file, we separate types from + function declarations in headers. Types should be defined in header + files suffixed by =_type.h=, and functions in files suffixed by + =_func.h=. + As these files will be concatenated in a single file, they should + not be guarded by ~#ifndef *_H~, and they should not include other + produced headers. + + Some particular types that are not exported need to be known by the + context, and there are some functions to update instances of these + types contained inside the context. For example, a + ~qmckl_numprec_struct~ is present in the context, and the function + ~qmckl_set_numprec_range~ takes a context as a parameter, and set a + value in the ~qmckl_numprec_struct~ contained in the context. + Because of these intricate dependencies, a private header is + created, containing the ~qmckl_numprec_struct~. This header is + included in the private header which defines the type of the + context. Headers for private types are suffixed by =_private_type.h= + and headers for private functions, =_private_func.h=. + Fortran interfaces should also be written in the =*_f_func.f90= file, + and the types definitions should be written in the =*_f_type.f90= file. + + | File | Scope | Description | + |--------------------+---------+------------------------------| + | =*_type.h= | Public | Type definitions | + | =*_func.h= | Public | Function definitions | + | =*_private_type.h= | Private | Type definitions | + | =*_private_func.h= | Private | Function definitions | + | =*fh_type.f90= | Public | Fortran type definitions | + | =*fh_func.f90= | Public | Fortran function definitions | + ** Low-level functions Low-level functions are very simple functions which are leaves of diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org deleted file mode 100644 index e26b2d1..0000000 --- a/src/qmckl_ao.org +++ /dev/null @@ -1,809 +0,0 @@ -#+TITLE: Atomic Orbitals -#+SETUPFILE: ../docs/theme.setup - -The atomic basis set is defined as a list of shells. Each shell $s$ is -centered on a nucleus $A$, possesses a given angular momentum $l$ and a -radial function $R_s$. The radial function is a linear combination of -\emph{primitive} functions that can be of type Slater ($p=1$) or -Gaussian ($p=2$): - -\[ - R_s(\mathbf{r}) = \mathcal{N}_s |\mathbf{r}-\mathbf{R}_A|^{n_s} - \sum_{k=1}^{N_{\text{prim}}} a_{ks} - \exp \left( - \gamma_{ks} | \mathbf{r}-\mathbf{R}_A | ^p \right). -\] - -In the case of Gaussian functions, $n_s$ is always zero. -The normalization factor $\mathcal{N}_s$ ensures that all the functions -of the shell are normalized to unity. As this normalization requires -the ability to compute overlap integrals, it should be written in the -file to ensure that the file is self-contained and does not require -the client program to have the ability to compute such integrals. - -Atomic orbitals (AOs) are defined as - -\[ -\chi_i (\mathbf{r}) = P_{\eta(i)}(\mathbf{r})\, R_{\theta(i)} (\mathbf{r}) -\] - -where $\theta(i)$ returns the shell on which the AO is expanded, -and $\eta(i)$ denotes which angular function is chosen. - -In this section we describe the kernels used to compute the values, -gradients and Laplacian of the atomic basis functions. - -* Headers :noexport: - - #+NAME: filename - #+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) - #+end_src - - - #+begin_src c :tangle (eval c_test) :noweb yes -#include "qmckl.h" -#include "munit.h" -MunitResult test_<>() { - qmckl_context context; - context = qmckl_context_create(); - #+end_src - -* Polynomial part - -** Powers of $x-X_i$ - - The ~qmckl_ao_power~ function computes all the powers of the ~n~ - input data up to the given maximum value given in input for each of - the $n$ points: - - \[ P_{ik} = X_i^k \] - - | ~context~ | input | Global state | - | ~n~ | input | Number of values | - | ~X(n)~ | input | Array containing the input values | - | ~LMAX(n)~ | input | Array containing the maximum power for each value | - | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | - | ~LDP~ | input | Leading dimension of array ~P~ | - - Requirements: - - - ~context~ is not ~QMCKL_NULL_CONTEXT~ - - ~n~ > 0 - - ~X~ is allocated with at least $n \times 8$ bytes - - ~LMAX~ is allocated with at least $n \times 4$ bytes - - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - - ~LDP~ >= $\max_i$ ~LMAX[i]~ - - #+begin_src c :tangle (eval h) -qmckl_exit_code -qmckl_ao_power(const qmckl_context context, - const int64_t n, - const double *X, - const int32_t *LMAX, - const double *P, - const int64_t LDP); - #+end_src - - #+begin_src f90 :tangle (eval f) -integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) - use qmckl - implicit none - integer*8 , intent(in) :: context - integer*8 , intent(in) :: n - real*8 , intent(in) :: X(n) - integer , intent(in) :: LMAX(n) - real*8 , intent(out) :: P(ldp,n) - integer*8 , intent(in) :: ldp - - integer*8 :: i,k - - info = QMCKL_SUCCESS - - if (context == QMCKL_NULL_CONTEXT) then - info = QMCKL_INVALID_CONTEXT - return - endif - - if (n <= ldp) then - info = QMCKL_INVALID_ARG_2 - return - endif - - k = MAXVAL(LMAX) - if (LDP < k) then - info = QMCKL_INVALID_ARG_6 - return - endif - - if (k <= 0) then - info = QMCKL_INVALID_ARG_4 - return - endif - - do i=1,n - P(1,i) = X(i) - do k=2,LMAX(i) - P(k,i) = P(k-1,i) * X(i) - end do - end do - -end function qmckl_ao_power_f - #+end_src - - #+begin_src f90 :tangle (eval f) :exports none -integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & - bind(C) result(info) - use, intrinsic :: iso_c_binding - implicit none - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: n - real (c_double) , intent(in) :: X(n) - integer (c_int32_t) , intent(in) :: LMAX(n) - real (c_double) , intent(out) :: P(ldp,n) - integer (c_int64_t) , intent(in) , value :: ldp - - integer, external :: qmckl_ao_power_f - info = qmckl_ao_power_f(context, n, X, LMAX, P, ldp) -end function qmckl_ao_power - #+end_src - - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: n - integer (c_int64_t) , intent(in) , value :: ldp - real (c_double) , intent(in) :: X(n) - integer (c_int32_t) , intent(in) :: LMAX(n) - real (c_double) , intent(out) :: P(ldp,n) - end function qmckl_ao_power - end interface - #+end_src - - # Test - #+begin_src f90 :tangle (eval f_test) -integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) - use qmckl - implicit none - - integer(c_int64_t), intent(in), value :: context - - integer*8 :: n, LDP - integer, allocatable :: LMAX(:) - double precision, allocatable :: X(:), P(:,:) - integer*8 :: i,j - double precision :: epsilon - - epsilon = qmckl_context_get_epsilon(context) - - n = 100; - LDP = 10; - - allocate(X(n), P(LDP,n), LMAX(n)) - - do j=1,n - X(j) = -5.d0 + 0.1d0 * dble(j) - LMAX(j) = 1 + int(mod(j, 5),4) - end do - - test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP) - if (test_qmckl_ao_power /= 0) return - - test_qmckl_ao_power = -1 - - do j=1,n - do i=1,LMAX(j) - if ( X(j)**i == 0.d0 ) then - if ( P(i,j) /= 0.d0) return - else - if ( dabs(1.d0 - P(i,j) / (X(j)**i)) > epsilon ) return - end if - end do - end do - - test_qmckl_ao_power = 0 - deallocate(X,P,LMAX) -end function test_qmckl_ao_power - #+end_src - - #+begin_src c :tangle (eval c_test) :exports none -int test_qmckl_ao_power(qmckl_context context); -munit_assert_int(0, ==, test_qmckl_ao_power(context)); - #+end_src - -** Value, Gradient and Laplacian of a polynomial - - A polynomial is centered on a nucleus $\mathbf{R}_i$ - - \[ - P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c - \] - - The gradients with respect to electron coordinates are - - \begin{eqnarray*} - \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ - \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ - \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & - = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ - \end{eqnarray*} - - and the Laplacian is - - \begin{eqnarray*} - \left( \frac{\partial }{\partial x^2} + - \frac{\partial }{\partial y^2} + - \frac{\partial }{\partial z^2} \right) P_l - \left(\mathbf{r},\mathbf{R}_i \right) & = & - a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ - && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ - && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1}. - \end{eqnarray*} - - ~qmckl_ao_polynomial_vgl~ computes the values, gradients and - Laplacians at a given point in space, of all polynomials with an - angular momentum up to ~lmax~. - - | ~context~ | input | Global state | - | ~X(3)~ | input | Array containing the coordinates of the points | - | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~lmax~ | input | Maximum angular momentum | - | ~n~ | output | Number of computed polynomials | - | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | - | ~ldl~ | input | Leading dimension of ~L~ | - | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | - | ~ldv~ | input | Leading dimension of array ~VGL~ | - - Requirements: - - - ~context~ is not ~QMCKL_NULL_CONTEXT~ - - ~n~ > 0 - - ~lmax~ >= 0 - - ~ldl~ >= 3 - - ~ldv~ >= 5 - - ~X~ is allocated with at least $3 \times 8$ bytes - - ~R~ is allocated with at least $3 \times 8$ bytes - - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ - - ~L~ is allocated with at least $3 \times n \times 4$ bytes - - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes - - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ - - On output, the powers are given in the following order (l=a+b+c): - - Increasing values of ~l~ - - Within a given value of ~l~, alphabetical order of the - string made by a*"x" + b*"y" + c*"z" (in Python notation). - For example, with a=0, b=2 and c=1 the string is "yyz" - - # Header - #+begin_src c :tangle (eval h) -qmckl_exit_code -qmckl_ao_polynomial_vgl(const qmckl_context context, - const double *X, - const double *R, - const int32_t lmax, - const int64_t *n, - const int32_t *L, - const int64_t ldl, - const double *VGL, - const int64_t ldv); - #+end_src - - # Source - #+begin_src f90 :tangle (eval f) -integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) - use qmckl - implicit none - integer*8 , intent(in) :: context - real*8 , intent(in) :: X(3), R(3) - integer , intent(in) :: lmax - integer*8 , intent(out) :: n - integer , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer*8 , intent(in) :: ldl - real*8 , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer*8 , intent(in) :: ldv - - integer*8 :: i,j - integer :: a,b,c,d - real*8 :: Y(3) - integer :: lmax_array(3) - real*8 :: pows(-2:lmax,3) - integer, external :: qmckl_ao_power_f - double precision :: xy, yz, xz - double precision :: da, db, dc, dd - - info = 0 - - if (context == QMCKL_NULL_CONTEXT) then - info = QMCKL_INVALID_CONTEXT - return - endif - - if (lmax < 0) then - info = QMCKL_INVALID_ARG_4 - return - endif - - if (ldl < 3) then - info = QMCKL_INVALID_ARG_7 - return - endif - - if (ldv < 5) then - info = QMCKL_INVALID_ARG_9 - return - endif - - - do i=1,3 - Y(i) = X(i) - R(i) - end do - - lmax_array(1:3) = lmax - if (lmax == 0) then - VGL(1,1) = 1.d0 - vgL(2:5,1) = 0.d0 - l(1:3,1) = 0 - n=1 - else if (lmax > 0) then - pows(-2:0,1:3) = 1.d0 - do i=1,lmax - pows(i,1) = pows(i-1,1) * Y(1) - pows(i,2) = pows(i-1,2) * Y(2) - pows(i,3) = pows(i-1,3) * Y(3) - end do - - VGL(1:5,1:4) = 0.d0 - l (1:3,1:4) = 0 - - VGL(1 ,1 ) = 1.d0 - vgl(1:5,2:4) = 0.d0 - - l (1,2) = 1 - vgl(1,2) = pows(1,1) - vgL(2,2) = 1.d0 - - l (2,3) = 1 - vgl(1,3) = pows(1,2) - vgL(3,3) = 1.d0 - - l (3,4) = 1 - vgl(1,4) = pows(1,3) - vgL(4,4) = 1.d0 - - n=4 - endif - - ! l>=2 - dd = 2.d0 - do d=2,lmax - da = dd - do a=d,0,-1 - db = dd-da - do b=d-a,0,-1 - c = d - a - b - dc = dd - da - db - n = n+1 - - l(1,n) = a - l(2,n) = b - l(3,n) = c - - xy = pows(a,1) * pows(b,2) - yz = pows(b,2) * pows(c,3) - xz = pows(a,1) * pows(c,3) - - vgl(1,n) = xy * pows(c,3) - - xy = dc * xy - xz = db * xz - yz = da * yz - - vgl(2,n) = pows(a-1,1) * yz - vgl(3,n) = pows(b-1,2) * xz - vgl(4,n) = pows(c-1,3) * xy - - vgl(5,n) = & - (da-1.d0) * pows(a-2,1) * yz + & - (db-1.d0) * pows(b-2,2) * xz + & - (dc-1.d0) * pows(c-2,3) * xy - - db = db - 1.d0 - end do - da = da - 1.d0 - end do - dd = dd + 1.d0 - end do - - info = QMCKL_SUCCESS - -end function qmckl_ao_polynomial_vgl_f - #+end_src - - - #+begin_src f90 :tangle (eval f) :exports none -integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & - bind(C) result(info) - use, intrinsic :: iso_c_binding - implicit none - integer (c_int64_t) , intent(in) , value :: context - real (c_double) , intent(in) :: X(3), R(3) - integer (c_int32_t) , intent(in) , value :: lmax - integer (c_int64_t) , intent(out) :: n - integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer (c_int64_t) , intent(in) , value :: ldl - real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer (c_int64_t) , intent(in) , value :: ldv - - integer, external :: qmckl_ao_polynomial_vgl_f - info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) -end function qmckl_ao_polynomial_vgl - #+end_src - - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & - bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t) , intent(in) , value :: context - integer (c_int32_t) , intent(in) , value :: lmax - integer (c_int64_t) , intent(in) , value :: ldl - integer (c_int64_t) , intent(in) , value :: ldv - real (c_double) , intent(in) :: X(3), R(3) - integer (c_int64_t) , intent(out) :: n - integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) - end function qmckl_ao_polynomial_vgl - end interface - #+end_src - - #+begin_src f90 :tangle (eval f_test) -integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) - use qmckl - implicit none - - integer(c_int64_t), intent(in), value :: context - - integer :: lmax, d, i - integer, allocatable :: L(:,:) - integer*8 :: n, ldl, ldv, j - double precision :: X(3), R(3), Y(3) - double precision, allocatable :: VGL(:,:) - double precision :: w - double precision :: epsilon - - epsilon = qmckl_context_get_epsilon(context) - - X = (/ 1.1 , 2.2 , 3.3 /) - R = (/ 0.1 , 1.2 , -2.3 /) - Y(:) = X(:) - R(:) - - lmax = 4; - ldl = 3; - ldv = 100; - - d = (lmax+1)*(lmax+2)*(lmax+3)/6 - - allocate (L(ldl,d), VGL(ldv,d)) - - test_qmckl_ao_polynomial_vgl = & - qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) - - if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return - if (n /= d) return - - do j=1,n - test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE - do i=1,3 - if (L(i,j) < 0) return - end do - test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE - if (dabs(1.d0 - VGL(1,j) / (& - Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) & - )) > epsilon ) return - - test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE - if (L(1,j) < 1) then - if (VGL(2,j) /= 0.d0) return - else - if (dabs(1.d0 - VGL(2,j) / (& - L(1,j) * Y(1)**(L(1,j)-1) * Y(2)**L(2,j) * Y(3)**L(3,j) & - )) > epsilon ) return - end if - - test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE - if (L(2,j) < 1) then - if (VGL(3,j) /= 0.d0) return - else - if (dabs(1.d0 - VGL(3,j) / (& - L(2,j) * Y(1)**L(1,j) * Y(2)**(L(2,j)-1) * Y(3)**L(3,j) & - )) > epsilon ) return - end if - - test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE - if (L(3,j) < 1) then - if (VGL(4,j) /= 0.d0) return - else - if (dabs(1.d0 - VGL(4,j) / (& - L(3,j) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-1) & - )) > epsilon ) return - end if - - test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE - w = 0.d0 - if (L(1,j) > 1) then - w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j) - end if - if (L(2,j) > 1) then - w = w + L(2,j) * (L(2,j)-1) * Y(1)**L(1,j) * Y(2)**(L(2,j)-2) * Y(3)**L(3,j) - end if - if (L(3,j) > 1) then - w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2) - end if - if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return - end do - - test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS - - deallocate(L,VGL) -end function test_qmckl_ao_polynomial_vgl - #+end_src - - #+begin_src c :tangle (eval c_test) -int test_qmckl_ao_polynomial_vgl(qmckl_context context); -munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - #+end_src - -* Gaussian basis functions - - ~qmckl_ao_gaussian_vgl~ computes the values, gradients and - Laplacians at a given point of ~n~ Gaussian functions centered at - the same point: - - \[ v_i = \exp(-a_i |X-R|^2) \] - \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] - \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] - \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] - \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] - - | ~context~ | input | Global state | - | ~X(3)~ | input | Array containing the coordinates of the points | - | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~n~ | input | Number of computed Gaussians | - | ~A(n)~ | input | Exponents of the Gaussians | - | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | - | ~ldv~ | input | Leading dimension of array ~VGL~ | - - Requirements : - - - ~context~ is not 0 - - ~n~ > 0 - - ~ldv~ >= 5 - - ~A(i)~ > 0 for all ~i~ - - ~X~ is allocated with at least $3 \times 8$ bytes - - ~R~ is allocated with at least $3 \times 8$ bytes - - ~A~ is allocated with at least $n \times 8$ bytes - - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes - - #+begin_src c :tangle (eval h) -qmckl_exit_code -qmckl_ao_gaussian_vgl(const qmckl_context context, - const double *X, - const double *R, - const int64_t *n, - const int64_t *A, - const double *VGL, - const int64_t ldv); - #+end_src - - #+begin_src f90 :tangle (eval f) -integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) - use qmckl - implicit none - integer*8 , intent(in) :: context - real*8 , intent(in) :: X(3), R(3) - integer*8 , intent(in) :: n - real*8 , intent(in) :: A(n) - real*8 , intent(out) :: VGL(ldv,5) - integer*8 , intent(in) :: ldv - - integer*8 :: i,j - real*8 :: Y(3), r2, t, u, v - - info = QMCKL_SUCCESS - - if (context == QMCKL_NULL_CONTEXT) then - info = QMCKL_INVALID_CONTEXT - return - endif - - if (n <= 0) then - info = QMCKL_INVALID_ARG_4 - return - endif - - if (ldv < n) then - info = QMCKL_INVALID_ARG_7 - return - endif - - - do i=1,3 - Y(i) = X(i) - R(i) - end do - r2 = Y(1)*Y(1) + Y(2)*Y(2) + Y(3)*Y(3) - - do i=1,n - VGL(i,1) = dexp(-A(i) * r2) - end do - - do i=1,n - VGL(i,5) = A(i) * VGL(i,1) - end do - - t = -2.d0 * ( X(1) - R(1) ) - u = -2.d0 * ( X(2) - R(2) ) - v = -2.d0 * ( X(3) - R(3) ) - - do i=1,n - VGL(i,2) = t * VGL(i,5) - VGL(i,3) = u * VGL(i,5) - VGL(i,4) = v * VGL(i,5) - end do - - t = 4.d0 * r2 - do i=1,n - VGL(i,5) = (t * A(i) - 6.d0) * VGL(i,5) - end do - -end function qmckl_ao_gaussian_vgl_f - #+end_src - - #+begin_src f90 :tangle (eval f) :exports none -integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & - bind(C) result(info) - use, intrinsic :: iso_c_binding - implicit none - integer (c_int64_t) , intent(in) , value :: context - real (c_double) , intent(in) :: X(3), R(3) - integer (c_int64_t) , intent(in) , value :: n - real (c_double) , intent(in) :: A(n) - real (c_double) , intent(out) :: VGL(ldv,5) - integer (c_int64_t) , intent(in) , value :: ldv - - integer, external :: qmckl_ao_gaussian_vgl_f - info = qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) -end function qmckl_ao_gaussian_vgl - #+end_src - - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & - bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: ldv - integer (c_int64_t) , intent(in) , value :: n - real (c_double) , intent(in) :: X(3), R(3), A(n) - real (c_double) , intent(out) :: VGL(ldv,5) - end function qmckl_ao_gaussian_vgl - end interface - #+end_src - - # Test - #+begin_src f90 :tangle (eval f_test) -integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) - use qmckl - implicit none - - integer(c_int64_t), intent(in), value :: context - - integer*8 :: n, ldv, j, i - double precision :: X(3), R(3), Y(3), r2 - double precision, allocatable :: VGL(:,:), A(:) - double precision :: epsilon - - epsilon = qmckl_context_get_epsilon(context) - - X = (/ 1.1 , 2.2 , 3.3 /) - R = (/ 0.1 , 1.2 , -2.3 /) - Y(:) = X(:) - R(:) - r2 = Y(1)**2 + Y(2)**2 + Y(3)**2 - - n = 10; - ldv = 100; - - allocate (A(n), VGL(ldv,5)) - do i=1,n - A(i) = 0.0013 * dble(ishft(1,i)) - end do - - - test_qmckl_ao_gaussian_vgl = & - qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) - if (test_qmckl_ao_gaussian_vgl /= 0) return - - test_qmckl_ao_gaussian_vgl = -1 - - do i=1,n - test_qmckl_ao_gaussian_vgl = -11 - if (dabs(1.d0 - VGL(i,1) / (& - dexp(-A(i) * r2) & - )) > epsilon ) return - - test_qmckl_ao_gaussian_vgl = -12 - if (dabs(1.d0 - VGL(i,2) / (& - -2.d0 * A(i) * Y(1) * dexp(-A(i) * r2) & - )) > epsilon ) return - - test_qmckl_ao_gaussian_vgl = -13 - if (dabs(1.d0 - VGL(i,3) / (& - -2.d0 * A(i) * Y(2) * dexp(-A(i) * r2) & - )) > epsilon ) return - - test_qmckl_ao_gaussian_vgl = -14 - if (dabs(1.d0 - VGL(i,4) / (& - -2.d0 * A(i) * Y(3) * dexp(-A(i) * r2) & - )) > epsilon ) return - - test_qmckl_ao_gaussian_vgl = -15 - if (dabs(1.d0 - VGL(i,5) / (& - A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) & - )) > epsilon ) return - end do - - test_qmckl_ao_gaussian_vgl = 0 - - deallocate(VGL) -end function test_qmckl_ao_gaussian_vgl - #+end_src - - #+begin_src c :tangle (eval c_test) :exports none -int test_qmckl_ao_gaussian_vgl(qmckl_context context); -munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); - #+end_src - -* TODO Slater basis functions - -* End of files :noexport: - -*** Test - #+begin_src c :tangle (eval c_test) - if (qmckl_context_destroy(context) != QMCKL_SUCCESS) - return QMCKL_FAILURE; - return MUNIT_OK; -} - #+end_src - -**✸ Compute file names - #+begin_src emacs-lisp -; The following is required to compute the file names - -(setq pwd (file-name-directory buffer-file-name)) -(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) -(setq f (concat pwd name "_f.f90")) -(setq fh (concat pwd name "_fh.f90")) -(setq c (concat pwd name ".c")) -(setq h (concat name ".h")) -(setq h_private (concat name "_private.h")) -(setq c_test (concat pwd "test_" name ".c")) -(setq f_test (concat pwd "test_" name "_f.f90")) - -; Minted -(require 'ox-latex) -(setq org-latex-listings 'minted) -(add-to-list 'org-latex-packages-alist '("" "listings")) -(add-to-list 'org-latex-packages-alist '("" "color")) - - #+end_src - - #+RESULTS: - | | color | - | | listings | - - -# -*- mode: org -*- -# vim: syntax=c - - diff --git a/src/qmckl_context.org b/src/qmckl_context.org index e195336..df721d5 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,24 +1,6 @@ #+TITLE: Context #+SETUPFILE: ../docs/theme.setup - - The context variable is a handle for the state of the library, - and is stored in a data structure which can't be seen outside of - the library. To simplify compatibility with other languages, the - pointer to the internal data structure is converted into a 64-bit - signed integer, defined in the ~qmckl_context~ type. - A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a - ~NULL~ pointer. - - #+begin_src c :comments org :tangle (eval h) -typedef int64_t qmckl_context ; -#define QMCKL_NULL_CONTEXT (qmckl_context) 0 - #+end_src - - #+begin_src f90 :comments org :tangle (eval fh) :exports none - integer*8, parameter :: QMCKL_NULL_CONTEXT = 0 - #+end_src - * Headers :noexport: #+NAME: filename @@ -33,14 +15,15 @@ typedef int64_t qmckl_context ; MunitResult test_<>() { #+end_src - #+begin_src c :tangle (eval h_private) -#ifndef __QMCKL_CONTEXT__ -#define __QMCKL_CONTEXT__ + #+begin_src c :tangle (eval h_private_type) :noweb yes +#ifndef QMCKL_CONTEXT_HPT +#define QMCKL_CONTEXT_HPT #include #include -#include "qmckl_error.h" +#include "qmckl_error_private_type.h" +#include "qmckl_numprec_private_type.h" #+end_src #+begin_src c :tangle (eval c) @@ -48,90 +31,97 @@ MunitResult test_<>() { #include #include #include -#include - -#include "qmckl_error.h" -#include "qmckl_context.h" -#include "qmckl_context_private.h" -#include "qmckl_memory.h" - #include +#include +#include + +#include "qmckl_error_type.h" +#include "qmckl_context_private_type.h" +#include "qmckl_context_type.h" + +#include "qmckl_memory_func.h" +#include "qmckl_context_func.h" + +static void init_lock(pthread_mutex_t* mutex); #+end_src * Context handling - The context appears as an immutable data structure: modifying a - context returns a new context with the modifications. Therefore, it - is necessary to store a pointer to the old version of context so - that it can be freed when necessary. - Note that we also provide a possibility to mutate the context, but - this should be done with caution, only when it is justified. + The context variable is a handle for the state of the library, + and is stored in a data structure which can't be seen outside of + the library. To simplify compatibility with other languages, the + pointer to the internal data structure is converted into a 64-bit + signed integer, defined in the ~qmckl_context~ type. + A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a + ~NULL~ pointer. + + #+NAME: qmckl_context + #+begin_src c :comments org :tangle (eval h_type) +typedef int64_t qmckl_context ; +#define QMCKL_NULL_CONTEXT (qmckl_context) 0 + #+end_src + + #+begin_src f90 :comments org :tangle (eval fh_type) :exports none + integer , parameter :: qmckl_context = c_int64_t + integer*8, parameter :: QMCKL_NULL_CONTEXT = 0 + #+end_src + + An immutable context would have required to implement a garbage + collector. To keep the library simple, we have chosen to implement + the context as a mutable data structure, so it has to be handled + with care. By convention, in this file ~context~ is a ~qmckl_context~ variable and ~ctx~ is a ~qmckl_context_struct*~ pointer. ** Data structure - The main data structure contains pointers to other data structures, - containing the data specific to each given domain, such that the - modified contexts don't need to duplicate the data but only the - pointers. - - #+NAME: qmckl_context_struct - #+begin_src c :comments org :tangle none :noweb yes + #+begin_src c :comments org :tangle (eval h_private_type) :noweb yes :exports none typedef struct qmckl_context_struct { - - /* Pointer to the previous context, before modification */ - struct qmckl_context_struct * prev; - - /* Molecular system */ - qmckl_ao_basis_struct * ao_basis; - - /* To be implemented: - qmckl_nucleus_struct * nucleus; - qmckl_electron_struct * electron; - qmckl_mo_struct * mo; - qmckl_determinant_struct * det; - ,*/ - - /* Numerical precision */ - qmckl_precision_struct * fp; - - /* Error handling */ - qmckl_error_struct * error; - - /* Memory allocation */ - qmckl_memory_struct * alloc; - - /* Thread lock */ - int lock_count; - pthread_mutex_t mutex; + /* -- State of the library -- */ /* Validity checking */ - uint32_t tag; + uint64_t tag; + + /* Numerical precision */ + qmckl_numprec_struct numprec; + + /* Thread lock */ + int lock_count; + pthread_mutex_t mutex; + + /* Error handling */ + qmckl_error_struct error; + + /* Memory allocation */ + /* + qmckl_memory_struct memory; + ,*/ + + /* -- Molecular system -- */ + /* To be implemented: + qmckl_ao_basis_struct ao_basis; + + qmckl_nucleus_struct nucleus; + qmckl_electron_struct electron; + qmckl_mo_struct mo; + qmckl_determinant_struct det; + ,*/ } qmckl_context_struct; #+end_src - - #+begin_src c :comments org :tangle (eval h_private) :noweb yes :exports none -<> - -<> - -<> - -<> - -<> - #+end_src + When a new element is added to the context, the functions + [[Creation][qmckl_context_create]], [[Destroy][qmckl_context_destroy]] and [[Copy][qmckl_context_copy]] + should be updated inorder to make deep copies. + A tag is used internally to check if the memory domain pointed by a pointer is a valid context. This allows to check that even if the pointer associated with a context is non-null, we can still verify that it points to the expected data structure. - #+begin_src c :comments org :tangle (eval h_private) :noweb yes + #+begin_src c :comments org :tangle (eval h_private_type) :noweb yes #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF #+end_src @@ -140,7 +130,7 @@ typedef struct qmckl_context_struct { the pointer is a valid context. It returns the input ~qmckl_context~ if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise. - #+begin_src c :comments org :tangle (eval h) :noexport + #+begin_src c :comments org :tangle (eval h_func) :noexport qmckl_context qmckl_context_check(const qmckl_context context) ; #+end_src @@ -150,7 +140,7 @@ qmckl_context qmckl_context_check(const qmckl_context context) { if (context == QMCKL_NULL_CONTEXT) return QMCKL_NULL_CONTEXT; - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + const qmckl_context_struct* const ctx = (const qmckl_context_struct* const) context; /* Try to access memory */ if (ctx->tag != VALID_TAG) { @@ -168,7 +158,7 @@ qmckl_context qmckl_context_check(const qmckl_context context) { - It returns ~QMCKL_NULL_CONTEXT~ upon failure to allocate the internal data structure # Header - #+begin_src c :comments org :tangle (eval h) :exports none + #+begin_src c :comments org :tangle (eval h_func) :exports none qmckl_context qmckl_context_create(); #+end_src @@ -176,8 +166,8 @@ qmckl_context qmckl_context_create(); #+begin_src c :tangle (eval c) qmckl_context qmckl_context_create() { - qmckl_context_struct* ctx = - (qmckl_context_struct*) qmckl_malloc (QMCKL_NULL_CONTEXT, sizeof(qmckl_context_struct)); + qmckl_context_struct* const ctx = + (qmckl_context_struct* const) malloc (sizeof(qmckl_context_struct)); if (ctx == NULL) { return QMCKL_NULL_CONTEXT; @@ -192,7 +182,7 @@ qmckl_context qmckl_context_create() { /* Initialize data */ ctx->tag = VALID_TAG; - const qmckl_context context = (qmckl_context) ctx; + const qmckl_context context = (const qmckl_context) ctx; assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); return context; @@ -200,10 +190,11 @@ qmckl_context qmckl_context_create() { #+end_src # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none + #+begin_src f90 :tangle (eval fh_func) :exports none interface - integer (c_int64_t) function qmckl_context_create() bind(C) + integer (qmckl_context) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding + import end function qmckl_context_create end interface #+end_src @@ -217,46 +208,6 @@ munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT ); munit_assert_int64( qmckl_context_check(context), ==, context ); #+end_src -** Access to the previous context - - ~qmckl_context_previous~ returns the previous context. It returns - ~QMCKL_NULL_CONTEXT~ for the initial context and for the ~NULL~ context. - - # Header - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_context qmckl_context_previous(const qmckl_context context); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_previous(const qmckl_context context) { - - const qmckl_context checked_context = qmckl_context_check(context); - if (checked_context == (qmckl_context) 0) { - return (qmckl_context) 0; - } - - const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; - return qmckl_context_check((qmckl_context) ctx->prev); -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer (c_int64_t) function qmckl_context_previous(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_previous - end interface - #+end_src - - # Test - #+begin_src c :comments link :tangle (eval c_test) :exports none -munit_assert_int64(qmckl_context_previous(context), ==, QMCKL_NULL_CONTEXT); -munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); - #+end_src - ** Locking For thread safety, the context may be locked/unlocked. The lock is @@ -265,16 +216,14 @@ munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CO ~lock_count~ attribute. # Header - #+begin_src c :comments org :tangle (eval h) :exports none + #+begin_src c :comments org :tangle (eval h_func) :exports none void qmckl_lock (qmckl_context context); void qmckl_unlock(qmckl_context context); - -void init_lock(pthread_mutex_t* mutex); #+end_src # Source #+begin_src c :tangle (eval c) -void init_lock(pthread_mutex_t* mutex) { +static void init_lock(pthread_mutex_t* mutex) { pthread_mutexattr_t attr; int rc; @@ -289,48 +238,49 @@ void init_lock(pthread_mutex_t* mutex) { (void)pthread_mutexattr_destroy(&attr); } -void qmckl_lock(qmckl_context context) { +void qmckl_lock(const qmckl_context context) { if (context == QMCKL_NULL_CONTEXT) return ; - qmckl_context_struct *ctx = (qmckl_context_struct*) context; + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; errno = 0; int rc = pthread_mutex_lock( &(ctx->mutex) ); if (rc != 0) { - fprintf(stderr, "qmckl_lock:%s\n", strerror(rc) ); + fprintf(stderr, "DEBUG qmckl_lock:%s\n", strerror(rc) ); fflush(stderr); } assert (rc == 0); - ctx->lock_count++; + ctx->lock_count += 1; /* printf(" lock : %d\n", ctx->lock_count); */ } -void qmckl_unlock(qmckl_context context) { - qmckl_context_struct *ctx = (qmckl_context_struct*) context; +void qmckl_unlock(const qmckl_context context) { + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; int rc = pthread_mutex_unlock( &(ctx->mutex) ); if (rc != 0) { - fprintf(stderr, "qmckl_unlock:%s\n", strerror(rc) ); + fprintf(stderr, "DEBUG qmckl_unlock:%s\n", strerror(rc) ); fflush(stderr); } assert (rc == 0); - ctx->lock_count--; + ctx->lock_count -= 1; /* printf("unlock : %d\n", ctx->lock_count); */ } #+end_src -** Copy +** TODO Copy ~qmckl_context_copy~ makes a shallow copy of a context. It returns ~QMCKL_NULL_CONTEXT~ upon failure. # Header - #+begin_src c :comments org :tangle (eval h) :exports none + #+begin_src c :comments org :tangle (eval h_func) :exports none qmckl_context qmckl_context_copy(const qmckl_context context); #+end_src + # Source #+begin_src c :tangle (eval c) qmckl_context qmckl_context_copy(const qmckl_context context) { @@ -345,11 +295,11 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { } - qmckl_context_struct* old_ctx = - (qmckl_context_struct*) checked_context; + const qmckl_context_struct* const old_ctx = + (qmckl_context_struct* const) checked_context; - qmckl_context_struct* new_ctx = - (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); + qmckl_context_struct* const new_ctx = + (qmckl_context_struct* const) qmckl_malloc (context, sizeof(qmckl_context_struct)); if (new_ctx == NULL) { qmckl_unlock(context); @@ -357,10 +307,10 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { } /* Copy the old context on the new one */ + /* TODO Deep copies should be done here */ memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct)); - new_ctx->prev = old_ctx; - + /* As the lock was copied, both need to be unlocked */ qmckl_unlock( (qmckl_context) new_ctx ); qmckl_unlock( (qmckl_context) old_ctx ); @@ -370,11 +320,12 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { #+end_src # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none + #+begin_src f90 :tangle (eval fh_func) :exports none interface - integer (c_int64_t) function qmckl_context_copy(context) bind(C) + integer (qmckl_context) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context + import + integer (qmckl_context), intent(in), value :: context end function qmckl_context_copy end interface #+end_src @@ -385,7 +336,6 @@ qmckl_context new_context = qmckl_context_copy(context); munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); -munit_assert_int64(qmckl_context_previous(new_context), ==, context); #+end_src ** Destroy @@ -394,42 +344,28 @@ munit_assert_int64(qmckl_context_previous(new_context), ==, context); It frees the context, and returns the previous context. # Header - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_context qmckl_context_destroy(qmckl_context context); + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code qmckl_context_destroy(const qmckl_context context); #+end_src # Source #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_destroy(const qmckl_context context) { +qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); - if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_NULL_CONTEXT; + if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; qmckl_lock(context); - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - assert (ctx != NULL); /* Shouldn't be true because the context is valid */ + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); /* Shouldn't be possible because the context is valid */ - qmckl_unlock(context); - - const qmckl_context prev_context = (qmckl_context) ctx->prev; - if (prev_context == QMCKL_NULL_CONTEXT) { - /* This is the first context, free all memory. */ - struct qmckl_memory_struct* new = NULL; - while (ctx->alloc != NULL) { - new = ctx->alloc->next; - free(ctx->alloc->pointer); - ctx->alloc->pointer = NULL; - free(ctx->alloc); - ctx->alloc = new; - } - } + /* TODO Remove all allocated data */ + /* + qmckl_memory_free_all(context); + ,*/ - qmckl_exit_code rc; - rc = qmckl_context_remove_memory(context,ctx); - assert (rc == QMCKL_SUCCESS); - - ctx->tag = INVALID_TAG; + qmckl_unlock(context); const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) ); if (rc_destroy != 0) { @@ -437,19 +373,22 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) { abort(); } - rc = qmckl_free(context,ctx); + ctx->tag = INVALID_TAG; + + const qmckl_exit_code rc = qmckl_free(context,ctx); assert (rc == QMCKL_SUCCESS); - return prev_context; + return QMCKL_SUCCESS; } #+end_src # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none + #+begin_src f90 :tangle (eval fh_func) :exports none interface - integer (c_int64_t) function qmckl_context_destroy(context) bind(C) + integer (qmckl_exit_code) function qmckl_context_destroy(context) bind(C) use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context + import + integer (qmckl_context), intent(in), value :: context end function qmckl_context_destroy end interface #+end_src @@ -457,1022 +396,17 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) { # Test #+begin_src c :tangle (eval c_test) :exports none munit_assert_int64(qmckl_context_check(new_context), ==, new_context); -munit_assert_int64(qmckl_context_destroy(new_context), ==, context); +munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); munit_assert_int64(qmckl_context_check(new_context), !=, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_CONTEXT); -munit_assert_int64(qmckl_context_destroy(context), ==, QMCKL_NULL_CONTEXT); -munit_assert_int64(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); +munit_assert_int32(qmckl_context_destroy(context), ==, QMCKL_SUCCESS); +munit_assert_int32(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_INVALID_CONTEXT); #+end_src -* Memory allocation handling - -** Data structure - - Pointers to all allocated memory domains are stored in the context, - in a linked list. The size is also stored, to enable the - computation of the amount of currently used memory by the library. - - #+NAME: qmckl_memory_struct - #+begin_src c :comments org :tangle no -typedef struct qmckl_memory_struct { - struct qmckl_memory_struct * next ; - void * pointer ; - size_t size ; -} qmckl_memory_struct; - #+end_src - -** Append memory - - The following function, called in [[./qmckl_memory.html][=qmckl_memory.c=]], appends a new - pair (pointer, size) to the data structure. - It is forbidden to pass the ~NULL~ pointer, or a zero size. - If the context is ~QMCKL_NULL_CONTEXT~, the function returns - immediately with ~QMCKL_SUCCESS~. - - # Header - #+begin_src c :comments org :tangle (eval h_private) :exports none -qmckl_exit_code qmckl_context_append_memory(qmckl_context context, - void* pointer, - const size_t size); - #+end_src - - # Source - #+begin_src c :comments org :tangle (eval c) -qmckl_exit_code qmckl_context_append_memory(qmckl_context context, - void* pointer, - const size_t size) { - assert (pointer != NULL); - assert (size > 0L); - - qmckl_lock(context); - - if ( qmckl_context_check(context) == QMCKL_NULL_CONTEXT ) { - qmckl_unlock(context); - return QMCKL_SUCCESS; - } - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - - qmckl_memory_struct* new_alloc = (qmckl_memory_struct*) - malloc(sizeof(qmckl_memory_struct)); - - if (new_alloc == NULL) { - qmckl_unlock(context); - return QMCKL_ALLOCATION_FAILED; - } - - new_alloc->next = NULL; - new_alloc->pointer = pointer; - new_alloc->size = size; - - qmckl_memory_struct* alloc = ctx->alloc; - if (alloc == NULL) { - ctx->alloc = new_alloc; - } else { - while (alloc->next != NULL) { - alloc = alloc->next; - } - alloc->next = new_alloc; - } - - qmckl_unlock(context); - - return QMCKL_SUCCESS; - -} - #+end_src - -** Remove memory - - The following function, called in [[./qmckl_memory.html][=qmckl_memory.c=]], removes a - pointer from the data structure. - It is forbidden to pass the ~NULL~ pointer. - If the context is ~QMCKL_NULL_CONTEXT~, the function returns - immediately with ~QMCKL_SUCCESS~. - - # Header - #+begin_src c :comments org :tangle (eval h_private) :exports none -qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, - const void* pointer); - #+end_src - - # Source - #+begin_src c :comments org :tangle (eval c) -qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, - const void* pointer) { - assert (pointer != NULL); - - qmckl_lock(context); - - if ( qmckl_context_check(context) == QMCKL_NULL_CONTEXT ) { - qmckl_unlock(context); - return QMCKL_SUCCESS; - } - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - - qmckl_memory_struct* alloc = ctx->alloc; - qmckl_memory_struct* prev = ctx->alloc; - - while ( (alloc != NULL) && (alloc->pointer != pointer) ) { - prev = alloc; - alloc = alloc->next; - } - - if (alloc != NULL) { - prev->next = alloc->next; - free(alloc); - } - - qmckl_unlock(context); - - return QMCKL_SUCCESS; -} - #+end_src - - #+RESULTS: - -* Error handling - -** Data structure - - #+NAME: qmckl_error_struct - #+begin_src c :comments org :tangle no -#define QMCKL_MAX_FUN_LEN 256 -#define QMCKL_MAX_MSG_LEN 1024 - -typedef struct qmckl_error_struct { - - qmckl_exit_code exit_code; - char function[QMCKL_MAX_FUN_LEN]; - char message [QMCKL_MAX_MSG_LEN]; - -} qmckl_error_struct; - #+end_src - -** Updating errors - - The error is updated in the context using - ~qmckl_context_update_error~, although it is recommended to use - ~qmckl_context_set_error~ for the immutable variant. - When the error is set in the context, it is mandatory to specify - from which function the error is triggered, and a message - explaining the error. The exit code can't be ~QMCKL_SUCCESS~. - - # Header - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_exit_code -qmckl_context_update_error(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function_name, - const char* message); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -qmckl_exit_code -qmckl_context_update_error(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function_name, - const char* message) -{ - /* Passing a function name and a message is mandatory. */ - assert (function_name != NULL); - assert (message != NULL); - - /* Exit codes are assumed valid. */ - assert (exit_code >= 0); - assert (exit_code != QMCKL_SUCCESS); - assert (exit_code < QMCKL_INVALID_EXIT_CODE); - - qmckl_lock(context); - - /* The context is assumed to exist. */ - assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT); - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - assert (ctx != NULL); /* Impossible because the context is valid. */ - - if (ctx->error != NULL) { - free(ctx->error); - ctx->error = NULL; - } - - qmckl_error_struct* error = - (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); - error->exit_code = exit_code; - strncpy(error->function, function_name, QMCKL_MAX_FUN_LEN); - strncpy(error->message, message, QMCKL_MAX_MSG_LEN); - - ctx->error = error; - - qmckl_unlock(context); - - return QMCKL_SUCCESS; -} - #+end_src - - The ~qmckl_context_set_error~ function returns a new context with - the error domain updated. - - # Header - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_context -qmckl_context_set_error(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function_name, - const char* message); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -qmckl_context -qmckl_context_set_error(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function_name, - const char* message) -{ - /* Passing a function name and a message is mandatory. */ - assert (function_name != NULL); - assert (message != NULL); - - /* Exit codes are assumed valid. */ - assert (exit_code >= 0); - assert (exit_code != QMCKL_SUCCESS); - assert (exit_code < QMCKL_INVALID_EXIT_CODE); - - /* The context is assumed to be valid */ - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) - return QMCKL_NULL_CONTEXT; - - qmckl_context new_context = qmckl_context_copy(context); - - /* Should be impossible because the context is valid */ - assert (new_context != QMCKL_NULL_CONTEXT); - - if (qmckl_context_update_error(new_context, - exit_code, - function_name, - message) != QMCKL_SUCCESS) { - return context; - } - - return new_context; -} - #+end_src - - - To make a function fail, the ~qmckl_failwith~ function should be - called, such that information about the failure is stored in - the context. The desired exit code is given as an argument, as - well as the name of the function and an error message. The return - code of the function is the desired return code. - - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_exit_code qmckl_failwith(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function, - const char* message) ; - #+end_src - - #+begin_src c :comments org :tangle (eval c) -qmckl_exit_code qmckl_failwith(qmckl_context context, - const qmckl_exit_code exit_code, - const char* function, - const char* message) { - - assert (exit_code > 0); - assert (exit_code < QMCKL_INVALID_EXIT_CODE); - assert (function != NULL); - assert (message != NULL); - assert (strlen(function) < QMCKL_MAX_FUN_LEN); - assert (strlen(message) < QMCKL_MAX_MSG_LEN); - - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) - return QMCKL_NULL_CONTEXT; - - const qmckl_exit_code rc = - qmckl_context_update_error(context, exit_code, function, message); - - assert (rc == QMCKL_SUCCESS); - - return exit_code; -} - - #+end_src - - For example, this function can be used as - #+begin_src c :tangle no -if (x < 0) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_function", - "Expected x >= 0"); - } - #+end_src - - # To decode the error messages, ~qmckl_strerror~ converts an - # error code into a string. - -* Control of the numerical precision - - Controlling numerical precision enables optimizations. Here, the - default parameters determining the target numerical precision and - range are defined. - - #+NAME: table-precision - | ~QMCKL_DEFAULT_PRECISION~ | 53 | - | ~QMCKL_DEFAULT_RANGE~ | 11 | - - # We need to force Emacs not to indent the Python code: - # -*- org-src-preserve-indentation: t - -#+begin_src python :var table=table-precision :results drawer :exports result -""" This script generates the C and Fortran constants from the org-mode table. -""" - -result = [ "#+begin_src c :comments org :tangle (eval h)" ] -for (text, code) in table: - text=text.replace("~","") - result += [ f"#define {text:30s} {code:d}" ] -result += [ "#+end_src" ] - -result += [ "" ] - -result += [ "#+begin_src f90 :comments org :tangle (eval fh) :exports none" ] -for (text, code) in table: - text=text.replace("~","") - result += [ f" integer, parameter :: {text:30s} = {code:d}" ] -result += [ "#+end_src" ] - -return '\n'.join(result) - -#+end_src - -#+RESULTS: -:results: -#+begin_src c :comments org :tangle (eval h) -#define QMCKL_DEFAULT_PRECISION 53 -#define QMCKL_DEFAULT_RANGE 11 -#+end_src - -#+begin_src f90 :comments org :tangle (eval fh) :exports none - integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 - integer, parameter :: QMCKL_DEFAULT_RANGE = 11 -#+end_src -:end: - - #+NAME: qmckl_precision_struct - #+begin_src c :comments org :tangle no -typedef struct qmckl_precision_struct { - int precision; - int range; -} qmckl_precision_struct; - #+end_src - - The following functions set and get the required precision and - range. ~precision~ is an integer between 2 and 53, and ~range~ is an - integer between 2 and 11. - - The setter functions functions return a new context as a 64-bit - integer. The getter functions return the value, as a 32-bit - integer. The update functions return ~QMCKL_SUCCESS~ or - ~QMCKL_FAILURE~. - -** Precision - ~qmckl_context_update_precision~ modifies the parameter for the - numerical precision in a context. If the context doesn't have any - precision set yet, the default values are used. - - # Header - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { - - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) - return QMCKL_INVALID_CONTEXT; - - if (precision < 2) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_context_update_precision", - "precision < 2"); - } - - if (precision > 53) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_context_update_precision", - "precision > 53"); - } - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - - /* This should be always true */ - assert (ctx != NULL); - - qmckl_lock(context); - - if (ctx->fp == NULL) { - - ctx->fp = (qmckl_precision_struct*) - qmckl_malloc(context, sizeof(qmckl_precision_struct)); - - if (ctx->fp == NULL) { - return qmckl_failwith(context, - QMCKL_ALLOCATION_FAILED, - "qmckl_context_update_precision", - "ctx->fp"); - } - ctx->fp->range = QMCKL_DEFAULT_RANGE; - } - - ctx->fp->precision = precision; - - qmckl_unlock(context); - - return QMCKL_SUCCESS; -} - #+end_src - - # Fortran interface - - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: precision - end function qmckl_context_update_precision - end interface - #+end_src - - ~qmckl_context_set_precision~ returns a copy of the context with a - different precision parameter. - - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return 0; - - if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0; - - return new_context; -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: precision - end function qmckl_context_set_precision - end interface - #+end_src - - ~qmckl_context_get_precision~ returns the value of the numerical precision in the context. - - #+begin_src c :comments org :tangle (eval h) :exports none -int32_t qmckl_context_get_precision(const qmckl_context context); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -int qmckl_context_get_precision(const qmckl_context context) { - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return qmckl_failwith(context, - QMCKL_INVALID_CONTEXT, - "qmckl_context_get_precision", - ""); - } - - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx->fp != NULL) - return ctx->fp->precision; - else - return QMCKL_DEFAULT_PRECISION; -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_precision - end interface - #+end_src - -** Range - - ~qmckl_context_update_range~ modifies the parameter for the numerical range in a given context. - - # Header - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { - - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) - return QMCKL_INVALID_CONTEXT; - - if (range < 2) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_context_update_range", - "range < 2"); - } - - if (range > 11) { - return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, - "qmckl_context_update_range", - "range > 11"); - } - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - - /* This should be always true */ - assert (ctx != NULL); - - qmckl_lock(context); - - if (ctx->fp == NULL) { - - ctx->fp = (qmckl_precision_struct*) - qmckl_malloc(context, sizeof(qmckl_precision_struct)); - - if (ctx->fp == NULL) { - return qmckl_failwith(context, - QMCKL_ALLOCATION_FAILED, - "qmckl_context_update_range", - "ctx->fp"); - } - - ctx->fp->precision = QMCKL_DEFAULT_PRECISION; - } - - ctx->fp->range = range; - - qmckl_unlock(context); - - return QMCKL_SUCCESS; -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: range - end function qmckl_context_update_range - end interface - #+end_src - - ~qmckl_context_set_range~ returns a copy of the context with a different precision parameter. - - #+begin_src c :comments org :tangle (eval h) :exports none -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); - #+end_src - - # Source - - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return 0; - - if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0; - - return new_context; -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: range - end function qmckl_context_set_range - end interface - #+end_src - - ~qmckl_context_get_range~ returns the value of the numerical range in the context. - - #+begin_src c :comments org :tangle (eval h) :exports none -int32_t qmckl_context_get_range(const qmckl_context context); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -int qmckl_context_get_range(const qmckl_context context) { - if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return qmckl_failwith(context, - QMCKL_INVALID_CONTEXT, - "qmckl_context_get_range", - ""); - } - - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx->fp != NULL) - return ctx->fp->range; - else - return QMCKL_DEFAULT_RANGE; -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none - interface - integer (c_int32_t) function qmckl_context_get_range(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_range - end interface - #+end_src - -** Helper functions - - ~qmckl_context_get_epsilon~ returns $\epsilon = 2^{1-n}$ where ~n~ is the precision. - - #+begin_src c :comments org :tangle (eval h) :exports none -double qmckl_context_get_epsilon(const qmckl_context context); - #+end_src - - # Source - #+begin_src c :tangle (eval c) -double qmckl_context_get_epsilon(const qmckl_context context) { - const int precision = qmckl_context_get_precision(context); - return 1. / (double) (1L << (precision-1)); -} - #+end_src - - # Fortran interface - #+begin_src f90 :tangle (eval fh) :exports none - interface - real (c_double) function qmckl_context_get_epsilon(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_epsilon - end interface - #+end_src - - -* TODO Basis set - - For H_2 with the following basis set, - - #+BEGIN_EXAMPLE -HYDROGEN -S 5 -1 3.387000E+01 6.068000E-03 -2 5.095000E+00 4.530800E-02 -3 1.159000E+00 2.028220E-01 -4 3.258000E-01 5.039030E-01 -5 1.027000E-01 3.834210E-01 -S 1 -1 3.258000E-01 1.000000E+00 -S 1 -1 1.027000E-01 1.000000E+00 -P 1 -1 1.407000E+00 1.000000E+00 -P 1 -1 3.880000E-01 1.000000E+00 -D 1 -1 1.057000E+00 1.0000000 - #+END_EXAMPLE - - we have: - - #+BEGIN_EXAMPLE -type = 'G' -shell_num = 12 -prim_num = 20 -SHELL_CENTER = [1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2] -SHELL_ANG_MOM = ['S', 'S', 'S', 'P', 'P', 'D', 'S', 'S', 'S', 'P', 'P', 'D'] -SHELL_PRIM_NUM = [5, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1] -prim_index = [1, 6, 7, 8, 9, 10, 11, 16, 17, 18, 19, 20] -EXPONENT = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, - 1.407, 0.388, 1.057, 33.87, 5.095, 1.159, 0.3258, 0.1027, - 0.3258, 0.1027, 1.407, 0.388, 1.057] -COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, - 1.0, 1.0, 1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822, - 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0] - #+END_EXAMPLE - -** Data structure - - #+NAME: qmckl_ao_basis_struct - #+begin_src c :comments org :tangle no -typedef struct qmckl_ao_basis_struct { - - int64_t shell_num; - int64_t prim_num; - int64_t * shell_center; - int32_t * shell_ang_mom; - double * shell_factor; - double * exponent ; - double * coefficient ; - int64_t * shell_prim_num; - char type; - -} qmckl_ao_basis_struct; - #+end_src - -** ~qmckl_context_update_ao_basis~ - - Updates the data describing the AO basis set into the context. - - | ~type~ | Gaussian or Slater | - | ~shell_num~ | Number of shells | - | ~prim_num~ | Total number of primitives | - | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | - | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | - | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | - | ~EXPONENT(prim_num)~ | Array of exponents | - | ~COEFFICIENT(prim_num)~ | Array of coefficients | - - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code -qmckl_context_update_ao_basis(qmckl_context context , - const char type , - const int64_t shell_num , - const int64_t prim_num , - const int64_t * SHELL_CENTER , - const int32_t * SHELL_ANG_MOM , - const double * SHELL_FACTOR , - const int64_t * SHELL_PRIM_NUM , - const int64_t * SHELL_PRIM_INDEX, - const double * EXPONENT , - const double * COEFFICIENT); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_exit_code -qmckl_context_update_ao_basis(qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, - const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, - const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, - const int64_t * SHELL_PRIM_INDEX, - const double * EXPONENT , const double * COEFFICIENT) -{ - - int64_t i; - - /* Check input */ - - if (type != 'G' && type != 'S') return QMCKL_FAILURE; - if (shell_num <= 0) return QMCKL_FAILURE; - if (prim_num <= 0) return QMCKL_FAILURE; - if (prim_num < shell_num) return QMCKL_FAILURE; - - for (i=0 ; ishell_center == NULL); - basis->shell_center = (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); - if (basis->shell_center == NULL) { - qmckl_free(context, basis); - basis = NULL; - return QMCKL_FAILURE; - } - - assert (basis->shell_ang_mom == NULL); - basis->shell_ang_mom = (int32_t*) qmckl_malloc (context, shell_num * sizeof(int32_t)); - if (basis->shell_ang_mom == NULL) { - qmckl_free(context, basis->shell_center); - basis->shell_center = NULL; - qmckl_free(context, basis); - basis = NULL; - return QMCKL_FAILURE; - } - - assert (basis->shell_prim_num == NULL); - basis->shell_prim_num= (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); - if (basis->shell_prim_num == NULL) { - qmckl_free(context, basis->shell_ang_mom); - basis->shell_ang_mom = NULL; - qmckl_free(context, basis->shell_center); - basis->shell_center = NULL; - qmckl_free(context, basis); - basis = NULL; - return QMCKL_FAILURE; - } - - assert (basis->shell_factor == NULL); - basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double)); - if (basis->shell_factor == NULL) { - qmckl_free(context, basis->shell_prim_num); - basis->shell_prim_num = NULL; - qmckl_free(context, basis->shell_ang_mom); - basis->shell_ang_mom = NULL; - qmckl_free(context, basis->shell_center); - basis->shell_center = NULL; - qmckl_free(context, basis); - basis = NULL; - return QMCKL_FAILURE; - } - - assert (basis->exponent == NULL); - basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double)); - if (basis->exponent == NULL) { - qmckl_free(context, basis->shell_factor); - basis->shell_factor = NULL; - qmckl_free(context, basis->shell_prim_num); - basis->shell_prim_num = NULL; - qmckl_free(context, basis->shell_ang_mom); - basis->shell_ang_mom = NULL; - qmckl_free(context, basis->shell_center); - basis->shell_center = NULL; - qmckl_free(context, basis); - basis = NULL; - return QMCKL_FAILURE; - } - - assert (basis->coefficient == NULL); - basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double)); - if (basis->coefficient == NULL) { - qmckl_free(context, basis->exponent); - basis->exponent = NULL; - qmckl_free(context, basis->shell_factor); - basis->shell_factor = NULL; - qmckl_free(context, basis->shell_prim_num); - basis->shell_prim_num = NULL; - qmckl_free(context, basis->shell_ang_mom); - basis->shell_ang_mom = NULL; - qmckl_free(context, basis->shell_center); - basis->shell_center = NULL; - qmckl_free(context, basis); - basis = NULL; - return QMCKL_FAILURE; - } - - - /* Assign data */ - - basis->type = type; - basis->shell_num = shell_num; - basis->prim_num = prim_num; - - for (i=0 ; ishell_center [i] = SHELL_CENTER [i]; - basis->shell_ang_mom [i] = SHELL_ANG_MOM [i]; - basis->shell_prim_num[i] = SHELL_PRIM_NUM[i]; - basis->shell_factor [i] = SHELL_FACTOR [i]; - } - - for (i=0 ; iexponent [i] = EXPONENT[i]; - basis->coefficient[i] = COEFFICIENT[i]; - } - - ctx->ao_basis = basis; - return QMCKL_SUCCESS; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_update_ao_basis(context, & - typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & - SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, COEFFICIENT) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - character(c_char) , intent(in), value :: typ - integer (c_int64_t), intent(in), value :: shell_num - integer (c_int64_t), intent(in), value :: prim_num - integer (c_int64_t), intent(in) :: SHELL_CENTER(shell_num) - integer (c_int32_t), intent(in) :: SHELL_ANG_MOM(shell_num) - double precision , intent(in) :: SHELL_FACTOR(shell_num) - integer (c_int64_t), intent(in) :: SHELL_PRIM_NUM(shell_num) - integer (c_int64_t), intent(in) :: SHELL_PRIM_INDEX(shell_num) - double precision , intent(in) :: EXPONENT(prim_num) - double precision , intent(in) :: COEFFICIENT(prim_num) - end function qmckl_context_update_ao_basis - end interface - #+end_src - -*** TODO Test - -** ~qmckl_context_set_ao_basis~ - - Sets the data describing the AO basis set into the context. - - | ~type~ | Gaussian or Slater | - | ~shell_num~ | Number of shells | - | ~prim_num~ | Total number of primitives | - | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | - | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | - | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | - | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | - | ~EXPONENT(prim_num)~ | Array of exponents | - | ~COEFFICIENT(prim_num)~ | Array of coefficients | - - #+begin_src c :comments org :tangle (eval h) -qmckl_context -qmckl_context_set_ao_basis(const qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, - const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, - const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, - const int64_t * SHELL_PRIM_INDEX, - const double * EXPONENT , const double * COEFFICIENT); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_context -qmckl_context_set_ao_basis(const qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, - const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, - const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, - const int64_t * SHELL_PRIM_INDEX, - const double * EXPONENT , const double * COEFFICIENT) -{ - - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return 0; - - if (qmckl_context_update_ao_basis(new_context, type, shell_num, prim_num, - SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, - SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, - COEFFICIENT - ) == QMCKL_FAILURE) - return 0; - - return new_context; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int64_t) function qmckl_context_set_ao_basis(context, & - typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & - SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, COEFFICIENT) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - character(c_char) , intent(in), value :: typ - integer (c_int64_t), intent(in), value :: shell_num - integer (c_int64_t), intent(in), value :: prim_num - integer (c_int64_t), intent(in) :: SHELL_CENTER(shell_num) - integer (c_int32_t), intent(in) :: SHELL_ANG_MOM(shell_num) - double precision , intent(in) :: SHELL_FACTOR(shell_num) - integer (c_int64_t), intent(in) :: SHELL_PRIM_NUM(shell_num) - integer (c_int64_t), intent(in) :: SHELL_PRIM_INDEX(shell_num) - double precision , intent(in) :: EXPONENT(prim_num) - double precision , intent(in) :: COEFFICIENT(prim_num) - end function qmckl_context_set_ao_basis - end interface - #+end_src - -*** TODO Test - * End of files :noexport: - #+begin_src c :comments link :tangle (eval h_private) + #+begin_src c :comments link :tangle (eval h_private_type) #endif #+end_src @@ -1482,32 +416,4 @@ return MUNIT_OK; } #+end_src -*** Compute file names - #+begin_src emacs-lisp -; The following is required to compute the file names - -(setq pwd (file-name-directory buffer-file-name)) -(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) -(setq f (concat pwd name "_f.f90")) -(setq fh (concat pwd name "_fh.f90")) -(setq c (concat pwd name ".c")) -(setq h (concat name ".h")) -(setq h_private (concat name "_private.h")) -(setq c_test (concat pwd "test_" name ".c")) -(setq f_test (concat pwd "test_" name "_f.f90")) - -; Minted -(require 'ox-latex) -(setq org-latex-listings 'minted) -(add-to-list 'org-latex-packages-alist '("" "listings")) -(add-to-list 'org-latex-packages-alist '("" "color")) - - #+end_src - - #+RESULTS: - | | color | - | | listings | - -# -*- mode: org -*- -# vim: syntax=c - + diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index b7e264b..cad3809 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -30,7 +30,7 @@ MunitResult test_<>() { :PROPERTIES: :Name: qmckl_distance_sq :CRetType: qmckl_exit_code - :FRetType: integer + :FRetType: qmckl_exit_code :END: ~qmckl_distance_sq~ computes the matrix of the squared distances @@ -72,7 +72,7 @@ MunitResult test_<>() { #+CALL: generate_c_header(table=qmckl_distance_sq_args,rettyp=get_value("CRetType"),fname=get_value("Name")) #+RESULTS: - #+begin_src c :tangle (eval h) :comments org + #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_distance_sq ( const qmckl_context context, const char transa, @@ -227,14 +227,15 @@ end function qmckl_distance_sq_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_distance_sq & + integer (qmckl_exit_code) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) result(info) use, intrinsic :: iso_c_binding + import implicit none - integer (c_int64_t) , intent(in) :: context + integer (qmckl_context), intent(in) :: context character , intent(in) :: transa character , intent(in) :: transb integer (c_int64_t) , intent(in) :: m @@ -246,7 +247,7 @@ end function qmckl_distance_sq_f real (c_double ) , intent(out) :: C(ldc,n) integer (c_int64_t) , intent(in) :: ldc - integer(c_int32_t), external :: qmckl_distance_sq_f + integer (qmckl_exit_code), external :: qmckl_distance_sq_f info = qmckl_distance_sq_f & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) @@ -258,13 +259,14 @@ end function qmckl_distance_sq_f #+RESULTS: #+begin_src f90 :tangle (eval fh) :comments org :exports none interface - integer(c_int32_t) function qmckl_distance_sq & + integer (qmckl_exit_code) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) use, intrinsic :: iso_c_binding + import implicit none - integer (c_int64_t) , intent(in) :: context + integer (qmckl_context), intent(in) :: context character , intent(in) :: transa character , intent(in) :: transb integer (c_int64_t) , intent(in) :: m @@ -282,10 +284,10 @@ end function qmckl_distance_sq_f *** Test :noexport: #+begin_src f90 :tangle (eval f_test) -integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) +integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C) use qmckl implicit none - integer(c_int64_t), intent(in), value :: context + integer(qmckl_context), intent(in), value :: context double precision, allocatable :: A(:,:), B(:,:), C(:,:) integer*8 :: m, n, LDA, LDB, LDC diff --git a/src/qmckl_error.org b/src/qmckl_error.org index 4f52854..b1fc1dc 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -8,9 +8,24 @@ (file-name-nondirectory (substring buffer-file-name 0 -4)) #+end_src + #+begin_src c :tangle (eval h_private_type) +#ifndef QMCKL_ERROR_HPT +#define QMCKL_ERROR_HPT + #+end_src + #+begin_src c :tangle (eval c) #include -#include "qmckl_error.h" +#include +#include +#include +#include + +#include "qmckl_error_type.h" +#include "qmckl_context_private_type.h" +#include "qmckl_context_type.h" + +#include "qmckl_context_func.h" +#include "qmckl_error_func.h" #+end_src #+begin_src c :tangle (eval c_test) :noweb yes @@ -19,9 +34,6 @@ MunitResult test_<>() { #+end_src - #+begin_src c :comments org :tangle (eval h) -#include -#include #+end_src * @@ -35,10 +47,15 @@ MunitResult test_<>() { All the functions return with an exit code, defined as #+NAME: type-exit-code - #+begin_src c :comments org :tangle (eval h) + #+begin_src c :comments org :tangle (eval h_type) typedef int32_t qmckl_exit_code; #+end_src + + #+begin_src f90 :comments org :tangle (eval fh_type) :exports none + integer , parameter :: qmckl_exit_code = c_int32_t + #+end_src + The exit code returns the completion status of the function to the calling program. When a function call completed successfully, ~QMCKL_SUCCESS~ is returned. If one of the functions of @@ -76,18 +93,18 @@ typedef int32_t qmckl_exit_code; codes from the org-mode table. """ -result = [ "#+begin_src c :comments org :tangle (eval h) :exports none" ] +result = [ "#+begin_src c :comments org :tangle (eval h_type) :exports none" ] for (text, code,_) in table: text=text.replace("~","") - result += [ f"#define {text:30s} {code:d}" ] + result += [ f"#define {text:30s} ((qmckl_exit_code) {code:d})" ] result += [ "#+end_src" ] result += [ "" ] -result += [ "#+begin_src f90 :comments org :tangle (eval fh) :exports none" ] +result += [ "#+begin_src f90 :comments org :tangle (eval fh_type) :exports none" ] for (text, code,_) in table: text=text.replace("~","") - result += [ f" integer, parameter :: {text:30s} = {code:d}" ] + result += [ f" integer(qmckl_exit_code), parameter :: {text:30s} = {code:d}" ] result += [ "#+end_src" ] return '\n'.join(result) @@ -96,44 +113,44 @@ return '\n'.join(result) #+RESULTS: :results: - #+begin_src c :comments org :tangle (eval h) :exports none - #define QMCKL_SUCCESS 0 - #define QMCKL_INVALID_ARG_1 1 - #define QMCKL_INVALID_ARG_2 2 - #define QMCKL_INVALID_ARG_3 3 - #define QMCKL_INVALID_ARG_4 4 - #define QMCKL_INVALID_ARG_5 5 - #define QMCKL_INVALID_ARG_6 6 - #define QMCKL_INVALID_ARG_7 7 - #define QMCKL_INVALID_ARG_8 8 - #define QMCKL_INVALID_ARG_9 9 - #define QMCKL_INVALID_ARG_10 10 - #define QMCKL_FAILURE 101 - #define QMCKL_ERRNO 102 - #define QMCKL_INVALID_CONTEXT 103 - #define QMCKL_ALLOCATION_FAILED 104 - #define QMCKL_DEALLOCATION_FAILED 105 - #define QMCKL_INVALID_EXIT_CODE 106 + #+begin_src c :comments org :tangle (eval h_type) :exports none + #define QMCKL_SUCCESS ((qmckl_exit_code) 0) + #define QMCKL_INVALID_ARG_1 ((qmckl_exit_code) 1) + #define QMCKL_INVALID_ARG_2 ((qmckl_exit_code) 2) + #define QMCKL_INVALID_ARG_3 ((qmckl_exit_code) 3) + #define QMCKL_INVALID_ARG_4 ((qmckl_exit_code) 4) + #define QMCKL_INVALID_ARG_5 ((qmckl_exit_code) 5) + #define QMCKL_INVALID_ARG_6 ((qmckl_exit_code) 6) + #define QMCKL_INVALID_ARG_7 ((qmckl_exit_code) 7) + #define QMCKL_INVALID_ARG_8 ((qmckl_exit_code) 8) + #define QMCKL_INVALID_ARG_9 ((qmckl_exit_code) 9) + #define QMCKL_INVALID_ARG_10 ((qmckl_exit_code) 10) + #define QMCKL_FAILURE ((qmckl_exit_code) 101) + #define QMCKL_ERRNO ((qmckl_exit_code) 102) + #define QMCKL_INVALID_CONTEXT ((qmckl_exit_code) 103) + #define QMCKL_ALLOCATION_FAILED ((qmckl_exit_code) 104) + #define QMCKL_DEALLOCATION_FAILED ((qmckl_exit_code) 105) + #define QMCKL_INVALID_EXIT_CODE ((qmckl_exit_code) 106) #+end_src - #+begin_src f90 :comments org :tangle (eval fh) :exports none - integer, parameter :: QMCKL_SUCCESS = 0 - integer, parameter :: QMCKL_INVALID_ARG_1 = 1 - integer, parameter :: QMCKL_INVALID_ARG_2 = 2 - integer, parameter :: QMCKL_INVALID_ARG_3 = 3 - integer, parameter :: QMCKL_INVALID_ARG_4 = 4 - integer, parameter :: QMCKL_INVALID_ARG_5 = 5 - integer, parameter :: QMCKL_INVALID_ARG_6 = 6 - integer, parameter :: QMCKL_INVALID_ARG_7 = 7 - integer, parameter :: QMCKL_INVALID_ARG_8 = 8 - integer, parameter :: QMCKL_INVALID_ARG_9 = 9 - integer, parameter :: QMCKL_INVALID_ARG_10 = 10 - integer, parameter :: QMCKL_FAILURE = 101 - integer, parameter :: QMCKL_ERRNO = 102 - integer, parameter :: QMCKL_INVALID_CONTEXT = 103 - integer, parameter :: QMCKL_ALLOCATION_FAILED = 104 - integer, parameter :: QMCKL_DEALLOCATION_FAILED = 105 - integer, parameter :: QMCKL_INVALID_EXIT_CODE = 106 + #+begin_src f90 :comments org :tangle (eval fh_type) :exports none + integer(qmckl_exit_code), parameter :: QMCKL_SUCCESS = 0 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_1 = 1 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_2 = 2 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_3 = 3 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_4 = 4 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_5 = 5 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_6 = 6 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_7 = 7 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_8 = 8 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_9 = 9 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_10 = 10 + integer(qmckl_exit_code), parameter :: QMCKL_FAILURE = 101 + integer(qmckl_exit_code), parameter :: QMCKL_ERRNO = 102 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_CONTEXT = 103 + integer(qmckl_exit_code), parameter :: QMCKL_ALLOCATION_FAILED = 104 + integer(qmckl_exit_code), parameter :: QMCKL_DEALLOCATION_FAILED = 105 + integer(qmckl_exit_code), parameter :: QMCKL_INVALID_EXIT_CODE = 106 #+end_src :end: @@ -144,7 +161,7 @@ return '\n'.join(result) #+NAME: MAX_STRING_LENGTH : 128 - #+begin_src c :comments org :tangle (eval h) :exports none :noweb yes + #+begin_src c :comments org :tangle (eval h_func) :exports none :noweb yes const char* qmckl_string_of_error(const qmckl_exit_code error); void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<>]); #+end_src @@ -183,25 +200,157 @@ void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<>) end subroutine qmckl_string_of_error end interface #+end_src +* Data structure in context + + The strings are declared with a maximum fixed size to avoid + dynamic memory allocation. + + #+begin_src c :comments org :tangle (eval h_private_type) +#define QMCKL_MAX_FUN_LEN 256 +#define QMCKL_MAX_MSG_LEN 1024 + +typedef struct qmckl_error_struct { + + qmckl_exit_code exit_code; + char function[QMCKL_MAX_FUN_LEN]; + char message [QMCKL_MAX_MSG_LEN]; + +} qmckl_error_struct; + #+end_src + +* Updating errors in the context + + The error is updated in the context using + ~qmckl_set_error~. + When the error is set in the context, it is mandatory to specify + from which function the error is triggered, and a message + explaining the error. The exit code can't be ~QMCKL_SUCCESS~. + + # Header + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code +qmckl_set_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_exit_code +qmckl_set_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message) +{ + /* Passing a function name and a message is mandatory. */ + assert (function_name != NULL); + assert (message != NULL); + + /* Exit codes are assumed valid. */ + assert (exit_code >= 0); + assert (exit_code != QMCKL_SUCCESS); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + + /* The context is assumed to exist. */ + assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT); + + qmckl_lock(context); + { + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); /* Impossible because the context is valid. */ + + ctx->error.exit_code = exit_code; + strncpy(ctx->error.function, function_name, QMCKL_MAX_FUN_LEN); + strncpy(ctx->error.message, message, QMCKL_MAX_MSG_LEN); + } + qmckl_unlock(context); + + return QMCKL_SUCCESS; +} + #+end_src + +* Failing + + To make a function fail, the ~qmckl_failwith~ function should be + called, such that information about the failure is stored in + the context. The desired exit code is given as an argument, as + well as the name of the function and an error message. The return + code of the function is the desired return code. + + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code qmckl_failwith(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function, + const char* message) ; + #+end_src + + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_failwith(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function, + const char* message) { + + assert (exit_code > 0); + assert (exit_code < QMCKL_INVALID_EXIT_CODE); + assert (function != NULL); + assert (message != NULL); + assert (strlen(function) < QMCKL_MAX_FUN_LEN); + assert (strlen(message) < QMCKL_MAX_MSG_LEN); + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_NULL_CONTEXT; + + const qmckl_exit_code rc = + qmckl_set_error(context, exit_code, function, message); + + assert (rc == QMCKL_SUCCESS); + + return exit_code; +} + + #+end_src + + For example, this function can be used as + #+begin_src c :tangle no +if (x < 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_function", + "Expected x >= 0"); + } + #+end_src + +* TODO Decoding errors + + To decode the error messages, ~qmckl_strerror~ converts an + error code into a string. + * End of files :noexport: + #+begin_src c :comments link :tangle (eval h_private_type) +#endif + #+end_src + + ** Test - #+begin_src c :comments link :tangle (eval c_test) + #+begin_src c :comments link :tangle (eval c_test) return MUNIT_OK; } - #+end_src + #+end_src -# -*- mode: org -*- -# vim: syntax=c + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 3f3a4e3..5016212 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -17,10 +17,13 @@ optimized libraries to fine-tune the memory allocation. #include #include -#include "qmckl_error.h" -#include "qmckl_context.h" -#include "qmckl_context_private.h" -#include "qmckl_memory.h" +#include "qmckl_error_type.h" +#include "qmckl_context_type.h" +#include "qmckl_context_private_type.h" + +#include "qmckl_memory_func.h" +#include "qmckl_context_func.h" +#include "qmckl_error_func.h" #+end_src #+begin_src c :tangle (eval c_test) :noweb yes @@ -44,7 +47,7 @@ MunitResult test_<>() { If the allocation failed, the ~NULL~ pointer is returned. # Header - #+begin_src c :tangle (eval h) :noexport + #+begin_src c :tangle (eval h_func) :noexport void* qmckl_malloc(qmckl_context context, const size_t size); #+end_src @@ -56,25 +59,29 @@ void* qmckl_malloc(qmckl_context context, #+begin_src c :tangle (eval c) void* qmckl_malloc(qmckl_context context, const size_t size) { + assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT); void * pointer = calloc(size, (size_t) 1); + /* if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { qmckl_exit_code rc; rc = qmckl_context_append_memory(context, pointer, size); assert (rc == QMCKL_SUCCESS); } + */ return pointer; } #+end_src # Fortran interface - #+begin_src f90 :tangle (eval fh) :noexport + #+begin_src f90 :tangle (eval fh_func) :noexport interface type (c_ptr) function qmckl_malloc (context, size) bind(C) use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int64_t), intent(in), value :: size + import + integer (qmckl_context), intent(in), value :: context + integer (c_int64_t) , intent(in), value :: size end function qmckl_malloc end interface #+end_src @@ -95,16 +102,17 @@ a[2] = 3; munit_assert_int(a[2], ==, 3); case some important information has been stored related to memory allocation and needs to be updated. - #+begin_src c :tangle (eval h) + #+begin_src c :tangle (eval h_func) qmckl_exit_code qmckl_free(qmckl_context context, void *ptr); #+end_src - #+begin_src f90 :tangle (eval fh) + #+begin_src f90 :tangle (eval fh_func) interface - integer (c_int32_t) function qmckl_free (context, ptr) bind(C) + integer (qmckl_exit_code) function qmckl_free (context, ptr) bind(C) use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context + import + integer (qmckl_context), intent(in), value :: context type (c_ptr), intent(in), value :: ptr end function qmckl_free end interface @@ -122,10 +130,12 @@ qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { "NULL pointer"); } + /* qmckl_exit_code rc; rc = qmckl_context_remove_memory(context, ptr); assert (rc == QMCKL_SUCCESS); + */ } free(ptr); return QMCKL_SUCCESS; diff --git a/src/qmckl_numprec.org b/src/qmckl_numprec.org new file mode 100644 index 0000000..8349529 --- /dev/null +++ b/src/qmckl_numprec.org @@ -0,0 +1,328 @@ +#+TITLE: Numerical precision +#+SETUPFILE: ../docs/theme.setup + +* Headers :noexport: + + #+NAME: filename + #+begin_src elisp tangle: no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src + + + #+begin_src c :tangle (eval c_test) :noweb yes +#include "qmckl.h" +#include "munit.h" +MunitResult test_<>() { + #+end_src + + #+begin_src c :tangle (eval h_private_type) +#ifndef QMCKL_NUMPREC_HPT +#define QMCKL_NUMPREC_HPT + +#include + #+end_src + + #+begin_src c :tangle (eval c) +#include +#include +#include +#include +#include + +#include "qmckl_error_type.h" +#include "qmckl_context_type.h" +#include "qmckl_context_private_type.h" +#include "qmckl_numprec_type.h" + +#include "qmckl_numprec_func.h" +#include "qmckl_error_func.h" +#include "qmckl_context_func.h" + + #+end_src + +* Control of the numerical precision + + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. Following the IEEE Standard for Floating-Point + Arithmetic (IEEE 754), + /precision/ refers to the number of significand bits and /range/ + refers to the number of exponent bits. + + #+NAME: table-precision + | ~QMCKL_DEFAULT_PRECISION~ | 53 | + | ~QMCKL_DEFAULT_RANGE~ | 11 | + + # We need to force Emacs not to indent the Python code: + # -*- org-src-preserve-indentation: t + +#+begin_src python :var table=table-precision :results drawer :exports results +""" This script generates the C and Fortran constants from the org-mode table. +""" + +result = [ "#+begin_src c :comments org :tangle (eval h_type)" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f"#define {text:30s} {code:d}" ] +result += [ "#+end_src" ] + +result += [ "" ] + +result += [ "#+begin_src f90 :comments org :tangle (eval fh_func) :exports none" ] +for (text, code) in table: + text=text.replace("~","") + result += [ f" integer, parameter :: {text:30s} = {code:d}" ] +result += [ "#+end_src" ] + +return '\n'.join(result) + +#+end_src + +#+RESULTS: +:results: +#+begin_src c :comments org :tangle (eval h_type) +#define QMCKL_DEFAULT_PRECISION 53 +#define QMCKL_DEFAULT_RANGE 11 +#+end_src + +#+begin_src f90 :comments org :tangle (eval fh_func) :exports none + integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 + integer, parameter :: QMCKL_DEFAULT_RANGE = 11 +#+end_src +:end: + + #+begin_src c :comments org :tangle (eval h_private_type) +typedef struct qmckl_numprec_struct { + uint32_t precision; + uint32_t range; +} qmckl_numprec_struct; + #+end_src + + The following functions set and get the required precision and + range. ~precision~ is an integer between 2 and 53, and ~range~ is an + integer between 2 and 11. + + The setter functions functions return a new context as a 64-bit + integer. The getter functions return the value, as a 32-bit + integer. The update functions return ~QMCKL_SUCCESS~ or + ~QMCKL_FAILURE~. + +* Precision + ~qmckl_context_set_numprec_precision~ modifies the parameter for the + numerical precision in the context. + + # Header + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code qmckl_set_numprec_precision(const qmckl_context context, const int precision); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_exit_code qmckl_set_numprec_precision(const qmckl_context context, const int precision) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_INVALID_CONTEXT; + + if (precision < 2) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_update_numprec_precision", + "precision < 2"); + } + + if (precision > 53) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_update_numprec_precision", + "precision > 53"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + + /* This should be always true because the context is valid */ + assert (ctx != NULL); + + qmckl_lock(context); + { + ctx->numprec.precision = (uint32_t) precision; + } + qmckl_unlock(context); + + return QMCKL_SUCCESS; +} + #+end_src + + # Fortran interface + + #+begin_src f90 :tangle (eval fh_func) + interface + integer (qmckl_exit_code) function qmckl_set_numprec_precision(context, precision) bind(C) + use, intrinsic :: iso_c_binding + import + integer (qmckl_context), intent(in), value :: context + integer (c_int32_t), intent(in), value :: precision + end function qmckl_set_numprec_precision + end interface + #+end_src + + ~qmckl_get_numprec_precision~ returns the value of the numerical precision in the context. + + #+begin_src c :comments org :tangle (eval h_func) :exports none +int32_t qmckl_get_numprec_precision(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +int qmckl_get_numprec_precision(const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith(context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_numprec_precision", + ""); + } + + const qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + return ctx->numprec.precision; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh_func) + interface + integer (qmckl_exit_code) function qmckl_get_numprec_precision(context) bind(C) + use, intrinsic :: iso_c_binding + import + integer (qmckl_context), intent(in), value :: context + end function qmckl_get_numprec_precision + end interface + #+end_src + +* Range + + ~qmckl_set_numprec_range~ modifies the parameter for the numerical + range in a given context. + + # Header + #+begin_src c :comments org :tangle (eval h_func) :exports none +qmckl_exit_code qmckl_set_numprec_range(const qmckl_context context, const int range); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_exit_code qmckl_set_numprec_range(const qmckl_context context, const int range) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_INVALID_CONTEXT; + + if (range < 2) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_set_numprec_range", + "range < 2"); + } + + if (range > 11) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_set_numprec_range", + "range > 11"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + + /* This should be always true because the context is valid */ + assert (ctx != NULL); + + qmckl_lock(context); + { + ctx->numprec.range = (uint32_t) range; + } + qmckl_unlock(context); + + return QMCKL_SUCCESS; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh_func) + interface + integer (qmckl_exit_code) function qmckl_numprec_set_range(context, range) bind(C) + use, intrinsic :: iso_c_binding + import + integer (qmckl_context), intent(in), value :: context + integer (c_int32_t), intent(in), value :: range + end function qmckl_numprec_set_range + end interface + #+end_src + + ~qmckl_get_numprec_range~ returns the value of the numerical range in the context. + + #+begin_src c :comments org :tangle (eval h_func) :exports none +int32_t qmckl_context_get_range(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +int qmckl_get_numprec_range(const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith(context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_numprec_range", + ""); + } + + const qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + return ctx->numprec.range; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh_func) :exports none + interface + integer (qmckl_exit_code) function qmckl_get_numprec_range(context) bind(C) + use, intrinsic :: iso_c_binding + import + integer (qmckl_context), intent(in), value :: context + end function qmckl_get_numprec_range + end interface + #+end_src + +* Helper functions + + ~qmckl_context_get_epsilon~ returns $\epsilon = 2^{1-n}$ where ~n~ is the precision. + + #+begin_src c :comments org :tangle (eval h_func) :exports none +double qmckl_get_numprec_epsilon(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +double qmckl_get_numprec_epsilon(const qmckl_context context) { + const int precision = qmckl_get_numprec_precision(context); + return 1. / (double) (1L << (precision-1)); +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh_func) :exports none + interface + real (c_double) function qmckl_get_numprec_epsilon(context) bind(C) + use, intrinsic :: iso_c_binding + import + integer (qmckl_context), intent(in), value :: context + end function qmckl_get_numprec_epsilon + end interface + #+end_src + +* End of files :noexport: + + #+begin_src c :comments link :tangle (eval h_private_type) +#endif + #+end_src + +*** Test + #+begin_src c :comments link :tangle (eval c_test) +return MUNIT_OK; +} + #+end_src + diff --git a/src/table_of_contents b/src/table_of_contents index a6a9011..03c9622 100644 --- a/src/table_of_contents +++ b/src/table_of_contents @@ -2,6 +2,4 @@ qmckl.org qmckl_error.org qmckl_context.org qmckl_memory.org -qmckl_distance.org -qmckl_ao.org test_qmckl.org diff --git a/tools/Building.org b/tools/Building.org index 32ccf3f..959deb8 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -353,7 +353,12 @@ EOF HEADERS="" for i in $(cat table_of_contents) do - HEADERS+="${i%.org}.h " + HEADERS+="${i%.org}_type.h " +done + +for i in $(cat table_of_contents) +do + HEADERS+="${i%.org}_func.h " done #+end_src @@ -389,7 +394,8 @@ EOF Generate Fortran interface file from all =qmckl_*_fh.f90= files #+begin_src bash -HEADERS="qmckl_*_fh.f90" +HEADERS_TYPE="qmckl_*_fh_type.f90" +HEADERS="qmckl_*_fh_func.f90" OUTPUT="../include/qmckl_f.f90" cat << EOF > ${OUTPUT} @@ -400,6 +406,11 @@ module qmckl use, intrinsic :: iso_c_binding EOF +for i in ${HEADERS_TYPE} +do + cat $i >> ${OUTPUT} +done + for i in ${HEADERS} do cat $i >> ${OUTPUT} diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh index 78f2665..ff57803 100755 --- a/tools/build_qmckl_h.sh +++ b/tools/build_qmckl_h.sh @@ -19,7 +19,12 @@ HEADERS="" for i in $(cat table_of_contents) do - HEADERS+="${i%.org}.h " + HEADERS+="${i%.org}_type.h " +done + +for i in $(cat table_of_contents) +do + HEADERS+="${i%.org}_func.h " done @@ -96,7 +101,8 @@ EOF # Generate Fortran interface file from all =qmckl_*_fh.f90= files -HEADERS="qmckl_*_fh.f90" +HEADERS_TYPE="qmckl_*_fh_type.f90" +HEADERS="qmckl_*_fh_func.f90" OUTPUT="../include/qmckl_f.f90" cat << EOF > ${OUTPUT} @@ -146,6 +152,11 @@ module qmckl use, intrinsic :: iso_c_binding EOF +for i in ${HEADERS_TYPE} +do + cat $i >> ${OUTPUT} +done + for i in ${HEADERS} do cat $i >> ${OUTPUT} diff --git a/tools/config_tangle.el b/tools/config_tangle.el index 6f1eed1..91c122f 100755 --- a/tools/config_tangle.el +++ b/tools/config_tangle.el @@ -36,10 +36,13 @@ (setq pwd (file-name-directory buffer-file-name)) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq f (concat pwd name "_f.f90")) -(setq fh (concat pwd name "_fh.f90")) +(setq fh_func (concat pwd name "_fh_func.f90")) +(setq fh_type (concat pwd name "_fh_type.f90")) (setq c (concat pwd name ".c")) -(setq h (concat name ".h")) -(setq h_private (concat name "_private.h")) +(setq h_func (concat name "_func.h")) +(setq h_type (concat name "_type.h")) +(setq h_private_type (concat name "_private_type.h")) +(setq h_private_func (concat name "_private_func.h")) (setq c_test (concat pwd "test_" name ".c")) (setq f_test (concat pwd "test_" name "_f.f90")) (org-babel-lob-ingest "../tools/lib.org") diff --git a/tools/lib.org b/tools/lib.org index c59eaae..e6e5216 100644 --- a/tools/lib.org +++ b/tools/lib.org @@ -10,7 +10,7 @@ #+RESULTS: get_value * Table of function arguments - + #+NAME: test | qmckl_context | context | in | Global state | | char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed | @@ -24,32 +24,35 @@ | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | | int64_t | ldc | in | Leading dimension of array ~C~ | - + ** Fortran-C type conversions #+NAME:f_of_c #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" f_of_c_d = { '' : '' - , 'qmckl_context' : 'integer (c_int64_t)' - , 'int32_t' : 'integer (c_int32_t)' - , 'int64_t' : 'integer (c_int64_t)' - , 'float' : 'real (c_float )' - , 'double' : 'real (c_double )' - , 'char' : 'character' + , 'qmckl_context' : 'integer (qmckl_context)' + , 'qmckl_exit_code' : 'integer (qmckl_exit_code)' + , 'int32_t' : 'integer (c_int32_t)' + , 'int64_t' : 'integer (c_int64_t)' + , 'float' : 'real (c_float )' + , 'double' : 'real (c_double )' + , 'char' : 'character' } #+END_SRC - + #+NAME:c_of_f #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" ctypeid_d = { '' : '' - , 'integer' : 'integer(c_int32_t)' - , 'integer*8' : 'integer(c_int64_t)' - , 'real' : 'real(c_float)' - , 'real*8' : 'real(c_double)' - , 'character' : 'character(c_char)' + , 'qmckl_context' : 'integer (qmckl_context)' + , 'qmckl_exit_code' : 'integer (qmckl_exit_code)' + , 'integer' : 'integer(c_int32_t)' + , 'integer*8' : 'integer(c_int64_t)' + , 'real' : 'real(c_float)' + , 'real*8' : 'real(c_double)' + , 'character' : 'character(c_char)' } #+END_SRC - + ** Parse the table #+NAME: parse_table @@ -79,7 +82,7 @@ def parse_table(table): else: d["name"] = d["name"].split('[')[0].strip() d["dims"] = [ x.replace(']','').strip() for x in dims[1:] ] - + result.append(d) return result @@ -88,7 +91,7 @@ def parse_table(table): ** Generates a C header #+NAME: generate_c_header - #+BEGIN_SRC python :var table=[] :var rettyp=[] :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h) :comments org" + #+BEGIN_SRC python :var table=[] :var rettyp=[] :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h_func) :comments org" <> results = [] @@ -105,7 +108,7 @@ for d in parse_table(table): const = "const" else: const = " " - + results += [ f" {const} {c_type} {name}" ] results=',\n'.join(results) @@ -116,11 +119,11 @@ return template #+END_SRC #+RESULTS: generate_c_header - #+begin_src c :tangle (eval h) :comments org + #+begin_src c :tangle (eval h_func) :comments org [] [] ( - ); + ); #+end_src - + ** Generates a C interface to the Fortran function #+NAME: generate_c_interface @@ -137,8 +140,9 @@ rettyp_c = ctypeid_d[rettyp.lower()] results = [ f"{rettyp_c} function {fname} &" , f" ({args}) &" , " bind(C) result(info)" -, "" +, "" , " use, intrinsic :: iso_c_binding" +, " import" , " implicit none" , "" ] @@ -166,7 +170,7 @@ for d in parse_table(table): results += [ "" , f" {rettyp_c}, external :: {fname}_f" , f" info = {fname}_f &" -, f" ({args})" +, f" ({args})" , "" , f"end function {fname}" ] @@ -193,6 +197,7 @@ results = [ f"interface" , f" ({args}) &" , " bind(C)" , " use, intrinsic :: iso_c_binding" +, " import" , " implicit none" , "" ] From 93b5e48a6b082ab61151f8eb343a81a2c100ba7f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 30 Mar 2021 22:40:56 +0200 Subject: [PATCH 44/65] Memory management --- src/qmckl_context.org | 158 ++++++++++++++++++------------ src/qmckl_error.org | 44 +++++---- src/qmckl_memory.org | 223 ++++++++++++++++++++++++++++++++---------- 3 files changed, 289 insertions(+), 136 deletions(-) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index df721d5..fa0aea0 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -23,6 +23,7 @@ MunitResult test_<>() { #include #include "qmckl_error_private_type.h" +#include "qmckl_memory_private_type.h" #include "qmckl_numprec_private_type.h" #+end_src @@ -39,10 +40,9 @@ MunitResult test_<>() { #include "qmckl_context_private_type.h" #include "qmckl_context_type.h" -#include "qmckl_memory_func.h" +#include "qmckl_memory_private_func.h" #include "qmckl_context_func.h" -static void init_lock(pthread_mutex_t* mutex); #+end_src * Context handling @@ -94,9 +94,7 @@ typedef struct qmckl_context_struct { qmckl_error_struct error; /* Memory allocation */ - /* qmckl_memory_struct memory; - ,*/ /* -- Molecular system -- */ /* To be implemented: @@ -173,11 +171,26 @@ qmckl_context qmckl_context_create() { return QMCKL_NULL_CONTEXT; } - /* Set all pointers to NULL */ - memset(ctx, 0, sizeof(qmckl_context_struct)); + /* Set all pointers and values to NULL */ + { + memset(ctx, 0, sizeof(qmckl_context_struct)); + } /* Initialize lock */ - init_lock(&(ctx->mutex)); + { + pthread_mutexattr_t attr; + int rc; + + rc = pthread_mutexattr_init(&attr); + assert (rc == 0); + + (void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + + rc = pthread_mutex_init ( &(ctx->mutex), &attr); + assert (rc == 0); + + (void) pthread_mutexattr_destroy(&attr); + } /* Initialize data */ ctx->tag = VALID_TAG; @@ -185,7 +198,21 @@ qmckl_context qmckl_context_create() { const qmckl_context context = (const qmckl_context) ctx; assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); - return context; + /* Allocate qmckl_memory_struct */ + { + const size_t size = 128L; + qmckl_memory_info_struct * new_array = calloc(size, sizeof(qmckl_memory_info_struct)); + if (new_array == NULL) { + return QMCKL_NULL_CONTEXT; + } + memset( &(new_array[0]), 0, size * sizeof(qmckl_memory_info_struct) ); + + ctx->memory.element = new_array; + ctx->memory.array_size = size; + ctx->memory.n_allocated = (size_t) 0; + } + + return (qmckl_context) ctx; } #+end_src @@ -223,22 +250,7 @@ void qmckl_unlock(qmckl_context context); # Source #+begin_src c :tangle (eval c) -static void init_lock(pthread_mutex_t* mutex) { - pthread_mutexattr_t attr; - int rc; - - rc = pthread_mutexattr_init(&attr); - assert (rc == 0); - - (void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); - - rc = pthread_mutex_init ( mutex, &attr); - assert (rc == 0); - - (void)pthread_mutexattr_destroy(&attr); -} - -void qmckl_lock(const qmckl_context context) { +void qmckl_lock(qmckl_context context) { if (context == QMCKL_NULL_CONTEXT) return ; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -252,7 +264,7 @@ void qmckl_lock(const qmckl_context context) { ctx->lock_count += 1; /* printf(" lock : %d\n", ctx->lock_count); -*/ +,*/ } void qmckl_unlock(const qmckl_context context) { @@ -266,13 +278,13 @@ void qmckl_unlock(const qmckl_context context) { ctx->lock_count -= 1; /* printf("unlock : %d\n", ctx->lock_count); -*/ +,*/ } #+end_src ** TODO Copy - ~qmckl_context_copy~ makes a shallow copy of a context. It returns + ~qmckl_context_copy~ makes a deep copy of a context. It returns ~QMCKL_NULL_CONTEXT~ upon failure. # Header @@ -285,36 +297,38 @@ qmckl_context qmckl_context_copy(const qmckl_context context); #+begin_src c :tangle (eval c) qmckl_context qmckl_context_copy(const qmckl_context context) { - qmckl_lock(context); - const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == QMCKL_NULL_CONTEXT) { - qmckl_unlock(context); return QMCKL_NULL_CONTEXT; } - - const qmckl_context_struct* const old_ctx = - (qmckl_context_struct* const) checked_context; - - qmckl_context_struct* const new_ctx = - (qmckl_context_struct* const) qmckl_malloc (context, sizeof(qmckl_context_struct)); - - if (new_ctx == NULL) { - qmckl_unlock(context); - return QMCKL_NULL_CONTEXT; + /* + qmckl_lock(context); + { + + const qmckl_context_struct* const old_ctx = + (qmckl_context_struct* const) checked_context; + + qmckl_context_struct* const new_ctx = + (qmckl_context_struct* const) malloc (context, sizeof(qmckl_context_struct)); + + if (new_ctx == NULL) { + qmckl_unlock(context); + return QMCKL_NULL_CONTEXT; + } + + * Copy the old context on the new one * + * TODO Deep copies should be done here * + memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct)); + + qmckl_unlock( (qmckl_context) new_ctx ); + + return (qmckl_context) new_ctx; } - - /* Copy the old context on the new one */ - /* TODO Deep copies should be done here */ - memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct)); - - /* As the lock was copied, both need to be unlocked */ - qmckl_unlock( (qmckl_context) new_ctx ); - qmckl_unlock( (qmckl_context) old_ctx ); - - return (qmckl_context) new_ctx; + qmckl_unlock(context); +*/ + return QMCKL_NULL_CONTEXT; } #+end_src @@ -332,10 +346,12 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { # Test #+begin_src c :comments link :tangle (eval c_test) :exports none +/* qmckl_context new_context = qmckl_context_copy(context); munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); +*/ #+end_src ** Destroy @@ -355,28 +371,36 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; - qmckl_lock(context); - qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); /* Shouldn't be possible because the context is valid */ - /* TODO Remove all allocated data */ - /* - qmckl_memory_free_all(context); - ,*/ - + qmckl_lock(context); + { + /* Memory: Remove all allocated data */ + for (size_t pos = (size_t) 0 ; pos < ctx->memory.array_size ; ++pos) { + if (ctx->memory.element[pos].pointer != NULL) { + free(ctx->memory.element[pos].pointer); + memset( &(ctx->memory.element[pos]), 0, sizeof(qmckl_memory_info_struct) ); + ctx->memory.n_allocated -= 1; + } + } + assert (ctx->memory.n_allocated == (size_t) 0); + free(ctx->memory.element); + ctx->memory.element = NULL; + ctx->memory.array_size = (size_t) 0; + } qmckl_unlock(context); + ctx->tag = INVALID_TAG; + const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) ); if (rc_destroy != 0) { +/* DEBUG */ fprintf(stderr, "qmckl_context_destroy: %s (count = %d)\n", strerror(rc_destroy), ctx->lock_count); abort(); } - ctx->tag = INVALID_TAG; - - const qmckl_exit_code rc = qmckl_free(context,ctx); - assert (rc == QMCKL_SUCCESS); + free(ctx); return QMCKL_SUCCESS; } @@ -395,11 +419,15 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { # Test #+begin_src c :tangle (eval c_test) :exports none -munit_assert_int64(qmckl_context_check(new_context), ==, new_context); -munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); -munit_assert_int64(qmckl_context_check(new_context), !=, new_context); -munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_CONTEXT); +/* Destroy valid context */ +munit_assert_int64(qmckl_context_check(context), ==, context); munit_assert_int32(qmckl_context_destroy(context), ==, QMCKL_SUCCESS); + +/* Check that context is destroyed */ +munit_assert_int64(qmckl_context_check(context), !=, context); +munit_assert_int64(qmckl_context_check(context), ==, QMCKL_NULL_CONTEXT); + +/* Destroy invalid context */ munit_assert_int32(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_INVALID_CONTEXT); #+end_src diff --git a/src/qmckl_error.org b/src/qmckl_error.org index b1fc1dc..be4b293 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -154,16 +154,22 @@ return '\n'.join(result) #+end_src :end: - The ~qmckl_strerror~ converts an exit code into a string. The + The ~qmckl_string_of_error~ converts an exit code into a string. The string is assumed to be large enough to contain the error message (typically 128 characters). +* Decoding errors + + To decode the error messages, ~qmckl_string_of_error~ converts an + error code into a string. + #+NAME: MAX_STRING_LENGTH : 128 #+begin_src c :comments org :tangle (eval h_func) :exports none :noweb yes const char* qmckl_string_of_error(const qmckl_exit_code error); -void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<>]); +void qmckl_string_of_error_f(const qmckl_exit_code error, + char result[<>]); #+end_src The text strings are extracted from the previous table. @@ -231,8 +237,7 @@ typedef struct qmckl_error_struct { * Updating errors in the context - The error is updated in the context using - ~qmckl_set_error~. + The error is updated in the context using ~qmckl_set_error~. When the error is set in the context, it is mandatory to specify from which function the error is triggered, and a message explaining the error. The exit code can't be ~QMCKL_SUCCESS~. @@ -286,8 +291,11 @@ qmckl_set_error(qmckl_context context, To make a function fail, the ~qmckl_failwith~ function should be called, such that information about the failure is stored in the context. The desired exit code is given as an argument, as - well as the name of the function and an error message. The return - code of the function is the desired return code. + well as the name of the function and an error message. If the + message is ~NULL~, then the default message obtained by + ~qmckl_string_of_error~ is used. The return code of the function is + the desired return code. + Upon failure, a ~QMCKL_NULL_CONTEXT~ is returned. #+begin_src c :comments org :tangle (eval h_func) :exports none qmckl_exit_code qmckl_failwith(qmckl_context context, @@ -305,17 +313,23 @@ qmckl_exit_code qmckl_failwith(qmckl_context context, assert (exit_code > 0); assert (exit_code < QMCKL_INVALID_EXIT_CODE); assert (function != NULL); - assert (message != NULL); assert (strlen(function) < QMCKL_MAX_FUN_LEN); - assert (strlen(message) < QMCKL_MAX_MSG_LEN); + if (message != NULL) { + assert (strlen(message) < QMCKL_MAX_MSG_LEN); + } if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) - return QMCKL_NULL_CONTEXT; + return QMCKL_INVALID_CONTEXT; - const qmckl_exit_code rc = - qmckl_set_error(context, exit_code, function, message); - - assert (rc == QMCKL_SUCCESS); + if (message == NULL) { + qmckl_exit_code rc = + qmckl_set_error(context, exit_code, function, qmckl_string_of_error(exit_code)); + assert (rc == QMCKL_SUCCESS); + } else { + qmckl_exit_code rc = + qmckl_set_error(context, exit_code, function, message); + assert (rc == QMCKL_SUCCESS); + } return exit_code; } @@ -332,10 +346,6 @@ if (x < 0) { } #+end_src -* TODO Decoding errors - - To decode the error messages, ~qmckl_strerror~ converts an - error code into a string. * End of files :noexport: diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 5016212..240b28b 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -15,12 +15,15 @@ optimized libraries to fine-tune the memory allocation. #+begin_src c :tangle (eval c) #include #include +#include #include #include "qmckl_error_type.h" +#include "qmckl_memory_private_type.h" #include "qmckl_context_type.h" #include "qmckl_context_private_type.h" +#include "qmckl_memory_private_func.h" #include "qmckl_memory_func.h" #include "qmckl_context_func.h" #include "qmckl_error_func.h" @@ -29,13 +32,59 @@ optimized libraries to fine-tune the memory allocation. #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" +#include "qmckl_context_private_type.h" +#include "qmckl_memory_private_func.h" MunitResult test_<>() { #+end_src -* -:PROPERTIES: -:UNNUMBERED: t -:END: + + #+begin_src c :tangle (eval h_private_type) :noweb yes +#ifndef QMCKL_MEMORY_HPT +#define QMCKL_MEMORY_HPT + +#include + #+end_src + +* Memory data structure for the context + + Every time a new block of memory is allocated, the information + relative to the allocation is stored in a new ~qmckl_memory_info_struct~. + A ~qmckl_memory_info_struct~ contains the pointer to the memory block, + its size in bytes, and extra implementation-specific information such as + alignment, pinning, if the memory should be allocated on CPU or GPU + /etc/. + + #+begin_src c :tangle (eval h_private_type) :noweb yes +typedef struct qmckl_memory_info_struct { + size_t size; + void* pointer; +} qmckl_memory_info_struct; + +static const qmckl_memory_info_struct qmckl_memory_info_struct_zero = + { + .size = (size_t) 0, + .pointer = NULL + }; + #+end_src + + The ~memory~ element of the context is a data structure which + contains an array of ~qmckl_memory_info_struct~, the size of the + array, and the number of allocated blocks. + + #+begin_src c :tangle (eval h_private_type) :noweb yes +typedef struct qmckl_memory_struct { + size_t n_allocated; + size_t array_size; + qmckl_memory_info_struct* element; +} qmckl_memory_struct; + #+end_src + +* Passing info to allocation routines + + Passing information to the allocation routine should be done by + passing an instance of a ~qmckl_memory_info_struct~. + +* Allocation/deallocation functions Memory allocation inside the library should be done with ~qmckl_malloc~. It lets the library choose how the memory will be @@ -47,55 +96,88 @@ MunitResult test_<>() { If the allocation failed, the ~NULL~ pointer is returned. # Header - #+begin_src c :tangle (eval h_func) :noexport + #+begin_src c :tangle (eval h_private_func) :noexport void* qmckl_malloc(qmckl_context context, - const size_t size); + const qmckl_memory_info_struct info); #+end_src - In this implementation, we use ~calloc~ because it initializes the - memory block to zero, so structs will have ~NULL~-initialized pointers. - # Source #+begin_src c :tangle (eval c) -void* qmckl_malloc(qmckl_context context, const size_t size) { +void* qmckl_malloc(qmckl_context context, const qmckl_memory_info_struct info) { assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT); - void * pointer = calloc(size, (size_t) 1); - /* - if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { - qmckl_exit_code rc; - rc = qmckl_context_append_memory(context, pointer, size); - assert (rc == QMCKL_SUCCESS); + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + + /* Allocate memory and zero it */ + void * pointer = malloc(info.size); + if (pointer == NULL) { + return NULL; } - */ + memset(pointer, 0, info.size); + qmckl_lock(context); + { + /* If qmckl_memory_struct is full, reallocate a larger one */ + if (ctx->memory.n_allocated == ctx->memory.array_size) { + const size_t old_size = ctx->memory.array_size; + qmckl_memory_info_struct * new_array = reallocarray(ctx->memory.element, + 2L * old_size, + sizeof(qmckl_memory_info_struct)); + if (new_array == NULL) { + qmckl_unlock(context); + return NULL; + } + + memset( &(new_array[old_size]), 0, old_size * sizeof(qmckl_memory_info_struct) ); + ctx->memory.element = new_array; + ctx->memory.array_size = 2L * old_size; + } + + /* Find first NULL entry */ + size_t pos = (size_t) 0; + while ( pos < ctx->memory.array_size && ctx->memory.element[pos].size > (size_t) 0) { + pos += (size_t) 1; + } + assert (ctx->memory.element[pos].size == (size_t) 0); + + /* Copy info at the new location */ + ctx->memory.element[pos].size = info.size; + ctx->memory.element[pos].pointer = pointer; + ctx->memory.n_allocated += (size_t) 1; + } + qmckl_unlock(context); + return pointer; } #+end_src - # Fortran interface - #+begin_src f90 :tangle (eval fh_func) :noexport - interface - type (c_ptr) function qmckl_malloc (context, size) bind(C) - use, intrinsic :: iso_c_binding - import - integer (qmckl_context), intent(in), value :: context - integer (c_int64_t) , intent(in), value :: size - end function qmckl_malloc - end interface - #+end_src # Test :noexport: #+begin_src c :tangle (eval c_test) +/* Create a context */ qmckl_context context = qmckl_context_create(); -int *a = (int*) qmckl_malloc(context, 3*sizeof(int)); -munit_assert(a != NULL); +qmckl_memory_info_struct info = qmckl_memory_info_struct_zero; +info.size = (size_t) 3; +/* Allocate an array of ints */ +int *a = (int*) qmckl_malloc(context, info); + +/* Check that array of ints is OK */ +munit_assert(a != NULL); a[0] = 1; munit_assert_int(a[0], ==, 1); a[1] = 2; munit_assert_int(a[1], ==, 2); a[2] = 3; munit_assert_int(a[2], ==, 3); + +/* Allocate another array of ints */ +int *b = (int*) qmckl_malloc(context, info); + +/* Check that array of ints is OK */ +munit_assert(b != NULL); +b[0] = 1; munit_assert_int(b[0], ==, 1); +b[1] = 2; munit_assert_int(b[1], ==, 2); +b[2] = 3; munit_assert_int(b[2], ==, 3); #+end_src When freeing the memory with ~qmckl_free~, the context is passed, in @@ -104,40 +186,53 @@ a[2] = 3; munit_assert_int(a[2], ==, 3); #+begin_src c :tangle (eval h_func) qmckl_exit_code qmckl_free(qmckl_context context, - void *ptr); - #+end_src - - #+begin_src f90 :tangle (eval fh_func) - interface - integer (qmckl_exit_code) function qmckl_free (context, ptr) bind(C) - use, intrinsic :: iso_c_binding - import - integer (qmckl_context), intent(in), value :: context - type (c_ptr), intent(in), value :: ptr - end function qmckl_free - end interface + void * const ptr); #+end_src # Source #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { - if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { +qmckl_exit_code qmckl_free(qmckl_context context, void * const ptr) { - if (ptr == NULL) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return qmckl_failwith(context, - QMCKL_INVALID_ARG_2, + QMCKL_INVALID_CONTEXT, "qmckl_free", - "NULL pointer"); + NULL); + } + + if (ptr == NULL) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_free", + "NULL pointer"); + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + + qmckl_lock(context); + { + /* Find pointer in array of saved pointers */ + size_t pos = (size_t) 0; + while ( pos < ctx->memory.array_size && ctx->memory.element[pos].pointer != ptr) { + pos += (size_t) 1; } - /* - qmckl_exit_code rc; - rc = qmckl_context_remove_memory(context, ptr); + if (pos >= ctx->memory.array_size) { + /* Not found */ + qmckl_unlock(context); + return qmckl_failwith(context, + QMCKL_FAILURE, + "qmckl_free", + "Pointer not found in context"); + } - assert (rc == QMCKL_SUCCESS); - */ + free(ptr); + + memset( &(ctx->memory.element[pos]), 0, sizeof(qmckl_memory_info_struct) ); + ctx->memory.n_allocated -= (size_t) 1; } - free(ptr); + qmckl_unlock(context); + return QMCKL_SUCCESS; } #+end_src @@ -145,11 +240,27 @@ qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { # Test #+begin_src c :tangle (eval c_test) :exports none qmckl_exit_code rc; - +/* Assert that both arrays are allocated */ munit_assert(a != NULL); +munit_assert(b != NULL); + +/* Free in NULL context */ +rc = qmckl_free(QMCKL_NULL_CONTEXT, a); +munit_assert(rc == QMCKL_INVALID_CONTEXT); + +/* Free NULL pointer */ +rc = qmckl_free(context, NULL); +munit_assert(rc == QMCKL_INVALID_ARG_2); + +/* Free for the first time */ rc = qmckl_free(context, a); munit_assert(rc == QMCKL_SUCCESS); +/* Free again */ +rc = qmckl_free(context, a); +munit_assert(rc == QMCKL_FAILURE); + +/* Clean up */ rc = qmckl_context_destroy(context); munit_assert(rc == QMCKL_SUCCESS); @@ -157,6 +268,10 @@ munit_assert(rc == QMCKL_SUCCESS); * End of files :noexport: + #+begin_src c :comments org :tangle (eval h_private_type) +#endif + + #+end_src ** Test #+begin_src c :comments org :tangle (eval c_test) return MUNIT_OK; From 7642d336d14e4dedde7fe4dd5562551309981318 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 31 Mar 2021 01:52:43 +0200 Subject: [PATCH 45/65] Fixed memory leak --- src/qmckl_context.org | 1 + src/qmckl_memory.org | 1 + 2 files changed, 2 insertions(+) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index fa0aea0..c2d660e 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -203,6 +203,7 @@ qmckl_context qmckl_context_create() { const size_t size = 128L; qmckl_memory_info_struct * new_array = calloc(size, sizeof(qmckl_memory_info_struct)); if (new_array == NULL) { + free(ctx); return QMCKL_NULL_CONTEXT; } memset( &(new_array[0]), 0, size * sizeof(qmckl_memory_info_struct) ); diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 240b28b..d9a4657 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -126,6 +126,7 @@ void* qmckl_malloc(qmckl_context context, const qmckl_memory_info_struct info) { sizeof(qmckl_memory_info_struct)); if (new_array == NULL) { qmckl_unlock(context); + free(pointer); return NULL; } From aa8a1fd3b1dab6fe81e30f86daab3703812c1e14 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 1 Apr 2021 01:19:33 +0200 Subject: [PATCH 46/65] Added AO struct --- src/qmckl_ao.org | 1531 ++++++++++++++++++++++++++++++++++++++++ src/qmckl_context.org | 9 +- src/qmckl_distance.org | 12 +- src/qmckl_numprec.org | 5 +- src/table_of_contents | 2 + 5 files changed, 1549 insertions(+), 10 deletions(-) create mode 100644 src/qmckl_ao.org diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org new file mode 100644 index 0000000..22026a5 --- /dev/null +++ b/src/qmckl_ao.org @@ -0,0 +1,1531 @@ +#+TITLE: Atomic Orbitals +#+SETUPFILE: ../docs/theme.setup + +The atomic basis set is defined as a list of shells. Each shell $s$ is +centered on a nucleus $A$, possesses a given angular momentum $l$ and a +radial function $R_s$. The radial function is a linear combination of +\emph{primitive} functions that can be of type Slater ($p=1$) or +Gaussian ($p=2$): + +\[ + R_s(\mathbf{r}) = \mathcal{N}_s |\mathbf{r}-\mathbf{R}_A|^{n_s} + \sum_{k=1}^{N_{\text{prim}}} a_{ks} + \exp \left( - \gamma_{ks} | \mathbf{r}-\mathbf{R}_A | ^p \right). +\] + +In the case of Gaussian functions, $n_s$ is always zero. +The normalization factor $\mathcal{N}_s$ ensures that all the functions +of the shell are normalized to unity. As this normalization requires +the ability to compute overlap integrals, it should be written in the +file to ensure that the file is self-contained and does not require +the client program to have the ability to compute such integrals. + +Atomic orbitals (AOs) are defined as + +\[ +\chi_i (\mathbf{r}) = P_{\eta(i)}(\mathbf{r})\, R_{\theta(i)} (\mathbf{r}) +\] + +where $\theta(i)$ returns the shell on which the AO is expanded, +and $\eta(i)$ denotes which angular function is chosen. + +In this section we describe the kernels used to compute the values, +gradients and Laplacian of the atomic basis functions. + +* Headers :noexport: + + #+NAME: filename + #+begin_src elisp :tangle no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src + + #+begin_src c :tangle (eval h_private_type) +#ifndef QMCKL_AO_HPT +#define QMCKL_AO_HPT + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes +#include "qmckl.h" +#include "munit.h" +MunitResult test_<>() { + qmckl_context context; + context = qmckl_context_create(); + #+end_src + + #+begin_src c :tangle (eval c) +#include +#include +#include +#include + +#include "qmckl_error_type.h" +#include "qmckl_context_type.h" +#include "qmckl_context_private_type.h" +#include "qmckl_memory_private_type.h" + +#include "qmckl_error_func.h" +#include "qmckl_memory_private_func.h" +#include "qmckl_memory_func.h" +#include "qmckl_context_func.h" + #+end_src + +* Context + + The following arrays are stored in the context: + + | ~type~ | | Gaussian (~'G'~) or Slater (~'S'~) | + | ~shell_num~ | | Number of shells | + | ~prim_num~ | | Total number of primitives | + | ~shell_center~ | ~[shell_num]~ | Id of the nucleus on which each shell is centered | + | ~shell_ang_mom~ | ~[shell_num]~ | Angular momentum of each shell | + | ~shell_prim_num~ | ~[shell_num]~ | Number of primitives in each shell | + | ~shell_prim_index~ | ~[shell_num]~ | Address of the first primitive of each shell in the ~EXPONENT~ array | + | ~shell_factor~ | ~[shell_num]~ | Normalization factor for each shell | + | ~exponent~ | ~[prim_num]~ | Array of exponents | + | ~coefficient~ | ~[prim_num]~ | Array of coefficients | + + For H_2 with the following basis set, + + #+BEGIN_EXAMPLE +HYDROGEN +S 5 +1 3.387000E+01 6.068000E-03 +2 5.095000E+00 4.530800E-02 +3 1.159000E+00 2.028220E-01 +4 3.258000E-01 5.039030E-01 +5 1.027000E-01 3.834210E-01 +S 1 +1 3.258000E-01 1.000000E+00 +S 1 +1 1.027000E-01 1.000000E+00 +P 1 +1 1.407000E+00 1.000000E+00 +P 1 +1 3.880000E-01 1.000000E+00 +D 1 +1 1.057000E+00 1.0000000 + #+END_EXAMPLE + + we have: + + #+BEGIN_EXAMPLE +type = 'G' +shell_num = 12 +prim_num = 20 +shell_center = [1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2] +shell_ang_mom = ['S', 'S', 'S', 'P', 'P', 'D', 'S', 'S', 'S', 'P', 'P', 'D'] +shell_factor = [ 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.] +shell_prim_num = [5, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1] +prim_index = [1, 6, 7, 8, 9, 10, 11, 16, 17, 18, 19, 20] +exponent = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, + 1.407, 0.388, 1.057, 33.87, 5.095, 1.159, 0.3258, 0.1027, + 0.3258, 0.1027, 1.407, 0.388, 1.057] +coefficient = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, + 1.0, 1.0, 1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822, + 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0] + #+END_EXAMPLE + +** Data structure + + #+begin_src c :comments org :tangle (eval h_private_type) +typedef struct qmckl_ao_basis_struct { + int32_t provided; + int32_t uninitialized; + int64_t shell_num; + int64_t prim_num; + int64_t * shell_center; + int32_t * shell_ang_mom; + int64_t * shell_prim_num; + int64_t * shell_prim_index; + double * shell_factor; + double * exponent ; + double * coefficient ; + char type; +} qmckl_ao_basis_struct; + #+end_src + + The ~uninitialized~ integer contains one bit set to one for each + initialization function which has not bee called. When it is equal + to zero, the struct is initialized and ~provided == 1~. + +** Access functions + + Access to scalars copies the values at the passed address, and + for array values a pointer to the array is returned. + + #+begin_src c :comments org :tangle (eval h_func) +char qmckl_get_ao_basis_type (qmckl_context context); +int64_t qmckl_get_ao_basis_shell_num (qmckl_context context); +int64_t qmckl_get_ao_basis_prim_num (qmckl_context context); +int64_t* qmckl_get_ao_basis_shell_center (qmckl_context context); +int32_t* qmckl_get_ao_basis_shell_ang_mom (qmckl_context context); +int64_t* qmckl_get_ao_basis_shell_prim_num (qmckl_context context); +double* qmckl_get_ao_basis_shell_factor (qmckl_context context); +double* qmckl_get_ao_basis_exponent (qmckl_context context); +double* qmckl_get_ao_basis_coefficient (qmckl_context context); + #+end_src + + #+NAME:post + #+begin_src c +if (ctx->ao_basis.uninitialized &= mask != 0) { + return NULL; +} + #+end_src + + + #+begin_src c :comments org :tangle (eval c) :noweb yes +char qmckl_get_ao_basis_type (qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return (char) 0; + } + + assert (ctx->ao_basis.type != (char) 0); + return ctx->ao_basis.type; +} + + +int64_t qmckl_get_ao_basis_shell_num (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 1; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return (int64_t) 0; + } + + assert (ctx->ao_basis.shell_num != (int64_t) 0); + return ctx->ao_basis.shell_num; +} + + +int64_t qmckl_get_ao_basis_prim_num (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 2; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return (int64_t) 0; + } + + assert (ctx->ao_basis.prim_num != (int64_t) 0); + return ctx->ao_basis.prim_num; +} + + +int64_t* qmckl_get_ao_basis_shell_center (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return NULL; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 3; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return NULL; + } + + assert (ctx->ao_basis.shell_center != NULL); + return ctx->ao_basis.shell_center; +} + + +int32_t* qmckl_get_ao_basis_shell_ang_mom (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return NULL; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 4; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return NULL; + } + + assert (ctx->ao_basis.shell_ang_mom != NULL); + return ctx->ao_basis.shell_ang_mom; +} + + +int64_t* qmckl_get_ao_basis_shell_prim_num (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return NULL; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 5; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return NULL; + } + + assert (ctx->ao_basis.shell_prim_num != NULL); + return ctx->ao_basis.shell_prim_num; +} + + +int64_t* qmckl_get_ao_basis_shell_prim_index (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return NULL; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 6; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return NULL; + } + + assert (ctx->ao_basis.shell_prim_index != NULL); + return ctx->ao_basis.shell_prim_index; +} + + +double* qmckl_get_ao_basis_shell_factor (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return NULL; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 7; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return NULL; + } + + assert (ctx->ao_basis.shell_factor != NULL); + return ctx->ao_basis.shell_factor; +} + + +double* qmckl_get_ao_basis_exponent (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return NULL; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + + int32_t mask = 1 << 8; + + if (ctx->ao_basis.uninitialized &= mask != 0) { + return NULL; + } + + assert (ctx->ao_basis.exponent != NULL); + return ctx->ao_basis.exponent; +} + + +double* qmckl_get_ao_basis_coefficient (qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return 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; + } + + assert (ctx->ao_basis.coefficient != NULL); + return ctx->ao_basis.coefficient; +} + #+end_src + +** Initialization functions + + To set the basis set, all the following functions need to be + called. When + + #+begin_src c :comments org :tangle (eval h_func) +qmckl_exit_code qmckl_set_ao_basis_type (qmckl_context context, const char t); +qmckl_exit_code qmckl_set_ao_basis_shell_num (qmckl_context context, const int64_t shell_num); +qmckl_exit_code qmckl_set_ao_basis_prim_num (qmckl_context context, const int64_t prim_num); +qmckl_exit_code qmckl_set_ao_basis_shell_center (qmckl_context context, const int64_t * shell_center); +qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom (qmckl_context context, const int32_t * shell_ang_mom); +qmckl_exit_code qmckl_set_ao_basis_shell_center (qmckl_context context, const int64_t * shell_prim_num); +qmckl_exit_code qmckl_set_ao_basis_shell_factor (qmckl_context context, const double * shell_factor); +qmckl_exit_code qmckl_set_ao_basis_exponent (qmckl_context context, const double * exponent); +qmckl_exit_code qmckl_set_ao_basis_coefficient (qmckl_context context, const double * coefficient); + #+end_src + + #+NAME:pre2 + #+begin_src c +if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + +qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + #+end_src + + #+NAME:post2 + #+begin_src c +ctx->ao_basis.uninitialized &= !(mask); + +if (ctx->ao_basis.uninitialized == 0) { + ctx->ao_basis.provided = 1; +} + +return QMCKL_SUCCESS; + #+end_src + + + #+begin_src c :comments org :tangle (eval c) :noweb yes +qmckl_exit_code qmckl_set_ao_basis_type(qmckl_context context, const char t) { + <> + + if (t != 'G' && t != 'S') { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_type", + NULL); + } + + int32_t mask = 1; + ctx->ao_basis.type = t; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_shell_num(qmckl_context context, const int64_t shell_num) { + <> + + if (shell_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_shell_num", + "shell_num <= 0"); + } + + int64_t prim_num = qmckl_get_ao_basis_prim_num(context); + + if (0L < prim_num && prim_num < shell_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_shell_num", + "shell_num > prim_num"); + } + + int32_t mask = 1 << 1; + ctx->ao_basis.shell_num = shell_num; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_prim_num(qmckl_context context, const int64_t prim_num) { + <> + + if (prim_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_shell_num", + "prim_num must be positive"); + } + + int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + + if (prim_num < shell_num) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_ao_basis_shell_num", + "prim_num < shell_num"); + } + + int32_t mask = 1 << 2; + ctx->ao_basis.prim_num = prim_num; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_shell_center(qmckl_context context, const int64_t* shell_center) { + <> + + int32_t mask = 1 << 3; + + const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + if (shell_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_shell_center", + "shell_num is not set"); + } + + if (ctx->ao_basis.shell_center != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_center); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_shell_center", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = shell_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_shell_center", + NULL); + } + + memcpy(new_array, shell_center, mem_info.size); + + ctx->ao_basis.shell_center = new_array; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom(qmckl_context context, const int32_t* shell_ang_mom) { + <> + + int32_t mask = 1 << 4; + + const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + if (shell_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_shell_ang_mom", + "shell_num is not set"); + } + + if (ctx->ao_basis.shell_ang_mom != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_ang_mom); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_shell_ang_mom", + NULL); + } + } + + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = shell_num * sizeof(int64_t); + int32_t* new_array = (int32_t*) qmckl_malloc(context, mem_info); + + if (new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_ao_basis_shell_ang_mom", + NULL); + } + + memcpy(new_array, shell_ang_mom, mem_info.size); + + ctx->ao_basis.shell_ang_mom = new_array; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_shell_prim_num(qmckl_context context, const int64_t* shell_prim_num) { + <> + + int32_t mask = 1 << 5; + + const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + if (shell_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_shell_prim_num", + "shell_num is not set"); + } + + if (ctx->ao_basis.shell_prim_num != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_prim_num); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_shell_prim_num", + NULL); + } + } + + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = shell_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_shell_prim_num", + NULL); + } + + memcpy(new_array, shell_prim_num, mem_info.size); + + ctx->ao_basis.shell_prim_num = new_array; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_shell_prim_index(qmckl_context context, const int64_t* shell_prim_index) { + <> + + int32_t mask = 1 << 6; + + const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + if (shell_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_shell_prim_index", + "shell_num is not set"); + } + + if (ctx->ao_basis.shell_prim_index != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_prim_index); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_shell_prim_index", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = shell_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_shell_prim_index", + NULL); + } + + memcpy(new_array, shell_prim_index, mem_info.size); + + ctx->ao_basis.shell_prim_index = new_array; + + <> +} + + +qmckl_exit_code qmckl_set_ao_basis_shell_factor(qmckl_context context, const double* shell_factor) { + <> + + int32_t mask = 1 << 7; + + const int64_t shell_num = qmckl_get_ao_basis_shell_num(context); + if (shell_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_shell_factor", + "shell_num is not set"); + } + + + if (ctx->ao_basis.shell_factor != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_factor); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_shell_factor", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = shell_num * sizeof(double); + double* new_array = (double*) qmckl_malloc(context, mem_info); + + if (new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_ao_basis_shell_factor", + NULL); + } + + memcpy(new_array, shell_factor, mem_info.size); + + ctx->ao_basis.shell_factor = new_array; + + <> +} + +qmckl_exit_code qmckl_set_ao_basis_exponent(qmckl_context context, const double* exponent) { + <> + + int32_t mask = 1 << 8; + + const int64_t prim_num = qmckl_get_ao_basis_prim_num(context); + if (prim_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_exponent", + "prim_num is not set"); + } + + if (ctx->ao_basis.exponent != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.exponent); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_exponent", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = prim_num * sizeof(double); + double* new_array = (double*) qmckl_malloc(context, mem_info); + + if (new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_ao_basis_exponent", + NULL); + } + + memcpy(new_array, exponent, mem_info.size); + + ctx->ao_basis.exponent = new_array; + + <> +} + +qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const double* coefficient) { + <> + + int32_t mask = 1 << 9; + + const int64_t prim_num = qmckl_get_ao_basis_prim_num(context); + if (prim_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_ao_basis_coefficient", + "prim_num is not set"); + } + + if (ctx->ao_basis.coefficient != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.coefficient); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_ao_basis_coefficient", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = prim_num * sizeof(double); + double* new_array = (double*) qmckl_malloc(context, mem_info); + + if (new_array == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_ao_basis_coefficient", + NULL); + } + + memcpy(new_array, coefficient, mem_info.size); + + ctx->ao_basis.coefficient = new_array; + + <> +} + + #+end_src + + + +* Polynomial part + +** Powers of $x-X_i$ + + The ~qmckl_ao_power~ function computes all the powers of the ~n~ + input data up to the given maximum value given in input for each of + the $n$ points: + + \[ P_{ik} = X_i^k \] + + | ~context~ | input | Global state | + | ~n~ | input | Number of values | + | ~X(n)~ | input | Array containing the input values | + | ~LMAX(n)~ | input | Array containing the maximum power for each value | + | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | + | ~LDP~ | input | Leading dimension of array ~P~ | + + Requirements: + + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~n~ > 0 + - ~X~ is allocated with at least $n \times 8$ bytes + - ~LMAX~ is allocated with at least $n \times 4$ bytes + - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - ~LDP~ >= $\max_i$ ~LMAX[i]~ + + #+begin_src c :tangle (eval h_func) +qmckl_exit_code +qmckl_ao_power(const qmckl_context context, + const int64_t n, + const double *X, + const int32_t *LMAX, + const double *P, + const int64_t LDP); + #+end_src + + #+begin_src f90 :tangle (eval f) +integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) + use qmckl + implicit none + integer*8 , intent(in) :: context + integer*8 , intent(in) :: n + real*8 , intent(in) :: X(n) + integer , intent(in) :: LMAX(n) + real*8 , intent(out) :: P(ldp,n) + integer*8 , intent(in) :: ldp + + integer*8 :: i,k + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (n <= ldp) then + info = QMCKL_INVALID_ARG_2 + return + endif + + k = MAXVAL(LMAX) + if (LDP < k) then + info = QMCKL_INVALID_ARG_6 + return + endif + + if (k <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + do i=1,n + P(1,i) = X(i) + do k=2,LMAX(i) + P(k,i) = P(k-1,i) * X(i) + end do + end do + +end function qmckl_ao_power_f + #+end_src + + #+begin_src f90 :tangle (eval f) :exports none +integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: n + real (c_double) , intent(in) :: X(n) + integer (c_int32_t) , intent(in) :: LMAX(n) + real (c_double) , intent(out) :: P(ldp,n) + integer (c_int64_t) , intent(in) , value :: ldp + + integer, external :: qmckl_ao_power_f + info = qmckl_ao_power_f(context, n, X, LMAX, P, ldp) +end function qmckl_ao_power + #+end_src + + #+begin_src f90 :tangle (eval fh_func) :exports none + interface + integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: n + integer (c_int64_t) , intent(in) , value :: ldp + real (c_double) , intent(in) :: X(n) + integer (c_int32_t) , intent(in) :: LMAX(n) + real (c_double) , intent(out) :: P(ldp,n) + end function qmckl_ao_power + end interface + #+end_src + + # Test + #+begin_src f90 :tangle (eval f_test) +integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) + use qmckl + implicit none + + integer(qmckl_context), intent(in), value :: context + + integer*8 :: n, LDP + integer, allocatable :: LMAX(:) + double precision, allocatable :: X(:), P(:,:) + integer*8 :: i,j + double precision :: epsilon + + epsilon = qmckl_get_numprec_epsilon(context) + print *, epsilon + + n = 100; + LDP = 10; + + allocate(X(n), P(LDP,n), LMAX(n)) + + do j=1,n + X(j) = -5.d0 + 0.1d0 * dble(j) + LMAX(j) = 1 + int(mod(j, 5),4) + end do + + test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP) + if (test_qmckl_ao_power /= QMCKL_SUCCESS) return + + test_qmckl_ao_power = QMCKL_FAILURE + + do j=1,n + do i=1,LMAX(j) + if ( X(j)**i == 0.d0 ) then + if ( P(i,j) /= 0.d0) return + else + if ( dabs(1.d0 - P(i,j) / (X(j)**i)) > epsilon ) return + end if + end do + end do + + test_qmckl_ao_power = QMCKL_SUCCESS + deallocate(X,P,LMAX) +end function test_qmckl_ao_power + #+end_src + + #+begin_src c :tangle (eval c_test) :exports none +int test_qmckl_ao_power(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_ao_power(context)); + #+end_src + +** Value, Gradient and Laplacian of a polynomial + + A polynomial is centered on a nucleus $\mathbf{R}_i$ + + \[ + P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c + \] + + The gradients with respect to electron coordinates are + + \begin{eqnarray*} + \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ + \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ + \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ + \end{eqnarray*} + + and the Laplacian is + + \begin{eqnarray*} + \left( \frac{\partial }{\partial x^2} + + \frac{\partial }{\partial y^2} + + \frac{\partial }{\partial z^2} \right) P_l + \left(\mathbf{r},\mathbf{R}_i \right) & = & + a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ + && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ + && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1}. + \end{eqnarray*} + + ~qmckl_ao_polynomial_vgl~ computes the values, gradients and + Laplacians at a given point in space, of all polynomials with an + angular momentum up to ~lmax~. + + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~lmax~ | input | Maximum angular momentum | + | ~n~ | output | Number of computed polynomials | + | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | + | ~ldl~ | input | Leading dimension of ~L~ | + | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | + | ~ldv~ | input | Leading dimension of array ~VGL~ | + + Requirements: + + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~n~ > 0 + - ~lmax~ >= 0 + - ~ldl~ >= 3 + - ~ldv~ >= 5 + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ + - ~L~ is allocated with at least $3 \times n \times 4$ bytes + - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes + - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ + - On output, the powers are given in the following order (l=a+b+c): + - Increasing values of ~l~ + - Within a given value of ~l~, alphabetical order of the + string made by a*"x" + b*"y" + c*"z" (in Python notation). + For example, with a=0, b=2 and c=1 the string is "yyz" + + # Header + #+begin_src c :tangle (eval h_func) +qmckl_exit_code +qmckl_ao_polynomial_vgl(const qmckl_context context, + const double *X, + const double *R, + const int32_t lmax, + const int64_t *n, + const int32_t *L, + const int64_t ldl, + const double *VGL, + const int64_t ldv); + #+end_src + + # Source + #+begin_src f90 :tangle (eval f) +integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) + use qmckl + implicit none + integer*8 , intent(in) :: context + real*8 , intent(in) :: X(3), R(3) + integer , intent(in) :: lmax + integer*8 , intent(out) :: n + integer , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer*8 , intent(in) :: ldl + real*8 , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer*8 , intent(in) :: ldv + + integer*8 :: i,j + integer :: a,b,c,d + real*8 :: Y(3) + integer :: lmax_array(3) + real*8 :: pows(-2:lmax,3) + integer, external :: qmckl_ao_power_f + double precision :: xy, yz, xz + double precision :: da, db, dc, dd + + info = 0 + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (lmax < 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (ldl < 3) then + info = QMCKL_INVALID_ARG_7 + return + endif + + if (ldv < 5) then + info = QMCKL_INVALID_ARG_9 + return + endif + + + do i=1,3 + Y(i) = X(i) - R(i) + end do + + lmax_array(1:3) = lmax + if (lmax == 0) then + VGL(1,1) = 1.d0 + vgL(2:5,1) = 0.d0 + l(1:3,1) = 0 + n=1 + else if (lmax > 0) then + pows(-2:0,1:3) = 1.d0 + do i=1,lmax + pows(i,1) = pows(i-1,1) * Y(1) + pows(i,2) = pows(i-1,2) * Y(2) + pows(i,3) = pows(i-1,3) * Y(3) + end do + + VGL(1:5,1:4) = 0.d0 + l (1:3,1:4) = 0 + + VGL(1 ,1 ) = 1.d0 + vgl(1:5,2:4) = 0.d0 + + l (1,2) = 1 + vgl(1,2) = pows(1,1) + vgL(2,2) = 1.d0 + + l (2,3) = 1 + vgl(1,3) = pows(1,2) + vgL(3,3) = 1.d0 + + l (3,4) = 1 + vgl(1,4) = pows(1,3) + vgL(4,4) = 1.d0 + + n=4 + endif + + ! l>=2 + dd = 2.d0 + do d=2,lmax + da = dd + do a=d,0,-1 + db = dd-da + do b=d-a,0,-1 + c = d - a - b + dc = dd - da - db + n = n+1 + + l(1,n) = a + l(2,n) = b + l(3,n) = c + + xy = pows(a,1) * pows(b,2) + yz = pows(b,2) * pows(c,3) + xz = pows(a,1) * pows(c,3) + + vgl(1,n) = xy * pows(c,3) + + xy = dc * xy + xz = db * xz + yz = da * yz + + vgl(2,n) = pows(a-1,1) * yz + vgl(3,n) = pows(b-1,2) * xz + vgl(4,n) = pows(c-1,3) * xy + + vgl(5,n) = & + (da-1.d0) * pows(a-2,1) * yz + & + (db-1.d0) * pows(b-2,2) * xz + & + (dc-1.d0) * pows(c-2,3) * xy + + db = db - 1.d0 + end do + da = da - 1.d0 + end do + dd = dd + 1.d0 + end do + + info = QMCKL_SUCCESS + +end function qmckl_ao_polynomial_vgl_f + #+end_src + + + #+begin_src f90 :tangle (eval f) :exports none +integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + real (c_double) , intent(in) :: X(3), R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(out) :: n + integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer (c_int64_t) , intent(in) , value :: ldv + + integer, external :: qmckl_ao_polynomial_vgl_f + info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) +end function qmckl_ao_polynomial_vgl + #+end_src + + #+begin_src f90 :tangle (eval fh_func) :exports none + interface + integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t) , intent(in) , value :: context + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(in) , value :: ldl + integer (c_int64_t) , intent(in) , value :: ldv + real (c_double) , intent(in) :: X(3), R(3) + integer (c_int64_t) , intent(out) :: n + integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) + real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + end function qmckl_ao_polynomial_vgl + end interface + #+end_src + + #+begin_src f90 :tangle (eval f_test) +integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) + use qmckl + implicit none + + integer(c_int64_t), intent(in), value :: context + + integer :: lmax, d, i + integer, allocatable :: L(:,:) + integer*8 :: n, ldl, ldv, j + double precision :: X(3), R(3), Y(3) + double precision, allocatable :: VGL(:,:) + double precision :: w + double precision :: epsilon + + epsilon = qmckl_get_numprec_epsilon(context) + + X = (/ 1.1 , 2.2 , 3.3 /) + R = (/ 0.1 , 1.2 , -2.3 /) + Y(:) = X(:) - R(:) + + lmax = 4; + ldl = 3; + ldv = 100; + + d = (lmax+1)*(lmax+2)*(lmax+3)/6 + + allocate (L(ldl,d), VGL(ldv,d)) + + test_qmckl_ao_polynomial_vgl = & + qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) + + if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return + if (n /= d) return + + do j=1,n + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE + do i=1,3 + if (L(i,j) < 0) return + end do + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE + if (dabs(1.d0 - VGL(1,j) / (& + Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) & + )) > epsilon ) return + + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE + if (L(1,j) < 1) then + if (VGL(2,j) /= 0.d0) return + else + if (dabs(1.d0 - VGL(2,j) / (& + L(1,j) * Y(1)**(L(1,j)-1) * Y(2)**L(2,j) * Y(3)**L(3,j) & + )) > epsilon ) return + end if + + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE + if (L(2,j) < 1) then + if (VGL(3,j) /= 0.d0) return + else + if (dabs(1.d0 - VGL(3,j) / (& + L(2,j) * Y(1)**L(1,j) * Y(2)**(L(2,j)-1) * Y(3)**L(3,j) & + )) > epsilon ) return + end if + + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE + if (L(3,j) < 1) then + if (VGL(4,j) /= 0.d0) return + else + if (dabs(1.d0 - VGL(4,j) / (& + L(3,j) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-1) & + )) > epsilon ) return + end if + + test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE + w = 0.d0 + if (L(1,j) > 1) then + w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j) + end if + if (L(2,j) > 1) then + w = w + L(2,j) * (L(2,j)-1) * Y(1)**L(1,j) * Y(2)**(L(2,j)-2) * Y(3)**L(3,j) + end if + if (L(3,j) > 1) then + w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2) + end if + if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return + end do + + test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS + + deallocate(L,VGL) +end function test_qmckl_ao_polynomial_vgl + #+end_src + + #+begin_src c :tangle (eval c_test) +int test_qmckl_ao_polynomial_vgl(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); + #+end_src + +* Gaussian basis functions + + ~qmckl_ao_gaussian_vgl~ computes the values, gradients and + Laplacians at a given point of ~n~ Gaussian functions centered at + the same point: + + \[ v_i = \exp(-a_i |X-R|^2) \] + \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] + \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] + \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] + \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] + + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~n~ | input | Number of computed Gaussians | + | ~A(n)~ | input | Exponents of the Gaussians | + | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | + | ~ldv~ | input | Leading dimension of array ~VGL~ | + + Requirements : + + - ~context~ is not 0 + - ~n~ > 0 + - ~ldv~ >= 5 + - ~A(i)~ > 0 for all ~i~ + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~A~ is allocated with at least $n \times 8$ bytes + - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes + + #+begin_src c :tangle (eval h_func) +qmckl_exit_code +qmckl_ao_gaussian_vgl(const qmckl_context context, + const double *X, + const double *R, + const int64_t *n, + const int64_t *A, + const double *VGL, + const int64_t ldv); + #+end_src + + #+begin_src f90 :tangle (eval f) +integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) + use qmckl + implicit none + integer*8 , intent(in) :: context + real*8 , intent(in) :: X(3), R(3) + integer*8 , intent(in) :: n + real*8 , intent(in) :: A(n) + real*8 , intent(out) :: VGL(ldv,5) + integer*8 , intent(in) :: ldv + + integer*8 :: i,j + real*8 :: Y(3), r2, t, u, v + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (n <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (ldv < n) then + info = QMCKL_INVALID_ARG_7 + return + endif + + + do i=1,3 + Y(i) = X(i) - R(i) + end do + r2 = Y(1)*Y(1) + Y(2)*Y(2) + Y(3)*Y(3) + + do i=1,n + VGL(i,1) = dexp(-A(i) * r2) + end do + + do i=1,n + VGL(i,5) = A(i) * VGL(i,1) + end do + + t = -2.d0 * ( X(1) - R(1) ) + u = -2.d0 * ( X(2) - R(2) ) + v = -2.d0 * ( X(3) - R(3) ) + + do i=1,n + VGL(i,2) = t * VGL(i,5) + VGL(i,3) = u * VGL(i,5) + VGL(i,4) = v * VGL(i,5) + end do + + t = 4.d0 * r2 + do i=1,n + VGL(i,5) = (t * A(i) - 6.d0) * VGL(i,5) + end do + +end function qmckl_ao_gaussian_vgl_f + #+end_src + + #+begin_src f90 :tangle (eval f) :exports none +integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + real (c_double) , intent(in) :: X(3), R(3) + integer (c_int64_t) , intent(in) , value :: n + real (c_double) , intent(in) :: A(n) + real (c_double) , intent(out) :: VGL(ldv,5) + integer (c_int64_t) , intent(in) , value :: ldv + + integer, external :: qmckl_ao_gaussian_vgl_f + info = qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) +end function qmckl_ao_gaussian_vgl + #+end_src + + #+begin_src f90 :tangle (eval fh_func) :exports none + interface + integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & + bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: ldv + integer (c_int64_t) , intent(in) , value :: n + real (c_double) , intent(in) :: X(3), R(3), A(n) + real (c_double) , intent(out) :: VGL(ldv,5) + end function qmckl_ao_gaussian_vgl + end interface + #+end_src + + # Test + #+begin_src f90 :tangle (eval f_test) +integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) + use qmckl + implicit none + + integer(c_int64_t), intent(in), value :: context + + integer*8 :: n, ldv, j, i + double precision :: X(3), R(3), Y(3), r2 + double precision, allocatable :: VGL(:,:), A(:) + double precision :: epsilon + + epsilon = qmckl_get_numprec_epsilon(context) + + X = (/ 1.1 , 2.2 , 3.3 /) + R = (/ 0.1 , 1.2 , -2.3 /) + Y(:) = X(:) - R(:) + r2 = Y(1)**2 + Y(2)**2 + Y(3)**2 + + n = 10; + ldv = 100; + + allocate (A(n), VGL(ldv,5)) + do i=1,n + A(i) = 0.0013 * dble(ishft(1,i)) + end do + + + test_qmckl_ao_gaussian_vgl = & + qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) + if (test_qmckl_ao_gaussian_vgl /= 0) return + + test_qmckl_ao_gaussian_vgl = -1 + + do i=1,n + test_qmckl_ao_gaussian_vgl = -11 + if (dabs(1.d0 - VGL(i,1) / (& + dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussian_vgl = -12 + if (dabs(1.d0 - VGL(i,2) / (& + -2.d0 * A(i) * Y(1) * dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussian_vgl = -13 + if (dabs(1.d0 - VGL(i,3) / (& + -2.d0 * A(i) * Y(2) * dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussian_vgl = -14 + if (dabs(1.d0 - VGL(i,4) / (& + -2.d0 * A(i) * Y(3) * dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussian_vgl = -15 + if (dabs(1.d0 - VGL(i,5) / (& + A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) & + )) > epsilon ) return + end do + + test_qmckl_ao_gaussian_vgl = 0 + + deallocate(VGL) +end function test_qmckl_ao_gaussian_vgl + #+end_src + + #+begin_src c :tangle (eval c_test) :exports none +int test_qmckl_ao_gaussian_vgl(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); + #+end_src + +* TODO Slater basis functions + +* End of files :noexport: + + #+begin_src c :tangle (eval h_private_type) +#endif + #+end_src + +*** Test + #+begin_src c :tangle (eval c_test) + if (qmckl_context_destroy(context) != QMCKL_SUCCESS) + return QMCKL_FAILURE; + return MUNIT_OK; +} + #+end_src + +**✸ Compute file names + #+begin_src emacs-lisp +; The following is required to compute the file names + +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + +; Minted +(require 'ox-latex) +(setq org-latex-listings 'minted) +(add-to-list 'org-latex-packages-alist '("" "listings")) +(add-to-list 'org-latex-packages-alist '("" "color")) + + #+end_src + + #+RESULTS: + | | color | + | | listings | + + +# -*- mode: org -*- +# vim: syntax=c + + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index c2d660e..8c6e8d4 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -25,6 +25,7 @@ MunitResult test_<>() { #include "qmckl_error_private_type.h" #include "qmckl_memory_private_type.h" #include "qmckl_numprec_private_type.h" +#include "qmckl_ao_private_type.h" #+end_src #+begin_src c :tangle (eval c) @@ -39,6 +40,7 @@ MunitResult test_<>() { #include "qmckl_error_type.h" #include "qmckl_context_private_type.h" #include "qmckl_context_type.h" +#include "qmckl_numprec_type.h" #include "qmckl_memory_private_func.h" #include "qmckl_context_func.h" @@ -97,9 +99,9 @@ typedef struct qmckl_context_struct { qmckl_memory_struct memory; /* -- Molecular system -- */ - /* To be implemented: qmckl_ao_basis_struct ao_basis; + /* To be implemented: qmckl_nucleus_struct nucleus; qmckl_electron_struct electron; qmckl_mo_struct mo; @@ -198,6 +200,11 @@ qmckl_context qmckl_context_create() { const qmckl_context context = (const qmckl_context) ctx; assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); + ctx->numprec.precision = QMCKL_DEFAULT_PRECISION; + ctx->numprec.range = QMCKL_DEFAULT_RANGE; + + ctx->ao_basis.uninitialized = (1 << 10) - 1; + /* Allocate qmckl_memory_struct */ { const size_t size = 128L; diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index cad3809..cdd2fa9 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -92,7 +92,7 @@ MunitResult test_<>() { integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) use qmckl implicit none - integer*8 , intent(in) :: context + integer(qmckl_context) , intent(in) :: context character , intent(in) :: transa, transb integer*8 , intent(in) :: m, n integer*8 , intent(in) :: lda @@ -227,15 +227,13 @@ end function qmckl_distance_sq_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none - integer (qmckl_exit_code) function qmckl_distance_sq & + integer (c_int32_t) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) result(info) - use, intrinsic :: iso_c_binding - import implicit none - integer (qmckl_context), intent(in) :: context + integer (c_int64_t) , intent(in) :: context character , intent(in) :: transa character , intent(in) :: transb integer (c_int64_t) , intent(in) :: m @@ -247,7 +245,7 @@ end function qmckl_distance_sq_f real (c_double ) , intent(out) :: C(ldc,n) integer (c_int64_t) , intent(in) :: ldc - integer (qmckl_exit_code), external :: qmckl_distance_sq_f + integer (c_int32_t), external :: qmckl_distance_sq_f info = qmckl_distance_sq_f & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) @@ -257,7 +255,7 @@ end function qmckl_distance_sq_f #+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) #+RESULTS: - #+begin_src f90 :tangle (eval fh) :comments org :exports none + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface integer (qmckl_exit_code) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & diff --git a/src/qmckl_numprec.org b/src/qmckl_numprec.org index 8349529..a20537b 100644 --- a/src/qmckl_numprec.org +++ b/src/qmckl_numprec.org @@ -289,7 +289,8 @@ int qmckl_get_numprec_range(const qmckl_context context) { * Helper functions - ~qmckl_context_get_epsilon~ returns $\epsilon = 2^{1-n}$ where ~n~ is the precision. + ~qmckl_get_numprec_epsilon~ returns $\epsilon = 2^{1-n}$ where ~n~ is the precision. + We need to remove the sign bit from the precision. #+begin_src c :comments org :tangle (eval h_func) :exports none double qmckl_get_numprec_epsilon(const qmckl_context context); @@ -299,7 +300,7 @@ double qmckl_get_numprec_epsilon(const qmckl_context context); #+begin_src c :tangle (eval c) double qmckl_get_numprec_epsilon(const qmckl_context context) { const int precision = qmckl_get_numprec_precision(context); - return 1. / (double) (1L << (precision-1)); + return 1. / (double) (1L << (precision-2)); } #+end_src diff --git a/src/table_of_contents b/src/table_of_contents index 03c9622..b9fd652 100644 --- a/src/table_of_contents +++ b/src/table_of_contents @@ -2,4 +2,6 @@ qmckl.org qmckl_error.org qmckl_context.org qmckl_memory.org +qmckl_ao.org +qmckl_distance.org test_qmckl.org From 249c145d0c6c525175e0ea5f67a50446a8ea3980 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 1 Apr 2021 10:59:36 +0200 Subject: [PATCH 47/65] Added tile --- src/qmckl_tile.org | 496 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 496 insertions(+) create mode 100644 src/qmckl_tile.org diff --git a/src/qmckl_tile.org b/src/qmckl_tile.org new file mode 100644 index 0000000..189944b --- /dev/null +++ b/src/qmckl_tile.org @@ -0,0 +1,496 @@ +#+TITLE: Tiled arrays +#+SETUPFILE: ../docs/theme.setup + +To increase performance, matrices may be stored as tiled +arrays. Instead of storing a matrix in a two-dimensional array, it may +be stored as a two dimensional array of small matrices (a rank 4 +tensor). This improves the locality of the data in matrix +multiplications, and also enables the possibility to use BLAS3 +while also exploiting part of the sparse structure of the matrices. + + Tile + │ ┌──────┬──────┬──────┐ + │ │1 4 7 │ │ │ + └───────►│2 5 8 │ T_12 │ T_13 │ + │3 6 9 │ │ │ + ├──────┼──────┼──────┤ + │ │ │ │ + │ T_21 │ T_22 │ T_23 │ + │ │ │ │ + ├──────┼──────┼──────┤ + │ │ │ │ + │ T_31 │ T_32 │ T_33 │ + │ │ │ │ + └──────┴──────┴──────┘ + + In this file, tiled matrice will be produced for the following + types: + + #+NAME: types + | float | + | double | + +* Headers :noexport: + + #+NAME: filename + #+begin_src elisp :tangle no +(file-name-nondirectory (substring buffer-file-name 0 -4)) + #+end_src + + #+begin_src c :tangle (eval h_private_type) +#ifndef QMCKL_TILE_HPT +#define QMCKL_TILE_HPT + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes +#include "qmckl.h" +#include "munit.h" +MunitResult test_<>() { + qmckl_context context; + context = qmckl_context_create(); + #+end_src + + #+begin_src c :tangle (eval c) +#include +#include +#include +#include +#include + +#include "qmckl_context_type.h" +#include "qmckl_error_type.h" +#include "qmckl_memory_private_type.h" +#include "qmckl_tile_private_type.h" + +#include "qmckl_context_func.h" +#include "qmckl_error_func.h" +#include "qmckl_memory_private_func.h" +#include "qmckl_tile_private_func.h" + #+end_src + +* Data structures + +** Tile + + A tile is a small matrix of fixed size. The dimensions of the + tiles is fixed at compile-time to increase performance. It is + defined as $2^s$: + + | s | tile size | + |----+-----------| + | 2 | 4 | + | 3 | 8 | + | 4 | 16 | + | 55 | 32 | + | 6 | 64 | + | 7 | 128 | + + + #+begin_src c :tangle (eval h_private_type) +#define TILE_SIZE_SHIFT 3 +#define TILE_SIZE 8 + #+end_src + + + #+NAME: tile_hpt + #+begin_src c +typedef struct $T$_tile_struct { + $T$ element[TILE_SIZE][TILE_SIZE]; + int32_t is_null; + int32_t padding; +} $T$_tile_struct; + #+end_src + +** Tiled matrix + + A tiled matrix is a two-dimensional array of tiles. + + #+NAME: matrix_hpt + #+begin_src c +typedef struct $T$_tiled_matrix { + $T$_tile_struct** tile; + size_t rows; + size_t cols; +} $T$_tiled_matrix; + #+end_src + + When a tiled matrix is initialized, it is set to zero. + + #+NAME: init_hpf + #+begin_src c +qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, + $T$_tiled_matrix* m, + size_t rows, + size_t cols); + #+end_src + + #+NAME: init_c + #+begin_src c +qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, + $T$_tiled_matrix* m, + size_t rows, + size_t cols) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_INVALID_CONTEXT; + } + + if (m == NULL) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "$T$_tiled_matrix_init", + NULL); + } + + if (rows == (size_t) 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_3, + "$T$_tiled_matrix_init", + NULL); + } + + if (cols == (size_t) 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_4, + "$T$_tiled_matrix_init", + NULL); + } + + qmckl_memory_info_struct info = qmckl_memory_info_struct_zero; + size_t n = rows * cols; + + /* Check overflow */ + if (n/cols != rows + || n > SIZE_MAX / sizeof($T$_tile_struct) ) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "$T$_tiled_matrix_init", + "rows * cols overflows" ); + } + + /* Allocate array of column pointers */ + info.size = cols * sizeof($T$_tile_struct*) ; + m->tile = ($T$_tile_struct**) qmckl_malloc(context, info); + + if (m->tile == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "$T$_tiled_matrix_init", + NULL); + } + + + /* Allocate array of tiles */ + info.size = n * sizeof($T$_tile_struct) ; + m->tile[0] = ($T$_tile_struct*) qmckl_malloc(context, info); + + if (m->tile[0] == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "$T$_tiled_matrix_init", + NULL); + } + + /* Compute array of pointers to the 1st element of columns */ + for (size_t i=1 ; itile[i] = m->tile[i-1] + rows; + } + + m->rows = rows; + m->cols = cols; + return QMCKL_SUCCESS; +} + + #+end_src + +* Write templates + + #+begin_src python :noweb yes :results drawer :var types=types :exports results +def generate(f, text): + result = [ f"#+begin_src c :tangle (eval {f})" ] + for t in types: + t=t[0] + result += [ text.replace("$T$",t), "" ] + + result += [ "#+end_src" ] + return '\n'.join(result) + +return '\n'.join( [ "" + +, generate("h_private_type", """ +<> + +<> +""") + +, "" + +, generate("h_private_func", """ +<> +""") + +, "" + +, generate("c", """ +<> +""") + +] ) + #+end_src + + #+RESULTS: + :results: + + #+begin_src c :tangle (eval h_private_type) + + typedef struct float_tile_struct { + float element[TILE_SIZE][TILE_SIZE]; + int32_t is_null; + int32_t padding; + } float_tile_struct; + + typedef struct float_tiled_matrix { + float_tile_struct** tile; + size_t rows; + size_t cols; + } float_tiled_matrix; + + + + typedef struct double_tile_struct { + double element[TILE_SIZE][TILE_SIZE]; + int32_t is_null; + int32_t padding; + } double_tile_struct; + + typedef struct double_tiled_matrix { + double_tile_struct** tile; + size_t rows; + size_t cols; + } double_tiled_matrix; + + + #+end_src + + #+begin_src c :tangle (eval h_private_func) + + qmckl_exit_code float_tiled_matrix_init (qmckl_context context, + float_tiled_matrix* m, + size_t rows, + size_t cols); + + + + qmckl_exit_code double_tiled_matrix_init (qmckl_context context, + double_tiled_matrix* m, + size_t rows, + size_t cols); + + + #+end_src + + #+begin_src c :tangle (eval c) + + qmckl_exit_code float_tiled_matrix_init (qmckl_context context, + float_tiled_matrix* m, + size_t rows, + size_t cols) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_INVALID_CONTEXT; + } + + if (m == NULL) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "float_tiled_matrix_init", + NULL); + } + + if (rows == (size_t) 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_3, + "float_tiled_matrix_init", + NULL); + } + + if (cols == (size_t) 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_4, + "float_tiled_matrix_init", + NULL); + } + + qmckl_memory_info_struct info = qmckl_memory_info_struct_zero; + size_t n = rows * cols; + + /* Check overflow */ + if (n/cols != rows + || n > SIZE_MAX / sizeof(float_tile_struct) ) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "float_tiled_matrix_init", + "rows * cols overflows" ); + } + + /* Allocate array of column pointers */ + info.size = cols * sizeof(float_tile_struct*) ; + m->tile = (float_tile_struct**) qmckl_malloc(context, info); + + if (m->tile == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "float_tiled_matrix_init", + NULL); + } + + + /* Allocate array of tiles */ + info.size = n * sizeof(float_tile_struct) ; + m->tile[0] = (float_tile_struct*) qmckl_malloc(context, info); + + if (m->tile[0] == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "float_tiled_matrix_init", + NULL); + } + + /* Compute array of pointers to the 1st element of columns */ + for (size_t i=1 ; itile[i] = m->tile[i-1] + rows; + } + + m->rows = rows; + m->cols = cols; + return QMCKL_SUCCESS; + } + + + + + qmckl_exit_code double_tiled_matrix_init (qmckl_context context, + double_tiled_matrix* m, + size_t rows, + size_t cols) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_INVALID_CONTEXT; + } + + if (m == NULL) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "double_tiled_matrix_init", + NULL); + } + + if (rows == (size_t) 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_3, + "double_tiled_matrix_init", + NULL); + } + + if (cols == (size_t) 0) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_4, + "double_tiled_matrix_init", + NULL); + } + + qmckl_memory_info_struct info = qmckl_memory_info_struct_zero; + size_t n = rows * cols; + + /* Check overflow */ + if (n/cols != rows + || n > SIZE_MAX / sizeof(double_tile_struct) ) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "double_tiled_matrix_init", + "rows * cols overflows" ); + } + + /* Allocate array of column pointers */ + info.size = cols * sizeof(double_tile_struct*) ; + m->tile = (double_tile_struct**) qmckl_malloc(context, info); + + if (m->tile == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "double_tiled_matrix_init", + NULL); + } + + + /* Allocate array of tiles */ + info.size = n * sizeof(double_tile_struct) ; + m->tile[0] = (double_tile_struct*) qmckl_malloc(context, info); + + if (m->tile[0] == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "double_tiled_matrix_init", + NULL); + } + + /* Compute array of pointers to the 1st element of columns */ + for (size_t i=1 ; itile[i] = m->tile[i-1] + rows; + } + + m->rows = rows; + m->cols = cols; + return QMCKL_SUCCESS; + } + + + + #+end_src + :end: + +* End of files :noexport: + + #+begin_src c :tangle (eval h_private_type) +#endif + #+end_src + +*** Test + #+begin_src c :tangle (eval c_test) + if (qmckl_context_destroy(context) != QMCKL_SUCCESS) + return QMCKL_FAILURE; + return MUNIT_OK; +} + #+end_src + +**✸ Compute file names + #+begin_src emacs-lisp +; The following is required to compute the file names + +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + +; Minted +(require 'ox-latex) +(setq org-latex-listings 'minted) +(add-to-list 'org-latex-packages-alist '("" "listings")) +(add-to-list 'org-latex-packages-alist '("" "color")) + + #+end_src + + #+RESULTS: + | | color | + | | listings | + + +# -*- mode: org -*- +# vim: syntax=c + + From fbfe55893706d417da0dc940f77b1682684902de Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 2 Apr 2021 12:04:24 +0200 Subject: [PATCH 48/65] Update names --- src/qmckl_tile.org | 141 ++++++++++++++++++++++++++------------------- 1 file changed, 83 insertions(+), 58 deletions(-) diff --git a/src/qmckl_tile.org b/src/qmckl_tile.org index 189944b..6c88fe7 100644 --- a/src/qmckl_tile.org +++ b/src/qmckl_tile.org @@ -76,19 +76,20 @@ MunitResult test_<>() { tiles is fixed at compile-time to increase performance. It is defined as $2^s$: - | s | tile size | - |----+-----------| - | 2 | 4 | - | 3 | 8 | - | 4 | 16 | - | 55 | 32 | - | 6 | 64 | - | 7 | 128 | + | s | tile size | + |---+-----------| + | 2 | 4 | + | 3 | 8 | + | 4 | 16 | + | 5 | 32 | + | 6 | 64 | + | 7 | 128 | #+begin_src c :tangle (eval h_private_type) #define TILE_SIZE_SHIFT 3 #define TILE_SIZE 8 +#define VEC_SIZE 8 #+end_src @@ -96,8 +97,8 @@ MunitResult test_<>() { #+begin_src c typedef struct $T$_tile_struct { $T$ element[TILE_SIZE][TILE_SIZE]; - int32_t is_null; - int32_t padding; + int64_t is_null; + int64_t padding[VEC_SIZE-1]; } $T$_tile_struct; #+end_src @@ -109,8 +110,10 @@ typedef struct $T$_tile_struct { #+begin_src c typedef struct $T$_tiled_matrix { $T$_tile_struct** tile; - size_t rows; - size_t cols; + size_t n_row; + size_t n_col; + size_t n_tile_row; + size_t n_tile_col; } $T$_tiled_matrix; #+end_src @@ -120,16 +123,37 @@ typedef struct $T$_tiled_matrix { #+begin_src c qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, $T$_tiled_matrix* m, - size_t rows, - size_t cols); + size_t n_tile_row, + size_t n_tile_col); #+end_src #+NAME: init_c #+begin_src c qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, $T$_tiled_matrix* m, - size_t rows, - size_t cols) { + size_t n_tile_row, + size_t n_tile_col) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { +} $T$_tiled_matrix; + #+end_src + + When a tiled matrix is initialized, it is set to zero. + + #+NAME: init_hpf + #+begin_src c +qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, + $T$_tiled_matrix* m, + size_t n_tile_row, + size_t n_tile_col); + #+end_src + + #+NAME: init_c + #+begin_src c +qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, + $T$_tiled_matrix* m, + size_t n_tile_row, + size_t n_tile_col) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_INVALID_CONTEXT; @@ -142,14 +166,14 @@ qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, NULL); } - if (rows == (size_t) 0) { + if (n_tile_row == (size_t) 0) { return qmckl_failwith(context, QMCKL_INVALID_ARG_3, "$T$_tiled_matrix_init", NULL); } - if (cols == (size_t) 0) { + if (n_tile_col == (size_t) 0) { return qmckl_failwith(context, QMCKL_INVALID_ARG_4, "$T$_tiled_matrix_init", @@ -157,19 +181,19 @@ qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, } qmckl_memory_info_struct info = qmckl_memory_info_struct_zero; - size_t n = rows * cols; + size_t n = n_tile_row * n_tile_col; /* Check overflow */ - if (n/cols != rows + if (n/n_tile_col != n_tile_row || n > SIZE_MAX / sizeof($T$_tile_struct) ) { return qmckl_failwith(context, QMCKL_ALLOCATION_FAILED, "$T$_tiled_matrix_init", - "rows * cols overflows" ); + "n_tile_row * n_tile_col overflows" ); } /* Allocate array of column pointers */ - info.size = cols * sizeof($T$_tile_struct*) ; + info.size = n_tile_col * sizeof($T$_tile_struct*) ; m->tile = ($T$_tile_struct**) qmckl_malloc(context, info); if (m->tile == NULL) { @@ -192,15 +216,16 @@ qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context, } /* Compute array of pointers to the 1st element of columns */ - for (size_t i=1 ; itile[i] = m->tile[i-1] + rows; + for (size_t i=1 ; itile[i] = m->tile[i-1] + n_tile_row; } - m->rows = rows; - m->cols = cols; + m->n_tile_row = n_tile_row; + m->n_tile_col = n_tile_col; return QMCKL_SUCCESS; } + #+end_src * Write templates @@ -251,8 +276,8 @@ return '\n'.join( [ "" typedef struct float_tiled_matrix { float_tile_struct** tile; - size_t rows; - size_t cols; + size_t n_tile_row; + size_t n_tile_col; } float_tiled_matrix; @@ -265,8 +290,8 @@ return '\n'.join( [ "" typedef struct double_tiled_matrix { double_tile_struct** tile; - size_t rows; - size_t cols; + size_t n_tile_row; + size_t n_tile_col; } double_tiled_matrix; @@ -276,15 +301,15 @@ return '\n'.join( [ "" qmckl_exit_code float_tiled_matrix_init (qmckl_context context, float_tiled_matrix* m, - size_t rows, - size_t cols); + size_t n_tile_row, + size_t n_tile_col); qmckl_exit_code double_tiled_matrix_init (qmckl_context context, double_tiled_matrix* m, - size_t rows, - size_t cols); + size_t n_tile_row, + size_t n_tile_col); #+end_src @@ -293,8 +318,8 @@ return '\n'.join( [ "" qmckl_exit_code float_tiled_matrix_init (qmckl_context context, float_tiled_matrix* m, - size_t rows, - size_t cols) { + size_t n_tile_row, + size_t n_tile_col) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_INVALID_CONTEXT; @@ -307,14 +332,14 @@ return '\n'.join( [ "" NULL); } - if (rows == (size_t) 0) { + if (n_tile_row == (size_t) 0) { return qmckl_failwith(context, QMCKL_INVALID_ARG_3, "float_tiled_matrix_init", NULL); } - if (cols == (size_t) 0) { + if (n_tile_col == (size_t) 0) { return qmckl_failwith(context, QMCKL_INVALID_ARG_4, "float_tiled_matrix_init", @@ -322,19 +347,19 @@ return '\n'.join( [ "" } qmckl_memory_info_struct info = qmckl_memory_info_struct_zero; - size_t n = rows * cols; + size_t n = n_tile_row * n_tile_col; /* Check overflow */ - if (n/cols != rows + if (n/n_tile_col != n_tile_row || n > SIZE_MAX / sizeof(float_tile_struct) ) { return qmckl_failwith(context, QMCKL_ALLOCATION_FAILED, "float_tiled_matrix_init", - "rows * cols overflows" ); + "n_tile_row * n_tile_col overflows" ); } /* Allocate array of column pointers */ - info.size = cols * sizeof(float_tile_struct*) ; + info.size = n_tile_col * sizeof(float_tile_struct*) ; m->tile = (float_tile_struct**) qmckl_malloc(context, info); if (m->tile == NULL) { @@ -357,12 +382,12 @@ return '\n'.join( [ "" } /* Compute array of pointers to the 1st element of columns */ - for (size_t i=1 ; itile[i] = m->tile[i-1] + rows; + for (size_t i=1 ; itile[i] = m->tile[i-1] + n_tile_row; } - m->rows = rows; - m->cols = cols; + m->n_tile_row = n_tile_row; + m->n_tile_col = n_tile_col; return QMCKL_SUCCESS; } @@ -371,8 +396,8 @@ return '\n'.join( [ "" qmckl_exit_code double_tiled_matrix_init (qmckl_context context, double_tiled_matrix* m, - size_t rows, - size_t cols) { + size_t n_tile_row, + size_t n_tile_col) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_INVALID_CONTEXT; @@ -385,14 +410,14 @@ return '\n'.join( [ "" NULL); } - if (rows == (size_t) 0) { + if (n_tile_row == (size_t) 0) { return qmckl_failwith(context, QMCKL_INVALID_ARG_3, "double_tiled_matrix_init", NULL); } - if (cols == (size_t) 0) { + if (n_tile_col == (size_t) 0) { return qmckl_failwith(context, QMCKL_INVALID_ARG_4, "double_tiled_matrix_init", @@ -400,19 +425,19 @@ return '\n'.join( [ "" } qmckl_memory_info_struct info = qmckl_memory_info_struct_zero; - size_t n = rows * cols; + size_t n = n_tile_row * n_tile_col; /* Check overflow */ - if (n/cols != rows + if (n/n_tile_col != n_tile_row || n > SIZE_MAX / sizeof(double_tile_struct) ) { return qmckl_failwith(context, QMCKL_ALLOCATION_FAILED, "double_tiled_matrix_init", - "rows * cols overflows" ); + "n_tile_row * n_tile_col overflows" ); } /* Allocate array of column pointers */ - info.size = cols * sizeof(double_tile_struct*) ; + info.size = n_tile_col * sizeof(double_tile_struct*) ; m->tile = (double_tile_struct**) qmckl_malloc(context, info); if (m->tile == NULL) { @@ -435,12 +460,12 @@ return '\n'.join( [ "" } /* Compute array of pointers to the 1st element of columns */ - for (size_t i=1 ; itile[i] = m->tile[i-1] + rows; + for (size_t i=1 ; itile[i] = m->tile[i-1] + n_tile_row; } - m->rows = rows; - m->cols = cols; + m->n_tile_row = n_tile_row; + m->n_tile_col = n_tile_col; return QMCKL_SUCCESS; } From 7397dac788863e7255c715b6ac4eb95522c1277a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 2 Apr 2021 12:05:13 +0200 Subject: [PATCH 49/65] Created HPC directory --- src/{ => hpc}/qmckl_tile.org | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/{ => hpc}/qmckl_tile.org (100%) diff --git a/src/qmckl_tile.org b/src/hpc/qmckl_tile.org similarity index 100% rename from src/qmckl_tile.org rename to src/hpc/qmckl_tile.org From ff8330f8f9c95fccd1f536bfdca06b874b8fec92 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Apr 2021 11:26:04 +0200 Subject: [PATCH 50/65] Include lib.org --- src/qmckl_ao.org | 6 +-- src/qmckl_context.org | 7 +-- src/qmckl_distance.org | 11 +---- src/qmckl_error.org | 6 +-- src/qmckl_memory.org | 6 +-- src/qmckl_numprec.org | 7 +-- tools/lib.org | 103 ++++++++++++++++++++++------------------- 7 files changed, 61 insertions(+), 85 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 22026a5..2653737 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -1,5 +1,6 @@ #+TITLE: Atomic Orbitals #+SETUPFILE: ../docs/theme.setup +#+INCLUDE: ../tools/lib.org The atomic basis set is defined as a list of shells. Each shell $s$ is centered on a nucleus $A$, possesses a given angular momentum $l$ and a @@ -34,11 +35,6 @@ gradients and Laplacian of the atomic basis functions. * Headers :noexport: - #+NAME: filename - #+begin_src elisp :tangle no -(file-name-nondirectory (substring buffer-file-name 0 -4)) - #+end_src - #+begin_src c :tangle (eval h_private_type) #ifndef QMCKL_AO_HPT #define QMCKL_AO_HPT diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 8c6e8d4..c6ae818 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,14 +1,9 @@ #+TITLE: Context #+SETUPFILE: ../docs/theme.setup +#+INCLUDE: ../tools/lib.org * Headers :noexport: - #+NAME: filename - #+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) - #+end_src - - #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index cdd2fa9..3b99f6c 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -1,20 +1,11 @@ #+TITLE: Inter-particle distances #+SETUPFILE: ../docs/theme.setup +#+INCLUDE: ../tools/lib.org Functions for the computation of distances between particles. * Headers :noexport: - #+NAME: filename - #+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) - #+end_src - - #+begin_src elisp :noexport :results none -(org-babel-lob-ingest "../tools/lib.org") - #+end_src - - #+begin_src c :comments link :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" diff --git a/src/qmckl_error.org b/src/qmckl_error.org index be4b293..4bfdfad 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -1,13 +1,9 @@ #+TITLE: Error handling #+SETUPFILE: ../docs/theme.setup +#+INCLUDE: ../tools/lib.org * Headers :noexport: - #+NAME: filename - #+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) - #+end_src - #+begin_src c :tangle (eval h_private_type) #ifndef QMCKL_ERROR_HPT #define QMCKL_ERROR_HPT diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index d9a4657..c6bfe09 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -1,5 +1,6 @@ #+TITLE: Memory management #+SETUPFILE: ../docs/theme.setup +#+INCLUDE: ../tools/lib.org We override the allocation functions to enable the possibility of optimized libraries to fine-tune the memory allocation. @@ -7,11 +8,6 @@ optimized libraries to fine-tune the memory allocation. * Headers :noexport: - #+NAME: filename - #+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) - #+end_src - #+begin_src c :tangle (eval c) #include #include diff --git a/src/qmckl_numprec.org b/src/qmckl_numprec.org index a20537b..ea082de 100644 --- a/src/qmckl_numprec.org +++ b/src/qmckl_numprec.org @@ -1,14 +1,9 @@ #+TITLE: Numerical precision #+SETUPFILE: ../docs/theme.setup +#+INCLUDE: ../tools/lib.org * Headers :noexport: - #+NAME: filename - #+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) - #+end_src - - #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include "munit.h" diff --git a/tools/lib.org b/tools/lib.org index e6e5216..6c57ec0 100644 --- a/tools/lib.org +++ b/tools/lib.org @@ -1,34 +1,42 @@ # -*- mode: org -*- -* Function to get the value of a property. -#+NAME: get_value -#+begin_src elisp :var key="Type" +* Library of org-mode functions :noexport: +** Defines the name of the current file + + #+NAME: filename + #+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" (setq x (org-property-values key)) (pop x) -#+end_src + #+end_src -#+RESULTS: get_value + #+RESULTS: get_value -* Table of function arguments +** Table of function arguments - #+NAME: test - | qmckl_context | context | in | Global state | - | char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed | - | char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed | - | int64_t | m | in | Number of points in the first set | - | int64_t | n | in | Number of points in the second set | - | double | A[3][lda] | in | Array containing the $m \times 3$ matrix $A$ | - | int64_t | lda | in | Leading dimension of array ~A~ | - | double | B[3][ldb] | in | Array containing the $n \times 3$ matrix $B$ | - | int64_t | ldb | in | Leading dimension of array ~B~ | - | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | - | int64_t | ldc | in | Leading dimension of array ~C~ | + #+NAME: test + | qmckl_context | context | in | Global state | + | char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed | + | char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed | + | int64_t | m | in | Number of points in the first set | + | int64_t | n | in | Number of points in the second set | + | double | A[3][lda] | in | Array containing the $m \times 3$ matrix $A$ | + | int64_t | lda | in | Leading dimension of array ~A~ | + | double | B[3][ldb] | in | Array containing the $n \times 3$ matrix $B$ | + | int64_t | ldb | in | Leading dimension of array ~B~ | + | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | + | int64_t | ldc | in | Leading dimension of array ~C~ | -** Fortran-C type conversions +*** Fortran-C type conversions - #+NAME:f_of_c - #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" + #+NAME:f_of_c + #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" f_of_c_d = { '' : '' , 'qmckl_context' : 'integer (qmckl_context)' , 'qmckl_exit_code' : 'integer (qmckl_exit_code)' @@ -38,10 +46,10 @@ f_of_c_d = { '' : '' , 'double' : 'real (c_double )' , 'char' : 'character' } - #+END_SRC + #+END_SRC - #+NAME:c_of_f - #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" + #+NAME:c_of_f + #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" ctypeid_d = { '' : '' , 'qmckl_context' : 'integer (qmckl_context)' , 'qmckl_exit_code' : 'integer (qmckl_exit_code)' @@ -51,12 +59,12 @@ ctypeid_d = { '' : '' , 'real*8' : 'real(c_double)' , 'character' : 'character(c_char)' } - #+END_SRC + #+END_SRC -** Parse the table +*** Parse the table - #+NAME: parse_table - #+BEGIN_SRC python :results none :noweb yes :exports none + #+NAME: parse_table + #+BEGIN_SRC python :results none :noweb yes :exports none def parse_table(table): result = [] @@ -86,12 +94,12 @@ def parse_table(table): result.append(d) return result - #+END_SRC + #+END_SRC -** Generates a C header +*** Generates a C header - #+NAME: generate_c_header - #+BEGIN_SRC python :var table=[] :var rettyp=[] :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h_func) :comments org" + #+NAME: generate_c_header + #+BEGIN_SRC python :var table=[] :var rettyp=[] :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h_func) :comments org" <> results = [] @@ -116,18 +124,18 @@ template = f"""{rettyp} {fname} ( {results} ); """ return template - #+END_SRC + #+END_SRC - #+RESULTS: generate_c_header - #+begin_src c :tangle (eval h_func) :comments org + #+RESULTS: generate_c_header + #+begin_src c :tangle (eval h_func) :comments org [] [] ( ); - #+end_src + #+end_src -** Generates a C interface to the Fortran function +*** Generates a C interface to the Fortran function - #+NAME: generate_c_interface - #+BEGIN_SRC python :var table=[] :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" + #+NAME: generate_c_interface + #+BEGIN_SRC python :var table=[] :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" <> <> <> @@ -176,13 +184,12 @@ results += [ "" ] results='\n'.join(results) return results - #+END_SRC + #+END_SRC +*** Generates a Fortran interface to the C function -** Generates a Fortran interface to the C function - - #+NAME: generate_f_interface - #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh) :comments org :exports none" + #+NAME: generate_f_interface + #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh) :comments org :exports none" <> <> <> @@ -228,8 +235,8 @@ results += [ "" ] results='\n'.join(results) return results - #+END_SRC + #+END_SRC - #+RESULTS: generate_c_interface - #+begin_src f90 :tangle (eval f) :comments org :exports none - #+end_src + #+RESULTS: generate_c_interface + #+begin_src f90 :tangle (eval f) :comments org :exports none + #+end_src From 33f33fcdf3b69d871d877bea96b2e40fab87705a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Apr 2021 00:57:08 +0200 Subject: [PATCH 51/65] Auto-generate interfaces --- docs/theme.setup | 1 + src/qmckl_ao.org | 348 ++++++++++++++++++++++++----------------- src/qmckl_distance.org | 18 +-- tools/lib.org | 79 ++++++++-- 4 files changed, 280 insertions(+), 166 deletions(-) diff --git a/docs/theme.setup b/docs/theme.setup index da0d396..bbb2ba6 100644 --- a/docs/theme.setup +++ b/docs/theme.setup @@ -13,3 +13,4 @@ #+LANGUAGE: en + diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 2653737..422e1ae 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -34,6 +34,10 @@ In this section we describe the kernels used to compute the values, gradients and Laplacian of the atomic basis functions. * Headers :noexport: + #+begin_src elisp :noexport :results none +(org-babel-lob-ingest "../tools/lib.org") +#+end_src + #+begin_src c :tangle (eval h_private_type) #ifndef QMCKL_AO_HPT @@ -759,11 +763,13 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou #+end_src - - * Polynomial part - ** Powers of $x-X_i$ + :PROPERTIES: + :Name: qmckl_ao_power + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: The ~qmckl_ao_power~ function computes all the powers of the ~n~ input data up to the given maximum value given in input for each of @@ -771,33 +777,41 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou \[ P_{ik} = X_i^k \] - | ~context~ | input | Global state | - | ~n~ | input | Number of values | - | ~X(n)~ | input | Array containing the input values | - | ~LMAX(n)~ | input | Array containing the maximum power for each value | - | ~P(LDP,n)~ | output | Array containing all the powers of ~X~ | - | ~LDP~ | input | Leading dimension of array ~P~ | - - Requirements: + #+NAME: qmckl_ao_power_args + | qmckl_context | context | in | Global state | + | int64_t | n | in | Number of values | + | double | X[n] | in | Array containing the input values | + | int32_t | LMAX[n] | in | Array containing the maximum power for each value | + | double | P[n][ldp] | out | Array containing all the powers of ~X~ | + | int64_t | ldp | in | Leading dimension of array ~P~ | - - ~context~ is not ~QMCKL_NULL_CONTEXT~ - - ~n~ > 0 - - ~X~ is allocated with at least $n \times 8$ bytes - - ~LMAX~ is allocated with at least $n \times 4$ bytes - - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - - ~LDP~ >= $\max_i$ ~LMAX[i]~ +*** Requirements: - #+begin_src c :tangle (eval h_func) -qmckl_exit_code -qmckl_ao_power(const qmckl_context context, - const int64_t n, - const double *X, - const int32_t *LMAX, - const double *P, - const int64_t LDP); - #+end_src + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~n~ > 0 + - ~X~ is allocated with at least $n \times 8$ bytes + - ~LMAX~ is allocated with at least $n \times 4$ bytes + - ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - ~LDP~ >= $\max_i$ ~LMAX[i]~ - #+begin_src f90 :tangle (eval f) +*** C Header + + #+CALL: generate_c_header(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power") + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_ao_power ( + const qmckl_context context, + const int64_t n, + const double* X, + const int32_t* LMAX, + double* const P, + const int64_t ldp ); + #+end_src + +*** Source + + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) use qmckl implicit none @@ -841,41 +855,62 @@ integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) end do end function qmckl_ao_power_f - #+end_src + #+end_src - #+begin_src f90 :tangle (eval f) :exports none -integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & - bind(C) result(info) - use, intrinsic :: iso_c_binding - implicit none - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: n - real (c_double) , intent(in) :: X(n) - integer (c_int32_t) , intent(in) :: LMAX(n) - real (c_double) , intent(out) :: P(ldp,n) - integer (c_int64_t) , intent(in) , value :: ldp +*** C interface + #+CALL: generate_c_interface(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power") - integer, external :: qmckl_ao_power_f - info = qmckl_ao_power_f(context, n, X, LMAX, P, ldp) -end function qmckl_ao_power - #+end_src + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_ao_power & + (context, n, X, LMAX, P, ldp) & + bind(C) result(info) - #+begin_src f90 :tangle (eval fh_func) :exports none - interface - integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: n - integer (c_int64_t) , intent(in) , value :: ldp - real (c_double) , intent(in) :: X(n) - integer (c_int32_t) , intent(in) :: LMAX(n) - real (c_double) , intent(out) :: P(ldp,n) - end function qmckl_ao_power - end interface - #+end_src + use, intrinsic :: iso_c_binding + implicit none - # Test - #+begin_src f90 :tangle (eval f_test) + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: X(n) + integer (c_int32_t) , intent(in) :: LMAX(n) + real (c_double ) , intent(out) :: P(ldp,n) + integer (c_int64_t) , intent(in) , value :: ldp + + integer(c_int32_t), external :: qmckl_ao_power_f + info = qmckl_ao_power_f & + (context, n, X, LMAX, P, ldp) + + end function qmckl_ao_power + #+end_src + +*** Fortran interface + + #+CALL: generate_f_interface(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power") + + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_ao_power & + (context, n, X, LMAX, P, ldp) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: X(n) + integer (c_int32_t) , intent(in) :: LMAX(n) + real (c_double ) , intent(out) :: P(ldp,n) + integer (c_int64_t) , intent(in) , value :: ldp + + end function qmckl_ao_power + end interface + #+end_src + +*** Test + + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) use qmckl implicit none @@ -919,14 +954,19 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) test_qmckl_ao_power = QMCKL_SUCCESS deallocate(X,P,LMAX) end function test_qmckl_ao_power - #+end_src + #+end_src - #+begin_src c :tangle (eval c_test) :exports none + #+begin_src c :tangle (eval c_test) :exports none int test_qmckl_ao_power(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_power(context)); - #+end_src + #+end_src ** Value, Gradient and Laplacian of a polynomial + :PROPERTIES: + :Name: qmckl_ao_polynomial_vgl + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: A polynomial is centered on a nucleus $\mathbf{R}_i$ @@ -961,51 +1001,56 @@ munit_assert_int(0, ==, test_qmckl_ao_power(context)); Laplacians at a given point in space, of all polynomials with an angular momentum up to ~lmax~. - | ~context~ | input | Global state | - | ~X(3)~ | input | Array containing the coordinates of the points | - | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~lmax~ | input | Maximum angular momentum | - | ~n~ | output | Number of computed polynomials | - | ~L(ldl,n)~ | output | Contains a,b,c for all ~n~ results | - | ~ldl~ | input | Leading dimension of ~L~ | - | ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials | - | ~ldv~ | input | Leading dimension of array ~VGL~ | + #+NAME: qmckl_ao_polynomial_vgl_args + | qmckl_context | context | in | Global state | + | double | X[3] | in | Array containing the coordinates of the points | + | double | R[3] | in | Array containing the x,y,z coordinates of the center | + | int32_t | lmax | in | Maximum angular momentum | + | int64_t | n | inout | Number of computed polynomials | + | int32_t | L[n][ldl] | out | Contains a,b,c for all ~n~ results | + | int64_t | ldl | in | Leading dimension of ~L~ | + | double | VGL[n][ldv] | out | Value, gradients and Laplacian of the polynomials | + | int64_t | ldv | in | Leading dimension of array ~VGL~ | - Requirements: +*** Requirements: - - ~context~ is not ~QMCKL_NULL_CONTEXT~ - - ~n~ > 0 - - ~lmax~ >= 0 - - ~ldl~ >= 3 - - ~ldv~ >= 5 - - ~X~ is allocated with at least $3 \times 8$ bytes - - ~R~ is allocated with at least $3 \times 8$ bytes - - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ - - ~L~ is allocated with at least $3 \times n \times 4$ bytes - - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes - - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ - - On output, the powers are given in the following order (l=a+b+c): - - Increasing values of ~l~ - - Within a given value of ~l~, alphabetical order of the - string made by a*"x" + b*"y" + c*"z" (in Python notation). - For example, with a=0, b=2 and c=1 the string is "yyz" + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~n~ > 0 + - ~lmax~ >= 0 + - ~ldl~ >= 3 + - ~ldv~ >= 5 + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~ + - ~L~ is allocated with at least $3 \times n \times 4$ bytes + - ~VGL~ is allocated with at least $5 \times n \times 8$ bytes + - On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~ + - On output, the powers are given in the following order (l=a+b+c): + - Increasing values of ~l~ + - Within a given value of ~l~, alphabetical order of the + string made by a*"x" + b*"y" + c*"z" (in Python notation). + For example, with a=0, b=2 and c=1 the string is "yyz" - # Header - #+begin_src c :tangle (eval h_func) -qmckl_exit_code -qmckl_ao_polynomial_vgl(const qmckl_context context, - const double *X, - const double *R, - const int32_t lmax, - const int64_t *n, - const int32_t *L, - const int64_t ldl, - const double *VGL, - const int64_t ldv); - #+end_src +*** C Header - # Source - #+begin_src f90 :tangle (eval f) + #+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_ao_polynomial_vgl ( + const qmckl_context context, + const double* X, + const double* R, + const int32_t lmax, + int64_t* n, + int32_t* const L, + const int64_t ldl, + double* const VGL, + const int64_t ldv ); + #+end_src + +*** Source + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) use qmckl implicit none @@ -1133,46 +1178,69 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, info = QMCKL_SUCCESS end function qmckl_ao_polynomial_vgl_f - #+end_src + #+end_src + +*** C interface + #+CALL: generate_c_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname=get_value("Name")) - #+begin_src f90 :tangle (eval f) :exports none -integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & - bind(C) result(info) - use, intrinsic :: iso_c_binding - implicit none - integer (c_int64_t) , intent(in) , value :: context - real (c_double) , intent(in) :: X(3), R(3) - integer (c_int32_t) , intent(in) , value :: lmax - integer (c_int64_t) , intent(out) :: n - integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer (c_int64_t) , intent(in) , value :: ldl - real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer (c_int64_t) , intent(in) , value :: ldv + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_ao_polynomial_vgl & + (context, X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) result(info) - integer, external :: qmckl_ao_polynomial_vgl_f - info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) -end function qmckl_ao_polynomial_vgl - #+end_src + use, intrinsic :: iso_c_binding + implicit none - #+begin_src f90 :tangle (eval fh_func) :exports none - interface - integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & - bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t) , intent(in) , value :: context - integer (c_int32_t) , intent(in) , value :: lmax - integer (c_int64_t) , intent(in) , value :: ldl - integer (c_int64_t) , intent(in) , value :: ldv - real (c_double) , intent(in) :: X(3), R(3) - integer (c_int64_t) , intent(out) :: n - integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) - end function qmckl_ao_polynomial_vgl - end interface - #+end_src + integer (c_int64_t) , intent(in) , value :: context + real (c_double ) , intent(in) :: X(3) + real (c_double ) , intent(in) :: R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(inout) :: n + integer (c_int32_t) , intent(out) :: L(ldl,n) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double ) , intent(out) :: VGL(ldv,n) + integer (c_int64_t) , intent(in) , value :: ldv - #+begin_src f90 :tangle (eval f_test) + integer(c_int32_t), external :: qmckl_ao_polynomial_vgl_f + info = qmckl_ao_polynomial_vgl_f & + (context, X, R, lmax, n, L, ldl, VGL, ldv) + + end function qmckl_ao_polynomial_vgl + #+end_src + +*** Fortran interface + + #+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_ao_polynomial_vgl & + (context, X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + real (c_double ) , intent(in) :: X(3) + real (c_double ) , intent(in) :: R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(inout) :: n + integer (c_int32_t) , intent(out) :: L(ldl,n) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double ) , intent(out) :: VGL(ldv,n) + integer (c_int64_t) , intent(in) , value :: ldv + + end function qmckl_ao_polynomial_vgl + end interface + #+end_src + +*** Test + + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl implicit none @@ -1262,12 +1330,12 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) deallocate(L,VGL) end function test_qmckl_ao_polynomial_vgl - #+end_src + #+end_src - #+begin_src c :tangle (eval c_test) + #+begin_src c :tangle (eval c_test) int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - #+end_src + #+end_src * Gaussian basis functions diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 3b99f6c..285f425 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -212,12 +212,12 @@ end function qmckl_distance_sq_f This function might be more efficient when ~A~ and ~B~ are transposed. -*** C interface :noexport: +** C interface :noexport: - #+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none integer (c_int32_t) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) result(info) @@ -241,12 +241,12 @@ end function qmckl_distance_sq_f (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) end function qmckl_distance_sq - #+end_src + #+end_src - #+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - #+RESULTS: - #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface integer (qmckl_exit_code) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & @@ -269,7 +269,7 @@ end function qmckl_distance_sq_f end function qmckl_distance_sq end interface - #+end_src + #+end_src *** Test :noexport: #+begin_src f90 :tangle (eval f_test) diff --git a/tools/lib.org b/tools/lib.org index 6c57ec0..888752b 100644 --- a/tools/lib.org +++ b/tools/lib.org @@ -38,8 +38,8 @@ #+NAME:f_of_c #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" f_of_c_d = { '' : '' - , 'qmckl_context' : 'integer (qmckl_context)' - , 'qmckl_exit_code' : 'integer (qmckl_exit_code)' + , 'qmckl_context' : 'integer (c_int64_t)' + , 'qmckl_exit_code' : 'integer (c_int32_t)' , 'int32_t' : 'integer (c_int32_t)' , 'int64_t' : 'integer (c_int64_t)' , 'float' : 'real (c_float )' @@ -48,11 +48,16 @@ f_of_c_d = { '' : '' } #+END_SRC + #+RESULTS: f_of_c + #+begin_src f90 :tangle (eval f) :comments org :exports none + None + #+end_src + #+NAME:c_of_f #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" ctypeid_d = { '' : '' - , 'qmckl_context' : 'integer (qmckl_context)' - , 'qmckl_exit_code' : 'integer (qmckl_exit_code)' + , 'qmckl_context' : 'integer(c_int64_t)' + , 'qmckl_exit_code' : 'integer(c_int32_t)' , 'integer' : 'integer(c_int32_t)' , 'integer*8' : 'integer(c_int64_t)' , 'real' : 'real(c_float)' @@ -61,6 +66,11 @@ ctypeid_d = { '' : '' } #+END_SRC + #+RESULTS: c_of_f + #+begin_src f90 :tangle (eval f) :comments org :exports none + None + #+end_src + *** Parse the table #+NAME: parse_table @@ -108,16 +118,19 @@ for d in parse_table(table): c_type = d["c_type"] # Add star for arrays - if d["rank"] > 0: + if d["rank"] > 0 or d["inout"] in ["out", "inout"]: c_type += "*" + if d["inout"] == "out": + c_type += " const" + # Only inputs are const if d["inout"] == "in": - const = "const" + const = "const " else: - const = " " - - results += [ f" {const} {c_type} {name}" ] + const = "" + + results += [ f" {const}{c_type} {name}" ] results=',\n'.join(results) template = f"""{rettyp} {fname} ( @@ -128,8 +141,18 @@ return template #+RESULTS: generate_c_header #+begin_src c :tangle (eval h_func) :comments org - [] [] ( - ); + [] [] ( + const qmckl_context context, + const char transa, + const char transb, + const int64_t m, + const int64_t n, + const double* const A, + const int64_t lda, + const double* const B, + const int64_t ldb, + double* const C, + const int64_t ldc ); #+end_src *** Generates a C interface to the Fortran function @@ -150,7 +173,6 @@ results = [ f"{rettyp_c} function {fname} &" , " bind(C) result(info)" , "" , " use, intrinsic :: iso_c_binding" -, " import" , " implicit none" , "" ] @@ -161,7 +183,7 @@ for d in parse_table(table): name = d["name"] # Input scalars are passed by value - if d["rank"] == 0 and inout == "in": + if d["rank"] == 0 and d["inout"] == "in": value = ", value" else: value = " " @@ -189,7 +211,7 @@ return results *** Generates a Fortran interface to the C function #+NAME: generate_f_interface - #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh) :comments org :exports none" + #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_func) :comments org :exports none" <> <> <> @@ -215,7 +237,7 @@ for d in parse_table(table): name = d["name"] # Input scalars are passed by value - if d["rank"] == 0 and inout == "in": + if d["rank"] == 0 and d["inout"] == "in": value = ", value" else: value = " " @@ -237,6 +259,29 @@ results='\n'.join(results) return results #+END_SRC - #+RESULTS: generate_c_interface - #+begin_src f90 :tangle (eval f) :comments org :exports none + #+RESULTS: generate_f_interface + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function [] & + (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (qmckl_context), intent(in) , value :: context + character , intent(in) , value :: transa + character , intent(in) , value :: transb + integer (c_int64_t) , intent(in) , value :: m + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: A(lda,3) + integer (c_int64_t) , intent(in) , value :: lda + real (c_double ) , intent(in) :: B(ldb,3) + integer (c_int64_t) , intent(in) , value :: ldb + real (c_double ) , intent(out) :: C(ldc,n) + integer (c_int64_t) , intent(in) , value :: ldc + + end function [] + end interface #+end_src + From 5c285dcdb6b98bf4e187ce0f41d51e52da970ebc Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 17 Apr 2021 12:35:52 +0200 Subject: [PATCH 52/65] Fixed distances --- src/qmckl_distance.org | 72 ++++++++++++++++++++++-------------------- tools/lib.org | 8 ++--- 2 files changed, 42 insertions(+), 38 deletions(-) diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 285f425..15776c1 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -5,6 +5,9 @@ Functions for the computation of distances between particles. * Headers :noexport: + #+begin_src elisp :noexport :results none +(org-babel-lob-ingest "../tools/lib.org") +#+end_src #+begin_src c :comments link :tangle (eval c_test) :noweb yes #include "qmckl.h" @@ -37,9 +40,9 @@ MunitResult test_<>() { | char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed | | int64_t | m | in | Number of points in the first set | | int64_t | n | in | Number of points in the second set | - | double | A[3][lda] | in | Array containing the $m \times 3$ matrix $A$ | + | double | A[][lda] | in | Array containing the $m \times 3$ matrix $A$ | | int64_t | lda | in | Leading dimension of array ~A~ | - | double | B[3][ldb] | in | Array containing the $n \times 3$ matrix $B$ | + | double | B[][ldb] | in | Array containing the $n \times 3$ matrix $B$ | | int64_t | ldb | in | Leading dimension of array ~B~ | | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | | int64_t | ldc | in | Leading dimension of array ~C~ | @@ -74,7 +77,7 @@ MunitResult test_<>() { const int64_t lda, const double* B, const int64_t ldb, - double* C, + double* const C, const int64_t ldc ); #+end_src @@ -214,62 +217,63 @@ end function qmckl_distance_sq_f ** C interface :noexport: - #+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer (c_int32_t) function qmckl_distance_sq & + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) result(info) + use, intrinsic :: iso_c_binding implicit none - integer (c_int64_t) , intent(in) :: context - character , intent(in) :: transa - character , intent(in) :: transb - integer (c_int64_t) , intent(in) :: m - integer (c_int64_t) , intent(in) :: n - real (c_double ) , intent(in) :: A(lda,3) - integer (c_int64_t) , intent(in) :: lda - real (c_double ) , intent(in) :: B(ldb,3) - integer (c_int64_t) , intent(in) :: ldb + integer (c_int64_t) , intent(in) , value :: context + character , intent(in) , value :: transa + character , intent(in) , value :: transb + integer (c_int64_t) , intent(in) , value :: m + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: A(lda,*) + integer (c_int64_t) , intent(in) , value :: lda + real (c_double ) , intent(in) :: B(ldb,*) + integer (c_int64_t) , intent(in) , value :: ldb real (c_double ) , intent(out) :: C(ldc,n) - integer (c_int64_t) , intent(in) :: ldc + integer (c_int64_t) , intent(in) , value :: ldc - integer (c_int32_t), external :: qmckl_distance_sq_f + integer(c_int32_t), external :: qmckl_distance_sq_f info = qmckl_distance_sq_f & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) end function qmckl_distance_sq - #+end_src + #+end_src - #+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - #+RESULTS: - #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer (qmckl_exit_code) function qmckl_distance_sq & + integer(c_int32_t) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) use, intrinsic :: iso_c_binding import implicit none - integer (qmckl_context), intent(in) :: context - character , intent(in) :: transa - character , intent(in) :: transb - integer (c_int64_t) , intent(in) :: m - integer (c_int64_t) , intent(in) :: n - real (c_double ) , intent(in) :: A(lda,3) - integer (c_int64_t) , intent(in) :: lda - real (c_double ) , intent(in) :: B(ldb,3) - integer (c_int64_t) , intent(in) :: ldb + integer (c_int64_t) , intent(in) , value :: context + character , intent(in) , value :: transa + character , intent(in) , value :: transb + integer (c_int64_t) , intent(in) , value :: m + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: A(lda,*) + integer (c_int64_t) , intent(in) , value :: lda + real (c_double ) , intent(in) :: B(ldb,*) + integer (c_int64_t) , intent(in) , value :: ldb real (c_double ) , intent(out) :: C(ldc,n) - integer (c_int64_t) , intent(in) :: ldc + integer (c_int64_t) , intent(in) , value :: ldc end function qmckl_distance_sq end interface - #+end_src + #+end_src *** Test :noexport: #+begin_src f90 :tangle (eval f_test) diff --git a/tools/lib.org b/tools/lib.org index 888752b..4dbe7dc 100644 --- a/tools/lib.org +++ b/tools/lib.org @@ -25,9 +25,9 @@ | char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed | | int64_t | m | in | Number of points in the first set | | int64_t | n | in | Number of points in the second set | - | double | A[3][lda] | in | Array containing the $m \times 3$ matrix $A$ | + | double | A[][lda] | in | Array containing the $m \times 3$ matrix $A$ | | int64_t | lda | in | Leading dimension of array ~A~ | - | double | B[3][ldb] | in | Array containing the $n \times 3$ matrix $B$ | + | double | B[][ldb] | in | Array containing the $n \times 3$ matrix $B$ | | int64_t | ldb | in | Leading dimension of array ~B~ | | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | | int64_t | ldc | in | Leading dimension of array ~C~ | @@ -92,8 +92,8 @@ def parse_table(table): elif d["inout"] in ["input/output", "inout"]: d["inout"] == "inout" - # Find dimensions - dims = d["name"].split('[') + # Find dimensions (replace [] by [*] to get * in Fortran dimensions) + dims = d["name"].replace("[]","[*]").split('[') d["rank"] = len(dims) - 1 if d["rank"] == 0: d["dims"] = [] From afd3f6ae7a68410ce8f29ffdee2944a5a92ffea1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 18 Apr 2021 15:10:55 +0200 Subject: [PATCH 53/65] Added test to set basis set parameters --- src/qmckl.org | 15 +-- src/qmckl_ao.org | 298 ++++++++++++++++++++++++++++++++--------------- 2 files changed, 208 insertions(+), 105 deletions(-) diff --git a/src/qmckl.org b/src/qmckl.org index a871b73..8e5ab50 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -163,8 +163,7 @@ cppcheck --addon=cert --enable=all *.c &> cppcheck.out and terminated by a ~'\0'~ character (C convention). - Complex numbers can be represented by an array of 2 floats. - Boolean variables are stored as integers, ~1~ for ~true~ and ~0~ for ~false~ - - Floating point variables should be by default - - ~double~ unless explicitly mentioned + - Floating point variables should be by default ~double~ unless explicitly mentioned - integers used for counting should always be ~int64_t~ To facilitate the use in other languages than C, we will provide some @@ -265,15 +264,3 @@ cppcheck --addon=cert --enable=all *.c &> cppcheck.out QMCkl is a general purpose library, multiple algorithms should be implemented adapted to different problem sizes. -** Rules for the API - - - =stdint= should be used for integers (=int32_t=, =int64_t=) - - integers used for counting should always be =int64_t= - - floats should be by default =double=, unless explicitly mentioned - - pointers are converted to =int64_t= to increase portability - - - - - - diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 422e1ae..916e3fd 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -116,7 +116,7 @@ shell_center = [1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2] shell_ang_mom = ['S', 'S', 'S', 'P', 'P', 'D', 'S', 'S', 'S', 'P', 'P', 'D'] shell_factor = [ 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.] shell_prim_num = [5, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1] -prim_index = [1, 6, 7, 8, 9, 10, 11, 16, 17, 18, 19, 20] +shell_prim_index = [1, 6, 7, 8, 9, 10, 11, 16, 17, 18, 19, 20] exponent = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, 1.407, 0.388, 1.057, 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, 1.407, 0.388, 1.057] @@ -134,7 +134,7 @@ typedef struct qmckl_ao_basis_struct { int64_t shell_num; int64_t prim_num; int64_t * shell_center; - int32_t * shell_ang_mom; + char * shell_ang_mom; int64_t * shell_prim_num; int64_t * shell_prim_index; double * shell_factor; @@ -145,36 +145,41 @@ typedef struct qmckl_ao_basis_struct { #+end_src The ~uninitialized~ integer contains one bit set to one for each - initialization function which has not bee called. When it is equal - to zero, the struct is initialized and ~provided == 1~. + initialization function which has not bee called. It becomes equal + to zero after all initialization functions have been called. The + struct is then initialized and ~provided == 1~. ** Access functions Access to scalars copies the values at the passed address, and for array values a pointer to the array is returned. + #+begin_src c :comments org :tangle (eval h_private_func) +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_shell_center (const qmckl_context context); +char* 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); + #+end_src + #+begin_src c :comments org :tangle (eval h_func) -char qmckl_get_ao_basis_type (qmckl_context context); -int64_t qmckl_get_ao_basis_shell_num (qmckl_context context); -int64_t qmckl_get_ao_basis_prim_num (qmckl_context context); -int64_t* qmckl_get_ao_basis_shell_center (qmckl_context context); -int32_t* qmckl_get_ao_basis_shell_ang_mom (qmckl_context context); -int64_t* qmckl_get_ao_basis_shell_prim_num (qmckl_context context); -double* qmckl_get_ao_basis_shell_factor (qmckl_context context); -double* qmckl_get_ao_basis_exponent (qmckl_context context); -double* qmckl_get_ao_basis_coefficient (qmckl_context context); +int32_t qmckl_ao_basis_provided (const qmckl_context context); #+end_src #+NAME:post #+begin_src c -if (ctx->ao_basis.uninitialized &= mask != 0) { +if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } #+end_src - #+begin_src c :comments org :tangle (eval c) :noweb yes -char qmckl_get_ao_basis_type (qmckl_context context) { +char qmckl_get_ao_basis_type (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; @@ -185,7 +190,7 @@ char qmckl_get_ao_basis_type (qmckl_context context) { int32_t mask = 1; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return (char) 0; } @@ -194,7 +199,7 @@ char qmckl_get_ao_basis_type (qmckl_context context) { } -int64_t qmckl_get_ao_basis_shell_num (qmckl_context context) { +int64_t qmckl_get_ao_basis_shell_num (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -204,16 +209,16 @@ int64_t qmckl_get_ao_basis_shell_num (qmckl_context context) { int32_t mask = 1 << 1; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return (int64_t) 0; } - assert (ctx->ao_basis.shell_num != (int64_t) 0); + assert (ctx->ao_basis.shell_num > (int64_t) 0); return ctx->ao_basis.shell_num; } -int64_t qmckl_get_ao_basis_prim_num (qmckl_context context) { +int64_t qmckl_get_ao_basis_prim_num (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -223,16 +228,16 @@ int64_t qmckl_get_ao_basis_prim_num (qmckl_context context) { int32_t mask = 1 << 2; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return (int64_t) 0; } - assert (ctx->ao_basis.prim_num != (int64_t) 0); + assert (ctx->ao_basis.prim_num > (int64_t) 0); return ctx->ao_basis.prim_num; } -int64_t* qmckl_get_ao_basis_shell_center (qmckl_context context) { +int64_t* qmckl_get_ao_basis_shell_center (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return NULL; } @@ -242,7 +247,7 @@ int64_t* qmckl_get_ao_basis_shell_center (qmckl_context context) { int32_t mask = 1 << 3; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } @@ -251,7 +256,7 @@ int64_t* qmckl_get_ao_basis_shell_center (qmckl_context context) { } -int32_t* qmckl_get_ao_basis_shell_ang_mom (qmckl_context context) { +char* qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return NULL; } @@ -261,7 +266,7 @@ int32_t* qmckl_get_ao_basis_shell_ang_mom (qmckl_context context) { int32_t mask = 1 << 4; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } @@ -270,7 +275,7 @@ int32_t* qmckl_get_ao_basis_shell_ang_mom (qmckl_context context) { } -int64_t* qmckl_get_ao_basis_shell_prim_num (qmckl_context context) { +int64_t* qmckl_get_ao_basis_shell_prim_num (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return NULL; } @@ -280,7 +285,7 @@ int64_t* qmckl_get_ao_basis_shell_prim_num (qmckl_context context) { int32_t mask = 1 << 5; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } @@ -289,7 +294,7 @@ int64_t* qmckl_get_ao_basis_shell_prim_num (qmckl_context context) { } -int64_t* qmckl_get_ao_basis_shell_prim_index (qmckl_context context) { +int64_t* qmckl_get_ao_basis_shell_prim_index (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return NULL; } @@ -299,7 +304,7 @@ int64_t* qmckl_get_ao_basis_shell_prim_index (qmckl_context context) { int32_t mask = 1 << 6; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } @@ -308,7 +313,7 @@ int64_t* qmckl_get_ao_basis_shell_prim_index (qmckl_context context) { } -double* qmckl_get_ao_basis_shell_factor (qmckl_context context) { +double* qmckl_get_ao_basis_shell_factor (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return NULL; } @@ -318,7 +323,7 @@ double* qmckl_get_ao_basis_shell_factor (qmckl_context context) { int32_t mask = 1 << 7; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } @@ -327,7 +332,7 @@ double* qmckl_get_ao_basis_shell_factor (qmckl_context context) { } -double* qmckl_get_ao_basis_exponent (qmckl_context context) { +double* qmckl_get_ao_basis_exponent (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return NULL; } @@ -338,7 +343,7 @@ double* qmckl_get_ao_basis_exponent (qmckl_context context) { int32_t mask = 1 << 8; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } @@ -347,7 +352,7 @@ double* qmckl_get_ao_basis_exponent (qmckl_context context) { } -double* qmckl_get_ao_basis_coefficient (qmckl_context context) { +double* qmckl_get_ao_basis_coefficient (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return NULL; } @@ -357,30 +362,44 @@ double* qmckl_get_ao_basis_coefficient (qmckl_context context) { int32_t mask = 1 << 9; - if (ctx->ao_basis.uninitialized &= mask != 0) { + if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } assert (ctx->ao_basis.coefficient != NULL); return ctx->ao_basis.coefficient; } - #+end_src + +int32_t qmckl_ao_basis_provided(const qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + return ctx->ao_basis.provided; +} + #+end_src + ** Initialization functions To set the basis set, all the following functions need to be called. When #+begin_src c :comments org :tangle (eval h_func) -qmckl_exit_code qmckl_set_ao_basis_type (qmckl_context context, const char t); -qmckl_exit_code qmckl_set_ao_basis_shell_num (qmckl_context context, const int64_t shell_num); -qmckl_exit_code qmckl_set_ao_basis_prim_num (qmckl_context context, const int64_t prim_num); -qmckl_exit_code qmckl_set_ao_basis_shell_center (qmckl_context context, const int64_t * shell_center); -qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom (qmckl_context context, const int32_t * shell_ang_mom); -qmckl_exit_code qmckl_set_ao_basis_shell_center (qmckl_context context, const int64_t * shell_prim_num); -qmckl_exit_code qmckl_set_ao_basis_shell_factor (qmckl_context context, const double * shell_factor); -qmckl_exit_code qmckl_set_ao_basis_exponent (qmckl_context context, const double * exponent); -qmckl_exit_code qmckl_set_ao_basis_coefficient (qmckl_context context, const double * coefficient); +qmckl_exit_code qmckl_set_ao_basis_type (qmckl_context context, const char t); +qmckl_exit_code qmckl_set_ao_basis_shell_num (qmckl_context context, const int64_t shell_num); +qmckl_exit_code qmckl_set_ao_basis_prim_num (qmckl_context context, const int64_t prim_num); +qmckl_exit_code qmckl_set_ao_basis_shell_prim_index (qmckl_context context, const int64_t * shell_prim_index); +qmckl_exit_code qmckl_set_ao_basis_shell_center (qmckl_context context, const int64_t * shell_center); +qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom (qmckl_context context, const char * shell_ang_mom); +qmckl_exit_code qmckl_set_ao_basis_shell_prim_num (qmckl_context context, const int64_t * shell_prim_num); +qmckl_exit_code qmckl_set_ao_basis_shell_factor (qmckl_context context, const double * shell_factor); +qmckl_exit_code qmckl_set_ao_basis_exponent (qmckl_context context, const double * exponent); +qmckl_exit_code qmckl_set_ao_basis_coefficient (qmckl_context context, const double * coefficient); #+end_src #+NAME:pre2 @@ -394,7 +413,7 @@ qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; #+NAME:post2 #+begin_src c -ctx->ao_basis.uninitialized &= !(mask); +ctx->ao_basis.uninitialized &= ~mask; if (ctx->ao_basis.uninitialized == 0) { ctx->ao_basis.provided = 1; @@ -515,7 +534,7 @@ qmckl_exit_code qmckl_set_ao_basis_shell_center(qmckl_context context, const in } -qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom(qmckl_context context, const int32_t* shell_ang_mom) { +qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom(qmckl_context context, const char* shell_ang_mom) { <> int32_t mask = 1 << 4; @@ -539,8 +558,8 @@ qmckl_exit_code qmckl_set_ao_basis_shell_ang_mom(qmckl_context context, const i qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; - mem_info.size = shell_num * sizeof(int64_t); - int32_t* new_array = (int32_t*) qmckl_malloc(context, mem_info); + mem_info.size = shell_num * sizeof(char); + char* new_array = (char*) qmckl_malloc(context, mem_info); if (new_array == NULL) { return qmckl_failwith( context, @@ -763,6 +782,101 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou #+end_src + +** Fortran interfaces + #+NAME: qmckl_ao_power_args + | qmckl_context | context | in | Global state | + | int64_t | n | in | Number of values | + | double | X[n] | in | Array containing the input values | + | int32_t | LMAX[n] | in | Array containing the maximum power for each value | + | double | P[n][ldp] | out | Array containing all the powers of ~X~ | + | int64_t | ldp | in | Leading dimension of array ~P~ | + +** Test + + #+begin_src c :tangle (eval c_test) +/* Reference input data */ + +char typ = 'G'; +#define shell_num ((int64_t) 12) +#define prim_num ((int64_t) 20) + +int64_t shell_center [shell_num] = + { 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2 }; + +char shell_ang_mom [shell_num] = + { 'S', 'S', 'S', 'P', 'P', 'D', 'S', 'S', 'S', 'P', 'P', 'D' }; + +double shell_factor [shell_num] = + { 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1. }; + +int64_t shell_prim_num [shell_num] = + {5, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1}; + +int64_t shell_prim_index [shell_num] = + {1, 6, 7, 8, 9, 10, 11, 16, 17, 18, 19, 20}; + +double exponent [prim_num] = + { 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, + 1.407, 0.388, 1.057, 33.87, 5.095, 1.159, 0.3258, 0.1027, + 0.3258, 0.1027, 1.407, 0.388, 1.057 }; + +double coefficient [prim_num] = + { 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, + 1.0, 1.0, 1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822, + 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0 }; +/* --- */ + +qmckl_exit_code rc; + +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_type (context, typ); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_shell_num (context, shell_num); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_prim_num (context, prim_num); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_shell_center (context, shell_center); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_shell_ang_mom (context, shell_ang_mom); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_shell_factor (context, shell_factor); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_shell_center (context, shell_prim_num); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_shell_prim_num (context, shell_prim_num); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_shell_prim_index (context, shell_prim_index); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_exponent (context, exponent); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); + +rc = qmckl_set_ao_basis_coefficient (context, coefficient); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert_int(qmckl_ao_basis_provided(context), ==, 1); + + #+end_src + * Polynomial part ** Powers of $x-X_i$ :PROPERTIES: @@ -924,7 +1038,6 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) double precision :: epsilon epsilon = qmckl_get_numprec_epsilon(context) - print *, epsilon n = 100; LDP = 10; @@ -1337,38 +1450,39 @@ int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); #+end_src -* Gaussian basis functions +* Radial part +** Gaussian basis functions - ~qmckl_ao_gaussian_vgl~ computes the values, gradients and - Laplacians at a given point of ~n~ Gaussian functions centered at - the same point: + ~qmckl_ao_gaussian_vgl~ computes the values, gradients and + Laplacians at a given point of ~n~ Gaussian functions centered at + the same point: - \[ v_i = \exp(-a_i |X-R|^2) \] - \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] - \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] - \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] - \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] + \[ v_i = \exp(-a_i |X-R|^2) \] + \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] + \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] + \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] + \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] - | ~context~ | input | Global state | - | ~X(3)~ | input | Array containing the coordinates of the points | - | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | - | ~n~ | input | Number of computed Gaussians | - | ~A(n)~ | input | Exponents of the Gaussians | - | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | - | ~ldv~ | input | Leading dimension of array ~VGL~ | + | ~context~ | input | Global state | + | ~X(3)~ | input | Array containing the coordinates of the points | + | ~R(3)~ | input | Array containing the x,y,z coordinates of the center | + | ~n~ | input | Number of computed Gaussians | + | ~A(n)~ | input | Exponents of the Gaussians | + | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | + | ~ldv~ | input | Leading dimension of array ~VGL~ | - Requirements : + Requirements : - - ~context~ is not 0 - - ~n~ > 0 - - ~ldv~ >= 5 - - ~A(i)~ > 0 for all ~i~ - - ~X~ is allocated with at least $3 \times 8$ bytes - - ~R~ is allocated with at least $3 \times 8$ bytes - - ~A~ is allocated with at least $n \times 8$ bytes - - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes + - ~context~ is not 0 + - ~n~ > 0 + - ~ldv~ >= 5 + - ~A(i)~ > 0 for all ~i~ + - ~X~ is allocated with at least $3 \times 8$ bytes + - ~R~ is allocated with at least $3 \times 8$ bytes + - ~A~ is allocated with at least $n \times 8$ bytes + - ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes - #+begin_src c :tangle (eval h_func) + #+begin_src c :tangle (eval h_func) qmckl_exit_code qmckl_ao_gaussian_vgl(const qmckl_context context, const double *X, @@ -1377,9 +1491,9 @@ qmckl_ao_gaussian_vgl(const qmckl_context context, const int64_t *A, const double *VGL, const int64_t ldv); - #+end_src + #+end_src - #+begin_src f90 :tangle (eval f) + #+begin_src f90 :tangle (eval f) integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) use qmckl implicit none @@ -1440,9 +1554,9 @@ integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(i end do end function qmckl_ao_gaussian_vgl_f - #+end_src + #+end_src - #+begin_src f90 :tangle (eval f) :exports none + #+begin_src f90 :tangle (eval f) :exports none integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -1457,9 +1571,9 @@ integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) integer, external :: qmckl_ao_gaussian_vgl_f info = qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) end function qmckl_ao_gaussian_vgl - #+end_src + #+end_src - #+begin_src f90 :tangle (eval fh_func) :exports none + #+begin_src f90 :tangle (eval fh_func) :exports none interface integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) @@ -1471,10 +1585,10 @@ end function qmckl_ao_gaussian_vgl real (c_double) , intent(out) :: VGL(ldv,5) end function qmckl_ao_gaussian_vgl end interface - #+end_src + #+end_src - # Test - #+begin_src f90 :tangle (eval f_test) + # Test + #+begin_src f90 :tangle (eval f_test) integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) use qmckl implicit none @@ -1539,15 +1653,17 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) deallocate(VGL) end function test_qmckl_ao_gaussian_vgl - #+end_src + #+end_src - #+begin_src c :tangle (eval c_test) :exports none + #+begin_src c :tangle (eval c_test) :exports none int test_qmckl_ao_gaussian_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); - #+end_src + #+end_src -* TODO Slater basis functions +** TODO Slater basis functions +** TODO Radial functions on a grid +* Combining radial and polynomial parts * End of files :noexport: #+begin_src c :tangle (eval h_private_type) From 3618cde7b10739b1cb2a97d00d54045d5f25fcb6 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 20 Apr 2021 18:33:36 +0200 Subject: [PATCH 54/65] Cleaned Makefiles --- .github/workflows/test-build.yml | 2 +- src/Makefile | 41 +++++++++--- tools/Building.org | 103 +++++++++++++++++++++++-------- tools/create_makefile.sh | 60 +++++++++++++----- 4 files changed, 154 insertions(+), 52 deletions(-) diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index bcc00a2..14c3185 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -37,4 +37,4 @@ jobs: git submodule sync git submodule update --init --recursive - name: make - run: make -C src/ test + run: make -C src/ check diff --git a/src/Makefile b/src/Makefile index 77e48c6..fc79478 100644 --- a/src/Makefile +++ b/src/Makefile @@ -3,6 +3,8 @@ # This file was created by tools/Building.org +.POSIX: + # Dependencies @@ -13,10 +15,15 @@ LIBS=-lpthread QMCKL_ROOT=$(shell dirname $(CURDIR)) +shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so +static_lib=$(QMCKL_ROOT)/lib/libqmckl.a +qmckl_h=$(QMCKL_ROOT)/include/qmckl.h +qmckl_f=$(QMCKL_ROOT)/include/qmckl_f.f90 + export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT ORG_SOURCE_FILES=$(wildcard *.org) -OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) +C_SOURCE_FILES=$(patsubst %.org,%.c,$(ORG_SOURCE_FILES)) INCLUDE=-I$(QMCKL_ROOT)/include/ # Compiler options @@ -82,27 +89,41 @@ endif # Rules # The source files are created during the generation of the file ~Makefile.generated~. +# The Makefile.generated is the one that will be distributed with the library. -.PHONY: clean +.PHONY: clean shared static doc all check .SECONDARY: # Needed to keep the produced C and Fortran files -libqmckl.so: ../include/qmckl.h - $(MAKE) -f Makefile.generated +$(shared_lib) $(static_lib): $(qmckl_h) $(qmckl_f) Makefile.generated + $(MAKE) -f Makefile.generated $@ -../include/qmckl.h: Makefile.generated +$(qmckl_f) $(qmckl_h): Makefile.generated ../tools/build_qmckl_h.sh -test: libqmckl.so - $(MAKE) -f Makefile.generated test +shared: $(shared_lib) +static: $(static_lib) +all: shared static doc + +check: $(static_lib) + $(MAKE) -f Makefile.generated check doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/build_doc.sh clean: - $(RM) test_qmckl_* test_qmckl.c test_qmckl \ - qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ - Makefile.generated libqmckl.so *.html *.mod + - $(MAKE) -f Makefile.generated clean + - $(RM) test_qmckl_* test_qmckl.c \ + $(qmckl_h) $(qmckl_f) \ + qmckl_*.f90 qmckl_*.c qmckl_*.h \ + Makefile.generated *.html Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_makefile.sh + + +.SUFFIXES: .org .c + +.org.c: + ../tools/tangle.sh $< + diff --git a/tools/Building.org b/tools/Building.org index 959deb8..29d5c7f 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -68,6 +68,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #+begin_src makefile # <> + +.POSIX: #+end_src ** Dependencies @@ -80,10 +82,15 @@ LIBS=-lpthread #+begin_src makefile QMCKL_ROOT=$(shell dirname $(CURDIR)) +shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so +static_lib=$(QMCKL_ROOT)/lib/libqmckl.a +qmckl_h=$(QMCKL_ROOT)/include/qmckl.h +qmckl_f=$(QMCKL_ROOT)/include/qmckl_f.f90 + export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT ORG_SOURCE_FILES=$(wildcard *.org) -OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) +C_SOURCE_FILES=$(patsubst %.org,%.c,$(ORG_SOURCE_FILES)) INCLUDE=-I$(QMCKL_ROOT)/include/ #+end_src @@ -154,30 +161,44 @@ endif ** Rules The source files are created during the generation of the file ~Makefile.generated~. + The Makefile.generated is the one that will be distributed with the library. #+begin_src makefile -.PHONY: clean +.PHONY: clean shared static doc all check .SECONDARY: # Needed to keep the produced C and Fortran files -libqmckl.so: ../include/qmckl.h - $(MAKE) -f Makefile.generated +$(shared_lib) $(static_lib): $(qmckl_h) $(qmckl_f) Makefile.generated + $(MAKE) -f Makefile.generated $@ -../include/qmckl.h: Makefile.generated - ../tools/build_qmckl_h.sh +$(qmckl_f) $(qmckl_h): Makefile.generated + $(QMCKL_ROOT)/tools/build_qmckl_h.sh -test: libqmckl.so - $(MAKE) -f Makefile.generated test +shared: $(shared_lib) +static: $(static_lib) +all: shared static doc + +check: $(static_lib) + $(MAKE) -f Makefile.generated check doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/build_doc.sh clean: - $(RM) test_qmckl_* test_qmckl.c test_qmckl \ - qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ - Makefile.generated libqmckl.so *.html *.mod + - $(MAKE) -f Makefile.generated clean + - $(RM) test_qmckl_* test_qmckl.c \ + $(qmckl_h) $(qmckl_f) \ + qmckl_*.f90 qmckl_*.c qmckl_*.h \ + Makefile.generated *.html Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_makefile.sh + + +.SUFFIXES: .org .c + +.org.c: + $(QMCKL_ROOT)/tools/tangle.sh $< + #+end_src * Script to tangle the org-mode files @@ -244,6 +265,7 @@ OUTPUT=Makefile.generated #+begin_src bash ${QMCKL_ROOT}/tools/tangle.sh *.org +${QMCKL_ROOT}/tools/build_qmckl_h.sh #+end_src Then we create the list of ~*.o~ files to be created, for library @@ -281,40 +303,69 @@ done >> $OUTPUT #+begin_src bash cat << EOF > ${OUTPUT} +.POSIX: +.SUFFIXES: + +PREFIX=/usr/local + CC=$CC CFLAGS=$CFLAGS -I../munit/ FC=$FC FFLAGS=$FFLAGS + OBJECT_FILES=$OBJECTS TESTS=$TESTS TESTS_F=$TESTS_F LIBS=$LIBS -libqmckl.so: \$(OBJECT_FILES) - \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so +QMCKL_ROOT=\$(shell dirname \$(CURDIR)) +shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so +static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a +qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h +qmckl_f=\$(QMCKL_ROOT)/include/qmckl_f.f90 +munit=\$(QMCKL_ROOT)/munit/munit.c -%.o: %.c - \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o +shared: \$(shared_lib) +static: \$(static_lib) +all: shared static -%.o: %.f90 qmckl_f.o - \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o +\$(shared_lib): \$(OBJECT_FILES) + \$(CC) -shared \$(OBJECT_FILES) -o \$(shared_lib) -../include/qmckl.h ../include/qmckl_f.f90: - ../tools/build_qmckl_h.sh +\$(static_lib): \$(OBJECT_FILES) + \$(AR) rcs \$(static_lib) \$(OBJECT_FILES) -qmckl_f.o: ../include/qmckl_f.f90 - \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o -test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) - \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ - ../munit/munit.c \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl +# Test + +qmckl_f.o: \$(qmckl_f) + \$(FC) \$(FFLAGS) -c \$(qmckl_f) -o \$@ -test: test_qmckl +test_qmckl: test_qmckl.c \$(qmckl_h) \$(static_lib) \$(TESTS) \$(TESTS_F) + \$(CC) \$(CFLAGS) \ + \$(munit) \$(TESTS) \$(TESTS_F) \$(static_lib) \$(LIBS) test_qmckl.c -o \$@ + +test_qmckl_shared: test_qmckl.c \$(qmckl_h) \$(shared_lib) \$(TESTS) \$(TESTS_F) + \$(CC) \$(CFLAGS) -Wl,-rpath,\$(QMCKL_ROOT)/lib -L\$(QMCKL_ROOT)/lib \ + \$(munit) \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o \$@ + +check: test_qmckl test_qmckl_shared ./test_qmckl -.PHONY: test +clean: + \$(RM) -- *.o *.mod \$(shared_lib) \$(static_lib) test_qmckl + +.SUFFIXES: .c .f90 .o + +.c.o: + \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o + +.f90.o: qmckl_f.o + \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o + +.PHONY: check clean all EOF #+end_src diff --git a/tools/create_makefile.sh b/tools/create_makefile.sh index 209857c..8c41e69 100755 --- a/tools/create_makefile.sh +++ b/tools/create_makefile.sh @@ -21,6 +21,7 @@ OUTPUT=Makefile.generated ${QMCKL_ROOT}/tools/tangle.sh *.org +../tools/build_qmckl_h.sh @@ -62,38 +63,67 @@ done >> $OUTPUT cat << EOF > ${OUTPUT} +.POSIX: +.SUFFIXES: + +PREFIX=/usr/local + CC=$CC CFLAGS=$CFLAGS -I../munit/ FC=$FC FFLAGS=$FFLAGS + OBJECT_FILES=$OBJECTS TESTS=$TESTS TESTS_F=$TESTS_F LIBS=$LIBS -libqmckl.so: \$(OBJECT_FILES) - \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so +QMCKL_ROOT=\$(shell dirname \$(CURDIR)) +shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so +static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a +qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h +qmckl_f=\$(QMCKL_ROOT)/include/qmckl_f.f90 +munit=\$(QMCKL_ROOT)/munit/munit.c -%.o: %.c - \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o +shared: \$(shared_lib) +static: \$(static_lib) +all: shared static -%.o: %.f90 qmckl_f.o - \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o +\$(shared_lib): \$(OBJECT_FILES) + \$(CC) -shared \$(OBJECT_FILES) -o \$(shared_lib) -../include/qmckl.h ../include/qmckl_f.f90: - ../tools/build_qmckl_h.sh +\$(static_lib): \$(OBJECT_FILES) + \$(AR) rcs \$(static_lib) \$(OBJECT_FILES) -qmckl_f.o: ../include/qmckl_f.f90 - \$(FC) \$(FFLAGS) -c ../include/qmckl_f.f90 -o qmckl_f.o -test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) - \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ - ../munit/munit.c \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl +# Test + +qmckl_f.o: \$(qmckl_f) + \$(FC) \$(FFLAGS) -c \$(qmckl_f) -o \$@ -test: test_qmckl +test_qmckl: test_qmckl.c \$(qmckl_h) \$(static_lib) \$(TESTS) \$(TESTS_F) + \$(CC) \$(CFLAGS) \ + \$(munit) \$(TESTS) \$(TESTS_F) \$(static_lib) \$(LIBS) test_qmckl.c -o \$@ + +test_qmckl_shared: test_qmckl.c \$(qmckl_h) \$(shared_lib) \$(TESTS) \$(TESTS_F) + \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD/../lib -L../lib \ + \$(munit) \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o \$@ + +check: test_qmckl test_qmckl_shared ./test_qmckl -.PHONY: test +clean: + \$(RM) -- *.o *.mod \$(shared_lib) \$(static_lib) test_qmckl + +.SUFFIXES: .c .f90 .o + +.c.o: + \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o + +.f90.o: qmckl_f.o + \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o + +.PHONY: check clean all EOF From 6d83abe736f6cb0eef249fb8fa612c84992c4551 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 20 Apr 2021 19:05:45 +0200 Subject: [PATCH 55/65] Added make distcheck --- Makefile | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 Makefile diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..03d01fa --- /dev/null +++ b/Makefile @@ -0,0 +1,57 @@ +# Use POSIX-compliant Makefiles +.POSIX: + +# Clear suffix list +.SUFFIXES: + +package = qmckl +version = 0.1-alpha +tarname = $(package) +distdir = $(tarname)-$(version) + + +all clean check: + $(MAKE) -C src $@ + +dist: $(distdir).tar.gz + + +$(distdir).tar.gz: $(distdir) + tar chof - $(distdir) | gzip -9 -c > $@ + rm -rf $(distdir) + + +$(distdir): include/qmckl.h include/qmckl_f.f90 src/Makefile.generated FORCE + mkdir -p $(distdir) + mkdir -p $(distdir)/munit + mkdir -p $(distdir)/src + mkdir -p $(distdir)/include + cp munit/munit.h munit/munit.c $(distdir)/munit + cp src/*.c src/*.h src/*.f90 $(distdir)/src + cp src/Makefile.generated $(distdir)/src/Makefile + cp include/* $(distdir)/include + cp Makefile $(distdir)/ + mkdir -p $(distdir)/lib + + +FORCE: + - rm -- $(distdir).tar.gz >/dev/null 2>&1 + - rm -rf -- $(distdir) >/dev/null 2>&1 + + +distcheck: $(distdir).tar.gz + gzip -cd $(distdir).tar.gz | tar xvf - + cd $(distdir) && $(MAKE) all check + rm $(distdir)/lib/libqmckl.so $(distdir)/include/qmckl.h \ + $(distdir)/include/qmckl_f.f90 + cd $(distdir) && $(MAKE) clean + rm -rf $(distdir) + @echo "*** Package $(distdir).tar.gz is ready for distribution." + + +include/qmckl.h include/qmckl_f.f90 src/Makefile.generated: + $(MAKE) -C src + + + +.PHONY: all clean dist FORCE From 03c0abbf4e8c7cfda8eaa815ec0b0185340ead30 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 20 Apr 2021 23:59:52 +0200 Subject: [PATCH 56/65] Added gitignore --- lib/.gitignore | 2 ++ src/qmckl_context.org | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) create mode 100644 lib/.gitignore diff --git a/lib/.gitignore b/lib/.gitignore new file mode 100644 index 0000000..17eec9d --- /dev/null +++ b/lib/.gitignore @@ -0,0 +1,2 @@ +libqmckl.so +libqmckl.a diff --git a/src/qmckl_context.org b/src/qmckl_context.org index c6ae818..142cba5 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -97,8 +97,8 @@ typedef struct qmckl_context_struct { qmckl_ao_basis_struct ao_basis; /* To be implemented: - qmckl_nucleus_struct nucleus; qmckl_electron_struct electron; + qmckl_nucleus_struct nucleus; qmckl_mo_struct mo; qmckl_determinant_struct det; ,*/ From e18655b147052f578b1fcc384b05804151379be7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Apr 2021 01:56:47 +0200 Subject: [PATCH 57/65] Added qmckl_electron --- .github/workflows/test-build.yml | 2 + src/qmckl_ao.org | 41 ++- src/qmckl_context.org | 11 +- src/qmckl_electron.org | 446 +++++++++++++++++++++++++++++++ src/table_of_contents | 1 + src/test_qmckl.org | 9 +- tools/build_qmckl_h.sh | 5 +- 7 files changed, 488 insertions(+), 27 deletions(-) create mode 100644 src/qmckl_electron.org diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index 14c3185..0e65800 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -38,3 +38,5 @@ jobs: git submodule update --init --recursive - name: make run: make -C src/ check + - name: make + run: make distcheck diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 916e3fd..f83ef2d 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -42,6 +42,7 @@ gradients and Laplacian of the atomic basis functions. #+begin_src c :tangle (eval h_private_type) #ifndef QMCKL_AO_HPT #define QMCKL_AO_HPT +#include #+end_src #+begin_src c :tangle (eval c_test) :noweb yes @@ -56,6 +57,7 @@ MunitResult test_<>() { #include #include #include +#include #include #include "qmckl_error_type.h" @@ -129,7 +131,6 @@ coefficient = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, #+begin_src c :comments org :tangle (eval h_private_type) typedef struct qmckl_ao_basis_struct { - int32_t provided; int32_t uninitialized; int64_t shell_num; int64_t prim_num; @@ -140,6 +141,7 @@ typedef struct qmckl_ao_basis_struct { double * shell_factor; double * exponent ; double * coefficient ; + bool provided; char type; } qmckl_ao_basis_struct; #+end_src @@ -147,7 +149,7 @@ typedef struct qmckl_ao_basis_struct { The ~uninitialized~ integer contains one bit set to one for each initialization function which has not bee called. It becomes equal to zero after all initialization functions have been called. The - struct is then initialized and ~provided == 1~. + struct is then initialized and ~provided == true~. ** Access functions @@ -168,7 +170,7 @@ double* qmckl_get_ao_basis_coefficient (const qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval h_func) -int32_t qmckl_ao_basis_provided (const qmckl_context context); +bool qmckl_ao_basis_provided (const qmckl_context context); #+end_src #+NAME:post @@ -371,10 +373,10 @@ double* qmckl_get_ao_basis_coefficient (const qmckl_context context) { } -int32_t qmckl_ao_basis_provided(const qmckl_context context) { +bool qmckl_ao_basis_provided(const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { - return 0; + return false; } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; @@ -414,10 +416,7 @@ qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; #+NAME:post2 #+begin_src c ctx->ao_basis.uninitialized &= ~mask; - -if (ctx->ao_basis.uninitialized == 0) { - ctx->ao_basis.provided = 1; -} +ctx->ao_basis.provided = (ctx->ao_basis.uninitialized == 0); return QMCKL_SUCCESS; #+end_src @@ -829,51 +828,51 @@ double coefficient [prim_num] = qmckl_exit_code rc; -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_type (context, typ); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_shell_num (context, shell_num); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_prim_num (context, prim_num); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_shell_center (context, shell_center); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_shell_ang_mom (context, shell_ang_mom); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_shell_factor (context, shell_factor); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_shell_center (context, shell_prim_num); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_shell_prim_num (context, shell_prim_num); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_shell_prim_index (context, shell_prim_index); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_exponent (context, exponent); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 0); +munit_assert(!qmckl_ao_basis_provided(context)); rc = qmckl_set_ao_basis_coefficient (context, coefficient); munit_assert_int64(rc, ==, QMCKL_SUCCESS); -munit_assert_int(qmckl_ao_basis_provided(context), ==, 1); +munit_assert(qmckl_ao_basis_provided(context)); #+end_src diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 142cba5..509ae9a 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -20,6 +20,7 @@ MunitResult test_<>() { #include "qmckl_error_private_type.h" #include "qmckl_memory_private_type.h" #include "qmckl_numprec_private_type.h" +#include "qmckl_electron_private_type.h" #include "qmckl_ao_private_type.h" #+end_src @@ -93,11 +94,14 @@ typedef struct qmckl_context_struct { /* Memory allocation */ qmckl_memory_struct memory; + /* Current date */ + uint64_t date; + /* -- Molecular system -- */ + qmckl_electron_struct electron; qmckl_ao_basis_struct ao_basis; /* To be implemented: - qmckl_electron_struct electron; qmckl_nucleus_struct nucleus; qmckl_mo_struct mo; qmckl_determinant_struct det; @@ -106,6 +110,10 @@ typedef struct qmckl_context_struct { } qmckl_context_struct; #+end_src + The context keeps a ``date'' that allows to check which data needs + to be recomputed. The date is incremented when the electron + coordinates are updated. + When a new element is added to the context, the functions [[Creation][qmckl_context_create]], [[Destroy][qmckl_context_destroy]] and [[Copy][qmckl_context_copy]] should be updated inorder to make deep copies. @@ -199,6 +207,7 @@ qmckl_context qmckl_context_create() { ctx->numprec.range = QMCKL_DEFAULT_RANGE; ctx->ao_basis.uninitialized = (1 << 10) - 1; + ctx->electron.uninitialized = (1 << 4) - 1; /* Allocate qmckl_memory_struct */ { diff --git a/src/qmckl_electron.org b/src/qmckl_electron.org new file mode 100644 index 0000000..fc26f4f --- /dev/null +++ b/src/qmckl_electron.org @@ -0,0 +1,446 @@ +#+TITLE: Electrons +#+SETUPFILE: ../docs/theme.setup +#+INCLUDE: ../tools/lib.org + +In conventional QMC simulations, up-spin and down-spin electrons are +different. The ~electron~ data structure contains the number of +up-spin and down-spin electrons, and the electron coordinates. + +* Headers :noexport: + #+begin_src elisp :noexport :results none +(org-babel-lob-ingest "../tools/lib.org") +#+end_src + + + #+begin_src c :tangle (eval h_private_type) +#ifndef QMCKL_ELECTRON_HPT +#define QMCKL_ELECTRON_HPT +#include + #+end_src + + #+begin_src c :tangle (eval c_test) :noweb yes +#include "qmckl.h" +#include "munit.h" +MunitResult test_<>() { + qmckl_context context; + context = qmckl_context_create(); + #+end_src + + #+begin_src c :tangle (eval c) +#include +#include +#include +#include +#include + +#include "qmckl_error_type.h" +#include "qmckl_context_type.h" +#include "qmckl_context_private_type.h" +#include "qmckl_memory_private_type.h" + +#include "qmckl_error_func.h" +#include "qmckl_memory_private_func.h" +#include "qmckl_memory_func.h" +#include "qmckl_context_func.h" + #+end_src + +* Context + + The following data stored in the context: + + | ~date~ | uint64_t | Last modification date of the coordinates | + | ~uninitialized~ | int32_t | Keeps bit set for uninitialized data | + | ~num~ | int64_t | Total number of electrons | + | ~up_num~ | int64_t | Number of up-spin electrons | + | ~down_num~ | int64_t | Number of down-spin electrons | + | ~walk_num~ | int64_t | Number of walkers | + | ~provided~ | bool | If true, ~electron~ is valid | + | ~coord_new~ | double[walk_num][3][num] | New set of electron coordinates | + | ~coord_old~ | double[walk_num][3][num] | Old set of electron coordinates | + +** Data structure + + #+begin_src c :comments org :tangle (eval h_private_type) +typedef struct qmckl_electron_struct { + int64_t date; + int64_t num; + int64_t up_num; + int64_t down_num; + int64_t walk_num; + double* coord_new; + double* coord_old; + int32_t uninitialized; + bool provided; +} qmckl_electron_struct; + #+end_src + + The ~uninitialized~ integer contains one bit set to one for each + initialization function which has not bee called. It becomes equal + to zero after all initialization functions have been called. The + struct is then initialized and ~provided == true~. + +** Access functions + + Access to scalars copies the values at the passed address, and + for array values a pointer to the array is returned. + + #+begin_src c :comments org :tangle (eval h_private_func) +int64_t qmckl_get_electron_num (const qmckl_context context); +int64_t qmckl_get_electron_up_num (const qmckl_context context); +int64_t qmckl_get_electron_down_num (const qmckl_context context); +int64_t qmckl_get_electron_walk_num (const qmckl_context context); +double* qmckl_get_electron_coord_new (const qmckl_context context); +double* qmckl_get_electron_coord_old (const qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval h_func) +bool qmckl_electron_provided (const qmckl_context context); + #+end_src + + #+NAME:post + #+begin_src c +if ( (ctx->electron.uninitialized & mask) != 0) { + return NULL; +} + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes +int64_t qmckl_get_electron_num (const qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1; + + if ( (ctx->electron.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->electron.num > (int64_t) 0); + return ctx->electron.num; +} + + +int64_t qmckl_get_electron_up_num (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 1; + + if ( (ctx->electron.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->electron.up_num > (int64_t) 0); + return ctx->electron.up_num; +} + + +int64_t qmckl_get_electron_down_num (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 2; + + if ( (ctx->electron.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->electron.down_num >= (int64_t) 0); + return ctx->electron.down_num; +} + + +int64_t qmckl_get_electron_walk_num (const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (int64_t) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int32_t mask = 1 << 3; + + if ( (ctx->electron.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->electron.walk_num > (int64_t) 0); + return ctx->electron.walk_num; +} + + + +bool qmckl_electron_provided(const qmckl_context context) { + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return false; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + return ctx->electron.provided; +} + #+end_src + +** Initialization functions + + To set the data relative to the electrons in the context, the + following functions need to be called. When the data structure is + initialized, the ~coord_new~ and ~coord_old~ arrays are both allocated. + + #+begin_src c :comments org :tangle (eval h_func) +qmckl_exit_code qmckl_set_electron_num (qmckl_context context, const int64_t up_num, const int64_t down_num); +qmckl_exit_code qmckl_set_electron_walk_num (qmckl_context context, const int64_t walk_num); +qmckl_exit_code qmckl_set_electron_coord (qmckl_context context, const double* coord); + #+end_src + + #+NAME:pre2 + #+begin_src c +if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return QMCKL_NULL_CONTEXT; + } + +qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + #+end_src + + #+NAME:post2 + #+begin_src c +ctx->electron.uninitialized &= ~mask; +ctx->electron.provided = (ctx->electron.uninitialized == 0); + +if (ctx->electron.provided) { + if (ctx->electron.coord_new != NULL) { + qmckl_free(context, ctx->electron.coord_new); + ctx->electron.coord_new = NULL; + } + if (ctx->electron.coord_old != NULL) { + qmckl_free(context, ctx->electron.coord_old); + ctx->electron.coord_old = NULL; + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.num * ctx->electron.walk_num * 3 * sizeof(double); + + double* coord_new = (double*) qmckl_malloc(context, mem_info); + if (coord_new == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_electron_num", + NULL); + } + ctx->electron.coord_new = coord_new; + + double* coord_old = (double*) qmckl_malloc(context, mem_info); + if (coord_old == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_set_electron_num", + NULL); + } + ctx->electron.coord_old = coord_old; + } + +return QMCKL_SUCCESS; + #+end_src + + To set the number of electrons, we give the number of up-spin and + down-spin electrons to the context. + + #+begin_src c :comments org :tangle (eval c) :noweb yes +qmckl_exit_code qmckl_set_electron_num(qmckl_context context, + const int64_t up_num, + const int64_t down_num) { + <> + + if (up_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_electron_num", + "up_num <= 0"); + } + + if (down_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_set_electron_num", + "down_num <= 0"); + } + + int32_t mask = (1 << 3) -1; + + ctx->electron.up_num = up_num; + ctx->electron.down_num = down_num; + ctx->electron.num = up_num + down_num; + + <> +} + #+end_src + + + Then, we set the number of walkers: + + #+begin_src c :comments org :tangle (eval c) :noweb yes +qmckl_exit_code qmckl_set_electron_walk_num(qmckl_context context, const int64_t walk_num) { + <> + + if (walk_num <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_electron_walk_num", + "walk_num <= 0"); + } + + int32_t mask = 1 << 3; + ctx->electron.walk_num = walk_num; + + <> +} + #+end_src + + + The following function sets the electron coordinates of all the + walkers. When this is done, the pointers to the old and new sets + of coordinates are swapped, and the new coordinates are + overwritten. + + #+begin_src c :comments org :tangle (eval c) :noweb yes +qmckl_exit_code qmckl_set_electron_coord(qmckl_context context, const double* coord) { + <> + + const int64_t num = qmckl_get_electron_num(context); + if (num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_electron_coord", + "num is not set"); + } + + const int64_t walk_num = qmckl_get_electron_walk_num(context); + if (walk_num == 0L) { + return qmckl_failwith( context, + QMCKL_FAILURE, + "qmckl_set_electron_coord", + "walk_num is not set"); + } + + /* If num and walk_num are set, the arrays should be allocated */ + assert (ctx->electron.coord_old != NULL); + assert (ctx->electron.coord_new != NULL); + + /* Increment the date of the context */ + ctx->date += 1UL; + + /* Swap pointers */ + double * swap; + swap = ctx->electron.coord_old; + ctx->electron.coord_old = ctx->electron.coord_new; + ctx->electron.coord_new = swap; + + memcpy(ctx->electron.coord_new, coord, walk_num * num * 3 * sizeof(double)); + ctx->electron.date = ctx->date; + + return QMCKL_SUCCESS; + +} + #+end_src + +** Test + + #+begin_src c :tangle (eval c_test) +/* Reference input data */ + +#define up_num ((int64_t) 3) +#define down_num ((int64_t) 2) +#define walk_num ((int64_t) 2) +#define num (up_num+down_num) + +double coord[walk_num*3*num] = + { 7.303633091022677881e+00, 1.375868694453235719e+01, 1.167371490471771217e-01, + 4.547755371567960836e+00, 3.245907105524011182e+00, 2.410764357550297110e-01, + 5.932816068137344523e+00, 1.491671465549257469e+01, 3.825374039119375236e-01, + 7.347336142660052083e+00, 1.341946976062362129e+00, 1.648917914228352322e+00, + 5.735221530102248444e+00, 1.064667491680036271e+01, 4.227201772236627297e-01, + 8.099550978782254163e+00, 6.861498941099086757e+00, 4.015884841159429036e-02, + 1.014757367558326173e+01, 5.219335322173662917e+00, 5.037004126899931322e-02, + 1.484094322159507051e+01, 9.777903829455864226e+00, 5.243007994024882767e-02, + 9.081723054990456845e+00, 5.499568496038920173e+00, 2.910446438899221347e-02, + 2.583154239492383653e+00, 1.442282811294904432e+00, 6.387191629878670451e-02 }; + +/* --- */ + +qmckl_exit_code rc; + +munit_assert(!qmckl_electron_provided(context)); + +rc = qmckl_set_electron_num (context, up_num, down_num); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert(!qmckl_electron_provided(context)); + +rc = qmckl_set_electron_walk_num (context, walk_num); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); +munit_assert(qmckl_electron_provided(context)); + +rc = qmckl_set_electron_coord (context, coord); +munit_assert_int64(rc, ==, QMCKL_SUCCESS); + + #+end_src + +* End of files :noexport: + + #+begin_src c :tangle (eval h_private_type) +#endif + #+end_src + +*** Test + #+begin_src c :tangle (eval c_test) + if (qmckl_context_destroy(context) != QMCKL_SUCCESS) + return QMCKL_FAILURE; + return MUNIT_OK; +} + #+end_src + +**✸ Compute file names + #+begin_src emacs-lisp +; The following is required to compute the file names + +(setq pwd (file-name-directory buffer-file-name)) +(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) +(setq f (concat pwd name "_f.f90")) +(setq fh (concat pwd name "_fh.f90")) +(setq c (concat pwd name ".c")) +(setq h (concat name ".h")) +(setq h_private (concat name "_private.h")) +(setq c_test (concat pwd "test_" name ".c")) +(setq f_test (concat pwd "test_" name "_f.f90")) + +; Minted +(require 'ox-latex) +(setq org-latex-listings 'minted) +(add-to-list 'org-latex-packages-alist '("" "listings")) +(add-to-list 'org-latex-packages-alist '("" "color")) + + #+end_src + + #+RESULTS: + | | color | + | | listings | + + +# -*- mode: org -*- +# vim: syntax=c + + diff --git a/src/table_of_contents b/src/table_of_contents index b9fd652..4b48cf9 100644 --- a/src/table_of_contents +++ b/src/table_of_contents @@ -2,6 +2,7 @@ qmckl.org qmckl_error.org qmckl_context.org qmckl_memory.org +qmckl_electron.org qmckl_ao.org qmckl_distance.org test_qmckl.org diff --git a/src/test_qmckl.org b/src/test_qmckl.org index a7125e7..de71b96 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -20,8 +20,9 @@ grep begin_src $FILES \ | qmckl_error | | qmckl_context | | qmckl_memory | - | qmckl_distance | + | qmckl_electron | | qmckl_ao | + | qmckl_distance | We generate the function headers #+begin_src sh :var files=test-files :exports output :results drawer @@ -42,8 +43,9 @@ echo "#+end_src" MunitResult test_qmckl_error(); MunitResult test_qmckl_context(); MunitResult test_qmckl_memory(); - MunitResult test_qmckl_distance(); + MunitResult test_qmckl_electron(); MunitResult test_qmckl_ao(); + MunitResult test_qmckl_distance(); #+end_src :end: @@ -66,8 +68,9 @@ echo "#+end_src" { (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, - { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_electron", test_qmckl_electron, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, #+end_src :end: diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh index ff57803..32fb77e 100755 --- a/tools/build_qmckl_h.sh +++ b/tools/build_qmckl_h.sh @@ -78,11 +78,12 @@ cat << EOF > ${OUTPUT} * */ -#ifndef __QMCKL_H__ -#define __QMCKL_H__ +#ifndef QMCKL_H +#define QMCKL_H #include #include +#include EOF for i in ${HEADERS} From 399a632bdd2b637c23edcf7645af21db5bf84170 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Apr 2021 12:44:03 +0200 Subject: [PATCH 58/65] Add doc in dist, and text doc --- .gitignore | 1 + Makefile | 31 ++++++++++++++++++++++++------- docs/.gitignore | 1 + man/.gitignore | 0 share/qmckl/fortran/.gitignore | 1 + src/Makefile | 13 ++++++------- src/qmckl.org | 20 ++++++++++---------- src/qmckl_ao.org | 6 +++--- tools/Building.org | 27 +++++++++++++++++++-------- tools/build_qmckl_h.sh | 6 +++--- tools/create_makefile.sh | 20 +++++++++++++++----- 11 files changed, 83 insertions(+), 43 deletions(-) create mode 100644 docs/.gitignore create mode 100644 man/.gitignore create mode 100644 share/qmckl/fortran/.gitignore diff --git a/.gitignore b/.gitignore index c7cf3cf..b3c7c38 100644 --- a/.gitignore +++ b/.gitignore @@ -7,5 +7,6 @@ src/auto/ src/ltximg/ src/qmckl.mod *.swp +*.tar.gz diff --git a/Makefile b/Makefile index 03d01fa..5568582 100644 --- a/Makefile +++ b/Makefile @@ -8,9 +8,18 @@ package = qmckl version = 0.1-alpha tarname = $(package) distdir = $(tarname)-$(version) +prefix = /usr/local + +QMCKL_ROOT=$(CURDIR) +shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so +static_lib=$(QMCKL_ROOT)/lib/libqmckl.a +qmckl_h=$(QMCKL_ROOT)/include/qmckl.h +qmckl_f=$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90 + +export prefix shared_lib static_lib qmckl_h qmckl_f -all clean check: +all clean doc check install uninstall: $(MAKE) -C src $@ dist: $(distdir).tar.gz @@ -21,16 +30,24 @@ $(distdir).tar.gz: $(distdir) rm -rf $(distdir) -$(distdir): include/qmckl.h include/qmckl_f.f90 src/Makefile.generated FORCE +$(distdir): $(qmckl_h) $(qmckl_f) $(static_lib) $(shared_lib) src/Makefile.generated doc FORCE mkdir -p $(distdir) mkdir -p $(distdir)/munit mkdir -p $(distdir)/src mkdir -p $(distdir)/include - cp munit/munit.h munit/munit.c $(distdir)/munit - cp src/*.c src/*.h src/*.f90 $(distdir)/src + mkdir -p $(distdir)/share/qmckl/fortran + mkdir -p $(distdir)/share/qmckl/doc/html/ + mkdir -p $(distdir)/share/qmckl/doc/text/ + mkdir -p $(distdir)/man + cp munit/munit.h munit/munit.c $(distdir)/munit/ + cp src/*.c src/*.h src/*.f90 $(distdir)/src/ cp src/Makefile.generated $(distdir)/src/Makefile cp include/* $(distdir)/include cp Makefile $(distdir)/ + cp docs/*.html $(distdir)/share/qmckl/doc/html/ + cp docs/*.css $(distdir)/share/qmckl/doc/html/ + cp docs/*.txt $(distdir)/share/qmckl/doc/text/ + cp share/qmckl/fortran/* $(distdir)/share/qmckl/fortran mkdir -p $(distdir)/lib @@ -49,9 +66,9 @@ distcheck: $(distdir).tar.gz @echo "*** Package $(distdir).tar.gz is ready for distribution." -include/qmckl.h include/qmckl_f.f90 src/Makefile.generated: - $(MAKE) -C src +$(qmckl_h) $(qmckl_f) $(static_lib) $(shared_lib) src/Makefile.generated: + $(MAKE) -C src $@ -.PHONY: all clean dist FORCE +.PHONY: all clean dist doc install uninstall FORCE diff --git a/docs/.gitignore b/docs/.gitignore new file mode 100644 index 0000000..2211df6 --- /dev/null +++ b/docs/.gitignore @@ -0,0 +1 @@ +*.txt diff --git a/man/.gitignore b/man/.gitignore new file mode 100644 index 0000000..e69de29 diff --git a/share/qmckl/fortran/.gitignore b/share/qmckl/fortran/.gitignore new file mode 100644 index 0000000..8f5f4da --- /dev/null +++ b/share/qmckl/fortran/.gitignore @@ -0,0 +1 @@ +qmckl_f.f90 diff --git a/src/Makefile b/src/Makefile index fc79478..316aab1 100644 --- a/src/Makefile +++ b/src/Makefile @@ -18,7 +18,7 @@ QMCKL_ROOT=$(shell dirname $(CURDIR)) shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so static_lib=$(QMCKL_ROOT)/lib/libqmckl.a qmckl_h=$(QMCKL_ROOT)/include/qmckl.h -qmckl_f=$(QMCKL_ROOT)/include/qmckl_f.f90 +qmckl_f=$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90 export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT @@ -92,18 +92,18 @@ endif # The Makefile.generated is the one that will be distributed with the library. -.PHONY: clean shared static doc all check +.PHONY: clean shared static doc all check install uninstall .SECONDARY: # Needed to keep the produced C and Fortran files -$(shared_lib) $(static_lib): $(qmckl_h) $(qmckl_f) Makefile.generated +$(shared_lib) $(static_lib) install uninstall: $(qmckl_h) $(qmckl_f) Makefile.generated $(MAKE) -f Makefile.generated $@ $(qmckl_f) $(qmckl_h): Makefile.generated - ../tools/build_qmckl_h.sh + $(QMCKL_ROOT)/tools/build_qmckl_h.sh shared: $(shared_lib) static: $(static_lib) -all: shared static doc +all: shared static doc check check: $(static_lib) $(MAKE) -f Makefile.generated check @@ -125,5 +125,4 @@ Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURC .SUFFIXES: .org .c .org.c: - ../tools/tangle.sh $< - + $(QMCKL_ROOT)/tools/tangle.sh $< diff --git a/src/qmckl.org b/src/qmckl.org index 8e5ab50..b72d451 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -2,19 +2,19 @@ #+PROPERTY: comments org #+SETUPFILE: ../docs/theme.setup # -*- mode: org -*- - + * Using QMCkl -The =qmckl.h= header file has to be included in C codes when -QMCkl functions are used: +The =qmckl.h= header file installed in the =${prefix}/include= directory +has to be included in C codes when QMCkl functions are used: #+begin_src c :tangle no #include "qmckl.h" #+end_src -In Fortran programs, the =qmckl_f.f90= interface file should be -included in the source code using the library, and the Fortran codes -should use the ~qmckl~ module as +In Fortran programs, the =qmckl_f.f90= installed in +=${prefix}/share/qmckl/fortran= interface file should be copied in the source +code using the library, and the Fortran codes should use the ~qmckl~ module as #+begin_src f90 :tangle no use qmckl @@ -23,7 +23,7 @@ use qmckl Both files are located in the =include/= directory. * Developing in QMCkl - + ** Literate programming In a traditional source code, most of the lines of source files of a program @@ -115,7 +115,7 @@ Both files are located in the =include/= directory. [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]]. ** Coding rules - + The authors should follow the recommendations of the C99 [[https://wiki.sei.cmu.edu/confluence/display/c/SEI+CERT+C+Coding+Standard][SEI+CERT C Coding Standard]]. @@ -186,7 +186,7 @@ cppcheck --addon=cert --enable=all *.c &> cppcheck.out The internal structure of the context is not specified, to give a maximum of freedom to the different implementations. Modifying the state is done by setters and getters, prefixed by - =qmckl_set_= an =qmckl_get_=. + =qmckl_set_= an =qmckl_get_=. ** Headers @@ -222,7 +222,7 @@ cppcheck --addon=cert --enable=all *.c &> cppcheck.out | =*_private_func.h= | Private | Function definitions | | =*fh_type.f90= | Public | Fortran type definitions | | =*fh_func.f90= | Public | Fortran function definitions | - + ** Low-level functions Low-level functions are very simple functions which are leaves of diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index f83ef2d..7999a04 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -898,7 +898,7 @@ munit_assert(qmckl_ao_basis_provided(context)); | double | P[n][ldp] | out | Array containing all the powers of ~X~ | | int64_t | ldp | in | Leading dimension of array ~P~ | -*** Requirements: +*** Requirements - ~context~ is not ~QMCKL_NULL_CONTEXT~ - ~n~ > 0 @@ -1124,7 +1124,7 @@ munit_assert_int(0, ==, test_qmckl_ao_power(context)); | double | VGL[n][ldv] | out | Value, gradients and Laplacian of the polynomials | | int64_t | ldv | in | Leading dimension of array ~VGL~ | -*** Requirements: +*** Requirements - ~context~ is not ~QMCKL_NULL_CONTEXT~ - ~n~ > 0 @@ -1470,7 +1470,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); | ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians | | ~ldv~ | input | Leading dimension of array ~VGL~ | - Requirements : + Requirements - ~context~ is not 0 - ~n~ > 0 diff --git a/tools/Building.org b/tools/Building.org index 29d5c7f..5f2ba8e 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -85,7 +85,7 @@ QMCKL_ROOT=$(shell dirname $(CURDIR)) shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so static_lib=$(QMCKL_ROOT)/lib/libqmckl.a qmckl_h=$(QMCKL_ROOT)/include/qmckl.h -qmckl_f=$(QMCKL_ROOT)/include/qmckl_f.f90 +qmckl_f=$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90 export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT @@ -164,10 +164,10 @@ endif The Makefile.generated is the one that will be distributed with the library. #+begin_src makefile -.PHONY: clean shared static doc all check +.PHONY: clean shared static doc all check install uninstall .SECONDARY: # Needed to keep the produced C and Fortran files -$(shared_lib) $(static_lib): $(qmckl_h) $(qmckl_f) Makefile.generated +$(shared_lib) $(static_lib) install uninstall: $(qmckl_h) $(qmckl_f) Makefile.generated $(MAKE) -f Makefile.generated $@ $(qmckl_f) $(qmckl_h): Makefile.generated @@ -175,7 +175,7 @@ $(qmckl_f) $(qmckl_h): Makefile.generated shared: $(shared_lib) static: $(static_lib) -all: shared static doc +all: shared static doc check check: $(static_lib) $(MAKE) -f Makefile.generated check @@ -306,7 +306,7 @@ cat << EOF > ${OUTPUT} .POSIX: .SUFFIXES: -PREFIX=/usr/local +prefix=/usr/local CC=$CC CFLAGS=$CFLAGS -I../munit/ @@ -324,7 +324,7 @@ QMCKL_ROOT=\$(shell dirname \$(CURDIR)) shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h -qmckl_f=\$(QMCKL_ROOT)/include/qmckl_f.f90 +qmckl_f=\$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90 munit=\$(QMCKL_ROOT)/munit/munit.c shared: \$(shared_lib) @@ -339,7 +339,7 @@ all: shared static # Test - + qmckl_f.o: \$(qmckl_f) \$(FC) \$(FFLAGS) -c \$(qmckl_f) -o \$@ @@ -357,6 +357,16 @@ check: test_qmckl test_qmckl_shared clean: \$(RM) -- *.o *.mod \$(shared_lib) \$(static_lib) test_qmckl +install: + install -d \$(prefix)/lib + install -d \$(prefix)/include + install -d \$(prefix)/share/qmckl/fortran + install -d \$(prefix)/man + install \$(shared_lib) \$(prefix)/lib + install \$(static_lib) \$(prefix)/lib + install \$(qmckl_h) \$(prefix)/include + install \$(qmckl_f) \$(prefix)/share/qmckl/fortran + .SUFFIXES: .c .f90 .o .c.o: @@ -428,6 +438,7 @@ cat << EOF > ${OUTPUT} #include #include +#include EOF for i in ${HEADERS} @@ -448,7 +459,7 @@ EOF HEADERS_TYPE="qmckl_*_fh_type.f90" HEADERS="qmckl_*_fh_func.f90" -OUTPUT="../include/qmckl_f.f90" +OUTPUT="../share/qmckl/fortran/qmckl_f.f90" cat << EOF > ${OUTPUT} ! ! <> diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh index 32fb77e..ef0458e 100755 --- a/tools/build_qmckl_h.sh +++ b/tools/build_qmckl_h.sh @@ -78,8 +78,8 @@ cat << EOF > ${OUTPUT} * */ -#ifndef QMCKL_H -#define QMCKL_H +#ifndef __QMCKL_H__ +#define __QMCKL_H__ #include #include @@ -105,7 +105,7 @@ EOF HEADERS_TYPE="qmckl_*_fh_type.f90" HEADERS="qmckl_*_fh_func.f90" -OUTPUT="../include/qmckl_f.f90" +OUTPUT="../share/qmckl/fortran/qmckl_f.f90" cat << EOF > ${OUTPUT} ! ! ------------------------------------------ diff --git a/tools/create_makefile.sh b/tools/create_makefile.sh index 8c41e69..f6e8951 100755 --- a/tools/create_makefile.sh +++ b/tools/create_makefile.sh @@ -21,7 +21,7 @@ OUTPUT=Makefile.generated ${QMCKL_ROOT}/tools/tangle.sh *.org -../tools/build_qmckl_h.sh +${QMCKL_ROOT}/tools/build_qmckl_h.sh @@ -66,7 +66,7 @@ cat << EOF > ${OUTPUT} .POSIX: .SUFFIXES: -PREFIX=/usr/local +prefix=/usr/local CC=$CC CFLAGS=$CFLAGS -I../munit/ @@ -84,7 +84,7 @@ QMCKL_ROOT=\$(shell dirname \$(CURDIR)) shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h -qmckl_f=\$(QMCKL_ROOT)/include/qmckl_f.f90 +qmckl_f=\$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90 munit=\$(QMCKL_ROOT)/munit/munit.c shared: \$(shared_lib) @@ -99,7 +99,7 @@ all: shared static # Test - + qmckl_f.o: \$(qmckl_f) \$(FC) \$(FFLAGS) -c \$(qmckl_f) -o \$@ @@ -108,7 +108,7 @@ test_qmckl: test_qmckl.c \$(qmckl_h) \$(static_lib) \$(TESTS) \$(TESTS_F) \$(munit) \$(TESTS) \$(TESTS_F) \$(static_lib) \$(LIBS) test_qmckl.c -o \$@ test_qmckl_shared: test_qmckl.c \$(qmckl_h) \$(shared_lib) \$(TESTS) \$(TESTS_F) - \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD/../lib -L../lib \ + \$(CC) \$(CFLAGS) -Wl,-rpath,\$(QMCKL_ROOT)/lib -L\$(QMCKL_ROOT)/lib \ \$(munit) \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o \$@ check: test_qmckl test_qmckl_shared @@ -117,6 +117,16 @@ check: test_qmckl test_qmckl_shared clean: \$(RM) -- *.o *.mod \$(shared_lib) \$(static_lib) test_qmckl +install: + install -d \$(prefix)/lib + install -d \$(prefix)/include + install -d \$(prefix)/share/qmckl/fortran + install -d \$(prefix)/man + install \$(shared_lib) \$(prefix)/lib + install \$(static_lib) \$(prefix)/lib + install \$(qmckl_h) \$(prefix)/include + install \$(qmckl_f) \$(prefix)/share/qmckl/fortran + .SUFFIXES: .c .f90 .o .c.o: From 59d56f6b277bc1aeb8da3440e0b9466e1c14c34b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Apr 2021 13:00:24 +0200 Subject: [PATCH 59/65] Hide code in doc --- src/qmckl_ao.org | 32 ++++++++++++-------------------- src/qmckl_electron.org | 29 ++++++++++++++--------------- 2 files changed, 26 insertions(+), 35 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 7999a04..2a6cb80 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -152,11 +152,8 @@ typedef struct qmckl_ao_basis_struct { struct is then initialized and ~provided == true~. ** Access functions - - Access to scalars copies the values at the passed address, and - for array values a pointer to the array is returned. - #+begin_src c :comments org :tangle (eval h_private_func) + #+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); @@ -169,18 +166,21 @@ double* qmckl_get_ao_basis_exponent (const qmckl_context context); double* qmckl_get_ao_basis_coefficient (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 #+NAME:post - #+begin_src c + #+begin_src c :exports none if ( (ctx->ao_basis.uninitialized & mask) != 0) { return NULL; } #+end_src - #+begin_src c :comments org :tangle (eval c) :noweb yes + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none char qmckl_get_ao_basis_type (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { @@ -405,7 +405,7 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient (qmckl_context context, con #+end_src #+NAME:pre2 - #+begin_src c + #+begin_src c :exports none if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; } @@ -414,7 +414,7 @@ qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; #+end_src #+NAME:post2 - #+begin_src c + #+begin_src c :exports none ctx->ao_basis.uninitialized &= ~mask; ctx->ao_basis.provided = (ctx->ao_basis.uninitialized == 0); @@ -422,7 +422,7 @@ return QMCKL_SUCCESS; #+end_src - #+begin_src c :comments org :tangle (eval c) :noweb yes + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_ao_basis_type(qmckl_context context, const char t) { <> @@ -781,19 +781,11 @@ qmckl_exit_code qmckl_set_ao_basis_coefficient(qmckl_context context, const dou #+end_src +** TODO Fortran interfaces -** Fortran interfaces - #+NAME: qmckl_ao_power_args - | qmckl_context | context | in | Global state | - | int64_t | n | in | Number of values | - | double | X[n] | in | Array containing the input values | - | int32_t | LMAX[n] | in | Array containing the maximum power for each value | - | double | P[n][ldp] | out | Array containing all the powers of ~X~ | - | int64_t | ldp | in | Leading dimension of array ~P~ | +** Test :noexport: -** Test - - #+begin_src c :tangle (eval c_test) + #+begin_src c :tangle (eval c_test) :exports none :exports none /* Reference input data */ char typ = 'G'; diff --git a/src/qmckl_electron.org b/src/qmckl_electron.org index fc26f4f..8ca17e9 100644 --- a/src/qmckl_electron.org +++ b/src/qmckl_electron.org @@ -81,10 +81,7 @@ typedef struct qmckl_electron_struct { ** Access functions - Access to scalars copies the values at the passed address, and - for array values a pointer to the array is returned. - - #+begin_src c :comments org :tangle (eval h_private_func) + #+begin_src c :comments org :tangle (eval h_private_func) :exports none int64_t qmckl_get_electron_num (const qmckl_context context); int64_t qmckl_get_electron_up_num (const qmckl_context context); int64_t qmckl_get_electron_down_num (const qmckl_context context); @@ -93,18 +90,21 @@ double* qmckl_get_electron_coord_new (const qmckl_context context); double* qmckl_get_electron_coord_old (const qmckl_context context); #+end_src + When all the data relative to electrons have been set, the + following function returns ~true~. + #+begin_src c :comments org :tangle (eval h_func) bool qmckl_electron_provided (const qmckl_context context); #+end_src #+NAME:post - #+begin_src c + #+begin_src c :exports none if ( (ctx->electron.uninitialized & mask) != 0) { return NULL; } #+end_src - #+begin_src c :comments org :tangle (eval c) :noweb yes + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none int64_t qmckl_get_electron_num (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { @@ -209,7 +209,7 @@ qmckl_exit_code qmckl_set_electron_coord (qmckl_context context, const dou #+end_src #+NAME:pre2 - #+begin_src c + #+begin_src c :exports none if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; } @@ -218,7 +218,7 @@ qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; #+end_src #+NAME:post2 - #+begin_src c + #+begin_src c :exports none ctx->electron.uninitialized &= ~mask; ctx->electron.provided = (ctx->electron.uninitialized == 0); @@ -258,9 +258,9 @@ return QMCKL_SUCCESS; #+end_src To set the number of electrons, we give the number of up-spin and - down-spin electrons to the context. + down-spin electrons to the context and we set the number of walkers. - #+begin_src c :comments org :tangle (eval c) :noweb yes + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_electron_num(qmckl_context context, const int64_t up_num, const int64_t down_num) { @@ -291,9 +291,7 @@ qmckl_exit_code qmckl_set_electron_num(qmckl_context context, #+end_src - Then, we set the number of walkers: - - #+begin_src c :comments org :tangle (eval c) :noweb yes + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_electron_walk_num(qmckl_context context, const int64_t walk_num) { <> @@ -315,9 +313,10 @@ qmckl_exit_code qmckl_set_electron_walk_num(qmckl_context context, const int64_t The following function sets the electron coordinates of all the walkers. When this is done, the pointers to the old and new sets of coordinates are swapped, and the new coordinates are - overwritten. + overwritten. This can be done only when the data relative to + electrons have been set. - #+begin_src c :comments org :tangle (eval c) :noweb yes + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_electron_coord(qmckl_context context, const double* coord) { <> From 8882b4b3d42e24e5b03b2979632890841947486d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Apr 2021 13:17:33 +0200 Subject: [PATCH 60/65] Fix htmlize --- src/Makefile | 2 +- tools/Building.org | 34 ++++++++++++++++------------------ tools/build_doc.sh | 24 +++++++++++------------- tools/create_makefile.sh | 2 +- 4 files changed, 29 insertions(+), 33 deletions(-) diff --git a/src/Makefile b/src/Makefile index 316aab1..abad9d4 100644 --- a/src/Makefile +++ b/src/Makefile @@ -116,7 +116,7 @@ clean: - $(RM) test_qmckl_* test_qmckl.c \ $(qmckl_h) $(qmckl_f) \ qmckl_*.f90 qmckl_*.c qmckl_*.h \ - Makefile.generated *.html + Makefile.generated *.html Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_makefile.sh diff --git a/tools/Building.org b/tools/Building.org index 5f2ba8e..69fd55f 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -69,7 +69,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #+begin_src makefile # <> -.POSIX: +.POSIX: #+end_src ** Dependencies @@ -188,7 +188,7 @@ clean: - $(RM) test_qmckl_* test_qmckl.c \ $(qmckl_h) $(qmckl_f) \ qmckl_*.f90 qmckl_*.c qmckl_*.h \ - Makefile.generated *.html + Makefile.generated *.html Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_makefile.sh @@ -325,7 +325,7 @@ shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h qmckl_f=\$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90 -munit=\$(QMCKL_ROOT)/munit/munit.c +munit=\$(QMCKL_ROOT)/munit/munit.c shared: \$(shared_lib) static: \$(static_lib) @@ -489,13 +489,13 @@ EOF :END: First define readonly global variables. - + #+begin_src bash :noweb yes readonly DOCS=${QMCKL_ROOT}/docs/ readonly SRC=${QMCKL_ROOT}/src/ readonly HTMLIZE=${DOCS}/htmlize.el -readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el -readonly CONFIG_TANGLE=${QMCKL_ROOT}/tools/config_tangle.el +readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el +readonly CONFIG_TANGLE=${QMCKL_ROOT}/tools/config_tangle.el #+end_src Check that all the defined global variables correspond to files. @@ -517,7 +517,7 @@ function check_preconditions() exit 2 fi done - + for file in ${CONFIG_DOC} ${CONFIG_TANGLE} do if [[ ! -f ${file} ]] @@ -537,7 +537,7 @@ function install_htmlize() { local url="https://github.com/hniksic/emacs-htmlize" local repo="emacs-htmlize" - + [[ -f ${HTMLIZE} ]] || ( cd ${DOCS} git clone ${url} \ @@ -558,8 +558,8 @@ function install_htmlize() function extract_doc() { local org=$1 - local local_html=${SRC}/${org%.org}.html - local html=${DOCS}/${org%.org}.html + local local_html=${SRC}/${org%.org}.html + local html=${DOCS}/${org%.org}.html if [[ -f ${html} && ${org} -ot ${html} ]] then @@ -570,23 +570,21 @@ function extract_doc() --load ${CONFIG_DOC} \ ${org} \ --load ${CONFIG_TANGLE} \ - -f org-html-export-to-html + -f org-html-export-to-html mv ${local_html} ${DOCS} } #+end_src The main function of the script. - + #+begin_src bash :noweb yes function main() { - - [[ check_preconditions ]] \ - || exit 1 - + + check_preconditions || exit 1 + # Install htmlize if needed - [[ install_htmlize ]] \ - || exit 2 + install_htmlize || exit 2 # Create documentation cd ${SRC} \ diff --git a/tools/build_doc.sh b/tools/build_doc.sh index 6eede96..7b91389 100755 --- a/tools/build_doc.sh +++ b/tools/build_doc.sh @@ -5,12 +5,12 @@ # :END: # First define readonly global variables. - + readonly DOCS=${QMCKL_ROOT}/docs/ readonly SRC=${QMCKL_ROOT}/src/ readonly HTMLIZE=${DOCS}/htmlize.el -readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el +readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el readonly CONFIG_TANGLE=${QMCKL_ROOT}/tools/config_tangle.el @@ -34,7 +34,7 @@ function check_preconditions() exit 2 fi done - + for file in ${CONFIG_DOC} ${CONFIG_TANGLE} do if [[ ! -f ${file} ]] @@ -55,7 +55,7 @@ function install_htmlize() { local url="https://github.com/hniksic/emacs-htmlize" local repo="emacs-htmlize" - + [[ -f ${HTMLIZE} ]] || ( cd ${DOCS} git clone ${url} \ @@ -77,8 +77,8 @@ function install_htmlize() function extract_doc() { local org=$1 - local local_html=${SRC}/${org%.org}.html - local html=${DOCS}/${org%.org}.html + local local_html=${SRC}/${org%.org}.html + local html=${DOCS}/${org%.org}.html if [[ -f ${html} && ${org} -ot ${html} ]] then @@ -89,7 +89,7 @@ function extract_doc() --load ${CONFIG_DOC} \ ${org} \ --load ${CONFIG_TANGLE} \ - -f org-html-export-to-html + -f org-html-export-to-html mv ${local_html} ${DOCS} } @@ -100,13 +100,11 @@ function extract_doc() function main() { - - [[ check_preconditions ]] \ - || exit 1 - + + check_preconditions || exit 1 + # Install htmlize if needed - [[ install_htmlize ]] \ - || exit 2 + install_htmlize || exit 2 # Create documentation cd ${SRC} \ diff --git a/tools/create_makefile.sh b/tools/create_makefile.sh index f6e8951..7c15a48 100755 --- a/tools/create_makefile.sh +++ b/tools/create_makefile.sh @@ -85,7 +85,7 @@ shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h qmckl_f=\$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90 -munit=\$(QMCKL_ROOT)/munit/munit.c +munit=\$(QMCKL_ROOT)/munit/munit.c shared: \$(shared_lib) static: \$(static_lib) From 56ba68b7f84aa5939c88e1160301ea58d991d2cf Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Apr 2021 13:26:11 +0200 Subject: [PATCH 61/65] Fixed text in org file --- Makefile | 4 ++-- src/Makefile | 6 +++++- tools/Building.org | 12 +++++++++--- tools/build_doc.sh | 6 ++++-- 4 files changed, 20 insertions(+), 8 deletions(-) diff --git a/Makefile b/Makefile index 5568582..6faa0ff 100644 --- a/Makefile +++ b/Makefile @@ -52,8 +52,8 @@ $(distdir): $(qmckl_h) $(qmckl_f) $(static_lib) $(shared_lib) src/Makefile.gener FORCE: - - rm -- $(distdir).tar.gz >/dev/null 2>&1 - - rm -rf -- $(distdir) >/dev/null 2>&1 + rm -f -- $(distdir).tar.gz + rm -rf -- $(distdir) distcheck: $(distdir).tar.gz diff --git a/src/Makefile b/src/Makefile index abad9d4..e48cc2c 100644 --- a/src/Makefile +++ b/src/Makefile @@ -116,7 +116,11 @@ clean: - $(RM) test_qmckl_* test_qmckl.c \ $(qmckl_h) $(qmckl_f) \ qmckl_*.f90 qmckl_*.c qmckl_*.h \ - Makefile.generated *.html + Makefile.generated *.html *.txt + +veryclean: clean FORCE + - $(RM) $(QMCKL_ROOT)/docs/*.html \ + $(QMCKL_ROOT)/docs/*.txt Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_makefile.sh diff --git a/tools/Building.org b/tools/Building.org index 69fd55f..d1042a7 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -188,7 +188,11 @@ clean: - $(RM) test_qmckl_* test_qmckl.c \ $(qmckl_h) $(qmckl_f) \ qmckl_*.f90 qmckl_*.c qmckl_*.h \ - Makefile.generated *.html + Makefile.generated *.html *.txt + +veryclean: clean FORCE + - $(RM) $(QMCKL_ROOT)/docs/*.html \ + $(QMCKL_ROOT)/docs/*.txt Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_makefile.sh @@ -559,6 +563,7 @@ function extract_doc() { local org=$1 local local_html=${SRC}/${org%.org}.html + local local_text=${SRC}/${org%.org}.txt local html=${DOCS}/${org%.org}.html if [[ -f ${html} && ${org} -ot ${html} ]] @@ -570,8 +575,9 @@ function extract_doc() --load ${CONFIG_DOC} \ ${org} \ --load ${CONFIG_TANGLE} \ - -f org-html-export-to-html - mv ${local_html} ${DOCS} + -f org-html-export-to-html \ + -f org-ascii-export-to-ascii + mv ${local_html} ${local_text} ${DOCS} } #+end_src diff --git a/tools/build_doc.sh b/tools/build_doc.sh index 7b91389..7de7111 100755 --- a/tools/build_doc.sh +++ b/tools/build_doc.sh @@ -78,6 +78,7 @@ function extract_doc() { local org=$1 local local_html=${SRC}/${org%.org}.html + local local_text=${SRC}/${org%.org}.txt local html=${DOCS}/${org%.org}.html if [[ -f ${html} && ${org} -ot ${html} ]] @@ -89,8 +90,9 @@ function extract_doc() --load ${CONFIG_DOC} \ ${org} \ --load ${CONFIG_TANGLE} \ - -f org-html-export-to-html - mv ${local_html} ${DOCS} + -f org-html-export-to-html \ + -f org-ascii-export-to-ascii + mv ${local_html} ${local_text} ${DOCS} } From b56a13be66d3a4e8a33b9f62c09c4496991a15e3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Apr 2021 13:30:02 +0200 Subject: [PATCH 62/65] FIxed distcheck --- Makefile | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 6faa0ff..dd1ae97 100644 --- a/Makefile +++ b/Makefile @@ -59,8 +59,12 @@ FORCE: distcheck: $(distdir).tar.gz gzip -cd $(distdir).tar.gz | tar xvf - cd $(distdir) && $(MAKE) all check - rm $(distdir)/lib/libqmckl.so $(distdir)/include/qmckl.h \ - $(distdir)/include/qmckl_f.f90 + rm $(distdir)/lib/libqmckl.so + rm $(distdir)/include/qmckl.h + rm $(distdir)/share/qmckl/fortran/qmckl_f.f90 + rm $(distdir)/share/qmckl/doc/html/*.html + rm $(distdir)/share/qmckl/doc/html/*.css + rm $(distdir)/share/qmckl/doc/text/*.txt cd $(distdir) && $(MAKE) clean rm -rf $(distdir) @echo "*** Package $(distdir).tar.gz is ready for distribution." From f0f6ac7d854896ab53df23b4d7577417840e8fd9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 Apr 2021 01:45:25 +0200 Subject: [PATCH 63/65] Added ee-distance computation --- src/Makefile | 5 +- src/qmckl_context.org | 2 +- src/qmckl_distance.org | 386 ++++++++++++++++++++++++++++++++++++++++- src/qmckl_electron.org | 236 +++++++++++++++++++++++-- src/qmckl_memory.org | 1 + 5 files changed, 612 insertions(+), 18 deletions(-) diff --git a/src/Makefile b/src/Makefile index e48cc2c..aabe343 100644 --- a/src/Makefile +++ b/src/Makefile @@ -92,7 +92,7 @@ endif # The Makefile.generated is the one that will be distributed with the library. -.PHONY: clean shared static doc all check install uninstall +.PHONY: clean shared static doc all check install uninstall syntax .SECONDARY: # Needed to keep the produced C and Fortran files $(shared_lib) $(static_lib) install uninstall: $(qmckl_h) $(qmckl_f) Makefile.generated @@ -108,6 +108,9 @@ all: shared static doc check check: $(static_lib) $(MAKE) -f Makefile.generated check +syntax: + cppcheck --addon=cert qmckl_*.c + doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/build_doc.sh diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 509ae9a..7aba5cb 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -207,7 +207,7 @@ qmckl_context qmckl_context_create() { ctx->numprec.range = QMCKL_DEFAULT_RANGE; ctx->ao_basis.uninitialized = (1 << 10) - 1; - ctx->electron.uninitialized = (1 << 4) - 1; + ctx->electron.uninitialized = (1 << 2) - 1; /* Allocate qmckl_memory_struct */ { diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 15776c1..a4ec5b9 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -83,7 +83,9 @@ MunitResult test_<>() { *** Source #+begin_src f90 :tangle (eval f) -integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) +integer function qmckl_distance_sq_f(context, transa, transb, m, n, & + A, LDA, B, LDB, C, LDC) & + result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context @@ -100,7 +102,7 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L real*8 :: x, y, z integer :: transab - info = 0 + info = QMCKL_SUCCESS if (context == QMCKL_NULL_CONTEXT) then info = QMCKL_INVALID_CONTEXT @@ -218,7 +220,7 @@ end function qmckl_distance_sq_f ** C interface :noexport: #+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name")) - + #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_distance_sq & @@ -390,6 +392,384 @@ end function test_qmckl_distance_sq int test_qmckl_distance_sq(qmckl_context context); munit_assert_int(0, ==, test_qmckl_distance_sq(context)); #+end_src +* Distance + +** ~qmckl_distance~ + :PROPERTIES: + :Name: qmckl_distance + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + ~qmckl_distance~ computes the matrix of the distances between all + pairs of points in two sets, one point within each set: + + \[ + C_{ij} = \sqrt{\sum_{k=1}^3 (A_{k,i}-B_{k,j})^2} + \] + + #+NAME: qmckl_distance_args + | qmckl_context | context | in | Global state | + | char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed | + | char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed | + | int64_t | m | in | Number of points in the first set | + | int64_t | n | in | Number of points in the second set | + | double | A[][lda] | in | Array containing the $m \times 3$ matrix $A$ | + | int64_t | lda | in | Leading dimension of array ~A~ | + | double | B[][ldb] | in | Array containing the $n \times 3$ matrix $B$ | + | int64_t | ldb | in | Leading dimension of array ~B~ | + | double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ | + | int64_t | ldc | in | Leading dimension of array ~C~ | + +*** Requirements + + - ~context~ is not ~QMCKL_NULL_CONTEXT~ + - ~m > 0~ + - ~n > 0~ + - ~lda >= 3~ if ~transa == 'N'~ + - ~lda >= m~ if ~transa == 'T'~ + - ~ldb >= 3~ if ~transb == 'N'~ + - ~ldb >= n~ if ~transb == 'T'~ + - ~ldc >= m~ + - ~A~ is allocated with at least $3 \times m \times 8$ bytes + - ~B~ is allocated with at least $3 \times n \times 8$ bytes + - ~C~ is allocated with at least $m \times n \times 8$ bytes + +*** C header + + #+CALL: generate_c_header(table=qmckl_distance_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src c :tangle (eval h_func) :comments org + qmckl_exit_code qmckl_distance ( + const qmckl_context context, + const char transa, + const char transb, + const int64_t m, + const int64_t n, + const double* A, + const int64_t lda, + const double* B, + const int64_t ldb, + double* const C, + const int64_t ldc ); + #+end_src + +*** Source + #+begin_src f90 :tangle (eval f) +integer function qmckl_distance_f(context, transa, transb, m, n, & + A, LDA, B, LDB, C, LDC) & + result(info) + use qmckl + implicit none + integer(qmckl_context) , intent(in) :: context + character , intent(in) :: transa, transb + integer*8 , intent(in) :: m, n + integer*8 , intent(in) :: lda + real*8 , intent(in) :: A(lda,*) + integer*8 , intent(in) :: ldb + real*8 , intent(in) :: B(ldb,*) + integer*8 , intent(in) :: ldc + real*8 , intent(out) :: C(ldc,*) + + integer*8 :: i,j + real*8 :: x, y, z + integer :: transab + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (m <= 0_8) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (n <= 0_8) then + info = QMCKL_INVALID_ARG_5 + return + endif + + if (transa == 'N' .or. transa == 'n') then + transab = 0 + else if (transa == 'T' .or. transa == 't') then + transab = 1 + else + transab = -100 + endif + + if (transb == 'N' .or. transb == 'n') then + continue + else if (transa == 'T' .or. transa == 't') then + transab = transab + 2 + else + transab = -100 + endif + + if (transab < 0) then + info = QMCKL_INVALID_ARG_1 + return + endif + + if (iand(transab,1) == 0 .and. LDA < 3) then + info = QMCKL_INVALID_ARG_7 + return + endif + + if (iand(transab,1) == 1 .and. LDA < m) then + info = QMCKL_INVALID_ARG_7 + return + endif + + if (iand(transab,2) == 0 .and. LDA < 3) then + info = QMCKL_INVALID_ARG_7 + return + endif + + if (iand(transab,2) == 2 .and. LDA < m) then + info = QMCKL_INVALID_ARG_7 + return + endif + + + select case (transab) + + case(0) + + do j=1,n + do i=1,m + x = A(1,i) - B(1,j) + y = A(2,i) - B(2,j) + z = A(3,i) - B(3,j) + C(i,j) = x*x + y*y + z*z + end do + C(:,j) = dsqrt(C(:,j)) + end do + + case(1) + + do j=1,n + do i=1,m + x = A(i,1) - B(1,j) + y = A(i,2) - B(2,j) + z = A(i,3) - B(3,j) + C(i,j) = x*x + y*y + z*z + end do + C(:,j) = dsqrt(C(:,j)) + end do + + case(2) + + do j=1,n + do i=1,m + x = A(1,i) - B(j,1) + y = A(2,i) - B(j,2) + z = A(3,i) - B(j,3) + C(i,j) = x*x + y*y + z*z + end do + C(:,j) = dsqrt(C(:,j)) + end do + + case(3) + + do j=1,n + do i=1,m + x = A(i,1) - B(j,1) + y = A(i,2) - B(j,2) + z = A(i,3) - B(j,3) + C(i,j) = x*x + y*y + z*z + end do + C(:,j) = dsqrt(C(:,j)) + end do + + end select + +end function qmckl_distance_f + #+end_src + +*** Performance + + This function might be more efficient when ~A~ and ~B~ are + transposed. + +** C interface :noexport: + + #+CALL: generate_c_interface(table=qmckl_distance_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_distance & + (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & + bind(C) result(info) + + use, intrinsic :: iso_c_binding + implicit none + + integer (c_int64_t) , intent(in) , value :: context + character , intent(in) , value :: transa + character , intent(in) , value :: transb + integer (c_int64_t) , intent(in) , value :: m + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: A(lda,*) + integer (c_int64_t) , intent(in) , value :: lda + real (c_double ) , intent(in) :: B(ldb,*) + integer (c_int64_t) , intent(in) , value :: ldb + real (c_double ) , intent(out) :: C(ldc,n) + integer (c_int64_t) , intent(in) , value :: ldc + + integer(c_int32_t), external :: qmckl_distance_f + info = qmckl_distance_f & + (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) + + end function qmckl_distance + #+end_src + + #+CALL: generate_f_interface(table=qmckl_distance_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_distance & + (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & + bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + + integer (c_int64_t) , intent(in) , value :: context + character , intent(in) , value :: transa + character , intent(in) , value :: transb + integer (c_int64_t) , intent(in) , value :: m + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: A(lda,*) + integer (c_int64_t) , intent(in) , value :: lda + real (c_double ) , intent(in) :: B(ldb,*) + integer (c_int64_t) , intent(in) , value :: ldb + real (c_double ) , intent(out) :: C(ldc,n) + integer (c_int64_t) , intent(in) , value :: ldc + + end function qmckl_distance + end interface + #+end_src + +*** Test :noexport: + #+begin_src f90 :tangle (eval f_test) +integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C) + use qmckl + implicit none + integer(qmckl_context), intent(in), value :: context + + double precision, allocatable :: A(:,:), B(:,:), C(:,:) + integer*8 :: m, n, LDA, LDB, LDC + double precision :: x + integer*8 :: i,j + + m = 5 + n = 6 + LDA = m + LDB = n + LDC = 5 + + allocate( A(LDA,m), B(LDB,n), C(LDC,n) ) + + do j=1,m + do i=1,m + A(i,j) = -10.d0 + dble(i+j) + end do + end do + do j=1,n + do i=1,n + B(i,j) = -1.d0 + dble(i*j) + end do + end do + + test_qmckl_dist = & + qmckl_distance(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC) + + if (test_qmckl_dist == 0) return + + test_qmckl_dist = & + qmckl_distance(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC) + + if (test_qmckl_dist == 0) return + + test_qmckl_dist = & + qmckl_distance(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC) + + if (test_qmckl_dist /= 0) return + + test_qmckl_dist = -1 + + do j=1,n + do i=1,m + x = dsqrt((A(i,1)-B(j,1))**2 + & + (A(i,2)-B(j,2))**2 + & + (A(i,3)-B(j,3))**2) + if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return + end do + end do + + test_qmckl_dist = & + qmckl_distance(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC) + + if (test_qmckl_dist /= 0) return + + test_qmckl_dist = -1 + + do j=1,n + do i=1,m + x = dsqrt((A(1,i)-B(j,1))**2 + & + (A(2,i)-B(j,2))**2 + & + (A(3,i)-B(j,3))**2) + if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return + end do + end do + + test_qmckl_dist = & + qmckl_distance(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC) + + if (test_qmckl_dist /= 0) return + + test_qmckl_dist = -1 + + do j=1,n + do i=1,m + x = dsqrt((A(i,1)-B(1,j))**2 + & + (A(i,2)-B(2,j))**2 + & + (A(i,3)-B(3,j))**2) + if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return + end do + end do + + test_qmckl_dist = & + qmckl_distance(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC) + + if (test_qmckl_dist /= 0) return + + test_qmckl_dist = -1 + + do j=1,n + do i=1,m + x = dsqrt((A(1,i)-B(1,j))**2 + & + (A(2,i)-B(2,j))**2 + & + (A(3,i)-B(3,j))**2) + if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return + end do + end do + + test_qmckl_dist = 0 + + deallocate(A,B,C) +end function test_qmckl_dist + #+end_src + + #+begin_src c :comments link :tangle (eval c_test) +int test_qmckl_dist(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_dist(context)); + #+end_src * End of files :noexport: #+begin_src c :comments link :tangle (eval c_test) diff --git a/src/qmckl_electron.org b/src/qmckl_electron.org index 8ca17e9..1371b5f 100644 --- a/src/qmckl_electron.org +++ b/src/qmckl_electron.org @@ -32,6 +32,9 @@ MunitResult test_<>() { #include #include #include +#include + +#include #include "qmckl_error_type.h" #include "qmckl_context_type.h" @@ -42,33 +45,38 @@ MunitResult test_<>() { #include "qmckl_memory_private_func.h" #include "qmckl_memory_func.h" #include "qmckl_context_func.h" +#include "qmckl_electron_private_func.h" #+end_src * Context The following data stored in the context: - | ~date~ | uint64_t | Last modification date of the coordinates | - | ~uninitialized~ | int32_t | Keeps bit set for uninitialized data | - | ~num~ | int64_t | Total number of electrons | - | ~up_num~ | int64_t | Number of up-spin electrons | - | ~down_num~ | int64_t | Number of down-spin electrons | - | ~walk_num~ | int64_t | Number of walkers | - | ~provided~ | bool | If true, ~electron~ is valid | - | ~coord_new~ | double[walk_num][3][num] | New set of electron coordinates | - | ~coord_old~ | double[walk_num][3][num] | Old set of electron coordinates | + | ~uninitialized~ | int32_t | Keeps bit set for uninitialized data | + | ~num~ | int64_t | Total number of electrons | + | ~up_num~ | int64_t | Number of up-spin electrons | + | ~down_num~ | int64_t | Number of down-spin electrons | + | ~walk_num~ | int64_t | Number of walkers | + | ~provided~ | bool | If true, ~electron~ is valid | + | ~coord_new~ | double[walk_num][3][num] | New set of electron coordinates | + | ~coord_old~ | double[walk_num][3][num] | Old set of electron coordinates | + | ~coord_new_date~ | uint64_t | Last modification date of the coordinates | + | ~ee_distance~e | double[walk_num][num][num] | Electron-electron distances | + | ~ee_distance_date~ | uint64_t | Last modification date of the electron-electron distances | ** Data structure #+begin_src c :comments org :tangle (eval h_private_type) typedef struct qmckl_electron_struct { - int64_t date; int64_t num; int64_t up_num; int64_t down_num; int64_t walk_num; + int64_t coord_new_date; + int64_t ee_distance_date; double* coord_new; double* coord_old; + double* ee_distance; int32_t uninitialized; bool provided; } qmckl_electron_struct; @@ -252,6 +260,7 @@ if (ctx->electron.provided) { NULL); } ctx->electron.coord_old = coord_old; + } return QMCKL_SUCCESS; @@ -280,7 +289,7 @@ qmckl_exit_code qmckl_set_electron_num(qmckl_context context, "down_num <= 0"); } - int32_t mask = (1 << 3) -1; + int32_t mask = 1; ctx->electron.up_num = up_num; ctx->electron.down_num = down_num; @@ -302,7 +311,7 @@ qmckl_exit_code qmckl_set_electron_walk_num(qmckl_context context, const int64_t "walk_num <= 0"); } - int32_t mask = 1 << 3; + int32_t mask = 2; ctx->electron.walk_num = walk_num; <> @@ -350,7 +359,7 @@ qmckl_exit_code qmckl_set_electron_coord(qmckl_context context, const double* c ctx->electron.coord_new = swap; memcpy(ctx->electron.coord_new, coord, walk_num * num * 3 * sizeof(double)); - ctx->electron.date = ctx->date; + ctx->electron.coord_new_date = ctx->date; return QMCKL_SUCCESS; @@ -398,6 +407,207 @@ munit_assert_int64(rc, ==, QMCKL_SUCCESS); #+end_src +* Computation + + The computed data is stored in the context so that it can be reused + by different kernels. To ensure that the data is valid, for each + computed data the date of the context is stored when it is computed. + To know if some data needs to be recomputed, we check if the date of + the dependencies are more recent than the date of the data to + compute. If it is the case, then the data is recomputed and the + current date is stored. + +** Electron-electron distances + +*** Get + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code qmckl_get_electron_ee_distance(qmckl_context context, double* distance); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_get_electron_ee_distance(qmckl_context context, double* distance) +{ + /* Check input parameters */ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + qmckl_exit_code rc = qmckl_provide_ee_distance(context); + if (rc != QMCKL_SUCCESS) return rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + size_t sze = ctx->electron.num * ctx->electron.num * ctx->electron.walk_num; + memcpy(distance, ctx->electron.ee_distance, sze * sizeof(double)); + + return QMCKL_SUCCESS; +} + #+end_src +*** Provide :noexport: + + #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none +qmckl_exit_code qmckl_provide_ee_distance(qmckl_context context); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code qmckl_provide_ee_distance(qmckl_context context) +{ + /* Check input parameters */ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return (char) 0; + } + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + + /* Compute if necessary */ + if (ctx->electron.coord_new_date > ctx->electron.ee_distance_date) { + + fprintf(stderr, "%10ld: provide ee_distance", ctx->date); + /* Allocate array */ + if (ctx->electron.ee_distance == NULL) { + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->electron.num * ctx->electron.num * + ctx->electron.walk_num * sizeof(double); + double* ee_distance = (double*) qmckl_malloc(context, mem_info); + + if (ee_distance == NULL) { + return qmckl_failwith( context, + QMCKL_ALLOCATION_FAILED, + "qmckl_ee_distance", + NULL); + } + ctx->electron.ee_distance = ee_distance; + } + + qmckl_exit_code rc = + qmckl_compute_ee_distance(context, + ctx->electron.num, + ctx->electron.walk_num, + ctx->electron.coord_new, + ctx->electron.ee_distance); + if (rc != QMCKL_SUCCESS) { + return rc; + } + + ctx->electron.ee_distance_date = ctx->date; + } + + return QMCKL_SUCCESS; +} + #+end_src + +*** Compute + :PROPERTIES: + :Name: qmckl_compute_ee_distance + :CRetType: qmckl_exit_code + :FRetType: qmckl_exit_code + :END: + + #+NAME: qmckl_ee_distance_args + | qmckl_context | context | in | Global state | + | int64_t | elec_num | in | Number of electrons | + | int64_t | walk_num | in | Number of walkers | + | double | coord[walk_num][3][elec_num] | in | Electron coordinates | + | double | ee_distance[walk_num][elec_num][elec_num] | out | Electron-electron distances | + + #+begin_src f90 :comments org :tangle (eval f) :noweb yes +integer function qmckl_compute_ee_distance_f(context, elec_num, walk_num, coord, ee_distance) & + result(info) + use qmckl + implicit none + integer(qmckl_context), intent(in) :: context + integer*8 , intent(in) :: elec_num + integer*8 , intent(in) :: walk_num + double precision , intent(in) :: coord(elec_num,3,walk_num) + double precision , intent(out) :: ee_distance(elec_num,elec_num,walk_num) + + integer*8 :: k + + info = QMCKL_SUCCESS + + if (context == QMCKL_NULL_CONTEXT) then + info = QMCKL_INVALID_CONTEXT + return + endif + + if (elec_num <= 0) then + info = QMCKL_INVALID_ARG_2 + return + endif + + if (walk_num <= 0) then + info = QMCKL_INVALID_ARG_3 + return + endif + + !$OMP PARALLEL DO DEFAULT(NONE) & + !$OMP SHARED(elec_num, walk_num, coord, ee_distance) + !$OMP PRIVATE(k) + do k=1,walk_num + info = qmckl_distance(context, 'T', 'T', elec_num, elec_num, & + coord(1,1,k), elec_num, & + coord(1,1,k), elec_num, & + ee_distance(1,1,k), elec_num) + end do + !$OMP END PARALLEL DO + +end function qmckl_compute_ee_distance_f + #+end_src + + #+begin_src c :tangle (eval h_private_func) :comments org :exports none + qmckl_exit_code qmckl_compute_ee_distance ( + const qmckl_context context, + const int64_t elec_num, + const int64_t walk_num, + const double* coord, + double* const ee_distance ); + #+end_src + + #+CALL: generate_c_interface(table=qmckl_ee_distance_args,rettyp=get_value("CRetType"),fname=get_value("Name")) + + #+RESULTS: + #+begin_src f90 :tangle (eval f) :comments org :exports none + integer(c_int32_t) function qmckl_compute_ee_distance & + (context, elec_num, walk_num, coord, ee_distance) & + bind(C) result(info) + + use, intrinsic :: iso_c_binding + implicit none + + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: elec_num + integer (c_int64_t) , intent(in) , value :: walk_num + real (c_double ) , intent(in) :: coord(elec_num,3,walk_num) + real (c_double ) , intent(out) :: ee_distance(elec_num,elec_num,walk_num) + + integer(c_int32_t), external :: qmckl_compute_ee_distance_f + info = qmckl_compute_ee_distance_f & + (context, elec_num, walk_num, coord, ee_distance) + + end function qmckl_compute_ee_distance + #+end_src + +*** Test + + #+begin_src c :tangle (eval c_test) +/* Reference input data */ + +munit_assert(qmckl_electron_provided(context)); + +double distance[walk_num*num*num]; +rc = qmckl_get_electron_ee_distance(context, distance); +rc = qmckl_get_electron_ee_distance(context, distance); +munit_assert_double(distance[0], ==, 0.); +munit_assert_double(distance[1], ==, distance[num]); +munit_assert_double_equal(distance[1], 8.6114953086801, 12); + + #+end_src + * End of files :noexport: #+begin_src c :tangle (eval h_private_type) diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index c6bfe09..6cef69a 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -39,6 +39,7 @@ MunitResult test_<>() { #define QMCKL_MEMORY_HPT #include +#include #+end_src * Memory data structure for the context From bc85565586fff3f1d958ec2b5adfcd1d554bc039 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Apr 2021 12:08:53 +0200 Subject: [PATCH 64/65] small changes --- Makefile | 10 +++++----- src/qmckl_electron.org | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Makefile b/Makefile index dd1ae97..7de88f0 100644 --- a/Makefile +++ b/Makefile @@ -36,17 +36,17 @@ $(distdir): $(qmckl_h) $(qmckl_f) $(static_lib) $(shared_lib) src/Makefile.gener mkdir -p $(distdir)/src mkdir -p $(distdir)/include mkdir -p $(distdir)/share/qmckl/fortran - mkdir -p $(distdir)/share/qmckl/doc/html/ - mkdir -p $(distdir)/share/qmckl/doc/text/ + mkdir -p $(distdir)/share/doc/qmckl/html/ + mkdir -p $(distdir)/share/doc/qmckl/text/ mkdir -p $(distdir)/man cp munit/munit.h munit/munit.c $(distdir)/munit/ cp src/*.c src/*.h src/*.f90 $(distdir)/src/ cp src/Makefile.generated $(distdir)/src/Makefile cp include/* $(distdir)/include cp Makefile $(distdir)/ - cp docs/*.html $(distdir)/share/qmckl/doc/html/ - cp docs/*.css $(distdir)/share/qmckl/doc/html/ - cp docs/*.txt $(distdir)/share/qmckl/doc/text/ + cp docs/*.html $(distdir)/share/doc/qmckl/html/ + cp docs/*.css $(distdir)/share/doc/qmckl/html/ + cp docs/*.txt $(distdir)/share/doc/qmckl/text/ cp share/qmckl/fortran/* $(distdir)/share/qmckl/fortran mkdir -p $(distdir)/lib diff --git a/src/qmckl_electron.org b/src/qmckl_electron.org index 1371b5f..9bf5c0e 100644 --- a/src/qmckl_electron.org +++ b/src/qmckl_electron.org @@ -61,7 +61,7 @@ MunitResult test_<>() { | ~coord_new~ | double[walk_num][3][num] | New set of electron coordinates | | ~coord_old~ | double[walk_num][3][num] | Old set of electron coordinates | | ~coord_new_date~ | uint64_t | Last modification date of the coordinates | - | ~ee_distance~e | double[walk_num][num][num] | Electron-electron distances | + | ~ee_distance~ | double[walk_num][num][num] | Electron-electron distances | | ~ee_distance_date~ | uint64_t | Last modification date of the electron-electron distances | ** Data structure From 79c9651021d82eadbf6808f385383a43c837519d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Apr 2021 13:30:04 +0200 Subject: [PATCH 65/65] Fix makefile --- Makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 7de88f0..9d09487 100644 --- a/Makefile +++ b/Makefile @@ -62,9 +62,9 @@ distcheck: $(distdir).tar.gz rm $(distdir)/lib/libqmckl.so rm $(distdir)/include/qmckl.h rm $(distdir)/share/qmckl/fortran/qmckl_f.f90 - rm $(distdir)/share/qmckl/doc/html/*.html - rm $(distdir)/share/qmckl/doc/html/*.css - rm $(distdir)/share/qmckl/doc/text/*.txt + rm $(distdir)/share/doc/qmckl/html/*.html + rm $(distdir)/share/doc/qmckl/html/*.css + rm $(distdir)/share/doc/qmckl/text/*.txt cd $(distdir) && $(MAKE) clean rm -rf $(distdir) @echo "*** Package $(distdir).tar.gz is ready for distribution."