mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-07-03 01:46:12 +02:00
Memory checking
This commit is contained in:
parent
4bf71426e4
commit
1af0bf053f
|
@ -116,8 +116,15 @@ Both files are located in the =include/= directory.
|
||||||
For more guidelines on using Fortran to generate a C interface, see
|
For more guidelines on using Fortran to generate a C interface, see
|
||||||
[[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]].
|
[[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
|
# # TODO: decide on a coding style
|
||||||
|
|
||||||
# To improve readability, we maintain a consistent coding style in
|
# 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]].
|
# Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]].
|
||||||
|
|
||||||
|
|
||||||
** Design of the library
|
** Design of the library
|
||||||
|
|
||||||
The proposed API should allow the library to: deal with memory transfers
|
The proposed API should allow the library to: deal with memory transfers
|
||||||
|
@ -251,3 +259,4 @@ Both files are located in the =include/= directory.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
271
src/qmckl_ao.org
271
src/qmckl_ao.org
|
@ -1,8 +1,36 @@
|
||||||
#+TITLE: Atomic Orbitals
|
#+TITLE: Atomic Orbitals
|
||||||
#+SETUPFILE: ../docs/theme.setup
|
#+SETUPFILE: ../docs/theme.setup
|
||||||
|
|
||||||
The routines for the computation of the values, gradients and
|
The atomic basis set is defined as a list of shells. Each shell $s$ is
|
||||||
Laplacian of atomic basis functions are defined here.
|
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:
|
* Headers :noexport:
|
||||||
|
|
||||||
|
@ -20,40 +48,15 @@ MunitResult test_<<filename()>>() {
|
||||||
context = qmckl_context_create();
|
context = qmckl_context_create();
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Polynomials
|
* Polynomial part
|
||||||
|
|
||||||
\[
|
** Powers of $x-X_i$
|
||||||
P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c
|
|
||||||
\]
|
|
||||||
|
|
||||||
\begin{eqnarray*}
|
The ~qmckl_ao_power~ function computes all the powers of the ~n~
|
||||||
\frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) &
|
input data up to the given maximum value given in input for each of
|
||||||
= & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\
|
the $n$ points:
|
||||||
\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*}
|
|
||||||
|
|
||||||
|
\[ P_{ik} = X_i^k \]
|
||||||
\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:
|
|
||||||
|
|
||||||
\[ P_{ij} = X_j^i \]
|
|
||||||
|
|
||||||
*** Arguments
|
|
||||||
|
|
||||||
| ~context~ | input | Global state |
|
| ~context~ | input | Global state |
|
||||||
| ~n~ | input | Number of values |
|
| ~n~ | input | Number of values |
|
||||||
|
@ -62,16 +65,15 @@ MunitResult test_<<filename()>>() {
|
||||||
| ~P(LDP,n)~ | output | Array containing all the powers of ~X~ |
|
| ~P(LDP,n)~ | output | Array containing all the powers of ~X~ |
|
||||||
| ~LDP~ | input | Leading dimension of array ~P~ |
|
| ~LDP~ | input | Leading dimension of array ~P~ |
|
||||||
|
|
||||||
*** Requirements
|
Requirements:
|
||||||
|
|
||||||
- ~context~ is not 0
|
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||||
- ~n~ > 0
|
- ~n~ > 0
|
||||||
- ~X~ is allocated with at least $n \times 8$ bytes
|
- ~X~ is allocated with at least $n \times 8$ bytes
|
||||||
- ~LMAX~ is allocated with at least $n \times 4$ 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
|
- ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes
|
||||||
- ~LDP~ >= $\max_i$ ~LMAX[i]~
|
- ~LDP~ >= $\max_i$ ~LMAX[i]~
|
||||||
|
|
||||||
*** Header
|
|
||||||
#+begin_src c :tangle (eval h)
|
#+begin_src c :tangle (eval h)
|
||||||
qmckl_exit_code
|
qmckl_exit_code
|
||||||
qmckl_ao_power(const qmckl_context context,
|
qmckl_ao_power(const qmckl_context context,
|
||||||
|
@ -82,9 +84,9 @@ qmckl_ao_power(const qmckl_context context,
|
||||||
const int64_t LDP);
|
const int64_t LDP);
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** Source
|
|
||||||
#+begin_src f90 :tangle (eval f)
|
#+begin_src f90 :tangle (eval f)
|
||||||
integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info)
|
integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info)
|
||||||
|
use qmckl
|
||||||
implicit none
|
implicit none
|
||||||
integer*8 , intent(in) :: context
|
integer*8 , intent(in) :: context
|
||||||
integer*8 , intent(in) :: n
|
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)
|
real*8 , intent(out) :: P(ldp,n)
|
||||||
integer*8 , intent(in) :: ldp
|
integer*8 , intent(in) :: ldp
|
||||||
|
|
||||||
integer*8 :: i,j
|
integer*8 :: i,k
|
||||||
|
|
||||||
info = 0
|
info = QMCKL_SUCCESS
|
||||||
|
|
||||||
if (context == 0_8) then
|
if (context == QMCKL_NULL_CONTEXT) then
|
||||||
info = -1
|
info = QMCKL_INVALID_CONTEXT
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (LDP < MAXVAL(LMAX)) then
|
if (n <= ldp) then
|
||||||
info = -2
|
info = QMCKL_INVALID_ARG_2
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
do j=1,n
|
k = MAXVAL(LMAX)
|
||||||
P(1,j) = X(j)
|
if (LDP < k) then
|
||||||
do i=2,LMAX(j)
|
info = QMCKL_INVALID_ARG_6
|
||||||
P(i,j) = P(i-1,j) * X(j)
|
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 do
|
end do
|
||||||
|
|
||||||
end function qmckl_ao_power_f
|
end function qmckl_ao_power_f
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** C interface :noexport:
|
#+begin_src f90 :tangle (eval f) :exports none
|
||||||
#+begin_src f90 :tangle (eval f)
|
|
||||||
integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) &
|
integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) &
|
||||||
bind(C) result(info)
|
bind(C) result(info)
|
||||||
use, intrinsic :: iso_c_binding
|
use, intrinsic :: iso_c_binding
|
||||||
|
@ -135,7 +147,7 @@ integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) &
|
||||||
end function qmckl_ao_power
|
end function qmckl_ao_power
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src f90 :tangle (eval fh)
|
#+begin_src f90 :tangle (eval fh) :exports none
|
||||||
interface
|
interface
|
||||||
integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C)
|
integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C)
|
||||||
use, intrinsic :: iso_c_binding
|
use, intrinsic :: iso_c_binding
|
||||||
|
@ -149,7 +161,7 @@ end function qmckl_ao_power
|
||||||
end interface
|
end interface
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** Test :noexport:
|
# Test
|
||||||
#+begin_src f90 :tangle (eval f_test)
|
#+begin_src f90 :tangle (eval f_test)
|
||||||
integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
|
integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
|
||||||
use qmckl
|
use qmckl
|
||||||
|
@ -195,17 +207,45 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
|
||||||
end function test_qmckl_ao_power
|
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);
|
int test_qmckl_ao_power(qmckl_context context);
|
||||||
munit_assert_int(0, ==, test_qmckl_ao_power(context));
|
munit_assert_int(0, ==, test_qmckl_ao_power(context));
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** <<<~qmckl_ao_polynomial_vgl~>>>
|
** Value, Gradient and Laplacian of a polynomial
|
||||||
|
|
||||||
Computes the values, gradients and Laplacians at a given point of
|
A polynomial is centered on a nucleus $\mathbf{R}_i$
|
||||||
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
|
||||||
|
\]
|
||||||
|
|
||||||
|
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 |
|
| ~context~ | input | Global state |
|
||||||
| ~X(3)~ | input | Array containing the coordinates of the points |
|
| ~X(3)~ | input | Array containing the coordinates of the points |
|
||||||
|
@ -217,9 +257,9 @@ munit_assert_int(0, ==, test_qmckl_ao_power(context));
|
||||||
| ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials |
|
| ~VGL(ldv,n)~ | output | Value, gradients and Laplacian of the polynomials |
|
||||||
| ~ldv~ | input | Leading dimension of array ~VGL~ |
|
| ~ldv~ | input | Leading dimension of array ~VGL~ |
|
||||||
|
|
||||||
*** Requirements
|
Requirements:
|
||||||
|
|
||||||
- ~context~ is not 0
|
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||||
- ~n~ > 0
|
- ~n~ > 0
|
||||||
- ~lmax~ >= 0
|
- ~lmax~ >= 0
|
||||||
- ~ldl~ >= 3
|
- ~ldl~ >= 3
|
||||||
|
@ -231,19 +271,12 @@ munit_assert_int(0, ==, test_qmckl_ao_power(context));
|
||||||
- ~VGL~ is allocated with at least $5 \times n \times 8$ 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, ~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):
|
- On output, the powers are given in the following order (l=a+b+c):
|
||||||
- Increase values of ~l~
|
- Increasing values of ~l~
|
||||||
- Within a given value of ~l~, alphabetical order of the
|
- Within a given value of ~l~, alphabetical order of the
|
||||||
string made by a*"x" + b*"y" + c*"z" (in Python notation).
|
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"
|
For example, with a=0, b=2 and c=1 the string is "yyz"
|
||||||
|
|
||||||
*** Error codes
|
# Header
|
||||||
|
|
||||||
| -1 | Null context |
|
|
||||||
| -2 | Inconsistent ~ldl~ |
|
|
||||||
| -3 | Inconsistent ~ldv~ |
|
|
||||||
| -4 | Inconsistent ~lmax~ |
|
|
||||||
|
|
||||||
*** Header
|
|
||||||
#+begin_src c :tangle (eval h)
|
#+begin_src c :tangle (eval h)
|
||||||
qmckl_exit_code
|
qmckl_exit_code
|
||||||
qmckl_ao_polynomial_vgl(const qmckl_context context,
|
qmckl_ao_polynomial_vgl(const qmckl_context context,
|
||||||
|
@ -257,9 +290,10 @@ qmckl_ao_polynomial_vgl(const qmckl_context context,
|
||||||
const int64_t ldv);
|
const int64_t ldv);
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** Source
|
# Source
|
||||||
#+begin_src f90 :tangle (eval f)
|
#+begin_src f90 :tangle (eval f)
|
||||||
integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info)
|
integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info)
|
||||||
|
use qmckl
|
||||||
implicit none
|
implicit none
|
||||||
integer*8 , intent(in) :: context
|
integer*8 , intent(in) :: context
|
||||||
real*8 , intent(in) :: X(3), R(3)
|
real*8 , intent(in) :: X(3), R(3)
|
||||||
|
@ -281,23 +315,28 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL,
|
||||||
|
|
||||||
info = 0
|
info = 0
|
||||||
|
|
||||||
if (context == 0_8) then
|
if (context == QMCKL_NULL_CONTEXT) then
|
||||||
info = -1
|
info = QMCKL_INVALID_CONTEXT
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
if (ldl < 3) then
|
|
||||||
info = -2
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
if (ldv < 5) then
|
|
||||||
info = -3
|
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (lmax <= 0) then
|
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
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
@ -382,13 +421,13 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL,
|
||||||
dd = dd + 1.d0
|
dd = dd + 1.d0
|
||||||
end do
|
end do
|
||||||
|
|
||||||
info = 0
|
info = QMCKL_SUCCESS
|
||||||
|
|
||||||
end function qmckl_ao_polynomial_vgl_f
|
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) &
|
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
|
||||||
bind(C) result(info)
|
bind(C) result(info)
|
||||||
use, intrinsic :: iso_c_binding
|
use, intrinsic :: iso_c_binding
|
||||||
|
@ -407,8 +446,7 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l
|
||||||
end function qmckl_ao_polynomial_vgl
|
end function qmckl_ao_polynomial_vgl
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** Fortran interface :noexport:
|
#+begin_src f90 :tangle (eval fh) :exports none
|
||||||
#+begin_src f90 :tangle (eval fh)
|
|
||||||
interface
|
interface
|
||||||
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
|
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
|
||||||
bind(C)
|
bind(C)
|
||||||
|
@ -424,7 +462,7 @@ end function qmckl_ao_polynomial_vgl
|
||||||
end function qmckl_ao_polynomial_vgl
|
end function qmckl_ao_polynomial_vgl
|
||||||
end interface
|
end interface
|
||||||
#+end_src
|
#+end_src
|
||||||
*** Test :noexport:
|
|
||||||
#+begin_src f90 :tangle (eval f_test)
|
#+begin_src f90 :tangle (eval f_test)
|
||||||
integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
|
integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
|
||||||
use qmckl
|
use qmckl
|
||||||
|
@ -527,10 +565,9 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context));
|
||||||
|
|
||||||
* 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
|
||||||
Computes the values, gradients and Laplacians at a given point of
|
the same point:
|
||||||
~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_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 \]
|
\[ \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 \]
|
\[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \]
|
||||||
|
|
||||||
*** Arguments
|
|
||||||
|
|
||||||
| ~context~ | input | Global state |
|
| ~context~ | input | Global state |
|
||||||
| ~X(3)~ | input | Array containing the coordinates of the points |
|
| ~X(3)~ | input | Array containing the coordinates of the points |
|
||||||
| ~R(3)~ | input | Array containing the x,y,z coordinates of the center |
|
| ~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 |
|
| ~VGL(ldv,5)~ | output | Value, gradients and Laplacian of the Gaussians |
|
||||||
| ~ldv~ | input | Leading dimension of array ~VGL~ |
|
| ~ldv~ | input | Leading dimension of array ~VGL~ |
|
||||||
|
|
||||||
*** Requirements
|
Requirements :
|
||||||
|
|
||||||
- ~context~ is not 0
|
- ~context~ is not 0
|
||||||
- ~n~ > 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
|
- ~A~ is allocated with at least $n \times 8$ bytes
|
||||||
- ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes
|
- ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes
|
||||||
|
|
||||||
*** Header
|
|
||||||
#+begin_src c :tangle (eval h)
|
#+begin_src c :tangle (eval h)
|
||||||
qmckl_exit_code
|
qmckl_exit_code
|
||||||
qmckl_ao_gaussian_vgl(const qmckl_context context,
|
qmckl_ao_gaussian_vgl(const qmckl_context context,
|
||||||
|
@ -571,9 +605,9 @@ qmckl_ao_gaussian_vgl(const qmckl_context context,
|
||||||
const int64_t ldv);
|
const int64_t ldv);
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** Source
|
|
||||||
#+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)
|
integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info)
|
||||||
|
use qmckl
|
||||||
implicit none
|
implicit none
|
||||||
integer*8 , intent(in) :: context
|
integer*8 , intent(in) :: context
|
||||||
real*8 , intent(in) :: X(3), R(3)
|
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
|
integer*8 :: i,j
|
||||||
real*8 :: Y(3), r2, t, u, v
|
real*8 :: Y(3), r2, t, u, v
|
||||||
|
|
||||||
info = 0
|
info = QMCKL_SUCCESS
|
||||||
|
|
||||||
if (context == 0_8) then
|
if (context == QMCKL_NULL_CONTEXT) then
|
||||||
info = -1
|
info = QMCKL_INVALID_CONTEXT
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (n <= 0) then
|
if (n <= 0) then
|
||||||
info = -2
|
info = QMCKL_INVALID_ARG_4
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (ldv < n) then
|
if (ldv < n) then
|
||||||
info = -3
|
info = QMCKL_INVALID_ARG_7
|
||||||
return
|
return
|
||||||
endif
|
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 function qmckl_ao_gaussian_vgl_f
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** C interface :noexport:
|
#+begin_src f90 :tangle (eval f) :exports none
|
||||||
#+begin_src f90 :tangle (eval f)
|
|
||||||
integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) &
|
integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) &
|
||||||
bind(C) result(info)
|
bind(C) result(info)
|
||||||
use, intrinsic :: iso_c_binding
|
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 function qmckl_ao_gaussian_vgl
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src f90 :tangle (eval fh)
|
#+begin_src f90 :tangle (eval fh) :exports none
|
||||||
interface
|
interface
|
||||||
integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) &
|
integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) &
|
||||||
bind(C)
|
bind(C)
|
||||||
|
@ -665,7 +698,8 @@ end function qmckl_ao_gaussian_vgl
|
||||||
end function qmckl_ao_gaussian_vgl
|
end function qmckl_ao_gaussian_vgl
|
||||||
end interface
|
end interface
|
||||||
#+end_src
|
#+end_src
|
||||||
*** Test :noexport:
|
|
||||||
|
# Test
|
||||||
#+begin_src f90 :tangle (eval f_test)
|
#+begin_src f90 :tangle (eval f_test)
|
||||||
integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C)
|
integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C)
|
||||||
use qmckl
|
use qmckl
|
||||||
|
@ -750,7 +784,34 @@ munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context));
|
||||||
}
|
}
|
||||||
#+end_src
|
#+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 -*-
|
# -*- mode: org -*-
|
||||||
# vim: syntax=c
|
# vim: syntax=c
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -55,6 +55,7 @@ MunitResult test_<<filename()>>() {
|
||||||
#include "qmckl_context_private.h"
|
#include "qmckl_context_private.h"
|
||||||
#include "qmckl_memory.h"
|
#include "qmckl_memory.h"
|
||||||
|
|
||||||
|
#include <stdio.h>
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Context handling
|
* Context handling
|
||||||
|
@ -103,6 +104,7 @@ typedef struct qmckl_context_struct {
|
||||||
qmckl_memory_struct * alloc;
|
qmckl_memory_struct * alloc;
|
||||||
|
|
||||||
/* Thread lock */
|
/* Thread lock */
|
||||||
|
int lock_count;
|
||||||
pthread_mutex_t mutex;
|
pthread_mutex_t mutex;
|
||||||
|
|
||||||
/* Validity checking */
|
/* Validity checking */
|
||||||
|
@ -150,8 +152,10 @@ qmckl_context qmckl_context_check(const qmckl_context context) {
|
||||||
|
|
||||||
const qmckl_context_struct* ctx = (qmckl_context_struct*) context;
|
const qmckl_context_struct* ctx = (qmckl_context_struct*) context;
|
||||||
|
|
||||||
if (ctx->tag != VALID_TAG)
|
/* Try to access memory */
|
||||||
|
if (ctx->tag != VALID_TAG) {
|
||||||
return QMCKL_NULL_CONTEXT;
|
return QMCKL_NULL_CONTEXT;
|
||||||
|
}
|
||||||
|
|
||||||
return context;
|
return context;
|
||||||
}
|
}
|
||||||
|
@ -183,18 +187,7 @@ qmckl_context qmckl_context_create() {
|
||||||
memset(ctx, 0, sizeof(qmckl_context_struct));
|
memset(ctx, 0, sizeof(qmckl_context_struct));
|
||||||
|
|
||||||
/* Initialize lock */
|
/* Initialize lock */
|
||||||
pthread_mutexattr_t attr;
|
init_lock(&(ctx->mutex));
|
||||||
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 */
|
/* Initialize data */
|
||||||
ctx->tag = VALID_TAG;
|
ctx->tag = VALID_TAG;
|
||||||
|
@ -218,7 +211,6 @@ qmckl_context qmckl_context_create() {
|
||||||
# Test
|
# Test
|
||||||
#+begin_src c :comments link :tangle (eval c_test) :exports none
|
#+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(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT);
|
||||||
munit_assert_int64( qmckl_context_check(0x12345), ==, QMCKL_NULL_CONTEXT);
|
|
||||||
|
|
||||||
qmckl_context context = qmckl_context_create();
|
qmckl_context context = qmckl_context_create();
|
||||||
munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT );
|
munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT );
|
||||||
|
@ -228,29 +220,60 @@ munit_assert_int64( qmckl_context_check(context), ==, context );
|
||||||
** Locking
|
** Locking
|
||||||
|
|
||||||
For thread safety, the context may be locked/unlocked. The lock is
|
For thread safety, the context may be locked/unlocked. The lock is
|
||||||
initialized with the ~PTHREAD_MUTEX_ERRORCHECK~, so it is a bit
|
initialized with the ~PTHREAD_MUTEX_RECURSIVE~ attribute, and the
|
||||||
slower than a usual mutex but safer.
|
number of times the thread has locked it is saved in the
|
||||||
|
~lock_count~ attribute.
|
||||||
|
|
||||||
# Header
|
# Header
|
||||||
#+begin_src c :comments org :tangle (eval h) :exports none
|
#+begin_src c :comments org :tangle (eval h) :exports none
|
||||||
void qmckl_lock (qmckl_context context);
|
void qmckl_lock (qmckl_context context);
|
||||||
void qmckl_unlock(qmckl_context context);
|
void qmckl_unlock(qmckl_context context);
|
||||||
|
|
||||||
|
void init_lock(pthread_mutex_t* mutex);
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
# Source
|
# Source
|
||||||
#+begin_src c :tangle (eval c)
|
#+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) {
|
void qmckl_lock(qmckl_context context) {
|
||||||
if (context == QMCKL_NULL_CONTEXT)
|
if (context == QMCKL_NULL_CONTEXT)
|
||||||
return ;
|
return ;
|
||||||
qmckl_context_struct *ctx = (qmckl_context_struct*) context;
|
qmckl_context_struct *ctx = (qmckl_context_struct*) context;
|
||||||
|
errno = 0;
|
||||||
int rc = pthread_mutex_lock( &(ctx->mutex) );
|
int rc = pthread_mutex_lock( &(ctx->mutex) );
|
||||||
|
if (rc != 0) {
|
||||||
|
fprintf(stderr, "qmckl_lock:%s\n", strerror(rc) );
|
||||||
|
fflush(stderr);
|
||||||
|
}
|
||||||
assert (rc == 0);
|
assert (rc == 0);
|
||||||
|
ctx->lock_count++;
|
||||||
|
printf(" lock : %d\n", ctx->lock_count);
|
||||||
}
|
}
|
||||||
|
|
||||||
void qmckl_unlock(qmckl_context context) {
|
void qmckl_unlock(qmckl_context context) {
|
||||||
qmckl_context_struct *ctx = (qmckl_context_struct*) context;
|
qmckl_context_struct *ctx = (qmckl_context_struct*) context;
|
||||||
int rc = pthread_mutex_unlock( &(ctx->mutex) );
|
int rc = pthread_mutex_unlock( &(ctx->mutex) );
|
||||||
|
if (rc != 0) {
|
||||||
|
fprintf(stderr, "qmckl_unlock:%s\n", strerror(rc) );
|
||||||
|
fflush(stderr);
|
||||||
|
}
|
||||||
assert (rc == 0);
|
assert (rc == 0);
|
||||||
|
ctx->lock_count--;
|
||||||
|
printf("unlock : %d\n", ctx->lock_count);
|
||||||
}
|
}
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
@ -292,7 +315,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) {
|
||||||
/* Copy the old context on the new one */
|
/* Copy the old context on the new one */
|
||||||
memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct));
|
memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct));
|
||||||
|
|
||||||
qmckl_unlock(context);
|
qmckl_unlock( (qmckl_context) old_ctx );
|
||||||
|
|
||||||
new_ctx->prev = 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)
|
#+begin_src c :tangle (eval c)
|
||||||
qmckl_context qmckl_context_destroy(const qmckl_context context) {
|
qmckl_context qmckl_context_destroy(const qmckl_context context) {
|
||||||
|
|
||||||
qmckl_lock(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_NULL_CONTEXT;
|
if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_NULL_CONTEXT;
|
||||||
|
|
||||||
|
qmckl_lock(context);
|
||||||
|
|
||||||
qmckl_context_struct* ctx = (qmckl_context_struct*) context;
|
qmckl_context_struct* ctx = (qmckl_context_struct*) context;
|
||||||
assert (ctx != NULL); /* Shouldn't be true because the context is valid */
|
assert (ctx != NULL); /* Shouldn't be true because the context is valid */
|
||||||
|
|
||||||
const qmckl_context prev_context = (qmckl_context) ctx->prev;
|
qmckl_unlock(context);
|
||||||
memset(ctx, 0, sizeof(qmckl_context_struct));
|
|
||||||
ctx->tag = INVALID_TAG;
|
|
||||||
|
|
||||||
|
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);
|
const qmckl_exit_code rc = qmckl_free(context,ctx);
|
||||||
assert (rc == QMCKL_SUCCESS);
|
assert (rc == QMCKL_SUCCESS);
|
||||||
|
|
||||||
if (prev_context == QMCKL_NULL_CONTEXT) {
|
//memset(ctx, 0, sizeof(qmckl_context_struct));
|
||||||
/* 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;
|
return prev_context;
|
||||||
}
|
}
|
||||||
|
@ -1094,8 +1127,8 @@ double qmckl_context_get_epsilon(const qmckl_context context);
|
||||||
# Source
|
# Source
|
||||||
#+begin_src c :tangle (eval c)
|
#+begin_src c :tangle (eval c)
|
||||||
double qmckl_context_get_epsilon(const qmckl_context context) {
|
double qmckl_context_get_epsilon(const qmckl_context context) {
|
||||||
const qmckl_context_struct* ctx = (qmckl_context_struct*) context;
|
const int precision = qmckl_context_get_precision(context);
|
||||||
return 1. / (double) (1 << (1 - ctx->fp->precision));
|
return 1. / (double) (1L << (precision-1));
|
||||||
}
|
}
|
||||||
#+end_src
|
#+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));
|
basis->shell_center = (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t));
|
||||||
if (basis->shell_center == NULL) {
|
if (basis->shell_center == NULL) {
|
||||||
qmckl_free(context, basis);
|
qmckl_free(context, basis);
|
||||||
|
basis = NULL;
|
||||||
return QMCKL_FAILURE;
|
return QMCKL_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
basis->shell_ang_mom = (int32_t*) qmckl_malloc (context, 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) {
|
if (basis->shell_ang_mom == NULL) {
|
||||||
qmckl_free(context, basis->shell_center);
|
qmckl_free(context, basis->shell_center);
|
||||||
|
basis->shell_center = NULL;
|
||||||
qmckl_free(context, basis);
|
qmckl_free(context, basis);
|
||||||
|
basis = NULL;
|
||||||
return QMCKL_FAILURE;
|
return QMCKL_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
basis->shell_prim_num= (int64_t*) qmckl_malloc (context, 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) {
|
if (basis->shell_prim_num == NULL) {
|
||||||
qmckl_free(context, basis->shell_ang_mom);
|
qmckl_free(context, basis->shell_ang_mom);
|
||||||
|
basis->shell_ang_mom = NULL;
|
||||||
qmckl_free(context, basis->shell_center);
|
qmckl_free(context, basis->shell_center);
|
||||||
|
basis->shell_center = NULL;
|
||||||
qmckl_free(context, basis);
|
qmckl_free(context, basis);
|
||||||
|
basis = NULL;
|
||||||
return QMCKL_FAILURE;
|
return QMCKL_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double ));
|
basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double ));
|
||||||
if (basis->shell_factor == NULL) {
|
if (basis->shell_factor == NULL) {
|
||||||
qmckl_free(context, basis->shell_prim_num);
|
qmckl_free(context, basis->shell_prim_num);
|
||||||
|
basis->shell_prim_num = NULL;
|
||||||
qmckl_free(context, basis->shell_ang_mom);
|
qmckl_free(context, basis->shell_ang_mom);
|
||||||
|
basis->shell_ang_mom = NULL;
|
||||||
qmckl_free(context, basis->shell_center);
|
qmckl_free(context, basis->shell_center);
|
||||||
|
basis->shell_center = NULL;
|
||||||
qmckl_free(context, basis);
|
qmckl_free(context, basis);
|
||||||
|
basis = NULL;
|
||||||
return QMCKL_FAILURE;
|
return QMCKL_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double ));
|
basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double ));
|
||||||
if (basis->exponent == NULL) {
|
if (basis->exponent == NULL) {
|
||||||
qmckl_free(context, basis->shell_factor);
|
qmckl_free(context, basis->shell_factor);
|
||||||
|
basis->shell_factor = NULL;
|
||||||
qmckl_free(context, basis->shell_prim_num);
|
qmckl_free(context, basis->shell_prim_num);
|
||||||
|
basis->shell_prim_num = NULL;
|
||||||
qmckl_free(context, basis->shell_ang_mom);
|
qmckl_free(context, basis->shell_ang_mom);
|
||||||
|
basis->shell_ang_mom = NULL;
|
||||||
qmckl_free(context, basis->shell_center);
|
qmckl_free(context, basis->shell_center);
|
||||||
|
basis->shell_center = NULL;
|
||||||
qmckl_free(context, basis);
|
qmckl_free(context, basis);
|
||||||
|
basis = NULL;
|
||||||
return QMCKL_FAILURE;
|
return QMCKL_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double ));
|
basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double ));
|
||||||
if (basis->coefficient == NULL) {
|
if (basis->coefficient == NULL) {
|
||||||
qmckl_free(context, basis->exponent);
|
qmckl_free(context, basis->exponent);
|
||||||
|
basis->exponent = NULL;
|
||||||
qmckl_free(context, basis->shell_factor);
|
qmckl_free(context, basis->shell_factor);
|
||||||
|
basis->shell_factor = NULL;
|
||||||
qmckl_free(context, basis->shell_prim_num);
|
qmckl_free(context, basis->shell_prim_num);
|
||||||
|
basis->shell_prim_num = NULL;
|
||||||
qmckl_free(context, basis->shell_ang_mom);
|
qmckl_free(context, basis->shell_ang_mom);
|
||||||
|
basis->shell_ang_mom = NULL;
|
||||||
qmckl_free(context, basis->shell_center);
|
qmckl_free(context, basis->shell_center);
|
||||||
|
basis->shell_center = NULL;
|
||||||
qmckl_free(context, basis);
|
qmckl_free(context, basis);
|
||||||
|
basis = NULL;
|
||||||
return QMCKL_FAILURE;
|
return QMCKL_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -19,6 +19,10 @@
|
||||||
MunitResult test_<<filename()>>() {
|
MunitResult test_<<filename()>>() {
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src c :comments org :tangle (eval h)
|
||||||
|
#include <errno.h>
|
||||||
|
#include <string.h>
|
||||||
|
#+end_src
|
||||||
*
|
*
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:UNNUMBERED: t
|
:UNNUMBERED: t
|
||||||
|
|
|
@ -8,70 +8,81 @@
|
||||||
|
|
||||||
First, we use a script to find the list of all the generated test files:
|
First, we use a script to find the list of all the generated test files:
|
||||||
#+NAME: test-files
|
#+NAME: test-files
|
||||||
#+begin_src sh :exports none :results value
|
#+begin_src sh :exports none
|
||||||
grep begin_src *.org | \
|
FILES=$(cat table_of_contents)
|
||||||
grep test_qmckl_ | \
|
grep begin_src $FILES \
|
||||||
rev | \
|
| grep c_test \
|
||||||
cut -d ' ' -f 1 | \
|
| cut -d '.' -f 1 \
|
||||||
rev | \
|
| uniq
|
||||||
sort | \
|
|
||||||
uniq
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+RESULTS: test-files
|
#+RESULTS: test-files
|
||||||
| test_qmckl_ao.c |
|
| qmckl_error |
|
||||||
| test_qmckl_context.c |
|
| qmckl_context |
|
||||||
| test_qmckl_distance.c |
|
| qmckl_memory |
|
||||||
| test_qmckl_memory.c |
|
| qmckl_distance |
|
||||||
|
| qmckl_ao |
|
||||||
|
|
||||||
We generate the function headers
|
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 "#+NAME: headers"
|
||||||
echo "#+begin_src c :tangle no"
|
echo "#+begin_src c :tangle no"
|
||||||
for file in $files
|
for file in $files
|
||||||
do
|
do
|
||||||
routine=${file%.c}
|
routine=test_${file%.c}
|
||||||
echo "MunitResult ${routine}();"
|
echo "MunitResult ${routine}();"
|
||||||
done
|
done
|
||||||
echo "#+end_src"
|
echo "#+end_src"
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+RESULTS:
|
#+RESULTS:
|
||||||
|
:results:
|
||||||
#+NAME: headers
|
#+NAME: headers
|
||||||
#+begin_src c :tangle no
|
#+begin_src c :tangle no
|
||||||
MunitResult test_qmckl_ao();
|
MunitResult test_qmckl_error();
|
||||||
MunitResult test_qmckl_context();
|
MunitResult test_qmckl_context();
|
||||||
MunitResult test_qmckl_distance();
|
|
||||||
MunitResult test_qmckl_memory();
|
MunitResult test_qmckl_memory();
|
||||||
|
MunitResult test_qmckl_distance();
|
||||||
|
MunitResult test_qmckl_ao();
|
||||||
#+end_src
|
#+end_src
|
||||||
|
:end:
|
||||||
|
|
||||||
and the required function calls:
|
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 "#+NAME: calls"
|
||||||
echo "#+begin_src c :tangle no"
|
echo "#+begin_src c :tangle no"
|
||||||
for file in $files
|
for file in $files
|
||||||
do
|
do
|
||||||
routine=${file%.c}
|
routine=test_${file%.c}
|
||||||
echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},"
|
echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},"
|
||||||
done
|
done
|
||||||
echo "#+end_src"
|
echo "#+end_src"
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+RESULTS:
|
#+RESULTS:
|
||||||
|
:results:
|
||||||
#+NAME: calls
|
#+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_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_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_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_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
|
#+begin_src c :comments link :noweb yes :tangle test_qmckl.c
|
||||||
#include "qmckl.h"
|
#include "qmckl.h"
|
||||||
#include "munit.h"
|
#include "munit.h"
|
||||||
|
#include "mcheck.h"
|
||||||
<<headers>>
|
<<headers>>
|
||||||
|
|
||||||
int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) {
|
int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) {
|
||||||
|
mtrace();
|
||||||
static MunitTest test_suite_tests[] =
|
static MunitTest test_suite_tests[] =
|
||||||
{
|
{
|
||||||
<<calls>>
|
<<calls>>
|
||||||
|
@ -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
|
(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
|
#+end_src
|
||||||
|
|
|
@ -246,13 +246,13 @@ ${QMCKL_ROOT}/tools/tangle.sh *.org
|
||||||
functions:
|
functions:
|
||||||
|
|
||||||
#+begin_src bash
|
#+begin_src bash
|
||||||
OBJECTS=""
|
OBJECTS="qmckl_f.o"
|
||||||
for i in $(ls qmckl_*.c) ; do
|
for i in $(ls qmckl_*.c) ; do
|
||||||
FILE=${i%.c}
|
FILE=${i%.c}
|
||||||
OBJECTS="${OBJECTS} ${FILE}.o"
|
OBJECTS="${OBJECTS} ${FILE}.o"
|
||||||
done >> $OUTPUT
|
done >> $OUTPUT
|
||||||
|
|
||||||
for i in $(ls qmckl_*_f.f90) ; do
|
for i in $(ls qmckl*_f.f90) ; do
|
||||||
FILE=${i%.f90}
|
FILE=${i%.f90}
|
||||||
OBJECTS="${OBJECTS} ${FILE}.o"
|
OBJECTS="${OBJECTS} ${FILE}.o"
|
||||||
done >> $OUTPUT
|
done >> $OUTPUT
|
||||||
|
@ -299,13 +299,14 @@ libqmckl.so: \$(OBJECT_FILES)
|
||||||
%.o: %.c
|
%.o: %.c
|
||||||
\$(CC) \$(CFLAGS) -c \$*.c -o \$*.o
|
\$(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
|
%.o: %.f90 qmckl_f.o
|
||||||
\$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.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)
|
test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F)
|
||||||
\$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \
|
\$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \
|
||||||
|
|
|
@ -28,13 +28,13 @@ ${QMCKL_ROOT}/tools/tangle.sh *.org
|
||||||
# functions:
|
# functions:
|
||||||
|
|
||||||
|
|
||||||
OBJECTS=""
|
OBJECTS="qmckl_f.o"
|
||||||
for i in $(ls qmckl_*.c) ; do
|
for i in $(ls qmckl_*.c) ; do
|
||||||
FILE=${i%.c}
|
FILE=${i%.c}
|
||||||
OBJECTS="${OBJECTS} ${FILE}.o"
|
OBJECTS="${OBJECTS} ${FILE}.o"
|
||||||
done >> $OUTPUT
|
done >> $OUTPUT
|
||||||
|
|
||||||
for i in $(ls qmckl_*_f.f90) ; do
|
for i in $(ls qmckl*_f.f90) ; do
|
||||||
FILE=${i%.f90}
|
FILE=${i%.f90}
|
||||||
OBJECTS="${OBJECTS} ${FILE}.o"
|
OBJECTS="${OBJECTS} ${FILE}.o"
|
||||||
done >> $OUTPUT
|
done >> $OUTPUT
|
||||||
|
@ -84,13 +84,14 @@ libqmckl.so: \$(OBJECT_FILES)
|
||||||
%.o: %.c
|
%.o: %.c
|
||||||
\$(CC) \$(CFLAGS) -c \$*.c -o \$*.o
|
\$(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
|
%.o: %.f90 qmckl_f.o
|
||||||
\$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.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)
|
test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F)
|
||||||
\$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \
|
\$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \
|
||||||
|
|
Loading…
Reference in New Issue
Block a user