1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-11-03 20:54:09 +01:00
qmckl/org/qmckl_ao.org

7371 lines
254 KiB
Org Mode
Raw Permalink Normal View History

2022-01-06 00:51:42 +01:00
#+TITLE: Atomic Orbitals
2021-04-30 01:26:19 +02:00
#+SETUPFILE: ../tools/theme.setup
2021-04-09 11:26:04 +02:00
#+INCLUDE: ../tools/lib.org
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
* Introduction
2021-04-01 01:19:33 +02:00
The atomic basis set is defined as a list of shells. Each shell $s$ is
centered on a nucleus $A$, possesses a given angular momentum $l$ and a
radial function $R_s$. The radial function is a linear combination of
2022-01-05 12:26:11 +01:00
/primitive/ functions that can be of type Slater ($p=1$) or
2021-04-01 01:19:33 +02:00
Gaussian ($p=2$):
\[
R_s(\mathbf{r}) = \mathcal{N}_s |\mathbf{r}-\mathbf{R}_A|^{n_s}
2021-06-03 18:26:00 +02:00
\sum_{k=1}^{N_{\text{prim}}} a_{ks}\, f_{ks}
2021-04-30 01:26:19 +02:00
\exp \left( - \gamma_{ks} | \mathbf{r}-\mathbf{R}_A | ^p \right).
2021-04-01 01:19:33 +02:00
\]
2022-01-05 12:26:11 +01:00
In the case of Gaussian functions, $n_s$ is always zero. The
2021-09-06 07:45:10 +02:00
normalization factor $\mathcal{N}_s$ ensures that all the functions of
the shell are normalized (integrate) to unity. Usually, basis sets are
given a combination of normalized primitives, so the normalization
2021-06-03 18:26:00 +02:00
coefficients of the primitives, $f_{ks}$, need also to be provided.
2021-04-01 01:19:33 +02:00
Atomic orbitals (AOs) are defined as
\[
2021-06-03 18:26:00 +02:00
\chi_i (\mathbf{r}) = \mathcal{M}_i\, P_{\eta(i)}(\mathbf{r})\, R_{\theta(i)} (\mathbf{r})
2021-04-01 01:19:33 +02:00
\]
2021-04-30 01:26:19 +02:00
2021-09-06 07:45:10 +02:00
where $\theta(i)$ returns the shell on which the AO is expanded, and
$\eta(i)$ denotes which angular function is chosen and $P$ are the
generating functions of the given angular momentum $\eta(i)$. Here,
the parameter $\mathcal{M}_i$ is an extra parameter which allows the
normalization of the different functions of the same shell to be
2021-06-03 18:26:00 +02:00
different, as in GAMESS for example.
2021-04-01 01:19:33 +02:00
2021-06-03 18:26:00 +02:00
In this section we describe first how the basis set is stored in the
context, and then we present the kernels used to compute the values,
2021-04-01 01:19:33 +02:00
gradients and Laplacian of the atomic basis functions.
* Headers :noexport:
2021-04-30 01:26:19 +02:00
#+begin_src elisp :noexport :results none
2021-04-16 00:57:08 +02:00
(org-babel-lob-ingest "../tools/lib.org")
2021-05-09 02:12:38 +02:00
#+end_src
2021-04-16 00:57:08 +02:00
2021-04-01 01:19:33 +02:00
2021-10-14 21:40:14 +02:00
#+begin_src c :tangle (eval h_private_func)
#ifndef QMCKL_AO_HPF
#define QMCKL_AO_HPF
2022-03-21 18:32:39 +01:00
#include "qmckl_blas_private_type.h"
2021-10-14 21:40:14 +02:00
#+end_src
2021-04-01 01:19:33 +02:00
#+begin_src c :tangle (eval h_private_type)
#ifndef QMCKL_AO_HPT
#define QMCKL_AO_HPT
2021-05-09 02:12:38 +02:00
2021-04-21 01:56:47 +02:00
#include <stdbool.h>
2022-02-27 23:31:52 +01:00
#include <stdio.h>
2022-03-21 18:32:39 +01:00
#include "qmckl_blas_private_type.h"
2021-04-01 01:19:33 +02:00
#+end_src
#+begin_src f90 :tangle (eval f) :noweb yes
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#+end_src
2021-04-01 01:19:33 +02:00
#+begin_src c :tangle (eval c_test) :noweb yes
#include "qmckl.h"
2021-05-11 16:41:03 +02:00
#include "assert.h"
2021-05-10 10:05:50 +02:00
#ifdef HAVE_CONFIG_H
2021-05-11 16:41:03 +02:00
#include "config.h"
2021-05-09 02:12:38 +02:00
#endif
2021-06-22 23:33:09 +02:00
#include <stdio.h>
2021-06-10 22:57:59 +02:00
#include <math.h>
2022-02-16 15:14:41 +01:00
#include <string.h>
2021-06-03 22:34:23 +02:00
#include "chbrclf.h"
2021-07-11 23:20:40 +02:00
#include "qmckl_ao_private_func.h"
2021-06-03 22:34:23 +02:00
2021-05-11 16:41:03 +02:00
int main() {
qmckl_context context;
context = qmckl_context_create();
2021-04-01 01:19:33 +02:00
#+end_src
#+begin_src c :tangle (eval c)
2021-05-10 10:05:50 +02:00
#ifdef HAVE_CONFIG_H
2021-05-10 10:41:59 +02:00
#include "config.h"
2021-05-09 02:12:38 +02:00
#endif
2021-05-10 10:05:50 +02:00
#ifdef HAVE_STDINT_H
2021-04-01 01:19:33 +02:00
#include <stdint.h>
2021-05-10 10:05:50 +02:00
#elif HAVE_INTTYPES_H
#include <inttypes.h>
#endif
2021-04-01 01:19:33 +02:00
#include <stdlib.h>
#include <string.h>
2021-04-21 01:56:47 +02:00
#include <stdbool.h>
2021-04-01 01:19:33 +02:00
#include <assert.h>
2022-02-16 00:21:37 +01:00
#include <stdio.h>
#include <math.h>
2021-04-01 01:19:33 +02:00
2021-05-11 13:57:23 +02:00
#include "qmckl.h"
2021-04-01 01:19:33 +02:00
#include "qmckl_context_private_type.h"
#include "qmckl_memory_private_type.h"
2022-03-21 18:32:39 +01:00
#include "qmckl_blas_private_type.h"
2021-04-01 01:19:33 +02:00
#include "qmckl_memory_private_func.h"
2021-06-10 22:57:59 +02:00
#include "qmckl_ao_private_type.h"
#include "qmckl_ao_private_func.h"
2022-06-29 13:31:58 +02:00
2021-04-01 01:19:33 +02:00
#+end_src
2024-01-11 14:33:40 +01:00
#+NAME:fortran_cutoff
#+begin_src fortran
cutoff = qmckl_get_numprec_precision(context)
cutoff = dlog(2.d0**(cutoff-2))
#+end_src
2021-04-01 01:19:33 +02:00
* Context
2022-01-05 15:56:25 +01:00
** Constant data
2022-01-06 02:28:13 +01:00
2022-01-05 15:56:25 +01:00
The following arrays are stored in the context, and need to be set
when initializing the library:
#+NAME: constant_data
2023-03-13 17:06:41 +01:00
|---------------------------+-----------------------+----------------------------------------------------------------------|
| Variable | Type | Description |
|---------------------------+-----------------------+----------------------------------------------------------------------|
| ~type~ | ~char~ | Gaussian (~'G'~) or Slater (~'S'~) |
| ~shell_num~ | ~int64_t~ | Number of shells |
| ~prim_num~ | ~int64_t~ | Total number of primitives |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | Index of the first shell of each nucleus |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | Number of shells per nucleus |
| ~shell_ang_mom~ | ~int32_t[shell_num]~ | Angular momentum of each shell |
| ~shell_prim_num~ | ~int64_t[shell_num]~ | Number of primitives in each shell |
| ~shell_prim_index~ | ~int64_t[shell_num]~ | Address of the first primitive of each shell in the ~EXPONENT~ array |
| ~shell_factor~ | ~double[shell_num]~ | Normalization factor for each shell |
| ~exponent~ | ~double[prim_num]~ | Array of exponents |
| ~coefficient~ | ~double[prim_num]~ | Array of coefficients |
| ~prim_factor~ | ~double[prim_num]~ | Normalization factors of the primtives |
| ~ao_num~ | ~int64_t~ | Number of AOs |
| ~ao_cartesian~ | ~bool~ | If true, use polynomials. Otherwise, use spherical harmonics |
| ~ao_factor~ | ~double[ao_num]~ | Normalization factor of the AO |
|---------------------------+-----------------------+----------------------------------------------------------------------|
The following data is computed when the basis is finalized:
2023-11-30 12:56:06 +01:00
|---------------------------+-----------------------+-------------------------------------------------------------------------------------------------|
| Variable | Type | Description |
|---------------------------+-----------------------+-------------------------------------------------------------------------------------------------|
| ~nucleus_prim_index~ | ~int64_t[nucl_num+1]~ | Index of the first primitive of each nucleus |
| ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | Maximum angular momentum of each nucleus |
| ~coefficient_normalized~~ | ~double[prim_num]~ | Normalized array of coefficients |
| ~ao_ang_mom~ | ~int32_t[ao_num]~ | Angular momentum of the shell to which the AO belongs |
| ~ao_nucl~ | ~int64_t[ao_num]~ | Nucleus on which the AO is centered |
| ~nucleus_range~ | ~double[nucl_num]~ | Used to compute the distance beyond which all Gaussian AOs are zero, depending on the precision |
|---------------------------+-----------------------+-------------------------------------------------------------------------------------------------|
2022-01-05 15:56:25 +01:00
For H_2 with the following basis set,
2022-01-06 02:28:13 +01:00
2022-01-05 15:56:25 +01:00
#+NAME: basis
#+BEGIN_EXAMPLE
2021-04-01 01:19:33 +02:00
HYDROGEN
S 5
2022-01-05 12:26:11 +01:00
1 3.387000E+01 6.068000E-03
2 5.095000E+00 4.530800E-02
3 1.159000E+00 2.028220E-01
4 3.258000E-01 5.039030E-01
5 1.027000E-01 3.834210E-01
2021-04-01 01:19:33 +02:00
S 1
2022-01-05 12:26:11 +01:00
1 3.258000E-01 1.000000E+00
2021-04-01 01:19:33 +02:00
S 1
2022-01-05 12:26:11 +01:00
1 1.027000E-01 1.000000E+00
2021-04-01 01:19:33 +02:00
P 1
2022-01-05 12:26:11 +01:00
1 1.407000E+00 1.000000E+00
2021-04-01 01:19:33 +02:00
P 1
2022-01-05 12:26:11 +01:00
1 3.880000E-01 1.000000E+00
2021-04-01 01:19:33 +02:00
D 1
2022-01-05 12:26:11 +01:00
1 1.057000E+00 1.0000000
2022-01-05 15:56:25 +01:00
#+END_EXAMPLE
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
we have:
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+NAME: params
#+BEGIN_EXAMPLE
2021-04-01 01:19:33 +02:00
type = 'G'
shell_num = 12
prim_num = 20
2023-05-02 14:24:30 +02:00
ao_num = 30
2022-01-05 12:26:11 +01:00
2021-06-10 00:10:19 +02:00
nucleus_index = [0 , 6]
2022-01-05 12:26:11 +01:00
2021-06-03 18:26:00 +02:00
shell_ang_mom = [0, 0, 0, 1, 1, 2, 0, 0, 0, 1, 1, 2]
2021-04-01 01:19:33 +02:00
shell_factor = [ 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.]
shell_prim_num = [5, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1]
2021-06-10 00:10:19 +02:00
shell_prim_index = [0 , 5 , 6 , 7 , 8 , 9 , 10, 15, 16, 17, 18, 19]
2022-01-05 12:26:11 +01:00
2021-06-03 18:26:00 +02:00
exponent = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, 1.407,
0.388, 1.057, 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, 1.407,
0.388, 1.057]
2022-01-05 12:26:11 +01:00
2021-06-03 18:26:00 +02:00
coefficient = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, 1.0, 1.0,
1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, 1.0, 1.0,
1.0, 1.0, 1.0]
2022-01-05 12:26:11 +01:00
2021-06-03 18:26:00 +02:00
prim_factor = [ 1.0006253235944540e+01, 2.4169531573445120e+00, 7.9610924849766440e-01
3.0734305383061117e-01, 1.2929684417481876e-01, 3.0734305383061117e-01,
1.2929684417481876e-01, 2.1842769845268308e+00, 4.3649547399719840e-01,
1.8135965626177861e+00, 1.0006253235944540e+01, 2.4169531573445120e+00,
7.9610924849766440e-01, 3.0734305383061117e-01, 1.2929684417481876e-01,
3.0734305383061117e-01, 1.2929684417481876e-01, 2.1842769845268308e+00,
4.3649547399719840e-01, 1.8135965626177861e+00 ]
2022-01-05 15:56:25 +01:00
#+END_EXAMPLE
A scalar variable ~$V$~ present in this table can be set or get by
2022-01-06 02:28:13 +01:00
calling the functions:
2022-01-05 15:56:25 +01:00
#+NAME: template_scalar_c
#+begin_src C :tangle no
qmckl_exit_code qmckl_set_ao_basis_$V$ ( qmckl_context context,
const $type_of_V$ $V$);
qmckl_exit_code qmckl_get_ao_basis_$V$ ( const qmckl_context context,
$type_of_V$ const $V$);
#+end_src
#+begin_src f90 :tangle no
interface
integer(c_int32_t) function qmckl_set_ao_basis_$V$ (context, $V$) &
bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
$f_type_of_V$ , intent(in) , value :: $V$
end function qmckl_set_ao_basis_$V$
end interface
interface
integer(c_int32_t) function qmckl_get_ao_basis_$V$ (context, $V$) &
bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
$f_type_of_V$ , intent(out) :: $V$
end function qmckl_get_ao_basis_$V$
end interface
#+end_src
For array variables, use the rule:
#+NAME: template_array_c
#+begin_src C :tangle no
qmckl_exit_code qmckl_set_ao_basis_$V$ ( qmckl_context context,
const $type_of_V$ $V$,
const int64_t size_max);
qmckl_exit_code qmckl_get_ao_basis_$V$ ( const qmckl_context context,
$type_of_V$ const $V$,
const int64_t size_max);
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src f90 :tangle no
interface
integer(c_int32_t) function qmckl_set_ao_basis_$V$ (context, &
$V$, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
$f_type_of_V$ , intent(in) , value :: $V$
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_$V$
end interface
interface
integer(c_int32_t) function qmckl_get_ao_basis_$V$ (context, &
$V$, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
$f_type_of_V$ , intent(out) :: $V$
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_get_ao_basis_$V$
end interface
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
*** Data structure :noexport:
2022-02-25 20:39:20 +01:00
#+begin_src c :comments org :tangle (eval h_private_type) :noweb yes
2021-04-01 01:19:33 +02:00
typedef struct qmckl_ao_basis_struct {
2022-03-21 18:32:39 +01:00
int64_t shell_num;
int64_t prim_num;
int64_t ao_num;
int64_t * restrict nucleus_index;
int64_t * restrict nucleus_shell_num;
int32_t * restrict shell_ang_mom;
int64_t * restrict shell_prim_num;
int64_t * restrict shell_prim_index;
double * restrict shell_factor;
double * restrict exponent;
double * restrict coefficient;
double * restrict prim_factor;
double * restrict ao_factor;
2023-03-13 17:06:41 +01:00
int64_t * restrict ao_nucl;
int32_t * restrict ao_ang_mom;
2022-03-21 18:32:39 +01:00
int64_t * restrict nucleus_prim_index;
double * restrict coefficient_normalized;
int32_t * restrict nucleus_max_ang_mom;
double * restrict nucleus_range;
double * restrict primitive_vgl;
uint64_t primitive_vgl_date;
double * restrict shell_vgl;
uint64_t shell_vgl_date;
double * restrict ao_vgl;
uint64_t ao_vgl_date;
2022-05-10 19:18:19 +02:00
double * restrict ao_value;
uint64_t ao_value_date;
2022-03-21 18:32:39 +01:00
int32_t uninitialized;
bool provided;
bool ao_cartesian;
char type;
2022-02-25 20:39:20 +01:00
#ifdef HAVE_HPC
<<HPC_struct>>
#endif
2021-04-01 01:19:33 +02:00
} qmckl_ao_basis_struct;
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
The ~uninitialized~ integer contains one bit set to one for each
initialization function which has not been called. It becomes equal
to zero after all initialization functions have been called. The
struct is then initialized and ~provided == true~.
Some values are initialized by default, and are not concerned by
this mechanism.
2021-04-30 01:26:19 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_private_func)
2021-06-10 22:57:59 +02:00
qmckl_exit_code qmckl_init_ao_basis(qmckl_context context);
2022-01-05 15:56:25 +01:00
#+end_src
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c)
2021-06-10 22:57:59 +02:00
qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) {
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_init_ao_basis",
NULL);
2021-06-10 22:57:59 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2021-06-10 22:57:59 +02:00
assert (ctx != NULL);
2021-07-09 00:45:17 +02:00
ctx->ao_basis.uninitialized = (1 << 14) - 1;
2021-06-10 22:57:59 +02:00
/* Default values */
2021-07-09 00:45:17 +02:00
ctx->ao_basis.ao_cartesian = true;
2021-06-10 22:57:59 +02:00
return QMCKL_SUCCESS;
}
2022-01-05 15:56:25 +01:00
#+end_src
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2022-01-05 15:56:25 +01:00
*** Initialization functions
2022-01-05 19:22:16 +01:00
~size_max~ is the dimension of the input array, which should be
equal of larger than the value given in the table of section [[Context]].
2022-01-05 15:56:25 +01:00
**** C interface
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+NAME:pre2
#+begin_src c :exports none
2022-01-05 12:26:11 +01:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_NULL_CONTEXT,
"qmckl_set_ao_*",
2022-01-05 12:26:11 +01:00
NULL);
}
2021-04-30 01:26:19 +02:00
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-07-09 11:34:38 +02:00
if (mask != 0 && !(ctx->ao_basis.uninitialized & mask)) {
return qmckl_failwith( context,
QMCKL_ALREADY_SET,
"qmckl_set_ao_*",
NULL);
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+NAME:post2
#+begin_src c :exports none
2022-01-05 12:26:11 +01:00
ctx->ao_basis.uninitialized &= ~mask;
ctx->ao_basis.provided = (ctx->ao_basis.uninitialized == 0);
if (ctx->ao_basis.provided) {
qmckl_exit_code rc_ = qmckl_finalize_basis(context);
if (rc_ != QMCKL_SUCCESS) return rc_;
}
return QMCKL_SUCCESS;
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-30 01:26:19 +02:00
2022-01-05 15:56:25 +01:00
To set the basis set, all the following functions need to be
called.
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_type (qmckl_context context,
const char basis_type);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_type(qmckl_context context,
const char basis_type)
2021-10-14 16:32:58 +02:00
{
int32_t mask = 1;
2022-01-05 12:26:11 +01:00
<<pre2>>
2021-04-01 01:19:33 +02:00
2022-01-06 02:28:13 +01:00
if (basis_type != 'G' && basis_type != 'S') {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_type",
2021-10-14 16:32:58 +02:00
NULL);
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
ctx->ao_basis.type = basis_type;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-06 02:28:13 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_num (qmckl_context context,
const int64_t shell_num);
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_num (qmckl_context context,
2022-01-06 02:28:13 +01:00
const int64_t shell_num)
2021-10-14 16:32:58 +02:00
{
int32_t mask = 1 << 1;
2022-01-05 12:26:11 +01:00
<<pre2>>
if (shell_num <= 0) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"shell_num <= 0");
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
const int64_t prim_num = ctx->ao_basis.prim_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (0L < prim_num && prim_num < shell_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"shell_num > prim_num");
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
ctx->ao_basis.shell_num = shell_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_prim_num (qmckl_context context,
const int64_t prim_num);
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_prim_num (qmckl_context context,
const int64_t prim_num)
2022-01-06 02:28:13 +01:00
{
int32_t mask = 1 << 2;
2022-01-05 12:26:11 +01:00
<<pre2>>
if (prim_num <= 0) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"prim_num must be positive");
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
const int64_t shell_num = ctx->ao_basis.shell_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (shell_num <= 0L) {
return qmckl_failwith( context,
QMCKL_FAILURE,
"qmckl_set_ao_basis_shell_num",
"shell_num is not set");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (prim_num < shell_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"prim_num < shell_num");
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
ctx->ao_basis.prim_num = prim_num;
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
qmckl_set_ao_basis_nucleus_shell_num (qmckl_context context,
const int64_t* nucleus_shell_num,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
qmckl_set_ao_basis_nucleus_shell_num (qmckl_context context,
const int64_t* nucleus_shell_num,
const int64_t size_max)
2022-01-06 02:28:13 +01:00
{
int32_t mask = 1 << 3;
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
<<pre2>>
2021-06-10 00:10:19 +02:00
2022-01-05 12:26:11 +01:00
const int64_t nucl_num = ctx->nucleus.num;
if (nucl_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_nucleus_shell_num",
"shell_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < nucl_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_set_ao_basis_nucleus_shell_num",
2022-01-05 12:26:11 +01:00
"input array too small");
2021-10-14 16:32:58 +02:00
}
if (ctx->ao_basis.nucleus_shell_num != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.nucleus_shell_num);
2022-01-05 12:26:11 +01:00
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_nucleus_shell_num",
2022-01-05 12:26:11 +01:00
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = nucl_num * sizeof(int64_t);
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_nucleus_shell_num",
2022-01-05 12:26:11 +01:00
NULL);
2021-06-10 00:10:19 +02:00
}
memcpy(new_array, nucleus_shell_num, mem_info.size);
2021-04-01 01:19:33 +02:00
ctx->ao_basis.nucleus_shell_num = new_array;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
qmckl_set_ao_basis_nucleus_index (qmckl_context context,
const int64_t* nucleus_index,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
qmckl_set_ao_basis_nucleus_index (qmckl_context context,
const int64_t* nucleus_index,
const int64_t size_max)
2021-10-14 16:32:58 +02:00
{
int32_t mask = 1 << 4;
2021-04-01 01:19:33 +02:00
<<pre2>>
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
const int64_t nucl_num = ctx->nucleus.num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (nucl_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_nucleus_index",
"nucl_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < nucl_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
QMCKL_FAILURE,
"qmckl_set_ao_basis_nucleus_index",
2022-01-05 12:26:11 +01:00
"input array too small");
2021-10-14 16:32:58 +02:00
}
if (ctx->ao_basis.nucleus_index != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.nucleus_index);
2022-01-05 12:26:11 +01:00
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_nucleus_index",
2022-01-05 12:26:11 +01:00
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = nucl_num * sizeof(int64_t);
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_nucleus_index",
2022-01-05 12:26:11 +01:00
NULL);
2021-04-01 01:19:33 +02:00
}
memcpy(new_array, nucleus_index, mem_info.size);
2021-04-01 01:19:33 +02:00
ctx->ao_basis.nucleus_index = new_array;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_ang_mom (qmckl_context context,
const int32_t* shell_ang_mom,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_ang_mom (qmckl_context context,
const int32_t* shell_ang_mom,
2022-01-06 02:28:13 +01:00
const int64_t size_max)
2021-10-14 16:32:58 +02:00
{
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 5;
2021-04-01 01:19:33 +02:00
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t shell_num = ctx->ao_basis.shell_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (shell_num == 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_shell_ang_mom",
"shell_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < shell_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_shell_ang_mom",
"input array too small");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.shell_ang_mom != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_ang_mom);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_shell_ang_mom",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = shell_num * sizeof(int32_t);
int32_t * new_array = (int32_t*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_shell_ang_mom",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
memcpy(new_array, shell_ang_mom, mem_info.size);
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
ctx->ao_basis.shell_ang_mom = new_array;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_prim_num (qmckl_context context,
const int64_t* shell_prim_num,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_prim_num (qmckl_context context,
const int64_t* shell_prim_num,
const int64_t size_max)
2021-10-14 16:32:58 +02:00
{
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 6;
2021-04-01 01:19:33 +02:00
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t shell_num = ctx->ao_basis.shell_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (shell_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_shell_prim_num",
"shell_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < shell_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_shell_prim_num",
"input array too small");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.shell_prim_num != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_prim_num);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_shell_prim_num",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = shell_num * sizeof(int64_t);
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_shell_prim_num",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
memcpy(new_array, shell_prim_num, mem_info.size);
ctx->ao_basis.shell_prim_num = new_array;
<<post2>>
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-03-21 18:32:39 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_prim_index (qmckl_context context,
const int64_t* shell_prim_index,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2022-03-21 18:32:39 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_prim_index (qmckl_context context,
const int64_t* shell_prim_index,
const int64_t size_max)
2021-10-14 16:32:58 +02:00
{
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 7;
2021-04-01 01:19:33 +02:00
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t shell_num = ctx->ao_basis.shell_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (shell_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_shell_prim_index",
"shell_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < shell_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_shell_prim_index",
"input array too small");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.shell_prim_index != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_prim_index);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_shell_prim_index",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = shell_num * sizeof(int64_t);
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_shell_prim_index",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
memcpy(new_array, shell_prim_index, mem_info.size);
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
ctx->ao_basis.shell_prim_index = new_array;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2022-03-21 18:32:39 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_factor (qmckl_context context,
const double* shell_factor,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2022-03-21 18:32:39 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_shell_factor (qmckl_context context,
const double* shell_factor,
const int64_t size_max)
2021-10-14 16:32:58 +02:00
{
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 8;
2021-04-01 01:19:33 +02:00
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t shell_num = ctx->ao_basis.shell_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (shell_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_shell_factor",
"shell_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < shell_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_shell_factor",
"input array too small");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.shell_factor != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.shell_factor);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_shell_factor",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = shell_num * sizeof(double);
double* new_array = (double*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_shell_factor",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
memcpy(new_array, shell_factor, mem_info.size);
ctx->ao_basis.shell_factor = new_array;
<<post2>>
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2022-03-21 18:32:39 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_exponent (qmckl_context context,
const double* exponent,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2022-03-21 18:32:39 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_exponent (qmckl_context context,
const double* exponent,
const int64_t size_max)
2021-10-14 16:32:58 +02:00
{
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 9;
2021-04-01 01:19:33 +02:00
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t prim_num = ctx->ao_basis.prim_num;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (prim_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_exponent",
"prim_num is not set");
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < prim_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_exponent",
"input array too small");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.exponent != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.exponent);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_exponent",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = prim_num * sizeof(double);
double* new_array = (double*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_exponent",
NULL);
2021-10-14 16:32:58 +02:00
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
memcpy(new_array, exponent, mem_info.size);
ctx->ao_basis.exponent = new_array;
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_coefficient (qmckl_context context,
const double* coefficient,
2021-10-14 16:32:58 +02:00
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_coefficient (qmckl_context context,
const double* coefficient,
2021-10-14 16:32:58 +02:00
const int64_t size_max)
{
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 10;
2021-06-03 18:26:00 +02:00
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t prim_num = ctx->ao_basis.prim_num;
2021-06-03 18:26:00 +02:00
2022-01-05 12:26:11 +01:00
if (prim_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_coefficient",
"prim_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < prim_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_coefficient",
"input array too small");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.coefficient != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.coefficient);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_coefficient",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = prim_num * sizeof(double);
double* new_array = (double*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_coefficient",
NULL);
2021-06-03 18:26:00 +02:00
}
2022-01-05 12:26:11 +01:00
memcpy(new_array, coefficient, mem_info.size);
2021-06-03 18:26:00 +02:00
2022-01-05 12:26:11 +01:00
ctx->ao_basis.coefficient = new_array;
2021-06-03 18:26:00 +02:00
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_prim_factor (qmckl_context context,
const double* prim_factor,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_prim_factor (qmckl_context context,
const double* prim_factor,
const int64_t size_max)
2021-10-14 16:32:58 +02:00
{
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 11;
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t prim_num = ctx->ao_basis.prim_num;
if (prim_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_prim_factor",
"prim_num is not set");
2021-07-09 00:45:17 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < prim_num) {
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_prim_factor",
"input array too small");
}
2021-07-09 00:45:17 +02:00
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.prim_factor != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.prim_factor);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_prim_factor",
NULL);
}
}
2021-07-09 00:45:17 +02:00
2022-01-05 12:26:11 +01:00
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = prim_num * sizeof(double);
double* new_array = (double*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_prim_factor",
2021-10-14 16:32:58 +02:00
NULL);
2021-07-09 00:45:17 +02:00
}
2022-01-05 12:26:11 +01:00
memcpy(new_array, prim_factor, mem_info.size);
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
ctx->ao_basis.prim_factor = new_array;
<<post2>>
2021-07-09 00:45:17 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-07-09 00:45:17 +02:00
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_ao_basis_ao_num (qmckl_context context,
const int64_t ao_num);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_set_ao_basis_ao_num (qmckl_context context,
const int64_t ao_num)
{
int32_t mask = 1 << 12;
<<pre2>>
if (ao_num <= 0) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"ao_num must be positive");
}
const int64_t shell_num = ctx->ao_basis.shell_num;
if (shell_num <= 0L) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"shell_num is not set");
}
if (ao_num < shell_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_set_ao_basis_shell_num",
"ao_num < shell_num");
}
ctx->ao_basis.ao_num = ao_num;
<<post2>>
}
#+end_src
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_set_ao_basis_ao_factor (qmckl_context context,
const double* ao_factor,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-10-14 16:32:58 +02:00
qmckl_exit_code
2022-01-05 12:26:11 +01:00
qmckl_set_ao_basis_ao_factor (qmckl_context context,
const double* ao_factor,
2021-10-14 16:32:58 +02:00
const int64_t size_max)
2022-01-06 02:28:13 +01:00
{
2021-07-09 00:45:17 +02:00
int32_t mask = 1 << 13;
<<pre2>>
2022-01-05 12:26:11 +01:00
const int64_t ao_num = ctx->ao_basis.ao_num;
if (ao_num <= 0L) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_FAILURE,
"qmckl_set_ao_basis_ao_factor",
"ao_num is not set");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < ao_num) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 12:26:11 +01:00
"qmckl_set_ao_basis_ao_factor",
"input array too small");
2021-10-14 16:32:58 +02:00
}
2022-01-05 12:26:11 +01:00
if (ctx->ao_basis.ao_factor != NULL) {
qmckl_exit_code rc = qmckl_free(context, ctx->ao_basis.ao_factor);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc,
"qmckl_set_ao_basis_ao_factor",
NULL);
}
}
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ao_num * sizeof(double);
double* new_array = (double*) qmckl_malloc(context, mem_info);
if (new_array == NULL) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_ALLOCATION_FAILED,
"qmckl_set_ao_basis_ao_factor",
NULL);
2021-07-09 00:45:17 +02:00
}
2022-01-05 12:26:11 +01:00
memcpy(new_array, ao_factor, mem_info.size);
ctx->ao_basis.ao_factor = new_array;
<<post2>>
2021-07-09 00:45:17 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_set_ao_basis_cartesian (qmckl_context context,
const bool cartesian);
2022-01-05 15:56:25 +01:00
#+end_src
2021-07-09 00:45:17 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_set_ao_basis_cartesian (qmckl_context context,
const bool cartesian)
{
int32_t mask = 1;
2022-01-05 12:26:11 +01:00
<<pre2>>
2021-07-09 00:45:17 +02:00
2022-01-06 02:28:13 +01:00
ctx->ao_basis.ao_cartesian = cartesian;
2022-01-05 12:26:11 +01:00
<<post2>>
}
2022-01-05 15:56:25 +01:00
#+end_src
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
**** Fortran interface
#+begin_src f90 :tangle (eval fh_func) :comments org
interface
integer(c_int32_t) function qmckl_set_ao_basis_type (context, &
basis_type) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
character(c_char) , intent(in) , value :: basis_type
end function qmckl_set_ao_basis_type
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_shell_num(context, &
num) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: num
end function qmckl_set_ao_basis_shell_num
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_prim_num(context, &
num) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: num
end function qmckl_set_ao_basis_prim_num
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_index(context, &
idx, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) :: idx(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_nucleus_index
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_shell_num(context, &
shell_num, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) :: shell_num(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_nucleus_shell_num
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_shell_ang_mom(context, &
shell_ang_mom, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int32_t) , intent(in) :: shell_ang_mom(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_shell_ang_mom
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_shell_prim_num(context, &
shell_prim_num, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) :: shell_prim_num(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_shell_prim_num
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_shell_prim_index(context, &
shell_prim_index, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) :: shell_prim_index(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_shell_prim_index
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_shell_factor(context, &
shell_factor, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: shell_factor(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_shell_factor
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_exponent(context, &
exponent, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: exponent(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_exponent
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_coefficient(context, &
coefficient, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: coefficient(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_coefficient
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_prim_factor(context, &
prim_factor, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: prim_factor(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_prim_factor
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_ao_num(context, &
num) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: num
end function qmckl_set_ao_basis_ao_num
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_cartesian(context, &
cartesian) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
logical (c_bool) , intent(in) , value :: cartesian
end function qmckl_set_ao_basis_cartesian
end interface
interface
integer(c_int32_t) function qmckl_set_ao_basis_ao_factor(context, &
ao_factor, size_max) bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: ao_factor(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_set_ao_basis_ao_factor
end interface
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
*** Access functions
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
~size_max~ is the dimension of the input array, which should be
2022-01-05 19:22:16 +01:00
equal of larger than the value given in the table of section [[Context]].
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
**** C interface
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_type (const qmckl_context context,
2022-01-06 02:28:13 +01:00
char* const basis_type);
2022-01-05 15:56:25 +01:00
#+end_src
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_type (const qmckl_context context,
char* const basis_type)
{
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_type",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1;
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_type",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.type != (char) 0);
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
basis_type[0] = ctx->ao_basis.type;
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-30 01:26:19 +02:00
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_num (const qmckl_context context,
int64_t* const shell_num);
2022-01-05 15:56:25 +01:00
#+end_src
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_num (const qmckl_context context,
int64_t* const shell_num)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_shell_factor",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 1;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_shell_num",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.shell_num > (int64_t) 0);
,*shell_num = ctx->ao_basis.shell_num;
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_prim_num (const qmckl_context context,
int64_t* const prim_num);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_prim_num (const qmckl_context context,
int64_t* const prim_num)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_prim_num",
NULL);
2021-06-10 00:10:19 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-06-10 00:10:19 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 2;
2021-06-10 00:10:19 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-06-10 00:10:19 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_prim_num",
2021-06-10 00:10:19 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.prim_num > (int64_t) 0);
2021-06-10 00:10:19 +02:00
2022-01-05 12:26:11 +01:00
,*prim_num = ctx->ao_basis.prim_num;
return QMCKL_SUCCESS;
2021-06-10 00:10:19 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-06-10 00:10:19 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_nucleus_shell_num (const qmckl_context context,
int64_t* const nucleus_shell_num,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_nucleus_shell_num (const qmckl_context context,
int64_t* const nucleus_shell_num,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-06-10 00:10:19 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_nucleus_shell_num",
NULL);
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 3;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_nucleus_shell_num",
2021-04-01 01:19:33 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
if (nucleus_shell_num == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_nucleus_shell_num",
"NULL pointer");
}
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->nucleus.num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_nucleus_shell_num",
"Array too small. Expected nucl_num");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.nucleus_shell_num != NULL);
memcpy(nucleus_shell_num, ctx->ao_basis.nucleus_shell_num,
(size_t) ctx->nucleus.num * sizeof(int64_t));
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_nucleus_index (const qmckl_context context,
int64_t* const nucleus_index,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_nucleus_index (const qmckl_context context,
int64_t* const nucleus_index,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_nucleus_index",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 4;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_nucleus_index",
2021-04-01 01:19:33 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
if (nucleus_index == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_nucleus_index",
"NULL pointer");
}
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->nucleus.num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_nucleus_index",
"Array too small. Expected shell_num");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.nucleus_index != NULL);
memcpy(nucleus_index, ctx->ao_basis.nucleus_index,
(size_t) ctx->nucleus.num * sizeof(int64_t));
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context,
int32_t* const shell_ang_mom,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-30 01:26:19 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_ang_mom (const qmckl_context context,
int32_t* const shell_ang_mom,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_shell_ang_mom",
NULL);
2021-04-01 01:19:33 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 5;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_shell_ang_mom",
2021-04-01 01:19:33 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
if (shell_ang_mom == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_shell_ang_mom",
"NULL pointer");
}
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.shell_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_shell_ang_mom",
"Array too small. Expected shell_num");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.shell_ang_mom != NULL);
memcpy(shell_ang_mom, ctx->ao_basis.shell_ang_mom,
(size_t) ctx->ao_basis.shell_num * sizeof(int32_t));
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_prim_num (const qmckl_context context,
int64_t* const shell_prim_num,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_prim_num (const qmckl_context context,
int64_t* const shell_prim_num,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_shell_prim_num",
NULL);
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 6;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_shell_prim_num",
2021-04-01 01:19:33 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
if (shell_prim_num == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_shell_prim_num",
"NULL pointer");
}
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.shell_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_shell_prim_num",
"Array too small. Expected shell_num");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.shell_prim_num != NULL);
memcpy(shell_prim_num, ctx->ao_basis.shell_prim_num,
(size_t) ctx->ao_basis.shell_num * sizeof(int64_t));
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_prim_index (const qmckl_context context,
int64_t* const shell_prim_index,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_prim_index (const qmckl_context context,
int64_t* const shell_prim_index,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_shell_prim_index",
NULL);
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 7;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_shell_prim_index",
2021-04-01 01:19:33 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
if (shell_prim_index == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_shell_prim_index",
"NULL pointer");
}
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.shell_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_shell_prim_index",
"Array too small. Expected shell_num");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.shell_prim_index != NULL);
memcpy(shell_prim_index, ctx->ao_basis.shell_prim_index,
(size_t) ctx->ao_basis.shell_num * sizeof(int64_t));
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-30 01:26:19 +02:00
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_factor (const qmckl_context context,
double* const shell_factor,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_shell_factor (const qmckl_context context,
double* const shell_factor,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_shell_factor",
NULL);
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 8;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_shell_factor",
2021-04-01 01:19:33 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
if (shell_factor == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_shell_factor",
"NULL pointer");
}
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.shell_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_shell_factor",
"Array too small. Expected shell_num");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.shell_factor != NULL);
memcpy(shell_factor, ctx->ao_basis.shell_factor,
(size_t) ctx->ao_basis.shell_num * sizeof(double));
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2021-04-01 01:19:33 +02:00
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-10-14 16:32:58 +02:00
2022-01-06 02:28:13 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_exponent (const qmckl_context context,
double* const exponent,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_exponent (const qmckl_context context,
double* const exponent,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_exponent",
NULL);
2021-04-01 01:19:33 +02:00
}
2021-04-30 01:26:19 +02:00
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 9;
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-04-01 01:19:33 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_exponent",
2021-04-01 01:19:33 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
if (exponent == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_exponent",
"NULL pointer");
}
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.prim_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_exponent",
"Array too small. Expected prim_num");
}
2021-04-01 01:19:33 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.exponent != NULL);
memcpy(exponent, ctx->ao_basis.exponent,
(size_t) ctx->ao_basis.prim_num * sizeof(double));
return QMCKL_SUCCESS;
2021-04-01 01:19:33 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-30 01:26:19 +02:00
2021-06-03 18:26:00 +02:00
2022-01-06 02:28:13 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_coefficient (const qmckl_context context,
double* const coefficient,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_coefficient (const qmckl_context context,
double* const coefficient,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-06-03 18:26:00 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_coefficient",
NULL);
2021-06-03 18:26:00 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-06-03 18:26:00 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 10;
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_coefficient",
NULL);
2021-06-03 18:26:00 +02:00
}
2022-01-05 12:26:11 +01:00
if (coefficient == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_coefficient",
"NULL pointer");
}
2021-06-03 18:26:00 +02:00
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.prim_num) {
2021-06-03 18:26:00 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_coefficient",
"Array too small. Expected prim_num");
2021-06-03 18:26:00 +02:00
}
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.coefficient != NULL);
memcpy(coefficient, ctx->ao_basis.coefficient,
(size_t) ctx->ao_basis.prim_num * sizeof(double));
return QMCKL_SUCCESS;
}
2021-06-03 18:26:00 +02:00
2022-01-05 15:56:25 +01:00
#+end_src
2021-06-03 18:26:00 +02:00
2022-01-05 12:26:11 +01:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_prim_factor (const qmckl_context context,
double* const prim_factor,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-06-03 18:26:00 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_prim_factor (const qmckl_context context,
double* const prim_factor,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-07-09 00:45:17 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_prim_factor",
NULL);
2021-07-09 00:45:17 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
int32_t mask = 1 << 11;
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_prim_factor",
NULL);
2021-10-14 16:32:58 +02:00
}
2021-07-09 00:45:17 +02:00
2022-01-05 12:26:11 +01:00
if (prim_factor == NULL) {
2021-07-09 00:45:17 +02:00
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
2022-01-05 12:26:11 +01:00
"qmckl_get_ao_basis_prim_factor",
"NULL pointer");
2021-07-09 00:45:17 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.prim_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_prim_factor",
"Array too small. Expected prim_num");
}
2021-07-09 00:45:17 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.prim_factor != NULL);
memcpy(prim_factor, ctx->ao_basis.prim_factor,
(size_t) ctx->ao_basis.prim_num * sizeof(double));
return QMCKL_SUCCESS;
2021-07-09 00:45:17 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-07-09 00:45:17 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_ao_num (const qmckl_context context,
int64_t* const ao_num);
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-14 16:32:58 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_ao_num (const qmckl_context context,
int64_t* const ao_num)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-07-09 00:45:17 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_ao_num",
NULL);
2021-07-09 00:45:17 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-07-09 00:45:17 +02:00
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 12;
2021-07-09 00:45:17 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
2021-07-09 00:45:17 +02:00
return qmckl_failwith( context,
2022-01-05 12:26:11 +01:00
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_ao_num",
2021-07-09 00:45:17 +02:00
NULL);
}
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.ao_num > (int64_t) 0);
2021-07-09 00:45:17 +02:00
2022-01-05 12:26:11 +01:00
*ao_num = ctx->ao_basis.ao_num;
return QMCKL_SUCCESS;
2021-07-09 00:45:17 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-06-10 00:10:19 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_ao_factor (const qmckl_context context,
double* const ao_factor,
const int64_t size_max);
2022-01-05 15:56:25 +01:00
#+end_src
2021-06-10 00:10:19 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
qmckl_exit_code
qmckl_get_ao_basis_ao_factor (const qmckl_context context,
double* const ao_factor,
const int64_t size_max)
{
2021-06-10 00:10:19 +02:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
2021-10-14 16:32:58 +02:00
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
2022-01-05 12:26:11 +01:00
"qmckl_get_ao_basis_ao_factor",
2021-10-14 16:32:58 +02:00
NULL);
2021-06-10 00:10:19 +02:00
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2021-06-10 00:10:19 +02:00
assert (ctx != NULL);
2022-01-05 12:26:11 +01:00
int32_t mask = 1 << 13;
2021-06-10 22:57:59 +02:00
2022-01-05 12:26:11 +01:00
if ( (ctx->ao_basis.uninitialized & mask) != 0) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_get_ao_basis_ao_factor",
NULL);
2021-06-10 22:57:59 +02:00
}
2022-01-05 12:26:11 +01:00
if (ao_factor == NULL) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_2,
"qmckl_get_ao_basis_ao_factor",
"NULL pointer");
2021-06-10 22:57:59 +02:00
}
2022-01-05 12:26:11 +01:00
if (size_max < ctx->ao_basis.ao_num) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_ao_factor",
"Array too small. Expected ao_num");
}
2021-07-08 19:20:19 +02:00
2022-01-05 12:26:11 +01:00
assert (ctx->ao_basis.ao_factor != NULL);
memcpy(ao_factor, ctx->ao_basis.ao_factor, ctx->ao_basis.ao_num * sizeof(double));
return QMCKL_SUCCESS;
}
2022-01-05 15:56:25 +01:00
#+end_src
2022-01-05 15:56:25 +01:00
When all the data for the AOs have been provided, the following
function returns ~true~.
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval h_func)
2022-01-05 12:26:11 +01:00
bool qmckl_ao_basis_provided (const qmckl_context context);
2022-01-05 15:56:25 +01:00
#+end_src
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 12:26:11 +01:00
bool qmckl_ao_basis_provided(const qmckl_context context) {
2021-07-08 19:20:19 +02:00
2022-01-05 12:26:11 +01:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return false;
}
2021-06-10 22:57:59 +02:00
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 12:26:11 +01:00
assert (ctx != NULL);
2021-07-08 19:20:19 +02:00
2022-01-05 12:26:11 +01:00
return ctx->ao_basis.provided;
2021-06-10 00:10:19 +02:00
}
2022-01-05 15:56:25 +01:00
#+end_src
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2022-01-05 15:56:25 +01:00
**** Fortran interface
2021-06-23 23:44:20 +02:00
2022-01-06 02:28:13 +01:00
#+begin_src f90 :tangle (eval fh_func) :comments org
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_type (context, &
basis_type) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
character(c_char) , intent(out) :: basis_type
end function qmckl_get_ao_basis_type
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_shell_num(context, &
num) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(out) :: num
end function qmckl_get_ao_basis_shell_num
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_prim_num(context, &
num) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(out) :: num
end function qmckl_get_ao_basis_prim_num
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_nucleus_shell_num(context, &
shell_num, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(out) :: shell_num(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_nucleus_shell_num
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_nucleus_index(context, &
idx, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(out) :: idx(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_nucleus_index
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_shell_ang_mom(context, &
shell_ang_mom, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int32_t) , intent(out) :: shell_ang_mom(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_shell_ang_mom
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_shell_prim_num(context, &
shell_prim_num, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(out) :: shell_prim_num(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_shell_prim_num
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_shell_prim_index(context, &
shell_prim_index, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(out) :: shell_prim_index(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_shell_prim_index
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_shell_factor(context, &
shell_factor, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
real (c_double) , intent(out) :: shell_factor(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_shell_factor
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_exponent(context, &
exponent, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
real (c_double) , intent(out) :: exponent(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_exponent
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_coefficient(context, &
coefficient, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
real (c_double) , intent(out) :: coefficient(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_coefficient
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-06-23 23:44:20 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_prim_factor(context, &
prim_factor, size_max) bind(C)
use qmckl_constants
2021-06-23 23:44:20 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
real (c_double) , intent(out) :: prim_factor(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_prim_factor
2021-07-19 09:26:05 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-07-19 09:26:05 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_ao_num(context, &
num) bind(C)
use qmckl_constants
2021-07-19 09:26:05 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(out) :: num
end function qmckl_get_ao_basis_ao_num
2021-07-19 09:26:05 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-07-19 09:26:05 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_cartesian(context, &
cartesian) bind(C)
use qmckl_constants
2021-07-19 09:26:05 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
logical (c_bool) , intent(out) :: cartesian
end function qmckl_get_ao_basis_cartesian
2021-07-19 09:26:05 +02:00
end interface
2022-01-05 12:26:11 +01:00
2021-07-19 09:26:05 +02:00
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_ao_factor(context, &
ao_factor, size_max) bind(C)
use qmckl_constants
2021-07-19 09:26:05 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2022-01-05 15:56:25 +01:00
real (c_double) , intent(out) :: ao_factor(*)
2022-01-05 12:26:11 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
2022-01-05 15:56:25 +01:00
end function qmckl_get_ao_basis_ao_factor
2021-06-23 23:44:20 +02:00
end interface
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-18 15:10:55 +02:00
2022-01-05 15:56:25 +01:00
*** Test :noexport:
2021-04-18 15:10:55 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :tangle (eval c_test) :exports none :exports none
2021-06-10 22:57:59 +02:00
const int64_t nucl_num = chbrclf_nucl_num;
const double* nucl_charge = chbrclf_charge;
const double* nucl_coord = &(chbrclf_nucl_coord[0][0]);
qmckl_exit_code rc;
rc = qmckl_set_nucleus_num (context, nucl_num);
assert(rc == QMCKL_SUCCESS);
2022-01-23 16:18:46 +01:00
rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num);
2021-06-10 22:57:59 +02:00
assert(rc == QMCKL_SUCCESS);
2022-01-23 16:18:46 +01:00
rc = qmckl_set_nucleus_charge(context, nucl_charge, nucl_num);
2021-06-10 22:57:59 +02:00
assert(rc == QMCKL_SUCCESS);
assert(qmckl_nucleus_provided(context));
2021-07-09 00:45:17 +02:00
const int64_t shell_num = chbrclf_shell_num;
const int64_t prim_num = chbrclf_prim_num;
const int64_t ao_num = chbrclf_ao_num;
2021-06-10 00:10:19 +02:00
const int64_t * nucleus_index = &(chbrclf_basis_nucleus_index[0]);
const int64_t * nucleus_shell_num = &(chbrclf_basis_nucleus_shell_num[0]);
2021-06-03 22:34:23 +02:00
const int32_t * shell_ang_mom = &(chbrclf_basis_shell_ang_mom[0]);
const int64_t * shell_prim_num = &(chbrclf_basis_shell_prim_num[0]);
const int64_t * shell_prim_index = &(chbrclf_basis_shell_prim_index[0]);
const double * shell_factor = &(chbrclf_basis_shell_factor[0]);
const double * exponent = &(chbrclf_basis_exponent[0]);
const double * coefficient = &(chbrclf_basis_coefficient[0]);
const double * prim_factor = &(chbrclf_basis_prim_factor[0]);
2021-07-09 00:45:17 +02:00
const double * ao_factor = &(chbrclf_basis_ao_factor[0]);
2021-04-18 15:10:55 +02:00
2021-07-11 23:20:40 +02:00
const char typ = 'G';
2021-04-18 15:10:55 +02:00
2021-06-03 22:34:23 +02:00
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2021-06-03 22:34:23 +02:00
rc = qmckl_set_ao_basis_type (context, typ);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2021-06-03 22:34:23 +02:00
rc = qmckl_set_ao_basis_shell_num (context, shell_num);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2021-06-03 22:34:23 +02:00
rc = qmckl_set_ao_basis_prim_num (context, prim_num);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-30 01:26:19 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_nucleus_index (context, nucleus_index, nucl_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
rc = qmckl_set_ao_basis_nucleus_index (context, nucleus_index, nucl_num);
assert(rc == QMCKL_ALREADY_SET);
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_nucleus_shell_num (context, nucleus_shell_num, nucl_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_shell_ang_mom (context, shell_ang_mom, shell_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_shell_factor (context, shell_factor, shell_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_shell_prim_num (context, shell_prim_num, shell_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_shell_prim_index (context, shell_prim_index, shell_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_exponent (context, exponent, prim_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_coefficient (context, coefficient, prim_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_prim_factor (context, prim_factor, prim_num);
2021-06-03 22:34:23 +02:00
assert(rc == QMCKL_SUCCESS);
2021-07-09 00:45:17 +02:00
rc = qmckl_set_ao_basis_ao_num(context, ao_num);
assert(rc == QMCKL_SUCCESS);
2022-01-05 12:26:11 +01:00
rc = qmckl_set_ao_basis_ao_factor (context, ao_factor, ao_num);
2021-07-09 00:45:17 +02:00
assert(rc == QMCKL_SUCCESS);
2021-06-03 22:34:23 +02:00
assert(qmckl_ao_basis_provided(context));
2021-04-18 15:10:55 +02:00
2021-07-11 23:20:40 +02:00
int64_t shell_num_test ;
int64_t prim_num_test ;
int64_t ao_num_test ;
int64_t * nucleus_index_test ;
int64_t * nucleus_shell_num_test;
int32_t * shell_ang_mom_test ;
int64_t * shell_prim_num_test ;
int64_t * shell_prim_index_test ;
double * shell_factor_test ;
double * exponent_test ;
double * coefficient_test ;
double * prim_factor_test ;
double * ao_factor_test ;
char typ_test ;
2021-10-14 16:32:58 +02:00
rc = qmckl_get_ao_basis_type (context, &typ_test);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
assert(typ == typ_test);
2021-10-14 16:32:58 +02:00
rc = qmckl_get_ao_basis_shell_num (context, &shell_num_test);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
assert(shell_num == shell_num_test);
2021-10-14 16:32:58 +02:00
rc = qmckl_get_ao_basis_prim_num (context, &prim_num_test);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
assert(prim_num == prim_num_test);
2021-10-14 16:32:58 +02:00
nucleus_index_test = (int64_t*) malloc (nucl_num * sizeof(int64_t));
rc = qmckl_get_ao_basis_nucleus_index (context, nucleus_index_test, nucl_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < nucl_num ; ++i) {
assert(nucleus_index_test[i] == nucleus_index[i]);
}
2021-10-14 16:32:58 +02:00
free(nucleus_index_test);
nucleus_shell_num_test = (int64_t*) malloc ( nucl_num * sizeof(int64_t));
rc = qmckl_get_ao_basis_nucleus_shell_num (context, nucleus_shell_num_test, nucl_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < nucl_num ; ++i) {
assert(nucleus_shell_num_test[i] == nucleus_shell_num[i]);
}
2022-07-08 17:43:11 +02:00
free(nucleus_shell_num_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
shell_ang_mom_test = (int32_t*) malloc ( shell_num * sizeof(int32_t));
rc = qmckl_get_ao_basis_shell_ang_mom (context, shell_ang_mom_test, shell_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < shell_num ; ++i) {
assert(shell_ang_mom_test[i] == shell_ang_mom[i]);
}
2022-02-16 15:14:41 +01:00
free(shell_ang_mom_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
shell_factor_test = (double*) malloc ( shell_num * sizeof(double));
rc = qmckl_get_ao_basis_shell_factor (context, shell_factor_test, shell_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < shell_num ; ++i) {
assert(shell_factor_test[i] == shell_factor[i]);
}
2022-02-16 15:14:41 +01:00
free(shell_factor_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
shell_prim_num_test = (int64_t*) malloc ( shell_num * sizeof(int64_t));
rc = qmckl_get_ao_basis_shell_prim_num (context, shell_prim_num_test, shell_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < shell_num ; ++i) {
assert(shell_prim_num_test[i] == shell_prim_num[i]);
}
2022-02-16 15:14:41 +01:00
free(shell_prim_num_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
shell_prim_index_test = (int64_t*) malloc ( shell_num * sizeof(int64_t));
rc = qmckl_get_ao_basis_shell_prim_index (context, shell_prim_index_test, shell_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < shell_num ; ++i) {
assert(shell_prim_index_test[i] == shell_prim_index[i]);
}
2022-02-16 15:14:41 +01:00
free(shell_prim_index_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
exponent_test = (double*) malloc ( prim_num * sizeof(double));
rc = qmckl_get_ao_basis_exponent(context, exponent_test, prim_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < prim_num ; ++i) {
assert(exponent_test[i] == exponent[i]);
}
2022-02-16 15:14:41 +01:00
free(exponent_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
coefficient_test = (double*) malloc ( prim_num * sizeof(double));
rc = qmckl_get_ao_basis_coefficient(context, coefficient_test, prim_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < prim_num ; ++i) {
assert(coefficient_test[i] == coefficient[i]);
}
2022-02-16 15:14:41 +01:00
free(coefficient_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
prim_factor_test = (double*) malloc ( prim_num * sizeof(double));
rc = qmckl_get_ao_basis_prim_factor (context, prim_factor_test, prim_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < prim_num ; ++i) {
assert(prim_factor_test[i] == prim_factor[i]);
}
2022-02-16 15:14:41 +01:00
free(prim_factor_test);
2021-07-11 23:20:40 +02:00
2021-10-14 16:32:58 +02:00
rc = qmckl_get_ao_basis_ao_num(context, &ao_num_test);
2021-07-11 23:20:40 +02:00
assert(ao_num == ao_num_test);
2021-10-14 16:32:58 +02:00
ao_factor_test = (double*) malloc ( ao_num * sizeof(double));
rc = qmckl_get_ao_basis_ao_factor (context, ao_factor_test, ao_num);
assert (rc == QMCKL_SUCCESS);
2021-07-11 23:20:40 +02:00
for (int64_t i=0 ; i < ao_num ; ++i) {
assert(ao_factor_test[i] == ao_factor[i]);
}
2022-02-16 15:14:41 +01:00
free(ao_factor_test);
2021-07-11 23:20:40 +02:00
2022-01-05 15:56:25 +01:00
#+end_src
** Computed data
The following data is computed as described in the next sections:
2022-01-26 17:06:51 +01:00
|----------------------+-----------------------------------+----------------------------------------------------------------------------------------------|
| Variable | Type | Description |
|----------------------+-----------------------------------+----------------------------------------------------------------------------------------------|
2022-02-15 16:42:47 +01:00
| ~primitive_vgl~ | ~double[point_num][5][prim_num]~ | Value, gradients, Laplacian of the primitives at current positions |
2022-01-26 17:06:51 +01:00
| ~primitive_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the primitives at current positions |
| ~shell_vgl~ | ~double[point_num][5][shell_num]~ | Value, gradients, Laplacian of the primitives at current positions |
2022-01-26 17:06:51 +01:00
| ~shell_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at current positions |
2022-05-10 19:18:19 +02:00
| ~ao_vgl~ | ~double[point_num][5][ao_num]~ | Value, gradients, Laplacian of the AOs at current positions |
2022-01-26 17:06:51 +01:00
| ~ao_vgl_date~ | ~uint64_t~ | Last modification date of Value, gradients, Laplacian of the AOs at current positions |
2022-05-10 19:18:19 +02:00
| ~ao_value~ | ~double[point_num][ao_num]~ | Values of the the AOs at current positions |
| ~ao_value_date~ | ~uint64_t~ | Last modification date of the values of the AOs at current positions |
2022-03-28 16:53:36 +02:00
|----------------------+-----------------------------------+----------------------------------------------------------------------------------------------|
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
*** After initialization
2022-01-06 02:28:13 +01:00
2022-01-05 19:22:16 +01:00
When the basis set is completely entered, extra data structures may be
computed to accelerate the calculations. The primitives within each
contraction are sorted in ascending order of their exponents, such
that as soon as a primitive is zero all the following functions
vanish. Also, it is possible to compute a nuclear radius beyond which
all the primitives are zero up to the numerical accuracy defined in
the context.
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_finalize_basis (qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_finalize_basis(qmckl_context context) {
2022-01-05 15:56:25 +01:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
2022-01-05 19:22:16 +01:00
"qmckl_finalize_basis",
2022-01-05 15:56:25 +01:00
NULL);
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 15:56:25 +01:00
assert (ctx != NULL);
2022-01-05 19:22:16 +01:00
int64_t nucl_num = 0;
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
qmckl_exit_code rc = qmckl_get_nucleus_num(context, &nucl_num);
if (rc != QMCKL_SUCCESS) return rc;
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
/* nucleus_prim_index */
{
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = (ctx->nucleus.num + (int64_t) 1) * sizeof(int64_t);
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
ctx->ao_basis.nucleus_prim_index = (int64_t*) qmckl_malloc(context, mem_info);
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
if (ctx->ao_basis.nucleus_prim_index == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"ao_basis.nucleus_prim_index",
NULL);
}
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
for (int64_t i=0 ; i<nucl_num ; ++i) {
int64_t shell_idx = ctx->ao_basis.nucleus_index[i];
ctx->ao_basis.nucleus_prim_index[i] = ctx->ao_basis.shell_prim_index[shell_idx];
}
ctx->ao_basis.nucleus_prim_index[nucl_num] = ctx->ao_basis.prim_num;
2022-01-05 15:56:25 +01:00
}
2023-03-13 17:06:41 +01:00
/* ao_ang_mom */
{
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
2023-03-14 14:59:14 +01:00
mem_info.size = ctx->ao_basis.ao_num * sizeof(int32_t);
2023-03-13 17:06:41 +01:00
ctx->ao_basis.ao_ang_mom = (int32_t*) qmckl_malloc(context, mem_info);
if (ctx->ao_basis.ao_ang_mom == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"ao_basis.ao_ang_mom",
NULL);
}
2023-03-14 14:59:14 +01:00
mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.ao_num * sizeof(int64_t);
2023-03-13 17:06:41 +01:00
ctx->ao_basis.ao_nucl = (int64_t*) qmckl_malloc(context, mem_info);
2023-03-14 14:59:14 +01:00
if (ctx->ao_basis.ao_nucl == NULL) {
2023-03-13 17:06:41 +01:00
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"ao_basis.ao_nucl",
NULL);
}
2023-03-14 14:59:14 +01:00
int64_t lstart[32];
for (int32_t l=0 ; l<32 ; ++l) {
lstart[l] = l*(l+1)*(l+2)/6;
}
2023-09-11 17:05:41 +02:00
2023-03-13 17:06:41 +01:00
int64_t ao_idx = 0;
for (int64_t inucl=0 ; inucl<nucl_num ; ++inucl) {
const int64_t ishell_start = ctx->ao_basis.nucleus_index[inucl];
const int64_t ishell_end = ctx->ao_basis.nucleus_index[inucl] + ctx->ao_basis.nucleus_shell_num[inucl];
for (int64_t ishell = ishell_start ; ishell < ishell_end ; ++ishell) {
const int l = ctx->ao_basis.shell_ang_mom[ishell];
2023-03-14 14:59:14 +01:00
assert (l<32);
for (int m=lstart[l] ; m < lstart[l+1]; m++) {
2023-03-13 17:06:41 +01:00
ctx->ao_basis.ao_ang_mom[ao_idx] = l;
ctx->ao_basis.ao_nucl[ao_idx] = inucl;
++ao_idx;
}
}
}
2023-03-14 14:59:14 +01:00
assert( ao_idx == ctx->ao_basis.ao_num );
2023-03-13 17:06:41 +01:00
}
2022-01-05 19:22:16 +01:00
/* Normalize coefficients */
{
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.prim_num * sizeof(double);
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
ctx->ao_basis.coefficient_normalized = (double *) qmckl_malloc(context, mem_info);
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
if (ctx->ao_basis.coefficient_normalized == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"ao_basis.coefficient_normalized",
NULL);
}
2022-01-05 15:56:25 +01:00
2022-01-05 19:22:16 +01:00
for (int64_t ishell=0 ; ishell < ctx->ao_basis.shell_num ; ++ishell) {
for (int64_t iprim=ctx->ao_basis.shell_prim_index[ishell] ;
iprim < ctx->ao_basis.shell_prim_index[ishell]+ctx->ao_basis.shell_prim_num[ishell] ;
++iprim) {
ctx->ao_basis.coefficient_normalized[iprim] =
ctx->ao_basis.coefficient[iprim] * ctx->ao_basis.prim_factor[iprim] *
ctx->ao_basis.shell_factor[ishell];
}
}
}
/* Find max angular momentum on each nucleus */
{
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->nucleus.num * sizeof(int32_t);
ctx->ao_basis.nucleus_max_ang_mom = (int32_t *) qmckl_malloc(context, mem_info);
if (ctx->ao_basis.nucleus_max_ang_mom == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"ao_basis.nucleus_max_ang_mom",
NULL);
}
for (int64_t inucl=0 ; inucl < nucl_num ; ++inucl) {
ctx->ao_basis.nucleus_max_ang_mom[inucl] = 0;
for (int64_t ishell=ctx->ao_basis.nucleus_index[inucl] ;
ishell < ctx->ao_basis.nucleus_index[inucl] + ctx->ao_basis.nucleus_shell_num[inucl] ;
++ishell) {
ctx->ao_basis.nucleus_max_ang_mom[inucl] =
ctx->ao_basis.nucleus_max_ang_mom[inucl] > ctx->ao_basis.shell_ang_mom[ishell] ?
ctx->ao_basis.nucleus_max_ang_mom[inucl] : ctx->ao_basis.shell_ang_mom[ishell] ;
}
}
}
2023-11-30 12:50:06 +01:00
2023-11-30 12:56:06 +01:00
/*
// Find distance beyond which all AOs are zero using computed Gaussians.
2022-01-05 19:22:16 +01:00
{
2023-11-30 12:50:06 +01:00
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->nucleus.num * 53 * sizeof(double);
ctx->ao_basis.nucleus_range = (double *) qmckl_malloc(context, mem_info);
2022-01-05 19:22:16 +01:00
2023-11-30 12:50:06 +01:00
if (ctx->ao_basis.nucleus_range == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"ao_basis.nucleus_range",
NULL);
}
2022-01-05 19:22:16 +01:00
2023-11-30 12:50:06 +01:00
for (int64_t i=0 ; i<ctx->nucleus.num * 53 ; ++i) {
ctx->ao_basis.nucleus_range[i] = 50.;
}
2022-01-05 19:22:16 +01:00
2023-11-30 12:50:06 +01:00
if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_nucleus_range_gaussian(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->ao_basis.prim_num,
nucl_num,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_prim_index,
ctx->ao_basis.shell_prim_num,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.exponent,
ctx->ao_basis.coefficient_normalized,
ctx->ao_basis.nucleus_range);
2022-01-05 19:22:16 +01:00
}
}
2023-11-30 12:56:06 +01:00
*/
/* Find distance beyond which all AOs are zero.
The distance is obtained by sqrt(-log(epsilon)*range) */
{
if (ctx->ao_basis.type == 'G') {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->nucleus.num * sizeof(double);
ctx->ao_basis.nucleus_range = (double *) qmckl_malloc(context, mem_info);
if (ctx->ao_basis.nucleus_range == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"ao_basis.nucleus_range",
NULL);
}
for (int64_t inucl=0 ; inucl < ctx->nucleus.num ; ++inucl) {
ctx->ao_basis.nucleus_range[inucl] = 0.;
for (int64_t ishell=ctx->ao_basis.nucleus_index[inucl] ;
ishell < ctx->ao_basis.nucleus_index[inucl] + ctx->ao_basis.nucleus_shell_num[inucl] ;
++ishell) {
for (int64_t iprim=ctx->ao_basis.shell_prim_index[ishell] ;
iprim < ctx->ao_basis.shell_prim_index[ishell] + ctx->ao_basis.shell_prim_num[ishell] ;
++iprim) {
double range = 1./ctx->ao_basis.exponent[iprim];
ctx->ao_basis.nucleus_range[inucl] =
ctx->ao_basis.nucleus_range[inucl] > range ?
ctx->ao_basis.nucleus_range[inucl] : range;
}
}
}
}
}
2022-02-25 20:39:20 +01:00
#ifdef HAVE_HPC
rc = qmckl_finalize_basis_hpc(context);
if (rc != QMCKL_SUCCESS) return rc;
2022-02-25 20:39:20 +01:00
#endif
return qmckl_context_touch(context);
2022-01-05 19:22:16 +01:00
}
#+end_src
2022-02-27 23:31:52 +01:00
*** TODO HPC-specific data structures
2022-02-25 20:39:20 +01:00
2022-02-27 11:18:26 +01:00
For faster access, we provide extra arrays for the shell information as:
2022-03-21 18:32:39 +01:00
- $C_{psa}$ = =coef_per_nucleus[inucl][ishell][iprim]=
- $\gamma_{pa}$ =expo_per_nucleus[inucl][iprim]=
2022-02-25 20:39:20 +01:00
such that the computation of the radial parts can be vectorized.
2022-03-21 18:32:39 +01:00
2022-02-25 20:39:20 +01:00
Exponents are sorted in increasing order to exit loops quickly,
2022-02-27 11:18:26 +01:00
and only unique exponents are kept. This also allows to pack the
exponents to enable vectorization of exponentials.
2022-02-25 20:39:20 +01:00
The computation of the radial part is made as
\[
R_{sa} = \sum_p C_{psa} \gamma_{pa}
\]
which is a matrix-vector product.
2022-03-21 18:32:39 +01:00
#+NAME:HPC_struct
2022-02-27 11:18:26 +01:00
#+begin_src c :comments org :exports none
2022-02-25 20:39:20 +01:00
/* HPC specific data structures */
2022-03-21 18:32:39 +01:00
int32_t* restrict prim_num_per_nucleus;
qmckl_tensor coef_per_nucleus;
qmckl_matrix expo_per_nucleus;
2022-02-25 20:39:20 +01:00
#+end_src
#+begin_src c :comments org :tangle (eval h_private_func) :exports none
#ifdef HAVE_HPC
2022-02-25 20:39:20 +01:00
qmckl_exit_code qmckl_finalize_basis_hpc (qmckl_context context);
#endif
2022-02-25 20:39:20 +01:00
#+end_src
2022-03-21 18:32:39 +01:00
2022-02-25 20:39:20 +01:00
#+begin_src c :comments org :tangle (eval c) :exports none
2022-02-27 23:31:52 +01:00
/* Data structure for sorting */
struct combined {
double expo;
int64_t index;
};
/* Comparison function */
int compare_basis( const void * l, const void * r )
{
2022-03-21 18:32:39 +01:00
const struct combined * restrict _l= (const struct combined *)l;
const struct combined * restrict _r= (const struct combined *)r;
if( _l->expo > _r->expo ) return 1;
2022-02-27 23:31:52 +01:00
if( _l->expo < _r->expo ) return -1;
return 0;
}
#ifdef HAVE_HPC
2022-02-25 20:39:20 +01:00
qmckl_exit_code qmckl_finalize_basis_hpc (qmckl_context context)
{
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-02-27 23:31:52 +01:00
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->nucleus.num * sizeof(int32_t);
ctx->ao_basis.prim_num_per_nucleus = (int32_t*) qmckl_malloc(context, mem_info);
2022-02-25 20:39:20 +01:00
2022-02-27 23:31:52 +01:00
/* Find max number of primitives per nucleus */
2022-02-25 20:39:20 +01:00
int64_t shell_max = 0;
int64_t prim_max = 0;
int64_t nucl_num = ctx->nucleus.num;
for (int inucl=0 ; inucl < nucl_num ; ++inucl) {
shell_max = ctx->ao_basis.nucleus_shell_num[inucl] > shell_max ?
2022-02-27 23:31:52 +01:00
ctx->ao_basis.nucleus_shell_num[inucl] : shell_max;
2022-02-25 20:39:20 +01:00
int64_t prim_num = 0;
const int64_t ishell_start = ctx->ao_basis.nucleus_index[inucl];
const int64_t ishell_end = ctx->ao_basis.nucleus_index[inucl] + ctx->ao_basis.nucleus_shell_num[inucl];
for (int64_t ishell = ishell_start ; ishell < ishell_end ; ++ishell) {
prim_num += ctx->ao_basis.shell_prim_num[ishell];
}
prim_max = prim_num > prim_max ?
2022-02-27 23:31:52 +01:00
prim_num : prim_max;
ctx->ao_basis.prim_num_per_nucleus[inucl] = prim_num;
2022-02-25 20:39:20 +01:00
}
2022-02-27 23:31:52 +01:00
2022-02-25 20:39:20 +01:00
int64_t size[3] = { prim_max, shell_max, nucl_num };
ctx->ao_basis.coef_per_nucleus = qmckl_tensor_alloc( context, 3, size );
ctx->ao_basis.coef_per_nucleus = qmckl_tensor_set(ctx->ao_basis.coef_per_nucleus, 0.);
ctx->ao_basis.expo_per_nucleus = qmckl_matrix_alloc( context, prim_max, nucl_num );
ctx->ao_basis.expo_per_nucleus = qmckl_matrix_set(ctx->ao_basis.expo_per_nucleus, 0.);
2022-02-27 23:31:52 +01:00
struct combined expo[prim_max];
2022-02-25 20:39:20 +01:00
double coef[shell_max][prim_max];
2022-02-27 23:31:52 +01:00
double newcoef[prim_max];
for (int64_t inucl=0 ; inucl < nucl_num ; ++inucl) {
2022-02-25 20:39:20 +01:00
memset(expo, 0, sizeof(expo));
memset(coef, 0, sizeof(expo));
int64_t idx = 0;
const int64_t ishell_start = ctx->ao_basis.nucleus_index[inucl];
const int64_t ishell_end = ctx->ao_basis.nucleus_index[inucl] + ctx->ao_basis.nucleus_shell_num[inucl];
for (int64_t ishell = ishell_start ; ishell < ishell_end ; ++ishell) {
2022-03-21 18:32:39 +01:00
2022-02-25 20:39:20 +01:00
const int64_t iprim_start = ctx->ao_basis.shell_prim_index[ishell];
const int64_t iprim_end = ctx->ao_basis.shell_prim_index[ishell] + ctx->ao_basis.shell_prim_num[ishell];
for (int64_t iprim = iprim_start ; iprim < iprim_end ; ++iprim) {
2022-02-27 23:31:52 +01:00
expo[idx].expo = ctx->ao_basis.exponent[iprim];
expo[idx].index = idx;
idx += 1;
}
}
/* Sort exponents */
qsort( expo, (size_t) idx, sizeof(struct combined), compare_basis );
idx = 0;
int64_t idx2 = 0;
for (int64_t ishell = ishell_start ; ishell < ishell_end ; ++ishell) {
2022-03-21 18:32:39 +01:00
2022-02-27 23:31:52 +01:00
memset(newcoef, 0, sizeof(newcoef));
const int64_t iprim_start = ctx->ao_basis.shell_prim_index[ishell];
const int64_t iprim_end = ctx->ao_basis.shell_prim_index[ishell] + ctx->ao_basis.shell_prim_num[ishell];
for (int64_t iprim = iprim_start ; iprim < iprim_end ; ++iprim) {
2022-03-21 18:32:39 +01:00
newcoef[idx] = ctx->ao_basis.coefficient_normalized[iprim];
2022-02-27 23:31:52 +01:00
idx += 1;
}
2022-03-21 18:32:39 +01:00
for (int32_t i=0 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-27 23:31:52 +01:00
idx2 = expo[i].index;
coef[ishell - ishell_start][i] = newcoef[idx2];
}
}
/* Apply ordering to coefficients */
/* Remove duplicates */
int64_t newidx[prim_max];
int64_t idxmax = 0;
idx = 0;
newidx[0] = 0;
2022-03-21 18:32:39 +01:00
for (int32_t i=1 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-27 23:31:52 +01:00
if (expo[i].expo != expo[i-1].expo) {
2022-02-25 20:39:20 +01:00
idx += 1;
}
2022-02-27 23:31:52 +01:00
newidx[i] = idx;
}
idxmax = idx;
2022-03-21 18:32:39 +01:00
for (int32_t j=0 ; j<ishell_end-ishell_start ; ++j) {
2022-02-27 23:31:52 +01:00
memset(newcoef, 0, sizeof(newcoef));
2022-03-21 18:32:39 +01:00
for (int32_t i=0 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-27 23:31:52 +01:00
newcoef[newidx[i]] += coef[j][i];
}
2022-03-21 18:32:39 +01:00
for (int32_t i=0 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-27 23:31:52 +01:00
coef[j][i] = newcoef[i];
}
}
2022-03-21 18:32:39 +01:00
for (int32_t i=0 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-27 23:31:52 +01:00
expo[newidx[i]].expo = expo[i].expo;
2022-02-25 20:39:20 +01:00
}
2022-02-27 23:31:52 +01:00
ctx->ao_basis.prim_num_per_nucleus[inucl] = idxmax+1;
2022-02-25 20:39:20 +01:00
2022-03-21 18:32:39 +01:00
for (int32_t i=0 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-27 23:31:52 +01:00
qmckl_mat( ctx->ao_basis.expo_per_nucleus, i, inucl ) = expo[i].expo;
2022-02-25 20:39:20 +01:00
}
2022-03-21 18:32:39 +01:00
for (int32_t j=0 ; j<ishell_end-ishell_start ; ++j) {
for (int32_t i=0 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-25 20:39:20 +01:00
qmckl_ten3( ctx->ao_basis.coef_per_nucleus, i, j, inucl ) = coef[j][i];
}
}
2022-03-21 18:32:39 +01:00
/*
for (int32_t i=0 ; i<ctx->ao_basis.prim_num_per_nucleus[inucl] ; ++i) {
2022-02-27 23:31:52 +01:00
printf("%4ld %4ld %15.5e | ", inucl, i, qmckl_mat( ctx->ao_basis.expo_per_nucleus, i, inucl ));
for (int64_t j=0 ; j<ishell_end-ishell_start ; ++j) {
printf("%8.5f ", qmckl_ten3( ctx->ao_basis.coef_per_nucleus, i, j, inucl ));
}
printf("\n");
}
printf("\n");
*/
2022-02-25 20:39:20 +01:00
}
2022-02-27 23:31:52 +01:00
2022-03-21 18:32:39 +01:00
2022-02-25 20:39:20 +01:00
return QMCKL_SUCCESS;
}
#endif
2022-03-21 18:32:39 +01:00
2022-02-25 20:39:20 +01:00
#+end_src
2022-01-05 19:22:16 +01:00
*** Access functions
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_ao_basis_primitive_vgl (qmckl_context context,
double* const primitive_vgl,
const int64_t size_max);
#+end_src
2022-01-06 02:28:13 +01:00
2022-01-05 19:22:16 +01:00
Returns the array of values, gradients an Laplacian of primitive
basis functions evaluated at the current coordinates.
See section [[Computation of primitives]].
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_ao_basis_primitive_vgl (qmckl_context context,
double* const primitive_vgl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_primitive_vgl",
NULL);
}
2022-01-08 15:36:07 +01:00
if (size_max <= 0) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_primitive_vgl",
"size_max <= 0");
}
2022-01-05 19:22:16 +01:00
qmckl_exit_code rc;
rc = qmckl_provide_ao_basis_primitive_vgl(context);
if (rc != QMCKL_SUCCESS) return rc;
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 19:22:16 +01:00
assert (ctx != NULL);
2022-01-26 17:06:51 +01:00
int64_t sze = ctx->ao_basis.prim_num * 5 * ctx->point.num;
2022-01-05 19:22:16 +01:00
if (size_max < sze) {
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 19:22:16 +01:00
"qmckl_get_ao_basis_primitive_vgl",
"input array too small");
}
2022-01-08 15:36:07 +01:00
memcpy(primitive_vgl, ctx->ao_basis.primitive_vgl, (size_t) sze * sizeof(double));
2022-01-05 19:22:16 +01:00
return QMCKL_SUCCESS;
}
#+end_src
2022-01-06 02:28:13 +01:00
2022-01-05 19:22:16 +01:00
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_get_ao_basis_primitive_vgl &
(context, primitive_vgl, size_max) &
bind(C)
use qmckl_constants
2022-01-05 19:22:16 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2023-09-11 17:05:41 +02:00
real(c_double), intent(out) :: primitive_vgl(*)
2022-01-05 19:22:16 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_ao_basis_shell_vgl (qmckl_context context,
double* const shell_vgl,
const int64_t size_max);
#+end_src
Returns the array of values, gradients an Laplacian of contracted shells
evaluated at the current coordinates. See section [[Computation of shells]].
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_ao_basis_shell_vgl (qmckl_context context,
double* const shell_vgl,
2022-01-06 02:28:13 +01:00
const int64_t size_max)
2022-01-05 19:22:16 +01:00
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_shell_vgl",
NULL);
}
qmckl_exit_code rc;
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) return rc;
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 19:22:16 +01:00
assert (ctx != NULL);
2022-01-26 17:06:51 +01:00
int64_t sze = ctx->ao_basis.shell_num * 5 * ctx->point.num;
2022-01-05 19:22:16 +01:00
if (size_max < sze) {
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 19:22:16 +01:00
"qmckl_get_ao_basis_shell_vgl",
"input array too small");
}
2022-01-08 15:36:07 +01:00
memcpy(shell_vgl, ctx->ao_basis.shell_vgl, (size_t)sze * sizeof(double));
2022-01-05 19:22:16 +01:00
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
2022-01-05 15:56:25 +01:00
integer(c_int32_t) function qmckl_get_ao_basis_shell_vgl &
(context, shell_vgl, size_max) &
bind(C)
use qmckl_constants
2022-01-05 15:56:25 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2023-09-11 17:05:41 +02:00
real(c_double), intent(out) :: shell_vgl(*)
2022-01-05 15:56:25 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
end function
end interface
#+end_src
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2022-01-05 19:22:16 +01:00
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_ao_basis_ao_vgl (qmckl_context context,
double* const ao_vgl,
const int64_t size_max);
#+end_src
Returns the array of values, gradients an Laplacian of the atomic orbitals
evaluated at the current coordinates.
See section [[Combining radial and polynomial parts]].
2022-01-06 02:28:13 +01:00
2022-01-05 19:22:16 +01:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_ao_basis_ao_vgl (qmckl_context context,
double* const ao_vgl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
2022-01-06 02:28:13 +01:00
"qmckl_get_ao_basis_ao_vgl",
2022-01-05 19:22:16 +01:00
NULL);
}
qmckl_exit_code rc;
2022-07-11 13:42:39 +02:00
rc = qmckl_provide_ao_basis_ao_vgl(context);
2022-01-05 19:22:16 +01:00
if (rc != QMCKL_SUCCESS) return rc;
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 19:22:16 +01:00
assert (ctx != NULL);
2022-01-26 17:06:51 +01:00
int64_t sze = ctx->ao_basis.ao_num * 5 * ctx->point.num;
2022-01-05 19:22:16 +01:00
if (size_max < sze) {
return qmckl_failwith( context,
2022-01-08 15:36:07 +01:00
QMCKL_INVALID_ARG_3,
2022-01-05 19:22:16 +01:00
"qmckl_get_ao_basis_ao_vgl",
"input array too small");
}
2022-01-08 15:36:07 +01:00
memcpy(ao_vgl, ctx->ao_basis.ao_vgl, (size_t) sze * sizeof(double));
2022-01-05 19:22:16 +01:00
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_get_ao_basis_ao_vgl (context, &
ao_vgl, size_max) bind(C)
use qmckl_constants
2022-01-05 19:22:16 +01:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2023-09-11 17:05:41 +02:00
real(c_double), intent(out) :: ao_vgl(*)
2022-01-05 19:22:16 +01:00
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_get_ao_basis_ao_vgl
end interface
#+end_src
2022-05-10 19:18:19 +02:00
Uses the given array to compute the VGL.
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_ao_basis_ao_vgl_inplace (qmckl_context context,
double* const ao_vgl,
const int64_t size_max);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_ao_basis_ao_vgl_inplace (qmckl_context context,
double* const ao_vgl,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_ao_vgl",
NULL);
}
qmckl_exit_code rc;
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->ao_basis.ao_num * 5 * ctx->point.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_ao_vgl",
"input array too small");
}
rc = qmckl_context_touch(context);
if (rc != QMCKL_SUCCESS) return rc;
double* old_array = ctx->ao_basis.ao_vgl;
ctx->ao_basis.ao_vgl = ao_vgl;
2022-07-11 13:42:39 +02:00
rc = qmckl_provide_ao_basis_ao_vgl(context);
if (rc != QMCKL_SUCCESS) return rc;
ctx->ao_basis.ao_vgl = old_array;
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_get_ao_basis_ao_vgl_inplace (context, &
ao_vgl, size_max) bind(C)
use qmckl_constants
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2023-09-11 17:05:41 +02:00
real(c_double), intent(out) :: ao_vgl(*)
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_get_ao_basis_ao_vgl_inplace
end interface
#+end_src
2022-05-10 19:18:19 +02:00
2022-06-11 10:57:58 +02:00
2022-05-10 19:18:19 +02:00
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_ao_basis_ao_value (qmckl_context context,
double* const ao_value,
const int64_t size_max);
#+end_src
Returns the array of values of the atomic orbitals evaluated at
the current coordinates. See section [[Combining radial and polynomial parts]].
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_ao_basis_ao_value (qmckl_context context,
double* const ao_value,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_ao_value",
NULL);
}
qmckl_exit_code rc;
rc = qmckl_provide_ao_basis_ao_value(context);
2022-05-10 19:18:19 +02:00
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->ao_basis.ao_num * ctx->point.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_ao_value",
"input array too small");
}
memcpy(ao_value, ctx->ao_basis.ao_value, (size_t) sze * sizeof(double));
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_get_ao_basis_ao_value (context, &
ao_value, size_max) bind(C)
use qmckl_constants
2022-05-10 19:18:19 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2023-09-11 17:05:41 +02:00
real(c_double) , intent(out) :: ao_value(*)
2022-05-10 19:18:19 +02:00
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_get_ao_basis_ao_value
end interface
#+end_src
Uses the given array to compute the value.
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_ao_basis_ao_value_inplace (qmckl_context context,
double* const ao_value,
const int64_t size_max);
#+end_src
2022-06-11 10:57:58 +02:00
2022-05-10 19:18:19 +02:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_ao_basis_ao_value_inplace (qmckl_context context,
double* const ao_value,
const int64_t size_max)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_get_ao_basis_ao_value",
NULL);
}
qmckl_exit_code rc;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
int64_t sze = ctx->ao_basis.ao_num * ctx->point.num;
if (size_max < sze) {
return qmckl_failwith( context,
QMCKL_INVALID_ARG_3,
"qmckl_get_ao_basis_ao_value",
"input array too small");
}
rc = qmckl_context_touch(context);
if (rc != QMCKL_SUCCESS) return rc;
double* old_array = ctx->ao_basis.ao_value;
ctx->ao_basis.ao_value = ao_value;
rc = qmckl_provide_ao_basis_ao_value(context);
2022-05-10 19:18:19 +02:00
if (rc != QMCKL_SUCCESS) return rc;
ctx->ao_basis.ao_value = old_array;
return QMCKL_SUCCESS;
}
#+end_src
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
integer(c_int32_t) function qmckl_get_ao_basis_ao_value_inplace (context, &
ao_value, size_max) bind(C)
use qmckl_constants
2022-05-10 19:18:19 +02:00
import
implicit none
integer (c_int64_t) , intent(in) , value :: context
2023-09-11 17:05:41 +02:00
real(c_double) , intent(out) :: ao_value(*)
2022-05-10 19:18:19 +02:00
integer (c_int64_t) , intent(in) , value :: size_max
end function qmckl_get_ao_basis_ao_value_inplace
end interface
#+end_src
2021-06-10 22:57:59 +02:00
* Radial part
2021-06-10 22:57:59 +02:00
** General functions for Gaussian basis functions
2021-04-18 15:10:55 +02:00
2022-01-05 15:56:25 +01:00
~qmckl_ao_gaussian_vgl~ computes the values, gradients and
Laplacians at a given point of ~n~ Gaussian functions centered at
the same point:
\[ v_i = \exp(-a_i |X-R|^2) \]
\[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \]
\[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \]
\[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \]
\[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \]
|--------------+------------------+------------------------------------------------------|
| Variable | Type | Description |
|--------------+------------------+------------------------------------------------------|
| ~context~ | ~qmckl_context~ | Global state |
| ~X(3)~ | ~double[3]~ | Array containing the coordinates of the points |
| ~R(3)~ | ~double[3]~ | Array containing the x,y,z coordinates of the center |
| ~n~ | ~int64_t~ | Number of computed Gaussians |
| ~A(n)~ | ~double[n]~ | Exponents of the Gaussians |
| ~VGL(ldv,5)~ | ~double[5][ldv]~ | Value, gradients and Laplacian of the Gaussians |
| ~ldv~ | ~int64_t~ | Leading dimension of array ~VGL~ |
|--------------+------------------+------------------------------------------------------|
Requirements:
- ~context~ \ne 0
- ~n~ > 0
- ~ldv~ >= 5
- ~A(i)~ > 0 for all ~i~
- ~X~ is allocated with at least $3 \times 8$ bytes
- ~R~ is allocated with at least $3 \times 8$ bytes
- ~A~ is allocated with at least $n \times 8$ bytes
- ~VGL~ is allocated with at least $n \times 5 \times 8$ bytes
#+begin_src c :tangle (eval h_func)
2021-06-10 22:57:59 +02:00
qmckl_exit_code
qmckl_ao_gaussian_vgl(const qmckl_context context,
const double *X,
const double *R,
const int64_t *n,
const int64_t *A,
const double *VGL,
const int64_t ldv);
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-16 00:57:08 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src f90 :tangle (eval f)
2023-09-22 16:41:43 +02:00
function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) &
bind(C) result(info)
use qmckl_constants
2021-04-01 01:19:33 +02:00
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context) , intent(in) , value :: context
real (c_double) , intent(in) :: X(3), R(3)
integer (c_int64_t) , intent(in) , value :: n
2024-02-23 16:37:31 +01:00
integer (c_int64_t) , intent(in) , value :: ldv
2023-09-22 16:41:43 +02:00
real (c_double) , intent(in) :: A(n)
real (c_double) , intent(out) :: VGL(ldv,5)
integer (qmckl_exit_code) :: info
2021-04-01 01:19:33 +02:00
2021-06-10 22:57:59 +02:00
integer*8 :: i,j
2023-08-24 09:59:57 +02:00
double precision :: Y(3), r2, t, u, v
2021-04-01 01:19:33 +02:00
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
2021-06-10 22:57:59 +02:00
if (n <= 0) then
info = QMCKL_INVALID_ARG_4
2021-04-01 01:19:33 +02:00
return
endif
2021-06-10 22:57:59 +02:00
if (ldv < n) then
info = QMCKL_INVALID_ARG_7
2021-04-01 01:19:33 +02:00
return
endif
2021-06-10 22:57:59 +02:00
do i=1,3
Y(i) = X(i) - R(i)
2021-04-01 01:19:33 +02:00
end do
2021-06-10 22:57:59 +02:00
r2 = Y(1)*Y(1) + Y(2)*Y(2) + Y(3)*Y(3)
2021-04-01 01:19:33 +02:00
2021-06-10 22:57:59 +02:00
do i=1,n
VGL(i,1) = dexp(-A(i) * r2)
end do
2021-04-16 00:57:08 +02:00
2021-06-10 22:57:59 +02:00
do i=1,n
VGL(i,5) = A(i) * VGL(i,1)
end do
2021-04-16 00:57:08 +02:00
2021-06-10 22:57:59 +02:00
t = -2.d0 * ( X(1) - R(1) )
u = -2.d0 * ( X(2) - R(2) )
v = -2.d0 * ( X(3) - R(3) )
2021-04-16 00:57:08 +02:00
2021-06-10 22:57:59 +02:00
do i=1,n
VGL(i,2) = t * VGL(i,5)
VGL(i,3) = u * VGL(i,5)
VGL(i,4) = v * VGL(i,5)
end do
2021-04-16 00:57:08 +02:00
2021-06-10 22:57:59 +02:00
t = 4.d0 * r2
do i=1,n
VGL(i,5) = (t * A(i) - 6.d0) * VGL(i,5)
end do
2021-04-16 00:57:08 +02:00
2021-06-10 22:57:59 +02:00
end function qmckl_ao_gaussian_vgl
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-16 00:57:08 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src f90 :tangle (eval fh_func) :exports none
2021-06-10 22:57:59 +02:00
interface
2023-09-22 16:41:43 +02:00
function qmckl_ao_gaussian_vgl(context, &
X, R, n, A, VGL, ldv) bind(C) result(info)
use qmckl_constants
integer (qmckl_context) , intent(in) , value :: context
2021-06-10 22:57:59 +02:00
integer (c_int64_t) , intent(in) , value :: ldv
integer (c_int64_t) , intent(in) , value :: n
real (c_double) , intent(in) :: X(3), R(3), A(n)
real (c_double) , intent(out) :: VGL(ldv,5)
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) :: info
2021-06-10 22:57:59 +02:00
end function qmckl_ao_gaussian_vgl
end interface
2022-01-05 15:56:25 +01:00
#+end_src
2021-04-16 00:57:08 +02:00
2022-01-05 15:56:25 +01:00
*** Test :noexport:
#+begin_src f90 :tangle (eval f_test)
2023-09-22 16:41:43 +02:00
function test_qmckl_ao_gaussian_vgl(context) bind(C)
2021-04-01 01:19:33 +02:00
use qmckl
implicit none
2023-09-22 16:41:43 +02:00
integer(qmckl_context), intent(in), value :: context
integer(qmckl_exit_code) :: test_qmckl_ao_gaussian_vgl
2021-06-10 22:57:59 +02:00
integer*8 :: n, ldv, j, i
2022-02-25 16:30:16 +01:00
double precision :: X(3), R(3), Y(3), r2, z
2021-06-10 22:57:59 +02:00
double precision, allocatable :: VGL(:,:), A(:)
double precision :: epsilon
2022-02-25 16:30:16 +01:00
epsilon = 3.d0 * qmckl_get_numprec_epsilon(context)
2021-06-10 22:57:59 +02:00
X = (/ 1.1 , 2.2 , 3.3 /)
R = (/ 0.1 , 1.2 , -2.3 /)
Y(:) = X(:) - R(:)
r2 = Y(1)**2 + Y(2)**2 + Y(3)**2
n = 10;
ldv = 100;
allocate (A(n), VGL(ldv,5))
do i=1,n
A(i) = 0.0013 * dble(ishft(1,i))
end do
2021-10-13 15:01:23 +02:00
2021-06-10 22:57:59 +02:00
test_qmckl_ao_gaussian_vgl = &
qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv)
if (test_qmckl_ao_gaussian_vgl /= 0) return
test_qmckl_ao_gaussian_vgl = -1
do i=1,n
test_qmckl_ao_gaussian_vgl = -11
2022-02-25 16:30:16 +01:00
z = dabs(1.d0 - VGL(i,1) / (dexp(-A(i) * r2)) )
if ( z > epsilon ) then
print *, z, epsilon
return
end if
2021-06-10 22:57:59 +02:00
test_qmckl_ao_gaussian_vgl = -12
2022-02-25 16:30:16 +01:00
z = dabs(1.d0 - VGL(i,2) / (&
-2.d0 * A(i) * Y(1) * dexp(-A(i) * r2) ))
if ( z > epsilon ) then
print *, z, epsilon
return
end if
2021-06-10 22:57:59 +02:00
test_qmckl_ao_gaussian_vgl = -13
2022-02-25 16:30:16 +01:00
z = dabs(1.d0 - VGL(i,3) / (&
-2.d0 * A(i) * Y(2) * dexp(-A(i) * r2) ))
if ( z > epsilon ) then
print *, z, epsilon
return
end if
2021-06-10 22:57:59 +02:00
test_qmckl_ao_gaussian_vgl = -14
2022-02-25 16:30:16 +01:00
z = dabs(1.d0 - VGL(i,4) / (&
-2.d0 * A(i) * Y(3) * dexp(-A(i) * r2) ))
if ( z > epsilon ) then
print *, z, epsilon
return
end if
2021-06-10 22:57:59 +02:00
test_qmckl_ao_gaussian_vgl = -15
2022-02-25 16:30:16 +01:00
z = dabs(1.d0 - VGL(i,5) / (&
A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) ))
if ( z > epsilon ) then
print *, z, epsilon
return
end if
2021-06-10 22:57:59 +02:00
end do
test_qmckl_ao_gaussian_vgl = 0
2021-10-13 15:01:23 +02:00
deallocate(VGL)
2021-06-10 22:57:59 +02:00
end function test_qmckl_ao_gaussian_vgl
2022-01-05 15:56:25 +01:00
#+end_src
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src c :tangle (eval c_test) :exports none
int test_qmckl_ao_gaussian_vgl(qmckl_context context);
assert(0 == test_qmckl_ao_gaussian_vgl(context));
#+end_src
** TODO General functions for Slater basis functions :noexport:
** TODO General functions for Radial functions on a grid :noexport:
2021-07-08 19:20:19 +02:00
** Computation of primitives
2022-01-05 15:56:25 +01:00
:PROPERTIES:
:Name: qmckl_compute_ao_basis_primitive_gaussian_vgl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_ao_basis_primitive_gaussian_vgl_args
2022-01-26 17:06:51 +01:00
| Variable | Type | In/Out | Description |
|----------------------+----------------------------------+--------+--------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~prim_num~ | ~int64_t~ | in | Number of primitives |
| ~point_num~ | ~int64_t~ | in | Number of points considered |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
2023-09-22 16:41:43 +02:00
| ~nucleus_prim_index~ | ~int64_t[nucl_num+1]~ | in | Index of the 1st primitive of each nucleus |
2022-01-26 17:06:51 +01:00
| ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives |
| ~primitive_vgl~ | ~double[point_num][5][prim_num]~ | out | Value, gradients and Laplacian of the primitives |
2022-01-05 19:22:16 +01:00
#+CALL: generate_c_header(table=qmckl_ao_basis_primitive_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_primitive_gaussian_vgl"))
2021-06-10 22:57:59 +02:00
2022-01-05 19:22:16 +01:00
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_compute_ao_basis_primitive_gaussian_vgl (
const qmckl_context context,
const int64_t prim_num,
2022-01-26 17:06:51 +01:00
const int64_t point_num,
2022-01-05 19:22:16 +01:00
const int64_t nucl_num,
const int64_t* nucleus_prim_index,
2022-01-26 17:06:51 +01:00
const double* coord,
2022-01-05 19:22:16 +01:00
const double* nucl_coord,
const double* expo,
2023-11-29 02:10:20 +01:00
double* const primitive_vgl );
2022-01-05 19:22:16 +01:00
#+end_src
2021-06-10 22:57:59 +02:00
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2022-01-05 19:22:16 +01:00
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
2023-09-22 16:41:43 +02:00
function qmckl_compute_ao_basis_primitive_gaussian_vgl &
(context, prim_num, point_num, nucl_num, nucleus_prim_index, coord, nucl_coord, expo, primitive_vgl) &
bind(C) result(info)
2021-06-10 22:57:59 +02:00
2023-09-22 16:41:43 +02:00
use qmckl_constants
2023-11-29 02:10:20 +01:00
2024-01-11 14:33:40 +01:00
use qmckl, only: qmckl_get_numprec_precision
2022-01-05 15:56:25 +01:00
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: prim_num
integer (c_int64_t) , intent(in) , value :: point_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) :: nucleus_prim_index(nucl_num+1)
real (c_double ) , intent(in) :: coord(point_num,3)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
real (c_double ) , intent(in) :: expo(prim_num)
real (c_double ) , intent(out) :: primitive_vgl(prim_num,5,point_num)
integer(qmckl_exit_code) :: info
2021-06-10 22:57:59 +02:00
2022-01-26 17:06:51 +01:00
integer*8 :: inucl, iprim, ipoint
2022-01-05 15:56:25 +01:00
double precision :: x, y, z, two_a, ar2, r2, v, cutoff
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
info = QMCKL_SUCCESS
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
! Don't compute exponentials when the result will be almost zero.
2024-01-11 14:33:40 +01:00
<<fortran_cutoff>>
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
do inucl=1,nucl_num
! C is zero-based, so shift bounds by one
do iprim = nucleus_prim_index(inucl)+1, nucleus_prim_index(inucl+1)
2022-01-26 17:06:51 +01:00
do ipoint = 1, point_num
x = coord(ipoint,1) - nucl_coord(inucl,1)
y = coord(ipoint,2) - nucl_coord(inucl,2)
z = coord(ipoint,3) - nucl_coord(inucl,3)
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
r2 = x*x + y*y + z*z
ar2 = expo(iprim)*r2
if (ar2 > cutoff) cycle
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
v = dexp(-ar2)
two_a = -2.d0 * expo(iprim) * v
2021-06-10 22:57:59 +02:00
primitive_vgl(iprim, 1, ipoint) = v
primitive_vgl(iprim, 2, ipoint) = two_a * x
primitive_vgl(iprim, 3, ipoint) = two_a * y
primitive_vgl(iprim, 4, ipoint) = two_a * z
primitive_vgl(iprim, 5, ipoint) = two_a * (3.d0 - 2.d0*ar2)
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
end do
end do
end do
2021-06-10 22:57:59 +02:00
2023-09-22 16:41:43 +02:00
end function qmckl_compute_ao_basis_primitive_gaussian_vgl
2022-01-05 19:22:16 +01:00
#+end_src
2022-01-05 15:56:25 +01:00
*** Provide :noexport:
#+CALL: write_provider_header( group="ao_basis", data="primitive_vgl" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
2022-01-05 15:56:25 +01:00
qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context);
#+end_src
2022-01-05 15:56:25 +01:00
#+CALL: write_provider_pre( group="ao_basis", data="primitive_vgl", dimension="ctx->ao_basis.prim_num * 5 * ctx->point.num")
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
2022-01-05 15:56:25 +01:00
qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
{
2022-08-07 14:57:10 +02:00
qmckl_exit_code rc = QMCKL_SUCCESS;
2022-01-05 15:56:25 +01:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_ao_basis_primitive_vgl",
2022-01-05 15:56:25 +01:00
NULL);
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 15:56:25 +01:00
assert (ctx != NULL);
if (!ctx->ao_basis.provided) {
return qmckl_failwith( context,
2021-06-10 22:57:59 +02:00
QMCKL_NOT_PROVIDED,
"qmckl_provide_ao_basis_primitive_vgl",
2021-06-10 22:57:59 +02:00
NULL);
}
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2021-06-10 22:57:59 +02:00
/* Compute if necessary */
2022-01-26 17:06:51 +01:00
if (ctx->point.date > ctx->ao_basis.primitive_vgl_date) {
2021-06-10 22:57:59 +02:00
2022-08-07 14:57:10 +02:00
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.prim_num * 5 * ctx->point.num * sizeof(double);
if (ctx->ao_basis.primitive_vgl != NULL) {
qmckl_memory_info_struct mem_info_test = qmckl_memory_info_struct_zero;
rc = qmckl_get_malloc_info(context, ctx->ao_basis.primitive_vgl, &mem_info_test);
/* if rc != QMCKL_SUCCESS, we are maybe in an _inplace function because the
memory was not allocated with qmckl_malloc */
if ((rc == QMCKL_SUCCESS) && (mem_info_test.size != mem_info.size)) {
rc = qmckl_free(context, ctx->ao_basis.primitive_vgl);
assert (rc == QMCKL_SUCCESS);
ctx->ao_basis.primitive_vgl = NULL;
}
}
2021-06-10 22:57:59 +02:00
/* Allocate array */
if (ctx->ao_basis.primitive_vgl == NULL) {
double* primitive_vgl = (double*) qmckl_malloc(context, mem_info);
if (primitive_vgl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_ao_basis_primitive_vgl",
NULL);
}
ctx->ao_basis.primitive_vgl = primitive_vgl;
}
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2021-06-10 22:57:59 +02:00
if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_ao_basis_primitive_gaussian_vgl(context,
ctx->ao_basis.prim_num,
2022-01-26 17:06:51 +01:00
ctx->point.num,
2021-06-10 22:57:59 +02:00
ctx->nucleus.num,
ctx->ao_basis.nucleus_prim_index,
2022-01-26 17:06:51 +01:00
ctx->point.coord.data,
2022-01-23 16:18:46 +01:00
ctx->nucleus.coord.data,
2021-06-10 22:57:59 +02:00
ctx->ao_basis.exponent,
ctx->ao_basis.primitive_vgl);
} else {
return qmckl_failwith( context,
QMCKL_FAILURE,
"compute_ao_basis_primitive_vgl",
"Not yet implemented");
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
}
#+end_src
#+CALL: write_provider_post( group="ao_basis", data="shell_vgl" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
2021-06-10 22:57:59 +02:00
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->ao_basis.shell_vgl_date = ctx->date;
2021-06-10 22:57:59 +02:00
}
return QMCKL_SUCCESS;
}
#+end_src
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
*** Test :noexport:
2021-06-10 22:57:59 +02:00
2022-01-05 15:56:25 +01:00
#+begin_src python :results output :exports none :exports none
2021-06-10 22:57:59 +02:00
import numpy as np
def f(a,x,y):
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
return np.exp( -a*(np.linalg.norm(x-y))**2 )
2021-06-10 22:57:59 +02:00
def df(a,x,y,n):
h0 = 1.e-6
if n == 1: h = np.array([h0,0.,0.])
elif n == 2: h = np.array([0.,h0,0.])
elif n == 3: h = np.array([0.,0.,h0])
return ( f(a,x+h,y) - f(a,x-h,y) ) / (2.*h0)
def d2f(a,x,y,n):
h0 = 1.e-6
if n == 1: h = np.array([h0,0.,0.])
elif n == 2: h = np.array([0.,h0,0.])
elif n == 3: h = np.array([0.,0.,h0])
return ( f(a,x+h,y) - 2.*f(a,x,y) + f(a,x-h,y) ) / h0**2
def lf(a,x,y):
return d2f(a,x,y,1) + d2f(a,x,y,2) + d2f(a,x,y,3)
elec_26_w1 = np.array( [ 1.49050402641, 2.90106987953, -1.05920815468 ] )
nucl_1 = np.array( [ 1.096243353458458e+00, 8.907054016973815e-01, 7.777092280258892e-01 ] )
nucl_2 = np.array( [ 1.168459237342663e+00, 1.125660720053393e+00, 2.833370314829343e+00 ] )
2021-09-23 11:16:54 +02:00
#double prim_vgl[prim_num][5][elec_num];
2021-06-10 22:57:59 +02:00
a = 0.9059; x = elec_26_w1 ; y = nucl_1
2021-09-23 11:16:54 +02:00
print ( "[7][0][26] : %e"% f(a,x,y))
print ( "[7][1][26] : %e"% df(a,x,y,1))
print ( "[7][2][26] : %e"% df(a,x,y,2))
print ( "[7][3][26] : %e"% df(a,x,y,3))
print ( "[7][4][26] : %e"% lf(a,x,y))
2021-06-10 22:57:59 +02:00
#+end_src
#+RESULTS:
2021-09-23 11:16:54 +02:00
: [7][0][26] : 1.050157e-03
: [7][1][26] : -7.501497e-04
: [7][2][26] : -3.825069e-03
: [7][3][26] : 3.495056e-03
: [7][4][26] : 2.040013e-02
2021-06-10 22:57:59 +02:00
2022-01-05 19:22:16 +01:00
#+begin_src c :tangle (eval c_test) :exports none
2021-06-22 23:33:09 +02:00
{
2022-01-23 16:18:46 +01:00
#define walk_num 1 // chbrclf_walk_num
2021-06-10 22:57:59 +02:00
#define elec_num chbrclf_elec_num
#define prim_num chbrclf_prim_num
2022-01-05 19:22:16 +01:00
int64_t elec_up_num = chbrclf_elec_up_num;
int64_t elec_dn_num = chbrclf_elec_dn_num;
double* elec_coord = &(chbrclf_elec_coord[0][0][0]);
2021-06-10 22:57:59 +02:00
2022-01-05 19:22:16 +01:00
rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num);
assert (rc == QMCKL_SUCCESS);
2021-06-10 22:57:59 +02:00
2022-01-05 19:22:16 +01:00
assert(qmckl_electron_provided(context));
2021-06-10 22:57:59 +02:00
2023-09-14 11:00:24 +02:00
int64_t point_num = elec_num;
2022-08-07 14:57:10 +02:00
rc = qmckl_set_point(context, 'N', point_num, elec_coord, point_num*3);
2022-01-05 19:22:16 +01:00
assert(rc == QMCKL_SUCCESS);
2021-06-10 22:57:59 +02:00
2022-08-07 14:57:10 +02:00
double prim_vgl[point_num][5][prim_num];
2021-06-10 22:57:59 +02:00
2022-01-06 02:28:13 +01:00
rc = qmckl_get_ao_basis_primitive_vgl(context, &(prim_vgl[0][0][0]),
2022-08-07 14:57:10 +02:00
(int64_t) 5*point_num*prim_num );
2022-01-05 19:22:16 +01:00
assert (rc == QMCKL_SUCCESS);
2021-06-10 22:57:59 +02:00
2022-06-15 23:21:31 +02:00
printf("prim_vgl[26][0][7] = %e\n",prim_vgl[26][0][7]);
assert( fabs(prim_vgl[26][0][7] - ( 1.0501570432064878E-003)) < 1.e-14 );
2022-06-15 23:21:31 +02:00
printf("prim_vgl[26][1][7] = %e\n",prim_vgl[26][1][7]);
assert( fabs(prim_vgl[26][1][7] - (-7.5014974095310560E-004)) < 1.e-14 );
2022-06-15 23:21:31 +02:00
printf("prim_vgl[26][2][7] = %e\n",prim_vgl[26][2][7]);
assert( fabs(prim_vgl[26][2][7] - (-3.8250692897610380E-003)) < 1.e-14 );
2022-06-15 23:21:31 +02:00
printf("prim_vgl[26][3][7] = %e\n",prim_vgl[26][3][7]);
assert( fabs(prim_vgl[26][3][7] - ( 3.4950559194080275E-003)) < 1.e-14 );
2022-06-15 23:21:31 +02:00
printf("prim_vgl[26][4][7] = %e\n",prim_vgl[26][4][7]);
assert( fabs(prim_vgl[26][4][7] - ( 2.0392163767356572E-002)) < 1.e-14 );
2021-10-13 15:01:23 +02:00
2021-06-22 23:33:09 +02:00
}
2021-06-10 22:57:59 +02:00
2022-01-05 19:22:16 +01:00
#+end_src
2021-06-14 12:53:38 +02:00
2021-06-22 23:33:09 +02:00
** Computation of shells
:PROPERTIES:
:Name: qmckl_compute_ao_basis_shell_gaussian_vgl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
2022-01-05 19:22:16 +01:00
#+NAME: qmckl_ao_basis_shell_gaussian_vgl_args
2022-01-26 17:06:51 +01:00
| Variable | Type | In/Out | Description |
|---------------------+-----------------------------------+--------+----------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~prim_num~ | ~int64_t~ | in | Number of primitives |
| ~shell_num~ | ~int64_t~ | in | Number of shells |
| ~point_num~ | ~int64_t~ | in | Number of points |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells for each nucleus |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus |
2022-02-14 19:11:37 +01:00
| ~nucleus_range~ | ~double[nucl_num]~ | in | Range of the nucleus |
2022-01-26 17:06:51 +01:00
| ~shell_prim_index~ | ~int64_t[shell_num]~ | in | Index of the 1st primitive of each shell |
| ~shell_prim_num~ | ~int64_t[shell_num]~ | in | Number of primitives per shell |
| ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives |
| ~coef_normalized~ | ~double[prim_num]~ | in | Coefficients of the primitives |
| ~shell_vgl~ | ~double[point_num][5][shell_num]~ | out | Value, gradients and Laplacian of the shells |
2022-01-05 15:56:25 +01:00
#+CALL: generate_c_header(table=qmckl_ao_basis_shell_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_shell_gaussian_vgl"))
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_compute_ao_basis_shell_gaussian_vgl (
const qmckl_context context,
const int64_t prim_num,
const int64_t shell_num,
2022-01-26 17:06:51 +01:00
const int64_t point_num,
2022-01-05 15:56:25 +01:00
const int64_t nucl_num,
2022-01-05 19:22:16 +01:00
const int64_t* nucleus_shell_num,
const int64_t* nucleus_index,
2022-02-14 19:11:37 +01:00
const double* nucleus_range,
2022-01-05 19:22:16 +01:00
const int64_t* shell_prim_index,
const int64_t* shell_prim_num,
2022-01-26 17:06:51 +01:00
const double* coord,
2022-01-05 19:22:16 +01:00
const double* nucl_coord,
const double* expo,
const double* coef_normalized,
2023-11-29 02:10:20 +01:00
double* const shell_vgl );
2022-01-05 15:56:25 +01:00
#+end_src
2021-10-13 15:01:23 +02:00
2022-01-05 19:22:16 +01:00
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
2023-09-22 16:41:43 +02:00
function qmckl_compute_ao_basis_shell_gaussian_vgl( &
2022-01-26 17:06:51 +01:00
context, prim_num, shell_num, point_num, nucl_num, &
2022-02-14 19:11:37 +01:00
nucleus_shell_num, nucleus_index, nucleus_range, &
shell_prim_index, shell_prim_num, coord, nucl_coord, &
expo, coef_normalized, shell_vgl) &
2023-09-22 16:41:43 +02:00
bind(C) result(info)
use qmckl_constants
2024-01-11 14:33:40 +01:00
use qmckl, only: qmckl_get_numprec_precision
2023-09-22 16:41:43 +02:00
2021-06-22 23:33:09 +02:00
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: prim_num
integer (c_int64_t) , intent(in) , value :: shell_num
integer (c_int64_t) , intent(in) , value :: point_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num)
integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num)
real (c_double ) , intent(in) :: nucleus_range(nucl_num)
integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num)
integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num)
real (c_double ) , intent(in) :: coord(point_num,3)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
real (c_double ) , intent(in) :: expo(prim_num)
real (c_double ) , intent(in) :: coef_normalized(prim_num)
real (c_double ) , intent(out) :: shell_vgl(shell_num,5,point_num)
integer(qmckl_exit_code) :: info
2021-06-22 23:33:09 +02:00
2022-01-26 17:06:51 +01:00
integer*8 :: inucl, iprim, ipoint, ishell
2022-01-05 19:22:16 +01:00
integer*8 :: ishell_start, ishell_end
integer*8 :: iprim_start , iprim_end
2021-06-22 23:33:09 +02:00
double precision :: x, y, z, two_a, ar2, r2, v, cutoff
info = QMCKL_SUCCESS
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2021-06-22 23:33:09 +02:00
! Don't compute exponentials when the result will be almost zero.
2024-01-11 14:33:40 +01:00
<<fortran_cutoff>>
2021-06-22 23:33:09 +02:00
2022-02-14 19:11:37 +01:00
do ipoint = 1, point_num
2022-01-05 19:22:16 +01:00
2022-02-14 19:11:37 +01:00
do inucl=1,nucl_num
2021-06-22 23:33:09 +02:00
2024-05-08 13:56:32 +02:00
! The shift below avoids having an exact zero on a node of the orbital
2022-01-26 17:06:51 +01:00
x = coord(ipoint,1) - nucl_coord(inucl,1)
y = coord(ipoint,2) - nucl_coord(inucl,2)
z = coord(ipoint,3) - nucl_coord(inucl,3)
2021-06-22 23:33:09 +02:00
2021-09-23 11:16:54 +02:00
r2 = x*x + y*y + z*z
2021-06-22 23:33:09 +02:00
2023-11-30 12:56:06 +01:00
if (r2 > cutoff*nucleus_range(inucl)) then
2022-02-14 19:11:37 +01:00
cycle
end if
! C is zero-based, so shift bounds by one
ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
2022-01-05 19:22:16 +01:00
do ishell=ishell_start, ishell_end
2021-07-08 19:20:19 +02:00
shell_vgl(ishell, 1, ipoint) = 0.d0
shell_vgl(ishell, 2, ipoint) = 0.d0
shell_vgl(ishell, 3, ipoint) = 0.d0
shell_vgl(ishell, 4, ipoint) = 0.d0
shell_vgl(ishell, 5, ipoint) = 0.d0
2021-06-22 23:33:09 +02:00
2022-01-05 19:22:16 +01:00
iprim_start = shell_prim_index(ishell) + 1
iprim_end = shell_prim_index(ishell) + shell_prim_num(ishell)
do iprim = iprim_start, iprim_end
2021-06-22 23:33:09 +02:00
2021-09-23 11:16:54 +02:00
ar2 = expo(iprim)*r2
if (ar2 > cutoff) then
cycle
end if
2021-06-22 23:33:09 +02:00
2021-09-23 11:16:54 +02:00
v = coef_normalized(iprim) * dexp(-ar2)
two_a = -2.d0 * expo(iprim) * v
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
shell_vgl(ishell, 1, ipoint) = &
shell_vgl(ishell, 1, ipoint) + v
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
shell_vgl(ishell, 2, ipoint) = &
shell_vgl(ishell, 2, ipoint) + two_a * x
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
shell_vgl(ishell, 3, ipoint) = &
shell_vgl(ishell, 3, ipoint) + two_a * y
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
shell_vgl(ishell, 4, ipoint) = &
shell_vgl(ishell, 4, ipoint) + two_a * z
2021-06-22 23:33:09 +02:00
shell_vgl(ishell, 5, ipoint) = &
shell_vgl(ishell, 5, ipoint) + two_a * (3.d0 - 2.d0*ar2)
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2021-06-22 23:33:09 +02:00
end do
2021-09-23 11:16:54 +02:00
2021-06-22 23:33:09 +02:00
end do
end do
2021-09-23 11:16:54 +02:00
2021-06-22 23:33:09 +02:00
end do
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
2023-09-22 16:41:43 +02:00
end function qmckl_compute_ao_basis_shell_gaussian_vgl
2022-01-05 19:22:16 +01:00
#+end_src
2021-06-22 23:33:09 +02:00
2022-01-05 15:56:25 +01:00
*** Provide :noexport:
#+CALL: write_provider_header( group="ao_basis", data="shell_vgl" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
2022-01-05 15:56:25 +01:00
qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context);
#+end_src
2022-01-05 15:56:25 +01:00
#+CALL: write_provider_pre( group="ao_basis", data="shell_vgl", dimension="ctx->ao_basis.shell_num * 5 * ctx->point.num")
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
2022-01-05 15:56:25 +01:00
qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
{
2022-08-07 14:57:10 +02:00
qmckl_exit_code rc = QMCKL_SUCCESS;
2022-01-05 15:56:25 +01:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_ao_basis_shell_vgl",
NULL);
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 15:56:25 +01:00
assert (ctx != NULL);
if (!ctx->ao_basis.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_ao_basis_shell_vgl",
NULL);
}
/* Compute if necessary */
2022-01-26 17:06:51 +01:00
if (ctx->point.date > ctx->ao_basis.shell_vgl_date) {
2022-01-05 15:56:25 +01:00
2022-08-07 14:57:10 +02:00
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.shell_num * 5 * ctx->point.num * sizeof(double);
if (ctx->ao_basis.shell_vgl != NULL) {
qmckl_memory_info_struct mem_info_test = qmckl_memory_info_struct_zero;
rc = qmckl_get_malloc_info(context, ctx->ao_basis.shell_vgl, &mem_info_test);
/* if rc != QMCKL_SUCCESS, we are maybe in an _inplace function because the
memory was not allocated with qmckl_malloc */
if ((rc == QMCKL_SUCCESS) && (mem_info_test.size != mem_info.size)) {
rc = qmckl_free(context, ctx->ao_basis.shell_vgl);
assert (rc == QMCKL_SUCCESS);
ctx->ao_basis.shell_vgl = NULL;
}
}
2022-01-05 15:56:25 +01:00
/* Allocate array */
if (ctx->ao_basis.shell_vgl == NULL) {
double* shell_vgl = (double*) qmckl_malloc(context, mem_info);
if (shell_vgl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_ao_basis_shell_vgl",
NULL);
}
ctx->ao_basis.shell_vgl = shell_vgl;
}
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-01-05 15:56:25 +01:00
if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_ao_basis_shell_gaussian_vgl(context,
2022-01-05 19:22:16 +01:00
ctx->ao_basis.prim_num,
ctx->ao_basis.shell_num,
2022-01-26 17:06:51 +01:00
ctx->point.num,
2022-01-05 19:22:16 +01:00
ctx->nucleus.num,
ctx->ao_basis.nucleus_shell_num,
ctx->ao_basis.nucleus_index,
2023-11-30 12:56:06 +01:00
ctx->ao_basis.nucleus_range,
2022-01-05 19:22:16 +01:00
ctx->ao_basis.shell_prim_index,
ctx->ao_basis.shell_prim_num,
2022-01-26 17:06:51 +01:00
ctx->point.coord.data,
2022-01-23 16:18:46 +01:00
ctx->nucleus.coord.data,
2022-01-05 19:22:16 +01:00
ctx->ao_basis.exponent,
ctx->ao_basis.coefficient_normalized,
ctx->ao_basis.shell_vgl);
2022-01-05 15:56:25 +01:00
} else {
return qmckl_failwith( context,
QMCKL_FAILURE,
"compute_ao_basis_shell_vgl",
"Not yet implemented");
}
#+end_src
#+CALL: write_provider_post( group="ao_basis", data="shell_vgl" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
2022-01-05 15:56:25 +01:00
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->ao_basis.shell_vgl_date = ctx->date;
}
return QMCKL_SUCCESS;
}
#+end_src
2022-01-05 15:56:25 +01:00
*** Test :noexport:
2021-06-22 23:33:09 +02:00
#+begin_src python :results output :exports none
import numpy as np
def f(a,x,y):
Integration of Verificarlo CI tests (#1) * comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
2021-07-07 13:42:42 +02:00
return np.sum( [c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] )
2021-06-22 23:33:09 +02:00
def df(a,x,y,n):
h0 = 1.e-6
if n == 1: h = np.array([h0,0.,0.])
elif n == 2: h = np.array([0.,h0,0.])
elif n == 3: h = np.array([0.,0.,h0])
return ( f(a,x+h,y) - f(a,x-h,y) ) / (2.*h0)
def d2f(a,x,y,n):
h0 = 1.e-6
if n == 1: h = np.array([h0,0.,0.])
elif n == 2: h = np.array([0.,h0,0.])
elif n == 3: h = np.array([0.,0.,h0])
return ( f(a,x+h,y) - 2.*f(a,x,y) + f(a,x-h,y) ) / h0**2
def lf(a,x,y):
return d2f(a,x,y,1) + d2f(a,x,y,2) + d2f(a,x,y,3)
elec_26_w1 = np.array( [ 1.49050402641, 2.90106987953, -1.05920815468 ] )
elec_15_w2 = np.array( [ -2.20180344582,-1.9113150239, 2.2193744778600002 ] )
nucl_1 = np.array( [ 1.096243353458458e+00, 8.907054016973815e-01, 7.777092280258892e-01 ] )
nucl_2 = np.array( [ 1.168459237342663e+00, 1.125660720053393e+00, 2.833370314829343e+00 ] )
2022-01-26 17:06:51 +01:00
#double prim_vgl[prim_num][5][point_num];
2021-06-22 23:33:09 +02:00
x = elec_26_w1 ; y = nucl_1
2021-07-11 23:20:40 +02:00
a = [( 8.236000E+03, -1.130000E-04 * 6.1616545431994848e+02 ),
( 1.235000E+03, -8.780000E-04 * 1.4847738511079908e+02 ),
( 2.808000E+02, -4.540000E-03 * 4.8888635917437597e+01 ),
( 7.927000E+01, -1.813300E-02 * 1.8933972232608955e+01 ),
( 2.559000E+01, -5.576000E-02 * 8.1089160941724145e+00 ),
( 8.997000E+00, -1.268950E-01 * 3.7024003863155635e+00 ),
( 3.319000E+00, -1.703520E-01 * 1.7525302846177560e+00 ),
( 9.059000E-01, 1.403820E-01 * 6.6179013183966806e-01 ),
( 3.643000E-01, 5.986840E-01 * 3.3419848027174592e-01 ),
( 1.285000E-01, 3.953890E-01 * 1.5296336817449557e-01 )]
2021-09-23 11:16:54 +02:00
print ( "[1][0][26] : %25.15e"% f(a,x,y))
print ( "[1][1][26] : %25.15e"% df(a,x,y,1))
print ( "[1][2][26] : %25.15e"% df(a,x,y,2))
print ( "[1][3][26] : %25.15e"% df(a,x,y,3))
print ( "[1][4][26] : %25.15e"% lf(a,x,y))
2021-06-22 23:33:09 +02:00
#+end_src
#+RESULTS:
2021-09-23 11:16:54 +02:00
: [1][0][26] : 3.564393437193867e-02
: [1][1][26] : -6.030177988891605e-03
: [1][2][26] : -3.074832579871845e-02
: [1][3][26] : 2.809546963133958e-02
: [1][4][26] : 1.903338597841753e-02
2021-06-22 23:33:09 +02:00
2022-01-05 19:22:16 +01:00
#+begin_src c :tangle (eval c_test) :exports none
2021-06-22 23:33:09 +02:00
{
#define shell_num chbrclf_shell_num
2022-01-05 19:22:16 +01:00
double* elec_coord = &(chbrclf_elec_coord[0][0][0]);
2021-06-22 23:33:09 +02:00
2022-01-05 19:22:16 +01:00
assert(qmckl_electron_provided(context));
2021-06-22 23:33:09 +02:00
2023-09-14 11:00:24 +02:00
int64_t point_num = elec_num;
2022-08-07 14:57:10 +02:00
rc = qmckl_set_point(context, 'N', point_num, elec_coord, point_num*3);
2022-01-05 19:22:16 +01:00
assert(rc == QMCKL_SUCCESS);
2021-06-22 23:33:09 +02:00
2022-08-07 14:57:10 +02:00
double shell_vgl[point_num][5][shell_num];
2021-06-22 23:33:09 +02:00
2022-01-06 02:28:13 +01:00
rc = qmckl_get_ao_basis_shell_vgl(context, &(shell_vgl[0][0][0]),
2022-08-07 14:57:10 +02:00
(int64_t) 5*point_num*shell_num);
2022-01-05 19:22:16 +01:00
assert (rc == QMCKL_SUCCESS);
2021-06-22 23:33:09 +02:00
printf(" shell_vgl[26][0][1] %25.15e\n", shell_vgl[26][0][1]);
printf(" shell_vgl[26][1][1] %25.15e\n", shell_vgl[26][1][1]);
printf(" shell_vgl[26][2][1] %25.15e\n", shell_vgl[26][2][1]);
printf(" shell_vgl[26][3][1] %25.15e\n", shell_vgl[26][3][1]);
printf(" shell_vgl[26][4][1] %25.15e\n", shell_vgl[26][4][1]);
2021-10-13 15:01:23 +02:00
assert( fabs(shell_vgl[26][0][1] - ( 3.564393437193868e-02)) < 1.e-14 );
assert( fabs(shell_vgl[26][1][1] - (-6.030177987072189e-03)) < 1.e-14 );
assert( fabs(shell_vgl[26][2][1] - (-3.074832579537582e-02)) < 1.e-14 );
assert( fabs(shell_vgl[26][3][1] - ( 2.809546963519935e-02)) < 1.e-14 );
assert( fabs(shell_vgl[26][4][1] - ( 1.896046117183968e-02)) < 1.e-14 );
2021-10-13 15:01:23 +02:00
}
2022-01-05 19:22:16 +01:00
#+end_src
2022-01-06 02:28:13 +01:00
2021-06-10 22:57:59 +02:00
* Polynomial part
2021-07-11 23:20:40 +02:00
Going from the atomic basis set to AOs implies a systematic
construction of all the angular functions of each shell. We
consider two cases for the angular functions: the real-valued
spherical harmonics, and the polynomials in Cartesian coordinates.
In the case of spherical harmonics, the AOs are ordered in
increasing magnetic quantum number ($-l \le m \le l$), and in the
case of polynomials we choose the canonical ordering, i.e
\begin{eqnarray}
p & : & p_x, p_y, p_z \nonumber \\
d & : & d_{xx}, d_{xy}, d_{xz}, d_{yy}, d_{yz}, d_{zz} \nonumber \\
f & : & f_{xxx}, f_{xxy}, f_{xxz}, f_{xyy}, f_{xyz}, f_{xzz}, f_{yyy}, f_{yyz}, f_{yzz}, f_{zzz} \nonumber \\
{\rm etc.} \nonumber
\end{eqnarray}
2021-06-10 22:57:59 +02:00
** General functions for Powers of $x-X_i$
:PROPERTIES:
:Name: qmckl_ao_power
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
The ~qmckl_ao_power~ function computes all the powers of the ~n~
input data up to the given maximum value given in input for each of
the $n$ points:
\[ P_{ik} = X_i^k \]
#+NAME: qmckl_ao_power_args
2022-01-05 15:56:25 +01:00
| Variable | Type | In/Out | Description |
|-----------+-----------------+--------+---------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~n~ | int64_t | in | Number of values |
| ~X~ | double[n] | in | Array containing the input values |
| ~LMAX~ | int32_t[n] | in | Array containing the maximum power for each value |
| ~P~ | double[n][ldp] | out | Array containing all the powers of ~X~ |
| ~ldp~ | int64_t | in | Leading dimension of array ~P~ |
Requirements:
- ~context~ is not ~QMCKL_NULL_CONTEXT~
- ~n~ > 0
- ~X~ is allocated with at least $n \times 8$ bytes
- ~LMAX~ is allocated with at least $n \times 4$ bytes
- ~P~ is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes
- ~LDP~ >= $\max_i$ ~LMAX[i]~
#+CALL: generate_c_header(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power")
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
2022-01-05 19:22:16 +01:00
qmckl_exit_code qmckl_ao_power (
const qmckl_context context,
const int64_t n,
const double* X,
const int32_t* LMAX,
double* const P,
2023-11-29 02:10:20 +01:00
const int64_t ldp );
2022-01-05 15:56:25 +01:00
#+end_src
#+begin_src f90 :tangle (eval f)
2023-09-22 16:41:43 +02:00
function qmckl_ao_power(context, n, X, LMAX, P, ldp) &
bind(C) result(info)
use qmckl_constants
2021-06-10 22:57:59 +02:00
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: n
2024-02-23 11:56:28 +01:00
integer (c_int64_t) , intent(in) , value :: ldp
2023-09-22 16:41:43 +02:00
real (c_double ) , intent(in) :: X(n)
integer (c_int32_t) , intent(in) :: LMAX(n)
real (c_double ) , intent(out) :: P(ldp,n)
integer(qmckl_exit_code) :: info
integer(c_int64_t) :: i,k
2021-06-10 22:57:59 +02:00
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (n <= ldp) then
info = QMCKL_INVALID_ARG_2
return
endif
k = MAXVAL(LMAX)
if (LDP < k) then
info = QMCKL_INVALID_ARG_6
return
endif
if (k <= 0) then
info = QMCKL_INVALID_ARG_4
return
endif
do i=1,n
P(1,i) = X(i)
do k=2,LMAX(i)
P(k,i) = P(k-1,i) * X(i)
end do
end do
2023-09-22 16:41:43 +02:00
end function qmckl_ao_power
2022-01-05 15:56:25 +01:00
#+end_src
2021-06-10 22:57:59 +02:00
#+CALL: generate_f_interface(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power")
#+RESULTS:
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) function qmckl_ao_power &
2021-06-10 22:57:59 +02:00
(context, n, X, LMAX, P, ldp) &
bind(C)
use :: qmckl_constants
2021-06-10 22:57:59 +02:00
import
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
2021-06-10 22:57:59 +02:00
integer (c_int64_t) , intent(in) , value :: n
2024-02-23 11:56:28 +01:00
integer (c_int64_t) , intent(in) , value :: ldp
2022-01-05 19:22:16 +01:00
real (c_double ) , intent(in) :: X(n)
integer (c_int32_t) , intent(in) :: LMAX(n)
real (c_double ) , intent(out) :: P(ldp,n)
2021-06-10 22:57:59 +02:00
end function qmckl_ao_power
end interface
#+end_src
2022-01-05 15:56:25 +01:00
*** Test :noexport:
2021-06-10 22:57:59 +02:00
#+begin_src f90 :tangle (eval f_test)
2023-11-29 02:10:20 +01:00
function test_qmckl_ao_power(context) bind(C)
2021-06-10 22:57:59 +02:00
use qmckl
implicit none
integer(qmckl_context), intent(in), value :: context
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) :: test_qmckl_ao_power
2021-04-01 01:19:33 +02:00
2021-04-30 01:26:19 +02:00
integer*8 :: n, LDP
integer, allocatable :: LMAX(:)
2021-04-01 01:19:33 +02:00
double precision, allocatable :: X(:), P(:,:)
integer*8 :: i,j
double precision :: epsilon
2024-01-11 14:33:40 +01:00
epsilon = qmckl_get_numprec_precision(context)
2021-04-01 01:19:33 +02:00
n = 100;
LDP = 10;
allocate(X(n), P(LDP,n), LMAX(n))
do j=1,n
X(j) = -5.d0 + 0.1d0 * dble(j)
LMAX(j) = 1 + int(mod(j, 5),4)
end do
2021-04-30 01:26:19 +02:00
test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP)
2021-04-01 01:19:33 +02:00
if (test_qmckl_ao_power /= QMCKL_SUCCESS) return
test_qmckl_ao_power = QMCKL_FAILURE
do j=1,n
do i=1,LMAX(j)
if ( X(j)**i == 0.d0 ) then
if ( P(i,j) /= 0.d0) return
else
if ( dabs(1.d0 - P(i,j) / (X(j)**i)) > epsilon ) return
end if
end do
end do
test_qmckl_ao_power = QMCKL_SUCCESS
deallocate(X,P,LMAX)
end function test_qmckl_ao_power
2021-04-16 00:57:08 +02:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-04-16 00:57:08 +02:00
#+begin_src c :tangle (eval c_test) :exports none
2022-01-05 15:56:25 +01:00
int test_qmckl_ao_power(qmckl_context context);
assert(0 == test_qmckl_ao_power(context));
2021-04-16 00:57:08 +02:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-06-10 22:57:59 +02:00
** General functions for Value, Gradient and Laplacian of a polynomial
2021-04-16 00:57:08 +02:00
:PROPERTIES:
:Name: qmckl_ao_polynomial_vgl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
2021-04-01 01:19:33 +02:00
A polynomial is centered on a nucleus $\mathbf{R}_i$
2021-04-30 01:26:19 +02:00
2021-04-01 01:19:33 +02:00
\[
2021-04-30 01:26:19 +02:00
P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c
2021-04-01 01:19:33 +02:00
\]
The gradients with respect to electron coordinates are
2021-04-30 01:26:19 +02:00
\begin{eqnarray*}
2021-04-01 01:19:33 +02:00
\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} \\
2021-04-30 01:26:19 +02:00
\end{eqnarray*}
2021-04-01 01:19:33 +02:00
and the Laplacian is
2021-04-30 01:26:19 +02:00
\begin{eqnarray*}
\left( \frac{\partial }{\partial x^2} +
\frac{\partial }{\partial y^2} +
2021-04-01 01:19:33 +02:00
\frac{\partial }{\partial z^2} \right) P_l
2021-04-30 01:26:19 +02:00
\left(\mathbf{r},\mathbf{R}_i \right) & = &
2021-04-01 01:19:33 +02:00
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-2} (z-Z_i)^c + \\
&& c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-2}.
2021-04-01 01:19:33 +02:00
\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~.
2021-04-16 00:57:08 +02:00
#+NAME: qmckl_ao_polynomial_vgl_args
2022-01-05 19:22:16 +01:00
| Variable | Type | In/Out | Description |
|-----------+-------------------+--------+------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~X~ | ~double[3]~ | in | Array containing the coordinates of the points |
| ~R~ | ~double[3]~ | in | Array containing the x,y,z coordinates of the center |
| ~lmax~ | ~int32_t~ | in | Maximum angular momentum |
| ~n~ | ~int64_t~ | inout | Number of computed polynomials |
| ~L~ | ~int32_t[n][ldl]~ | out | Contains a,b,c for all ~n~ results |
| ~ldl~ | ~int64_t~ | in | Leading dimension of ~L~ |
| ~VGL~ | ~double[n][ldv]~ | out | Value, gradients and Laplacian of the polynomials |
| ~ldv~ | ~int64_t~ | in | Leading dimension of array ~VGL~ |
Requirements:
- ~context~ \ne ~QMCKL_NULL_CONTEXT~
2021-04-16 00:57:08 +02:00
- ~n~ > 0
- ~lmax~ >= 0
- ~ldl~ >= 3
- ~ldv~ >= 5
- ~X~ is allocated with at least $3 \times 8$ bytes
- ~R~ is allocated with at least $3 \times 8$ bytes
- ~n~ >= ~(lmax+1)(lmax+2)(lmax+3)/6~
- ~L~ is allocated with at least $3 \times n \times 4$ bytes
- ~VGL~ is allocated with at least $5 \times n \times 8$ bytes
- On output, ~n~ should be equal to ~(lmax+1)(lmax+2)(lmax+3)/6~
- On output, the powers are given in the following order (l=a+b+c):
- Increasing values of ~l~
- Within a given value of ~l~, alphabetical order of the
string made by a*"x" + b*"y" + c*"z" (in Python notation).
For example, with a=0, b=2 and c=1 the string is "yyz"
#+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_ao_polynomial_vgl (
const qmckl_context context,
const double* X,
const double* R,
const int32_t lmax,
int64_t* n,
int32_t* const L,
const int64_t ldl,
double* const VGL,
2023-11-29 02:10:20 +01:00
const int64_t ldv );
2021-04-16 00:57:08 +02:00
#+end_src
2022-02-16 01:12:42 +01:00
#+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_vgl_doc")
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_ao_polynomial_vgl_doc (
const qmckl_context context,
const double* X,
const double* R,
const int32_t lmax,
int64_t* n,
int32_t* const L,
const int64_t ldl,
double* const VGL,
2023-11-29 02:10:20 +01:00
const int64_t ldv );
2022-02-16 01:12:42 +01:00
#+end_src
#+begin_src c :tangle (eval c) :comments org
qmckl_exit_code
qmckl_ao_polynomial_vgl (const qmckl_context context,
const double* X,
const double* R,
const int32_t lmax,
int64_t* n,
int32_t* const L,
const int64_t ldl,
double* const VGL,
const int64_t ldv )
{
#ifdef HAVE_HPC
//return qmckl_ao_polynomial_vgl_hpc (context, X, R, lmax, n, L, ldl, VGL, ldv);
2023-09-22 16:41:43 +02:00
return qmckl_ao_polynomial_vgl_doc
2022-02-16 01:12:42 +01:00
#else
2023-09-22 16:41:43 +02:00
return qmckl_ao_polynomial_vgl_doc
2022-02-19 19:24:18 +01:00
#endif
2023-09-22 16:41:43 +02:00
(context, X, R, lmax, n, L, ldl, VGL, ldv);
2022-02-16 01:12:42 +01:00
}
#+end_src
2021-04-16 00:57:08 +02:00
#+begin_src f90 :tangle (eval f)
2023-09-22 16:41:43 +02:00
function qmckl_ao_polynomial_vgl_doc (context, &
X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C) result(info)
use qmckl_constants
2021-04-01 01:19:33 +02:00
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
real (c_double ) , intent(in) :: X(3)
real (c_double ) , intent(in) :: R(3)
integer (c_int32_t) , intent(in) , value :: lmax
integer (c_int64_t) , intent(inout) :: n
integer (c_int64_t) , intent(in) , value :: ldl
integer (c_int64_t) , intent(in) , value :: ldv
2024-02-23 16:37:31 +01:00
integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6)
real (c_double ) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6)
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) :: info
2021-04-01 01:19:33 +02:00
integer*8 :: i,j
integer :: a,b,c,d
2023-08-24 09:59:57 +02:00
double precision :: Y(3)
double precision :: pows(-2:lmax,3)
2021-04-01 01:19:33 +02:00
double precision :: xy, yz, xz
double precision :: da, db, dc, dd
info = 0
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (lmax < 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (ldl < 3) then
info = QMCKL_INVALID_ARG_7
return
endif
if (ldv < 5) then
info = QMCKL_INVALID_ARG_9
return
endif
2024-05-08 13:56:32 +02:00
! The shift below is such that polynomials will not make the AO equal to zero at the nodes of the orbitals
2021-04-01 01:19:33 +02:00
do i=1,3
2024-05-08 13:56:32 +02:00
Y(i) = X(i) - R(i) + 1.d-20
2021-04-01 01:19:33 +02:00
end do
if (lmax == 0) then
VGL(1,1) = 1.d0
2023-08-24 09:59:57 +02:00
VGL(2,1) = 0.d0
VGL(3,1) = 0.d0
VGL(4,1) = 0.d0
VGL(5,1) = 0.d0
l(1,1) = 0
l(2,1) = 0
l(3,1) = 0
2021-04-01 01:19:33 +02:00
n=1
else if (lmax > 0) then
pows(-2:0,1:3) = 1.d0
do i=1,lmax
2021-04-30 01:26:19 +02:00
pows(i,1) = pows(i-1,1) * Y(1)
pows(i,2) = pows(i-1,2) * Y(2)
pows(i,3) = pows(i-1,3) * Y(3)
2021-04-01 01:19:33 +02:00
end do
VGL(1:5,1:4) = 0.d0
2023-08-24 09:59:57 +02:00
VGL(1,1) = 1.d0
2022-02-09 18:06:46 +01:00
VGL(1,2) = pows(1,1)
VGL(2,2) = 1.d0
VGL(1,3) = pows(1,2)
VGL(3,3) = 1.d0
VGL(1,4) = pows(1,3)
VGL(4,4) = 1.d0
2021-04-01 01:19:33 +02:00
2023-08-24 09:59:57 +02:00
l (1:3,1:4) = 0
l (1,2) = 1
l (2,3) = 1
l (3,4) = 1
2021-04-01 01:19:33 +02:00
n=4
endif
! l>=2
dd = 2.d0
do d=2,lmax
da = dd
do a=d,0,-1
db = dd-da
do b=d-a,0,-1
c = d - a - b
dc = dd - da - db
n = n+1
l(1,n) = a
l(2,n) = b
l(3,n) = c
xy = pows(a,1) * pows(b,2)
yz = pows(b,2) * pows(c,3)
xz = pows(a,1) * pows(c,3)
2022-02-09 18:06:46 +01:00
VGL(1,n) = xy * pows(c,3)
2021-04-01 01:19:33 +02:00
xy = dc * xy
xz = db * xz
yz = da * yz
2022-02-09 18:06:46 +01:00
VGL(2,n) = pows(a-1,1) * yz
VGL(3,n) = pows(b-1,2) * xz
VGL(4,n) = pows(c-1,3) * xy
2021-04-01 01:19:33 +02:00
2022-02-09 18:06:46 +01:00
VGL(5,n) = &
2021-04-01 01:19:33 +02:00
(da-1.d0) * pows(a-2,1) * yz + &
(db-1.d0) * pows(b-2,2) * xz + &
(dc-1.d0) * pows(c-2,3) * xy
db = db - 1.d0
end do
da = da - 1.d0
end do
dd = dd + 1.d0
end do
info = QMCKL_SUCCESS
2023-09-22 16:41:43 +02:00
end function qmckl_ao_polynomial_vgl_doc
2022-02-16 01:12:42 +01:00
#+end_src
#+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("FRetType"),fname="qmckl_ao_polynomial_vgl_doc" )
#+RESULTS:
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) function qmckl_ao_polynomial_vgl_doc &
2022-02-16 01:12:42 +01:00
(context, X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C)
use qmckl_constants
2022-02-16 01:12:42 +01:00
import
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
2022-02-16 01:12:42 +01:00
real (c_double ) , intent(in) :: X(3)
real (c_double ) , intent(in) :: R(3)
integer (c_int32_t) , intent(in) , value :: lmax
integer (c_int64_t) , intent(inout) :: n
integer (c_int64_t) , intent(in) , value :: ldl
integer (c_int64_t) , intent(in) , value :: ldv
2024-02-23 11:56:28 +01:00
integer (c_int32_t) , intent(out) :: L(ldl,n)
real (c_double ) , intent(out) :: VGL(ldv,n)
2022-02-16 01:12:42 +01:00
end function qmckl_ao_polynomial_vgl_doc
end interface
2021-04-16 00:57:08 +02:00
#+end_src
2022-02-16 01:12:42 +01:00
#+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("FRetType"),fname="qmckl_ao_polynomial_vgl" )
2021-04-16 00:57:08 +02:00
#+RESULTS:
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) function qmckl_ao_polynomial_vgl &
2021-04-16 00:57:08 +02:00
(context, X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C)
use qmckl_constants
2021-04-16 00:57:08 +02:00
import
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
2021-04-16 00:57:08 +02:00
real (c_double ) , intent(in) :: X(3)
real (c_double ) , intent(in) :: R(3)
integer (c_int32_t) , intent(in) , value :: lmax
2024-02-23 11:56:28 +01:00
integer (c_int64_t) , intent(inout) :: n
2021-04-16 00:57:08 +02:00
integer (c_int64_t) , intent(in) , value :: ldl
integer (c_int64_t) , intent(in) , value :: ldv
2024-02-23 11:56:28 +01:00
integer (c_int32_t) , intent(out) :: L(ldl,n)
real (c_double ) , intent(out) :: VGL(ldv,n)
2021-04-16 00:57:08 +02:00
end function qmckl_ao_polynomial_vgl
end interface
#+end_src
2021-04-30 01:26:19 +02:00
2022-02-16 01:12:42 +01:00
#+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_transp_vgl")
2022-02-16 01:12:42 +01:00
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_ao_polynomial_transp_vgl (
const qmckl_context context,
const double* X,
const double* R,
const int32_t lmax,
int64_t* n,
int32_t* const L,
const int64_t ldl,
double* const VGL,
2023-11-29 02:10:20 +01:00
const int64_t ldv );
2022-02-16 01:12:42 +01:00
#+end_src
#+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_transp_vgl_doc")
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_ao_polynomial_transp_vgl_doc (
const qmckl_context context,
const double* X,
const double* R,
const int32_t lmax,
int64_t* n,
int32_t* const L,
const int64_t ldl,
double* const VGL,
2023-11-29 02:10:20 +01:00
const int64_t ldv );
2022-02-16 01:12:42 +01:00
#+end_src
2022-10-13 11:48:40 +02:00
# #+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_transp_vgl_hpc")
2022-02-16 15:14:41 +01:00
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_ao_polynomial_transp_vgl_hpc (
const qmckl_context context,
const double* X,
const double* R,
const int32_t lmax,
int64_t* n,
int32_t* const L,
const int64_t ldl,
double* const VGL,
2022-02-19 19:24:18 +01:00
const int64_t ldv );
2022-02-16 15:14:41 +01:00
#+end_src
2022-02-16 01:12:42 +01:00
#+begin_src c :tangle (eval c) :comments org
qmckl_exit_code
qmckl_ao_polynomial_transp_vgl (const qmckl_context context,
const double* X,
const double* R,
const int32_t lmax,
int64_t* n,
int32_t* const L,
const int64_t ldl,
double* const VGL,
const int64_t ldv )
{
#ifdef HAVE_HPC
2023-09-22 16:41:43 +02:00
return qmckl_ao_polynomial_transp_vgl_hpc
2022-02-16 01:12:42 +01:00
#else
2023-09-22 16:41:43 +02:00
return qmckl_ao_polynomial_transp_vgl_doc
2022-02-19 19:24:18 +01:00
#endif
2023-09-22 16:41:43 +02:00
(context, X, R, lmax, n, L, ldl, VGL, ldv);
2022-02-16 01:12:42 +01:00
}
#+end_src
#+begin_src f90 :tangle (eval f)
2023-09-22 16:41:43 +02:00
function qmckl_ao_polynomial_transp_vgl_doc (context, &
X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C) result(info)
use qmckl_constants
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
real (c_double ) , intent(in) :: X(3)
real (c_double ) , intent(in) :: R(3)
integer (c_int32_t) , intent(in) , value :: lmax
integer (c_int64_t) , intent(inout) :: n
integer (c_int64_t) , intent(in) , value :: ldl
integer (c_int64_t) , intent(in) , value :: ldv
2024-02-23 16:37:31 +01:00
integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6)
real (c_double ) , intent(out) :: VGL(ldv,5)
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) :: info
integer*8 :: i,j
integer :: a,b,c,d
real*8 :: Y(3)
2022-02-14 19:11:37 +01:00
real*8 :: pows(-2:21,3) ! lmax < 22
double precision :: xy, yz, xz
double precision :: da, db, dc, dd
info = 0
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (lmax < 0) then
info = QMCKL_INVALID_ARG_4
return
endif
if (ldl < 3) then
info = QMCKL_INVALID_ARG_7
return
endif
if (ldv < (lmax+1)*(lmax+2)*(lmax+3)/6) then
info = QMCKL_INVALID_ARG_9
return
endif
2022-02-14 19:11:37 +01:00
if (lmax > 0) then
do i=1,3
Y(i) = X(i) - R(i)
end do
pows(-2:0,1:3) = 1.d0
do i=1,lmax
pows(i,1) = pows(i-1,1) * Y(1)
pows(i,2) = pows(i-1,2) * Y(2)
pows(i,3) = pows(i-1,3) * Y(3)
end do
l (1:3,1:4) = 0
VGL(1:4,1:5) = 0.d0
VGL(1 ,1 ) = 1.d0
l (1,2) = 1
2022-02-16 15:14:41 +01:00
VGL(2,1) = Y(1)
VGL(2,2) = 1.d0
l (2,3) = 1
2022-02-16 15:14:41 +01:00
VGL(3,1) = Y(2)
VGL(3,3) = 1.d0
l (3,4) = 1
2022-02-16 15:14:41 +01:00
VGL(4,1) = Y(3)
VGL(4,4) = 1.d0
n=4
2022-02-19 19:24:18 +01:00
else
2022-02-14 19:11:37 +01:00
VGL(1,1) = 1.d0
VGL(1,2:5) = 0.d0
l(1:3,1) = 0
n=1
return
endif
! l>=2
dd = 2.d0
do d=2,lmax
da = dd
do a=d,0,-1
db = dd-da
do b=d-a,0,-1
c = d - a - b
dc = dd - da - db
n = n+1
xy = pows(a,1) * pows(b,2)
yz = pows(b,2) * pows(c,3)
xz = pows(a,1) * pows(c,3)
2022-02-16 15:14:41 +01:00
l(1,n) = a
l(2,n) = b
l(3,n) = c
VGL(n,1) = xy * pows(c,3)
xy = dc * xy
xz = db * xz
yz = da * yz
VGL(n,2) = pows(a-1,1) * yz
VGL(n,3) = pows(b-1,2) * xz
VGL(n,4) = pows(c-1,3) * xy
VGL(n,5) = &
(da-1.d0) * pows(a-2,1) * yz + &
(db-1.d0) * pows(b-2,2) * xz + &
(dc-1.d0) * pows(c-2,3) * xy
db = db - 1.d0
end do
da = da - 1.d0
end do
dd = dd + 1.d0
end do
info = QMCKL_SUCCESS
2023-09-22 16:41:43 +02:00
end function qmckl_ao_polynomial_transp_vgl_doc
#+end_src
2022-02-16 15:14:41 +01:00
#+begin_src c :tangle (eval c) :comments org
2022-10-13 11:48:40 +02:00
static inline qmckl_exit_code
qmckl_ao_polynomial_transp_vgl_hpc_inline (const qmckl_context context,
2022-03-21 18:32:39 +01:00
const double* restrict X,
const double* restrict R,
2022-02-16 15:14:41 +01:00
const int32_t lmax,
2022-05-06 11:30:21 +02:00
int64_t* n,
2022-03-21 18:32:39 +01:00
int32_t* restrict const L,
2022-02-16 15:14:41 +01:00
const int64_t ldl,
2022-03-21 18:32:39 +01:00
double* restrict const VGL,
2022-02-16 15:14:41 +01:00
const int64_t ldv )
{
2022-04-05 11:03:38 +02:00
const qmckl_context_struct* ctx = (qmckl_context_struct*) context;
2022-02-16 15:14:41 +01:00
assert (ctx != NULL && X != NULL && R != NULL && n != NULL && L != NULL && VGL != NULL);
if (lmax < 0) return QMCKL_INVALID_ARG_4;
if (ldl < 3) return QMCKL_INVALID_ARG_7;
int32_t m;
2024-05-08 13:56:32 +02:00
const double shift=1.e-20;
2022-02-16 15:14:41 +01:00
switch (lmax) {
case 0:
{
if (ldv < 1) return QMCKL_INVALID_ARG_9;
2022-02-16 19:40:14 +01:00
L[0] = 0; L[1] = 0; L[2] = 0;
2022-02-16 15:14:41 +01:00
2022-02-16 19:49:05 +01:00
VGL[0 ] = 1.0;
VGL[ldv ] = 0.0;
VGL[ldv<<1 ] = 0.0;
2022-02-19 19:24:18 +01:00
VGL[(ldv<<1)+ldv] = 0.0;
2022-02-16 19:49:05 +01:00
VGL[ldv<<2 ] = 0.0;
2022-02-16 19:40:14 +01:00
m=1;
2022-02-16 15:14:41 +01:00
break;
}
case 1:
{
if (ldv < 4) return QMCKL_INVALID_ARG_9;
2022-02-16 19:40:14 +01:00
if (ldl == 3) {
const int32_t ltmp[12] = {0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1};
for (int i=0 ; i<12 ; ++i)
L[i] = ltmp[i];
2022-02-19 19:24:18 +01:00
2022-02-16 19:40:14 +01:00
} else {
2022-03-21 18:32:39 +01:00
int32_t* restrict const l[4] = {L, L+ldl, L+(ldl<<1), L+ldl+(ldl<<1)};
2022-02-16 19:40:14 +01:00
l[0][0] = 0; l[0][1] = 0; l[0][2] = 0;
l[1][0] = 1; l[1][1] = 0; l[1][2] = 0;
l[2][0] = 0; l[2][1] = 1; l[2][2] = 0;
l[3][0] = 0; l[3][1] = 0; l[3][2] = 1;
2022-02-16 15:14:41 +01:00
}
2022-02-16 19:40:14 +01:00
if (ldv == 4) {
2024-05-08 13:56:32 +02:00
const double tmp[20] = {1.0, X[0]-R[0]+shift, X[1]-R[1]+shift, X[2]-R[2]+shift,
2022-02-17 12:36:16 +01:00
0.0, 1.0, 0.0, 0.0,
0.0, 0.0, 1.0, 0.0,
0.0, 0.0, 0.0, 1.0,
0.0, 0.0, 0.0, 0.0};
2022-02-16 19:40:14 +01:00
for (int i=0 ; i<20 ; ++i)
VGL[i] = tmp[i];
} else {
2022-03-21 18:32:39 +01:00
double* restrict const vgl1 = VGL;
double* restrict const vgl2 = VGL + ldv;
double* restrict const vgl3 = VGL + (ldv << 1);
double* restrict const vgl4 = VGL + ldv + (ldv << 1);
double* restrict const vgl5 = VGL + (ldv << 2);
2022-02-16 19:40:14 +01:00
for (int32_t k=0 ; k<4 ; ++k) {
vgl2[k] = 0.0;
vgl3[k] = 0.0;
vgl4[k] = 0.0;
vgl5[k] = 0.0;
}
vgl1[0] = 1.0;
2024-05-08 13:56:32 +02:00
vgl1[1] = X[0]-R[0]+shift;
vgl1[2] = X[1]-R[1]+shift;
vgl1[3] = X[2]-R[2]+shift;
2022-02-16 19:40:14 +01:00
vgl2[1] = 1.0;
vgl3[2] = 1.0;
vgl4[3] = 1.0;
2022-02-16 15:14:41 +01:00
}
m=4;
break;
}
case 2:
{
if (ldv < 10) return QMCKL_INVALID_ARG_9;
2022-02-16 19:40:14 +01:00
if (ldl == 3) {
2022-02-19 19:24:18 +01:00
const int32_t ltmp[30] = {0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1,
2022-02-16 19:40:14 +01:00
2, 0, 0, 1, 1, 0, 1, 0, 1, 0, 2, 0,
0, 1, 1, 0, 0, 2};
for (int i=0 ; i<30 ; ++i)
L[i] = ltmp[i];
} else {
2022-03-21 18:32:39 +01:00
int32_t* restrict l[10];
2022-02-16 19:40:14 +01:00
for (int32_t i=0 ; i<10 ; ++i) {
l[i] = L + i*ldl;
}
2022-02-19 19:24:18 +01:00
2022-02-16 19:40:14 +01:00
l[0][0] = 0; l[0][1] = 0; l[0][2] = 0;
l[1][0] = 1; l[1][1] = 0; l[1][2] = 0;
l[2][0] = 0; l[2][1] = 1; l[2][2] = 0;
2022-02-19 19:24:18 +01:00
l[3][0] = 0; l[3][1] = 0; l[3][2] = 1;
2022-02-16 19:40:14 +01:00
l[4][0] = 2; l[4][1] = 0; l[4][2] = 0;
l[5][0] = 1; l[5][1] = 1; l[5][2] = 0;
l[6][0] = 1; l[6][1] = 0; l[6][2] = 1;
l[7][0] = 0; l[7][1] = 2; l[7][2] = 0;
l[8][0] = 0; l[8][1] = 1; l[8][2] = 1;
l[9][0] = 0; l[9][1] = 0; l[9][2] = 2;
}
2022-02-19 19:24:18 +01:00
const double Y[3] = { X[0]-R[0],
X[1]-R[1],
2022-02-16 15:14:41 +01:00
X[2]-R[2] };
2022-02-16 19:40:14 +01:00
if (ldv == 50) {
const double tmp[50] = {
2024-05-08 13:56:32 +02:00
1.0, Y[0]+shift, Y[1]+shift, Y[2]+shift,
Y[0] * Y[0]+shift, Y[0] * Y[1]+shift, Y[0] * Y[2]+shift,
Y[1] * Y[1]+shift, Y[1] * Y[2]+shift, Y[2] * Y[2]+shift,
0.0, 1.0, 0.0, 0.0,
Y[0] + Y[0], Y[1], Y[2], 0.0, 0.0, 0.0,
2022-02-16 19:40:14 +01:00
0.0, 0.0, 1.0, 0.0, 0.0,
Y[0], 0.0, Y[1] + Y[1], Y[2], 0.0,
0.0, 0.0, 0.0, 1.0, 0.0,
0.0, Y[0], 0.0, Y[1], Y[2] + Y[2],
0.0, 0.0, 0.0, 0.0, 2.0,
0.0, 0.0, 2.0, 0., 2.0 };
for (int i=0 ; i<50 ; ++i)
VGL[i] = tmp[i];
} else {
2022-03-21 18:32:39 +01:00
double* restrict const vgl1 = VGL;
double* restrict const vgl2 = VGL + ldv;
double* restrict const vgl3 = VGL + (ldv << 1);
double* restrict const vgl4 = VGL + 3*ldv;
double* restrict const vgl5 = VGL + (ldv << 2);
2022-02-16 19:40:14 +01:00
2024-05-08 13:56:32 +02:00
vgl1[0] = 1.0 ; vgl1[1] = Y[0]+shift ; vgl1[2] = Y[1]+shift;
vgl1[3] = Y[2]+shift ; vgl1[4] = Y[0]*Y[0]+shift; vgl1[5] = Y[0]*Y[1]+shift;
vgl1[6] = Y[0]*Y[2]+shift; vgl1[7] = Y[1]*Y[1]+shift; vgl1[8] = Y[1]*Y[2]+shift;
vgl1[9] = Y[2]*Y[2]+shift;
2022-02-16 19:40:14 +01:00
vgl2[0] = 0.0 ; vgl2[1] = 1.0 ; vgl2[2] = 0.0 ;
vgl2[3] = 0.0 ; vgl2[4] = Y[0]+Y[0]; vgl2[5] = Y[1];
vgl2[6] = Y[2]; vgl2[7] = 0.0 ; vgl2[8] = 0.0 ;
vgl2[9] = 0.0 ;
vgl3[0] = 0.0; vgl3[1] = 0.0 ; vgl3[2] = 1.0 ;
vgl3[3] = 0.0; vgl3[4] = 0.0 ; vgl3[5] = Y[0];
vgl3[6] = 0.0; vgl3[7] = Y[1]+Y[1]; vgl3[8] = Y[2];
vgl3[9] = 0.0;
vgl4[0] = 0.0 ; vgl4[1] = 0.0; vgl4[2] = 0.0 ;
vgl4[3] = 1.0 ; vgl4[4] = 0.0; vgl4[5] = 0.0 ;
vgl4[6] = Y[0] ; vgl4[7] = 0.0; vgl4[8] = Y[1];
vgl4[9] = Y[2]+Y[2];
vgl5[0] = 0.0; vgl5[1] = 0.0; vgl5[2] = 0.0;
vgl5[3] = 0.0; vgl5[4] = 2.0; vgl5[5] = 0.0;
vgl5[6] = 0.0; vgl5[7] = 2.0; vgl5[8] = 0.0;
vgl5[9] = 2.0;
2022-02-19 19:24:18 +01:00
}
2022-02-16 19:40:14 +01:00
m=10;
2022-02-16 15:14:41 +01:00
break;
}
2022-02-19 19:24:18 +01:00
default:
2022-02-16 15:14:41 +01:00
{
const int32_t size_max = (lmax+1)*(lmax+2)*(lmax+3)/6;
if (ldv < size_max) return QMCKL_INVALID_ARG_9;
2022-02-16 19:40:14 +01:00
2022-03-21 18:32:39 +01:00
double* restrict const vgl1 = VGL;
double* restrict const vgl2 = VGL + ldv;
double* restrict const vgl3 = VGL + (ldv<<1);
double* restrict const vgl4 = VGL + ldv + (ldv<<1);
double* restrict const vgl5 = VGL + (ldv<<2);
2022-02-19 19:24:18 +01:00
const double Y[3] = { X[0]-R[0],
X[1]-R[1],
2024-05-08 13:56:32 +02:00
X[2]-R[2]};
2022-02-16 19:40:14 +01:00
2022-02-19 19:24:18 +01:00
assert(size_max > lmax+3);
2022-02-16 15:14:41 +01:00
double pows[3][size_max];
2022-02-19 19:24:18 +01:00
for (int32_t i=0 ; i<3 ; ++i) {
2022-02-16 15:14:41 +01:00
pows[0][i] = 1.0;
pows[1][i] = 1.0;
pows[2][i] = 1.0;
}
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
for (int32_t i=3 ; i<=lmax+2 ; ++i) {
pows[0][i] = pows[0][i-1] * Y[0];
pows[1][i] = pows[1][i-1] * Y[1];
pows[2][i] = pows[2][i-1] * Y[2];
}
2022-02-19 19:24:18 +01:00
int32_t* l[size_max];
2022-02-16 15:14:41 +01:00
for (int32_t i=0 ; i<size_max ; ++i) {
2022-02-19 19:24:18 +01:00
l[i] = &(L[i*ldl]);
2022-02-16 15:14:41 +01:00
}
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
for (int32_t i=0 ; i<4 ; ++i) {
l[i][0] = 0;
l[i][1] = 0;
l[i][2] = 0;
}
l[1][0] = 1;
l[2][1] = 1;
l[3][2] = 1;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
for (int32_t k=0 ; k<4 ; ++k) {
vgl2[k] = 0.0;
vgl3[k] = 0.0;
vgl4[k] = 0.0;
vgl5[k] = 0.0;
}
vgl1[0] = 1.0;
2024-05-08 13:56:32 +02:00
vgl1[1] = Y[0]+shift;
vgl1[2] = Y[1]+shift;
vgl1[3] = Y[2]+shift;
2022-02-16 15:14:41 +01:00
vgl2[1] = 1.0;
vgl3[2] = 1.0;
vgl4[3] = 1.0;
m=4;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
double dd = 2.0;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
for (int32_t d=2 ; d<= lmax ; ++d) {
double da = dd;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
for (int32_t a=d ; a>=0 ; --a) {
double db = dd-da;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
for (int32_t b=d-a ; b>=0 ; --b) {
2022-02-19 19:24:18 +01:00
const int32_t c = d - a - b;
2022-02-16 15:14:41 +01:00
const double dc = dd - da - db;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
double xy = pows[0][a+2] * pows[1][b+2];
double yz = pows[1][b+2] * pows[2][c+2];
double xz = pows[0][a+2] * pows[2][c+2];
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
l[m][0] = a;
l[m][1] = b;
l[m][2] = c;
2022-02-19 19:24:18 +01:00
2024-05-08 13:56:32 +02:00
vgl1[m] = xy * pows[2][c+2]+shift;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
xy *= dc;
xz *= db;
yz *= da;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
vgl2[m] = pows[0][a+1] * yz;
vgl3[m] = pows[1][b+1] * xz;
vgl4[m] = pows[2][c+1] * xy;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
vgl5[m] = (da-1.) * pows[0][a] * yz +
(db-1.) * pows[1][b] * xz +
(dc-1.) * pows[2][c] * xy;
2022-02-19 19:24:18 +01:00
2022-02-16 15:14:41 +01:00
db -= 1.0;
++m;
}
da -= 1.0;
}
dd += 1.0;
}
}
}
,*n = m;
return QMCKL_SUCCESS;
}
2022-10-13 11:48:40 +02:00
qmckl_exit_code
qmckl_ao_polynomial_transp_vgl_hpc (const qmckl_context context,
const double* restrict X,
const double* restrict R,
const int32_t lmax,
int64_t* n,
int32_t* restrict const L,
const int64_t ldl,
double* restrict const VGL,
const int64_t ldv )
{
return qmckl_ao_polynomial_transp_vgl_hpc_inline (context,
X, R, lmax, n, L, ldl, VGL, ldv );
}
2022-02-16 15:14:41 +01:00
#+end_src
2022-02-16 01:12:42 +01:00
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) function qmckl_ao_polynomial_transp_vgl &
2022-02-16 01:12:42 +01:00
(context, X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C)
use qmckl_constants
2022-02-16 01:12:42 +01:00
import
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
2022-02-16 01:12:42 +01:00
real (c_double ) , intent(in) :: X(3)
real (c_double ) , intent(in) :: R(3)
integer (c_int32_t) , intent(in) , value :: lmax
integer (c_int64_t) , intent(inout) :: n
integer (c_int64_t) , intent(in) , value :: ldl
integer (c_int64_t) , intent(in) , value :: ldv
2024-02-23 11:56:28 +01:00
integer (c_int32_t) , intent(out) :: L(ldl,n)
real (c_double ) , intent(out) :: VGL(ldv,5)
end function qmckl_ao_polynomial_transp_vgl
2022-02-16 01:12:42 +01:00
end interface
#+end_src
2022-01-05 19:22:16 +01:00
*** Test :noexport:
2021-04-01 01:19:33 +02:00
2021-04-16 00:57:08 +02:00
#+begin_src f90 :tangle (eval f_test)
2023-11-29 02:10:20 +01:00
function test_qmckl_ao_polynomial_vgl(context) bind(C)
2021-04-01 01:19:33 +02:00
use qmckl
implicit none
2023-09-22 16:41:43 +02:00
integer(qmckl_context), intent(in), value :: context
2021-04-01 01:19:33 +02:00
integer :: lmax, d, i
integer, allocatable :: L(:,:)
integer*8 :: n, ldl, ldv, j
double precision :: X(3), R(3), Y(3)
double precision, allocatable :: VGL(:,:)
double precision :: w
double precision :: epsilon
2023-09-22 16:41:43 +02:00
integer(qmckl_exit_code) :: test_qmckl_ao_polynomial_vgl
2021-04-01 01:19:33 +02:00
2024-01-11 14:33:40 +01:00
epsilon = qmckl_get_numprec_precision(context)
2021-04-01 01:19:33 +02:00
X = (/ 1.1 , 2.2 , 3.3 /)
R = (/ 0.1 , 1.2 , -2.3 /)
Y(:) = X(:) - R(:)
lmax = 4;
ldl = 3;
ldv = 100;
d = (lmax+1)*(lmax+2)*(lmax+3)/6
allocate (L(ldl,d), VGL(ldv,d))
test_qmckl_ao_polynomial_vgl = &
qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv)
if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return
if (n /= d) return
do j=1,n
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
do i=1,3
if (L(i,j) < 0) return
end do
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (dabs(1.d0 - VGL(1,j) / (&
Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) &
)) > epsilon ) return
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (L(1,j) < 1) then
if (VGL(2,j) /= 0.d0) return
else
if (dabs(1.d0 - VGL(2,j) / (&
L(1,j) * Y(1)**(L(1,j)-1) * Y(2)**L(2,j) * Y(3)**L(3,j) &
)) > epsilon ) return
end if
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (L(2,j) < 1) then
if (VGL(3,j) /= 0.d0) return
else
if (dabs(1.d0 - VGL(3,j) / (&
L(2,j) * Y(1)**L(1,j) * Y(2)**(L(2,j)-1) * Y(3)**L(3,j) &
)) > epsilon ) return
end if
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (L(3,j) < 1) then
if (VGL(4,j) /= 0.d0) return
else
if (dabs(1.d0 - VGL(4,j) / (&
L(3,j) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-1) &
)) > epsilon ) return
end if
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
w = 0.d0
if (L(1,j) > 1) then
2021-04-30 01:26:19 +02:00
w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j)
2021-04-01 01:19:33 +02:00
end if
if (L(2,j) > 1) then
2021-04-30 01:26:19 +02:00
w = w + L(2,j) * (L(2,j)-1) * Y(1)**L(1,j) * Y(2)**(L(2,j)-2) * Y(3)**L(3,j)
2021-04-01 01:19:33 +02:00
end if
if (L(3,j) > 1) then
2021-04-30 01:26:19 +02:00
w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2)
2021-04-01 01:19:33 +02:00
end if
2023-08-23 14:24:33 +02:00
if (w /= 0.d0) then
if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return
endif
2021-04-01 01:19:33 +02:00
end do
test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS
deallocate(L,VGL)
end function test_qmckl_ao_polynomial_vgl
2021-04-16 00:57:08 +02:00
#+end_src
2021-04-01 01:19:33 +02:00
2021-04-16 00:57:08 +02:00
#+begin_src c :tangle (eval c_test)
2022-02-16 15:14:41 +01:00
int test_qmckl_ao_polynomial_vgl(qmckl_context context);
assert(0 == test_qmckl_ao_polynomial_vgl(context));
double X[3] = { 1.1, 2.2, 3.3 };
double R[3] = { 0.2, 1.1, 3.0 };
2022-02-19 19:24:18 +01:00
int32_t ldv[8] = {1, 4, 10, 20, 35, 56, 84, 120};
for (int32_t ldl=3 ; ldl<=5 ; ++ldl) {
2022-02-16 19:40:14 +01:00
int64_t n;
2022-02-19 19:24:18 +01:00
int32_t L0[200][ldl];
int32_t L1[200][ldl];
2022-02-16 19:40:14 +01:00
printf("ldl=%d\n", ldl);
2022-02-19 19:24:18 +01:00
for (int32_t lmax=0 ; lmax<=7 ; lmax++) {
2022-02-16 19:40:14 +01:00
double VGL0[5][ldv[lmax]];
double VGL1[5][ldv[lmax]];
memset(&L0[0][0], 0, sizeof(L0));
memset(&L1[0][0], 0, sizeof(L1));
memset(&VGL0[0][0], 0, sizeof(VGL0));
memset(&VGL1[0][0], 0, sizeof(VGL1));
rc = qmckl_ao_polynomial_transp_vgl_doc (context, X, R, lmax, &n, &(L0[0][0]), ldl, &(VGL0[0][0]), ldv[lmax]);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_ao_polynomial_transp_vgl_hpc (context, X, R, lmax, &n, &(L1[0][0]), ldl, &(VGL1[0][0]), ldv[lmax]);
assert (rc == QMCKL_SUCCESS);
printf("lmax=%d\n", lmax);
for (int32_t l=0 ; l<n ; ++l) {
for (int32_t k=0 ; k<3 ; ++k) {
printf("L[%d][%d] = %d %d\n", l, k, L0[l][k], L1[l][k]);
assert( L0[l][k] == L1[l][k] );
}
}
2022-02-19 19:24:18 +01:00
2022-02-16 19:40:14 +01:00
for (int32_t k=0 ; k<5 ; ++k) {
for (int32_t l=0 ; l<n ; ++l) {
2022-02-25 13:57:13 +01:00
printf("VGL[%d][%d] = %e %e %e\n", k, l, VGL0[k][l], VGL1[k][l], VGL0[k][l]-VGL1[k][l]);
assert( fabs(1.-(VGL0[k][l]+1.e-100)/(VGL1[k][l]+1.e-100)) < 1.e-15 );
2022-02-16 19:40:14 +01:00
}
}
}
2022-02-16 15:14:41 +01:00
}
2021-04-16 00:57:08 +02:00
#+end_src
2021-04-30 01:26:19 +02:00
2021-04-18 15:10:55 +02:00
* Combining radial and polynomial parts
2022-05-10 19:18:19 +02:00
2023-11-30 12:50:06 +01:00
** Determination of nucleus ranges
The range of a nucleus is defined as the distance beyond which all
the AOs are zero, up to a given precision. For all possible numbers
of bits of precision (1-53), a range is given.
#+begin_src c :tangle (eval h_private_func) :comments org
qmckl_exit_code qmckl_compute_nucleus_range_gaussian(
const qmckl_context context,
const int64_t ao_num,
const int64_t shell_num,
const int64_t prim_num,
const int64_t nucl_num,
const double* nucl_coord,
const int64_t* nucleus_index,
const int64_t* nucleus_shell_num,
const int32_t* nucleus_max_ang_mom,
const int64_t* shell_prim_index,
const int64_t* shell_prim_num,
const int32_t* shell_ang_mom,
const double* ao_factor,
const double* ao_expo,
const double* coefficient_normalized,
double* const nucleus_range);
#+end_src
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
function qmckl_compute_nucleus_range_gaussian(context, &
ao_num, shell_num, prim_num, nucl_num, &
nucl_coord, nucleus_index, nucleus_shell_num, &
nucleus_max_ang_mom, shell_prim_index, shell_prim_num, shell_ang_mom, &
ao_factor, expo, coef_normalized, nucleus_range) &
bind(C) result(info)
use qmckl_constants
2024-01-11 14:33:40 +01:00
use qmckl, only: qmckl_ao_polynomial_vgl, qmckl_get_numprec_precision
2023-11-30 12:50:06 +01:00
implicit none
integer (qmckl_context), intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: ao_num
integer (c_int64_t) , intent(in) , value :: shell_num
integer (c_int64_t) , intent(in) , value :: prim_num
integer (c_int64_t) , intent(in) , value :: nucl_num
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num)
integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num)
integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num)
integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num)
integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num)
integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num)
real (c_double ) , intent(in) :: ao_factor(ao_num)
real (c_double ) , intent(in) :: expo(prim_num)
real (c_double ) , intent(in) :: coef_normalized(prim_num)
real (c_double ) , intent(out) :: nucleus_range(nucl_num,53)
integer(qmckl_exit_code) :: info
double precision :: e_coord(3), n_coord(3)
integer*8 :: n_poly, iprim, iprim_start, iprim_end
integer :: l, il, k, iprecision
integer*8 :: ipoint, inucl, ishell
integer*8 :: ishell_start, ishell_end
integer :: lstart(0:20)
double precision :: shell_vgl(3)
double precision :: x, y, z, r2, ar2, two_a
double precision :: vmax, cutoff, v
double precision, allocatable :: poly_vgl(:,:), ao_vgl(:,:)
integer , allocatable :: powers(:,:), ao_index(:)
allocate(poly_vgl(5,ao_num), powers(3,ao_num), ao_index(ao_num))
! Pre-computed data
do l=0,20
lstart(l) = l*(l+1)*(l+2)/6 +1
end do
k=1
do inucl=1,nucl_num
ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
do ishell = ishell_start, ishell_end
l = shell_ang_mom(ishell)
ao_index(ishell) = k
k = k + lstart(l+1) - lstart(l)
end do
end do
info = QMCKL_SUCCESS
n_coord(1) = 0.d0
n_coord(2) = 0.d0
n_coord(3) = 0.d0
e_coord(2) = 0.d0
e_coord(3) = 0.d0
nucleus_range = 50.d0
do inucl=1,nucl_num
x = 50.d0
do iprecision = 53,2,-1
cutoff = 1.d0 / ( 2.d0** (iprecision-2) )
vmax = 0.d0
do while ( (vmax < cutoff) .and. (x > 0.d0) )
x = x - .1d0
vmax = 0.d0
e_coord(1) = x
r2 = x*x
! Compute polynomials
info = qmckl_ao_polynomial_vgl(context, e_coord, n_coord, &
nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, &
poly_vgl, 5_8)
! Loop over shells
ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
do ishell = ishell_start, ishell_end
shell_vgl(1) = 0.d0
shell_vgl(2) = 0.d0
shell_vgl(3) = 0.d0
iprim_start = shell_prim_index(ishell) + 1
iprim_end = shell_prim_index(ishell) + shell_prim_num(ishell)
do iprim = iprim_start, iprim_end
ar2 = expo(iprim)*r2
v = coef_normalized(iprim) * dexp(-ar2)
two_a = -2.d0 * expo(iprim) * v
shell_vgl(1) = shell_vgl(1) + v
shell_vgl(2) = shell_vgl(2) + two_a * x
shell_vgl(3) = shell_vgl(3) + two_a * (3.d0 - 2.d0*ar2)
end do
k = ao_index(ishell)
l = shell_ang_mom(ishell)
do il = lstart(l), lstart(l+1)-1
vmax = max(vmax, poly_vgl(1,il) * shell_vgl(1) * ao_factor(k))
vmax = max(vmax, ( poly_vgl(2,il) * shell_vgl(1) + poly_vgl(1,il) * shell_vgl(2) ) * ao_factor(k))
vmax = max(vmax, ( poly_vgl(5,il) * shell_vgl(3) + poly_vgl(1,il) * shell_vgl(3) + &
2.d0 * (poly_vgl(2,il) * shell_vgl(2) ) ) * ao_factor(k) )
k = k+1
end do
end do
end do
nucleus_range(inucl,iprecision) = x
end do
end do
deallocate(poly_vgl, powers)
end function qmckl_compute_nucleus_range_gaussian
#+end_src
2022-05-10 19:18:19 +02:00
** Values only
2021-07-11 23:20:40 +02:00
:PROPERTIES:
2022-05-10 19:18:19 +02:00
:Name: qmckl_compute_ao_value
2021-07-11 23:20:40 +02:00
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
2022-05-10 19:18:19 +02:00
*** Unoptimized version
#+NAME: qmckl_ao_value_args_doc
2023-11-28 17:00:39 +01:00
| Variable | Type | In/Out | Description |
|-----------------------+-----------------------------------+--------+----------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~ao_num~ | ~int64_t~ | in | Number of AOs |
| ~shell_num~ | ~int64_t~ | in | Number of shells |
| ~point_num~ | ~int64_t~ | in | Number of points |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells per nucleus |
| ~nucleus_range~ | ~double[nucl_num]~ | in | Range beyond which all is zero |
| ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus |
| ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell |
| ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs |
| ~shell_vgl~ | ~double[point_num][5][shell_num]~ | in | Value, gradients and Laplacian of the shells |
| ~ao_value~ | ~double[point_num][ao_num]~ | out | Values of the AOs |
2022-05-10 19:18:19 +02:00
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
2023-09-22 16:41:43 +02:00
function qmckl_compute_ao_value_doc(context, &
2022-01-26 17:06:51 +01:00
ao_num, shell_num, point_num, nucl_num, &
coord, nucl_coord, nucleus_index, nucleus_shell_num, &
2021-07-11 23:20:40 +02:00
nucleus_range, nucleus_max_ang_mom, shell_ang_mom, &
2022-05-10 19:18:19 +02:00
ao_factor, shell_vgl, ao_value) &
2023-09-22 16:41:43 +02:00
bind(C) result(info)
use qmckl_constants
2024-01-11 14:33:40 +01:00
use qmckl, only: qmckl_ao_polynomial_vgl, qmckl_get_numprec_precision
2021-07-11 23:20:40 +02:00
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: ao_num
integer (c_int64_t) , intent(in) , value :: shell_num
integer (c_int64_t) , intent(in) , value :: point_num
integer (c_int64_t) , intent(in) , value :: nucl_num
real (c_double ) , intent(in) :: coord(point_num,3)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num)
integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num)
real (c_double ) , intent(in) :: nucleus_range(nucl_num)
integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num)
integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num)
real (c_double ) , intent(in) :: ao_factor(ao_num)
real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num)
real (c_double ) , intent(out) :: ao_value(ao_num,point_num)
integer(qmckl_exit_code) :: info
2021-07-11 23:20:40 +02:00
double precision :: e_coord(3), n_coord(3)
integer*8 :: n_poly
integer :: l, il, k
2022-01-26 17:06:51 +01:00
integer*8 :: ipoint, inucl, ishell
2022-01-05 19:22:16 +01:00
integer*8 :: ishell_start, ishell_end
2021-07-11 23:20:40 +02:00
integer :: lstart(0:20)
double precision :: x, y, z, r2
double precision :: cutoff
double precision, allocatable :: poly_vgl(:,:)
2022-02-14 19:11:37 +01:00
integer , allocatable :: powers(:,:), ao_index(:)
2021-07-11 23:20:40 +02:00
2022-02-14 19:11:37 +01:00
allocate(poly_vgl(5,ao_num), powers(3,ao_num), ao_index(ao_num))
2021-07-11 23:20:40 +02:00
! Pre-computed data
do l=0,20
lstart(l) = l*(l+1)*(l+2)/6 +1
2021-07-11 23:20:40 +02:00
end do
2022-02-14 19:11:37 +01:00
k=1
do inucl=1,nucl_num
ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
do ishell = ishell_start, ishell_end
l = shell_ang_mom(ishell)
ao_index(ishell) = k
k = k + lstart(l+1) - lstart(l)
end do
end do
2021-07-11 23:20:40 +02:00
info = QMCKL_SUCCESS
2021-07-11 23:20:40 +02:00
! Don't compute polynomials when the radial part is zero.
2024-01-11 14:33:40 +01:00
<<fortran_cutoff>>
2021-07-11 23:20:40 +02:00
2022-01-26 17:06:51 +01:00
do ipoint = 1, point_num
e_coord(1) = coord(ipoint,1)
e_coord(2) = coord(ipoint,2)
e_coord(3) = coord(ipoint,3)
2023-08-24 10:14:37 +02:00
ao_value(:,ipoint) = 0.d0
2021-09-23 11:16:54 +02:00
do inucl=1,nucl_num
2022-02-19 19:24:18 +01:00
n_coord(1) = nucl_coord(inucl,1)
n_coord(2) = nucl_coord(inucl,2)
n_coord(3) = nucl_coord(inucl,3)
2021-09-23 11:16:54 +02:00
2022-01-26 17:06:51 +01:00
! Test if the point is in the range of the nucleus
2021-09-23 11:16:54 +02:00
x = e_coord(1) - n_coord(1)
y = e_coord(2) - n_coord(2)
z = e_coord(3) - n_coord(3)
2022-02-14 19:11:37 +01:00
r2 = x*x + y*y + z*z
2021-09-23 11:16:54 +02:00
2023-11-30 12:56:06 +01:00
if (r2 > cutoff*nucleus_range(inucl)) then
2021-09-23 11:16:54 +02:00
cycle
end if
2022-02-19 19:24:18 +01:00
! Compute polynomials
2023-09-22 16:41:43 +02:00
info = qmckl_ao_polynomial_vgl(context, e_coord, n_coord, &
nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, &
poly_vgl, 5_8)
! Loop over shells
ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
do ishell = ishell_start, ishell_end
2022-02-14 19:11:37 +01:00
k = ao_index(ishell)
l = shell_ang_mom(ishell)
do il = lstart(l), lstart(l+1)-1
! Value
2022-05-10 19:18:19 +02:00
ao_value(k,ipoint) = &
poly_vgl(1,il) * shell_vgl(ishell,1,ipoint) * ao_factor(k)
k = k+1
end do
end do
end do
end do
2022-02-09 18:06:46 +01:00
deallocate(poly_vgl, powers)
2023-09-22 16:41:43 +02:00
end function qmckl_compute_ao_value_doc
2022-05-10 19:18:19 +02:00
#+end_src
2022-03-21 18:32:39 +01:00
2022-05-10 19:18:19 +02:00
*** HPC version
#+NAME: qmckl_ao_value_args_hpc_gaussian
2023-11-28 17:00:39 +01:00
| Variable | Type | In/Out | Description |
|-----------------------+-----------------------------+--------+----------------------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~ao_num~ | ~int64_t~ | in | Number of AOs |
| ~shell_num~ | ~int64_t~ | in | Number of shells |
| ~prim_num~ | ~int64_t~ | in | Number of primitives |
| ~point_num~ | ~int64_t~ | in | Number of points |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells per nucleus |
| ~nucleus_range~ | ~double[nucl_num]~ | in | Range beyond which all is zero |
| ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus |
| ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell |
| ~shell_prim_index~ | ~int64_t[shell_num]~ | in | Index of the 1st primitive of each shell |
| ~shell_prim_num~ | ~int64_t[shell_num]~ | in | Number of primitives per shell |
| ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs |
| ~ao_expo~ | ~double[prim_num]~ | in | Value, gradients and Laplacian of the shells |
| ~coef_normalized~ | ~double[prim_num]~ | in | Value, gradients and Laplacian of the shells |
| ~ao_value~ | ~double[point_num][ao_num]~ | out | Values of the AOs |
2022-05-10 19:18:19 +02:00
2022-08-14 16:09:58 +02:00
#+NAME:ao_value_constants
#+begin_src c :exports none
int32_t lstart[32] __attribute__((aligned(64)));
2022-02-19 19:24:18 +01:00
for (int32_t l=0 ; l<32 ; ++l) {
2022-02-16 00:21:37 +01:00
lstart[l] = l*(l+1)*(l+2)/6;
}
2022-08-14 16:09:58 +02:00
int64_t ao_index[shell_num+1] __attribute__((aligned(64)));
2022-02-16 00:21:37 +01:00
int64_t size_max = 0;
2022-03-21 18:32:39 +01:00
int64_t prim_max = 0;
int64_t shell_max = 0;
2022-02-19 19:24:18 +01:00
{
2022-03-21 18:32:39 +01:00
int64_t k=0;
for (int inucl=0 ; inucl < nucl_num ; ++inucl) {
prim_max = prim_num_per_nucleus[inucl] > prim_max ?
prim_num_per_nucleus[inucl] : prim_max;
shell_max = nucleus_shell_num[inucl] > shell_max ?
nucleus_shell_num[inucl] : shell_max;
const int64_t ishell_start = nucleus_index[inucl];
const int64_t ishell_end = nucleus_index[inucl] + nucleus_shell_num[inucl];
for (int64_t ishell = ishell_start ; ishell < ishell_end ; ++ishell) {
const int l = shell_ang_mom[ishell];
ao_index[ishell] = k;
k += lstart[l+1] - lstart[l];
size_max = size_max < lstart[l+1] ? lstart[l+1] : size_max;
}
}
ao_index[shell_num] = ao_num+1;
2022-02-16 00:21:37 +01:00
}
2023-11-28 17:00:39 +01:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
2022-02-16 00:21:37 +01:00
/* Don't compute polynomials when the radial part is zero. */
2023-11-28 17:00:39 +01:00
const int precision = ctx->numprec.precision;
const double cutoff = log( (double) ( ((uint64_t) 1) << (precision-2) ) );
2023-11-30 01:17:18 +01:00
const bool double_precision = precision > 22;
2022-08-14 16:09:58 +02:00
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
#ifdef HAVE_HPC
qmckl_exit_code
qmckl_compute_ao_value_hpc_gaussian (const qmckl_context context,
const int64_t ao_num,
const int64_t shell_num,
const int32_t* restrict prim_num_per_nucleus,
const int64_t point_num,
const int64_t nucl_num,
const double* restrict coord,
const double* restrict nucl_coord,
const int64_t* restrict nucleus_index,
const int64_t* restrict nucleus_shell_num,
const double* nucleus_range,
const int32_t* restrict nucleus_max_ang_mom,
const int32_t* restrict shell_ang_mom,
const double* restrict ao_factor,
const qmckl_matrix expo_per_nucleus,
const qmckl_tensor coef_per_nucleus,
double* restrict const ao_value )
{
<<ao_value_constants>>
2022-02-16 00:21:37 +01:00
#ifdef HAVE_OPENMP
2022-10-13 11:48:40 +02:00
#pragma omp parallel if (point_num > 16)
2022-02-16 00:21:37 +01:00
#endif
{
2022-02-17 15:37:57 +01:00
qmckl_exit_code rc;
2022-08-14 16:09:58 +02:00
double ar2[prim_max] __attribute__((aligned(64)));
2023-11-28 17:00:39 +01:00
float ar2_sp[prim_max] __attribute__((aligned(64)));
2022-08-14 16:09:58 +02:00
int32_t powers[3*size_max] __attribute__((aligned(64)));
double poly_vgl[5*size_max] __attribute__((aligned(64)));
2022-02-16 00:21:37 +01:00
2022-08-14 16:09:58 +02:00
double exp_mat[prim_max] __attribute__((aligned(64)));
2023-11-28 17:00:39 +01:00
float exp_mat_sp[prim_max] __attribute__((aligned(64)));
2022-08-14 16:09:58 +02:00
double ce_mat[shell_max] __attribute__((aligned(64)));
2022-03-21 18:32:39 +01:00
2023-11-29 02:10:20 +01:00
int32_t (*coef_mat_sparse_idx)[shell_max][prim_max+1] __attribute__((aligned(64))) =
2023-09-13 13:23:16 +02:00
malloc(nucl_num * sizeof (*coef_mat_sparse_idx));
double (*coef_mat_sparse)[shell_max][prim_max+1] __attribute__((aligned(64))) =
malloc(nucl_num * sizeof (*coef_mat_sparse));
2022-03-21 18:32:39 +01:00
for (int i=0 ; i<nucl_num ; ++i) {
for (int j=0 ; j<shell_max; ++j) {
2022-10-11 17:46:30 +02:00
int l=1;
2022-03-21 18:32:39 +01:00
for (int k=0 ; k<prim_max; ++k) {
2022-10-11 17:46:30 +02:00
const double c = qmckl_ten3(coef_per_nucleus,k, j, i);
if (c != 0.) {
coef_mat_sparse_idx[i][j][l] = k;
coef_mat_sparse[i][j][l] = c;
l+=1;
}
2022-03-21 18:32:39 +01:00
}
2022-10-11 17:46:30 +02:00
coef_mat_sparse_idx[i][j][0] = l;
2022-03-21 18:32:39 +01:00
}
}
2022-02-16 00:21:37 +01:00
#ifdef HAVE_OPENMP
2024-02-07 17:04:18 +01:00
#pragma omp for schedule(guided)
2022-02-16 00:21:37 +01:00
#endif
for (int64_t ipoint=0 ; ipoint < point_num ; ++ipoint) {
2024-02-06 22:27:17 +01:00
2024-02-07 17:06:27 +01:00
/*
2024-02-06 22:39:52 +01:00
double* const ptr = &ao_value[ipoint*ao_num];
for (size_t k=0 ; k<ao_num ; ++k) {
ptr[k] = 0.;
}
2024-05-08 13:56:32 +02:00
,*/
2024-02-06 22:39:52 +01:00
2024-02-07 17:06:27 +01:00
memset(&ao_value[ipoint*ao_num], 0, ao_num*sizeof(double));
2024-02-06 22:27:17 +01:00
2022-08-14 16:09:58 +02:00
const double e_coord[3] __attribute__((aligned(64))) =
{ coord[ipoint],
coord[ipoint + point_num],
coord[ipoint + 2*point_num] };
2023-09-11 17:05:41 +02:00
2022-03-21 18:32:39 +01:00
for (int64_t inucl=0 ; inucl < nucl_num ; ++inucl) {
2022-08-14 16:09:58 +02:00
const double n_coord[3] __attribute__((aligned(64))) =
{ nucl_coord[inucl],
nucl_coord[inucl + nucl_num],
nucl_coord[inucl + 2*nucl_num] };
2023-09-11 17:05:41 +02:00
2024-07-11 13:53:10 +02:00
/* Shift to avoid having exact zeros at the nodes of the AOs */
2024-05-08 13:56:32 +02:00
const double shift = 1.e-20;
2022-03-21 18:32:39 +01:00
const double x = e_coord[0] - n_coord[0];
const double y = e_coord[1] - n_coord[1];
const double z = e_coord[2] - n_coord[2];
2022-02-14 19:11:37 +01:00
2023-11-28 17:00:39 +01:00
const double x2 = x*x;
const double y2 = y*y;
const double z2 = z*z;
const double r2 = x2 + y2 + z2;
2022-02-14 19:11:37 +01:00
2024-05-08 13:56:32 +02:00
/* Test if the point is in the range of the nucleus */
2023-11-30 12:56:06 +01:00
if (r2 > cutoff * nucleus_range[inucl]) {
2022-03-21 18:32:39 +01:00
continue;
}
2022-02-14 19:11:37 +01:00
2022-03-21 18:32:39 +01:00
int64_t n_poly;
switch (nucleus_max_ang_mom[inucl]) {
case 0:
break;
case 1:
2022-08-14 16:09:58 +02:00
poly_vgl[0] = 1.;
2022-05-10 19:18:19 +02:00
poly_vgl[1] = x;
poly_vgl[2] = y;
poly_vgl[3] = z;
2022-03-21 18:32:39 +01:00
break;
case 2:
2022-08-14 16:09:58 +02:00
poly_vgl[0] = 1.;
2024-05-08 13:56:32 +02:00
poly_vgl[1] = x+shift;
poly_vgl[2] = y+shift;
poly_vgl[3] = z+shift;
2023-11-28 17:00:39 +01:00
poly_vgl[4] = x2;
2022-05-10 19:18:19 +02:00
poly_vgl[5] = x*y;
poly_vgl[6] = x*z;
2023-11-28 17:00:39 +01:00
poly_vgl[7] = y2;
2022-05-10 19:18:19 +02:00
poly_vgl[8] = y*z;
2023-11-28 17:00:39 +01:00
poly_vgl[9] = z2;
2022-03-21 18:32:39 +01:00
break;
default:
2022-10-13 11:48:40 +02:00
rc = qmckl_ao_polynomial_transp_vgl_hpc_inline(context, e_coord, n_coord,
2023-11-28 17:00:39 +01:00
nucleus_max_ang_mom[inucl],
&n_poly, powers, (int64_t) 3,
poly_vgl, size_max);
2022-03-21 18:32:39 +01:00
assert (rc == QMCKL_SUCCESS);
break;
}
2022-02-17 12:36:16 +01:00
2022-03-21 18:32:39 +01:00
/* Compute all exponents */
2022-02-17 12:36:16 +01:00
2022-03-21 18:32:39 +01:00
int64_t nidx = 0;
2023-11-28 17:00:39 +01:00
if (double_precision) {
for (int64_t iprim = 0 ; iprim < prim_num_per_nucleus[inucl] ; ++iprim) {
const double v = qmckl_mat(expo_per_nucleus, iprim, inucl) * r2;
if (v <= cutoff) {
2023-11-29 01:18:15 +01:00
ar2[iprim] = v;
2023-11-28 17:00:39 +01:00
++nidx;
} else {
break;
}
}
2024-02-14 11:11:50 +01:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2023-11-28 17:00:39 +01:00
for (int64_t iprim = 0 ; iprim < nidx ; ++iprim) {
2023-11-29 01:18:15 +01:00
exp_mat[iprim] = exp(-ar2[iprim]);
2023-11-28 17:00:39 +01:00
}
} else {
for (int64_t iprim = 0 ; iprim < prim_num_per_nucleus[inucl] ; ++iprim) {
const double v = qmckl_mat(expo_per_nucleus, iprim, inucl) * r2;
if (v <= cutoff) {
2023-11-29 01:18:15 +01:00
ar2_sp[iprim] = (float) v;
2023-11-28 17:00:39 +01:00
++nidx;
} else {
break;
}
}
2024-02-14 11:11:50 +01:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2023-11-28 17:00:39 +01:00
for (int64_t iprim = 0 ; iprim < nidx ; ++iprim) {
2023-11-29 01:18:15 +01:00
exp_mat_sp[iprim] = expf(-ar2_sp[iprim]);
2023-11-28 17:00:39 +01:00
}
2024-02-14 11:11:50 +01:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2023-11-28 17:00:39 +01:00
for (int64_t iprim = 0 ; iprim < nidx ; ++iprim) {
exp_mat[iprim] = exp_mat_sp[iprim];
2022-03-21 18:32:39 +01:00
}
2022-02-17 12:36:16 +01:00
2022-03-21 18:32:39 +01:00
}
2022-02-19 19:24:18 +01:00
2022-03-21 18:32:39 +01:00
for (int i=0 ; i<nucleus_shell_num[inucl] ; ++i) {
2022-08-14 16:09:58 +02:00
ce_mat[i] = 0.;
2022-10-13 11:31:44 +02:00
const int32_t* restrict idx = &(coef_mat_sparse_idx[inucl][i][0]);
const double* restrict v = &(coef_mat_sparse[inucl][i][0]);
2022-10-11 17:46:30 +02:00
for (int l=1 ; l<coef_mat_sparse_idx[inucl][i][0]; ++l) {
const int k = idx[l];
if (k >= nidx) break;
2024-01-30 11:31:07 +01:00
ce_mat[i] = ce_mat[i] + v[l] * exp_mat[k];
2022-02-27 23:31:52 +01:00
}
2022-03-21 18:32:39 +01:00
}
2022-02-27 23:31:52 +01:00
2022-03-21 18:32:39 +01:00
const int64_t ishell_start = nucleus_index[inucl];
const int64_t ishell_end = nucleus_index[inucl] + nucleus_shell_num[inucl];
2023-11-28 17:00:39 +01:00
const int64_t ipoint_ao_num = ipoint*ao_num;
2022-03-21 18:32:39 +01:00
for (int64_t ishell = ishell_start ; ishell < ishell_end ; ++ishell) {
2022-05-10 19:18:19 +02:00
const double s1 = ce_mat[ishell-ishell_start];
2022-03-21 18:32:39 +01:00
2024-02-14 11:11:50 +01:00
if (s1 == 0.0) {
continue;
}
2022-03-21 18:32:39 +01:00
const int64_t k = ao_index[ishell];
2023-11-28 17:00:39 +01:00
double* restrict const ao_value_1 = ao_value + ipoint_ao_num + k;
2022-03-21 18:32:39 +01:00
const int32_t l = shell_ang_mom[ishell];
const int32_t n = lstart[l+1]-lstart[l];
double* restrict poly_vgl_1 = NULL;
if (nidx > 0) {
const double* restrict f = ao_factor + k;
const int64_t idx = lstart[l];
2022-05-10 19:18:19 +02:00
poly_vgl_1 = &(poly_vgl[idx]);
2022-03-21 18:32:39 +01:00
switch (n) {
2022-08-14 16:09:58 +02:00
case 1:
2022-05-10 19:18:19 +02:00
ao_value_1[0] = s1 * f[0];
2022-03-21 18:32:39 +01:00
break;
2022-08-14 16:09:58 +02:00
case 3:
2022-02-25 16:30:16 +01:00
#ifdef HAVE_OPENMP
2022-03-21 18:32:39 +01:00
#pragma omp simd
2022-02-25 16:30:16 +01:00
#endif
2022-03-21 18:32:39 +01:00
for (int il=0 ; il<3 ; ++il) {
2022-05-10 19:18:19 +02:00
ao_value_1[il] = poly_vgl_1[il] * s1 * f[il];
}
break;
case(6):
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
for (int il=0 ; il<6 ; ++il) {
ao_value_1[il] = poly_vgl_1[il] * s1 * f[il];
}
break;
default:
#ifdef HAVE_OPENMP
2022-08-14 16:09:58 +02:00
#pragma omp simd
2022-05-10 19:18:19 +02:00
#endif
for (int il=0 ; il<n ; ++il) {
ao_value_1[il] = poly_vgl_1[il] * s1 * f[il];
}
break;
}
}
}
}
}
2023-09-13 13:23:16 +02:00
free(coef_mat_sparse_idx);
free(coef_mat_sparse);
2022-05-10 19:18:19 +02:00
}
return QMCKL_SUCCESS;
}
#endif
#+end_src
*** Interfaces
# #+CALL: generate_c_header(table=qmckl_ao_value_args_doc,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_value"))
# (Commented because the header needs to go into h_private_func)
#+begin_src c :tangle (eval h_private_func) :comments org
qmckl_exit_code qmckl_compute_ao_value_doc (
const qmckl_context context,
const int64_t ao_num,
const int64_t shell_num,
const int64_t point_num,
const int64_t nucl_num,
const double* coord,
const double* nucl_coord,
const int64_t* nucleus_index,
const int64_t* nucleus_shell_num,
const double* nucleus_range,
const int32_t* nucleus_max_ang_mom,
const int32_t* shell_ang_mom,
const double* ao_factor,
const double* shell_vgl,
double* const ao_value );
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org
#ifdef HAVE_HPC
qmckl_exit_code qmckl_compute_ao_value_hpc_gaussian (
const qmckl_context context,
const int64_t ao_num,
const int64_t shell_num,
const int32_t* prim_num_per_nucleus,
const int64_t point_num,
const int64_t nucl_num,
const double* coord,
const double* nucl_coord,
const int64_t* nucleus_index,
const int64_t* nucleus_shell_num,
const double* nucleus_range,
const int32_t* nucleus_max_ang_mom,
const int32_t* shell_ang_mom,
const double* ao_factor,
const qmckl_matrix expo_per_nucleus,
const qmckl_tensor coef_per_nucleus,
double* const ao_value );
#endif
#+end_src
**** Provide :noexport:
#+CALL: write_provider_header( group="ao_basis", data="ao_value" )
2022-05-10 19:18:19 +02:00
#+RESULTS:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_ao_value(qmckl_context context);
#+end_src
#+CALL: write_provider_pre( group="ao_basis", data="ao_value", dimension="ctx->ao_basis.ao_num * ctx->point.num")
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_ao_value(qmckl_context context)
2022-05-10 19:18:19 +02:00
{
2022-08-07 14:57:10 +02:00
qmckl_exit_code rc = QMCKL_SUCCESS;
2022-05-10 19:18:19 +02:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_provide_ao_basis_ao_value",
2022-05-10 19:18:19 +02:00
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL);
if (!ctx->ao_basis.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_provide_ao_basis_ao_value",
2022-05-10 19:18:19 +02:00
NULL);
}
/* Compute if necessary */
if (ctx->point.date > ctx->ao_basis.ao_value_date) {
2022-08-07 14:57:10 +02:00
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.ao_num * ctx->point.num * sizeof(double);
if (ctx->ao_basis.ao_value != NULL) {
qmckl_memory_info_struct mem_info_test = qmckl_memory_info_struct_zero;
rc = qmckl_get_malloc_info(context, ctx->ao_basis.ao_value, &mem_info_test);
/* if rc != QMCKL_SUCCESS, we are maybe in an _inplace function because the
memory was not allocated with qmckl_malloc */
if ((rc == QMCKL_SUCCESS) && (mem_info_test.size != mem_info.size)) {
rc = qmckl_free(context, ctx->ao_basis.ao_value);
assert (rc == QMCKL_SUCCESS);
ctx->ao_basis.ao_value = NULL;
}
2022-05-10 19:18:19 +02:00
}
/* Allocate array */
if (ctx->ao_basis.ao_value == NULL) {
double* ao_value = (double*) qmckl_malloc(context, mem_info);
if (ao_value == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_ao_basis_ao_value",
NULL);
}
ctx->ao_basis.ao_value = ao_value;
}
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-05-10 19:18:19 +02:00
if (ctx->ao_basis.ao_vgl_date == ctx->point.date) {
// ao_vgl has been computed at this step: Just copy the data.
double * v = &(ctx->ao_basis.ao_value[0]);
double * vgl = &(ctx->ao_basis.ao_vgl[0]);
for (int i=0 ; i<ctx->point.num ; ++i) {
for (int k=0 ; k<ctx->ao_basis.ao_num ; ++k) {
v[k] = vgl[k];
}
v += ctx->ao_basis.ao_num;
vgl += ctx->ao_basis.ao_num * 5;
}
} else {
#ifdef HAVE_HPC
if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_ao_value_hpc_gaussian(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->ao_basis.prim_num_per_nucleus,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
2023-11-30 12:56:06 +01:00
ctx->ao_basis.nucleus_range,
2022-05-10 19:18:19 +02:00
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.expo_per_nucleus,
ctx->ao_basis.coef_per_nucleus,
ctx->ao_basis.ao_value);
/*
} else if (ctx->ao_basis.type == 'S') {
rc = qmck_compute_ao_value_hpc_slater(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->ao_basis.prim_num,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
ctx->ao_basis.nucleus_range,
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.shell_prim_index,
ctx->ao_basis.shell_prim_num,
ctx->ao_basis.ao_factor,
ctx->ao_basis.exponent,
ctx->ao_basis.coefficient_normalized,
ctx->ao_basis.ao_value);
,*/
} else {
/* Provide required data */
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
}
2022-05-10 19:18:19 +02:00
rc = qmckl_compute_ao_value_doc(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
2023-11-30 12:56:06 +01:00
ctx->ao_basis.nucleus_range,
2022-05-10 19:18:19 +02:00
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.shell_vgl,
ctx->ao_basis.ao_value);
}
#else
/* Provide required data */
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
}
2022-05-10 19:18:19 +02:00
rc = qmckl_compute_ao_value_doc(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
2023-11-30 12:56:06 +01:00
ctx->ao_basis.nucleus_range,
2022-05-10 19:18:19 +02:00
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.shell_vgl,
ctx->ao_basis.ao_value);
#endif
}
#+end_src
#+CALL: write_provider_post( group="ao_basis", data="ao_value" )
2022-05-10 19:18:19 +02:00
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
if (rc != QMCKL_SUCCESS) {
return rc;
2022-05-10 19:18:19 +02:00
}
ctx->ao_basis.ao_value_date = ctx->date;
}
return QMCKL_SUCCESS;
}
#+end_src
2022-05-10 19:18:19 +02:00
**** Test :noexport:
#+begin_src python :results output :exports none
import numpy as np
from math import sqrt
h0 = 1.e-4
def f(a,x,y):
return np.sum( [c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] )
elec_26_w1 = np.array( [ 1.49050402641, 2.90106987953, -1.05920815468 ] )
elec_15_w2 = np.array( [ -2.20180344582,-1.9113150239, 2.2193744778600002 ] )
nucl_1 = np.array( [ -2.302574592081335e+00, -3.542027060505035e-01, -5.334129934317614e-02] )
#double ao_value[prim_num][5][elec_num];
x = elec_26_w1 ; y = nucl_1
a = [( 4.0382999999999998e+02, 1.4732000000000000e-03 * 5.9876577632594533e+04),
( 1.2117000000000000e+02, 1.2672500000000000e-02 * 7.2836806319891484e+03),
( 4.6344999999999999e+01, 5.8045100000000002e-02 * 1.3549226646722386e+03),
( 1.9721000000000000e+01, 1.7051030000000000e-01 * 3.0376315094739988e+02),
( 8.8623999999999992e+00, 3.1859579999999998e-01 * 7.4924579607137730e+01),
( 3.9962000000000000e+00, 3.8450230000000002e-01 * 1.8590543353806009e+01),
( 1.7636000000000001e+00, 2.7377370000000001e-01 * 4.4423176930919421e+00),
( 7.0618999999999998e-01, 7.4396699999999996e-02 * 8.9541051939952665e-01)]
norm = sqrt(3.)
# x^2 * g(r)
print ( "[26][0][219] : %25.15e"%(fx(a,x,y)) )
print ( "[26][1][219] : %25.15e"%(df(a,x,y,1)) )
print ( "[26][2][219] : %25.15e"%(df(a,x,y,2)) )
print ( "[26][3][219] : %25.15e"%(df(a,x,y,3)) )
print ( "[26][4][219] : %25.15e"%(lf(a,x,y)) )
print ( "[26][0][220] : %25.15e"%(norm*f(a,x,y) * (x[0] - y[0]) * (x[1] - y[1]) ))
print ( "[26][1][220] : %25.15e"%(norm*df(a,x,y,1)* (x[0] - y[0]) * (x[1] - y[1]) + norm*f(a,x,y) * (x[1] - y[1])) )
print ( "[26][0][221] : %25.15e"%(norm*f(a,x,y) * (x[0] - y[0]) * (x[2] - y[2])) )
print ( "[26][1][221] : %25.15e"%(norm*df(a,x,y,1)* (x[0] - y[0]) * (x[2] - y[2]) + norm*f(a,x,y) * (x[2] - y[2])) )
print ( "[26][0][222] : %25.15e"%(f(a,x,y) * (x[1] - y[1]) * (x[1] - y[1])) )
print ( "[26][1][222] : %25.15e"%(df(a,x,y,1)* (x[1] - y[1]) * (x[1] - y[1])) )
print ( "[26][0][223] : %25.15e"%(norm*f(a,x,y) * (x[1] - y[1]) * (x[2] - y[2])) )
print ( "[26][1][223] : %25.15e"%(norm*df(a,x,y,1)* (x[1] - y[1]) * (x[2] - y[2])) )
print ( "[26][0][224] : %25.15e"%(f(a,x,y) * (x[2] - y[2]) * (x[2] - y[2])) )
print ( "[26][1][224] : %25.15e"%(df(a,x,y,1)* (x[2] - y[2]) * (x[2] - y[2])) )
#+end_src
#+RESULTS:
#+begin_src c :tangle (eval c_test) :exports none
{
#define shell_num chbrclf_shell_num
#define ao_num chbrclf_ao_num
double* elec_coord = &(chbrclf_elec_coord[0][0][0]);
assert(qmckl_electron_provided(context));
2023-09-14 11:00:24 +02:00
int64_t point_num = elec_num;
2022-08-07 14:57:10 +02:00
rc = qmckl_set_point(context, 'N', point_num, elec_coord, point_num*3);
2022-05-10 19:18:19 +02:00
assert(rc == QMCKL_SUCCESS);
2022-08-07 14:57:10 +02:00
double ao_value[point_num][ao_num];
2022-05-10 19:18:19 +02:00
rc = qmckl_get_ao_basis_ao_value(context, &(ao_value[0][0]),
2022-08-07 14:57:10 +02:00
(int64_t) point_num*ao_num);
2022-05-10 19:18:19 +02:00
assert (rc == QMCKL_SUCCESS);
printf("\n");
printf(" ao_value ao_value[26][219] %25.15e\n", ao_value[26][219]);
printf(" ao_value ao_value[26][220] %25.15e\n", ao_value[26][220]);
printf(" ao_value ao_value[26][221] %25.15e\n", ao_value[26][221]);
printf(" ao_value ao_value[26][222] %25.15e\n", ao_value[26][222]);
printf(" ao_value ao_value[26][223] %25.15e\n", ao_value[26][223]);
printf(" ao_value ao_value[26][224] %25.15e\n", ao_value[26][224]);
printf("\n");
2022-10-11 17:46:30 +02:00
printf("%e %e\n", ao_value[26][219], 1.020298798341620e-08);
2022-05-10 19:18:19 +02:00
assert( fabs(ao_value[26][219] - ( 1.020298798341620e-08)) < 1.e-14 );
assert( fabs(ao_value[26][220] - ( 1.516643537739178e-08)) < 1.e-14 );
assert( fabs(ao_value[26][221] - ( -4.686370882518819e-09)) < 1.e-14 );
assert( fabs(ao_value[26][222] - ( 7.514816980753531e-09)) < 1.e-14 );
assert( fabs(ao_value[26][223] - ( -4.021908374204471e-09)) < 1.e-14 );
assert( fabs(ao_value[26][224] - ( 7.175045873560788e-10)) < 1.e-14 );
}
#+end_src
** Value, gradients, Laplacian
:PROPERTIES:
:Name: qmckl_compute_ao_vgl
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
2023-03-13 15:32:35 +01:00
*** Reference version
2022-05-10 19:18:19 +02:00
#+NAME: qmckl_ao_vgl_args_doc
| Variable | Type | In/Out | Description |
|-----------------------+-----------------------------------+--------+----------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~ao_num~ | ~int64_t~ | in | Number of AOs |
| ~shell_num~ | ~int64_t~ | in | Number of shells |
| ~point_num~ | ~int64_t~ | in | Number of points |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells per nucleus |
| ~nucleus_range~ | ~double[nucl_num]~ | in | Range beyond which all is zero |
| ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus |
| ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell |
| ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs |
| ~shell_vgl~ | ~double[point_num][5][shell_num]~ | in | Value, gradients and Laplacian of the shells |
| ~ao_vgl~ | ~double[point_num][5][ao_num]~ | out | Value, gradients and Laplacian of the AOs |
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
2023-09-22 16:41:43 +02:00
function qmckl_compute_ao_vgl_doc(context, &
2022-05-10 19:18:19 +02:00
ao_num, shell_num, point_num, nucl_num, &
coord, nucl_coord, nucleus_index, nucleus_shell_num, &
nucleus_range, nucleus_max_ang_mom, shell_ang_mom, &
ao_factor, shell_vgl, ao_vgl) &
2023-09-22 16:41:43 +02:00
bind(C) result(info)
use qmckl_constants
2024-01-11 14:33:40 +01:00
use qmckl, only : qmckl_ao_polynomial_vgl, qmckl_get_numprec_precision
2022-05-10 19:18:19 +02:00
implicit none
2023-09-22 16:41:43 +02:00
integer (qmckl_context), intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: ao_num
integer (c_int64_t) , intent(in) , value :: shell_num
integer (c_int64_t) , intent(in) , value :: point_num
integer (c_int64_t) , intent(in) , value :: nucl_num
real (c_double ) , intent(in) :: coord(point_num,3)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num)
integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num)
real (c_double ) , intent(in) :: nucleus_range(nucl_num)
integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num)
integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num)
real (c_double ) , intent(in) :: ao_factor(ao_num)
real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num)
real (c_double ) , intent(out) :: ao_vgl(ao_num,5,point_num)
integer(qmckl_exit_code) :: info
2022-05-10 19:18:19 +02:00
double precision :: e_coord(3), n_coord(3)
integer*8 :: n_poly
integer :: l, il, k
integer*8 :: ipoint, inucl, ishell
integer*8 :: ishell_start, ishell_end
integer :: lstart(0:20)
double precision :: x, y, z, r2
double precision :: cutoff
double precision, allocatable :: poly_vgl(:,:)
integer , allocatable :: powers(:,:), ao_index(:)
allocate(poly_vgl(5,ao_num), powers(3,ao_num), ao_index(ao_num))
! Pre-computed data
do l=0,20
lstart(l) = l*(l+1)*(l+2)/6 +1
end do
k=1
do inucl=1,nucl_num
ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
do ishell = ishell_start, ishell_end
l = shell_ang_mom(ishell)
ao_index(ishell) = k
k = k + lstart(l+1) - lstart(l)
end do
end do
info = QMCKL_SUCCESS
! Don't compute polynomials when the radial part is zero.
2024-01-11 14:33:40 +01:00
<<fortran_cutoff>>
2022-05-10 19:18:19 +02:00
do ipoint = 1, point_num
e_coord(1) = coord(ipoint,1)
e_coord(2) = coord(ipoint,2)
e_coord(3) = coord(ipoint,3)
2023-08-24 09:59:57 +02:00
ao_vgl(:,:,ipoint) = 0.d0
2022-05-10 19:18:19 +02:00
do inucl=1,nucl_num
n_coord(1) = nucl_coord(inucl,1)
n_coord(2) = nucl_coord(inucl,2)
n_coord(3) = nucl_coord(inucl,3)
! Test if the point is in the range of the nucleus
x = e_coord(1) - n_coord(1)
y = e_coord(2) - n_coord(2)
z = e_coord(3) - n_coord(3)
r2 = x*x + y*y + z*z
2023-11-30 12:56:06 +01:00
if (r2 > cutoff*nucleus_range(inucl)) then
2022-05-10 19:18:19 +02:00
cycle
end if
! Compute polynomials
2023-09-22 16:41:43 +02:00
info = qmckl_ao_polynomial_vgl(context, e_coord, n_coord, &
2022-05-10 19:18:19 +02:00
nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, &
poly_vgl, 5_8)
! Loop over shells
ishell_start = nucleus_index(inucl) + 1
ishell_end = nucleus_index(inucl) + nucleus_shell_num(inucl)
do ishell = ishell_start, ishell_end
k = ao_index(ishell)
l = shell_ang_mom(ishell)
do il = lstart(l), lstart(l+1)-1
! Value
ao_vgl(k,1,ipoint) = &
poly_vgl(1,il) * shell_vgl(ishell,1,ipoint) * ao_factor(k)
! Grad_x
ao_vgl(k,2,ipoint) = ( &
poly_vgl(2,il) * shell_vgl(ishell,1,ipoint) + &
poly_vgl(1,il) * shell_vgl(ishell,2,ipoint) &
) * ao_factor(k)
! Grad_y
ao_vgl(k,3,ipoint) = ( &
poly_vgl(3,il) * shell_vgl(ishell,1,ipoint) + &
poly_vgl(1,il) * shell_vgl(ishell,3,ipoint) &
) * ao_factor(k)
! Grad_z
ao_vgl(k,4,ipoint) = ( &
poly_vgl(4,il) * shell_vgl(ishell,1,ipoint) + &
poly_vgl(1,il) * shell_vgl(ishell,4,ipoint) &
) * ao_factor(k)
! Lapl_z
ao_vgl(k,5,ipoint) = ( &
poly_vgl(5,il) * shell_vgl(ishell,1,ipoint) + &
poly_vgl(1,il) * shell_vgl(ishell,5,ipoint) + &
2.d0 * ( &
poly_vgl(2,il) * shell_vgl(ishell,2,ipoint) + &
poly_vgl(3,il) * shell_vgl(ishell,3,ipoint) + &
poly_vgl(4,il) * shell_vgl(ishell,4,ipoint) ) &
) * ao_factor(k)
k = k+1
end do
end do
end do
end do
deallocate(poly_vgl, powers)
2023-09-22 16:41:43 +02:00
end function qmckl_compute_ao_vgl_doc
2022-05-10 19:18:19 +02:00
#+end_src
*** HPC version
#+NAME: qmckl_ao_vgl_args_hpc_gaussian
2023-11-30 12:50:06 +01:00
| Variable | Type | In/Out | Description |
|-----------------------+--------------------------------+--------+-------------------------------------------|
| ~context~ | ~qmckl_context~ | in | Global state |
| ~ao_num~ | ~int64_t~ | in | Number of AOs |
| ~shell_num~ | ~int64_t~ | in | Number of shells |
| ~prim_num~ | ~int64_t~ | in | Number of primitives |
| ~point_num~ | ~int64_t~ | in | Number of points |
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
| ~coord~ | ~double[3][point_num]~ | in | Coordinates |
| ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
| ~nucleus_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st shell of each nucleus |
| ~nucleus_shell_num~ | ~int64_t[nucl_num]~ | in | Number of shells per nucleus |
| ~nucleus_range~ | ~double[nucl_num]~ | in | Range beyond which all is zero |
| ~nucleus_max_ang_mom~ | ~int32_t[nucl_num]~ | in | Maximum angular momentum per nucleus |
| ~shell_ang_mom~ | ~int32_t[shell_num]~ | in | Angular momentum of each shell |
| ~shell_prim_index~ | ~int64_t[shell_num]~ | in | Index of the 1st primitive of each shell |
| ~shell_prim_num~ | ~int64_t[shell_num]~ | in | Number of primitives per shell |
| ~ao_factor~ | ~double[ao_num]~ | in | Normalization factor of the AOs |
| ~ao_expo~ | ~double[prim_num]~ | in | Exponents of the primitives |
| ~coef_normalized~ | ~double[prim_num]~ | in | Normalized coefficients of the primitives |
| ~ao_vgl~ | ~double[point_num][5][ao_num]~ | out | Value, gradients and Laplacian of the AOs |
2022-05-10 19:18:19 +02:00
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
#ifdef HAVE_HPC
qmckl_exit_code
qmckl_compute_ao_vgl_hpc_gaussian (
const qmckl_context context,
const int64_t ao_num,
const int64_t shell_num,
const int32_t* restrict prim_num_per_nucleus,
const int64_t point_num,
const int64_t nucl_num,
const double* restrict coord,
const double* restrict nucl_coord,
const int64_t* restrict nucleus_index,
const int64_t* restrict nucleus_shell_num,
const double* nucleus_range,
const int32_t* restrict nucleus_max_ang_mom,
const int32_t* restrict shell_ang_mom,
const double* restrict ao_factor,
const qmckl_matrix expo_per_nucleus,
const qmckl_tensor coef_per_nucleus,
double* restrict const ao_vgl )
{
2022-10-11 17:46:30 +02:00
<<ao_value_constants>>
2022-05-10 19:18:19 +02:00
#ifdef HAVE_OPENMP
#pragma omp parallel if (point_num > 16)
2022-05-10 19:18:19 +02:00
#endif
{
qmckl_exit_code rc;
2022-06-29 13:31:58 +02:00
double ar2[prim_max] __attribute__((aligned(64)));
2023-11-28 17:00:39 +01:00
float ar2_sp[prim_max] __attribute__((aligned(64)));
2022-06-29 13:31:58 +02:00
int32_t powers[3*size_max] __attribute__((aligned(64)));
2022-05-10 19:18:19 +02:00
2022-06-29 13:31:58 +02:00
double exp_mat[prim_max][8] __attribute__((aligned(64))) ;
2023-11-28 17:00:39 +01:00
float exp_mat_sp[prim_max] __attribute__((aligned(64)));
2022-06-29 13:31:58 +02:00
double ce_mat[shell_max][8] __attribute__((aligned(64))) ;
2022-05-10 19:18:19 +02:00
2023-11-29 02:10:20 +01:00
int32_t (*coef_mat_sparse_idx)[shell_max][prim_max+1] __attribute__((aligned(64))) =
2023-09-13 13:23:16 +02:00
malloc(nucl_num * sizeof (*coef_mat_sparse_idx));
double (*coef_mat_sparse)[shell_max][prim_max+1] __attribute__((aligned(64))) =
malloc(nucl_num * sizeof (*coef_mat_sparse));
2022-05-10 19:18:19 +02:00
for (int i=0 ; i<nucl_num ; ++i) {
for (int j=0 ; j<shell_max; ++j) {
2022-10-11 17:46:30 +02:00
int l=1;
2022-05-10 19:18:19 +02:00
for (int k=0 ; k<prim_max; ++k) {
2022-10-11 17:46:30 +02:00
const double c = qmckl_ten3(coef_per_nucleus,k, j, i);
if (c != 0.) {
coef_mat_sparse_idx[i][j][l] = k;
coef_mat_sparse[i][j][l] = c;
l+=1;
}
2022-05-10 19:18:19 +02:00
}
2022-10-11 17:46:30 +02:00
coef_mat_sparse_idx[i][j][0] = l;
2022-05-10 19:18:19 +02:00
}
}
2022-08-14 16:09:58 +02:00
double poly_vgl_l1[4][4] __attribute__((aligned(64))) =
2022-10-11 17:46:30 +02:00
{{1.0, 0.0, 0.0, 0.0},
{0.0, 1.0, 0.0, 0.0},
{0.0, 0.0, 1.0, 0.0},
{0.0, 0.0, 0.0, 1.0}};
2022-08-14 16:09:58 +02:00
double poly_vgl_l2[5][10]__attribute__((aligned(64))) =
2022-10-11 17:46:30 +02:00
{{1., 0., 0., 0., 0., 0., 0., 0., 0., 0.},
{0., 1., 0., 0., 0., 0., 0., 0., 0., 0.},
{0., 0., 1., 0., 0., 0., 0., 0., 0., 0.},
{0., 0., 0., 1., 0., 0., 0., 0., 0., 0.},
{0., 0., 0., 0., 2., 0., 0., 2., 0., 2.}};
2022-08-14 16:09:58 +02:00
double poly_vgl[5][size_max] __attribute__((aligned(64)));
2022-05-10 19:18:19 +02:00
#ifdef HAVE_OPENMP
#pragma omp for
#endif
for (int64_t ipoint=0 ; ipoint < point_num ; ++ipoint) {
2024-02-06 22:27:17 +01:00
2024-02-07 17:06:27 +01:00
/*
2024-02-06 22:39:52 +01:00
double* const ptr = &ao_vgl[ipoint*5*ao_num];
for (size_t k=0 ; k<5*ao_num ; ++k) {
ptr[k] = 0.;
}
2024-05-08 13:56:32 +02:00
,*/
2024-02-06 22:39:52 +01:00
2024-02-07 17:06:27 +01:00
memset(&ao_vgl[ipoint*ao_num*5], 0, 5*ao_num*sizeof(double));
2024-02-06 22:27:17 +01:00
2022-06-29 13:31:58 +02:00
const double e_coord[3] __attribute__((aligned(64))) =
2022-08-14 16:09:58 +02:00
{ coord[ipoint],
coord[ipoint + point_num],
coord[ipoint + 2*point_num] };
2023-09-11 17:05:41 +02:00
2022-05-10 19:18:19 +02:00
for (int64_t inucl=0 ; inucl < nucl_num ; ++inucl) {
2022-06-29 13:31:58 +02:00
const double n_coord[3] __attribute__((aligned(64))) =
2022-08-14 16:09:58 +02:00
{ nucl_coord[inucl],
nucl_coord[inucl + nucl_num],
nucl_coord[inucl + 2*nucl_num] };
2022-05-10 19:18:19 +02:00
2024-05-08 13:56:32 +02:00
const double shift = 1.e-20;
2022-05-10 19:18:19 +02:00
const double x = e_coord[0] - n_coord[0];
const double y = e_coord[1] - n_coord[1];
const double z = e_coord[2] - n_coord[2];
2023-11-28 17:00:39 +01:00
const double x2 = x*x;
const double y2 = y*y;
const double z2 = z*z;
const double r2 = x2 + y2 + z2;
2022-05-10 19:18:19 +02:00
2024-05-08 13:56:32 +02:00
/* Test if the point is in the range of the nucleus */
2023-11-30 12:56:06 +01:00
if (r2 > cutoff * nucleus_range[inucl]) {
2022-05-10 19:18:19 +02:00
continue;
}
int64_t n_poly;
switch (nucleus_max_ang_mom[inucl]) {
case 0:
break;
case 1:
2024-05-08 13:56:32 +02:00
poly_vgl_l1[0][1] = x+shift;
poly_vgl_l1[0][2] = y+shift;
poly_vgl_l1[0][3] = z+shift;
2022-05-10 19:18:19 +02:00
break;
case 2:
2024-05-08 13:56:32 +02:00
poly_vgl_l2[0][1] = x+shift;
poly_vgl_l2[0][2] = y+shift;
poly_vgl_l2[0][3] = z+shift;
poly_vgl_l2[0][4] = x2+shift;
poly_vgl_l2[0][5] = x*y+shift;
poly_vgl_l2[0][6] = x*z+shift;
poly_vgl_l2[0][7] = y2+shift;
poly_vgl_l2[0][8] = y*z+shift;
poly_vgl_l2[0][9] = z2+shift;
2022-05-10 19:18:19 +02:00
poly_vgl_l2[1][4] = x+x;
poly_vgl_l2[1][5] = y;
poly_vgl_l2[1][6] = z;
poly_vgl_l2[2][5] = x;
poly_vgl_l2[2][7] = y+y;
poly_vgl_l2[2][8] = z;
poly_vgl_l2[3][6] = x;
poly_vgl_l2[3][8] = y;
poly_vgl_l2[3][9] = z+z;
break;
default:
2022-10-13 11:48:40 +02:00
rc = qmckl_ao_polynomial_transp_vgl_hpc_inline(context, e_coord, n_coord,
2023-11-28 17:00:39 +01:00
nucleus_max_ang_mom[inucl],
&n_poly, powers, (int64_t) 3,
&(poly_vgl[0][0]), size_max);
2022-05-10 19:18:19 +02:00
assert (rc == QMCKL_SUCCESS);
break;
}
/* Compute all exponents */
int64_t nidx = 0;
2023-11-28 17:00:39 +01:00
if (double_precision) {
for (int64_t iprim = 0 ; iprim < prim_num_per_nucleus[inucl] ; ++iprim) {
const double v = qmckl_mat(expo_per_nucleus, iprim, inucl) * r2;
if (v <= cutoff) {
ar2[iprim] = v;
++nidx;
} else {
break;
}
}
2024-02-14 11:11:50 +01:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2023-11-28 17:00:39 +01:00
for (int64_t iprim = 0 ; iprim < nidx ; ++iprim) {
exp_mat[iprim][0] = exp(-ar2[iprim]);
}
} else {
for (int64_t iprim = 0 ; iprim < prim_num_per_nucleus[inucl] ; ++iprim) {
const double v = qmckl_mat(expo_per_nucleus, iprim, inucl) * r2;
if (v <= cutoff) {
2023-11-29 01:18:15 +01:00
ar2[iprim] = v;
2023-11-28 17:00:39 +01:00
ar2_sp[iprim] = (float) v;
++nidx;
} else {
break;
}
}
2024-02-14 11:11:50 +01:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2023-11-28 17:00:39 +01:00
for (int64_t iprim = 0 ; iprim < nidx ; ++iprim) {
exp_mat_sp[iprim] = expf(-ar2_sp[iprim]);
}
2024-02-14 11:11:50 +01:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2023-11-28 17:00:39 +01:00
for (int64_t iprim = 0 ; iprim < nidx ; ++iprim) {
exp_mat[iprim][0] = exp_mat_sp[iprim];
2022-05-10 19:18:19 +02:00
}
}
2022-08-14 16:09:58 +02:00
2024-02-14 11:11:50 +01:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2022-05-10 19:18:19 +02:00
for (int64_t iprim = 0 ; iprim < nidx ; ++iprim) {
double f = qmckl_mat(expo_per_nucleus, iprim, inucl) * exp_mat[iprim][0];
f = -f-f;
exp_mat[iprim][1] = f * x;
exp_mat[iprim][2] = f * y;
exp_mat[iprim][3] = f * z;
exp_mat[iprim][4] = f * (3.0 - 2.0 * ar2[iprim]);
}
2022-06-14 22:30:33 +02:00
2022-06-29 13:31:58 +02:00
/* --- */
2022-06-14 22:30:33 +02:00
2022-10-11 17:46:30 +02:00
// if (do_sparse) {
for (int i=0 ; i<nucleus_shell_num[inucl] ; ++i) {
2022-08-14 16:09:58 +02:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2022-10-11 17:46:30 +02:00
for (int j=0 ; j<8 ; ++j) {
ce_mat[i][j] = 0.;
}
2022-10-13 11:31:44 +02:00
const int32_t* restrict idx = &(coef_mat_sparse_idx[inucl][i][0]);
const double* restrict v = &(coef_mat_sparse[inucl][i][0]);
2022-10-11 17:46:30 +02:00
for (int l=1 ; l<idx[0]; ++l) {
const int k = idx[l];
if (k >= nidx) break;
2022-08-14 16:09:58 +02:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
2022-10-11 17:46:30 +02:00
for (int j=0 ; j<8 ; ++j) {
2024-01-30 11:31:07 +01:00
ce_mat[i][j] = ce_mat[i][j] + v[l] * exp_mat[k][j];
2022-06-29 13:31:58 +02:00
}
}
2022-05-10 19:18:19 +02:00
}
2022-10-11 17:46:30 +02:00
2022-05-10 19:18:19 +02:00
const int64_t ishell_start = nucleus_index[inucl];
const int64_t ishell_end = nucleus_index[inucl] + nucleus_shell_num[inucl];
2023-11-28 17:00:39 +01:00
const int64_t ipoint_5_ao_num = ipoint*5*ao_num;
2022-05-10 19:18:19 +02:00
for (int64_t ishell = ishell_start ; ishell < ishell_end ; ++ishell) {
const double s1 = ce_mat[ishell-ishell_start][0];
const int64_t k = ao_index[ishell];
2023-11-28 17:00:39 +01:00
double* restrict const ao_vgl_1 = ao_vgl + ipoint_5_ao_num + k;
2022-05-10 19:18:19 +02:00
const int32_t l = shell_ang_mom[ishell];
const int32_t n = lstart[l+1]-lstart[l];
double* restrict const ao_vgl_2 = ao_vgl_1 + ao_num;
double* restrict const ao_vgl_3 = ao_vgl_1 + (ao_num<<1);
double* restrict const ao_vgl_4 = ao_vgl_1 + (ao_num<<1) + ao_num;
double* restrict const ao_vgl_5 = ao_vgl_1 + (ao_num<<2);
2022-06-15 23:21:31 +02:00
if (s1 == 0.0) {
2023-11-28 17:00:39 +01:00
/*
2022-06-15 23:21:31 +02:00
for (int64_t il=0 ; il<n ; ++il) {
ao_vgl_1[il] = 0.0;
ao_vgl_2[il] = 0.0;
ao_vgl_3[il] = 0.0;
ao_vgl_4[il] = 0.0;
ao_vgl_5[il] = 0.0;
}
2024-05-08 13:56:32 +02:00
,*/
2022-06-15 23:21:31 +02:00
continue;
}
const double s2 = ce_mat[ishell-ishell_start][1];
const double s3 = ce_mat[ishell-ishell_start][2];
const double s4 = ce_mat[ishell-ishell_start][3];
const double s5 = ce_mat[ishell-ishell_start][4];
2022-05-10 19:18:19 +02:00
double* restrict poly_vgl_1 = NULL;
double* restrict poly_vgl_2 = NULL;
double* restrict poly_vgl_3 = NULL;
double* restrict poly_vgl_4 = NULL;
double* restrict poly_vgl_5 = NULL;
if (nidx > 0) {
const double* restrict f = ao_factor + k;
const int64_t idx = lstart[l];
switch (nucleus_max_ang_mom[inucl]) {
case 0:
break;
case 1:
poly_vgl_1 = &(poly_vgl_l1[0][idx]);
poly_vgl_2 = &(poly_vgl_l1[1][idx]);
poly_vgl_3 = &(poly_vgl_l1[2][idx]);
poly_vgl_4 = &(poly_vgl_l1[3][idx]);
break;
case 2:
poly_vgl_1 = &(poly_vgl_l2[0][idx]);
poly_vgl_2 = &(poly_vgl_l2[1][idx]);
poly_vgl_3 = &(poly_vgl_l2[2][idx]);
poly_vgl_4 = &(poly_vgl_l2[3][idx]);
poly_vgl_5 = &(poly_vgl_l2[4][idx]);
break;
default:
poly_vgl_1 = &(poly_vgl[0][idx]);
poly_vgl_2 = &(poly_vgl[1][idx]);
poly_vgl_3 = &(poly_vgl[2][idx]);
poly_vgl_4 = &(poly_vgl[3][idx]);
poly_vgl_5 = &(poly_vgl[4][idx]);
}
switch (n) {
2022-08-14 16:09:58 +02:00
case 1:
2022-05-10 19:18:19 +02:00
ao_vgl_1[0] = s1 * f[0];
ao_vgl_2[0] = s2 * f[0];
ao_vgl_3[0] = s3 * f[0];
ao_vgl_4[0] = s4 * f[0];
2024-01-11 14:33:40 +01:00
ao_vgl_5[0] = s5 * f[0];
2022-05-10 19:18:19 +02:00
break;
2022-08-14 16:09:58 +02:00
case 3:
2022-05-10 19:18:19 +02:00
#ifdef HAVE_OPENMP
#pragma omp simd
#endif
for (int il=0 ; il<3 ; ++il) {
ao_vgl_1[il] = poly_vgl_1[il] * s1 * f[il];
ao_vgl_2[il] = (poly_vgl_2[il] * s1 + poly_vgl_1[il] * s2) * f[il];
ao_vgl_3[il] = (poly_vgl_3[il] * s1 + poly_vgl_1[il] * s3) * f[il];
ao_vgl_4[il] = (poly_vgl_4[il] * s1 + poly_vgl_1[il] * s4) * f[il];
ao_vgl_5[il] = (poly_vgl_1[il] * s5 +
2.0*(poly_vgl_2[il] * s2 +
2022-03-21 18:32:39 +01:00
poly_vgl_3[il] * s3 +
poly_vgl_4[il] * s4 )) * f[il];
}
break;
2022-08-14 16:09:58 +02:00
case 6:
2022-02-25 16:30:16 +01:00
#ifdef HAVE_OPENMP
2022-03-21 18:32:39 +01:00
#pragma omp simd
2022-02-25 16:30:16 +01:00
#endif
2022-03-21 18:32:39 +01:00
for (int il=0 ; il<6 ; ++il) {
ao_vgl_1[il] = poly_vgl_1[il] * s1 * f[il];
ao_vgl_2[il] = (poly_vgl_2[il] * s1 + poly_vgl_1[il] * s2) * f[il];
ao_vgl_3[il] = (poly_vgl_3[il] * s1 + poly_vgl_1[il] * s3) * f[il];
ao_vgl_4[il] = (poly_vgl_4[il] * s1 + poly_vgl_1[il] * s4) * f[il];
ao_vgl_5[il] = (poly_vgl_5[il] * s1 + poly_vgl_1[il] * s5 +
2.0*(poly_vgl_2[il] * s2 +
poly_vgl_3[il] * s3 +
poly_vgl_4[il] * s4 )) * f[il];
}
break;
default:
2022-02-25 16:30:16 +01:00
#ifdef HAVE_OPENMP
2022-06-15 23:21:31 +02:00
#pragma omp simd
2022-02-25 16:30:16 +01:00
#endif
2022-03-21 18:32:39 +01:00
for (int 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];
ao_vgl_3[il] = (poly_vgl_3[il] * s1 + poly_vgl_1[il] * s3) * f[il];
ao_vgl_4[il] = (poly_vgl_4[il] * s1 + poly_vgl_1[il] * s4) * f[il];
ao_vgl_5[il] = (poly_vgl_5[il] * s1 + poly_vgl_1[il] * s5 +
2.0*(poly_vgl_2[il] * s2 +
poly_vgl_3[il] * s3 +
poly_vgl_4[il] * s4 )) * f[il];
}
break;
}
2023-11-28 17:00:39 +01:00
/*
2024-02-23 11:56:28 +01:00
} else {
2022-03-21 18:32:39 +01:00
for (int64_t il=0 ; il<n ; ++il) {
ao_vgl_1[il] = 0.0;
ao_vgl_2[il] = 0.0;
ao_vgl_3[il] = 0.0;
ao_vgl_4[il] = 0.0;
ao_vgl_5[il] = 0.0;
}
2024-05-08 13:56:32 +02:00
,*/
2022-02-16 00:21:37 +01:00
}
2022-03-21 18:32:39 +01:00
}
}
2022-02-16 00:21:37 +01:00
}
2023-09-13 13:23:16 +02:00
free(coef_mat_sparse_idx);
free(coef_mat_sparse);
2022-02-16 00:21:37 +01:00
}
2022-03-21 18:32:39 +01:00
2022-02-16 00:21:37 +01:00
return QMCKL_SUCCESS;
}
#endif
2022-05-10 19:18:19 +02:00
#+end_src
2021-07-11 23:20:40 +02:00
2022-05-10 19:18:19 +02:00
*** Interfaces
# #+CALL: generate_c_header(table=qmckl_ao_vgl_args_doc,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl"))
# (Commented because the header needs to go into h_private_func)
2021-07-11 23:20:40 +02:00
2022-05-10 19:18:19 +02:00
#+begin_src c :tangle (eval h_private_func) :comments org
2022-02-14 19:11:37 +01:00
qmckl_exit_code qmckl_compute_ao_vgl_doc (
2021-07-11 23:20:40 +02:00
const qmckl_context context,
const int64_t ao_num,
const int64_t shell_num,
2022-01-26 17:06:51 +01:00
const int64_t point_num,
2021-07-11 23:20:40 +02:00
const int64_t nucl_num,
2022-01-26 17:06:51 +01:00
const double* coord,
2021-07-11 23:20:40 +02:00
const double* nucl_coord,
const int64_t* nucleus_index,
const int64_t* nucleus_shell_num,
const double* nucleus_range,
const int32_t* nucleus_max_ang_mom,
const int32_t* shell_ang_mom,
2021-07-13 09:54:43 +02:00
const double* ao_factor,
2021-07-11 23:20:40 +02:00
const double* shell_vgl,
double* const ao_vgl );
2022-05-10 19:18:19 +02:00
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org
#ifdef HAVE_HPC
2022-02-19 19:24:18 +01:00
qmckl_exit_code qmckl_compute_ao_vgl_hpc_gaussian (
2022-02-14 19:11:37 +01:00
const qmckl_context context,
const int64_t ao_num,
const int64_t shell_num,
2022-03-21 18:32:39 +01:00
const int32_t* prim_num_per_nucleus,
2022-02-14 19:11:37 +01:00
const int64_t point_num,
const int64_t nucl_num,
const double* coord,
const double* nucl_coord,
const int64_t* nucleus_index,
const int64_t* nucleus_shell_num,
const double* nucleus_range,
const int32_t* nucleus_max_ang_mom,
const int32_t* shell_ang_mom,
const double* ao_factor,
2022-03-21 18:32:39 +01:00
const qmckl_matrix expo_per_nucleus,
const qmckl_tensor coef_per_nucleus,
2022-02-14 19:11:37 +01:00
double* const ao_vgl );
#endif
2022-05-10 19:18:19 +02:00
#+end_src
2021-07-11 23:20:40 +02:00
2022-05-10 19:18:19 +02:00
**** Provide :noexport:
2022-01-05 19:22:16 +01:00
2022-07-11 13:42:39 +02:00
#+CALL: write_provider_header( group="ao_basis", data="ao_vgl" )
2022-01-05 19:22:16 +01:00
2022-07-11 13:42:39 +02:00
#+RESULTS:
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_ao_vgl(qmckl_context context);
#+end_src
#+CALL: write_provider_pre( group="ao_basis", data="ao_vgl", dimension="ctx->ao_basis.ao_num * 5 * ctx->point.num")
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
qmckl_exit_code qmckl_provide_ao_basis_ao_vgl(qmckl_context context)
2022-01-05 19:22:16 +01:00
{
2022-08-07 14:57:10 +02:00
qmckl_exit_code rc = QMCKL_SUCCESS;
2022-07-11 13:42:39 +02:00
2022-01-05 19:22:16 +01:00
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
2022-07-11 13:42:39 +02:00
"qmckl_provide_ao_basis_ao_vgl",
2022-01-05 19:22:16 +01:00
NULL);
}
2022-04-05 11:03:38 +02:00
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
2022-01-05 19:22:16 +01:00
assert (ctx != NULL);
if (!ctx->ao_basis.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
2022-07-11 13:42:39 +02:00
"qmckl_provide_ao_basis_ao_vgl",
2022-01-05 19:22:16 +01:00
NULL);
}
/* Compute if necessary */
2022-01-26 17:06:51 +01:00
if (ctx->point.date > ctx->ao_basis.ao_vgl_date) {
2022-01-05 19:22:16 +01:00
2022-08-07 14:57:10 +02:00
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->ao_basis.ao_num * 5 * ctx->point.num * sizeof(double);
if (ctx->ao_basis.ao_vgl != NULL) {
qmckl_memory_info_struct mem_info_test = qmckl_memory_info_struct_zero;
rc = qmckl_get_malloc_info(context, ctx->ao_basis.ao_vgl, &mem_info_test);
/* if rc != QMCKL_SUCCESS, we are maybe in an _inplace function because the
memory was not allocated with qmckl_malloc */
if ((rc == QMCKL_SUCCESS) && (mem_info_test.size != mem_info.size)) {
2022-07-11 13:42:39 +02:00
rc = qmckl_free(context, ctx->ao_basis.ao_vgl);
assert (rc == QMCKL_SUCCESS);
ctx->ao_basis.ao_vgl = NULL;
}
2022-01-05 19:22:16 +01:00
}
/* Allocate array */
if (ctx->ao_basis.ao_vgl == NULL) {
double* ao_vgl = (double*) qmckl_malloc(context, mem_info);
if (ao_vgl == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_ao_basis_ao_vgl",
NULL);
}
ctx->ao_basis.ao_vgl = ao_vgl;
}
2022-07-11 13:42:39 +02:00
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
2022-02-14 19:11:37 +01:00
#ifdef HAVE_HPC
2023-11-30 12:50:06 +01:00
if (ctx->ao_basis.type == 'G') {
rc = qmckl_compute_ao_vgl_hpc_gaussian(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->ao_basis.prim_num_per_nucleus,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
2023-11-30 12:56:06 +01:00
ctx->ao_basis.nucleus_range,
2023-11-30 12:50:06 +01:00
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.expo_per_nucleus,
ctx->ao_basis.coef_per_nucleus,
ctx->ao_basis.ao_vgl);
/* DEBUG
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
}
2022-06-15 23:21:31 +02:00
int64_t K= ctx->ao_basis.ao_num * 5 * ctx->point.num;
double* check = malloc(K*sizeof(double));
2023-11-30 12:50:06 +01:00
rc = qmckl_compute_ao_vgl_doc(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
ctx->ao_basis.nucleus_range,
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.shell_vgl,
check);
2022-06-15 23:21:31 +02:00
for (int64_t i=0 ; i<K ; ++i) {
2023-11-30 12:50:06 +01:00
if (fabs(check[i] - ctx->ao_basis.ao_vgl[i]) > 1.e-10) {
int a, b, c;
a = i/(ctx->ao_basis.ao_num*5);
b = (i-a*ctx->ao_basis.ao_num*5)/ctx->ao_basis.ao_num;
c = (i-a*ctx->ao_basis.ao_num*5 -b*ctx->ao_basis.ao_num);
printf("%d: %d, %d, %d, %e %e\n", i, a, b, c, check[i], ctx->ao_basis.ao_vgl[i]);
2022-06-15 23:21:31 +02:00
}
2023-11-30 12:50:06 +01:00
}
,*/
2022-06-15 23:21:31 +02:00
2023-11-30 12:50:06 +01:00
/*
2022-02-19 19:24:18 +01:00
} else if (ctx->ao_basis.type == 'S') {
2023-11-30 12:50:06 +01:00
rc = qmck_compute_ao_vgl_hpc_slater(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->ao_basis.prim_num,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
ctx->ao_basis.nucleus_range,
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.shell_prim_index,
ctx->ao_basis.shell_prim_num,
ctx->ao_basis.ao_factor,
ctx->ao_basis.exponent,
ctx->ao_basis.coefficient_normalized,
ctx->ao_basis.ao_vgl);
,*/
} else {
/* Provide required data */
2022-07-11 13:42:39 +02:00
2023-11-30 12:50:06 +01:00
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
}
rc = qmckl_compute_ao_vgl_doc(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
2023-11-30 12:56:06 +01:00
ctx->ao_basis.nucleus_range,
2023-11-30 12:50:06 +01:00
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.shell_vgl,
ctx->ao_basis.ao_vgl);
}
2022-02-14 19:11:37 +01:00
#else
2023-11-30 12:50:06 +01:00
rc = qmckl_provide_ao_basis_shell_vgl(context);
if (rc != QMCKL_SUCCESS) {
return qmckl_failwith( context, rc, "qmckl_provide_ao_basis_shell_vgl", NULL);
}
2022-07-11 13:42:39 +02:00
2023-11-30 12:50:06 +01:00
rc = qmckl_compute_ao_vgl_doc(context,
ctx->ao_basis.ao_num,
ctx->ao_basis.shell_num,
ctx->point.num,
ctx->nucleus.num,
ctx->point.coord.data,
ctx->nucleus.coord.data,
ctx->ao_basis.nucleus_index,
ctx->ao_basis.nucleus_shell_num,
2023-11-30 12:56:06 +01:00
ctx->ao_basis.nucleus_range,
2023-11-30 12:50:06 +01:00
ctx->ao_basis.nucleus_max_ang_mom,
ctx->ao_basis.shell_ang_mom,
ctx->ao_basis.ao_factor,
ctx->ao_basis.shell_vgl,
ctx->ao_basis.ao_vgl);
2022-02-14 19:11:37 +01:00
#endif
2022-07-11 13:42:39 +02:00
#+end_src
#+CALL: write_provider_post( group="ao_basis", data="ao_vgl" )
#+RESULTS:
#+begin_src c :comments org :tangle (eval c) :noweb yes :export none
2022-01-05 19:22:16 +01:00
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->ao_basis.ao_vgl_date = ctx->date;
}
return QMCKL_SUCCESS;
}
2022-07-11 13:42:39 +02:00
#+end_src
2022-01-05 19:22:16 +01:00
2022-05-10 19:18:19 +02:00
**** Test :noexport:
2022-01-05 19:22:16 +01:00
2022-05-10 19:18:19 +02:00
#+begin_src python :results output :exports none
2021-07-11 23:20:40 +02:00
import numpy as np
2021-09-23 11:16:54 +02:00
from math import sqrt
2021-07-11 23:20:40 +02:00
2022-03-21 18:32:39 +01:00
h0 = 1.e-4
2021-07-11 23:20:40 +02:00
def f(a,x,y):
return np.sum( [c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] )
2021-07-11 23:20:40 +02:00
2022-03-21 18:32:39 +01:00
def fx(a,x,y):
return f(a,x,y) * (x[0] - y[0])**2
2021-07-11 23:20:40 +02:00
def df(a,x,y,n):
2022-03-21 18:32:39 +01:00
if n == 1: h = np.array([h0,0.,0.])
elif n == 2: h = np.array([0.,h0,0.])
elif n == 3: h = np.array([0.,0.,h0])
return ( fx(a,x+h,y) - fx(a,x-h,y) ) / (2.*h0)
# return np.sum( [-2.*b * c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] ) * (x-y)[n-1]
2021-07-11 23:20:40 +02:00
def d2f(a,x,y,n):
if n == 1: h = np.array([h0,0.,0.])
elif n == 2: h = np.array([0.,h0,0.])
elif n == 3: h = np.array([0.,0.,h0])
2022-03-21 18:32:39 +01:00
return ( fx(a,x+h,y) - 2.*fx(a,x,y) + fx(a,x-h,y) ) / h0**2
2022-06-11 10:57:58 +02:00
# return np.sum( [( (2.*b*(x-y)[n-1])**2 -2.*b ) * c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] )
2021-07-11 23:20:40 +02:00
def lf(a,x,y):
2022-06-11 10:57:58 +02:00
# return np.sum( [( (2.*b*np.linalg.norm(x-y))**2 -6.*b ) * c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] )
2021-07-11 23:20:40 +02:00
return d2f(a,x,y,1) + d2f(a,x,y,2) + d2f(a,x,y,3)
2022-03-21 18:32:39 +01:00
2021-07-11 23:20:40 +02:00
elec_26_w1 = np.array( [ 1.49050402641, 2.90106987953, -1.05920815468 ] )
elec_15_w2 = np.array( [ -2.20180344582,-1.9113150239, 2.2193744778600002 ] )
nucl_1 = np.array( [ -2.302574592081335e+00, -3.542027060505035e-01, -5.334129934317614e-02] )
2021-09-23 11:16:54 +02:00
#double ao_vgl[prim_num][5][elec_num];
2021-07-11 23:20:40 +02:00
x = elec_26_w1 ; y = nucl_1
2022-03-21 18:32:39 +01:00
a = [( 4.0382999999999998e+02, 1.4732000000000000e-03 * 5.9876577632594533e+04),
( 1.2117000000000000e+02, 1.2672500000000000e-02 * 7.2836806319891484e+03),
( 4.6344999999999999e+01, 5.8045100000000002e-02 * 1.3549226646722386e+03),
( 1.9721000000000000e+01, 1.7051030000000000e-01 * 3.0376315094739988e+02),
( 8.8623999999999992e+00, 3.1859579999999998e-01 * 7.4924579607137730e+01),
( 3.9962000000000000e+00, 3.8450230000000002e-01 * 1.8590543353806009e+01),
( 1.7636000000000001e+00, 2.7377370000000001e-01 * 4.4423176930919421e+00),
( 7.0618999999999998e-01, 7.4396699999999996e-02 * 8.9541051939952665e-01)]
2021-07-11 23:20:40 +02:00
2021-09-23 11:16:54 +02:00
norm = sqrt(3.)
2022-03-21 18:32:39 +01:00
# x^2 * g(r)
print ( "[26][0][219] : %25.15e"%(fx(a,x,y)) )
print ( "[26][1][219] : %25.15e"%(df(a,x,y,1)) )
print ( "[26][2][219] : %25.15e"%(df(a,x,y,2)) )
print ( "[26][3][219] : %25.15e"%(df(a,x,y,3)) )
print ( "[26][4][219] : %25.15e"%(lf(a,x,y)) )
2021-07-11 23:20:40 +02:00
2022-03-21 18:32:39 +01:00
print ( "[26][0][220] : %25.15e"%(norm*f(a,x,y) * (x[0] - y[0]) * (x[1] - y[1]) ))
print ( "[26][1][220] : %25.15e"%(norm*df(a,x,y,1)* (x[0] - y[0]) * (x[1] - y[1]) + norm*f(a,x,y) * (x[1] - y[1])) )
2021-07-11 23:20:40 +02:00
2022-03-21 18:32:39 +01:00
print ( "[26][0][221] : %25.15e"%(norm*f(a,x,y) * (x[0] - y[0]) * (x[2] - y[2])) )
print ( "[26][1][221] : %25.15e"%(norm*df(a,x,y,1)* (x[0] - y[0]) * (x[2] - y[2]) + norm*f(a,x,y) * (x[2] - y[2])) )
2021-07-11 23:20:40 +02:00
2022-03-21 18:32:39 +01:00
print ( "[26][0][222] : %25.15e"%(f(a,x,y) * (x[1] - y[1]) * (x[1] - y[1])) )
print ( "[26][1][222] : %25.15e"%(df(a,x,y,1)* (x[1] - y[1]) * (x[1] - y[1])) )
2021-07-11 23:20:40 +02:00
2022-03-21 18:32:39 +01:00
print ( "[26][0][223] : %25.15e"%(norm*f(a,x,y) * (x[1] - y[1]) * (x[2] - y[2])) )
print ( "[26][1][223] : %25.15e"%(norm*df(a,x,y,1)* (x[1] - y[1]) * (x[2] - y[2])) )
2021-07-11 23:20:40 +02:00
2022-03-21 18:32:39 +01:00
print ( "[26][0][224] : %25.15e"%(f(a,x,y) * (x[2] - y[2]) * (x[2] - y[2])) )
print ( "[26][1][224] : %25.15e"%(df(a,x,y,1)* (x[2] - y[2]) * (x[2] - y[2])) )
2021-07-11 23:20:40 +02:00
2022-05-10 19:18:19 +02:00
#+end_src
2021-07-11 23:20:40 +02:00
2022-05-10 19:18:19 +02:00
#+RESULTS:
2021-07-11 23:20:40 +02:00
2022-05-10 19:18:19 +02:00
#+begin_src c :tangle (eval c_test) :exports none
2021-07-11 23:20:40 +02:00
{
#define shell_num chbrclf_shell_num
#define ao_num chbrclf_ao_num
double* elec_coord = &(chbrclf_elec_coord[0][0][0]);
assert(qmckl_electron_provided(context));
2023-09-14 11:00:24 +02:00
int64_t point_num = elec_num;
2022-08-07 14:57:10 +02:00
rc = qmckl_set_point(context, 'N', point_num, elec_coord, point_num*3);
2021-07-11 23:20:40 +02:00
assert(rc == QMCKL_SUCCESS);
2022-08-07 14:57:10 +02:00
double ao_vgl[point_num][5][ao_num];
2021-07-11 23:20:40 +02:00
2022-01-06 02:28:13 +01:00
rc = qmckl_get_ao_basis_ao_vgl(context, &(ao_vgl[0][0][0]),
2022-08-07 14:57:10 +02:00
(int64_t) 5*point_num*ao_num);
2021-07-11 23:20:40 +02:00
assert (rc == QMCKL_SUCCESS);
printf("\n");
2022-03-21 18:32:39 +01:00
printf(" ao_vgl ao_vgl[26][0][219] %25.15e\n", ao_vgl[26][0][219]);
printf(" ao_vgl ao_vgl[26][1][219] %25.15e\n", ao_vgl[26][1][219]);
printf(" ao_vgl ao_vgl[26][2][219] %25.15e\n", ao_vgl[26][2][219]);
printf(" ao_vgl ao_vgl[26][3][219] %25.15e\n", ao_vgl[26][3][219]);
printf(" ao_vgl ao_vgl[26][4][219] %25.15e\n", ao_vgl[26][4][219]);
printf(" ao_vgl ao_vgl[26][0][220] %25.15e\n", ao_vgl[26][0][220]);
printf(" ao_vgl ao_vgl[26][1][220] %25.15e\n", ao_vgl[26][1][220]);
printf(" ao_vgl ao_vgl[26][2][220] %25.15e\n", ao_vgl[26][2][220]);
printf(" ao_vgl ao_vgl[26][3][220] %25.15e\n", ao_vgl[26][3][220]);
printf(" ao_vgl ao_vgl[26][4][220] %25.15e\n", ao_vgl[26][4][220]);
printf(" ao_vgl ao_vgl[26][0][221] %25.15e\n", ao_vgl[26][0][221]);
printf(" ao_vgl ao_vgl[26][1][221] %25.15e\n", ao_vgl[26][1][221]);
printf(" ao_vgl ao_vgl[26][2][221] %25.15e\n", ao_vgl[26][2][221]);
printf(" ao_vgl ao_vgl[26][3][221] %25.15e\n", ao_vgl[26][3][221]);
printf(" ao_vgl ao_vgl[26][4][221] %25.15e\n", ao_vgl[26][4][221]);
printf(" ao_vgl ao_vgl[26][0][222] %25.15e\n", ao_vgl[26][0][222]);
printf(" ao_vgl ao_vgl[26][1][222] %25.15e\n", ao_vgl[26][1][222]);
printf(" ao_vgl ao_vgl[26][2][222] %25.15e\n", ao_vgl[26][2][222]);
printf(" ao_vgl ao_vgl[26][3][222] %25.15e\n", ao_vgl[26][3][222]);
printf(" ao_vgl ao_vgl[26][4][222] %25.15e\n", ao_vgl[26][4][222]);
printf(" ao_vgl ao_vgl[26][0][223] %25.15e\n", ao_vgl[26][0][223]);
printf(" ao_vgl ao_vgl[26][1][223] %25.15e\n", ao_vgl[26][1][223]);
printf(" ao_vgl ao_vgl[26][2][223] %25.15e\n", ao_vgl[26][2][223]);
printf(" ao_vgl ao_vgl[26][3][223] %25.15e\n", ao_vgl[26][3][223]);
printf(" ao_vgl ao_vgl[26][4][223] %25.15e\n", ao_vgl[26][4][223]);
printf(" ao_vgl ao_vgl[26][0][224] %25.15e\n", ao_vgl[26][0][224]);
printf(" ao_vgl ao_vgl[26][1][224] %25.15e\n", ao_vgl[26][1][224]);
printf(" ao_vgl ao_vgl[26][2][224] %25.15e\n", ao_vgl[26][2][224]);
printf(" ao_vgl ao_vgl[26][3][224] %25.15e\n", ao_vgl[26][3][224]);
printf(" ao_vgl ao_vgl[26][4][224] %25.15e\n", ao_vgl[26][4][224]);
2021-07-11 23:20:40 +02:00
printf("\n");
2022-03-21 18:32:39 +01:00
assert( fabs(ao_vgl[26][0][219] - ( 1.020298798341620e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][1][219] - ( -4.928035238010602e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][2][219] - ( -4.691009312035986e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][3][219] - ( 1.449504046436699e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][4][219] - ( 4.296442111843973e-07)) < 1.e-14 );
assert( fabs(ao_vgl[26][0][220] - ( 1.516643537739178e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][1][220] - ( -7.725221462603871e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][2][220] - ( -6.507140835104833e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][3][220] - ( 2.154644255710413e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][4][220] - ( 6.365449359656352e-07)) < 1.e-14 );
assert( fabs(ao_vgl[26][0][221] - ( -4.686370882518819e-09)) < 1.e-14 );
assert( fabs(ao_vgl[26][1][221] - ( 2.387064067626827e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][2][221] - ( 2.154644255710412e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][3][221] - ( -1.998731863512374e-09)) < 1.e-14 );
assert( fabs(ao_vgl[26][4][221] - ( -1.966899656441993e-07)) < 1.e-14 );
assert( fabs(ao_vgl[26][0][222] - ( 7.514816980753531e-09)) < 1.e-14 );
assert( fabs(ao_vgl[26][1][222] - ( -4.025889138635182e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][2][222] - ( -2.993372555126361e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][3][222] - ( 1.067604670272904e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][4][222] - ( 3.168199650002648e-07)) < 1.e-14 );
assert( fabs(ao_vgl[26][0][223] - ( -4.021908374204471e-09)) < 1.e-14 );
assert( fabs(ao_vgl[26][1][223] - ( 2.154644255710413e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][2][223] - ( 1.725594944732276e-08)) < 1.e-14 );
assert( fabs(ao_vgl[26][3][223] - ( -1.715339357718333e-09)) < 1.e-14 );
assert( fabs(ao_vgl[26][4][223] - ( -1.688020516893476e-07)) < 1.e-14 );
assert( fabs(ao_vgl[26][0][224] - ( 7.175045873560788e-10)) < 1.e-14 );
assert( fabs(ao_vgl[26][1][224] - ( -3.843864637762753e-09)) < 1.e-14 );
assert( fabs(ao_vgl[26][2][224] - ( -3.298857850451910e-09)) < 1.e-14 );
assert( fabs(ao_vgl[26][3][224] - ( -4.073047518790881e-10)) < 1.e-14 );
assert( fabs(ao_vgl[26][4][224] - ( 3.153244195820293e-08)) < 1.e-14 );
2021-10-13 15:01:23 +02:00
}
2022-05-10 19:18:19 +02:00
#+end_src
2021-07-11 23:20:40 +02:00
2021-04-01 01:19:33 +02:00
* End of files :noexport:
2021-04-30 01:26:19 +02:00
2021-04-01 01:19:33 +02:00
#+begin_src c :tangle (eval h_private_type)
#endif
#+end_src
2021-10-14 21:40:14 +02:00
#+begin_src c :tangle (eval h_private_func)
#endif
#+end_src
2021-04-01 01:19:33 +02:00
*** Test
#+begin_src c :tangle (eval c_test)
2021-05-11 16:41:03 +02:00
rc = qmckl_context_destroy(context);
assert (rc == QMCKL_SUCCESS);
return 0;
2021-04-01 01:19:33 +02:00
}
#+end_src
2021-04-30 01:26:19 +02:00
2021-10-14 21:40:14 +02:00
*** Compute file names
2021-04-30 01:26:19 +02:00
#+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
2021-04-01 01:19:33 +02:00
#+RESULTS:
| | color |
| | listings |
2021-04-30 01:26:19 +02:00
2021-04-01 01:19:33 +02:00
# -*- mode: org -*-
# vim: syntax=c
2021-10-14 16:32:58 +02:00
2022-01-05 12:26:11 +01:00
* TODO [0/1] Missing features :noexport:
- [ ] Error messages to tell what is missing when initializing