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

Updated documentation

Browse Source
This commit is contained in:
Anthony Scemama 2022-02-24 19:06:19 +01:00
parent 173b73b5f1
commit 1a5b76157b
4 changed files with 234 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
org/qmckl_ao.org
View File

@ -5428,17 +5428,17 @@ qmckl_compute_ao_vgl_hpc_gaussian (
const int32_t n = lstart[l+1]-lstart[l]; const int32_t n = lstart[l+1]-lstart[l];
const int64_t k = ao_index[ishell]; const int64_t k = ao_index[ishell];
double* const ao_vgl_1 = &(ao_vgl[ipoint*5*ao_num+k]); double* __restrict__ const ao_vgl_1 = &(ao_vgl[ipoint*5*ao_num+k]);
double* const ao_vgl_2 = &(ao_vgl_1[ ao_num]); double* __restrict__ const ao_vgl_2 = &(ao_vgl_1[ ao_num]);
double* const ao_vgl_3 = &(ao_vgl_1[2*ao_num]); double* __restrict__ const ao_vgl_3 = &(ao_vgl_1[2*ao_num]);
double* const ao_vgl_4 = &(ao_vgl_1[3*ao_num]); double* __restrict__ const ao_vgl_4 = &(ao_vgl_1[3*ao_num]);
double* const ao_vgl_5 = &(ao_vgl_1[4*ao_num]); double* __restrict__ const ao_vgl_5 = &(ao_vgl_1[4*ao_num]);
double* poly_vgl_1; double* __restrict__ poly_vgl_1;
double* poly_vgl_2; double* __restrict__ poly_vgl_2;
double* poly_vgl_3; double* __restrict__ poly_vgl_3;
double* poly_vgl_4; double* __restrict__ poly_vgl_4;
double* poly_vgl_5; double* __restrict__ poly_vgl_5;
if (nidx > 0) { if (nidx > 0) {
const double* f = &(ao_factor[k]); const double* f = &(ao_factor[k]);
const int64_t idx = lstart[l]; const int64_t idx = lstart[l];
@ -5473,6 +5473,7 @@ qmckl_compute_ao_vgl_hpc_gaussian (
poly_vgl_3 = &(poly_vgl_l2[2][idx]); poly_vgl_3 = &(poly_vgl_l2[2][idx]);
poly_vgl_4 = &(poly_vgl_l2[3][idx]); poly_vgl_4 = &(poly_vgl_l2[3][idx]);
poly_vgl_5 = &(poly_vgl_l2[4][idx]); poly_vgl_5 = &(poly_vgl_l2[4][idx]);
for (int64_t il=0 ; il<n ; ++il) { for (int64_t il=0 ; il<n ; ++il) {
ao_vgl_1[il] = poly_vgl_1[il] * s1 * f[il]; ao_vgl_1[il] = poly_vgl_1[il] * s1 * f[il];
ao_vgl_2[il] = (poly_vgl_2[il] * s1 + poly_vgl_1[il] * s2) * f[il]; ao_vgl_2[il] = (poly_vgl_2[il] * s1 + poly_vgl_1[il] * s2) * f[il];
@ -5490,6 +5491,7 @@ qmckl_compute_ao_vgl_hpc_gaussian (
poly_vgl_3 = &(poly_vgl[2][idx]); poly_vgl_3 = &(poly_vgl[2][idx]);
poly_vgl_4 = &(poly_vgl[3][idx]); poly_vgl_4 = &(poly_vgl[3][idx]);
poly_vgl_5 = &(poly_vgl[4][idx]); poly_vgl_5 = &(poly_vgl[4][idx]);
for (int64_t il=0 ; il<n ; ++il) { for (int64_t il=0 ; il<n ; ++il) {
ao_vgl_1[il] = poly_vgl_1[il] * s1 * f[il]; ao_vgl_1[il] = poly_vgl_1[il] * s1 * f[il];
ao_vgl_2[il] = (poly_vgl_2[il] * s1 + poly_vgl_1[il] * s2) * f[il]; ao_vgl_2[il] = (poly_vgl_2[il] * s1 + poly_vgl_1[il] * s2) * f[il];

187
org/qmckl_blas.org
View File

@ -60,6 +60,18 @@ int main() {
#+end_src #+end_src
* -
:PROPERTIES:
:UNNUMBERED: t
:END:
Basic linear algebra data types and operations are described in this file.
The data types are private, so that HPC implementations can use
whatever data structures they prefer.
These data types are expected to be used internally in QMCkl. They
are not intended to be passed to external codes.
* Data types * Data types
** Vector ** Vector
@ -69,7 +81,7 @@ int main() {
| ~size~ | ~int64_t~ | Dimension of the vector | | ~size~ | ~int64_t~ | Dimension of the vector |
| ~data~ | ~double*~ | Elements | | ~data~ | ~double*~ | Elements |
#+begin_src c :comments org :tangle (eval h_private_type) #+begin_src c :comments org :tangle (eval h_private_type) :exports none
typedef struct qmckl_vector { typedef struct qmckl_vector {
int64_t size; int64_t size;
double* data; double* data;
@ -85,7 +97,7 @@ qmckl_vector_alloc( qmckl_context context,
Allocates a new vector. If the allocation failed the size is zero. Allocates a new vector. If the allocation failed the size is zero.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_vector qmckl_vector
qmckl_vector_alloc( qmckl_context context, qmckl_vector_alloc( qmckl_context context,
const int64_t size) const int64_t size)
@ -114,7 +126,7 @@ qmckl_vector_free( qmckl_context context,
qmckl_vector* vector); qmckl_vector* vector);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_vector_free( qmckl_context context, qmckl_vector_free( qmckl_context context,
qmckl_vector* vector) qmckl_vector* vector)
@ -145,7 +157,7 @@ qmckl_vector_free( qmckl_context context,
The dimensions use Fortran ordering: two elements differing by one The dimensions use Fortran ordering: two elements differing by one
in the first dimension are consecutive in memory. in the first dimension are consecutive in memory.
#+begin_src c :comments org :tangle (eval h_private_type) #+begin_src c :comments org :tangle (eval h_private_type) :exports none
typedef struct qmckl_matrix { typedef struct qmckl_matrix {
int64_t size[2]; int64_t size[2];
double* data; double* data;
@ -162,7 +174,7 @@ qmckl_matrix_alloc( qmckl_context context,
Allocates a new matrix. If the allocation failed the sizes are zero. Allocates a new matrix. If the allocation failed the sizes are zero.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_matrix qmckl_matrix
qmckl_matrix_alloc( qmckl_context context, qmckl_matrix_alloc( qmckl_context context,
const int64_t size1, const int64_t size1,
@ -195,7 +207,7 @@ qmckl_matrix_free( qmckl_context context,
qmckl_matrix* matrix); qmckl_matrix* matrix);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_matrix_free( qmckl_context context, qmckl_matrix_free( qmckl_context context,
qmckl_matrix* matrix) qmckl_matrix* matrix)
@ -228,7 +240,7 @@ qmckl_matrix_free( qmckl_context context,
The dimensions use Fortran ordering: two elements differing by one The dimensions use Fortran ordering: two elements differing by one
in the first dimension are consecutive in memory. in the first dimension are consecutive in memory.
#+begin_src c :comments org :tangle (eval h_private_type) #+begin_src c :comments org :tangle (eval h_private_type) :exports none
#define QMCKL_TENSOR_ORDER_MAX 16 #define QMCKL_TENSOR_ORDER_MAX 16
typedef struct qmckl_tensor { typedef struct qmckl_tensor {
@ -249,7 +261,7 @@ qmckl_tensor_alloc( qmckl_context context,
Allocates memory for a tensor. If the allocation failed, the size Allocates memory for a tensor. If the allocation failed, the size
is zero. is zero.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_tensor qmckl_tensor
qmckl_tensor_alloc( qmckl_context context, qmckl_tensor_alloc( qmckl_context context,
const int64_t order, const int64_t order,
@ -285,11 +297,11 @@ qmckl_tensor_alloc( qmckl_context context,
#+begin_src c :comments org :tangle (eval h_private_func) #+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code qmckl_exit_code
qmckl_tensor_free( qmckl_context context, qmckl_tensor_free (qmckl_context context,
qmckl_tensor* tensor); qmckl_tensor* tensor);
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_tensor_free( qmckl_context context, qmckl_tensor_free( qmckl_context context,
qmckl_tensor* tensor) qmckl_tensor* tensor)
@ -325,7 +337,7 @@ qmckl_matrix_of_vector(const qmckl_vector vector,
Reshapes a vector into a matrix. Reshapes a vector into a matrix.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_matrix qmckl_matrix
qmckl_matrix_of_vector(const qmckl_vector vector, qmckl_matrix_of_vector(const qmckl_vector vector,
const int64_t size1, const int64_t size1,
@ -355,7 +367,7 @@ qmckl_tensor_of_vector(const qmckl_vector vector,
Reshapes a vector into a tensor. Reshapes a vector into a tensor.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_tensor qmckl_tensor
qmckl_tensor_of_vector(const qmckl_vector vector, qmckl_tensor_of_vector(const qmckl_vector vector,
const int64_t order, const int64_t order,
@ -385,7 +397,7 @@ qmckl_vector_of_matrix(const qmckl_matrix matrix);
Reshapes a matrix into a vector. Reshapes a matrix into a vector.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_vector qmckl_vector
qmckl_vector_of_matrix(const qmckl_matrix matrix) qmckl_vector_of_matrix(const qmckl_matrix matrix)
{ {
@ -409,7 +421,7 @@ qmckl_tensor_of_matrix(const qmckl_matrix matrix,
Reshapes a matrix into a tensor. Reshapes a matrix into a tensor.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_tensor qmckl_tensor
qmckl_tensor_of_matrix(const qmckl_matrix matrix, qmckl_tensor_of_matrix(const qmckl_matrix matrix,
const int64_t order, const int64_t order,
@ -439,7 +451,7 @@ qmckl_vector_of_tensor(const qmckl_tensor tensor);
Reshapes a tensor into a vector. Reshapes a tensor into a vector.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_vector qmckl_vector
qmckl_vector_of_tensor(const qmckl_tensor tensor) qmckl_vector_of_tensor(const qmckl_tensor tensor)
{ {
@ -468,7 +480,7 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
Reshapes a tensor into a vector. Reshapes a tensor into a vector.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_matrix qmckl_matrix
qmckl_matrix_of_tensor(const qmckl_tensor tensor, qmckl_matrix_of_tensor(const qmckl_tensor tensor,
const int64_t size1, const int64_t size1,
@ -493,7 +505,20 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
** Access macros ** Access macros
#+begin_src c :comments org :tangle (eval h_private_func) Macros are provided to ease the access to vectors, matrices and
tensors. Matrices use column-major ordering, as in Fortran.
#+begin_src c :tangle no
double qmckl_vec (qmckl_vector v, int64_t i); // v[i]
double qmckl_mat (qmckl_matrix m, int64_t i, int64_t j) // m[j][i]
double qmckl_ten3(qmckl_tensor t, int64_t i, int64_t j, int64_t k); // t[k][j][i]
double qmckl_ten4(qmckl_tensor t, int64_t i, int64_t j, int64_t k, int64_t l);
double qmckl_ten5(qmckl_tensor t, int64_t i, int64_t j, int64_t k, int64_t l, int64_t m);
...
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :exports none
#define qmckl_vec(v, i) v.data[i] #define qmckl_vec(v, i) v.data[i]
#define qmckl_mat(m, i, j) m.data[(i) + (j)*m.size[0]] #define qmckl_mat(m, i, j) m.data[(i) + (j)*m.size[0]]
@ -502,6 +527,8 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
#define qmckl_ten5(t, i, j, k, l, m) t.data[(i) + m.size[0]*((j) + size[1]*((k) + size[2]*((l) + size[3]*(m))))] #define qmckl_ten5(t, i, j, k, l, m) t.data[(i) + m.size[0]*((j) + size[1]*((k) + size[2]*((l) + size[3]*(m))))]
#+end_src #+end_src
For example:
** Copy to/from to ~double*~ ** Copy to/from to ~double*~
#+begin_src c :comments org :tangle (eval h_private_func) #+begin_src c :comments org :tangle (eval h_private_func)
@ -514,7 +541,7 @@ qmckl_double_of_vector(const qmckl_context context,
Converts a vector to a ~double*~. Converts a vector to a ~double*~.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_double_of_vector(const qmckl_context context, qmckl_double_of_vector(const qmckl_context context,
const qmckl_vector vector, const qmckl_vector vector,
@ -546,7 +573,7 @@ qmckl_double_of_matrix(const qmckl_context context,
Converts a matrix to a ~double*~. Converts a matrix to a ~double*~.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_double_of_matrix(const qmckl_context context, qmckl_double_of_matrix(const qmckl_context context,
const qmckl_matrix matrix, const qmckl_matrix matrix,
@ -569,7 +596,7 @@ qmckl_double_of_tensor(const qmckl_context context,
Converts a tensor to a ~double*~. Converts a tensor to a ~double*~.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_double_of_tensor(const qmckl_context context, qmckl_double_of_tensor(const qmckl_context context,
const qmckl_tensor tensor, const qmckl_tensor tensor,
@ -592,7 +619,7 @@ qmckl_vector_of_double(const qmckl_context context,
Converts a ~double*~ to a vector. Converts a ~double*~ to a vector.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_vector_of_double(const qmckl_context context, qmckl_vector_of_double(const qmckl_context context,
const double* target, const double* target,
@ -636,9 +663,9 @@ qmckl_matrix_of_double(const qmckl_context context,
qmckl_matrix* matrix); qmckl_matrix* matrix);
#+end_src #+end_src
Converts a matrix to a ~double*~. Converts a ~double*~ to a matrix.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_matrix_of_double(const qmckl_context context, qmckl_matrix_of_double(const qmckl_context context,
const double* target, const double* target,
@ -662,9 +689,9 @@ qmckl_tensor_of_double(const qmckl_context context,
qmckl_tensor* tensor); qmckl_tensor* tensor);
#+end_src #+end_src
Converts a matrix to a ~double*~. Converts a ~double*~ to a tensor.
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_tensor_of_double(const qmckl_context context, qmckl_tensor_of_double(const qmckl_context context,
const double* target, const double* target,
@ -681,10 +708,9 @@ qmckl_tensor_of_double(const qmckl_context context,
** Tests :noexport:
** Tests #+begin_src c :comments link :tangle (eval c_test) :exports none
#+begin_src c :comments link :tangle (eval c_test)
{ {
int64_t m = 3; int64_t m = 3;
int64_t n = 4; int64_t n = 4;
@ -720,7 +746,7 @@ qmckl_tensor_of_double(const qmckl_context context,
** ~qmckl_dgemm~ ** ~qmckl_dgemm~
Matrix multiplication: Matrix multiplication with a BLAS interface:
\[ \[
C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj} C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj}
@ -780,7 +806,7 @@ qmckl_tensor_of_double(const qmckl_context context,
const int64_t ldc ); const int64_t ldc );
#+end_src #+end_src
#+begin_src f90 :tangle (eval f) #+begin_src f90 :tangle (eval f) :exports none
integer function qmckl_dgemm_f(context, TransA, TransB, & integer function qmckl_dgemm_f(context, TransA, TransB, &
m, n, k, alpha, A, LDA, B, LDB, beta, C, LDC) & m, n, k, alpha, A, LDA, B, LDB, beta, C, LDC) &
result(info) result(info)
@ -975,14 +1001,14 @@ integer(qmckl_exit_code) function test_qmckl_dgemm(context) bind(C)
end function test_qmckl_dgemm end function test_qmckl_dgemm
#+end_src #+end_src
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test) :exports none
qmckl_exit_code test_qmckl_dgemm(qmckl_context context); qmckl_exit_code test_qmckl_dgemm(qmckl_context context);
assert(QMCKL_SUCCESS == test_qmckl_dgemm(context)); assert(QMCKL_SUCCESS == test_qmckl_dgemm(context));
#+end_src #+end_src
** ~qmckl_matmul~ ** ~qmckl_matmul~
Matrix multiplication: Matrix multiplication using the =qmckl_matrix= data type:
\[ \[
C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj} C_{ij} = \beta C_{ij} + \alpha \sum_{k} A_{ik} \cdot B_{kj}
@ -1017,7 +1043,7 @@ qmckl_matmul (const qmckl_context context,
qmckl_matrix* const C ); qmckl_matrix* const C );
#+end_src #+end_src
#+begin_src c :tangle (eval c) :comments org #+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_exit_code
qmckl_matmul (const qmckl_context context, qmckl_matmul (const qmckl_context context,
const char TransA, const char TransA,
@ -1155,9 +1181,88 @@ qmckl_matmul (const qmckl_context context,
} }
#+end_src #+end_src
*** Test :noexport:
*** TODO Test :noexport: #+begin_src python :exports none :results output
import numpy as np
A = np.array([[ 1., 2., 3., 4. ],
[ 5., 6., 7., 8. ],
[ 9., 10., 11., 12. ]])
B = np.array([[ 1., -2., 3., 4., 5. ],
[ 5., -6., 7., 8., 9. ],
[ 9., 10., 11., 12., 13. ],
[10., 11., 12., 15., 14. ]])
C = 0.5 * A @ B
print(A.T)
print(B.T)
print(C.T)
#+end_src
#+RESULTS:
#+begin_example
[[ 1. 5. 9.]
[ 2. 6. 10.]
[ 3. 7. 11.]
[ 4. 8. 12.]]
[[ 1. 5. 9. 10.]
[-2. -6. 10. 11.]
[ 3. 7. 11. 12.]
[ 4. 8. 12. 15.]
[ 5. 9. 13. 14.]]
[[ 39. 89. 139.]
[ 30. 56. 82.]
[ 49. 115. 181.]
[ 58. 136. 214.]
[ 59. 141. 223.]]
#+end_example
#+begin_src c :comments link :tangle (eval c_test) :exports none
{
double a[12] = { 1., 5., 9.,
2., 6., 10.,
3., 7., 11.,
4., 8., 12. };
double b[20] = { 1., 5., 9., 10.,
-2., -6., 10., 11.,
3., 7., 11., 12.,
4., 8., 12., 15.,
5., 9., 13., 14. };
double c[15] = { 39., 89., 139.,
30., 56., 82.,
49., 115., 181.,
58., 136., 214.,
59., 141., 223. };
double cnew[15];
qmckl_exit_code rc;
qmckl_matrix A = qmckl_matrix_alloc(context, 3, 4);
rc = qmckl_matrix_of_double(context, a, 12, &A);
assert(rc == QMCKL_SUCCESS);
qmckl_matrix B = qmckl_matrix_alloc(context, 4, 5);
rc = qmckl_matrix_of_double(context, b, 20, &B);
assert(rc == QMCKL_SUCCESS);
qmckl_matrix C = qmckl_matrix_alloc(context, 3, 5);
rc = qmckl_matmul(context, 'N', 'N', 0.5, A, B, 0., &C);
assert(rc == QMCKL_SUCCESS);
rc = qmckl_double_of_matrix(context, C, cnew, 15);
assert(rc == QMCKL_SUCCESS);
#include <stdio.h>
for (int i=0 ; i<15 ; ++i) {
printf("%f %f\n", cnew[i], c[i]);
assert (c[i] == cnew[i]);
}
}
#+end_src
** ~qmckl_adjugate~ ** ~qmckl_adjugate~
Given a matrix $\mathbf{A}$, the adjugate matrix Given a matrix $\mathbf{A}$, the adjugate matrix
@ -1208,7 +1313,7 @@ qmckl_matmul (const qmckl_context context,
for performance motivations. For larger sizes, we rely on the for performance motivations. For larger sizes, we rely on the
LAPACK library. LAPACK library.
#+begin_src f90 :tangle (eval f) #+begin_src f90 :tangle (eval f) :exports none
integer function qmckl_adjugate_f(context, na, A, LDA, B, ldb, det_l) & integer function qmckl_adjugate_f(context, na, A, LDA, B, ldb, det_l) &
result(info) result(info)
use qmckl use qmckl
@ -2048,10 +2153,10 @@ assert(QMCKL_SUCCESS == test_qmckl_adjugate(context));
Transposes a matrix: $A^\dagger_{ji} = A_{ij}$. Transposes a matrix: $A^\dagger_{ji} = A_{ij}$.
| Variable | Type | In/Out | Description | | Variable | Type | In/Out | Description |
|----------+---------------+--------+-------------------| |-----------+-----------------+--------+-------------------|
| context | qmckl_context | in | Global state | | ~context~ | ~qmckl_context~ | in | Global state |
| A | qmckl_matrix | in | Input matrix | | ~A~ | ~qmckl_matrix~ | in | Input matrix |
| At | qmckl_matrix | out | Transposed matrix | | ~At~ | ~qmckl_matrix~ | out | Transposed matrix |
#+begin_src c :tangle (eval h_private_func) :comments org #+begin_src c :tangle (eval h_private_func) :comments org
qmckl_exit_code qmckl_exit_code
@ -2061,7 +2166,7 @@ qmckl_transpose (qmckl_context context,
#+end_src #+end_src
#+begin_src c :tangle (eval c) :comments org #+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_exit_code
qmckl_transpose (qmckl_context context, qmckl_transpose (qmckl_context context,
const qmckl_matrix A, const qmckl_matrix A,
@ -2100,7 +2205,7 @@ qmckl_transpose (qmckl_context context,
} }
#+end_src #+end_src
*** Test *** Test :noexport:
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test)
{ {

70
org/qmckl_context.org
View File

@ -146,7 +146,7 @@ typedef struct qmckl_context_struct {
the pointer associated with a context is non-null, we can still the pointer associated with a context is non-null, we can still
verify that it points to the expected data structure. verify that it points to the expected data structure.
#+begin_src c :comments org :tangle (eval h_private_type) :noweb yes #+begin_src c :comments org :tangle (eval h_private_type) :noweb yes :exports none
#define VALID_TAG 0xBEEFFACE #define VALID_TAG 0xBEEFFACE
#define INVALID_TAG 0xDEADBEEF #define INVALID_TAG 0xDEADBEEF
#+end_src #+end_src
@ -156,10 +156,11 @@ typedef struct qmckl_context_struct {
if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise. if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise.
#+begin_src c :comments org :tangle (eval h_func) :noexport #+begin_src c :comments org :tangle (eval h_func) :noexport
qmckl_context qmckl_context_check(const qmckl_context context) ; qmckl_context
qmckl_context_check (const qmckl_context context) ;
#+end_src #+end_src
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c) :exports none
qmckl_context qmckl_context_check(const qmckl_context context) { qmckl_context qmckl_context_check(const qmckl_context context) {
if (context == QMCKL_NULL_CONTEXT) if (context == QMCKL_NULL_CONTEXT)
@ -176,19 +177,27 @@ qmckl_context qmckl_context_check(const qmckl_context context) {
} }
#+end_src #+end_src
The context keeps a ``date'' that allows to check which data needs The context keeps a /date/ that allows to check which data needs
to be recomputed. The date is incremented when the context is touched. to be recomputed. The date is incremented when the context is touched.
When a new element is added to the context, the functions When a new element is added to the context, the functions
[[Creation][qmckl_context_create]], [[Destroy][qmckl_context_destroy]] and [[Copy][qmckl_context_copy]] [[Creation][=qmckl_context_create=]] [[Destroy][=qmckl_context_destroy=]] and [[Copy][=qmckl_context_copy=]]
should be updated in order to make deep copies. should be updated in order to make deep copies.
#+begin_src c :comments org :tangle (eval h_func) :noexport When the electron coordinates have changed, the context is touched
qmckl_exit_code qmckl_context_touch(const qmckl_context context) ; using the following function.
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_context_touch (const qmckl_context context);
#+end_src #+end_src
#+begin_src c :tangle (eval c) This has the effect to increment the date of the context.
qmckl_exit_code qmckl_context_touch(const qmckl_context context) {
#+begin_src c :tangle (eval c) :exports none
qmckl_exit_code
qmckl_context_touch(const qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context, return qmckl_failwith( context,
@ -213,12 +222,12 @@ qmckl_exit_code qmckl_context_touch(const qmckl_context context) {
- A new context always has all its members initialized with a NULL value - A new context always has all its members initialized with a NULL value
# Header # Header
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func)
qmckl_context qmckl_context_create(); qmckl_context qmckl_context_create();
#+end_src #+end_src
# Source # Source
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c) :exports none
qmckl_context qmckl_context_create() { qmckl_context qmckl_context_create() {
qmckl_context_struct* const ctx = qmckl_context_struct* const ctx =
@ -326,13 +335,13 @@ assert( qmckl_context_check(context) == context );
~lock_count~ attribute. ~lock_count~ attribute.
# Header # Header
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func)
void qmckl_lock (qmckl_context context); void qmckl_lock (qmckl_context context);
void qmckl_unlock(qmckl_context context); void qmckl_unlock(qmckl_context context);
#+end_src #+end_src
# Source # Source
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c) :exports none
void qmckl_lock(qmckl_context context) { void qmckl_lock(qmckl_context context) {
if (context == QMCKL_NULL_CONTEXT) if (context == QMCKL_NULL_CONTEXT)
return ; return ;
@ -345,9 +354,6 @@ void qmckl_lock(qmckl_context context) {
} }
assert (rc == 0); assert (rc == 0);
ctx->lock_count += 1; ctx->lock_count += 1;
/*
printf(" lock : %d\n", ctx->lock_count);
,*/
} }
void qmckl_unlock(const qmckl_context context) { void qmckl_unlock(const qmckl_context context) {
@ -359,9 +365,6 @@ void qmckl_unlock(const qmckl_context context) {
} }
assert (rc == 0); assert (rc == 0);
ctx->lock_count -= 1; ctx->lock_count -= 1;
/*
printf("unlock : %d\n", ctx->lock_count);
,*/
} }
#+end_src #+end_src
@ -372,12 +375,14 @@ void qmckl_unlock(const qmckl_context context) {
# Header # Header
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func) :exports none
/*
qmckl_context qmckl_context_copy(const qmckl_context context); qmckl_context qmckl_context_copy(const qmckl_context context);
*/
#+end_src #+end_src
# Source # Source
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c) :exports none
qmckl_context qmckl_context_copy(const qmckl_context context) { qmckl_context qmckl_context_copy(const qmckl_context context) {
const qmckl_context checked_context = qmckl_context_check(context); const qmckl_context checked_context = qmckl_context_check(context);
@ -418,13 +423,13 @@ qmckl_context qmckl_context_copy(const qmckl_context context) {
# Fortran interface # Fortran interface
#+begin_src f90 :tangle (eval fh_func) :exports none #+begin_src f90 :tangle (eval fh_func) :exports none
interface ! interface
integer (qmckl_context) function qmckl_context_copy(context) bind(C) ! integer (qmckl_context) function qmckl_context_copy(context) bind(C)
use, intrinsic :: iso_c_binding ! use, intrinsic :: iso_c_binding
import ! import
integer (qmckl_context), intent(in), value :: context ! integer (qmckl_context), intent(in), value :: context
end function qmckl_context_copy ! end function qmckl_context_copy
end interface ! end interface
#+end_src #+end_src
# Test # Test
@ -443,13 +448,16 @@ munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
It frees the context, and returns the previous context. It frees the context, and returns the previous context.
# Header # Header
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_context_destroy(const qmckl_context context); qmckl_exit_code
qmckl_context_destroy (const qmckl_context context);
#+end_src #+end_src
# Source # Source
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c) :exports none
qmckl_exit_code 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); const qmckl_context checked_context = qmckl_context_check(context);
if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT; if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT;

49
org/qmckl_error.org
View File

@ -46,7 +46,7 @@ int main() {
#+end_src #+end_src
* * -
:PROPERTIES: :PROPERTIES:
:UNNUMBERED: t :UNNUMBERED: t
:END: :END:
@ -204,17 +204,24 @@ return '\n'.join(result)
string is assumed to be large enough to contain the error message string is assumed to be large enough to contain the error message
(typically 128 characters). (typically 128 characters).
* hidden :noexport:
#+NAME: MAX_STRING_LENGTH
: 128
* Decoding errors * Decoding errors
To decode the error messages, ~qmckl_string_of_error~ converts an To decode the error messages, ~qmckl_string_of_error~ converts an
error code into a string. error code into a string.
#+NAME: MAX_STRING_LENGTH #+begin_src c :comments org :tangle (eval h_func) :noweb yes
: 128 const char*
qmckl_string_of_error (const qmckl_exit_code error);
#+end_src
#+begin_src c :comments org :tangle (eval h_func) :exports none :noweb yes #+begin_src c :comments org :tangle (eval h_private_func) :exports none :noweb yes
const char* qmckl_string_of_error(const qmckl_exit_code error); void
void qmckl_string_of_error_f(const qmckl_exit_code error, qmckl_string_of_error_f(const qmckl_exit_code error,
char result[<<MAX_STRING_LENGTH()>>]); char result[<<MAX_STRING_LENGTH()>>]);
#+end_src #+end_src
@ -326,7 +333,7 @@ return '\n'.join(result)
#+end_example #+end_example
# Source # Source
#+begin_src c :comments org :tangle (eval c) :noweb yes #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
const char* qmckl_string_of_error(const qmckl_exit_code error) { const char* qmckl_string_of_error(const qmckl_exit_code error) {
switch (error) { switch (error) {
<<cases()>> <<cases()>>
@ -340,7 +347,7 @@ void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<<MAX_STRI
#+end_src #+end_src
# Fortran interface # Fortran interface
#+begin_src f90 :tangle (eval fh_func) :noexport :noweb yes #+begin_src f90 :tangle (eval fh_func) :exports none :noweb yes
interface interface
subroutine qmckl_string_of_error (error, string) bind(C, name='qmckl_string_of_error_f') subroutine qmckl_string_of_error (error, string) bind(C, name='qmckl_string_of_error_f')
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -353,7 +360,7 @@ void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<<MAX_STRI
* Data structure in context * Data structure in context
The strings are declared with a maximum fixed size to avoid The strings are declared internally with a maximum fixed size to avoid
dynamic memory allocation. dynamic memory allocation.
#+begin_src c :comments org :tangle (eval h_private_type) #+begin_src c :comments org :tangle (eval h_private_type)
@ -377,7 +384,7 @@ typedef struct qmckl_error_struct {
explaining the error. The exit code can't be ~QMCKL_SUCCESS~. explaining the error. The exit code can't be ~QMCKL_SUCCESS~.
# Header # Header
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_exit_code
qmckl_set_error(qmckl_context context, qmckl_set_error(qmckl_context context,
const qmckl_exit_code exit_code, const qmckl_exit_code exit_code,
@ -386,7 +393,7 @@ qmckl_set_error(qmckl_context context,
#+end_src #+end_src
# Source # Source
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_set_error(qmckl_context context, qmckl_set_error(qmckl_context context,
const qmckl_exit_code exit_code, const qmckl_exit_code exit_code,
@ -428,7 +435,7 @@ qmckl_set_error(qmckl_context context,
function name and message is mandatory. function name and message is mandatory.
# Header # Header
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_exit_code
qmckl_get_error(qmckl_context context, qmckl_get_error(qmckl_context context,
qmckl_exit_code *exit_code, qmckl_exit_code *exit_code,
@ -437,7 +444,7 @@ qmckl_get_error(qmckl_context context,
#+end_src #+end_src
# Source # Source
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c) :exports none
qmckl_exit_code qmckl_exit_code
qmckl_get_error(qmckl_context context, qmckl_get_error(qmckl_context context,
qmckl_exit_code *exit_code, qmckl_exit_code *exit_code,
@ -488,19 +495,21 @@ qmckl_get_error(qmckl_context context,
the desired return code. the desired return code.
Upon failure, a ~QMCKL_NULL_CONTEXT~ is returned. Upon failure, a ~QMCKL_NULL_CONTEXT~ is returned.
#+begin_src c :comments org :tangle (eval h_func) :exports none #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code qmckl_failwith(qmckl_context context, qmckl_exit_code
qmckl_failwith(qmckl_context context,
const qmckl_exit_code exit_code, const qmckl_exit_code exit_code,
const char* function, const char* function,
const char* message) ; const char* message) ;
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) #+begin_src c :comments org :tangle (eval c) :exports none
qmckl_exit_code qmckl_failwith(qmckl_context context, qmckl_exit_code
qmckl_failwith(qmckl_context context,
const qmckl_exit_code exit_code, const qmckl_exit_code exit_code,
const char* function, const char* function,
const char* message) { const char* message)
{
assert (exit_code > 0); assert (exit_code > 0);
assert (exit_code < QMCKL_INVALID_EXIT_CODE); assert (exit_code < QMCKL_INVALID_EXIT_CODE);
assert (function != NULL); assert (function != NULL);
@ -544,8 +553,6 @@ if (x < 0) {
#endif #endif
#+end_src #+end_src
** Test
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test)
/* Initialize the variables */ /* Initialize the variables */
char function_name[QMCKL_MAX_FUN_LEN]=""; char function_name[QMCKL_MAX_FUN_LEN]="";