mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-08-16 18:38:28 +02:00
Check in malloc
This commit is contained in:
parent
cd6de216b8
commit
1b846de413
@ -72,11 +72,11 @@ 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 |
|
||||
|----------+-----------+-------------------------|
|
||||
| ~size~ | ~int64_t~ | Dimension of the vector |
|
||||
@ -92,7 +92,7 @@ typedef struct qmckl_vector {
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
qmckl_vector
|
||||
qmckl_vector_alloc( qmckl_context context,
|
||||
qmckl_vector_alloc( qmckl_context context,
|
||||
const int64_t size);
|
||||
#+end_src
|
||||
|
||||
@ -100,12 +100,12 @@ qmckl_vector_alloc( qmckl_context context,
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_vector
|
||||
qmckl_vector_alloc( qmckl_context context,
|
||||
qmckl_vector_alloc( qmckl_context context,
|
||||
const int64_t size)
|
||||
{
|
||||
/* Should always be true by contruction */
|
||||
assert (size > (int64_t) 0);
|
||||
|
||||
|
||||
qmckl_vector result;
|
||||
result.size = size;
|
||||
|
||||
@ -120,23 +120,30 @@ qmckl_vector_alloc( qmckl_context context,
|
||||
return result;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
qmckl_exit_code
|
||||
qmckl_vector_free( qmckl_context context,
|
||||
qmckl_vector_free( qmckl_context context,
|
||||
qmckl_vector* vector);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_vector_free( qmckl_context context,
|
||||
qmckl_vector_free( qmckl_context context,
|
||||
qmckl_vector* vector)
|
||||
{
|
||||
if (vector == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_vector_free",
|
||||
"Null pointer");
|
||||
}
|
||||
|
||||
/* Always true */
|
||||
assert (vector->data != NULL);
|
||||
|
||||
|
||||
qmckl_exit_code rc;
|
||||
|
||||
|
||||
rc = qmckl_free(context, vector->data);
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
@ -149,7 +156,7 @@ qmckl_vector_free( qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
** Matrix
|
||||
|
||||
|
||||
| Variable | Type | Description |
|
||||
|----------+--------------+-----------------------------|
|
||||
| ~size~ | ~int64_t[2]~ | Dimension of each component |
|
||||
@ -157,7 +164,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) :exports none
|
||||
typedef struct qmckl_matrix {
|
||||
double* restrict data;
|
||||
@ -168,7 +175,7 @@ typedef struct qmckl_matrix {
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
qmckl_matrix
|
||||
qmckl_matrix_alloc( qmckl_context context,
|
||||
qmckl_matrix_alloc( qmckl_context context,
|
||||
const int64_t size1,
|
||||
const int64_t size2);
|
||||
#+end_src
|
||||
@ -177,13 +184,13 @@ qmckl_matrix_alloc( qmckl_context context,
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_matrix
|
||||
qmckl_matrix_alloc( qmckl_context context,
|
||||
qmckl_matrix_alloc( qmckl_context context,
|
||||
const int64_t size1,
|
||||
const int64_t size2)
|
||||
{
|
||||
/* Should always be true by contruction */
|
||||
assert (size1 * size2 > (int64_t) 0);
|
||||
|
||||
|
||||
qmckl_matrix result;
|
||||
|
||||
result.size[0] = size1;
|
||||
@ -201,23 +208,30 @@ qmckl_matrix_alloc( qmckl_context context,
|
||||
return result;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
qmckl_exit_code
|
||||
qmckl_matrix_free( qmckl_context context,
|
||||
qmckl_matrix_free( qmckl_context context,
|
||||
qmckl_matrix* matrix);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_matrix_free( qmckl_context context,
|
||||
qmckl_matrix_free( qmckl_context context,
|
||||
qmckl_matrix* matrix)
|
||||
{
|
||||
if (matrix == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_matrix_free",
|
||||
"Null pointer");
|
||||
}
|
||||
|
||||
/* Always true */
|
||||
assert (matrix->data != NULL);
|
||||
|
||||
|
||||
qmckl_exit_code rc;
|
||||
|
||||
|
||||
rc = qmckl_free(context, matrix->data);
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
@ -231,7 +245,7 @@ qmckl_matrix_free( qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
** Tensor
|
||||
|
||||
|
||||
| Variable | Type | Description |
|
||||
|----------+-----------------------------------+-----------------------------|
|
||||
| ~order~ | ~int64_t~ | Order of the tensor |
|
||||
@ -240,7 +254,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) :exports none
|
||||
#define QMCKL_TENSOR_ORDER_MAX 16
|
||||
|
||||
@ -254,7 +268,7 @@ typedef struct qmckl_tensor {
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
qmckl_tensor
|
||||
qmckl_tensor_alloc( qmckl_context context,
|
||||
qmckl_tensor_alloc( qmckl_context context,
|
||||
const int64_t order,
|
||||
const int64_t* size);
|
||||
#+end_src
|
||||
@ -264,7 +278,7 @@ qmckl_tensor_alloc( qmckl_context context,
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_tensor
|
||||
qmckl_tensor_alloc( qmckl_context context,
|
||||
qmckl_tensor_alloc( qmckl_context context,
|
||||
const int64_t order,
|
||||
const int64_t* size)
|
||||
{
|
||||
@ -272,7 +286,7 @@ qmckl_tensor_alloc( qmckl_context context,
|
||||
assert (order > 0);
|
||||
assert (order <= QMCKL_TENSOR_ORDER_MAX);
|
||||
assert (size != NULL);
|
||||
|
||||
|
||||
qmckl_tensor result;
|
||||
result.order = order;
|
||||
|
||||
@ -295,28 +309,35 @@ qmckl_tensor_alloc( qmckl_context context,
|
||||
return result;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
#+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) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_tensor_free( qmckl_context context,
|
||||
qmckl_tensor_free( qmckl_context context,
|
||||
qmckl_tensor* tensor)
|
||||
{
|
||||
if (tensor == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_tensor_free",
|
||||
"Null pointer");
|
||||
}
|
||||
|
||||
/* Always true */
|
||||
assert (tensor->data != NULL);
|
||||
|
||||
|
||||
qmckl_exit_code rc;
|
||||
|
||||
|
||||
rc = qmckl_free(context, tensor->data);
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
||||
|
||||
memset(tensor, 0, sizeof(qmckl_tensor));
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
@ -326,7 +347,7 @@ qmckl_tensor_free( qmckl_context context,
|
||||
** Reshaping
|
||||
|
||||
Reshaping occurs in-place and the pointer to the data is copied.
|
||||
|
||||
|
||||
*** Vector -> Matrix
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
@ -343,7 +364,7 @@ qmckl_matrix
|
||||
qmckl_matrix_of_vector(const qmckl_vector vector,
|
||||
const int64_t size1,
|
||||
const int64_t size2)
|
||||
{
|
||||
{
|
||||
/* Always true */
|
||||
assert (size1 * size2 == vector.size);
|
||||
|
||||
@ -373,7 +394,7 @@ qmckl_tensor
|
||||
qmckl_tensor_of_vector(const qmckl_vector vector,
|
||||
const int64_t order,
|
||||
const int64_t* size)
|
||||
{
|
||||
{
|
||||
qmckl_tensor result;
|
||||
|
||||
int64_t prod_size = 1;
|
||||
@ -401,7 +422,7 @@ qmckl_vector_of_matrix(const qmckl_matrix matrix);
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_vector
|
||||
qmckl_vector_of_matrix(const qmckl_matrix matrix)
|
||||
{
|
||||
{
|
||||
qmckl_vector result;
|
||||
|
||||
result.size = matrix.size[0] * matrix.size[1];
|
||||
@ -427,7 +448,7 @@ qmckl_tensor
|
||||
qmckl_tensor_of_matrix(const qmckl_matrix matrix,
|
||||
const int64_t order,
|
||||
const int64_t* size)
|
||||
{
|
||||
{
|
||||
qmckl_tensor result;
|
||||
|
||||
int64_t prod_size = 1;
|
||||
@ -455,7 +476,7 @@ qmckl_vector_of_tensor(const qmckl_tensor tensor);
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_vector
|
||||
qmckl_vector_of_tensor(const qmckl_tensor tensor)
|
||||
{
|
||||
{
|
||||
int64_t prod_size = (int64_t) tensor.size[0];
|
||||
for (int64_t i=1 ; i<tensor.order ; i++) {
|
||||
prod_size *= tensor.size[i];
|
||||
@ -486,7 +507,7 @@ qmckl_matrix
|
||||
qmckl_matrix_of_tensor(const qmckl_tensor tensor,
|
||||
const int64_t size1,
|
||||
const int64_t size2)
|
||||
{
|
||||
{
|
||||
/* Always true */
|
||||
int64_t prod_size = (int64_t) 1;
|
||||
for (int64_t i=0 ; i<tensor.order ; i++) {
|
||||
@ -510,7 +531,7 @@ qmckl_matrix_of_tensor(const qmckl_tensor tensor,
|
||||
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_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]
|
||||
@ -527,11 +548,11 @@ double qmckl_ten5(qmckl_tensor t, int64_t i, int64_t j, int64_t k, int64_t l, in
|
||||
#define qmckl_ten4(t, i, j, k, l) t.data[(i) + t.size[0]*((j) + t.size[1]*((k) + t.size[2]*(l)))]
|
||||
#define qmckl_ten5(t, i, j, k, l, m) t.data[(i) + t.size[0]*((j) + t.size[1]*((k) + t.size[2]*((l) + t.size[3]*(m))))]
|
||||
#+end_src
|
||||
|
||||
|
||||
For example:
|
||||
|
||||
|
||||
** Set all elements
|
||||
|
||||
|
||||
*** Vector
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
@ -568,7 +589,7 @@ qmckl_matrix_set(qmckl_matrix matrix, double value)
|
||||
return qmckl_matrix_of_vector(vector, matrix.size[0], matrix.size[1]);
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
*** Tensor
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
@ -587,7 +608,7 @@ qmckl_tensor_set(qmckl_tensor tensor, double value)
|
||||
return qmckl_tensor_of_vector(vector, tensor.order, tensor.size);
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
** Copy to/from to ~double*~
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
@ -599,7 +620,7 @@ qmckl_double_of_vector(const qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
Converts a vector to a ~double*~.
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_double_of_vector(const qmckl_context context,
|
||||
@ -631,7 +652,7 @@ qmckl_double_of_matrix(const qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
Converts a matrix to a ~double*~.
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_double_of_matrix(const qmckl_context context,
|
||||
@ -654,7 +675,7 @@ qmckl_double_of_tensor(const qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
Converts a tensor to a ~double*~.
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_double_of_tensor(const qmckl_context context,
|
||||
@ -677,7 +698,7 @@ qmckl_vector_of_double(const qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
Converts a ~double*~ to a vector.
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_vector_of_double(const qmckl_context context,
|
||||
@ -723,7 +744,7 @@ qmckl_matrix_of_double(const qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
Converts a ~double*~ to a matrix.
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_matrix_of_double(const qmckl_context context,
|
||||
@ -749,7 +770,7 @@ qmckl_tensor_of_double(const qmckl_context context,
|
||||
#+end_src
|
||||
|
||||
Converts a ~double*~ to a tensor.
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_tensor_of_double(const qmckl_context context,
|
||||
@ -774,17 +795,17 @@ qmckl_tensor_of_double(const qmckl_context context,
|
||||
int64_t p = m*n;
|
||||
qmckl_vector vec = qmckl_vector_alloc(context, p);
|
||||
|
||||
for (int64_t i=0 ; i<p ; ++i)
|
||||
for (int64_t i=0 ; i<p ; ++i)
|
||||
qmckl_vec(vec, i) = (double) i;
|
||||
|
||||
for (int64_t i=0 ; i<p ; ++i)
|
||||
for (int64_t i=0 ; i<p ; ++i)
|
||||
assert( vec.data[i] == (double) i );
|
||||
|
||||
qmckl_matrix mat = qmckl_matrix_of_vector(vec, m, n);
|
||||
assert (mat.size[0] == m);
|
||||
assert (mat.size[1] == n);
|
||||
assert (mat.data == vec.data);
|
||||
|
||||
|
||||
for (int64_t j=0 ; j<n ; ++j)
|
||||
for (int64_t i=0 ; i<m ; ++i)
|
||||
assert ( qmckl_mat(mat, i, j) == qmckl_vec(vec, i+j*m)) ;
|
||||
@ -792,7 +813,7 @@ qmckl_tensor_of_double(const qmckl_context context,
|
||||
qmckl_vector vec2 = qmckl_vector_of_matrix(mat);
|
||||
assert (vec2.size == p);
|
||||
assert (vec2.data == vec.data);
|
||||
for (int64_t i=0 ; i<p ; ++i)
|
||||
for (int64_t i=0 ; i<p ; ++i)
|
||||
assert ( qmckl_vec(vec2, i) == qmckl_vec(vec, i) ) ;
|
||||
|
||||
qmckl_vector_free(context, &vec);
|
||||
@ -1097,7 +1118,7 @@ qmckl_matmul (const qmckl_context context,
|
||||
const qmckl_matrix A,
|
||||
const qmckl_matrix B,
|
||||
const double beta,
|
||||
qmckl_matrix* const C );
|
||||
qmckl_matrix* const C );
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c) :comments org :exports none
|
||||
@ -1183,7 +1204,7 @@ qmckl_matmul (const qmckl_context context,
|
||||
C->data, C->size[0]);
|
||||
break;
|
||||
case 1:
|
||||
if (A.size[0] != B.size[0]) {
|
||||
if (A.size[0] != B.size[0]) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_matmul",
|
||||
@ -1243,7 +1264,7 @@ qmckl_matmul (const qmckl_context context,
|
||||
#+begin_src python :exports none :results output
|
||||
import numpy as np
|
||||
|
||||
A = np.array([[ 1., 2., 3., 4. ],
|
||||
A = np.array([[ 1., 2., 3., 4. ],
|
||||
[ 5., 6., 7., 8. ],
|
||||
[ 9., 10., 11., 12. ]])
|
||||
|
||||
@ -1282,7 +1303,7 @@ print(C.T)
|
||||
2., 6., 10.,
|
||||
3., 7., 11.,
|
||||
4., 8., 12. };
|
||||
|
||||
|
||||
double b[20] = { 1., 5., 9., 10.,
|
||||
-2., -6., 10., 11.,
|
||||
3., 7., 11., 12.,
|
||||
@ -1317,7 +1338,7 @@ print(C.T)
|
||||
printf("%f %f\n", cnew[i], c[i]);
|
||||
assert (c[i] == cnew[i]);
|
||||
}
|
||||
}
|
||||
}
|
||||
#+end_src
|
||||
** ~qmckl_adjugate~
|
||||
|
||||
@ -1424,7 +1445,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
|
||||
@ -2213,12 +2234,12 @@ assert(QMCKL_SUCCESS == test_qmckl_adjugate(context));
|
||||
| ~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
|
||||
qmckl_transpose (qmckl_context context,
|
||||
const qmckl_matrix A,
|
||||
qmckl_matrix At );
|
||||
qmckl_matrix At );
|
||||
#+end_src
|
||||
|
||||
|
||||
@ -2253,10 +2274,10 @@ qmckl_transpose (qmckl_context context,
|
||||
"Invalid size for At");
|
||||
}
|
||||
|
||||
for (int64_t j=0 ; j<At.size[1] ; ++j)
|
||||
for (int64_t i=0 ; i<At.size[0] ; ++i)
|
||||
for (int64_t j=0 ; j<At.size[1] ; ++j)
|
||||
for (int64_t i=0 ; i<At.size[0] ; ++i)
|
||||
qmckl_mat(At, i, j) = qmckl_mat(A, j, i);
|
||||
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
@ -308,7 +308,7 @@ qmckl_set_point (qmckl_context context,
|
||||
assert (ctx != NULL);
|
||||
|
||||
qmckl_exit_code rc;
|
||||
if (ctx->point.num < num) {
|
||||
if (ctx->point.num != num) {
|
||||
|
||||
if (ctx->point.coord.data != NULL) {
|
||||
rc = qmckl_matrix_free(context, &(ctx->point.coord));
|
||||
|
||||
@ -1086,7 +1086,7 @@ qmckl_trexio_read(const qmckl_context context, const char* file_name, const int6
|
||||
|
||||
qmckl_exit_code rc;
|
||||
char file_name_new[size_max+1];
|
||||
strncpy(file_name_new, file_name, size_max+1);
|
||||
strncpy(file_name_new, file_name, size_max);
|
||||
file_name_new[size_max] = '\0';
|
||||
|
||||
#ifdef HAVE_TREXIO
|
||||
|
||||
Loading…
Reference in New Issue
Block a user