mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-12-22 12:23:56 +01:00
Updated documentation
This commit is contained in:
parent
173b73b5f1
commit
1a5b76157b
@ -5428,17 +5428,17 @@ qmckl_compute_ao_vgl_hpc_gaussian (
|
||||
const int32_t n = lstart[l+1]-lstart[l];
|
||||
const int64_t k = ao_index[ishell];
|
||||
|
||||
double* const ao_vgl_1 = &(ao_vgl[ipoint*5*ao_num+k]);
|
||||
double* const ao_vgl_2 = &(ao_vgl_1[ ao_num]);
|
||||
double* const ao_vgl_3 = &(ao_vgl_1[2*ao_num]);
|
||||
double* 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_1 = &(ao_vgl[ipoint*5*ao_num+k]);
|
||||
double* __restrict__ const ao_vgl_2 = &(ao_vgl_1[ ao_num]);
|
||||
double* __restrict__ const ao_vgl_3 = &(ao_vgl_1[2*ao_num]);
|
||||
double* __restrict__ const ao_vgl_4 = &(ao_vgl_1[3*ao_num]);
|
||||
double* __restrict__ const ao_vgl_5 = &(ao_vgl_1[4*ao_num]);
|
||||
|
||||
double* poly_vgl_1;
|
||||
double* poly_vgl_2;
|
||||
double* poly_vgl_3;
|
||||
double* poly_vgl_4;
|
||||
double* poly_vgl_5;
|
||||
double* __restrict__ poly_vgl_1;
|
||||
double* __restrict__ poly_vgl_2;
|
||||
double* __restrict__ poly_vgl_3;
|
||||
double* __restrict__ poly_vgl_4;
|
||||
double* __restrict__ poly_vgl_5;
|
||||
if (nidx > 0) {
|
||||
const double* f = &(ao_factor[k]);
|
||||
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_4 = &(poly_vgl_l2[3][idx]);
|
||||
poly_vgl_5 = &(poly_vgl_l2[4][idx]);
|
||||
|
||||
for (int64_t il=0 ; il<n ; ++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];
|
||||
@ -5490,6 +5491,7 @@ qmckl_compute_ao_vgl_hpc_gaussian (
|
||||
poly_vgl_3 = &(poly_vgl[2][idx]);
|
||||
poly_vgl_4 = &(poly_vgl[3][idx]);
|
||||
poly_vgl_5 = &(poly_vgl[4][idx]);
|
||||
|
||||
for (int64_t il=0 ; il<n ; ++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];
|
||||
|
||||
@ -60,8 +60,20 @@ int main() {
|
||||
|
||||
#+end_src
|
||||
|
||||
* Data types
|
||||
* -
|
||||
: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
|
||||
|
||||
** Vector
|
||||
|
||||
| Variable | Type | Description |
|
||||
@ -69,7 +81,7 @@ int main() {
|
||||
| ~size~ | ~int64_t~ | Dimension of the vector |
|
||||
| ~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 {
|
||||
int64_t size;
|
||||
double* data;
|
||||
@ -85,7 +97,7 @@ qmckl_vector_alloc( qmckl_context context,
|
||||
|
||||
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_alloc( qmckl_context context,
|
||||
const int64_t size)
|
||||
@ -114,7 +126,7 @@ qmckl_vector_free( qmckl_context context,
|
||||
qmckl_vector* vector);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c)
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_vector_free( qmckl_context context,
|
||||
qmckl_vector* vector)
|
||||
@ -145,7 +157,7 @@ qmckl_vector_free( qmckl_context context,
|
||||
The dimensions use Fortran ordering: two elements differing by one
|
||||
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 {
|
||||
int64_t size[2];
|
||||
double* data;
|
||||
@ -162,7 +174,7 @@ qmckl_matrix_alloc( qmckl_context context,
|
||||
|
||||
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_alloc( qmckl_context context,
|
||||
const int64_t size1,
|
||||
@ -195,7 +207,7 @@ qmckl_matrix_free( qmckl_context context,
|
||||
qmckl_matrix* matrix);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c)
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_matrix_free( qmckl_context context,
|
||||
qmckl_matrix* matrix)
|
||||
@ -228,7 +240,7 @@ qmckl_matrix_free( qmckl_context context,
|
||||
The dimensions use Fortran ordering: two elements differing by one
|
||||
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
|
||||
|
||||
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
|
||||
is zero.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c)
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_tensor
|
||||
qmckl_tensor_alloc( qmckl_context context,
|
||||
const int64_t order,
|
||||
@ -285,11 +297,11 @@ qmckl_tensor_alloc( qmckl_context context,
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
qmckl_exit_code
|
||||
qmckl_tensor_free( qmckl_context context,
|
||||
qmckl_tensor_free (qmckl_context context,
|
||||
qmckl_tensor* tensor);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c)
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_tensor_free( qmckl_context context,
|
||||
qmckl_tensor* tensor)
|
||||
@ -325,7 +337,7 @@ qmckl_matrix_of_vector(const qmckl_vector vector,
|
||||
|
||||
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_of_vector(const qmckl_vector vector,
|
||||
const int64_t size1,
|
||||
@ -355,7 +367,7 @@ qmckl_tensor_of_vector(const qmckl_vector vector,
|
||||
|
||||
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_of_vector(const qmckl_vector vector,
|
||||
const int64_t order,
|
||||
@ -385,7 +397,7 @@ qmckl_vector_of_matrix(const qmckl_matrix matrix);
|
||||
|
||||
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_of_matrix(const qmckl_matrix matrix)
|
||||
{
|
||||
@ -409,7 +421,7 @@ qmckl_tensor_of_matrix(const qmckl_matrix matrix,
|
||||
|
||||
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_of_matrix(const qmckl_matrix matrix,
|
||||
const int64_t order,
|
||||
@ -439,7 +451,7 @@ qmckl_vector_of_tensor(const qmckl_tensor tensor);
|
||||
|
||||
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_of_tensor(const qmckl_tensor tensor)
|
||||
{
|
||||
@ -468,7 +480,7 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
|
||||
|
||||
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_of_tensor(const qmckl_tensor tensor,
|
||||
const int64_t size1,
|
||||
@ -493,7 +505,20 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
|
||||
|
||||
** 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_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))))]
|
||||
#+end_src
|
||||
|
||||
For example:
|
||||
|
||||
** Copy to/from to ~double*~
|
||||
|
||||
#+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*~.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c)
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_double_of_vector(const qmckl_context context,
|
||||
const qmckl_vector vector,
|
||||
@ -546,7 +573,7 @@ qmckl_double_of_matrix(const qmckl_context context,
|
||||
|
||||
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_double_of_matrix(const qmckl_context context,
|
||||
const qmckl_matrix matrix,
|
||||
@ -569,7 +596,7 @@ qmckl_double_of_tensor(const qmckl_context context,
|
||||
|
||||
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_double_of_tensor(const qmckl_context context,
|
||||
const qmckl_tensor tensor,
|
||||
@ -592,7 +619,7 @@ qmckl_vector_of_double(const qmckl_context context,
|
||||
|
||||
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_vector_of_double(const qmckl_context context,
|
||||
const double* target,
|
||||
@ -636,9 +663,9 @@ qmckl_matrix_of_double(const qmckl_context context,
|
||||
qmckl_matrix* matrix);
|
||||
#+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_matrix_of_double(const qmckl_context context,
|
||||
const double* target,
|
||||
@ -662,9 +689,9 @@ qmckl_tensor_of_double(const qmckl_context context,
|
||||
qmckl_tensor* tensor);
|
||||
#+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_tensor_of_double(const qmckl_context context,
|
||||
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)
|
||||
#+begin_src c :comments link :tangle (eval c_test) :exports none
|
||||
{
|
||||
int64_t m = 3;
|
||||
int64_t n = 4;
|
||||
@ -720,7 +746,7 @@ qmckl_tensor_of_double(const qmckl_context context,
|
||||
|
||||
** ~qmckl_dgemm~
|
||||
|
||||
Matrix multiplication:
|
||||
Matrix multiplication with a BLAS interface:
|
||||
|
||||
\[
|
||||
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 );
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :tangle (eval f)
|
||||
#+begin_src f90 :tangle (eval f) :exports none
|
||||
integer function qmckl_dgemm_f(context, TransA, TransB, &
|
||||
m, n, k, alpha, A, LDA, B, LDB, beta, C, LDC) &
|
||||
result(info)
|
||||
@ -975,14 +1001,14 @@ integer(qmckl_exit_code) function test_qmckl_dgemm(context) bind(C)
|
||||
end function test_qmckl_dgemm
|
||||
#+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);
|
||||
assert(QMCKL_SUCCESS == test_qmckl_dgemm(context));
|
||||
#+end_src
|
||||
|
||||
** ~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}
|
||||
@ -1017,7 +1043,7 @@ qmckl_matmul (const qmckl_context context,
|
||||
qmckl_matrix* const C );
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c) :comments org
|
||||
#+begin_src c :tangle (eval c) :comments org :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_matmul (const qmckl_context context,
|
||||
const char TransA,
|
||||
@ -1155,9 +1181,88 @@ qmckl_matmul (const qmckl_context context,
|
||||
}
|
||||
#+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~
|
||||
|
||||
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
|
||||
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) &
|
||||
result(info)
|
||||
use qmckl
|
||||
@ -1263,7 +1368,7 @@ integer function qmckl_adjugate_f(context, na, A, LDA, B, ldb, det_l) &
|
||||
|
||||
end function qmckl_adjugate_f
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src f90 :tangle (eval f) :exports none
|
||||
subroutine adjugate2(A,LDA,B,LDB,na,det_l)
|
||||
implicit none
|
||||
@ -2047,11 +2152,11 @@ assert(QMCKL_SUCCESS == test_qmckl_adjugate(context));
|
||||
|
||||
Transposes a matrix: $A^\dagger_{ji} = A_{ij}$.
|
||||
|
||||
| Variable | Type | In/Out | Description |
|
||||
|----------+---------------+--------+-------------------|
|
||||
| context | qmckl_context | in | Global state |
|
||||
| A | qmckl_matrix | in | Input matrix |
|
||||
| At | qmckl_matrix | out | Transposed matrix |
|
||||
| Variable | Type | In/Out | Description |
|
||||
|-----------+-----------------+--------+-------------------|
|
||||
| ~context~ | ~qmckl_context~ | in | Global state |
|
||||
| ~A~ | ~qmckl_matrix~ | in | Input matrix |
|
||||
| ~At~ | ~qmckl_matrix~ | out | Transposed matrix |
|
||||
|
||||
#+begin_src c :tangle (eval h_private_func) :comments org
|
||||
qmckl_exit_code
|
||||
@ -2061,7 +2166,7 @@ qmckl_transpose (qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src c :tangle (eval c) :comments org
|
||||
#+begin_src c :tangle (eval c) :comments org :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_transpose (qmckl_context context,
|
||||
const qmckl_matrix A,
|
||||
@ -2100,7 +2205,7 @@ qmckl_transpose (qmckl_context context,
|
||||
}
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
*** Test :noexport:
|
||||
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
{
|
||||
|
||||
@ -146,7 +146,7 @@ typedef struct qmckl_context_struct {
|
||||
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_type) :noweb yes
|
||||
#+begin_src c :comments org :tangle (eval h_private_type) :noweb yes :exports none
|
||||
#define VALID_TAG 0xBEEFFACE
|
||||
#define INVALID_TAG 0xDEADBEEF
|
||||
#+end_src
|
||||
@ -156,10 +156,11 @@ typedef struct qmckl_context_struct {
|
||||
if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise.
|
||||
|
||||
#+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
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
#+begin_src c :tangle (eval c) :exports none
|
||||
qmckl_context qmckl_context_check(const qmckl_context context) {
|
||||
|
||||
if (context == QMCKL_NULL_CONTEXT)
|
||||
@ -176,19 +177,27 @@ qmckl_context qmckl_context_check(const qmckl_context context) {
|
||||
}
|
||||
#+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.
|
||||
|
||||
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.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :noexport
|
||||
qmckl_exit_code qmckl_context_touch(const qmckl_context context) ;
|
||||
When the electron coordinates have changed, the context is touched
|
||||
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
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
qmckl_exit_code qmckl_context_touch(const qmckl_context context) {
|
||||
This has the effect to increment the date of the 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) {
|
||||
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
|
||||
|
||||
# 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();
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
#+begin_src c :tangle (eval c) :exports none
|
||||
qmckl_context qmckl_context_create() {
|
||||
|
||||
qmckl_context_struct* const ctx =
|
||||
@ -326,13 +335,13 @@ assert( qmckl_context_check(context) == context );
|
||||
~lock_count~ attribute.
|
||||
|
||||
# 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_unlock(qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
#+begin_src c :tangle (eval c) :exports none
|
||||
void qmckl_lock(qmckl_context context) {
|
||||
if (context == QMCKL_NULL_CONTEXT)
|
||||
return ;
|
||||
@ -345,9 +354,6 @@ void qmckl_lock(qmckl_context context) {
|
||||
}
|
||||
assert (rc == 0);
|
||||
ctx->lock_count += 1;
|
||||
/*
|
||||
printf(" lock : %d\n", ctx->lock_count);
|
||||
,*/
|
||||
}
|
||||
|
||||
void qmckl_unlock(const qmckl_context context) {
|
||||
@ -359,9 +365,6 @@ void qmckl_unlock(const qmckl_context context) {
|
||||
}
|
||||
assert (rc == 0);
|
||||
ctx->lock_count -= 1;
|
||||
/*
|
||||
printf("unlock : %d\n", ctx->lock_count);
|
||||
,*/
|
||||
}
|
||||
#+end_src
|
||||
|
||||
@ -372,12 +375,14 @@ void qmckl_unlock(const qmckl_context context) {
|
||||
|
||||
# Header
|
||||
#+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)
|
||||
#+begin_src c :tangle (eval c) :exports none
|
||||
qmckl_context qmckl_context_copy(const qmckl_context 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
|
||||
#+begin_src f90 :tangle (eval fh_func) :exports none
|
||||
interface
|
||||
integer (qmckl_context) function qmckl_context_copy(context) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), intent(in), value :: context
|
||||
end function qmckl_context_copy
|
||||
end interface
|
||||
! interface
|
||||
! integer (qmckl_context) function qmckl_context_copy(context) bind(C)
|
||||
! use, intrinsic :: iso_c_binding
|
||||
! import
|
||||
! integer (qmckl_context), intent(in), value :: context
|
||||
! end function qmckl_context_copy
|
||||
! end interface
|
||||
#+end_src
|
||||
|
||||
# Test
|
||||
@ -443,13 +448,16 @@ munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
|
||||
It frees the context, and returns the previous context.
|
||||
|
||||
# Header
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
qmckl_exit_code qmckl_context_destroy(const qmckl_context context);
|
||||
#+begin_src c :comments org :tangle (eval h_func)
|
||||
qmckl_exit_code
|
||||
qmckl_context_destroy (const qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
qmckl_exit_code qmckl_context_destroy(const qmckl_context context) {
|
||||
#+begin_src c :tangle (eval c) :exports none
|
||||
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;
|
||||
|
||||
@ -46,7 +46,7 @@ int main() {
|
||||
|
||||
#+end_src
|
||||
|
||||
*
|
||||
* -
|
||||
:PROPERTIES:
|
||||
:UNNUMBERED: t
|
||||
:END:
|
||||
@ -204,18 +204,25 @@ return '\n'.join(result)
|
||||
string is assumed to be large enough to contain the error message
|
||||
(typically 128 characters).
|
||||
|
||||
* hidden :noexport:
|
||||
|
||||
#+NAME: MAX_STRING_LENGTH
|
||||
: 128
|
||||
|
||||
* 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) :noweb yes
|
||||
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
|
||||
const char* qmckl_string_of_error(const qmckl_exit_code error);
|
||||
void qmckl_string_of_error_f(const qmckl_exit_code error,
|
||||
char result[<<MAX_STRING_LENGTH()>>]);
|
||||
#+begin_src c :comments org :tangle (eval h_private_func) :exports none :noweb yes
|
||||
void
|
||||
qmckl_string_of_error_f(const qmckl_exit_code error,
|
||||
char result[<<MAX_STRING_LENGTH()>>]);
|
||||
#+end_src
|
||||
|
||||
The text strings are extracted from the previous table.
|
||||
@ -326,7 +333,7 @@ return '\n'.join(result)
|
||||
#+end_example
|
||||
|
||||
# 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) {
|
||||
switch (error) {
|
||||
<<cases()>>
|
||||
@ -340,7 +347,7 @@ void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<<MAX_STRI
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
#+begin_src f90 :tangle (eval fh_func) :noexport :noweb yes
|
||||
#+begin_src f90 :tangle (eval fh_func) :exports none :noweb yes
|
||||
interface
|
||||
subroutine qmckl_string_of_error (error, string) bind(C, name='qmckl_string_of_error_f')
|
||||
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
|
||||
|
||||
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.
|
||||
|
||||
#+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~.
|
||||
|
||||
# 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_set_error(qmckl_context context,
|
||||
const qmckl_exit_code exit_code,
|
||||
@ -386,7 +393,7 @@ qmckl_set_error(qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
#+begin_src c :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_set_error(qmckl_context context,
|
||||
const qmckl_exit_code exit_code,
|
||||
@ -428,7 +435,7 @@ qmckl_set_error(qmckl_context context,
|
||||
function name and message is mandatory.
|
||||
|
||||
# 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_get_error(qmckl_context context,
|
||||
qmckl_exit_code *exit_code,
|
||||
@ -437,7 +444,7 @@ qmckl_get_error(qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
#+begin_src c :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_get_error(qmckl_context context,
|
||||
qmckl_exit_code *exit_code,
|
||||
@ -488,19 +495,21 @@ qmckl_get_error(qmckl_context context,
|
||||
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,
|
||||
const qmckl_exit_code exit_code,
|
||||
const char* function,
|
||||
const char* message) ;
|
||||
#+begin_src c :comments org :tangle (eval h_func)
|
||||
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) {
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
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);
|
||||
@ -544,8 +553,6 @@ if (x < 0) {
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
|
||||
** Test
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
/* Initialize the variables */
|
||||
char function_name[QMCKL_MAX_FUN_LEN]="";
|
||||
|
||||
Loading…
Reference in New Issue
Block a user